From 11890621257a43a5226b8b24e0fe526d171a034e Mon Sep 17 00:00:00 2001 From: Thibaud Fritz Date: Wed, 6 Nov 2019 10:34:36 -0500 Subject: [PATCH 001/291] Feat: Changes to include GEOS-Chem as a chemistry option for CESM (1) This introduces an option to compile GEOS-Chem src files. (2) Interface is inexistant so far (3) CAM still uses the Terminator chem package to satisfy dependencies Reproducing commit from MSL - Jan 19, 2018 --- src/chemistry/pp_geoschem/.exclude | 53 ++++++++++++++++++++++++++++++ 1 file changed, 53 insertions(+) create mode 100644 src/chemistry/pp_geoschem/.exclude diff --git a/src/chemistry/pp_geoschem/.exclude b/src/chemistry/pp_geoschem/.exclude new file mode 100644 index 0000000000..2f725c1ef5 --- /dev/null +++ b/src/chemistry/pp_geoschem/.exclude @@ -0,0 +1,53 @@ +regrid_a2a_mod.F90 +transport_mod.F +drydep_mod.F +tpcore_window_mod.F90 +tpcore_bc_mod.F90 +tpcore_fvdas_mod.F90 +olson_landmap_mod.F90 +geosfp_read_mod.F90 +modis_lai_mod.F90 +hco_interp_mod.F90 +merra2_read_mod.F90 +regrid_a2a_mod.F90 +land_mercury_mod.F +hcoio_read_std_mod.F90 +hcoio_dataread_mod.F90 +hco_readlist_mod.F90 +hcox_paranox_mod.F90 +hco_config_mod.F90 +planeflight_mod.F +hco_driver_mod.F90 +hcox_driver_mod.F90 +hcox_lightnox_mod.F90 +hcoi_standalone_mod.F90 +hemco_standalone.F90 +restart_mod.F +pops_mod.F +diag49_mod.F +diag51_mod.F +diag03_mod.F +diag04_mod.F +diag1.F +diag20_mod.F +diag_2pm.F +diag3.F +diag41_mod.F +diag42_mod.F +diag48_mod.F +diag50_mod.F +diag51b_mod.F +diag53_mod.F +diag56_mod.F +diag63_mod.F +emissions_mod.F90 +diag3.F +hcoi_gc_main_mod.F90 +gamap_mod.F +initialize.F +ndxx_setup.F +mixing_mod.F90 +vdiff_mod.F90 +input_mod.F +cleanup.F +main.F From a5bf274c92c4b95d7f2b1076a5fcf415fe1e6396 Mon Sep 17 00:00:00 2001 From: Thibaud Fritz Date: Thu, 14 May 2020 15:42:04 -0400 Subject: [PATCH 002/291] Squashed of 50+ commits from Thibaud Fritz Feat: Update config files to include GEOS-Chem option for CAM (1) Update config files in cam/bld/ (2) Update config files in cam/cime_config Feat: Add customized chemistry.F90 for GEOS-Chem: *Reproducing commit from MSL - Mar 6, 2018 Feat: Initial implementation of compilable code (1) The code can now be compiled using a CAM 4.0 + "dummy" GEOS-Chem component set (compset FGC). This is based on the "tropospheric mozart" set. *Reproducing commit from SDE - May 17, 2018 Feat: Make radiatively-active species into chemical constituants (1) Added N2O, CH4, CFC11, CFC12 Feat: Get tracers and species from input.geos and KPP (1) Tracer lists are now acquired from the input files and from the pre-built KPP mechanism *Reproducing commit from SDE - May 19, 2018 Feat: Add additional flags when compiling GEOS-Chem Fix: Update folder name following version 12.6.0 Feat: Allocate major state variables (Input, Met, Chem) (1) Allocating GEOS-Chem state variables (2) Setting input.geos path as a module variable *Reproducing commit from SDE - May 19, 2018 Chore: Cleanup and capitalization Feat: Initialize core GEOS-Chem modules (1) Initializes ChmState, GrdState and MetState objects (2) Grid objects are currently initialized identically. However, they should be chunk-dependent. The grids are set based on the lat/lon edges for now, using GEOS-Chem's SetGridFromCtrEdges subroutine (3) Initializes Input_Opt (4) Added subroutine to update time-steps within GEOS-Chem (5) Added error trapping statements Feat: Add initialization of Linoz module and passing CHEM_INPUTS (1) Initializing Linoz module (2) Passing CHEM_INPUTS to Input_Opt (3) Remove incorrect overwrite of NTracers Feat: Initialize and cleanup State_Chm and State_Met Feat: Initialize Drydep_Mod (1) Initialize Drydep_Mod (2) Update .exclude file to include GeosCore/drydep_mod.F Feat: Add Init_Error to chem_init for GEOS-Chem Feat: Initialize and cleanup GEOS-Chem modules (1) Add calls to module initialization and cleanup subroutines (2) Update .exclude file Feat: Get grid area and Ap and Bp values from CAM (1) Get grid area from CAM interface (2) Pass CAM's Ap and Bp values to GEOS-Chem's Pressure_Mod (3) Call to Cleanup_Pressure Feat: Affect data to State_Chm Feat: Initialize chemistry, add missing cleanup routines Feat: Initialize pressure transfer Feat: Add first call to chemistry Feat: Register all tracers using species database (1) Register species (2) Initial step towards the update of State_Met Feat: Fill key variables in State_Met Feat: Add PBL height transfer capability (1) Enforce lat/lonMidArr to be R4 not FP Feat: Enforce correct tracer registration Feat: Add initialization of short-lived species Feat: Update surface area during chemistry loop Feat: Use reference MMRs when queried for ICs (1) Zero reference MMRs at initialization (2) Use reference MMRs when queried for initial conditions Feat: Groundwork for correctly reporing H2O tendencies (1) Add indices to key species Feat: Add all advected species to output (1) Add advected species to output (2) Force precision of H2O to be r8 (3) Fixed capitalization of variables Feat: Make short-lived species persist between time steps Feat: Set GEOS-Chem data from CAM (1) Date information is now propagated to GEOS-Chem. Algorithm needs tweaking (seems to give a date 1 minute earlier than it should). Also currently force the year to be 2000 as the default CAM year is 0000. Feat: Disable stratospheric aerosols in GEOS-Chem Feat: Progate more met fields to State_Met using CAM data Feat: Change NY to PCOLS for consistency and add step count tracking Feat: Increased default list of diagnostics for GEOS-Chem Feat: Implement GEOS-Chem wet deposition + Estimate of 2D cloudiness (1) Implemented GEOS-Chem wet deposition (2) CAM does not provide an estimate of 2D cloud cover, so we use an estimate (maximum 3D cloudiness in vertical column). This matches the technique originally used for GCAP in GEOS-Chem. (3) Fix Z0 not being assigned Feat: Move SLS information to chem_mods + Emission module (1) Move tracer and SLS information out to chem_mods (2) Added temporary NO source to provide useful output (3) Initial code stub for an emissions module Fix: Fix reading of tracers in input.geos (1) Tracers in input.geos (2) Fix indentation Chore: Now compiling GEOS-Chem with -DMODEL_ Feat: Added wet/(dry) deposition. See more comments below! (01) Added definition of MaxTropLev, MaxStratLev and MaxChemLev. This will require some additional thought (02) As of right now, Linoz is turned off as the current grid doesn't extend past 30 km, causing segmentation when running with Linoz turned on (03) Added code that's commented out right now for future development (HEMCO, Olson landmap, convection, ...) (04) Added field descrition and unit of State_Met variables when converted from CESM to State_Met (05) Updated compution of cloud optical depth. Following what MOZART does. (06) Now correctly initializing InChemGrid to .True. everywhere (07) Added newDay, newMonth variables (08) Added wet deposition (09) Added dry deposition. However, it is purely a software right now, as it runs without initializing land types (10) Uniformization of variables Chore: Remove debug Feat: Deal with compile-time definition of GEOS-Chem dry dep. species (1) Update ChemNamelist to be able to read deposition species from .xml files and filtering these with the species list from mo_sim_dat.F90. This last file lists all GEOS-Chem species and is only read at compile time and is not compiled since GEOS-Chem tracers and species are defined at run time from input.geos and KPP files. (2) Update geoschem.xml to now list dry and wet deposition species Feat: Implement dry deposition in CESM/GC (1) Different options are available to compute dry deposition velocities: 1. All deposition velocities are computed from GEOS-Chem using data from HEMCO 2. CLM passes dry deposition velocities over land and ocean and ice velocities are computed from GEOS-Chem using data from HEMCO 3. CLM passes dry deposition velocities over land and ocean and ice velocities are computed in a similar way as MOZART Feat: Add missing file from last commit to replicate MOZART's dry dep. calculations Feat: Add Externals to download GEOS-Chem source code Feat: Add mo_chem_utils.F90 required for mo_drydep_mod Feat: Update .exclude Feat: Import CLM4.0/4.5/5.0 data and use it for GEOS-Chem (1) Import data from CLM (2) Add compset to run GEOS-Chem with CLM4.5/5.0 (3) Add routine getLandTypes to convert CLM to OlsonLandMaps. More work is needed to convert CLM4.5 land types (4) CAM's building procedure has been modified to include the right version of CLM (5) Modify .exclude Style: Fix typos that got introduced when converting commits to fork Feat: Modify Externals_CAM.cfg to download GEOS-Chem code Revert "Feat: Modify Externals_CAM.cfg to download GEOS-Chem code" Feat: Update .gitignore to ignore GEOS-Chem repo --- .gitignore | 2 +- Externals_CAM.cfg | 7 + bld/build-namelist | 8 +- bld/config_files/definition.xml | 2 + bld/configure | 69 +- bld/namelist_files/namelist_definition.xml | 2 +- bld/namelist_files/use_cases/geoschem.xml | 82 + .../use_cases/geoschem_baro_moist.xml | 22 + bld/perl5lib/Build/ChemNamelist.pm | 46 + cime_config/buildcpp | 9 + cime_config/config_component.xml | 12 +- cime_config/config_compsets.xml | 27 + src/chemistry/pp_geoschem/.exclude | 11 +- src/chemistry/pp_geoschem/aero_model.F90 | 1150 +++++ .../pp_geoschem/charge_neutrality.F90 | 176 + src/chemistry/pp_geoschem/chem_mods.F90 | 91 + .../pp_geoschem/chem_prod_loss_diags.F90 | 37 + src/chemistry/pp_geoschem/chemistry.F90 | 4225 +++++++++++++++++ src/chemistry/pp_geoschem/clybry_fam.F90 | 180 + src/chemistry/pp_geoschem/epp_ionization.F90 | 508 ++ src/chemistry/pp_geoschem/gc_emissions.F90 | 76 + src/chemistry/pp_geoschem/getLandTypes.F90 | 218 + src/chemistry/pp_geoschem/mo_apex.F90 | 314 ++ src/chemistry/pp_geoschem/mo_chem_utls.F90 | 162 + src/chemistry/pp_geoschem/mo_drydep.F90 | 3303 +++++++++++++ .../pp_geoschem/mo_gas_phase_chemdr.F90 | 1180 +++++ src/chemistry/pp_geoschem/mo_lightning.F90 | 182 + src/chemistry/pp_geoschem/mo_sim_dat.F90 | 839 ++++ src/chemistry/pp_geoschem/rate_diags.F90 | 177 + .../pp_geoschem/short_lived_species.F90 | 229 + src/chemistry/pp_geoschem/upper_bc.F90 | 243 + src/control/camsrfexch.F90 | 31 +- src/cpl/atm_import_export.F90 | 20 +- src/cpl/cam_cpl_indices.F90 | 15 +- 34 files changed, 13623 insertions(+), 32 deletions(-) create mode 100644 bld/namelist_files/use_cases/geoschem.xml create mode 100644 bld/namelist_files/use_cases/geoschem_baro_moist.xml create mode 100644 src/chemistry/pp_geoschem/aero_model.F90 create mode 100644 src/chemistry/pp_geoschem/charge_neutrality.F90 create mode 100644 src/chemistry/pp_geoschem/chem_mods.F90 create mode 100644 src/chemistry/pp_geoschem/chem_prod_loss_diags.F90 create mode 100644 src/chemistry/pp_geoschem/chemistry.F90 create mode 100644 src/chemistry/pp_geoschem/clybry_fam.F90 create mode 100644 src/chemistry/pp_geoschem/epp_ionization.F90 create mode 100644 src/chemistry/pp_geoschem/gc_emissions.F90 create mode 100644 src/chemistry/pp_geoschem/getLandTypes.F90 create mode 100644 src/chemistry/pp_geoschem/mo_apex.F90 create mode 100644 src/chemistry/pp_geoschem/mo_chem_utls.F90 create mode 100644 src/chemistry/pp_geoschem/mo_drydep.F90 create mode 100644 src/chemistry/pp_geoschem/mo_gas_phase_chemdr.F90 create mode 100644 src/chemistry/pp_geoschem/mo_lightning.F90 create mode 100644 src/chemistry/pp_geoschem/mo_sim_dat.F90 create mode 100644 src/chemistry/pp_geoschem/rate_diags.F90 create mode 100644 src/chemistry/pp_geoschem/short_lived_species.F90 create mode 100644 src/chemistry/pp_geoschem/upper_bc.F90 diff --git a/.gitignore b/.gitignore index 18ee78968c..5cc0bde57c 100644 --- a/.gitignore +++ b/.gitignore @@ -7,7 +7,7 @@ src/physics/carma/base src/physics/clubb src/physics/cosp2/src src/physics/silhs - +src/chemistry/pp_geoschem/geoschem_src # Ignore compiled python buildnmlc diff --git a/Externals_CAM.cfg b/Externals_CAM.cfg index b9f5082208..e50b7ea88e 100644 --- a/Externals_CAM.cfg +++ b/Externals_CAM.cfg @@ -26,6 +26,13 @@ repo_url = https://github.com/CFMIP/COSPv2.0/tags/ tag = v2.0.3cesm/src required = True +[geoschem] +local_path = src/chemistry/pp_geoschem/geoschem_src +protocol = git +tag = CESM +repo_url = https://github.com/fritzt/CESM2-GC_Src +required = True + [externals_description] schema_version = 1.0.0 diff --git a/bld/build-namelist b/bld/build-namelist index 2b470043b8..7d8374fe81 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -1016,6 +1016,8 @@ if ((($chem =~ /waccm_ma/) or ($chem =~ /waccm_sc_mam/) or ($chem =~ /waccm_tsml $radval .= ",'A:N2O:N2O','A:CH4:CH4','A:CFC11:CFC11','A:CFC12:CFC12'"; } elsif ($prog_ghg1 and !$prog_ghg2 and !$chem_rad_passive ) { $radval .= ",'A:N2O:N2O','A:CH4:CH4','N:CFC11:CFC11','N:CFC12:CFC12'"; +} elsif ($chem =~ /geoschem/) { + $radval .= ",'A:N2O:N2O','A:CH4:CH4','A:CFC11:CFC11','A:CFC12:CFC12'"; } else { $radval .= ",'N:N2O:N2O','N:CH4:CH4','N:CFC11:CFC11','N:CFC12:CFC12'"; } @@ -1887,7 +1889,7 @@ my $megan_emis = defined $nl->get_value('megan_specifier'); if ( $megan_emis ) { add_default($nl, 'megan_factors_file'); } # Tropospheric full chemistry options -if (($chem =~ /trop_mozart/ or $chem =~ /trop_strat/ or $chem =~ /waccm_tsmlt/) and ($phys !~ /cam6/)) { +if (($chem =~ /geoschem/ or $chem =~ /trop_mozart/ or $chem =~ /trop_strat/ or $chem =~ /waccm_tsmlt/) and ($phys !~ /cam6/)) { # Surface emission datasets: my %verhash; @@ -2068,7 +2070,7 @@ if (($chem =~ /trop_mozart/ or $chem =~ /trop_strat/ or $chem =~ /waccm_tsmlt/) } } -if ($chem =~ /trop_mozart/ or $chem =~ /trop_strat/ or $chem =~ /waccm_tsmlt/) { +if ($chem =~ /geoschem/ or $chem =~ /trop_mozart/ or $chem =~ /trop_strat/ or $chem =~ /waccm_tsmlt/) { my $val; @@ -2083,6 +2085,8 @@ if ($chem =~ /trop_mozart/ or $chem =~ /trop_strat/ or $chem =~ /waccm_tsmlt/) { if ($chem =~ /_tsmlt_mam/ or $chem =~ /trop_strat/) { $val = "'CCL4','CF2CLBR','CF3BR','CFC11','CFC113','CFC12','CH3BR','CH3CCL3','CH3CL','CH4','CO2'" .",'H2','HCFC22','N2O','CFC114','CFC115','HCFC141B','HCFC142B','CH2BR2','CHBR3','H2402'"; + } elsif ($chem =~ /geoschem/) { + $val = "'CH4','OCS','N2O','CO2','CFC11','CFC12'"; } else { $val = "'CH4','H2','N2O','CO2','CFC11','CFC12'"; } diff --git a/bld/config_files/definition.xml b/bld/config_files/definition.xml index 656f62f152..dd0d01e5ee 100644 --- a/bld/config_files/definition.xml +++ b/bld/config_files/definition.xml @@ -93,6 +93,8 @@ test_radiative (Radiatively Active Dust), test_swelling (Sea Salt), test_tracers Chemistry package: trop_mam3 trop_mam4 trop_mam7 trop_mozart trop_strat_mam4_vbs trop_strat_mam4_vbsext waccm_ma waccm_mad waccm_mad_mam4 waccm_ma_mam4 waccm_ma_sulfur waccm_sc waccm_sc_mam4 waccm_tsmlt_mam4 terminator none + +Chemistry package: trop_mam3 trop_mam4 trop_mam7 trop_mozart trop_strat_mam4_vbs trop_strat_mam4_vbsext waccm_ma waccm_mad waccm_mad_mam4 waccm_ma_mam4 waccm_ma_sulfur waccm_sc waccm_sc_mam4 waccm_tsmlt_mam4 terminator GEOS-Chem none Prognostic mozart species packages: list of any subset of the following: DST,SSLT,SO4,GHG,OC,BC,CARBON16 diff --git a/bld/configure b/bld/configure index 581657e6d0..25bd9e1dbf 100755 --- a/bld/configure +++ b/bld/configure @@ -124,8 +124,11 @@ OPTIONS [ trop_mam3 | trop_mam4 | trop_mam7 | trop_mozart | trop_strat_mam4_vbs | trop_strat_mam4_vbsext | waccm_ma | waccm_mad | waccm_mad_mam4 | waccm_ma_mam4 | waccm_ma_sulfur | waccm_sc | waccm_sc_mam4 | waccm_tsmlt_mam4 | - terminator | none ]. + terminator | geoschem | none ]. Default: trop_mam4 for cam6 and trop_mam3 for cam5. + -clm_vers Version of land model to use. This option is only used when chem + is set to 'geoschem'. + [ 4.0 | 4.5 | 5.0 ] -[no]clubb_sgs Switch on [off] CLUBB_SGS. Default: on for cam6, otherwise off. -clubb_opts Comma separated list of CLUBB options to turn on/off. By default they are all off. Current option is: clubb_do_adv (Advect CLUBB moments) @@ -303,6 +306,7 @@ GetOptions( "ccsm_seq" => \$opts{'ccsm_seq'}, "cflags=s" => \$opts{'cflags'}, "chem=s" => \$opts{'chem'}, + "clm_vers=s" => \$opts{'clm_vers'}, "clubb_sgs!" => \$opts{'clubb_sgs'}, "clubb_opts=s" => \$opts{'clubb_opts'}, "co2_cycle" => \$opts{'co2_cycle'}, @@ -666,10 +670,10 @@ if (defined $opts{'chem'}) { # If the user has specified a simple physics package... if ($simple_phys) { - # the only valid chemistry options are 'none' and 'terminator' - if (($chem_pkg ne 'none') and ($chem_pkg ne 'terminator')) { + # the only valid chemistry options are 'none', 'terminator' and 'geoschem' + if (($chem_pkg ne 'none') and ($chem_pkg ne 'terminator') and ($chem_pkg ne 'geoschem')) { die "configure ERROR: -phys=$phys_pkg -chem=$chem_pkg\n". - " -chem can only be set to 'none' or 'terminator'.\n"; + " -chem can only be set to 'none', 'terminator' or 'geoschem'.\n"; } } elsif ($phys_pkg =~ m/^cam3$|^cam4$|^spcam_sam1mom$/) { @@ -1413,10 +1417,10 @@ if ($customize) { } if ($print>=2) { print "Chem preprocessor compiler: $chemproc_fc $eol"; } ($chem_nadv) = chem_preprocess($cfg_ref,$print,$chemproc_fc); -} elsif ($chem_pkg ne 'none') { +} elsif ($chem_pkg ne 'none' and $chem_pkg !~ 'geoschem') { # copy over chem docs - copy("$chem_src_dir/chem_mech.doc",$cam_bld) or die "copy failed $! \n"; - copy("$chem_src_dir/chem_mech.in" ,$cam_bld) or die "copy failed $! \n"; + copy("$chem_src_dir/chem_mech.doc",$cam_bld) or die "copy of chem_mec.doc failed $! \n"; + copy("$chem_src_dir/chem_mech.in" ,$cam_bld) or die "copy of chem_mech.in failed $! \n"; ($chem_nadv) = chem_number_adv($chem_src_dir); } @@ -1428,6 +1432,25 @@ if ($chem_pkg =~ '_mam3') { $chem_cppdefs = ' -DMODAL_AERO -DMODAL_AERO_7MODE '; } +# TMMF - wedge in GEOS-Chem CPP definitions here +if ($chem_pkg =~ 'geoschem') { + $chem_cppdefs .= ' -DEXTERNAL_GRID -DEXTERNAL_FORCING -DLINUX_IFORT -DUSE_REAL8 -DMODEL_ -DMODEL_CESM'; + # TMMF - Temporary fix + $chem_nadv = 200; + if (defined $opts{'clm_vers'}) { + if ($opts{'clm_vers'} =~ 'CLM4.0') { + $chem_cppdefs .= ' -DCLM40' + } + elsif ($opts{'clm_vers'} =~ 'CLM4.5') { + $chem_cppdefs .= ' -DCLM45' + } + elsif ($opts{'clm_vers'} =~ 'CLM5.0') { + $chem_cppdefs .= ' -DCLM50' + } + } +} + + # CARMA sectional microphysics # # New CARMA models need to define the number of advected constituents. @@ -2785,13 +2808,17 @@ sub write_filepath } if ($chem_src_dir) { print $fh "$chem_src_dir\n"; + if ($chem_pkg eq 'geoschem') { + print $fh "$chem_src_dir/geoschem_src/GeosCore\n"; + print $fh "$chem_src_dir/geoschem_src/GeosUtil\n"; + print $fh "$chem_src_dir/geoschem_src/Headers\n"; + print $fh "$chem_src_dir/geoschem_src/HEMCO/Core\n"; + print $fh "$chem_src_dir/geoschem_src/HEMCO/Extensions\n"; + print $fh "$chem_src_dir/geoschem_src/HEMCO/Interfaces\n"; + print $fh "$chem_src_dir/geoschem_src/ISORROPIA\n"; + print $fh "$chem_src_dir/geoschem_src/KPP/Standard\n"; } +# print $fh "$camsrcdir/cam/src/chemistry/pp_geoschem\n"; } } - if ($chem =~ /_mam/) { - print $fh "$camsrcdir/src/chemistry/modal_aero\n"; - } else { - print $fh "$camsrcdir/src/chemistry/bulk_aero\n"; - } - print $fh "$camsrcdir/src/chemistry/aerosol\n"; if ($waccmx) { print $fh "$camsrcdir/src/physics/waccmx\n"; @@ -2804,7 +2831,21 @@ sub write_filepath } print $fh "$camsrcdir/src/ionosphere\n"; - print $fh "$camsrcdir/src/chemistry/mozart\n"; + # -- Added by MSL - 1/2018 + # -- Updated by TMMF - 11/2019 + if ($chem_pkg ne 'geoschem') { + print $fh "$camsrcdir/cam/src/chemistry/mozart\n"; + if ($chem =~ /_mam/) { + print $fh "$camsrcdir/cam/src/chemistry/modal_aero\n"; + } else { + print $fh "$camsrcdir/cam/src/chemistry/bulk_aero\n"; + } + print $fh "$camsrcdir/cam/src/chemistry/aerosol\n"; +# } +# else { +# print $fh "$camsrcdir/cam/src/chemistry/mozart\n"; + } + # -- print $fh "$camsrcdir/src/chemistry/utils\n"; if ($rad eq 'rrtmg') { diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index 28899a7082..3bd44f4200 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -3904,7 +3904,7 @@ Default: set by build-namelist Name of the CAM chemistry package. N.B. this variable may not be set by diff --git a/bld/namelist_files/use_cases/geoschem.xml b/bld/namelist_files/use_cases/geoschem.xml new file mode 100644 index 0000000000..14e8f7a9ba --- /dev/null +++ b/bld/namelist_files/use_cases/geoschem.xml @@ -0,0 +1,82 @@ + + + + +00010101 + +367.0e-6 + +atm/cam/inic/fv/cami-chem_1990-01-01_1.9x2.5_L26_c080114.nc + + +atm/cam/solar/spectral_irradiance_Lean_1610-2009_ann_c100405.nc +20000101 +FIXED + + +atm/cam/chem/trop_mozart_aero/aero +aero_1.9x2.5_L26_1850-2005_c091112.nc +CYCLICAL +2000 + + +atm/cam/chem/trop_mozart_aero/aero +aerosoldep_monthly_2000_mean_1.9x2.5_c090421.nc +CYCLICAL +2000 + + + atm/cam/ozone + ozone_1.9x2.5_L26_1850-2005_c090803.nc + O3 + CYCLICAL + 2000 + +.true. +'xactive_lnd' + + +2000 + + +2000 +atm/waccm/lb/LBC_1765-2500_1.9x2.5_CMIP5_RCP45_za_c120204.nc +CYCLICAL + + + + +'CYCLICAL' +2000 + + + 1, 24 + 0, -1 + 'A', 'A' + + + 'Q', 'U', 'V', 'OMEGA', 'T', 'PS', + + + + 'O3', 'NO', 'NO2', 'CO', 'HNO3', 'CH4', 'NIT', 'NH4', 'NH3', 'SO4', 'SO2', 'OH', + + + + 'ACET','ACTA','ALD2','ASOG1','ASOG2','ASOG3','BR2','BRNO3','CH2O','HCHO','CLNO3','DHDN','EOH','ETHLN','GLYC','GLYX','H2O2','HAC','HBR','HC187','HCL','HCOOH','HNO3','HOBR','HOCL','HONIT','HPALD','IEPOXA','IEPOXB','IEPOXD','IMAE','IPMN','ISN1','ISN1OG','ISOPNB','ISOPND','LIMO','LVOC','MACR','MACRN','MAP','MGLY','MONITS','MONITU','MTPA','MTPO','MVK','MVKN','N2O5','NH3','NO2','NPMN','O3','OPOG1','OPOG2','PAN','POG1','POG2','PPN','PROPNN','R4N2','RIPA','RIPB','RIPD','SO2','HOI','I2','IBR','ICL','HI','IONO','IONO2','I2O2','I2O3','I2O4','H2SO4','TSOG0','TSOG1','TSOG2','TSOG3' + + + + 'ASOA1','ASOA2','ASOA3','ASOAN','BCPI','BCPO','DST1','DSTAL1','NITD1','SO4D1','DST2','DSTAL2','NITD2','SO4D2','DST3','DSTAL3','NITD3','SO4D3','DST4','DSTAL4','NITD4','SO4D4','INDIOL','IONITA','ISN1OA','LVOCOA','MONITA','MOPI','MOPO','MSA','NH4','NIT','NITS','OCPI','OCPO','OPOA1','OPOA2','PFE','POA1','POA2','SALA','SALC','SO4','SO4S','SOAIE','SOAGX','SOAME','SOAMG','SOAS','TSOA0','TSOA1','TSOA2','TSOA3','BRSALA','BRSALC','ISALA','ISALC','AERI' + + + + 'ACTA','ALD2','ASOG1','ASOG2','ASOG3','BR2','CH2O','HCHO','DHDN','EOH','ETHLN','GLYC','GLYX','H2O2','HAC','HBR','HCL','HCOOH','HNO3','HOBR','HOCL','HONIT','IEPOXA','IEPOXB','IEPOXD','IMAE','ISN1','ISN1OG','ISOPNB','ISOPND','LIMO','LVOC','MACRN','MAP','MGLY','MOBA','MONITS','MONITU','MP','CH3OOH','MTPA','MTPO','MVKN','NH3','OPOG1','OPOG2','POG1','POG2','PROPNN','RIPA','RIPB','RIPD','SO2','TSOG0','TSOG1','TSOG2','TSOG3','HOI','I2','IBR','ICL','HI','IONO','IONO2','I2O2','I2O3','I2O4','H2SO4' + + + + 'ASOA1','ASOA2','ASOA3','ASOAN','BCPI','BCPO','DST1','DSTAL1','NITD1','SO4D1','DST2','DSTAL2','NITD2','SO4D2','DST3','DSTAL3','NITD3','SO4D3','DST4','DSTAL4','NITD4','SO4D4','INDIOL','IONITA','ISN1OA','LVOCOA','MONITA','MOPI','MOPO','MSA','NH4','NIT','NITS','OCPI','OCPO','OPOA1','OPOA2','PFE','POA1','POA2','SALA','SALC','SO4','SO4S','SOAIE','SOAGX','SOAME','SOAMG','SOAS','TSOA0','TSOA1','TSOA2','TSOA3','BRSALA','BRSALC','ISALA','ISALC','AERI' + + + + diff --git a/bld/namelist_files/use_cases/geoschem_baro_moist.xml b/bld/namelist_files/use_cases/geoschem_baro_moist.xml new file mode 100644 index 0000000000..da938fe300 --- /dev/null +++ b/bld/namelist_files/use_cases/geoschem_baro_moist.xml @@ -0,0 +1,22 @@ + + + + + 10101 + + +.false. + + +0,-6 + + 'U:I','V:I','T:I' + +'baroclinic_wave' + + diff --git a/bld/perl5lib/Build/ChemNamelist.pm b/bld/perl5lib/Build/ChemNamelist.pm index 3584b98be0..0cf0114337 100644 --- a/bld/perl5lib/Build/ChemNamelist.pm +++ b/bld/perl5lib/Build/ChemNamelist.pm @@ -65,13 +65,33 @@ sub set_dep_lists } if ($print_lvl>=2) {print "Chemistry species : @species_list \n" ;} + if (!defined $nl->get_value('gas_wetdep_list')) { $gas_wetdep_list = get_gas_wetdep_list( $cfgdir, $print_lvl, @species_list ); + } else { + $gas_wetdep_list = $nl->get_value('gas_wetdep_list'); + $gas_wetdep_list = filter_dep_list( $gas_wetdep_list, $print_lvl, @species_list ); + } + if (!defined $nl->get_value('aer_wetdep_list')) { $aer_wetdep_list = get_aer_wetdep_list( $cfgdir, $print_lvl, @species_list ); + } else { + $aer_wetdep_list = $nl->get_value('aer_wetdep_list'); + $aer_wetdep_list = filter_dep_list( $aer_wetdep_list, $print_lvl, @species_list ); + } + if (!defined $nl->get_value('drydep_list')) { $gas_drydep_list = get_gas_drydep_list( $cfgdir, $print_lvl, @species_list ); + } else { + $gas_drydep_list = $nl->get_value('drydep_list'); + $gas_drydep_list = filter_dep_list( $gas_drydep_list, $print_lvl, @species_list ); + } + if (!defined $nl->get_value('aer_drydep_list')) { $aer_drydep_list = get_aer_drydep_list( $cfgdir, $print_lvl, @species_list ); + } else { + $aer_drydep_list = $nl->get_value('aer_drydep_list'); + $aer_drydep_list = filter_dep_list( $aer_drydep_list, $print_lvl, @species_list ); + } # set solubility factors for aerosols if (length($aer_wetdep_list)>2){ @@ -276,6 +296,32 @@ sub get_dep_list return ($list); } +#------------------------------------------------------------------------------- +#------------------------------------------------------------------------------- +sub filter_dep_list +{ + my ( $input_list, $print_lvl, @species_list ) = @_; + + my @master_list = split( ('\s+|\s*,+\s*'), $input_list); + + my $list = ''; + my $first = 1; my $pre = ""; + foreach my $name (sort @species_list) { + foreach my $item (@master_list) { + $item =~ s/['"]//g; #"' + if ($name eq $item) { + $list .= $pre . quote_string($name) ; + if ($first) { $pre = ","; $first = 0; } + } + } + } + + if ( length($list)<1 ) {$list = quote_string(' ') ;} + + return ($list); + +} + #------------------------------------------------------------------------------- sub read_master_list_file { diff --git a/cime_config/buildcpp b/cime_config/buildcpp index 7b8f9a8d53..eeb0ab57ad 100644 --- a/cime_config/buildcpp +++ b/cime_config/buildcpp @@ -40,6 +40,7 @@ def buildcpp(case): compiler = case.get_value("COMPILER") # for chem preprocessor nthrds_atm = case.get_value("NTHRDS_ATM") cam_config_opts = case.get_value("CAM_CONFIG_OPTS") + clm_config_opts = case.get_value("CLM_CONFIG_OPTS") # level information for CAM is part of the atm grid name - and must be stripped out nlev = '' @@ -93,6 +94,14 @@ def buildcpp(case): else: config_opts += ["-ocn", comp_ocn] + if '-chem geoschem' in cam_config_opts: + if 'clm4_0' in clm_config_opts: + config_opts += ["-clm_vers", "CLM4.0"] + elif 'clm4_5' in clm_config_opts: + config_opts += ["-clm_vers", "CLM4.5"] + elif 'clm5_0' in clm_config_opts: + config_opts += ["-clm_vers", "CLM5.0"] + # Add user options. config_opts += cam_config_opts.split(" ") diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index 7873931219..fdc00f964b 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -10,8 +10,8 @@ --> CAM cam6 physics: CAM cam5 physics: - CAM cam4 physics: - CAM simplified and non-versioned physics : + CAM cam4 physics: + CAM simplified and non-versioned physics : @@ -255,6 +259,10 @@ scam_arm97 + + geoschem + geoschem + geoschem_baro_moist run_component_cam env_run.xml diff --git a/cime_config/config_compsets.xml b/cime_config/config_compsets.xml index 5e07c0c925..1c637f1d73 100644 --- a/cime_config/config_compsets.xml +++ b/cime_config/config_compsets.xml @@ -381,6 +381,33 @@ SDYN_CAM40%WXIED_CLM40%SP_CICE%PRES_DOCN%DOM_RTM_SGLC_SWAV + + + + GEOSCHEM + 2000_CAM40%GC_SLND_SICE_SOCN_SROF_SGLC_SWAV + + + + GEOSCHEMTEST + 2000_CAM%GCHS_SLND_SICE_SOCN_SROF_SGLC_SWAV + + + + FGC + 2000_CAM40%GC_CLM40%SP_CICE%PRES_DOCN%DOM_RTM_SGLC_SWAV + + + + FGC_CLM45 + 2000_CAM40%GC_CLM45%SP_CICE%PRES_DOCN%DOM_RTM_SGLC_SWAV + + + + FGC_CLM50 + 2000_CAM40%GC_CLM50%SP_CICE%PRES_DOCN%DOM_RTM_SGLC_SWAV + + diff --git a/src/chemistry/pp_geoschem/.exclude b/src/chemistry/pp_geoschem/.exclude index 2f725c1ef5..48f78ec307 100644 --- a/src/chemistry/pp_geoschem/.exclude +++ b/src/chemistry/pp_geoschem/.exclude @@ -1,22 +1,19 @@ regrid_a2a_mod.F90 transport_mod.F -drydep_mod.F tpcore_window_mod.F90 tpcore_bc_mod.F90 tpcore_fvdas_mod.F90 -olson_landmap_mod.F90 +flexgrid_read_mod.F90 geosfp_read_mod.F90 -modis_lai_mod.F90 +get_met_mod.F90 hco_interp_mod.F90 merra2_read_mod.F90 regrid_a2a_mod.F90 -land_mercury_mod.F hcoio_read_std_mod.F90 hcoio_dataread_mod.F90 hco_readlist_mod.F90 hcox_paranox_mod.F90 hco_config_mod.F90 -planeflight_mod.F hco_driver_mod.F90 hcox_driver_mod.F90 hcox_lightnox_mod.F90 @@ -45,9 +42,7 @@ diag3.F hcoi_gc_main_mod.F90 gamap_mod.F initialize.F -ndxx_setup.F -mixing_mod.F90 -vdiff_mod.F90 input_mod.F cleanup.F main.F +mo_sim_dat.F90 diff --git a/src/chemistry/pp_geoschem/aero_model.F90 b/src/chemistry/pp_geoschem/aero_model.F90 new file mode 100644 index 0000000000..3c9133adf6 --- /dev/null +++ b/src/chemistry/pp_geoschem/aero_model.F90 @@ -0,0 +1,1150 @@ +!=============================================================================== +! Bulk Aerosol Model +!=============================================================================== +module aero_model + use shr_kind_mod, only: r8 => shr_kind_r8 + use constituents, only: pcnst, cnst_name, cnst_get_ind + use ppgrid, only: pcols, pver, pverp + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + use perf_mod, only: t_startf, t_stopf + use camsrfexch, only: cam_in_t, cam_out_t + use physics_types, only: physics_state, physics_ptend, physics_ptend_init + use physics_buffer, only: physics_buffer_desc + use physconst, only: gravit, rair + use spmd_utils, only: masterproc + use physics_buffer, only: pbuf_get_field, pbuf_get_index + use cam_history, only: outfld + use infnan, only: nan, assignment(=) + + 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 + + integer :: so4_ndx, cb2_ndx, oc2_ndx, nit_ndx + integer :: soa_ndx, soai_ndx, soam_ndx, soab_ndx, soat_ndx, soax_ndx + + ! Namelist variables + character(len=16) :: wetdep_list(pcnst) = ' ' + character(len=16) :: drydep_list(pcnst) = ' ' + + integer :: ndrydep = 0 + integer,allocatable :: drydep_indices(:) + integer :: nwetdep = 0 + integer,allocatable :: wetdep_indices(:) + logical :: drydep_lq(pcnst) + logical :: wetdep_lq(pcnst) + + integer :: fracis_idx = 0 + + real(r8) :: aer_sol_facti(pcnst) ! in-cloud solubility factor + real(r8) :: aer_sol_factb(pcnst) ! below-cloud solubility factor + real(r8) :: aer_scav_coef(pcnst) + +contains + + !============================================================================= + ! reads aerosol namelist options + !============================================================================= + subroutine aero_model_readnl(nlfile) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + 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 + character(len=16) :: aer_wetdep_list(pcnst) = ' ' + character(len=16) :: aer_drydep_list(pcnst) = ' ' + + namelist /aerosol_nl/ aer_wetdep_list, aer_drydep_list + namelist /aerosol_nl/ aer_sol_facti, aer_sol_factb, aer_scav_coef + !----------------------------------------------------------------------------- + !aer_sol_facti = nan + !aer_sol_factb = nan + !aer_scav_coef = nan + + !! 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(aer_wetdep_list, len(aer_wetdep_list(1))*pcnst, mpichar, 0, mpicom) + !call mpibcast(aer_drydep_list, len(aer_drydep_list(1))*pcnst, mpichar, 0, mpicom) + !call mpibcast(aer_sol_facti, pcnst, mpir8, 0, mpicom) + !call mpibcast(aer_sol_factb, pcnst, mpir8, 0, mpicom) + !call mpibcast(aer_scav_coef, pcnst, mpir8, 0, mpicom) +#endif + + !wetdep_list = aer_wetdep_list + !drydep_list = aer_drydep_list + + end subroutine aero_model_readnl + + !============================================================================= + !============================================================================= + subroutine aero_model_register() + !use mo_setsoa, only : soa_register + + !call soa_register() + end subroutine aero_model_register + + !============================================================================= + !============================================================================= + subroutine aero_model_init( pbuf2d ) + + !use mo_chem_utls, only: get_inv_ndx, get_spc_ndx + use cam_history, only: addfld, add_default, horiz_only + use phys_control, only: phys_getopts + !use mo_aerosols, only: aerosols_inti + !use mo_setsoa, only: soa_inti + !use dust_model, only: dust_init + !use seasalt_model, only: seasalt_init + !use drydep_mod, only: inidrydep + !use wetdep, only: wetdep_init + !use mo_setsox, only: has_sox + + ! args + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + ! local vars + character(len=12), parameter :: subrname = 'aero_model_init' + integer :: m, id + character(len=20) :: dummy + logical :: history_aerosol ! Output MAM or SECT aerosol tendencies + + !call phys_getopts( history_aerosol_out=history_aerosol ) + !call aerosols_inti() + !call soa_inti(pbuf2d) + !call dust_init() + !call seasalt_init() + !call wetdep_init() + + !fracis_idx = pbuf_get_index('FRACIS') + + !nwetdep = 0 + !ndrydep = 0 + + !count_species: do m = 1,pcnst + ! if ( len_trim(wetdep_list(m)) /= 0 ) then + ! nwetdep = nwetdep+1 + ! endif + ! if ( len_trim(drydep_list(m)) /= 0 ) then + ! ndrydep = ndrydep+1 + ! endif + !enddo count_species + ! + !if (nwetdep>0) & + ! allocate(wetdep_indices(nwetdep)) + !if (ndrydep>0) & + ! allocate(drydep_indices(ndrydep)) + + !do m = 1,ndrydep + ! call cnst_get_ind ( drydep_list(m), id, abort=.false. ) + ! if (id>0) then + ! drydep_indices(m) = id + ! else + ! call endrun(subrname//': invalid drydep species: '//trim(drydep_list(m)) ) + ! endif + + ! if (masterproc) then + ! write(iulog,*) subrname//': '//drydep_list(m)//' will have drydep applied' + ! endif + !enddo + !do m = 1,nwetdep + ! call cnst_get_ind ( wetdep_list(m), id, abort=.false. ) + ! if (id>0) then + ! wetdep_indices(m) = id + ! else + ! call endrun(subrname//': invalid wetdep species: '//trim(wetdep_list(m)) ) + ! endif + ! + ! if (masterproc) then + ! write(iulog,*) subrname//': '//wetdep_list(m)//' will have wet removal' + ! endif + !enddo + ! + !! set flags for drydep tendencies + !drydep_lq(:) = .false. + !do m=1,ndrydep + ! id = drydep_indices(m) + ! drydep_lq(id) = .true. + !enddo + + !! set flags for wetdep tendencies + !wetdep_lq(:) = .false. + !do m=1,nwetdep + ! id = wetdep_indices(m) + ! wetdep_lq(id) = .true. + !enddo + + !do m = 1,ndrydep + ! + ! dummy = trim(drydep_list(m)) // 'TB' + ! call addfld (dummy,horiz_only, 'A','kg/m2/s',trim(drydep_list(m))//' turbulent dry deposition flux') + ! if ( history_aerosol ) then + ! call add_default (dummy, 1, ' ') + ! endif + ! dummy = trim(drydep_list(m)) // 'GV' + ! call addfld (dummy,horiz_only, 'A','kg/m2/s',trim(drydep_list(m)) //' gravitational dry deposition flux') + ! if ( history_aerosol ) then + ! call add_default (dummy, 1, ' ') + ! endif + ! dummy = trim(drydep_list(m)) // 'DD' + ! call addfld (dummy,horiz_only, 'A','kg/m2/s',trim(drydep_list(m)) //' dry deposition flux at bottom (grav + turb)') + ! if ( history_aerosol ) then + ! call add_default (dummy, 1, ' ') + ! endif + ! dummy = trim(drydep_list(m)) // 'DT' + ! call addfld (dummy,(/ 'lev' /), 'A','kg/kg/s',trim(drydep_list(m))//' dry deposition') + ! if ( history_aerosol ) then + ! call add_default (dummy, 1, ' ') + ! endif + ! dummy = trim(drydep_list(m)) // 'DV' + ! call addfld (dummy,(/ 'lev' /), 'A','m/s',trim(drydep_list(m))//' deposition velocity') + ! if ( history_aerosol ) then + ! call add_default (dummy, 1, ' ') + ! endif + + !enddo + ! + !if (ndrydep>0) then + + ! call inidrydep(rair, gravit) + + ! dummy = 'RAM1' + ! call addfld (dummy,horiz_only, 'A','frac','RAM1') + ! if ( history_aerosol ) then + ! call add_default (dummy, 1, ' ') + ! endif + ! dummy = 'airFV' + ! call addfld (dummy,horiz_only, 'A','frac','FV') + ! if ( history_aerosol ) then + ! call add_default (dummy, 1, ' ') + ! endif + + ! if (sslt_active) then + ! dummy = 'SSTSFDRY' + ! call addfld (dummy,horiz_only, 'A','kg/m2/s','Sea salt deposition flux at surface') + ! if ( history_aerosol ) then + ! call add_default (dummy, 1, ' ') + ! endif + ! endif + ! if (dust_active) then + ! dummy = 'DSTSFDRY' + ! call addfld (dummy,horiz_only, 'A','kg/m2/s','Dust deposition flux at surface') + ! if ( history_aerosol ) then + ! call add_default (dummy, 1, ' ') + ! endif + ! endif + + !endif + + !do m = 1,nwetdep + + ! call addfld (trim(wetdep_list(m))//'SFWET', horiz_only, 'A','kg/m2/s', & + ! 'Wet deposition flux at surface') + ! call addfld (trim(wetdep_list(m))//'SFSIC', horiz_only, 'A','kg/m2/s', & + ! 'Wet deposition flux (incloud, convective) at surface') + ! call addfld (trim(wetdep_list(m))//'SFSIS', horiz_only, 'A','kg/m2/s', & + ! 'Wet deposition flux (incloud, stratiform) at surface') + ! call addfld (trim(wetdep_list(m))//'SFSBC', horiz_only, 'A','kg/m2/s', & + ! 'Wet deposition flux (belowcloud, convective) at surface') + ! call addfld (trim(wetdep_list(m))//'SFSBS', horiz_only, 'A','kg/m2/s', & + ! 'Wet deposition flux (belowcloud, stratiform) at surface') + ! call addfld (trim(wetdep_list(m))//'WET', (/ 'lev' /), 'A','kg/kg/s', & + ! 'wet deposition tendency') + ! call addfld (trim(wetdep_list(m))//'SIC', (/ 'lev' /), 'A','kg/kg/s', & + ! trim(wetdep_list(m))//' ic wet deposition') + ! call addfld (trim(wetdep_list(m))//'SIS', (/ 'lev' /), 'A','kg/kg/s', & + ! trim(wetdep_list(m))//' is wet deposition') + ! call addfld (trim(wetdep_list(m))//'SBC', (/ 'lev' /), 'A','kg/kg/s', & + ! trim(wetdep_list(m))//' bc wet deposition') + ! call addfld (trim(wetdep_list(m))//'SBS', (/ 'lev' /), 'A','kg/kg/s', & + ! trim(wetdep_list(m))//' bs wet deposition') + !enddo + ! + !if (nwetdep>0) then + ! if (sslt_active) then + ! dummy = 'SSTSFWET' + ! call addfld (dummy,horiz_only, 'A','kg/m2/s','Sea salt wet deposition flux at surface') + ! if ( history_aerosol ) then + ! call add_default (dummy, 1, ' ') + ! endif + ! endif + ! if (dust_active) then + ! dummy = 'DSTSFWET' + ! call addfld (dummy,horiz_only, 'A','kg/m2/s','Dust wet deposition flux at surface') + ! if ( history_aerosol ) then + ! call add_default (dummy, 1, ' ') + ! endif + ! endif + !endif + ! + !if (dust_active) then + ! ! emissions diagnostics .... + + ! do m = 1, dust_nbin + ! dummy = trim(dust_names(m)) // 'SF' + ! call addfld (dummy,horiz_only, 'A','kg/m2/s',trim(dust_names(m))//' dust surface emission') + ! if (history_aerosol) then + ! call add_default (dummy, 1, ' ') + ! endif + ! enddo + + ! dummy = 'DSTSFMBL' + ! call addfld (dummy,horiz_only, 'A','kg/m2/s','Mobilization flux at surface') + ! if (history_aerosol) then + ! call add_default (dummy, 1, ' ') + ! endif + + ! dummy = 'LND_MBL' + ! call addfld (dummy,horiz_only, 'A','frac','Soil erodibility factor') + ! if (history_aerosol) then + ! call add_default (dummy, 1, ' ') + ! endif + + !endif + ! + !if (sslt_active) then + + ! dummy = 'SSTSFMBL' + ! call addfld (dummy,horiz_only, 'A','kg/m2/s','Mobilization flux at surface') + ! if (history_aerosol) then + ! call add_default (dummy, 1, ' ') + ! endif + + ! do m = 1, seasalt_nbin + ! dummy = trim(seasalt_names(m)) // 'SF' + ! call addfld (dummy,horiz_only, 'A','kg/m2/s',trim(seasalt_names(m))//' seasalt surface emission') + ! if (history_aerosol) then + ! call add_default (dummy, 1, ' ') + ! endif + ! enddo + + !endif + + !if( has_sox ) then + ! call addfld( 'XPH_LWC',(/ 'lev' /), 'A','kg/kg', 'pH value multiplied by lwc') + + ! if ( history_aerosol ) then + ! call add_default ('XPH_LWC', 1, ' ') + ! endif + !endif + + !so4_ndx = get_spc_ndx( 'SO4' ) + !soa_ndx = get_spc_ndx( 'SOA' ) + !soai_ndx = get_spc_ndx( 'SOAI' ) + !soam_ndx = get_spc_ndx( 'SOAM' ) + !soab_ndx = get_spc_ndx( 'SOAB' ) + !soat_ndx = get_spc_ndx( 'SOAT' ) + !soax_ndx = get_spc_ndx( 'SOAX' ) + !cb2_ndx = get_spc_ndx( 'CB2' ) + !oc2_ndx = get_spc_ndx( 'OC2' ) + !nit_ndx = get_spc_ndx( 'NH4NO3' ) + + end subroutine aero_model_init + + !============================================================================= + !============================================================================= + subroutine aero_model_drydep ( state, pbuf, obklen, ustar, cam_in, dt, cam_out, ptend ) + + !use dust_sediment_mod, only: dust_sediment_tend + !use drydep_mod, only: d3ddflux, calcram + !use dust_model, only: dust_depvel, dust_nbin, dust_names + !use seasalt_model, only: sslt_depvel=>seasalt_depvel, sslt_nbin=>seasalt_nbin, sslt_names=>seasalt_names + + ! 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(:) + + ! local vars + real(r8), pointer :: landfrac(:) ! land fraction + real(r8), pointer :: icefrac(:) ! ice fraction + real(r8), pointer :: ocnfrac(:) ! ocean fraction + real(r8), pointer :: fvin(:) ! + real(r8), pointer :: ram1in(:) ! for dry dep velocities from land model for progseasalts + + real(r8) :: fv(pcols) ! for dry dep velocities, from land modified over ocean & ice + real(r8) :: ram1(pcols) ! for dry dep velocities, from land modified over ocean & ice + + ! local decarations + + !integer, parameter :: naero = sslt_nbin+dust_nbin + !integer, parameter :: begslt = 1 + !integer, parameter :: endslt = sslt_nbin + !integer, parameter :: begdst = sslt_nbin+1 + !integer, parameter :: enddst = sslt_nbin+dust_nbin + + !integer :: ncol, lchnk + + !character(len=6) :: aeronames(naero) ! = (/ sslt_names, dust_names /) + + !real(r8) :: vlc_trb(pcols,naero) !Turbulent deposn velocity (m/s) + !real(r8) :: vlc_grv(pcols,pver,naero) !grav deposn velocity (m/s) + !real(r8) :: vlc_dry(pcols,pver,naero) !dry deposn velocity (m/s) + + !real(r8) :: dep_trb(pcols) !kg/m2/s + !real(r8) :: dep_grv(pcols) !kg/m2/s (total of grav and trb) + + !real(r8) :: tsflx_dst(pcols) + !real(r8) :: tsflx_slt(pcols) + !real(r8) :: pvaeros(pcols,pverp) ! sedimentation velocity in Pa + !real(r8) :: sflx(pcols) + + !real(r8) :: tvs(pcols,pver) + !real(r8) :: rho(pcols,pver) ! air density in kg/m3 + + !integer :: m,mm, i, im + ! + !if (ndrydep<1) return + + !landfrac => cam_in%landfrac(:) + !icefrac => cam_in%icefrac(:) + !ocnfrac => cam_in%ocnfrac(:) + !fvin => cam_in%fv(:) + !ram1in => cam_in%ram1(:) + + !lchnk = state%lchnk + !ncol = state%ncol + + !! calc ram and fv over ocean and sea ice ... + !call calcram( ncol,landfrac,icefrac,ocnfrac,obklen,& + ! ustar,ram1in,ram1,state%t(:,pver),state%pmid(:,pver),& + ! state%pdel(:,pver),fvin,fv) + + !call outfld( 'airFV', fv(:), pcols, lchnk ) + !call outfld( 'RAM1', ram1(:), pcols, lchnk ) + + !! note that tendencies are not only in sfc layer (because of sedimentation) + !! and that ptend is updated within each subroutine for different species + ! + !call physics_ptend_init(ptend, state%psetcols, 'aero_model_drydep', lq=drydep_lq) + + !aeronames(:sslt_nbin) = sslt_names(:) + !aeronames(sslt_nbin+1:) = dust_names(:) + + !lchnk = state%lchnk + !ncol = state%ncol + + !tvs(:ncol,:) = state%t(:ncol,:) + !rho(:ncol,:) = state%pmid(:ncol,:)/(rair*state%t(:ncol,:)) + + !! compute dep velocities for sea salt and dust... + !if (sslt_active) then + ! call sslt_depvel( state%t(:,:), state%pmid(:,:), state%q(:,:,1), ram1, fv, ncol, lchnk, & + ! vlc_dry(:,:,begslt:endslt), vlc_trb(:,begslt:endslt), vlc_grv(:,:,begslt:endslt)) + !endif + !if (dust_active) then + ! call dust_depvel( state%t(:,:), state%pmid(:,:), ram1, fv, ncol, & + ! vlc_dry(:,:,begdst:enddst), vlc_trb(:,begdst:enddst), vlc_grv(:,:,begdst:enddst) ) + !endif + + !tsflx_dst(:)=0._r8 + !tsflx_slt(:)=0._r8 + + !! do drydep for each of the bins of dust and seasalt + !do m=1,ndrydep + + ! mm = drydep_indices(m) + ! findindex: do im = 1,naero + ! if (trim(cnst_name(mm))==trim(aeronames(im))) exit findindex + ! enddo findindex + + ! pvaeros(:ncol,1)=0._r8 + ! pvaeros(:ncol,2:pverp) = vlc_dry(:ncol,:,im) + + ! call outfld( trim(cnst_name(mm))//'DV', pvaeros(:,2:pverp), pcols, lchnk ) + + ! if(.true.) then ! use phil's method + ! ! convert from meters/sec to pascals/sec + ! ! pvaeros(:,1) is assumed zero, use density from layer above in conversion + ! pvaeros(:ncol,2:pverp) = pvaeros(:ncol,2:pverp) * rho(:ncol,:)*gravit + + ! ! calculate the tendencies and sfc fluxes from the above velocities + ! call dust_sediment_tend( & + ! ncol, dt, state%pint(:,:), state%pmid, state%pdel, state%t , & + ! state%q(:,:,mm) , pvaeros , ptend%q(:,:,mm), sflx ) + ! else !use charlie's method + ! call d3ddflux(ncol, vlc_dry(:,:,im), state%q(:,:,mm),state%pmid,state%pdel, tvs,sflx,ptend%q(:,:,mm),dt) + ! endif + ! ! apportion dry deposition into turb and gravitational settling for tapes + ! do i=1,ncol + ! dep_trb(i)=sflx(i)*vlc_trb(i,im)/vlc_dry(i,pver,im) + ! dep_grv(i)=sflx(i)*vlc_grv(i,pver,im)/vlc_dry(i,pver,im) + ! enddo + + ! if ( any( sslt_names(:)==trim(cnst_name(mm)) ) ) & + ! tsflx_slt(:ncol)=tsflx_slt(:ncol)+sflx(:ncol) + ! if ( any( dust_names(:)==trim(cnst_name(mm)) ) ) & + ! tsflx_dst(:ncol)=tsflx_dst(:ncol)+sflx(:ncol) + + ! ! if the user has specified prescribed aerosol dep fluxes then + ! ! do not set cam_out dep fluxes according to the prognostic aerosols + ! if (.not. aerodep_flx_prescribed()) then + ! ! set deposition in export state + ! if (im==begdst) then + ! cam_out%dstdry1(:ncol) = max(sflx(:ncol), 0._r8) + ! elseif(im==begdst+1) then + ! cam_out%dstdry2(:ncol) = max(sflx(:ncol), 0._r8) + ! elseif(im==begdst+2) then + ! cam_out%dstdry3(:ncol) = max(sflx(:ncol), 0._r8) + ! elseif(im==begdst+3) then + ! cam_out%dstdry4(:ncol) = max(sflx(:ncol), 0._r8) + ! endif + ! endif + + ! call outfld( trim(cnst_name(mm))//'DD', sflx, pcols, lchnk) + ! call outfld( trim(cnst_name(mm))//'TB', dep_trb, pcols, lchnk ) + ! call outfld( trim(cnst_name(mm))//'GV', dep_grv, pcols, lchnk ) + ! call outfld( trim(cnst_name(mm))//'DT', ptend%q(:,:,mm), pcols, lchnk) + + !end do + ! + !! output the total dry deposition + !if (sslt_active) then + ! call outfld( 'SSTSFDRY', tsflx_slt, pcols, lchnk) + !endif + !if (dust_active) then + ! call outfld( 'DSTSFDRY', tsflx_dst, pcols, lchnk) + !endif + + endsubroutine aero_model_drydep + + !============================================================================= + !============================================================================= + subroutine aero_model_wetdep( state, dt, dlf, cam_out, ptend, pbuf) + + !use wetdep, only : wetdepa_v1, wetdep_inputs_set, wetdep_inputs_t + !use dust_model, only : dust_names + !use seasalt_model, only : sslt_names=>seasalt_names + + ! 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(:) + + !! local vars + + !integer :: ncol ! number of atmospheric columns + !integer :: lchnk ! chunk identifier + !integer :: m,mm, i,k + + !real(r8) :: sflx_tot_dst(pcols) + !real(r8) :: sflx_tot_slt(pcols) + + !real(r8) :: iscavt(pcols, pver) + !real(r8) :: scavt(pcols, pver) + !real(r8) :: scavcoef(pcols,pver) ! Dana and Hales coefficient (/mm) (0.1) + !real(r8) :: sflx(pcols) ! deposition flux + + !real(r8) :: icscavt(pcols, pver) + !real(r8) :: isscavt(pcols, pver) + !real(r8) :: bcscavt(pcols, pver) + !real(r8) :: bsscavt(pcols, pver) + + !real(r8) :: sol_factb, sol_facti + + !real(r8) :: rainmr(pcols,pver) ! mixing ratio of rain within cloud volume + !real(r8) :: cldv(pcols,pver) ! cloudy volume undergoing scavenging + !real(r8) :: cldvcu(pcols,pver) ! Convective precipitation area at the top interface of current layer + !real(r8) :: cldvst(pcols,pver) ! Stratiform precipitation area at the top interface of current layer + + !real(r8), pointer :: fracis(:,:,:) ! fraction of transported species that are insoluble + + !type(wetdep_inputs_t) :: dep_inputs ! obj that contains inputs to wetdepa routine + + !if (nwetdep<1) return + + !call pbuf_get_field(pbuf, fracis_idx, fracis, start=(/1,1,1/), kount=(/pcols, pver, pcnst/) ) + + !call physics_ptend_init(ptend, state%psetcols, 'aero_model_wetdep', lq=wetdep_lq) + + !call wetdep_inputs_set( state, pbuf, dep_inputs ) + + !lchnk = state%lchnk + !ncol = state%ncol + + !sflx_tot_dst(:) = 0._r8 + !sflx_tot_slt(:) = 0._r8 + + !do m = 1, nwetdep + + ! mm = wetdep_indices(m) + + ! sol_factb = aer_sol_factb(m) + ! sol_facti = aer_sol_facti(m) + + ! scavcoef(:ncol,:) = aer_scav_coef(m) + + ! call wetdepa_v1( state%t, state%pmid, state%q(:,:,1), state%pdel, & + ! dep_inputs%cldt, dep_inputs%cldcu, dep_inputs%cmfdqr, & + ! dep_inputs%conicw, dep_inputs%prain, dep_inputs%qme, & + ! dep_inputs%evapr, dep_inputs%totcond, state%q(:,:,mm), dt, & + ! scavt, iscavt, dep_inputs%cldv, & + ! fracis(:,:,mm), sol_factb, ncol, & + ! scavcoef, & + ! sol_facti_in=sol_facti, & + ! icscavt=icscavt, isscavt=isscavt, bcscavt=bcscavt, bsscavt=bsscavt ) + + ! ptend%q(:ncol,:,mm)=scavt(:ncol,:) + + ! call outfld( trim(cnst_name(mm))//'WET', ptend%q(:,:,mm), pcols, lchnk) + ! call outfld( trim(cnst_name(mm))//'SIC', icscavt , pcols, lchnk) + ! call outfld( trim(cnst_name(mm))//'SIS', isscavt, pcols, lchnk) + ! call outfld( trim(cnst_name(mm))//'SBC', bcscavt, pcols, lchnk) + ! call outfld( trim(cnst_name(mm))//'SBS', bsscavt, pcols, lchnk) + + ! sflx(:)=0._r8 + + ! do k=1,pver + ! do i=1,ncol + ! sflx(i)=sflx(i)+ptend%q(i,k,mm)*state%pdel(i,k)/gravit + ! enddo + ! enddo + ! call outfld( trim(cnst_name(mm))//'SFWET', sflx, pcols, lchnk) + ! + ! if ( any( sslt_names(:)==trim(cnst_name(mm)) ) ) & + ! sflx_tot_slt(:ncol) = sflx_tot_slt(:ncol) + sflx(:ncol) + ! if ( any( dust_names(:)==trim(cnst_name(mm)) ) ) & + ! sflx_tot_dst(:ncol) = sflx_tot_dst(:ncol) + sflx(:ncol) + + ! ! if the user has specified prescribed aerosol dep fluxes then + ! ! do not set cam_out dep fluxes according to the prognostic aerosols + ! if (.not.aerodep_flx_prescribed()) then + ! ! export deposition fluxes to coupler ??? why "-" sign ??? + ! if (trim(cnst_name(mm))=='CB2') then + ! cam_out%bcphiwet(:) = max(-sflx(:), 0._r8) + ! elseif (trim(cnst_name(mm))=='OC2') then + ! cam_out%ocphiwet(:) = max(-sflx(:), 0._r8) + ! elseif (trim(cnst_name(mm))==trim(dust_names(1))) then + ! cam_out%dstwet1(:) = max(-sflx(:), 0._r8) + ! elseif (trim(cnst_name(mm))==trim(dust_names(2))) then + ! cam_out%dstwet2(:) = max(-sflx(:), 0._r8) + ! elseif (trim(cnst_name(mm))==trim(dust_names(3))) then + ! cam_out%dstwet3(:) = max(-sflx(:), 0._r8) + ! elseif (trim(cnst_name(mm))==trim(dust_names(4))) then + ! cam_out%dstwet4(:) = max(-sflx(:), 0._r8) + ! endif + ! endif + + !enddo + ! + !if (sslt_active) then + ! call outfld( 'SSTSFWET', sflx_tot_slt, pcols, lchnk) + !endif + !if (dust_active) then + ! call outfld( 'DSTSFWET', sflx_tot_dst, pcols, lchnk) + !endif + + endsubroutine aero_model_wetdep + + !------------------------------------------------------------------------- + ! provides aerosol surface area info for sectional aerosols + ! called from mo_usrrxt + !------------------------------------------------------------------------- + subroutine aero_model_surfarea( & + 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 + 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_total(:,:) + real(r8), intent(out) :: reff_trop(:,:) + + !! local vars + + !integer :: i,k + !real(r8) :: rho_air + !real(r8) :: v, n, n_exp, r_rd, r_sd + !real(r8) :: dm_sulf, dm_sulf_wet, log_sd_sulf, sfc_sulf, sfc_nit + !real(r8) :: dm_orgc, dm_orgc_wet, log_sd_orgc, sfc_oc, sfc_soa + !real(r8) :: sfc_soai, sfc_soam, sfc_soab, sfc_soat, sfc_soax + !real(r8) :: dm_bc, dm_bc_wet, log_sd_bc, sfc_bc + !real(r8) :: rxt_sulf, rxt_nit, rxt_oc, rxt_soa + !real(r8) :: c_n2o5, c_ho2, c_no2, c_no3 + !real(r8) :: s_exp + + !!----------------------------------------------------------------- + !! ... parameters for log-normal distribution by number + !! references: + !! Chin et al., JAS, 59, 461, 2003 + !! Liao et al., JGR, 108(D1), 4001, 2003 + !! Martin et al., JGR, 108(D3), 4097, 2003 + !!----------------------------------------------------------------- + !real(r8), parameter :: rm_sulf = 6.95e-6_r8 ! mean radius of sulfate particles (cm) (Chin) + !real(r8), parameter :: sd_sulf = 2.03_r8 ! standard deviation of radius for sulfate (Chin) + !real(r8), parameter :: rho_sulf = 1.7e3_r8 ! density of sulfate aerosols (kg/m3) (Chin) + + !real(r8), parameter :: rm_orgc = 2.12e-6_r8 ! mean radius of organic carbon particles (cm) (Chin) + !real(r8), parameter :: sd_orgc = 2.20_r8 ! standard deviation of radius for OC (Chin) + !real(r8), parameter :: rho_orgc = 1.8e3_r8 ! density of OC aerosols (kg/m3) (Chin) + + !real(r8), parameter :: rm_bc = 1.18e-6_r8 ! mean radius of soot/BC particles (cm) (Chin) + !real(r8), parameter :: sd_bc = 2.00_r8 ! standard deviation of radius for BC (Chin) + !real(r8), parameter :: rho_bc = 1.0e3_r8 ! density of BC aerosols (kg/m3) (Chin) + + !real(r8), parameter :: mw_so4 = 98.e-3_r8 ! so4 molecular wt (kg/mole) + + !integer :: irh, rh_l, rh_u + !real(r8) :: factor, rfac_sulf, rfac_oc, rfac_bc, rfac_ss + !logical :: zero_aerosols + + !!----------------------------------------------------------------- + !! ... table for hygroscopic growth effect on radius (Chin et al) + !! (no growth effect for mineral dust) + !!----------------------------------------------------------------- + !real(r8), dimension(7) :: table_rh, table_rfac_sulf, table_rfac_bc, table_rfac_oc, table_rfac_ss + + !data table_rh(1:7) / 0.0_r8, 0.5_r8, 0.7_r8, 0.8_r8, 0.9_r8, 0.95_r8, 0.99_r8/ + !data table_rfac_sulf(1:7) / 1.0_r8, 1.4_r8, 1.5_r8, 1.6_r8, 1.8_r8, 1.9_r8, 2.2_r8/ + !data table_rfac_oc(1:7) / 1.0_r8, 1.2_r8, 1.4_r8, 1.5_r8, 1.6_r8, 1.8_r8, 2.2_r8/ + !data table_rfac_bc(1:7) / 1.0_r8, 1.0_r8, 1.0_r8, 1.2_r8, 1.4_r8, 1.5_r8, 1.9_r8/ + !data table_rfac_ss(1:7) / 1.0_r8, 1.6_r8, 1.8_r8, 2.0_r8, 2.4_r8, 2.9_r8, 4.8_r8/ + + !!----------------------------------------------------------------- + !! ... exponent for calculating number density + !!----------------------------------------------------------------- + !n_exp = exp( -4.5_r8*log(sd_sulf)*log(sd_sulf) ) + + !dm_sulf = 2._r8 * rm_sulf + !dm_orgc = 2._r8 * rm_orgc + !dm_bc = 2._r8 * rm_bc + + !log_sd_sulf = log(sd_sulf) + !log_sd_orgc = log(sd_orgc) + !log_sd_bc = log(sd_bc) + + !reff_trop(:,:) = 0._r8 + + !ver_loop: do k = 1,pver + ! col_loop: do i = 1,ncol + ! !------------------------------------------------------------------------- + ! ! ... air density (kg/m3) + ! !------------------------------------------------------------------------- + ! rho_air = pmid(i,k)/(temp(i,k)*287.04_r8) + ! !------------------------------------------------------------------------- + ! ! ... aerosol growth interpolated from M.Chin's table + ! !------------------------------------------------------------------------- + ! if (relhum(i,k) >= table_rh(7)) then + ! rfac_sulf = table_rfac_sulf(7) + ! rfac_oc = table_rfac_oc(7) + ! rfac_bc = table_rfac_bc(7) + ! else + ! do irh = 2,7 + ! if (relhum(i,k) <= table_rh(irh)) then + ! exit + ! end if + ! end do + ! rh_l = irh-1 + ! rh_u = irh + + ! factor = (relhum(i,k) - table_rh(rh_l))/(table_rh(rh_u) - table_rh(rh_l)) + + ! rfac_sulf = table_rfac_sulf(rh_l) + factor*(table_rfac_sulf(rh_u) - table_rfac_sulf(rh_l)) + ! rfac_oc = table_rfac_oc(rh_u) + factor*(table_rfac_oc(rh_u) - table_rfac_oc(rh_l)) + ! rfac_bc = table_rfac_bc(rh_u) + factor*(table_rfac_bc(rh_u) - table_rfac_bc(rh_l)) + ! end if + + ! dm_sulf_wet = dm_sulf * rfac_sulf + ! dm_orgc_wet = dm_orgc * rfac_oc + ! dm_bc_wet = dm_bc * rfac_bc + + ! dm_bc_wet = min(dm_bc_wet ,50.e-6_r8) ! maximum size is 0.5 micron (Chin) + ! dm_orgc_wet = min(dm_orgc_wet,50.e-6_r8) ! maximum size is 0.5 micron (Chin) + + + ! !------------------------------------------------------------------------- + ! ! ... sulfate aerosols + ! !------------------------------------------------------------------------- + ! zero_aerosols = k < ltrop(i) + ! if ( abs( dlat(i) ) > 50._r8 ) then + ! zero_aerosols = pmid(i,k) < 30000._r8 + ! endif + ! !------------------------------------------------------------------------- + ! ! ... use ubvals climatology for stratospheric sulfate surface area density + ! !------------------------------------------------------------------------- + ! if( zero_aerosols ) then + ! sfc_sulf = strato_sad(i,k) + ! if ( het1_ndx > 0 ) then + ! sfc_sulf = 0._r8 ! reaction already taken into account in mo_strato_rates.F90 + ! end if + ! sfc_nit = 0._r8 + ! sfc_soa = 0._r8 + ! sfc_oc = 0._r8 + ! sfc_bc = 0._r8 + ! else + + ! if( so4_ndx > 0 ) then + ! !------------------------------------------------------------------------- + ! ! convert mass mixing ratio of aerosol to cm3/cm3 (cm^3_aerosol/cm^3_air) + ! ! v=volume density (m^3/m^3) + ! ! rho_aer=density of aerosol (kg/m^3) + ! ! v=m*rho_air/rho_aer [kg/kg * (kg/m3)_air/(kg/m3)_aer] + ! !------------------------------------------------------------------------- + ! v = mmr(i,k,so4_ndx) * rho_air/rho_sulf + ! !------------------------------------------------------------------------- + ! ! calculate the number density of aerosol (aerosols/cm3) + ! ! assuming a lognormal distribution + ! ! n = (aerosols/cm3) + ! ! dm = geometric mean diameter + ! ! + ! ! because only the dry mass of the aerosols is known, we + ! ! use the mean dry radius + ! !------------------------------------------------------------------------- + ! n = v * (6._r8/pi)*(1._r8/(dm_sulf**3._r8))*n_exp + ! !------------------------------------------------------------------------- + ! ! find surface area of aerosols using dm_wet, log_sd + ! ! (increase of sd due to RH is negligible) + ! ! and number density calculated above as distribution + ! ! parameters + ! ! sfc = surface area of wet aerosols (cm^2/cm^3) + ! !------------------------------------------------------------------------- + ! s_exp = exp(2._r8*log_sd_sulf*log_sd_sulf) + ! sfc_sulf = n * pi * (dm_sulf_wet**2._r8) * s_exp + + ! else + ! !------------------------------------------------------------------------- + ! ! if so4 not simulated, use off-line sulfate and calculate as above + ! ! convert sulfate vmr to volume density of aerosol (cm^3_aerosol/cm^3_air) + ! !------------------------------------------------------------------------- + ! v = sulfate(i,k) * m(i,k) * mw_so4 / (avo * rho_sulf) *1.e6_r8 + ! n = v * (6._r8/pi)*(1._r8/(dm_sulf**3._r8))*n_exp + ! s_exp = exp(2._r8*log_sd_sulf*log_sd_sulf) + ! sfc_sulf = n * pi * (dm_sulf_wet**2._r8) * s_exp + + ! end if + ! + ! !------------------------------------------------------------------------- + ! ! ammonium nitrate (follow same procedure as sulfate, using size and density of sulfate) + ! !------------------------------------------------------------------------- + ! if( nit_ndx > 0 ) then + ! v = mmr(i,k,nit_ndx) * rho_air/rho_sulf + ! n = v * (6._r8/pi)*(1._r8/(dm_sulf**3._r8))*n_exp + ! s_exp = exp(2._r8*log_sd_sulf*log_sd_sulf) + ! sfc_nit = n * pi * (dm_sulf_wet**2._r8) * s_exp + ! else + ! sfc_nit = 0._r8 + ! end if + + ! !------------------------------------------------------------------------- + ! ! hydrophylic organic carbon (follow same procedure as sulfate) + ! !------------------------------------------------------------------------- + ! if( oc2_ndx > 0 ) then + ! v = mmr(i,k,oc2_ndx) * rho_air/rho_orgc + ! n = v * (6._r8/pi)*(1._r8/(dm_orgc**3))*n_exp + ! s_exp = exp(2._r8*log_sd_orgc*log_sd_orgc) + ! sfc_oc = n * pi * (dm_orgc_wet**2._r8) * s_exp + ! else + ! sfc_oc = 0._r8 + ! end if + + ! !------------------------------------------------------------------------- + ! ! secondary organic carbon (follow same procedure as sulfate) + ! !------------------------------------------------------------------------- + ! if( soa_ndx > 0 ) then + ! v = mmr(i,k,soa_ndx) * rho_air/rho_orgc + ! n = v * (6._r8/pi)*(1._r8/(dm_orgc**3._r8))*n_exp + ! s_exp = exp(2._r8*log_sd_orgc*log_sd_orgc) + ! sfc_soa = n * pi * (dm_orgc_wet**2._r8) * s_exp + ! else + ! sfc_soa = 0._r8 + ! end if + + ! !------------------------------------------------------------------------- + ! ! black carbon (follow same procedure as sulfate) + ! !------------------------------------------------------------------------- + ! if( cb2_ndx > 0 ) then + ! v = mmr(i,k,cb2_ndx) * rho_air/rho_bc + ! n = v * (6._r8/pi)*(1._r8/(dm_bc**3._r8))*n_exp + ! s_exp = exp(2._r8*log_sd_bc*log_sd_bc) + ! sfc_bc = n * pi * (dm_bc_wet**2._r8) * s_exp + ! else + ! sfc_bc = 0._r8 + ! end if + ! if( soai_ndx > 0 ) then + ! v = mmr(i,k,soai_ndx) * rho_air/rho_orgc + ! n = v * (6._r8/pi)*(1._r8/(dm_orgc**3._r8))*n_exp + ! s_exp = exp(2._r8*log_sd_orgc*log_sd_orgc) + ! sfc_soai = n * pi * (dm_orgc_wet**2._r8) * s_exp + ! else + ! sfc_soai = 0._r8 + ! end if + ! if( soam_ndx > 0 ) then + ! v = mmr(i,k,soam_ndx) * rho_air/rho_orgc + ! n = v * (6._r8/pi)*(1._r8/(dm_orgc**3._r8))*n_exp + ! s_exp = exp(2._r8*log_sd_orgc*log_sd_orgc) + ! sfc_soam = n * pi * (dm_orgc_wet**2._r8) * s_exp + ! else + ! sfc_soam = 0._r8 + ! end if + ! if( soab_ndx > 0 ) then + ! v = mmr(i,k,soab_ndx) * rho_air/rho_orgc + ! n = v * (6._r8/pi)*(1._r8/(dm_orgc**3._r8))*n_exp + ! s_exp = exp(2._r8*log_sd_orgc*log_sd_orgc) + ! sfc_soab = n * pi * (dm_orgc_wet**2._r8) * s_exp + ! else + ! sfc_soab = 0._r8 + ! end if + ! if( soat_ndx > 0 ) then + ! v = mmr(i,k,soat_ndx) * rho_air/rho_orgc + ! n = v * (6._r8/pi)*(1._r8/(dm_orgc**3._r8))*n_exp + ! s_exp = exp(2._r8*log_sd_orgc*log_sd_orgc) + ! sfc_soat = n * pi * (dm_orgc_wet**2._r8) * s_exp + ! else + ! sfc_soat = 0._r8 + ! end if + ! if( soax_ndx > 0 ) then + ! v = mmr(i,k,soax_ndx) * rho_air/rho_orgc + ! n = v * (6._r8/pi)*(1._r8/(dm_orgc**3._r8))*n_exp + ! s_exp = exp(2._r8*log_sd_orgc*log_sd_orgc) + ! sfc_soax = n * pi * (dm_orgc_wet**2._r8) * s_exp + ! else + ! sfc_soax = 0._r8 + ! end if + ! sfc_soa = sfc_soa + sfc_soai + sfc_soam + sfc_soab + sfc_soat + sfc_soax + + ! end if + + ! sfc(i,k,:) = (/ sfc_sulf, sfc_nit, sfc_oc, sfc_soa, sfc_bc /) + ! dm_aer(i,k,:) = (/ dm_sulf_wet,dm_sulf_wet,dm_orgc_wet,dm_orgc_wet,dm_bc_wet /) + + ! !------------------------------------------------------------------------- + ! ! ... add up total surface area density for output + ! !------------------------------------------------------------------------- + ! sad_total(i,k) = sfc_sulf + sfc_nit + sfc_oc + sfc_soa + sfc_bc + + ! enddo col_loop + !enddo ver_loop + + end subroutine aero_model_surfarea + + !------------------------------------------------------------------------- + ! stub + !------------------------------------------------------------------------- + subroutine aero_model_strat_surfarea( ncol, mmr, pmid, temp, ltrop, pbuf, strato_sad, reff_strat ) + + ! dummy args + 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(:,:) + real(r8), intent(out) :: reff_strat(:,:) + + strato_sad(:,:) = 0._r8 + reff_strat(:,:) = 0._r8 + + end subroutine aero_model_strat_surfarea + + !============================================================================= + !============================================================================= + subroutine aero_model_gasaerexch( 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 chem_mods, only : gas_pcnst + !use mo_aerosols, only : aerosols_formation, has_aerosols + !use mo_setsox, only : setsox, has_sox + !use mo_setsoa, only : setsoa, has_soa + + !----------------------------------------------------------------------- + ! ... dummy arguments + !----------------------------------------------------------------------- + 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 + + !real(r8) :: vmrcw(ncol,pver,gas_pcnst) ! cloud-borne aerosol (vmr) + + !real(r8) :: aqso4(ncol,1) ! aqueous phase chemistry + !real(r8) :: aqh2so4(ncol,1) ! 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 + + + ! !aqueous chemistry ... + + !if( has_sox ) then + ! call setsox( & + ! ncol, & + ! lchnk, & + ! loffset, & + ! delt, & + ! pmid, & + ! pdel, & + ! tfld, & + ! mbar, & + ! cwat, & + ! cldfr, & + ! cldnum, & + ! airdens, & + ! invariants, & + ! vmrcw, & + ! vmr, & + ! xphlwc, & + ! aqso4, & + ! aqh2so4, & + ! aqso4_h2o2,& + ! aqso4_o3 & + ! ) + ! call outfld( 'XPH_LWC',xphlwc(:ncol,:), ncol , lchnk ) + !endif + + !if( has_soa ) then + ! call setsoa( ncol, lchnk, delt, reaction_rates, tfld, airdens, vmr, pbuf) + !endif + + !if( has_aerosols ) then + ! call aerosols_formation( ncol, lchnk, tfld, relhum, vmr ) + !endif + + + end subroutine aero_model_gasaerexch + + !============================================================================= + !============================================================================= + subroutine aero_model_emissions( state, cam_in ) + !use seasalt_model, only: seasalt_emis, seasalt_indices + !use dust_model, only: dust_emis, dust_indices + use physics_types, only: physics_state + + ! Arguments: + + type(physics_state), intent(in) :: state ! Physics state variables + type(cam_in_t), intent(inout) :: cam_in ! import state + + !! local vars + + !integer :: lchnk, ncol + !integer :: m, mm + !real(r8) :: soil_erod_tmp(pcols) + !real(r8) :: sflx(pcols) ! accumulate over all bins for output + !real(r8) :: u10cubed(pcols) + !real (r8), parameter :: z0=0.0001_r8 ! m roughness length over oceans--from ocean model + + !lchnk = state%lchnk + !ncol = state%ncol + + !if (dust_active) then + + ! call dust_emis( ncol, lchnk, cam_in%dstflx, cam_in%cflx, soil_erod_tmp ) + + ! ! some dust emis diagnostics ... + ! sflx(:)=0._r8 + ! do m=1,dust_nbin + ! mm = dust_indices(m) + ! sflx(:ncol)=sflx(:ncol)+cam_in%cflx(:ncol,mm) + ! call outfld(trim(dust_names(m))//'SF',cam_in%cflx(:,mm),pcols, lchnk) + ! enddo + ! call outfld('DSTSFMBL',sflx(:),pcols,lchnk) + ! call outfld('LND_MBL',soil_erod_tmp(:),pcols, lchnk ) + !endif + + !if (sslt_active) then + ! u10cubed(:ncol)=sqrt(state%u(:ncol,pver)**2+state%v(:ncol,pver)**2) + ! ! move the winds to 10m high from the midpoint of the gridbox: + ! ! follows Tie and Seinfeld and Pandis, p.859 with math. + + ! u10cubed(:ncol)=u10cubed(:ncol)*log(10._r8/z0)/log(state%zm(:ncol,pver)/z0) + + ! ! we need them to the 3.41 power, according to Gong et al., 1997: + ! u10cubed(:ncol)=u10cubed(:ncol)**3.41_r8 + + ! sflx(:)=0._r8 + + ! call seasalt_emis( u10cubed, cam_in%sst, cam_in%ocnfrac, ncol, cam_in%cflx ) + + ! do m=1,seasalt_nbin + ! mm = seasalt_indices(m) + ! sflx(:ncol)=sflx(:ncol)+cam_in%cflx(:ncol,mm) + ! call outfld(trim(seasalt_names(m))//'SF',cam_in%cflx(:,mm),pcols,lchnk) + ! enddo + ! call outfld('SSTSFMBL',sflx(:),pcols,lchnk) + !endif + + end subroutine aero_model_emissions + +end module aero_model diff --git a/src/chemistry/pp_geoschem/charge_neutrality.F90 b/src/chemistry/pp_geoschem/charge_neutrality.F90 new file mode 100644 index 0000000000..92ec519000 --- /dev/null +++ b/src/chemistry/pp_geoschem/charge_neutrality.F90 @@ -0,0 +1,176 @@ +module charge_neutrality + + use shr_kind_mod, only : r8 => shr_kind_r8 + use ppgrid, only : pcols, pver + !use mo_chem_utls, only : get_spc_ndx + + implicit none + + private + public :: charge_balance + + interface charge_balance + module procedure charge_fix_vmr + module procedure charge_fix_mmr ! for fixing charge balance after vertical diffusion + end interface + + !integer, parameter :: pos_ion_n = 22 + !character(len=16), parameter :: pos_ion_names(pos_ion_n) = (/ & + ! 'Np ','N2p ','Op ','O2p ','NOp ', & + ! 'O4p ','O2p_H2O ','Hp_H2O ','Hp_2H2O ','Hp_3H2O ', & + ! 'Hp_4H2O ','Hp_5H2O ','H3Op_OH ','Hp_3N1 ','Hp_4N1 ', & + ! 'NOp_H2O ','NOp_2H2O ','NOp_3H2O ','NOp_CO2 ','NOp_N2 ', & + ! 'Op2P ','Op2D ' /) + + !integer, parameter :: neg_ion_n = 21 + !character(len=16), parameter :: neg_ion_names(neg_ion_n) = (/ & + ! 'Om ','O2m ','O3m ','O4m ','OHm ', & + ! 'CO3m ','CO4m ','NO2m ','NO3m ','HCO3m ', & + ! 'CLm ','CLOm ','CLm_H2O ','CLm_HCL ','CO3m_H2O ', & + ! 'NO3m_H2O ','CO3m2H2O ','NO2m_H2O ','NO3m2H2O ','NO3mHNO3 ', & + ! 'NO3m_HCL ' /) + +contains + + !----------------------------------------------------------------------- + ! ... force ion/electron balance + !----------------------------------------------------------------------- + subroutine charge_fix_vmr( ncol, vmr ) + + !----------------------------------------------------------------------- + ! ... dummy arguments + !----------------------------------------------------------------------- + integer, intent(in) :: ncol + real(r8), intent(inout) :: vmr(:,:,:) ! concentration + + !----------------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------------- + integer :: i, n + integer :: elec_ndx + real(r8) :: wrk(ncol,pver) + + !elec_ndx = get_spc_ndx('e') + + !!-------------------------------------------------------------------- + !! If electrons are in the chemistry add up charges to get electrons + !!-------------------------------------------------------------------- + !if( elec_ndx > 0 ) then + ! wrk(:,:) = 0._r8 + + ! do i = 1,pos_ion_n + ! n = get_spc_ndx(pos_ion_names(i)) + ! if (n>0) then + ! wrk(:ncol,:) = wrk(:ncol,:) + vmr(:ncol,:,n) + ! endif + ! enddo + ! do i = 1,neg_ion_n + ! n = get_spc_ndx(neg_ion_names(i)) + ! if (n>0) then + ! wrk(:ncol,:) = wrk(:ncol,:) - vmr(:ncol,:,n) + ! endif + ! enddo + + ! where ( wrk(:,:)<0._r8 ) + ! wrk(:,:)=0._r8 + ! end where + + ! vmr(:ncol,:,elec_ndx) = wrk(:ncol,:) + + !end if + + end subroutine charge_fix_vmr + + !----------------------------------------------------------------------- + ! ... force ion/electron balance + !----------------------------------------------------------------------- + subroutine charge_fix_mmr(state, pbuf) + + use constituents, only : cnst_get_ind + use physconst, only : mbarv ! Constituent dependent mbar + use short_lived_species, only : slvd_index,slvd_pbf_ndx => pbf_idx ! Routines to access short lived species in pbuf + use chem_mods, only : adv_mass + use physics_buffer, only : pbuf_get_field,physics_buffer_desc ! Needed to get variables from physics buffer + use physics_types, only : physics_state + + !----------------------------------------------------------------------- + ! ... dummy arguments + !----------------------------------------------------------------------- + type(physics_state), intent(inout), target :: state + type(physics_buffer_desc), pointer :: pbuf(:) ! physics buffer + + !----------------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------------- + !integer :: i, n, ns, nc + !integer :: elec_ndx + !integer :: lchnk !Chunk number from state structure + !integer :: ncol !Number of columns in this chunk from state structure + + !real(r8), dimension(:,:,:), pointer :: q ! model mass mixing ratios + !real(r8), dimension(:,:), pointer :: qs ! Pointer to access fields in pbuf + + !character(len=16) :: name + !real(r8) :: vmr(state%ncol,pver) + !real(r8) :: wrk(state%ncol,pver) + + !!----------------------------------------------------------------------- + !elec_ndx = get_spc_ndx('e') + + !!-------------------------------------------------------------------- + !! If electrons are simulated enforce charge neutrality ... + !!-------------------------------------------------------------------- + !if( elec_ndx > 0 ) then + ! lchnk = state%lchnk + ! ncol = state%ncol + ! q => state%q + ! wrk(:,:) = 0._r8 + + ! do i = 1,pos_ion_n+neg_ion_n + ! if (i .le. pos_ion_n) then + ! name = pos_ion_names(i) + ! else + ! name = neg_ion_names(i-pos_ion_n) + ! endif + ! n = get_spc_ndx(name) + + ! if (n>0) then + ! call cnst_get_ind( name, nc, abort=.false. ) + ! if (nc>0) then + ! vmr(:ncol,:) = mbarv(:ncol,:,lchnk) * q(:ncol,:,nc) / adv_mass(n) + ! else + ! ! not transported + ! ns = slvd_index( name ) + ! if (ns>0) then + ! call pbuf_get_field(pbuf, slvd_pbf_ndx, qs, start=(/1,1,ns/), kount=(/pcols,pver,1/) ) + ! vmr(:ncol,:) = mbarv(:ncol,:,lchnk) * qs(:ncol,:) / adv_mass(n) + ! endif + ! endif + ! if (i .le. pos_ion_n) then + ! wrk(:ncol,:) = wrk(:ncol,:) + vmr(:ncol,:) + ! else + ! wrk(:ncol,:) = wrk(:ncol,:) - vmr(:ncol,:) + ! endif + ! end if + ! end do + + ! where ( wrk(:,:)<0._r8 ) + ! wrk(:,:)=0._r8 + ! end where + + ! call cnst_get_ind( 'e', nc, abort=.false. ) + + ! if (nc>0) then + ! q(:ncol,:,nc) = adv_mass(elec_ndx) * wrk(:ncol,:) / mbarv(:ncol,:,lchnk) + ! else + ! ! not transported + ! ns = slvd_index( 'e' ) + ! call pbuf_get_field(pbuf, slvd_pbf_ndx, qs, start=(/1,1,ns/), kount=(/pcols,pver,1/) ) + ! qs(:ncol,:) = adv_mass(elec_ndx) * wrk(:ncol,:) / mbarv(:ncol,:,lchnk) + ! endif + + !endif + + end subroutine charge_fix_mmr + +end module charge_neutrality diff --git a/src/chemistry/pp_geoschem/chem_mods.F90 b/src/chemistry/pp_geoschem/chem_mods.F90 new file mode 100644 index 0000000000..af430ac0ca --- /dev/null +++ b/src/chemistry/pp_geoschem/chem_mods.F90 @@ -0,0 +1,91 @@ + module chem_mods +!-------------------------------------------------------------- +! ... Basic chemistry parameters and arrays +!-------------------------------------------------------------- + use shr_kind_mod, only : r8 => shr_kind_r8 + use constituents, only : pcnst + implicit none + save + + INTEGER, PARAMETER :: nTracersMax = 200 ! Must be equal to nadv_chem + INTEGER :: nTracers + CHARACTER(LEN=255) :: tracerNames(nTracersMax) + CHARACTER(LEN=255) :: tracerLongNames(nTracersMax) + REAL(r8) :: adv_Mass(nTracersMax) + REAL(r8) :: MWRatio(nTracersMax) + REAL(r8) :: ref_MMR(nTracersMax) + + ! Short-lived species (i.e. not advected) + INTEGER, PARAMETER :: nSlsMax = 500 ! UNadvected species only + INTEGER :: nSls + CHARACTER(LEN=255) :: slsNames(nSlsMax) + CHARACTER(LEN=255) :: slsLongnames(nSlsMax) + REAL(r8) :: sls_Ref_MMR(nSlsMax) + REAL(r8) :: slsMWRatio(nSlsMax) + + ! Mapping between constituents and GEOS-Chem tracers + INTEGER :: map2GC(pcnst) + INTEGER :: map2GC_Sls(nSlsMax) + + !----------------------------- + ! Dry deposition index mapping + !----------------------------- + ! drySpc_ndx maps drydep_list onto tracerNames such that + ! tracerNames(drySpc_ndx(:)) = drydep_list(:) + INTEGER, ALLOCATABLE :: drySpc_ndx(:) + + ! map2GC_dryDep maps drydep_list onto the GEOS-Chem dry deposition + ! velocity arrays such that + ! State_Chm%DryDepVel(1,:,map2GC_dryDep(:)) = cam_in%depVel(:,:) + INTEGER, ALLOCATABLE :: map2GC_dryDep(:) + + + ! Mapping from constituents to raw index + INTEGER :: map2Idx(pcnst) + + INTEGER, PARAMETER :: phtcnt = 40, & ! number of photolysis reactions + rxntot = 212, & ! number of total reactions + gascnt = 172, & ! number of gas phase reactions + nabscol = 2, & ! number of absorbing column densities + gas_pcnst = 103, & ! number of "gas phase" species + nfs = 4, & ! number of "fixed" species + relcnt = 0, & ! number of relationship species + grpcnt = 0, & ! number of group members + nzcnt = 824, & ! number of non-zero matrix entries + extcnt = 4, & ! number of species with external forcing + clscnt1 = 8, & ! number of species in explicit class + clscnt2 = 0, & ! number of species in hov class + clscnt3 = 0, & ! number of species in ebi class + clscnt4 = 95, & ! 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 = 4, & ! index of water vapor density + clsze = 1, & ! loop length for implicit chemistry + rxt_tag_cnt = 95, & + enthalpy_cnt = 0 +! nslvd = 0 + 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=16), 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 :: nslvd + character(len=255), allocatable :: slvd_lst(:) + real(r8), allocatable :: slvd_ref_mmr(:) + end module chem_mods diff --git a/src/chemistry/pp_geoschem/chem_prod_loss_diags.F90 b/src/chemistry/pp_geoschem/chem_prod_loss_diags.F90 new file mode 100644 index 0000000000..b3eb614cf4 --- /dev/null +++ b/src/chemistry/pp_geoschem/chem_prod_loss_diags.F90 @@ -0,0 +1,37 @@ +module chem_prod_loss_diags + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt1, clscnt4, gas_pcnst, clsmap, permute + use ppgrid, only : pver + use chem_mods, only : rxntot + use cam_history, only : addfld, outfld, add_default + !use mo_tracname, only : solsym + + implicit none + + private + public :: chem_prod_loss_diags_init + public :: chem_prod_loss_diags_out + +contains + + !----------------------------------------------------------------------------- + !----------------------------------------------------------------------------- + subroutine chem_prod_loss_diags_init + + end subroutine chem_prod_loss_diags_init + + !----------------------------------------------------------------------------- + !----------------------------------------------------------------------------- + subroutine chem_prod_loss_diags_out( ncol, lchnk, base_sol, reaction_rates, prod_in, loss_in, xhnm ) + + integer, intent(in) :: ncol, lchnk + real(r8), intent(in) :: base_sol(ncol,pver,gas_pcnst) + real(r8), intent(in) :: reaction_rates(ncol,pver,max(1,rxntot)) + real(r8), intent(in) :: prod_in(ncol,pver,max(1,clscnt4)) + real(r8), intent(in) :: loss_in(ncol,pver,max(1,clscnt4)) + real(r8), intent(in) :: xhnm(ncol,pver) + + end subroutine chem_prod_loss_diags_out + +end module chem_prod_loss_diags + diff --git a/src/chemistry/pp_geoschem/chemistry.F90 b/src/chemistry/pp_geoschem/chemistry.F90 new file mode 100644 index 0000000000..6393a2e1b5 --- /dev/null +++ b/src/chemistry/pp_geoschem/chemistry.F90 @@ -0,0 +1,4225 @@ +!================================================================================================ +! This is the "GEOS-Chem" chemistry module. +!================================================================================================ + +module chemistry + use shr_kind_mod, only: r8 => shr_kind_r8 + use physics_types, only: physics_state, physics_ptend, physics_ptend_init + use ppgrid, only: begchunk, endchunk, pcols + use ppgrid, only: pver, pverp + use constituents, only: pcnst, cnst_add, cnst_get_ind + !use mo_gas_phase_chemdr, only: map2chm + !use mo_constants, only: pi + use shr_const_mod, only: molw_dryair=>SHR_CONST_MWDAIR + !use chem_mods, only : gas_pcnst, adv_mass + !use mo_sim_dat, only: set_sim_dat + use seq_drydep_mod, only : nddvels => n_drydep, drydep_list + use spmd_utils, only : MasterProc, myCPU=>Iam, nCPUs=>npes + use cam_logfile, only : iulog + use string_utils, only : to_upper + + !-------------------------------------------------------------------- + ! Basic GEOS-Chem modules + !-------------------------------------------------------------------- + USE DiagList_Mod, ONLY : DgnList ! Derived type for diagnostics list + USE Input_Opt_Mod, ONLY : OptInput ! Derived type for Input Options + USE State_Chm_Mod, ONLY : ChmState ! Derived type for Chemistry State object + USE State_Diag_Mod, ONLY : DgnState ! Derived type for Diagnostics State object + USE State_Grid_Mod, ONLY : GrdState ! Derived type for Grid State object + USE State_Met_Mod, ONLY : MetState ! Derived type for Meteorology State object + USE ErrCode_Mod ! Error codes for success or failure + USE Error_Mod ! For error checking + + !----------------------------------------------------------------- + ! Parameters to define floating-point variables + !----------------------------------------------------------------- + USE PRECISION_MOD, ONLY : fp, f4 ! Flexible precision + + use Chem_Mods, only : nSlvd, slvd_Lst, slvd_ref_MMR + + ! Exit routine in CAM + use cam_abortutils, only : endrun + + use chem_mods, only : nTracersMax + use chem_mods, only : nTracers + use chem_mods, only : tracerNames + use chem_mods, only : tracerLongNames + use chem_mods, only : adv_Mass + use chem_mods, only : mwRatio + use chem_mods, only : ref_mmr + use chem_mods, only : nSlsMax + use chem_mods, only : nSls + use chem_mods, only : slsNames + use chem_mods, only : slsLongNames + use chem_mods, only : sls_ref_MMR + use chem_mods, only : slsmwRatio + use chem_mods, only : map2GC + use chem_mods, only : map2GC_Sls + use chem_mods, only : map2Idx + + IMPLICIT NONE + PRIVATE + SAVE + ! + ! Public interfaces + ! + public :: chem_is ! identify which chemistry is being used + public :: chem_register ! register consituents + public :: chem_is_active ! returns true if this package is active (ghg_chem=.true.) + public :: chem_implements_cnst ! returns true if consituent is implemented by this package + public :: chem_init_cnst ! initialize mixing ratios if not read from initial file + public :: chem_init ! initialize (history) variables + public :: chem_timestep_tend ! interface to tendency computation + public :: chem_final + public :: chem_write_restart + public :: chem_read_restart + public :: chem_init_restart + public :: chem_readnl ! read chem namelist + + public :: chem_emissions + public :: chem_timestep_init + + ! Location of valid input.geos + CHARACTER(LEN=500) :: inputGeosPath + + ! Location of chemistry input (for now) + CHARACTER(LEN=500) :: chemInputsDir + + !----------------------------- + ! Derived type objects + !----------------------------- + TYPE(OptInput) :: Input_Opt ! Input Options object + TYPE(ChmState),ALLOCATABLE :: State_Chm(:) ! Chemistry State object + TYPE(DgnState),ALLOCATABLE :: State_Diag(:) ! Diagnostics State object + TYPE(GrdState),ALLOCATABLE :: State_Grid(:) ! Grid State object + TYPE(MetState),ALLOCATABLE :: State_Met(:) ! Meteorology State object + TYPE(DgnList ) :: Diag_List ! Diagnostics list object + + ! Indices of critical species + INTEGER :: iH2O, iO3, iCH4, iCO, iNO + + ! Indices in the physics buffer + INTEGER :: NDX_PBLH ! PBL height [m] + INTEGER :: NDX_FSDS ! Downward shortwave flux at surface [W/m2] + INTEGER :: NDX_CLDTOP ! Cloud top height [index] + INTEGER :: NDX_CLDFRC ! Cloud fraction [-] + INTEGER :: NDX_PRAIN ! Rain production rate [kg/kg/s] + INTEGER :: NDX_NEVAPR ! Total rate of precipitation evaporation [kg/kg/s] + INTEGER :: NDX_RPRDTOT ! Convective total precip. production rate [kg/kg/s] + INTEGER :: NDX_LSFLXPRC ! Large-scale precip. at interface (liq + snw) [kg/m2/s] + INTEGER :: NDX_LSFLXSNW ! Large-scale precip. at interface (snow only) [kg/m2/s] + + ! Get constituent indices + INTEGER :: ixCldLiq + INTEGER :: ixCldIce + + ! Strings + CHARACTER(LEN=255) :: ThisLoc + CHARACTER(LEN=255) :: ErrMsg + +#define ALLDDVEL_GEOSCHEM 1 +#define OCNDDVEL_GEOSCHEM 0 +#define OCNDDVEL_MOZART 0 + +! The following flags are only used if ALLDDVEL_GEOSCHEM is on +#define LANDTYPE_HEMCO 0 +#define LANDTYPE_CLM 1 + +#if ( OCNDDVEL_MOZART ) + ! Filenames to compute dry deposition velocities similarly to MOZART + CHARACTER(LEN=255) :: MOZART_depvel_lnd_file = 'depvel_lnd_file' + CHARACTER(LEN=255) :: MOZART_clim_soilw_file = 'clim_soilw_file' + CHARACTER(LEN=255) :: MOZART_season_wes_file = 'season_wes_file' +#endif + +!================================================================================================ +contains +!================================================================================================ + + LOGICAL function chem_is (NAME) + + CHARACTER(LEN=*), INTENT(IN) :: NAME + + chem_is = .false. + IF (NAME == 'geoschem' ) THEN + chem_is = .true. + ENDIF + IF (MasterProc) WRITE(iulog,'(a)') 'GCCALL CHEM_IS' + + end function chem_is + +!================================================================================================ + + subroutine chem_register + + use physics_buffer, only : pbuf_add_field, dtype_r8 + use PhysConst, only : MWDry + + use Short_Lived_Species, only : Register_Short_Lived_Species + + use State_Grid_Mod, only : Init_State_Grid, Cleanup_State_Grid + use State_Chm_Mod, only : Init_State_Chm, Cleanup_State_Chm + use State_Chm_Mod, only : Ind_ + use Input_Opt_Mod, only : Set_Input_Opt, Cleanup_Input_Opt + use Species_Mod, only : Species + + !----------------------------------------------------------------------- + ! + ! Purpose: register advected constituents for chemistry + ! + !----------------------------------------------------------------------- + ! Need to generate a temporary species database + Type(ChmState) :: SC + Type(GrdState) :: SG + Type(OptInput) :: IO + TYPE(Species), POINTER :: ThisSpc + + INTEGER :: I, N, M + REAL(r8) :: cptmp + REAL(r8) :: mwtmp + REAL(r8) :: qmin + REAL(r8) :: ref_VMR + CHARACTER(LEN=128) :: mixtype + CHARACTER(LEN=128) :: molectype + CHARACTER(LEN=128) :: lng_Name + LOGICAL :: camout + LOGICAL :: ic_from_cam2 + LOGICAL :: has_fixed_ubc + LOGICAL :: has_fixed_ubflx + + INTEGER :: RC + + ! SDE 2018-05-02: This seems to get called before anything else + ! that includes CHEM_INIT + ! At this point, mozart calls SET_SIM_DAT, which is specified by each + ! mechanism separately (ie mozart/chemistry.F90 calls the subroutine + ! set_sim_dat which is in pp_[mechanism]/mo_sim_dat.F90. That sets a lot of + ! data in other places, notably in "chem_mods" + + IF (MasterProc) WRITE(iulog,'(a)') 'GCCALL CHEM_REGISTER' + + ! Generate fake state_chm + IO%Max_BPCH_Diag = 1000 + IO%Max_AdvectSpc = 500 + IO%Max_Families = 250 + + IO%RootCPU = .False. + + CALL Set_Input_Opt( am_I_Root = .False., & + Input_Opt = IO, & + RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Could not generate reference input options object!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + ! Options needed by Init_State_Chm + IO%ITS_A_FULLCHEM_SIM = .True. + IO%LLinoz = .True. + IO%LUCX = .True. + IO%LPRT = .False. + IO%N_Advect = nTracers + DO I = 1, nTracers + IO%AdvectSpc_Name(I) = TRIM(tracerNames(I)) + ENDDO + IO%SalA_rEdge_um(1) = 0.01e+0_fp + IO%SalA_rEdge_um(2) = 0.50e+0_fp + IO%SalC_rEdge_um(1) = 0.50e+0_fp + IO%SalC_rEdge_um(2) = 8.00e+0_fp + + ! Prevent reporting + IO%rootCPU = .False. + IO%myCPU = myCPU + + CALL Init_State_Grid( am_I_Root = .False., & + State_Grid = SG , & + RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered within call to "Init_State_Grid"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + SG%NX = 1 + SG%NY = 1 + SG%NZ = 1 + + CALL Init_State_Chm( am_I_Root = .False., & + Input_Opt = IO, & + State_Chm = SC, & + State_Grid = SG, & + RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered within call to "Init_State_Chm"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + ! At the moment, we force nadv_chem=200 in the setup file + ! Default + map2GC = -1 + ref_MMR(:) = 0.0e+0_r8 + MWRatio(:) = 1.0e+0_r8 + tracerLongNames = '' + + DO I = 1, nTracersMax + IF (I.LE.nTracers) THEN + N = Ind_(tracerNames(I)) + ThisSpc => SC%SpcData(N)%Info + lng_Name = TRIM(ThisSpc%FullName) + MWTmp = REAL(ThisSpc%MW_g,r8) + ref_VMR = REAL(ThisSpc%BackgroundVV,r8) + adv_Mass(I) = MWTmp + ref_MMR(I) = ref_VMR / (MWDry / MWTmp) + ELSE + lng_Name = TRIM(tracerNames(I)) + MWTmp = 1000.0e+0_r8 * (0.001e+0_r8) + adv_Mass(I) = MWTmp + ref_MMR(I) = 1.0e-38_r8 + ENDIF + MWRatio(I) = MWDry/MWTmp + tracerLongNames(I) = TRIM(lng_Name) + + ! dummy value for specific heat of constant pressure (Cp) + cptmp = 666._r8 + ! minimum mixing ratio + qmin = 1.e-38_r8 + ! mixing ratio type + mixtype = 'dry' + ! Used for ionospheric WACCM (WACCM-X) + molectype = 'minor' + ! Is an output field (?) + camout = .false. + ! Not true for O2(1-delta) or O2(1-sigma) + ic_from_cam2 = .true. + ! Use a fixed value at the upper boundary + has_fixed_ubc = .false. + ! Use a fixed flux condition at the upper boundary + has_fixed_ubflx = .false. + !write(tracernames(i),'(a,I0.4)') 'GCTRC_', i + ! NOTE: In MOZART, this only gets called for tracers + ! This is the call to add a "constituent" + CALL cnst_add( TRIM(tracerNames(I)), adv_Mass(I), cptmp, qmin, N, & + readiv=ic_from_cam2, mixtype=mixtype, cam_outfld=camout, & + molectype=molectype, fixed_ubc=has_fixed_ubc, & + fixed_ubflx=has_fixed_ubflx, longname=TRIM(lng_Name) ) + + ! Add to GC mapping. When starting a timestep, we will want to update the + ! concentration of State_Chm(x)%Species(1,iCol,iLev,m) with data from + ! constituent n + M = Ind_(TRIM(tracerNames(I))) + IF ( M > 0 ) THEN + map2GC(N) = M + map2Idx(N) = I + ENDIF + ! Nullify pointer + ThisSpc => NULL() + ENDDO + + ! Now unadvected species + map2GC_Sls = 0 + sls_ref_MMR(:) = 0.0e+0_r8 + SlsMWRatio(:) = -1.0e+0_r8 + slsLongNames = '' + DO I = 1, nSls + N = Ind_(slsNames(I)) + IF ( N .GT. 0 ) THEN + ThisSpc => SC%SpcData(N)%Info + MWTmp = REAL(ThisSpc%MW_g,r8) + ref_VMR = REAL(ThisSpc%BackgroundVV,r8) + lng_Name = TRIM(ThisSpc%FullName) + slsLongNames(I) = lng_Name + sls_ref_MMR(I) = ref_VMR / (MWDry / MWTmp) + SlsMWRatio(I) = MWDry / MWTmp + map2GC_Sls(I) = N + ThisSpc => NULL() + ENDIF + ENDDO + + ! Pass information to "short_lived_species" module + slvd_ref_MMR(1:nSls) = sls_ref_MMR(1:nSls) + CALL Register_Short_Lived_Species() + ! More information: + ! http://www.cesm.ucar.edu/models/atm-cam/docs/phys-interface/node5.html + + ! Clean up + Call Cleanup_State_Chm ( .False., SC, RC ) + Call Cleanup_State_Grid( .False., SG, RC ) + Call Cleanup_Input_Opt ( .False., IO, RC ) + + end subroutine chem_register + + subroutine chem_readnl(nlfile) + ! This is the FIRST routine to get called - so it should read in + ! GEOS-Chem options from input.geos without actually doing any + ! initialization + + use cam_abortutils, only : endrun + use units, only : getunit, freeunit + use mpishorthand + use gckpp_Model, only : nSpec, Spc_Names + use mo_chem_utls, only : get_spc_ndx + use chem_mods, only : drySpc_ndx + + ! args + CHARACTER(LEN=*), INTENT(IN) :: nlfile ! filepath for file containing namelist input + + ! Local variables + INTEGER :: I, N, nIgnored + INTEGER :: UNITN, IERR + CHARACTER(LEN=500) :: line + LOGICAL :: menuFound + LOGICAL :: validSLS + +#if ( OCNDDVEL_MOZART ) + namelist /chem_inparm/ MOZART_depvel_lnd_file, & + MOZART_clim_soilw_file, & + MOZART_season_wes_file +#endif + + nIgnored = 0 + + ! Set paths + ! MIT path + !inputGeosPath='/home/fritzt/input.geos.template' + !chemInputsDir='/net/d06/data/GCdata/ExtData/CHEM_INPUTS/' + ! Cheyenne path + inputGeosPath='/glade/u/home/fritzt/input.geos.template' + chemInputsDir='/glade/p/univ/umit0034/ExtData/CHEM_INPUTS/' + + +#if ( ALLDDVEL_GEOSCHEM + OCNDDVEL_GEOSCHEM + OCNDDVEL_MOZART != 1 ) + IF (MasterProc) THEN + Write(iulog,'(/,a)') REPEAT( "=", 79 ) + Write(iulog,'(a)') " Preprocessor flags are not set correctly in chemistry.F90" + Write(iulog,'(a)') " The user needs to decide how to compute dry deposition velocities" + Write(iulog,'(a)') " Three options appear: " + Write(iulog,'(a)') " + Let GEOS-Chem calculate all dry deposition velocities." + Write(iulog,'(a)') " Required setup:" + Write(iulog,'(a)') " ALLDDVEL_GEOSCHEM == 1" + Write(iulog,'(a)') " OCNDDVEL_GEOSCHEM == 0" + Write(iulog,'(a)') " OCNDDVEL_MOZART == 0" + Write(iulog,'(a)') " + Let CLM compute dry deposition velocities over land and let" + Write(iulog,'(a)') " GEOS-Chem compute velocities over ocean and ice" + Write(iulog,'(a)') " Required setup:" + Write(iulog,'(a)') " ALLDDVEL_GEOSCHEM == 0" + Write(iulog,'(a)') " OCNDDVEL_GEOSCHEM == 1" + Write(iulog,'(a)') " OCNDDVEL_MOZART == 0" + Write(iulog,'(a)') " + Let CLM compute dry deposition velocities over land and" + Write(iulog,'(a)') " compute velocities over ocean and ice in a similar way as" + Write(iulog,'(a)') " MOZART" + Write(iulog,'(a)') " Required setup:" + Write(iulog,'(a)') " ALLDDVEL_GEOSCHEM == 0" + Write(iulog,'(a)') " OCNDDVEL_GEOSCHEM == 0" + Write(iulog,'(a)') " OCNDDVEL_MOZART == 1" + Write(iulog,'(a)') REPEAT( "=", 79 ) + CALL ENDRUN('Incorrect definitions for dry deposition velocities') + ENDIF +#endif +#if ( ALLDDVEL_GEOSCHEM && ( LANDTYPE_HEMCO + LANDTYPE_CLM != 1 ) ) + IF (MasterProc) THEN + Write(iulog,'(/,a)') REPEAT( "=", 79 ) + Write(iulog,'(a)') REPEAT( "=", 79 ) + Write(iulog,'(a)') " Preprocessor flags are not set correctly in chemistry.F90" + Write(iulog,'(a)') " Dry-deposition velocities are computed by GEOS-Chem" + Write(iulog,'(a)') " The user needs to decide if land types should be from CLM or from HEMCO" + CALL ENDRUN('Incorrect definitions for source of land type data') + ENDIF +#endif + + ALLOCATE(drySpc_ndx(nddvels), STAT=IERR) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failed to allocate drySpc_ndx') + + IF (MasterProc) THEN + + Write(iulog,'(/,a)') REPEAT( '=', 50 ) + Write(iulog,'(a)') REPEAT( '=', 50 ) + Write(iulog,'(a)') 'This is the GEOS-CHEM / CESM interface' + Write(iulog,'(a)') REPEAT( '=', 50 ) + Write(iulog,'(a)') ' + Routines written by Thibaud M. Fritz' + Write(iulog,'(a)') ' + Laboratory for Aviation and the Environment,' + Write(iulog,'(a)') ' + Department of Aeronautics and Astronautics,' + Write(iulog,'(a)') ' + Massachusetts Institute of Technology' + Write(iulog,'(a)') REPEAT( '=', 50 ) + + Write(iulog,'(/,/, a)') 'Now defining GEOS-Chem tracers and dry deposition mapping...' + + UNITN = GETUNIT() + + !============================================================== + ! Opening input.geos and go to ADVECTED SPECIES MENU + !============================================================== + + OPEN( UNITN, FILE=TRIM(inputGeosPath), STATUS='OLD', IOSTAT=IERR ) + IF (IERR .NE. 0) THEN + CALL ENDRUN('chem_readnl: ERROR opening input.geos') + ENDIF + + ! Go to ADVECTED SPECIES MENU + menuFound = .False. + DO WHILE ( .NOT. menuFound ) + READ( UNITN, '(a)', IOSTAT=IERR ) line + IF ( IERR .NE. 0 ) THEN + CALL ENDRUN('chem_readnl: ERROR finding advected species menu') + ELSEIF ( INDEX(line, 'ADVECTED SPECIES MENU') > 0 ) THEN + menuFound = .True. + ENDIF + ENDDO + + !============================================================== + ! Read list of GEOS-Chem tracers + !============================================================== + + DO + ! Read line + READ(UNITN,'(26x,a)', IOSTAT=IERR) line + + IF ( INDEX( TRIM(line), '---' ) > 0 ) EXIT + + nTracers = nTracers + 1 + tracerNames(nTracers) = TRIM(line) + + ENDDO + + CLOSE(UNITN) + CALL FREEUNIT(UNITN) + + ! Assign remaining tracers dummy names + DO I = (nTracers+1), nTracersMax + WRITE(tracerNames(I),'(a,I0.4)') 'GCTRC_', I + ENDDO + + !============================================================== + ! Now go through the KPP mechanism and add any species not + ! implemented by the tracer list in input.geos + !============================================================== + + IF ( nSpec > nSlsMax ) THEN + CALL ENDRUN('chem_readnl: too many species - increase nSlsmax') + ENDIF + + nSls = 0 + DO I = 1, nSpec + ! Get the name of the species from KPP + line = ADJUSTL(TRIM(Spc_Names(I))) + ! Only add this + validSLS = ( .NOT. ANY(TRIM(line) .EQ. tracerNames) ) + IF (validSLS) THEN + ! Genuine new short-lived species + nSls = nSls + 1 + slsNames(nSls) = TRIM(line) + ENDIF + ENDDO + + !============================================================== + ! Get mapping between dry deposition species and species set + !============================================================== + + DO N = 1, nddvels + + ! The species names need to be convert to upper case as, + ! for instance, BR2 != Br2 + drySpc_ndx(N) = get_spc_ndx( to_upper(drydep_list(N)) ) + + IF ( drySpc_ndx(N) < 0 ) THEN + Write(iulog,'(a,a)') ' ## Ignoring dry deposition of ', & + TRIM(drydep_list(N)) + nIgnored = nIgnored + 1 + ENDIF + ENDDO + + IF ( nIgnored > 0 ) THEN + Write(iulog,'(a,a)') ' The species listed above have dry', & + ' deposition turned off for one of the following reasons:' + Write(iulog,'(a)') ' - They are not present in the GEOS-Chem tracer list.' + Write(iulog,'(a)') ' - They have a synonym (e.g. CH2O and HCHO).' + ENDIF + + !============================================================== + ! Print summary + !============================================================== + + Write(iulog,'(/, a)') '### Summary of GEOS-Chem species: ' + Write(iulog,'( a)') REPEAT( '-', 50 ) + Write(iulog,'( a)') '+ List of advected species: ' + Write(iulog,100) 'ID', 'Tracer', 'Dry deposition (T/F)' + DO N = 1, nTracers + WRITE(iulog,110) N, TRIM(tracerNames(N)), any(drySpc_ndx .eq. N) + ENDDO + + Write(iulog,'(/, a)') '+ List of short-lived species: ' + DO N = 1, nSls + WRITE(iulog,120) N, TRIM(slsNames(N)) + ENDDO + + 100 FORMAT( 1x, A3, 3x, A10, 1x, A25 ) + 110 FORMAT( 1x, I3, 3x, A10, 1x, L15 ) + 120 FORMAT( 1x, I3, 3x, A10 ) + + !============================================================== + + ENDIF + + !================================================================== + ! Broadcast to all processors + !================================================================== + +#if defined( SPMD ) + CALL MPIBCAST(nTracers, 1, MPIINT, 0, MPICOM ) + CALL MPIBCAST(tracerNames, LEN(tracerNames(1))*nTracersMax, MPICHAR, 0, MPICOM ) + CALL MPIBCAST(nSls, 1, MPIINT, 0, MPICOM ) + CALL MPIBCAST(slsNames, LEN(slsNames(1))*nSlsMax, MPICHAR, 0, MPICOM ) + CALL MPIBCAST(drySpc_ndx, nddvels, MPIINT, 0, MPICOM ) + +#if ( OCNDDVEL_MOZART ) + !============================================================== + ! The following lines should only be called if we compute + ! velocities over the ocean and ice in a MOZART-like way. + ! Thibaud M. Fritz - 26 Feb 2020 + !============================================================== + + CALL MPIBCAST(MOZART_depvel_lnd_file, LEN(MOZART_depvel_lnd_file), MPICHAR, 0, MPICOM) + CALL MPIBCAST(MOZART_clim_soilw_file, LEN(MOZART_clim_soilw_file), MPICHAR, 0, MPICOM) + CALL MPIBCAST(MOZART_season_wes_file, LEN(MOZART_season_wes_file), MPICHAR, 0, MPICOM) +#endif + +#endif + + ! Update "short_lived_species" arrays - will eventually unify these + nSlvd = nSls + ALLOCATE(slvd_Lst(nSlvd), STAT=IERR) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating slvd_Lst') + ALLOCATE(slvd_ref_MMR(nSlvd), STAT=IERR) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating slvd_ref_MMR') + DO I = 1, nSls + slvd_Lst(I) = TRIM(slsNames(I)) + ENDDO + + end subroutine chem_readnl + +!================================================================================================ + + function chem_is_active() + !----------------------------------------------------------------------- + logical :: chem_is_active + !----------------------------------------------------------------------- + chem_is_active = .true. + + end function chem_is_active + +!================================================================================================ + + function chem_implements_cnst(name) + !----------------------------------------------------------------------- + ! + ! Purpose: return true if specified constituent is implemented by this package + ! + ! Author: B. Eaton + ! + !----------------------------------------------------------------------- + IMPLICIT NONE + !-----------------------------Arguments--------------------------------- + + CHARACTER(LEN=*), INTENT(IN) :: name ! constituent name + LOGICAL :: chem_implements_cnst ! return value + + INTEGER :: I + + chem_implements_cnst = .false. + + DO I = 1, nTracers + IF (TRIM(tracerNames(I)) .eq. TRIM(NAME)) THEN + chem_implements_cnst = .true. + EXIT + ENDIF + ENDDO + + IF (MasterProc) WRITE(iulog,'(a)') 'GCCALL CHEM_IMPLEMENTS_CNST' + + end function chem_implements_cnst + +!=============================================================================== + + subroutine chem_init(phys_state, pbuf2d) + !----------------------------------------------------------------------- + ! + ! Purpose: initialize GEOS-Chem parts (state objects, mainly) + ! (and declare history variables) + ! + !----------------------------------------------------------------------- + use physics_buffer, only: physics_buffer_desc, pbuf_get_index + use cam_history, only: addfld, add_default, horiz_only + use chem_mods, only: map2GC_dryDep, drySpc_ndx + + use mpishorthand + use cam_abortutils, only : endrun + + use Input_Opt_Mod + use State_Chm_Mod + use State_Grid_Mod + use State_Met_Mod + use DiagList_Mod, only : Init_DiagList, Print_DiagList + use GC_Environment_Mod + use GC_Grid_Mod, only : SetGridFromCtrEdges + + ! Use GEOS-Chem versions of physical constants + use PhysConstants, only : PI, PI_180 + use PhysConstants, only : Re + + use Phys_Grid, only : get_Area_All_p + use hycoef, only : ps0, hyai, hybi + + use Time_Mod, only : Accept_External_Date_Time + !use Time_Mod, only : Set_Begin_Time, Set_End_Time + !use Time_Mod, only : Set_Current_Time, Set_DiagB + !use Transfer_Mod, only : Init_Transfer + use Linoz_Mod, only : Linoz_Read + +#if ( OCNDDVEL_MOZART ) + use seq_drydep_mod, only: drydep_method, DD_XLND + use mo_drydep, only: drydep_inti +#endif + + use CMN_Size_Mod + + use Drydep_Mod, only : Init_Drydep, DepName, nDVZind + use Carbon_Mod, only : Init_Carbon + use Dust_Mod, only : Init_Dust + use Seasalt_Mod, only : Init_Seasalt + use Sulfate_Mod, only : Init_Sulfate + use Aerosol_Mod, only : Init_Aerosol + use WetScav_Mod, only : Init_WetScav + use TOMS_Mod, only : Init_TOMS + use Pressure_Mod, only : Init_Pressure, Accept_External_ApBp + use Chemistry_Mod, only : Init_Chemistry + use UCX_Mod, only : Init_UCX +#if ( ALLDDVEL_GEOSCHEM && LANDTYPE_HEMCO ) + use Olson_Landmap_Mod +#endif + use Mixing_Mod + + use PBL_Mix_Mod, only : Init_PBL_Mix + + use GC_Emissions_Mod, only : GC_Emissions_Init + + TYPE(physics_state), INTENT(IN):: phys_state(BEGCHUNK:ENDCHUNK) + TYPE(physics_buffer_desc), POINTER :: pbuf2d(:,:) + + ! Local variables + + !---------------------------- + ! Scalars + !---------------------------- + + ! Integers + INTEGER :: LCHNK(BEGCHUNK:ENDCHUNK), NCOL(BEGCHUNK:ENDCHUNK) + INTEGER :: IWAIT, IERR + INTEGER :: nX, nY, nZ + INTEGER :: iX, jY + INTEGER :: I, J, L, N + INTEGER :: RC + INTEGER :: NLINOZ + + ! Logicals + LOGICAL :: am_I_Root, rootChunk + LOGICAL :: prtDebug + + ! Strings + CHARACTER(LEN=255) :: historyConfigFile + CHARACTER(LEN=255) :: SpcName + + ! Grid setup + REAL(fp) :: lonVal, latVal + REAL(fp) :: dLonFix, dLatFix + REAL(f4), ALLOCATABLE :: lonMidArr(:,:), latMidArr(:,:) + REAL(f4), ALLOCATABLE :: lonEdgeArr(:,:), latEdgeArr(:,:) + REAL(r8), ALLOCATABLE :: linozData(:,:,:,:) + + REAL(r8), ALLOCATABLE :: Col_Area(:) + REAL(fp), ALLOCATABLE :: Ap_CAM_Flip(:), Bp_CAM_Flip(:) + + REAL(r8), POINTER :: SlsPtr(:,:,:) + + + ! Assume a successful return until otherwise + RC = GC_SUCCESS + + ! For error trapping + ErrMsg = '' + ThisLoc = ' -> at GEOS-Chem (in chemistry/pp_geoschem/chemistry.F90)' + + ! LCHNK: which chunks we have on this process + LCHNK = PHYS_STATE%LCHNK + ! NCOL: number of atmospheric columns for each chunk + NCOL = PHYS_STATE%NCOL + + write(iulog,'(2(a,x,I6,x))') 'chem_init called on PE ', myCPU, ' of ', nCPUs + + ! The GEOS-Chem grids on every "chunk" will all be the same size, to avoid + ! the possibility of having differently-sized chunks + nX = 1 + !nY = MAXVAL(NCOL) + nY = PCOLS + nZ = PVER + + !! Add short lived speies to buffers + !CALL Pbuf_add_field(Trim(SLSBuffer),'global',dtype_r8,(/PCOLS,PVER,nSls/),Sls_Pbf_Idx) + !! Initialize + !ALLOCATE(SlsPtr(PCOLS,PVER,BEGCHUNK:ENDCHUNK), STAT=IERR) + !IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating SlsPtr') + !SlsPtr(:,:,:) = 0.0e+0_r8 + !DO I=1,nSls + ! SlsPtr(:,:,:) = sls_ref_MMR(I) + ! CALL pbuf_set_field(pbuf2d,Sls_Pbf_Idx,SlsPtr,start=(/1,1,i/),kount=(/PCOLS,PVER,1/)) + !ENDDO + !DEALLOCATE(SlsPtr) + + ! This ensures that each process allocates everything needed for its chunks + ALLOCATE(State_Chm(BEGCHUNK:ENDCHUNK) , STAT=IERR) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating State_Chm') + ALLOCATE(State_Diag(BEGCHUNK:ENDCHUNK) , STAT=IERR) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating State_Diag') + ALLOCATE(State_Grid(BEGCHUNK:ENDCHUNK), STAT=IERR) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating State_Grid') + ALLOCATE(State_Met(BEGCHUNK:ENDCHUNK) , STAT=IERR) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating State_Met') + + ! Initialize fields of the Input Options object + CALL Set_Input_Opt( am_I_Root = MasterProc, & + Input_Opt = Input_Opt, & + RC = RC ) + + ! Set some basic flags + Input_Opt%LUCX = .True. + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered within call to "Set_Input_Opt"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + DO I = BEGCHUNK, ENDCHUNK + + ! Only treat the first chunk as the "root" + am_I_Root = ((I.EQ.BEGCHUNK) .and. MasterProc) + + ! Initialize fields of the Grid State object + CALL Init_State_Grid( am_I_Root = am_I_Root, & + State_Grid = State_Grid(I), & + RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered within call to "Init_State_Grid"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + State_Grid(I)%NX = nX + State_Grid(I)%NY = nY + State_Grid(I)%NZ = nZ + + ! Initialize GEOS-Chem horizontal grid structure + CALL GC_Init_Grid( am_I_Root = am_I_Root, & + Input_Opt = Input_Opt, & + State_Grid = State_Grid(I), & + RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered within call to "GC_Init_Grid"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + ! Define more variables for State_Grid + ! TMMF, might need tweaking + State_Grid(I)%MaxTropLev = MIN(40, nZ) + State_Grid(I)%MaxStratLev = MIN(59, nZ) + + ! Set maximum number of levels in the chemistry grid + IF ( Input_Opt%LUCX ) THEN + State_Grid(I)%MaxChemLev = State_Grid(I)%MaxStratLev + ELSE + State_Grid(I)%MaxChemLev = State_Grid(I)%MaxTropLev + ENDIF + + ENDDO + + ! Note - this is called AFTER chem_readnl, after X, and after + ! every constituent has had its initial conditions read. Any + ! constituent which is not found in the CAM restart file will + ! then have already had a call to chem_implements_cnst, and will + ! have then had a call to chem_init_cnst to set a default VMR + ! Call the routine GC_Allocate_All (located in module file + ! GeosCore/gc_environment_mod.F90) to allocate all lat/lon + ! allocatable arrays used by GEOS-Chem. + CALL GC_Allocate_All ( am_I_Root = MasterProc, & + Input_Opt = Input_Opt, & + State_Grid = State_Grid(BEGCHUNK), & + value_I_Lo = 1, & + value_J_Lo = 1, & + value_I_Hi = nX, & + value_J_Hi = nY, & + value_IM = nX, & + value_JM = nY, & + value_LM = nZ, & + value_IM_WORLD = nX, & + value_JM_WORLD = nY, & + value_LM_WORLD = nZ, & + value_LLSTRAT = 59, & !TMMF + RC = RC ) + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "GC_Allocate_All"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + Input_Opt%myCPU = myCPU + Input_Opt%rootCPU = MasterProc + + ! TODO: Mimic GEOS-Chem's reading of input options + !IF (MasterProc) THEN + ! CALL Read_Input_File( am_I_Root = .True., & + ! Input_Opt = Input_Opt(BEGCHUNK), & + ! srcFile = inputGeosPath, & + ! RC = RC ) + !ENDIF + !CALL + + ! For now just hard-code it + ! First setup directories + Input_Opt%Chem_Inputs_Dir = TRIM(chemInputsDir) + + ! Simulation menu + Input_Opt%NYMDb = 20000101 + Input_Opt%NHMSb = 000000 + Input_Opt%NYMDe = 20010101 + Input_Opt%NHMSe = 000000 + + ! Now READ_SIMULATION_MENU + Input_Opt%ITS_A_CH4_SIM = .False. + Input_Opt%ITS_A_CO2_SIM = .False. + Input_Opt%ITS_A_FULLCHEM_SIM = .True. + Input_Opt%ITS_A_MERCURY_SIM = .False. + Input_Opt%ITS_A_POPS_SIM = .False. + Input_Opt%ITS_A_RnPbBe_SIM = .False. + Input_Opt%ITS_A_TAGO3_SIM = .False. + Input_Opt%ITS_A_TAGCO_SIM = .False. + Input_Opt%ITS_AN_AEROSOL_SIM = .False. + + ! Now READ_ADVECTED_SPECIES_MENU + Input_Opt%N_Advect = nTracers + IF (Input_Opt%N_Advect.GT.Input_Opt%Max_AdvectSpc) THEN + CALL ENDRUN('Number of tracers exceeds max count') + ENDIF + ! Assign tracer names + DO J = 1, Input_Opt%N_Advect + Input_Opt%AdvectSpc_Name(J) = TRIM(tracerNames(J)) + ENDDO + ! No tagged species + Input_Opt%LSplit = .False. + + ! Now READ_TRANSPORT_MENU + Input_Opt%LTran = .True. + Input_Opt%LFill = .True. + Input_Opt%TPCore_IOrd = 3 + Input_Opt%TPCore_JOrd = 3 + Input_Opt%TPCore_KOrd = 3 + + ! Now READ_CONVECTION_MENU + ! For now, TMMF + Input_Opt%LConv = .False. + Input_Opt%LTurb = .True. + Input_Opt%LNLPBL = .True. + + ! Now READ_EMISSIONS_MENU + Input_Opt%LEmis = .False. + Input_Opt%HCOConfigFile = 'HEMCO_Config.rc' + Input_Opt%LFix_PBL_Bro = .False. + + ! Set surface VMRs - turn this off so that CAM can handle it + Input_Opt%LCH4Emis = .False. + Input_Opt%LCH4SBC = .False. + Input_Opt%LOCSEmis = .False. + Input_Opt%LCFCEmis = .False. + Input_Opt%LClEmis = .False. + Input_Opt%LBrEmis = .False. + Input_Opt%LN2OEmis = .False. + Input_Opt%LBasicEmis = .False. + + ! Set initial conditions + Input_Opt%LSetH2O = .True. + + ! CFC control + Input_Opt%CFCYear = 0 + + ! Now READ_AEROSOL_MENU + Input_Opt%LSulf = .True. + Input_Opt%LMetalcatSO2 = .True. + Input_Opt%LCarb = .True. + Input_Opt%LBrC = .False. + Input_Opt%LSOA = .True. + Input_Opt%LSVPOA = .False. + Input_Opt%LOMOC = .False. + Input_Opt%LDust = .True. + Input_Opt%LDstUp = .False. + Input_Opt%LSSalt = .True. + Input_Opt%SalA_rEdge_um(1) = 0.01e+0_fp + Input_Opt%SalA_rEdge_um(2) = 0.50e+0_fp + Input_Opt%SalC_rEdge_um(1) = 0.50e+0_fp + Input_Opt%SalC_rEdge_um(2) = 8.00e+0_fp + Input_Opt%LMPOA = .False. + ! For now, disable solid PSCs and strat aerosol settling + ! Our treatment of the stratosphere isn't really sophisticated + ! enough to warrant it yet + Input_Opt%LGravStrat = .False. + Input_Opt%LSolidPSC = .False. + Input_Opt%LHomNucNAT = .False. + Input_Opt%T_NAT_Supercool = 3.0e+0_fp + Input_Opt%P_Ice_Supersat = 1.2e+0_fp + Input_Opt%LPSCChem = .True. + Input_Opt%LStratOD = .True. + Input_Opt%hvAerNIT = .False. + Input_Opt%hvAerNIT_JNIT = .False. + Input_Opt%hvAerNIT_JNITs = .False. + Input_Opt%JNITChanA = 0e+0_fp + Input_Opt%JNITChanB = 0e+0_fp + + ! Now READ_DEPOSITION_MENU + Input_Opt%LDryD = .True. + !================================================================== + ! Add the following options: + ! + GEOS-Chem computes ALL dry-deposition velocities + ! + CLM computes land velocities. Velocities over ocean and ice are + ! computed in a MOZART-like way + ! + CLM computes land velocities. Velocities over ocean and ice are + ! computed from GEOS-Chem + ! + ! Note: What to do about aerosols? Who should compute the dry + ! deposition velocities + ! + ! Thibaud M. Fritz - 26 Feb 2020 + !================================================================== + Input_Opt%LWetD = .True. + Input_Opt%CO2_Effect = .False. + Input_Opt%CO2_Level = 390.0_fp + Input_Opt%CO2_Ref = 390.0_fp + + ! Now READ_CHEMISTRY_MENU + Input_Opt%LChem = .True. + Input_Opt%LSChem = .False. ! .True. !TMMF + Input_Opt%LLinoz = .True. + Input_Opt%LSynoz = .True. + Input_Opt%LUCX = .True. + Input_Opt%LActiveH2O = .True. + Input_Opt%Use_Online_O3 = .True. + ! Expect to get total overhead ozone, although it shouldn not + ! make too much of a difference since we want to use "full-UCX" + Input_Opt%Use_O3_from_Met = .True. + Input_Opt%Use_TOMS_O3 = .False. + Input_Opt%Gamma_HO2 = 0.2e+0_fp + + Input_Opt%LPRT = .False. + + ! Read in data for Linoz. All CPUs allocate one array to hold the data. Only + ! the root CPU reads in the data; then we copy it out to a temporary array, + ! broadcast to all other CPUs, and finally duplicate the data into every + ! copy of Input_Opt + IF ( Input_Opt%LLinoz ) THEN + ! Allocate array for broadcast + nLinoz = Input_Opt%Linoz_NLevels * & + Input_Opt%Linoz_NLat * & + Input_Opt%Linoz_NMonths * & + Input_Opt%Linoz_NFields + ALLOCATE( linozData( Input_Opt%Linoz_NLevels, & + Input_Opt%Linoz_NLat, & + Input_Opt%Linoz_NMonths, & + Input_Opt%Linoz_NFields ), STAT=IERR) + IF (IERR.NE.0) CALL ENDRUN('Failure while allocating linozData') + linozData = 0.0e+0_r8 + + IF ( MasterProc ) THEN + ! Read data in to Input_Opt%Linoz_TParm + CALL Linoz_Read( MasterProc, Input_Opt, RC ) + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Linoz_Read"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + ! Copy the data to a temporary array + linozData = REAL(Input_Opt%LINOZ_TPARM,r8) + ENDIF +#if defined( SPMD ) + CALL MPIBCAST( linozData, nLinoz, MPIR8, 0, MPICOM ) +#endif + IF ( .NOT. MasterProc ) THEN + Input_Opt%LINOZ_TPARM = REAL(linozData,fp) + ENDIF + DEALLOCATE(linozData) + ENDIF + + + ! Note: The following calculations do not setup the gridcell areas. + ! In any case, we will need to be constantly updating this grid + ! to compensate for the "multiple chunks per processor" element + ALLOCATE(lonMidArr(nX,nY), STAT=IERR) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating lonMidArr') + ALLOCATE(lonEdgeArr(nX+1,nY+1), STAT=IERR) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating lonEdgeArr') + ALLOCATE(latMidArr(nX,nY), STAT=IERR) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating latMidArr') + ALLOCATE(latEdgeArr(nX+1,nY+1), STAT=IERR) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating latEdgeArr') + + ! We could try and get the data from CAM.. but the goal is to make this GC + ! component completely grid independent. So for now, we set to arbitrary + ! values + ! TODO: This needs more refinement. For now, this generates identical + ! State_Grid for all chunks + DO L = BEGCHUNK, ENDCHUNK + lonMidArr = 0.0e+0_f4 + latMidArr = 0.0e+0_f4 + dLonFix = 360.0e+0_fp / REAL(nX,fp) + dLatFix = 180.0e+0_fp / REAL(nY,fp) + DO I = 1, nX + ! Center of box, assuming dateline edge + lonVal = -180.0e+0_fp + (REAL(I-1,fp)*dLonFix) + DO J = 1, nY + ! Center of box, assuming regular cells + latVal = -90.0e+0_fp + (REAL(J-1,fp)*dLatFix) + lonMidArr(I,J) = REAL((lonVal + (0.5e+0_fp * dLonFix)) * PI_180, f4) + latMidArr(I,J) = REAL((latVal + (0.5e+0_fp * dLatFix)) * PI_180, f4) + + ! Edges of box, assuming regular cells + lonEdgeArr(I,J) = REAL(lonVal * PI_180, f4) + latEdgeArr(I,J) = REAL(latVal * PI_180, f4) + ENDDO + ! Edges of box, assuming regular cells + lonEdgeArr(I,nY+1) = REAL((lonVal + dLonFix) * PI_180, f4) + latEdgeArr(I,nY+1) = REAL((latVal + dLatFix) * PI_180, f4) + ENDDO + DO J = 1, nY+1 + ! Edges of box, assuming regular cells + latVal = -90.0e+0_fp + (REAL(J-1,fp)*dLatFix) + lonEdgeArr(nX+1,J) = REAL((lonVal + dLonFix) * PI_180, f4) + latEdgeArr(nX+1,J) = REAL((latVal) * PI_180, f4) + ENDDO + + CALL SetGridFromCtrEdges( am_I_Root = MasterProc, & + State_Grid = State_Grid(L), & + lonCtr = lonMidArr, & + latCtr = latMidArr, & + lonEdge = lonEdgeArr, & + latEdge = latEdgeArr, & + RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "SetGridFromCtrEdges"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + ENDDO + DEALLOCATE(lonMidArr) + DEALLOCATE(latMidArr) + DEALLOCATE(lonEdgeArr) + DEALLOCATE(latEdgeArr) + + + ! Set the times held by "time_mod" + CALL Accept_External_Date_Time( am_I_Root = MasterProc, & + value_NYMDb = Input_Opt%NYMDb, & + value_NHMSb = Input_Opt%NHMSb, & + value_NYMDe = Input_Opt%NYMDe, & + value_NHMSe = Input_Opt%NHMSe, & + value_NYMD = Input_Opt%NYMDb, & + value_NHMS = Input_Opt%NHMSb, & + RC = RC ) + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Accept_External_Date_Time"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + ! Start by setting some dummy timesteps + CALL GC_Update_Timesteps(300.0E+0_r8) + + ! Initialize error module + CALL Init_Error( MasterProc, Input_Opt, RC ) + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Init_Error"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + ! Set a flag to denote if we should print ND70 debug output + prtDebug = ( Input_Opt%LPRT .and. MasterProc ) + + ! Debug output + IF ( prtDebug ) CALL Debug_Msg( '### MAIN: a READ_INPUT_FILE' ) + + historyConfigFile = 'HISTORY.rc' ! InputOpt not yet initialized + !TMMF need to pass input.geos path + !CALL Init_DiagList( MasterProc, historyConfigFile, Diag_List, RC ) + !IF ( RC /= GC_SUCCESS ) THEN + ! ErrMsg = 'Error encountered in "Init_DiagList"!' + ! CALL Error_Stop( ErrMsg, ThisLoc ) + !ENDIF + + !!### Print diagnostic list if needed for debugging + !IF ( prtDebug ) CALL Print_DiagList( am_I_Root, Diag_List, RC ) + + DO I = BEGCHUNK, ENDCHUNK + am_I_Root = (MasterProc .AND. (I == BEGCHUNK)) + + CALL GC_Init_StateObj( am_I_Root = am_I_Root, & ! Root CPU (Y/N)? + & Diag_List = Diag_List, & ! Diagnostic list obj + & Input_Opt = Input_Opt, & ! Input Options + & State_Chm = State_Chm(I), & ! Chemistry State + & State_Diag = State_Diag(I), & ! Diagnostics State + & State_Grid = State_Grid(I), & ! Grid State + & State_Met = State_Met(I), & ! Meteorology State + & RC = RC ) ! Success or failure + + ! Trap potential errors + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "GC_Init_StateObj"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + ! Start with v/v dry (CAM standard) + State_Chm(I)%Spc_Units = 'v/v dry' + + ENDDO + + ! Now replicate GC_Init_Extra + IF ( Input_Opt%LDryD ) THEN + + ! Setup for dry deposition + CALL Init_Drydep( am_I_Root = MasterProc, & + & Input_Opt = Input_Opt, & + & State_Chm = State_Chm(BEGCHUNK), & + & State_Diag = State_Diag(BEGCHUNK), & + & State_Grid = State_Grid(BEGCHUNK), & + & RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Init_Drydep"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + !============================================================== + ! Get mapping between CESM dry deposited species and the + ! indices of State_Chm%DryDepVel. This needs to be done after + ! Init_Drydep + ! Thibaud M. Fritz - 04 Mar 2020 + !============================================================== + + ALLOCATE(map2GC_dryDep(nddvels), STAT=IERR) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failed to allocate map2GC_dryDep') + + DO N = 1, nddvels + + ! Initialize index to -1 + map2GC_dryDep(N) = -1 + + IF ( drySpc_ndx(N) > 0 ) THEN + + ! Convert to upper case + SpcName = to_upper(drydep_list(N)) + + DO I = 1, State_Chm(BEGCHUNK)%nDryDep + IF ( TRIM( SpcName ) == TRIM( to_upper(depName(I)) ) ) THEN + map2GC_dryDep(N) = nDVZind(I) + EXIT + ENDIF + ENDDO + + ENDIF + + ENDDO + +#if ( OCNDDVEL_MOZART ) + !============================================================== + ! The following line should only be called if we compute + ! velocities over the ocean and ice in a MOZART-like way. + ! Thibaud M. Fritz - 26 Feb 2020 + !============================================================== + + IF ( drydep_method == DD_XLND ) THEN + CALL drydep_inti( MOZART_depvel_lnd_file, & + MOZART_clim_soilw_file, & + MOZART_season_wes_file ) + ELSE + Write(iulog,'(a,a)') ' drydep_method is set to: ', TRIM(drydep_method) + CALL ENDRUN('drydep_method must be DD_XLND to compute dry deposition' // & + ' velocities similarly to MOZART over ocean and ice!') + ENDIF +#endif + + ENDIF + + !================================================================= + ! Call setup routines for wet deposition + ! + ! We need to initialize the wetdep module if either wet + ! deposition or convection is turned on, so that we can do the + ! large-scale and convective scavenging. Also initialize the + ! wetdep module if both wetdep and convection are turned off, + ! but chemistry is turned on. The INIT_WETSCAV routine will also + ! allocate the H2O2s and SO2s arrays that are referenced in the + ! convection code. (bmy, 9/23/15) + !================================================================= + IF ( Input_Opt%LConv .OR. & + Input_Opt%LWetD .OR. & + Input_Opt%LChem ) THEN + CALL Init_WetScav( am_I_Root = MasterProc, & + & Input_Opt = Input_Opt, & + & State_Chm = State_Chm(BEGCHUNK), & + & State_Diag = State_Diag(BEGCHUNK), & + & State_Grid = State_Grid(BEGCHUNK), & + & RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Init_WetScav"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + ENDIF + + !----------------------------------------------------------------- + ! Call SET_VDIFF_VALUES so that we can pass several values from + ! Input_Opt to the vdiff_mod.F90. This replaces the functionality + ! of logical_mod.F and tracer_mod.F.. This has to be called + ! after the input.geos file has been read from disk. + !----------------------------------------------------------------- + !CALL Set_VDiff_Values( am_I_Root = MasterProc, & + !& Input_Opt = Input_Opt, & + !& State_Chm = State_Chm(BEGCHUNK), & + !& RC = RC ) + + !&IF (RC /= GC_SUCCESS) THEN + ! ErrMsg = 'Error encountered in "Set_VDiff_Values"!' + ! CALL Error_Stop( ErrMsg, ThisLoc ) + !ENDIF + + !----------------------------------------------------------------- + ! Initialize the GET_NDEP_MOD for soil NOx deposition (bmy, 6/17/16) + !----------------------------------------------------------------- + !CALL Init_Get_NDep( am_I_Root = MasterProc, & + !& Input_Opt = Input_Opt, & + !& State_Chm = State_Chm(BEGCHUNK), & + !& State_Diag = State_Diag(BEGCHUNK), & + !& RC = RC ) + ! + !IF (RC /= GC_SUCCESS) THEN + ! ErrMsg = 'Error encountered in "Init_Get_NDep"!' + ! CALL Error_Stop( ErrMsg, ThisLoc ) + !ENDIF + + !----------------------------------------------------------------- + ! Initialize "carbon_mod.F" + !----------------------------------------------------------------- + IF ( Input_Opt%LCarb ) THEN + CALL Init_Carbon( am_I_Root = MasterProc, & + & Input_Opt = Input_Opt, & + & State_Chm = State_Chm(BEGCHUNK), & + & State_Diag = State_Diag(BEGCHUNK), & + & State_Grid = State_Grid(BEGCHUNK), & + & RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Init_Carbon"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + ENDIF + + IF ( Input_Opt%LDust ) THEN + CALL Init_Dust( am_I_Root = MasterProc, & + & Input_Opt = Input_Opt, & + & State_Chm = State_Chm(BEGCHUNK), & + & State_Diag = State_Diag(BEGCHUNK), & + & State_Grid = State_Grid(BEGCHUNK), & + & RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Init_Dust"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + ENDIF + + IF ( Input_Opt%LSSalt ) THEN + CALL Init_Seasalt( am_I_Root = MasterProc, & + & Input_Opt = Input_Opt, & + & State_Chm = State_Chm(BEGCHUNK), & + & State_Diag = State_Diag(BEGCHUNK), & + & State_Grid = State_Grid(BEGCHUNK), & + & RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Init_Seasalt"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + ENDIF + + IF ( Input_Opt%LSulf ) THEN + CALL Init_Sulfate( am_I_Root = MasterProc, & + & Input_Opt = Input_Opt, & + & State_Chm = State_Chm(BEGCHUNK), & + & State_Diag = State_Diag(BEGCHUNK), & + & State_Grid = State_Grid(BEGCHUNK), & + & RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Init_Sulfate"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + ENDIF + + IF ( Input_Opt%LSulf .OR. & + Input_Opt%LCarb .OR. & + Input_Opt%LDust .OR. & + Input_Opt%LSSalt ) THEN + CALL Init_Aerosol( am_I_Root = MasterProc, & + & Input_Opt = Input_Opt, & + & State_Chm = State_Chm(BEGCHUNK), & + & State_Diag = State_Diag(BEGCHUNK), & + & State_Grid = State_Grid(BEGCHUNK), & + & RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Init_Aerosol"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + ENDIF + + IF ( Input_Opt%LChem ) THEN + CALL Init_Toms( am_I_Root = MasterProc, & + & Input_Opt = Input_Opt, & + & State_Chm = State_Chm(BEGCHUNK), & + & State_Diag = State_Diag(BEGCHUNK), & + & State_Grid = State_Grid(BEGCHUNK), & + & RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Init_TOMS"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + ENDIF + + ! This is a bare subroutine - no module + CALL NDXX_Setup( MasterProc, & + & Input_Opt, & + & State_Chm(BEGCHUNK), & + & State_Grid(BEGCHUNK), & + & RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Init_NDXX_Setup"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + CALL Init_PBL_Mix( am_I_Root = MasterProc, & + State_Grid = State_Grid(BEGCHUNK), & + RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Init_PBL_Mix"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + ! Set grid-cell area + DO I = BEGCHUNK, ENDCHUNK + ALLOCATE(Col_Area(NCOL(I)), STAT=IERR) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating Col_Area') + + CALL Get_Area_All_p(I, NCOL(I), Col_Area) + + ! Set default value (in case of chunks with fewer columns) + State_Grid(I)%Area_M2 = 1.0e+10_fp + DO iX = 1, nX + DO jY = 1, NCOL(I) + State_Grid(I)%Area_M2(iX,jY) = REAL(Col_Area(jY) * Re**2,fp) + ENDDO + ENDDO + + DEALLOCATE(Col_Area) + + ! Copy to State_Met(I)%Area_M2 + State_Met(I)%Area_M2 = State_Grid(I)%Area_M2 + ENDDO + + + ! Initialize (mostly unused) diagnostic arrays + ! WARNING: This routine likely calls on modules which are currently + ! excluded from the GC-CESM build (eg diag03) + ! CALL Initialize( MasterProc, Input_Opt, 2, RC ) + ! CALL Initialize( Masterproc, Input_Opt, 3, RC ) + + ! Get Ap and Bp from CAM at pressure edges + ALLOCATE(Ap_CAM_Flip(nZ+1), STAT=IERR) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating Ap_CAM_Flip') + ALLOCATE(Bp_CAM_Flip(nZ+1), STAT=IERR) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating Bp_CAM_Flip') + + Ap_CAM_Flip = 0.0e+0_fp + Bp_CAM_Flip = 0.0e+0_fp + DO I = 1, (nZ+1) + Ap_CAM_Flip(I) = hyai(nZ+2-I) * ps0 * 0.01e+0_r8 + Bp_CAM_Flip(I) = hybi(nZ+2-I) + ENDDO + + !----------------------------------------------------------------- + ! Initialize the hybrid pressure module. Define Ap and Bp. + !----------------------------------------------------------------- + CALL Init_Pressure( am_I_Root = MasterProc, & ! Root CPU (Y/N)? + State_Grid = State_Grid(BEGCHUNK), & ! Grid State + RC = RC ) ! Success or failure + + ! Trapping errors + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Init_Pressure"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + !----------------------------------------------------------------- + ! Pass external Ap and Bp to GEOS-Chem's Pressure_Mod + !----------------------------------------------------------------- + CALL Accept_External_ApBp( am_I_Root = MasterProc, & ! Root CPU (Y/N)? + State_Grid = State_Grid(BEGCHUNK), & ! Grid State + ApIn = Ap_CAM_Flip, & ! "A" term for hybrid grid + BpIn = Bp_CAM_Flip, & ! "B" term for hybrid grid + RC = RC ) ! Success or failure + + ! Print vertical coordinates + IF ( MasterProc ) THEN + WRITE( 6, '(a)' ) REPEAT( '=', 79 ) + WRITE( 6, '(a,/)' ) 'V E R T I C A L G R I D S E T U P' + WRITE( 6, '( ''Ap '', /, 6(f11.6,1x) )' ) Ap_CAM_Flip(1:State_Grid(BEGCHUNK)%NZ+1) + WRITE( 6, '(a)' ) + WRITE( 6, '( ''Bp '', /, 6(f11.6,1x) )' ) Bp_CAM_Flip(1:State_Grid(BEGCHUNK)%NZ+1) + WRITE( 6, '(a)' ) REPEAT( '=', 79 ) + ENDIF + + ! Trapping errors + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Accept_External_ApBp"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + DEALLOCATE(Ap_CAM_Flip,Bp_CAM_Flip) + + !! Initialize HEMCO? + !CALL Emissions_Init ( am_I_Root = MasterProc, & + ! Input_Opt = Input_Opt, & + ! State_Met = State_Met, & + ! State_Chm = State_Chm, & + ! State_Grid = State_Grid, & + ! State_Met = State_Met, & + ! RC = RC, & + ! HcoConfig = HcoConfig ) + ! + !IF ( RC /= GC_SUCCESS ) THEN + ! ErrMsg = 'Error encountered in "Emissions_Init"!' + ! CALL Error_Stop( ErrMsg, ThisLoc ) + !ENDIF + ! + +#if ( ALLDDVEL_GEOSCHEM && LANDTYPE_HEMCO ) + ! Populate the State_Met%LandTypeFrac field with data from HEMCO + CALL Init_LandTypeFrac( am_I_Root = MasterProc, & + Input_Opt = Input_Opt, & + State_Met = State_Met(BEGCHUNK), & + RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Init_LandTypeFrac"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + ! Compute the Olson landmap fields of State_Met + ! (e.g. State_Met%IREG, State_Met%ILAND, etc.) + CALL Compute_Olson_Landmap( am_I_Root = MasterProc, & + Input_Opt = Input_Opt, & + State_Grid = State_Grid(BEGCHUNK), & + State_Met = State_Met(BEGCHUNK), & + RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Compute_Olson_Landmap"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF +#endif + + ! Initialize PBL quantities but do not do mixing + ! Add option for non-local PBL (Lin, 03/31/09) + CALL Init_Mixing ( am_I_Root = MasterProc, & + Input_Opt = Input_Opt, & + State_Chm = State_Chm(BEGCHUNK), & + State_Diag = State_Diag(BEGCHUNK), & + State_Grid = State_Grid(BEGCHUNK), & + State_Met = State_Met(BEGCHUNK), & + RC = RC ) + + ! Trap potential errors + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in Init_Mixing!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + IF ( Input_Opt%Its_A_FullChem_Sim .OR. & + Input_Opt%Its_An_Aerosol_Sim ) THEN + ! This also initializes Fast-JX + CALL Init_Chemistry( am_I_Root = MasterProc, & + & Input_Opt = Input_Opt, & + & State_Chm = State_Chm(BEGCHUNK), & + & State_Diag = State_Diag(BEGCHUNK), & + & State_Grid = State_Grid(BEGCHUNK), & + & RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Init_Chemistry"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + ENDIF + + IF ( Input_Opt%LChem .AND. & + Input_Opt%LUCX ) THEN + CALL Init_UCX( am_I_Root = MasterProc, & + & Input_Opt = Input_Opt, & + & State_Chm = State_Chm(BEGCHUNK), & + & State_Diag = State_Diag(BEGCHUNK), & + & State_Grid = State_Grid(BEGCHUNK) ) + ENDIF + + ! Get the index of H2O + iH2O = Ind_('H2O') + iO3 = Ind_('O3') + iCH4 = Ind_('CH4') + iCO = Ind_('CO') + iNO = Ind_('NO') + + ! Get indices for physical fields in physics buffer + NDX_PBLH = Pbuf_Get_Index('pblh' ) + NDX_FSDS = Pbuf_Get_Index('FSDS' ) + NDX_CLDTOP = Pbuf_Get_Index('CLDTOP' ) + NDX_CLDFRC = Pbuf_Get_Index('CLD' ) + NDX_PRAIN = Pbuf_Get_Index('PRAIN' ) + NDX_NEVAPR = Pbuf_Get_Index('NEVAPR' ) + NDX_RPRDTOT = Pbuf_Get_Index('RPRDTOT' ) + NDX_LSFLXPRC = Pbuf_Get_Index('LS_FLXPRC') + NDX_LSFLXSNW = Pbuf_Get_Index('LS_FLXSNW') + + ! Get cloud water indices + CALL Cnst_Get_Ind('CLDLIQ', ixCldLiq) + CALL Cnst_Get_Ind('CLDICE', ixCldIce) + + ! Can add history output here too with the "addfld" & "add_default" routines + ! Note that constituents are already output by default + ! Add all species as output fields if desired + DO I = 1, nTracers + SpcName = TRIM(tracerNames(I)) + CALL AddFld( TRIM(SpcName), (/ 'lev' /), 'A', 'mol/mol', TRIM(tracerLongNames(I))//' concentration') + IF (TRIM(SpcName) == 'O3') THEN + CALL Add_Default ( TRIM(SpcName), 1, ' ') + ENDIF + ENDDO + DO I =1, nSls + SpcName = TRIM(slsNames(I)) + CALL AddFld( TRIM(SpcName), (/ 'lev' /), 'A', 'mol/mol', TRIM(slsLongNames(I))//' concentration') + !CALL Add_Default(TRIM(SpcName), 1, '') + ENDDO + + ! Initialize emissions interface (this will eventually handle HEMCO) + CALL GC_Emissions_Init + + !CALL AddFld ( 'BCPI', (/'lev'/), 'A', 'mole/mole', trim('BCPI')//' mixing ratio' ) + !CALL Add_Default ( 'BCPI', 1, ' ') + +#if defined( CLM40 ) + SpcName = 'lu_soil' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'lu_landice' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'lu_deeplake' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'lu_shallowlake' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'lu_wetland' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'lu_urban' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'lu_icemec' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'lu_crop' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') +#elif defined( CLM45 ) || defined( CLM50 ) + SpcName = 'lu_soil' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'lu_crop' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'lu_landice' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'lu_deeplake' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'lu_wetland' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'lu_urban' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') +#endif + SpcName = 'p_notveg' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_needle_eg_temp' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_needle_eg_bor' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_needle_dd_bor' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_broad_eg_trop' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_broad_eg_temp' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_broad_dd_trop' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_broad_dd_temp' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_broad_dd_bor' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_broad_eg_sh' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_broad_dd_temp_sh' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_broad_dd_bor_sh' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_c3_arctic_grass' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_c3_narctic_grass' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_c4_grass' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_c3_crop' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_c3_irrigated' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') +#if defined( CLM40 ) + SpcName = 'p_c3_corn' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_spring_cereal' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_winter_cereal' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_soybean' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') +#elif defined( CLM45 ) || defined( CLM50 ) + SpcName = 'p_temp_corn' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_irr_temp_corn' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_spring_wheat' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_irr_spring_wheat' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_winter_wheat' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_irr_winter_wheat' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_temp_soybean' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_irr_temp_soybean' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_barley' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_irr_barley' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_winter_barley' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_irr_winter_barley' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_rye' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_irr_rye' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_winter_rye' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_irr_winter_rye' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_cassava' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_irr_cassava' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_citrus' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_irr_citrus' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_cocoa' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_irr_cocoa' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_coffee' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_irr_coffee' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_cotton' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_irr_cotton' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_datepalm' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_irr_datepalm' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_foddergrass' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_irr_foddergrass' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_grapes' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_irr_grapes' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_groundnuts' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_irr_groundnuts' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_millet' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_irr_millet' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_oilpalm' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_irr_oilpalm' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_potatoes' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_irr_potatoes' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_pulses' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_irr_pulses' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_rapeseed' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_irr_rapessed' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_rice' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_irr_rice' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_sorghum' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_irr_sorghum' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_sugarbeet' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_irr_sugarbeet' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_sugarcane' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_irr_sugarcane' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_sunflower' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_irr_sunflower' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_miscanthus' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_irr_miscanthus' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_switchgrass' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_irr_switchgrass' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_trop_corn' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_irr_trop_corn' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_trop_soybean' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'p_irr_trop_soybean' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') +#endif + SpcName = 'pla_notveg' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_needle_eg_temp' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_needle_eg_bor' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_needle_dd_bor' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_broad_eg_trop' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_broad_eg_temp' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_broad_dd_trop' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_broad_dd_temp' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_broad_dd_bor' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_broad_eg_sh' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_broad_dd_temp_sh' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_broad_dd_bor_sh' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_c3_arctic_grass' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_c3_narctic_grass' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_c4_grass' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_c3_crop' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_c3_irrigated' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') +#if defined( CLM40 ) + SpcName = 'pla_c3_corn' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_spring_cereal' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_winter_cereal' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_soybean' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') +#elif defined( CLM45 ) || defined( CLM50 ) + SpcName = 'pla_temp_corn' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_irr_temp_corn' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_spring_wheat' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_irr_spring_wheat' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_winter_wheat' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_irr_winter_wheat' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_temp_soybean' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_irr_temp_soybean' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_barley' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_irr_barley' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_winter_barley' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_irr_winter_barley' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_rye' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_irr_rye' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_winter_rye' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_irr_winter_rye' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_cassava' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_irr_cassava' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_citrus' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_irr_citrus' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_cocoa' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_irr_cocoa' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_coffee' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_irr_coffee' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_cotton' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_irr_cotton' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_datepalm' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_irr_datepalm' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_foddergrass' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_irr_foddergrass' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_grapes' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_irr_grapes' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_groundnuts' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_irr_groundnuts' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_millet' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_irr_millet' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_oilpalm' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_irr_oilpalm' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_potatoes' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_irr_potatoes' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_pulses' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_irr_pulses' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_rapeseed' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_irr_rapessed' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_rice' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_irr_rice' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_sorghum' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_irr_sorghum' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_sugarbeet' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_irr_sugarbeet' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_sugarcane' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_irr_sugarcane' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_sunflower' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_irr_sunflower' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_miscanthus' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_irr_miscanthus' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_switchgrass' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_irr_switchgrass' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_trop_corn' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_irr_trop_corn' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_trop_soybean' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') + SpcName = 'pla_irr_trop_soybean' + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') +#endif + + IF (MasterProc) WRITE(iulog,'(a)') 'GCCALL CHEM_INIT' + + end subroutine chem_init + +!=============================================================================== + + subroutine chem_timestep_init(phys_state, pbuf2d) + use physics_buffer, only: physics_buffer_desc + + TYPE(physics_state), INTENT(IN):: phys_state(begchunk:endchunk) + TYPE(physics_buffer_desc), POINTER :: pbuf2d(:,:) + + ! Not sure what we would realistically do here rather than in tend + + end subroutine chem_timestep_init + +!=============================================================================== + + subroutine GC_Update_Timesteps(DT) + + use Time_Mod, only : Set_Timesteps + + REAL(r8), INTENT(IN) :: DT + INTEGER :: DT_MIN + INTEGER, SAVE :: DT_MIN_LAST = -1 + + DT_MIN = NINT(DT) + + Input_Opt%TS_CHEM = DT_MIN + Input_Opt%TS_EMIS = DT_MIN + Input_Opt%TS_CONV = DT_MIN + Input_Opt%TS_DYN = DT_MIN + Input_Opt%TS_RAD = DT_MIN + + ! Only bother updating the module information if there's been a change + IF (DT_MIN .NE. DT_MIN_LAST) THEN + IF (MasterProc) WRITE(iulog,'(a,F7.1,a)') ' --> GC: updating dt to ', DT, ' seconds' + + CALL Set_Timesteps( MasterProc, & + CHEMISTRY = DT_MIN, & + EMISSION = DT_MIN, & + DYNAMICS = DT_MIN, & + UNIT_CONV = DT_MIN, & + CONVECTION = DT_MIN, & + DIAGNOS = DT_MIN, & + RADIATION = DT_MIN ) + DT_MIN_LAST = DT_MIN + ENDIF + + end subroutine + +!=============================================================================== + + subroutine chem_timestep_tend( State, ptend, cam_in, cam_out, dT, pbuf, fh2o ) + + use physics_buffer, only: physics_buffer_desc, pbuf_get_field, pbuf_old_tim_idx + use cam_history, only: outfld + use camsrfexch, only: cam_in_t, cam_out_t + + use phys_grid, only: get_ncols_p, get_rlat_all_p, get_rlon_all_p + + use chem_mods, only: drySpc_ndx, map2GC_dryDep +#if ( LANDTYPE_CLM ) + use Olson_Landmap_Mod, only: Compute_Olson_Landmap + use Modis_LAI_Mod, only: Compute_XLAI +#endif +#if ( ALLDDVEL_GEOSCHEM || OCNDDVEL_GEOSCHEM ) + use Drydep_Mod, only: Do_Drydep +#elif ( OCNDDVEL_MOZART ) + use mo_drydep, only: drydep_update, drydep_fromlnd +#endif + use Drydep_Mod, only: DEPNAME !TMMF, this is just needed for debug + use Drydep_Mod, only: Update_DryDepSav + use Mixing_Mod + + use Dao_Mod, only: Set_Dry_Surface_Pressure + use Dao_Mod, only: AirQnt + use GC_Grid_Mod, only: SetGridFromCtr + use Pressure_Mod, only: Set_Floating_Pressures + use Pressure_Mod, only: Accept_External_Pedge + use Time_Mod, only: Accept_External_Date_Time + use Strat_chem_Mod, only: Init_Strat_Chem + use Toms_Mod, only: Compute_Overhead_O3 + use Chemistry_Mod, only: Do_Chemistry + use Wetscav_Mod, only: Setup_Wetscav, Do_WetDep + use CMN_Size_Mod, only: PTop + use PBL_Mix_Mod, only: Compute_PBL_Height + + use Tropopause, only: Tropopause_findChemTrop, Tropopause_Find + + ! For calculating SZA + use Orbit, only: zenith + use Time_Manager, only: Get_Curr_Calday, Get_Curr_Date + + ! Calculating relative humidity + use WV_Saturation, only: QSat + use PhysConst, only: MWDry + + ! Grid area + use PhysConst, only: Gravit + use PhysConstants, only: Re + use Phys_Grid, only: get_area_all_p, get_lat_all_p, get_lon_all_p + + use Short_Lived_Species, only : Get_Short_Lived_Species + use Short_Lived_Species, only : Set_Short_Lived_Species + + ! Use GEOS-Chem versions of physical constants + use PhysConstants, only: PI, PI_180, g0 + + REAL(r8), INTENT(IN) :: dT ! Time step + TYPE(physics_state), INTENT(IN) :: State ! Physics State variables + TYPE(physics_ptend), INTENT(OUT) :: ptend ! indivdual parameterization tendencies + TYPE(cam_in_t), INTENT(INOUT) :: cam_in + TYPE(cam_out_t), INTENT(IN) :: cam_out + TYPE(physics_buffer_desc), POINTER :: pbuf(:) + REAL(r8), OPTIONAL, INTENT(OUT) :: fh2o(PCOLS) ! h2o flux to balance source from chemistry + + ! Initial MMR for all species + REAL(r8) :: MMR_Beg(PCOLS,PVER,nSls+nTracers) + REAL(r8) :: MMR_End(PCOLS,PVER,nSls+nTracers) + REAL(r8) :: MMR_TEnd(PCOLS,PVER,nSls+nTracers) + + + ! Mapping (?) + LOGICAL :: lq(pcnst) + + ! Indexing + INTEGER :: I, J, K, L, N, M + INTEGER :: nX, nY, nZ + + INTEGER :: LCHNK, NCOL + + REAL(r8), DIMENSION(State%NCOL) :: & + CSZA, & ! Cosine of solar zenith angle + Zsurf, & ! Surface height + Rlats, Rlons ! Chunk latitudes and longitudes (radians) + + REAL(r8), POINTER :: PblH(:) ! PBL height on each chunk [m] + REAL(r8), POINTER :: cldTop(:) ! Cloud top height [?] + REAL(r8), POINTER :: cldFrc(:,:) ! Cloud fraction [-] + REAL(r8), POINTER :: Fsds(:) ! Downward shortwave flux at surface [W/m2] + REAL(r8), POINTER :: PRain(:,:) ! Total stratiform precip. prod. (rain + snow) [kg/kg/s] + REAL(r8), POINTER :: RprdTot(:,:) ! Total convective precip. prod. (rain + snow) [kg/kg/s] + REAL(r8), POINTER :: NEvapr(:,:) ! Evaporation of total precipitation (rain + snow) [kg/kg/s] + REAL(r8), POINTER :: LsFlxPrc(:,:) ! Large-scale downward precip. flux at interface (rain + snow) [kg/m2/s] + REAL(r8), POINTER :: LsFlxSnw(:,:) ! Large-scale downward precip. flux at interface (snow only) [kg/m2/s] + + REAL(r8) :: RelHum(State%NCOL, PVER) ! Relative humidity [0-1] + REAL(r8) :: SatV (State%NCOL, PVER) ! Work arrays + REAL(r8) :: SatQ (State%NCOL, PVER) ! Work arrays + REAL(r8) :: qH2O (State%NCOL, PVER) ! Specific humidity [kg/kg] + REAL(r8) :: H2OVMR(State%NCOL, PVER) ! H2O volume mixing ratio +#if ( OCNDDVEL_MOZART ) + REAL(r8) :: windSpeed(State%NCOL) ! Wind speed at ground level [m/s] + REAL(r8) :: potT(State%NCOL) ! Potential temperature [K] + + INTEGER :: latndx(PCOLS) + INTEGER :: lonndx(PCOLS) + + ! For MOZART's dry deposition over ocean and ice + ! Deposition velocity (cm/s) + REAL(r8) :: MOZART_depVel(State%NCOL, nTracersMax) + ! Deposition flux (/cm^2/s) + REAL(r8) :: MOZART_depFlx(State%NCOL, nTracersMax) +#endif + REAL(r8), PARAMETER :: zlnd = 0.01_r8 ! Roughness length for soil [m] + REAL(r8), PARAMETER :: zslnd = 0.0024_r8 ! Roughness length for snow [m] + REAL(r8), PARAMETER :: zsice = 0.0400_r8 ! Roughness length for sea ice [m] + REAL(r8), PARAMETER :: zocn = 0.0001_r8 ! Roughness length for oean [m] + + ! Because of strat chem + LOGICAL, SAVE :: SCHEM_READY = .FALSE. + + REAL(f4) :: lonMidArr(1,PCOLS), latMidArr(1,PCOLS) + INTEGER :: iMaxLoc(1) + + REAL(r8) :: Col_Area(State%NCOL) + + ! Intermediate arrays + INTEGER :: Trop_Lev (PCOLS) + REAL(r8) :: Trop_P (PCOLS) + REAL(r8) :: Trop_T (PCOLS) + REAL(r8) :: Trop_Ht (PCOLS) + REAL(r8) :: SnowDepth(PCOLS) + REAL(r8) :: cld2D (PCOLS) + REAL(r8) :: Z0 (PCOLS) + REAL(r8) :: Sd_Ice, Sd_Lnd, Sd_Avg, Frc_Ice + + ! Estimating cloud optical depth + REAL(r8) :: cld(PCOLS,PVER) + REAL(r8) :: TauCli(PCOLS,PVER) + REAL(r8) :: TauClw(PCOLS,PVER) + REAL(r8), PARAMETER :: re_m = 1.0e-05_r8 ! Cloud drop radius in m + REAL(r8), PARAMETER :: cldMin = 1.0e-02_r8 ! Minimum cloud cover + REAL(r8), PARAMETER :: cnst = 1.5e+00_r8 / (re_m * 1.0e+03_r8 * g0) + + ! Calculating SZA + REAL(r8) :: Calday + + ! For archiving + CHARACTER(LEN=255) :: SpcName + REAL(r8) :: VMR(State%NCOL,PVER) + + REAL(r8) :: SlsData(State%NCOL, PVER, nSls) + + INTEGER :: currYr, currMo, currDy, currTOD + INTEGER :: currYMD, currHMS, currHr, currMn, currSc + REAL(f4) :: currUTC + LOGICAL :: firstDay = .True. + LOGICAL :: newDay = .False. + LOGICAL :: newMonth = .False. + + INTEGER :: TIM_NDX + + INTEGER, SAVE :: iStep = 0 + LOGICAL :: rootChunk + INTEGER :: RC + + ! LCHNK: which chunk we have on this process + LCHNK = State%LCHNK + ! NCOL: number of atmospheric columns on this chunk + NCOL = State%NCOL + + ! Am I the first chunk on the first CPU? + rootChunk = ( MasterProc.and.(LCHNK==BEGCHUNK) ) + + ! Count the number of steps which have passed + IF (LCHNK.EQ.BEGCHUNK) iStep = iStep + 1 + + ! Need to update the timesteps throughout the code + CALL GC_Update_Timesteps(dT) + + + ! For safety's sake + PTop = State%Pint(1,1)*0.01e+0_fp + + ! Need to be super careful that the module arrays are updated and correctly + ! set. NOTE: First thing - you'll need to flip all the data vertically + + nX = 1 + nY = NCOL + nZ = PVER + + ! Update the grid lat/lons since they are module variables + ! Assume (!) that area hasn't changed for now, as GEOS-Chem will + ! retrieve this from State_Met which is chunked + !CALL get_rlat_all_p( LCHNK, NCOL, Rlats ) + !CALL get_rlon_all_p( LCHNK, NCOL, Rlons ) + Rlats(1:nY) = State%Lat(1:nY) + Rlons(1:nY) = State%Lon(1:nY) + + lonMidArr = 0.0e+0_f4 + latMidArr = 0.0e+0_f4 + DO I = 1, nX + DO J = 1, nY + lonMidArr(I,J) = REAL(Rlons(J), f4) + latMidArr(I,J) = REAL(Rlats(J), f4) + ENDDO + ENDDO + + ! Update the grid + Call SetGridFromCtr( am_I_Root = rootChunk, & + State_Grid = State_Grid(LCHNK), & + lonCtr = lonMidArr, & + latCtr = latMidArr, & + RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered within call to "SetGridFromCtr"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + ! Set area + CALL Get_Area_All_p( LCHNK, nY, Col_Area ) + + ! Field : AREA_M2 + ! Description: Grid box surface area + ! Unit : - + ! Dimensions : nX, nY + ! Note : Set default value (in case of chunks with fewer columns) + State_Grid(LCHNK)%Area_M2 = 1.0e+10_fp + DO J = 1, nY + State_Grid(LCHNK)%Area_M2(1,J) = REAL(Col_Area(J) * Re**2,fp) + ENDDO + State_Met(LCHNK)%Area_M2 = State_Grid(LCHNK)%Area_M2 + + ! 2. Copy tracers into State_Chm + ! Data was received in kg/kg dry + State_Chm(LCHNK)%Spc_Units = 'kg/kg dry' + ! Initialize ALL State_Chm species data to zero, not just tracers + State_Chm(LCHNK)%Species = 0.0e+0_fp + + lq(:) = .FALSE. + + MMR_Beg = 0.0e+0_r8 + DO N = 1, pcnst + M = map2GC(N) + IF (M > 0) THEN + I = 1 + DO J = 1, nY + DO K = 1, nZ + ! CURRENTLY KG/KG DRY + MMR_Beg(J,K,M) = State%q(J,nZ+1-K,N) + State_Chm(LCHNK)%Species(1,J,K,M) = REAL(MMR_Beg(J,K,M),fp) + ENDDO + ENDDO + lq(N) = .TRUE. + ENDIF + ENDDO + + ! Retrieve previous value of species data + SlsData(:,:,:) = 0.0e+0_r8 + CALL Get_Short_Lived_Species( SlsData, LCHNK, nY, Pbuf ) + + ! Remap and flip them + DO N = 1, nSls + M = map2GC_Sls(N) + IF (M > 0) THEN + DO J = 1, nY + DO K = 1, nZ + State_Chm(LCHNK)%Species(1,J,K,M) = REAL(SlsData(J,nZ+1-K,N),fp) + ENDDO + ENDDO + ENDIF + ENDDO + + ! Initialize tendency array + CALL Physics_ptend_init(ptend, State%psetcols, 'chemistry', lq=lq) + + ! Calculate COS(SZA) + Calday = Get_Curr_Calday( ) + CALL Zenith( Calday, Rlats, Rlons, CSZA, nY ) + + ! Get all required data from physics buffer + TIM_NDX = Pbuf_Old_Tim_Idx() + CALL Pbuf_Get_Field( Pbuf, NDX_PBLH, PblH ) + CALL Pbuf_Get_Field( Pbuf, NDX_FSDS, Fsds ) + CALL Pbuf_Get_Field( Pbuf, NDX_CLDTOP, cldTop ) + CALL Pbuf_Get_Field( Pbuf, NDX_CLDFRC, cldFrc, START=(/1,1,TIM_NDX/), KOUNT=(/NCOL,PVER,1/) ) + CALL Pbuf_Get_Field( Pbuf, NDX_NEVAPR, NEvapr, START=(/1,1/), KOUNT=(/NCOL,PVER/)) + CALL Pbuf_Get_Field( Pbuf, NDX_PRAIN, PRain, START=(/1,1/), KOUNT=(/NCOL,PVER/)) + CALL Pbuf_Get_Field( Pbuf, NDX_RPRDTOT, RprdTot, START=(/1,1/), KOUNT=(/NCOL,PVER/)) + CALL Pbuf_Get_Field( Pbuf, NDX_LSFLXPRC, LsFlxPrc, START=(/1,1/), KOUNT=(/NCOL,PVERP/)) + CALL Pbuf_Get_Field( Pbuf, NDX_LSFLXSNW, LsFlxSnw, START=(/1,1/), KOUNT=(/NCOL,PVERP/)) + + ! Get VMR and MMR of H2O + H2OVMR = 0.0e0_fp + qH2O = 0.0e0_fp + ! Note MWDRY = 28.966 g/mol + DO J = 1, nY + DO L = 1, nZ + qH2O(J,L) = REAL(State_Chm(LCHNK)%Species(1,J,L,iH2O),r8) + H2OVMR(J,L) = qH2O(J,L) * MWDry / 18.016e+0_fp + ENDDO + ENDDO + + ! Calculate RH (range 0-1, note still level 1 = TOA) + relHum(:,:) = 0.0e+0_r8 + CALL QSat(State%T(:nY,:), State%Pmid(:nY,:), SatV, SatQ) + DO J = 1, nY + DO L = 1, nZ + relHum(J,L) = 0.622e+0_r8 * H2OVMR(J,L) / SatQ(J,L) + relHum(J,L) = MAX( 0.0e+0_r8, MIN( 1.0e+0_r8, relHum(J,L) ) ) + ENDDO + ENDDO + + Z0 = 0.0e+0_r8 + DO J = 1, nY + Z0(J) = cam_in%landFrac(J) * zlnd & + + cam_in%iceFrac(J) * zsice & + + cam_in%ocnFrac(J) * zocn + IF (( cam_in%snowhLand(J) > 0.01_r8 ) .OR. & + ( cam_in%snowhIce(J) > 0.01_r8 )) THEN + ! Land is covered in snow + Z0(J) = zslnd + ENDIF + ENDDO + + ! Estimate cloud liquid water content and OD + TauCli = 0.0e+0_r8 + TauClw = 0.0e+0_r8 + + ! Note: all using CAM vertical convention (1 = TOA) + ! Calculation is based on that done for MOZART + DO J = 1, nY + DO L = nZ, 1, -1 + ! Convert water mixing ratio [kg/kg] to water content [g/m^3] + IF ( ( State%Q(J,L,ixCldLiq) + State%Q(J,L,ixCldIce) ) * & + State%PMid(J,L) / (State%T(J,L) * 287.0e+00_r8) * 1.0e+03_r8 <= 0.01_r8 .AND. & + cldFrc(J,L) /= 0.0e+00_r8 ) THEN + cld(J,L) = 0.0e+00_r8 + ELSE + cld(J,L) = cldFrc(J,L) + ENDIF + ENDDO + ENDDO + + DO J = 1, nY + IF ( COUNT( cld(J,:nZ) > cldMin ) > 0 ) THEN + DO L = nZ, 1, -1 + ! ================================================================= + ! =========== Compute cloud optical depth based on ============ + ! =========== Liao et al. JGR, 104, 23697, 1999 ============ + ! ================================================================= + ! + ! Tau = 3/2 * LWC * dZ / ( \rho_w * r_e ) + ! dZ = - dP / ( \rho_air * g ) + ! since Pint is ascending, we can neglect the minus sign + ! + ! Tau = 3/2 * LWC * dP / ( \rho_air * r_e * \rho_w * g ) + ! LWC / \rho_air = Q + ! + ! Tau = 3/2 * Q * dP / ( r_e * rho_w * g ) + ! Tau(K) = 3/2 * Q(K) * (Pint(K+1) - Pint(K)) / (re * rho_w * g ) + ! Tau(K) = Q(K) * (Pint(K+1) - Pint(K)) * Cnst + ! + ! Unit check: | + ! Q : [kg H2O/kg air] | + ! Pint : [Pa]=[kg air/m/s^2] | + ! re : [m] | = 1.0e-5 + ! rho_w: [kg H2O/m^3] | = 1.0e+3 + ! g : [m/s^2] | = 9.81 + ! + TauClw(J,L) = State%Q(J,L,ixCldLiq) & + * (State%Pint(J,L+1)-State%Pint(J,L)) & + * cnst + TauClw(J,L) = MAX(TauClw(J,L), 0.0e+00_r8) + TauCli(J,L) = State%Q(J,L,ixCldIce) & + * (State%Pint(J,L+1)-State%Pint(J,L)) & + * cnst + TauCli(J,L) = MAX(TauCli(J,L), 0.0e+00_r8) + + ENDDO + ENDIF + ENDDO + + ! Retrieve tropopause level + Trop_Lev = 0.0e+0_r8 + CALL Tropopause_FindChemTrop(State, Trop_Lev) + ! Back out the pressure + Trop_P = 1000.0e+0_r8 + DO J = 1, nY + Trop_P(J) = State%PMid(J,Trop_Lev(J)) * 0.01e+0_r8 + ENDDO + + ! Calculate snow depth + snowDepth = 0.0e+0_r8 + DO J = 1, nY + Sd_Ice = MAX(0.0e+0_r8,cam_in%snowhIce(J)) + Sd_Lnd = MAX(0.0e+0_r8,cam_in%snowhLand(J)) + Frc_Ice = MAX(0.0e+0_r8,cam_in%iceFrac(J)) + IF (Frc_Ice > 0.0e+0_r8) THEN + Sd_Avg = (Sd_Lnd*(1.0e+0_r8 - Frc_Ice)) + (Sd_Ice * Frc_Ice) + ELSE + Sd_Avg = Sd_Lnd + ENDIF + snowDepth(J) = Sd_Avg + ENDDO + + ! Field : ALBD + ! Description: Visible surface albedo + ! Unit : - + ! Dimensions : nX, nY + State_Met(LCHNK)%ALBD (1,:) = cam_in%Asdir(:) + + ! Field : CLDFRC + ! Description: Column cloud fraction + ! Unit : - + ! Dimensions : nX, nY + ! Note : Estimate column cloud fraction as the maximum cloud + ! fraction in the column (pessimistic assumption) + DO J = 1, nY + State_Met(LCHNK)%CLDFRC(1,J) = MAXVAL(cldFrc(J,:)) + ENDDO + + ! Field : EFLUX, HFLUX + ! Description: Latent heat flux, sensible heat flux + ! Unit : W/m^2 + ! Dimensions : nX, nY + State_Met(LCHNK)%EFLUX (1,:) = cam_in%Lhf(:) + State_Met(LCHNK)%HFLUX (1,:) = cam_in%Shf(:) + + ! Field : LandTypeFrac + ! Description: Olson fraction per type + ! Unit : - (between 0 and 1) + ! Dimensions : nX, nY, NSURFTYPE + ! Note : Index 1 is water +#if ( LANDTYPE_CLM ) + ! Fill in water + State_Met(LCHNK)%LandTypeFrac(1,:, 1) = cam_in%ocnFrac(:) & + + cam_in%iceFrac(:) +#if ( ALLDDVEL_GEOSCHEM ) + CALL getLandTypes( cam_in, & + nY, & + State_Met(LCHNK) ) +#endif +#endif + + ! Field : FRCLND, FRLAND, FROCEAN, FRSEAICE, FRLAKE, FRLANDIC + ! Description: Olson land fraction + ! Fraction of land + ! Fraction of ocean + ! Fraction of sea ice + ! Fraction of lake + ! Fraction of land ice + ! Fraction of snow + ! Unit : - + ! Dimensions : nX, nY + State_Met(LCHNK)%FRCLND (1,:) = 1.e+0_fp - & + State_Met(LCHNK)%LandTypeFrac(1,:,1) ! Olson Land Fraction + State_Met(LCHNK)%FRLAND (1,:) = cam_in%landFrac(:) + State_Met(LCHNK)%FROCEAN (1,:) = cam_in%ocnFrac(:) + cam_in%iceFrac(:) + State_Met(LCHNK)%FRSEAICE (1,:) = cam_in%iceFrac(:) +#if ( LANDTYPE_CLM ) + State_Met(LCHNK)%FRLAKE (1,:) = cam_in%lwtgcell(:,3) + & + cam_in%lwtgcell(:,4) + State_Met(LCHNK)%FRLANDIC (1,:) = cam_in%lwtgcell(:,2) + State_Met(LCHNK)%FRSNO (1,:) = 0.0e+0_fp +#else + State_Met(LCHNK)%FRLAKE (1,:) = 0.0e+0_fp + State_Met(LCHNK)%FRLANDIC (1,:) = 0.0e+0_fp + State_Met(LCHNK)%FRSNO (1,:) = 0.0e+0_fp +#endif + + ! Field : GWETROOT, GWETTOP + ! Description: Root and top soil moisture + ! Unit : - + ! Dimensions : nX, nY + State_Met(LCHNK)%GWETROOT (1,:) = 0.0e+0_fp + State_Met(LCHNK)%GWETTOP (1,:) = 0.0e+0_fp + + ! Field : LAI + ! Description: Leaf area index + ! Unit : m^2/m^2 + ! Dimensions : nX, nY + State_Met(LCHNK)%LAI (1,:) = 0.0e+0_fp + + ! Field : PARDR, PARDF + ! Description: Direct and diffuse photosynthetically active radiation + ! Unit : W/m^2 + ! Dimensions : nX, nY + State_Met(LCHNK)%PARDR (1,:) = 0.0e+0_fp + State_Met(LCHNK)%PARDF (1,:) = 0.0e+0_fp + + ! Field : PBLH + ! Description: PBL height + ! Unit : m + ! Dimensions : nX, nY + State_Met(LCHNK)%PBLH (1,:) = PblH(:nY) + + ! Field : PHIS + ! Description: Surface geopotential height + ! Unit : m + ! Dimensions : nX, nY + State_Met(LCHNK)%PHIS (1,:) = State%Phis(:) + + ! Field : PRECANV, PRECCON, PRECLSC, PRECTOT + ! Description: Anvil precipitation @ ground + ! Convective precipitation @ ground + ! Large-scale precipitation @ ground + ! Total precipitation @ ground + ! Unit : kg/m^2/s + ! Dimensions : nX, nY + State_Met(LCHNK)%PRECANV (1,:) = 0.0e+0_fp + State_Met(LCHNK)%PRECCON (1,:) = cam_out%Precc(:) + State_Met(LCHNK)%PRECLSC (1,:) = cam_out%Precl(:) + State_Met(LCHNK)%PRECTOT (1,:) = cam_out%Precc(:) + cam_out%Precl(:) + + ! Field : TROPP + ! Description: Tropopause pressure + ! Unit : hPa + ! Dimensions : nX, nY + State_Met(LCHNK)%TROPP (1,:) = Trop_P(:) + + ! Field : PS1_WET, PS2_WET + ! Description: Wet surface pressure at start and end of timestep + ! Unit : hPa + ! Dimensions : nX, nY + State_Met(LCHNK)%PS1_WET (1,:) = State%ps(:)*0.01e+0_fp + State_Met(LCHNK)%PS2_WET (1,:) = State%ps(:)*0.01e+0_fp + + ! Field : SLP + ! Description: Sea level pressure + ! Unit : hPa + ! Dimensions : nX, nY + State_Met(LCHNK)%SLP (1,:) = State%ps(:)*0.01e+0_fp + + ! Field : TS, TSKIN + ! Description: Surface temperature, surface skin temperature + ! Unit : K + ! Dimensions : nX, nY + State_Met(LCHNK)%TS (1,:) = cam_in%TS(:) + State_Met(LCHNK)%TSKIN (1,:) = cam_in%TS(:) + + ! Field : SWGDN + ! Description: Incident radiation @ ground + ! Unit : W/m^2 + ! Dimensions : nX, nY + State_Met(LCHNK)%SWGDN (1,:) = fsds(:) + + ! Field : TO3 + ! Description: Total overhead ozone column + ! Unit : DU + ! Dimensions : nX, nY + State_Met(LCHNK)%TO3 (1,:) = 300.0e+0_fp ! TMMF + + ! Field : SNODP, SNOMAS + ! Description: Snow depth, snow mass + ! Unit : m, kg/m^2 + ! Dimensions : nX, nY + ! Note : Conversion from m to kg/m^2 + ! \rho_{ice} = 916.7 kg/m^3 + State_Met(LCHNK)%SNODP (1,:) = snowDepth(:) + State_Met(LCHNK)%SNOMAS (1,:) = snowDepth(:) * 916.7e+0_r8 + + ! Field : SUNCOS, SUNCOSmid + ! Description: COS(solar zenith angle) at current time and midpoint + ! of chemistry timestep + ! Unit : - + ! Dimensions : nX, nY + ! Note : Compute tendency in -/s (tmmf, 1/13/20) ? + State_Met(LCHNK)%SUNCOS (1,:) = CSZA(:) + State_Met(LCHNK)%SUNCOSmid (1,:) = CSZA(:) + + ! Field : U10M, V10M + ! Description: E/W and N/S wind speed @ 10m height + ! Unit : m/s + ! Dimensions : nX, nY + State_Met(LCHNK)%U10M (1,:) = State%U(:,nZ) + State_Met(LCHNK)%V10M (1,:) = State%V(:,nZ) + + ! Field : USTAR + ! Description: Friction velocity + ! Unit : m/s + ! Dimensions : nX, nY + ! Note : We here combine the land friction velocity (fv) with + ! the ocean friction velocity (ustar) + DO J = 1, nY + State_Met(LCHNK)%USTAR (1,J) = & + cam_in%fv(J) * ( cam_in%landFrac(J)) & + + cam_in%uStar(J) * ( 1.0e+0_fp - cam_in%landFrac(J)) + ENDDO + + ! Field : Z0 + ! Description: Surface roughness length + ! Unit : m + ! Dimensions : nX, nY + State_Met(LCHNK)%Z0 (1,:) = Z0(:) + + DO J = 1, nY + iMaxLoc = MAXLOC( (/ State_Met(LCHNK)%FRLAND(1,J) + & + State_Met(LCHNK)%FRLANDIC(1,J) + & + State_Met(LCHNK)%FRLAKE(1,J), & + State_Met(LCHNK)%FRSEAICE(1,J), & + State_Met(LCHNK)%FROCEAN(1,J) - & + State_Met(LCHNK)%FRSEAICE(1,J) /) ) + IF ( iMaxLoc(1) == 3 ) iMaxLoc(1) = 0 + ! reset ocean to 0 + + ! Field : LWI + ! Description: Land/water indices + ! Unit : - + ! Dimensions : nX, nY + State_Met(LCHNK)%LWI(1,J) = FLOAT( iMaxLoc(1) ) + ENDDO + + ! Three-dimensional fields on level edges + DO J = 1, nY + DO L = 1, nZ+1 + ! Field : PEDGE + ! Description: Wet air pressure at (vertical) level edges + ! Unit : hPa + ! Dimensions : nX, nY, nZ+1 + State_Met(LCHNK)%PEDGE (1,J,L) = State%Pint(J,nZ+2-L)*0.01e+0_fp + + ! Field : CMFMC + ! Description: Upward moist convective mass flux + ! Unit : kg/m^2/s + ! Dimensions : nX, nY, nZ+1 + State_Met(LCHNK)%CMFMC (1,J,L) = 0.0e+0_fp + + ! Field : PFICU, PFLCU + ! Description: Downward flux of ice/liquid precipitation (convective) + ! Unit : kg/m^2/s + ! Dimensions : nX, nY, nZ+1 + State_Met(LCHNK)%PFICU (1,J,L) = 0.0e+0_fp + State_Met(LCHNK)%PFLCU (1,J,L) = 0.0e+0_fp + + ! Field : PFILSAN, PFLLSAN + ! Description: Downward flux of ice/liquid precipitation (Large-scale & anvil) + ! Unit : kg/m^2/s + ! Dimensions : nX, nY, nZ+1 + State_Met(LCHNK)%PFILSAN (1,J,L) = LsFlxSnw(j,nZ+2-L) ! kg/m2/s + State_Met(LCHNK)%PFLLSAN (1,J,L) = MAX(0.0e+0_fp,LsFlxPrc(J,nZ+2-L) - LsFlxSnw(J,nZ+2-L)) ! kg/m2/s + ENDDO + ENDDO + + DO J = 1, nY + ! Field : U, V + ! Description: Max cloud top height + ! Unit : level + ! Dimensions : nX, nY + State_Met(LCHNK)%cldTops(1,J) = nZ + 1 - NINT(cldTop(J)) + ENDDO + + ! Three-dimensional fields on level centers + DO J = 1, nY + DO L = 1, nZ + + ! Field : U, V + ! Description: E/W and N/S component of wind + ! Unit : m/s + ! Dimensions : nX, nY, nZ + State_Met(LCHNK)%U (1,J,L) = State%U(J,nZ+1-L) + State_Met(LCHNK)%V (1,J,L) = State%V(J,nZ+1-L) + + ! Field : OMEGA + ! Description: Updraft velocity + ! Unit : Pa/s + ! Dimensions : nX, nY, nZ + !State_Met(LCHNK)%OMEGA (1,J,L) = State%Omega(J,nZ+1-L) + + ! Field : CLDF + ! Description: 3-D cloud fraction + ! Unit : - + ! Dimensions : nX, nY, nZ + State_Met(LCHNK)%CLDF (1,J,L) = cldFrc(j,nZ+1-l) + + ! Field : DTRAIN + ! Description: Detrainment flux + ! Unit : kg/m^2/s + ! Dimensions : nX, nY, nZ + State_Met(LCHNK)%DTRAIN (1,J,L) = 0.0e+0_fp ! Used in convection + + ! Field : DQRCU + ! Description: Convective precipitation production rate + ! Unit : kg/kg dry air/s + ! Dimensions : nX, nY, nZ + State_Met(LCHNK)%DQRCU (1,J,L) = 0.0e+0_fp ! Used in convection + + ! Field : DQRLSAN + ! Description: Large-scale precipitation production rate + ! Unit : kg/kg dry air/s + ! Dimensions : nX, nY, nZ + State_Met(LCHNK)%DQRLSAN (1,J,L) = PRain(J,nZ+1-L) ! kg/kg/s + + ! Field : QI, QL + ! Description: Cloud ice/water mixing ratio + ! Unit : kg/kg dry air + ! Dimensions : nX, nY, nZ + State_Met(LCHNK)%QI (1,J,L) = State%Q(J,nZ+1-L,ixCldIce) ! kg ice / kg dry air + State_Met(LCHNK)%QL (1,J,L) = State%Q(J,nZ+1-L,ixCldLiq) ! kg water / kg dry air + + ! Field : RH + ! Description: Relative humidity + ! Unit : % + ! Dimensions : nX, nY, nZ + State_Met(LCHNK)%RH (1,J,L) = RelHum(J,nZ+1-L) * 100.0e+0_fp + + ! Field : TAUCLI, TAUCLW + ! Description: Optical depth of ice/H2O clouds + ! Unit : - + ! Dimensions : nX, nY, nZ + State_Met(LCHNK)%TAUCLI (1,J,L) = TauCli(J,nZ+1-L) + State_Met(LCHNK)%TAUCLW (1,J,L) = TauClw(J,nZ+1-L) + + ! Field : REEVAPCN + ! Description: Evaporation of convective precipitation + ! (w/r/t dry air) + ! Unit : kg + ! Dimensions : nX, nY, nZ + State_Met(LCHNK)%REEVAPCN (1,J,L) = 0.0e+0_fp + + ! Field : REEVAPLS + ! Description: Evaporation of large-scale + anvil precipitation + ! (w/r/t dry air) + ! Unit : kg + ! Dimensions : nX, nY, nZ + State_Met(LCHNK)%REEVAPLS (1,J,L) = NEvapr(J,nZ+1-L) ! kg/kg/s + + ! Field : SPHU1, SPHU2 + ! Description: Specific humidity at current and next timestep + ! Unit : g H2O/ kg air + ! Dimensions : nX, nY, nZ + ! Note : Since we are using online meteorology, we do not have + ! access to the data at the next time step + ! Compute tendency in g H2O/kg air/s (tmmf, 1/13/20) ? + State_Met(LCHNK)%SPHU1 (1,J,L) = qH2O(J,nZ+1-L) * 1.0e+3_fp ! g/kg + State_Met(LCHNK)%SPHU2 (1,J,L) = qH2O(J,nZ+1-L) * 1.0e+3_fp ! g/kg + + ! Field : TMPU1, TMPU2 + ! Description: Temperature at current and next timestep + ! Unit : K + ! Dimensions : nX, nY, nZ + ! Note : Since we are using online meteorology, we do not have + ! access to the data at the next time step + ! Compute tendency in K/s (tmmf, 1/13/20) ? + State_Met(LCHNK)%TMPU1 (1,J,L) = State%T(J,nZ+1-L) + State_Met(LCHNK)%TMPU2 (1,J,L) = State%T(J,nZ+1-L) + ENDDO + ENDDO + + ! Field : T + ! Description: Temperature at current time + ! Unit : K + ! Dimensions : nX, nY, nZ + ! Note : Since we are using online meteorology, we do not have + ! access to the data at the next time step + ! Compute tendency in K/s (tmmf, 1/13/20) ? + State_Met(LCHNK)%T = (State_Met(LCHNK)%TMPU1 + State_Met(LCHNK)%TMPU2)*0.5e+0_fp + + ! Field : SPHU + ! Description: Specific humidity at current time + ! Unit : g H2O/ kg air + ! Dimensions : nX, nY, nZ + ! Note : Since we are using online meteorology, we do not have + ! access to the data at the next time step + ! Compute tendency in g H2O/kg air/s (tmmf, 1/13/20) ? + State_Met(LCHNK)%SPHU = (State_Met(LCHNK)%SPHU1 + State_Met(LCHNK)%SPHU2)*0.5e+0_fp + + ! Field : OPTD + ! Description: Total in-cloud optical depth (visible band) + ! Unit : - + ! Dimensions : nX, nY, nZ + State_Met(LCHNK)%OPTD = State_Met(LCHNK)%TAUCLI + State_Met(LCHNK)%TAUCLW + + ! Nullify all pointers + Nullify(PblH ) + Nullify(Fsds ) + Nullify(PRain ) + Nullify(LsFlxSnw) + Nullify(LsFlxPrc) + Nullify(cldTop ) + Nullify(cldFrc ) + Nullify(NEvapr ) + Nullify(RprdTot ) + + ! Field : InChemGrid + ! Description: Are we in the chemistry grid? + ! Unit : - + ! Dimensions : nX, nY, nZ + State_Met(LCHNK)%InChemGrid(:,:,:) = .True. + + ! Determine current date and time + CALL Get_Curr_Date( yr = currYr, & + mon = currMo, & + day = currDy, & + tod = currTOD ) + + ! For now, force year to be 2000 + currYr = 2000 + currYMD = (currYr*1000) + (currMo*100) + (currDy) + ! Deal with subdaily + currUTC = REAL(currTOD,f4)/3600.0e+0_f4 + currSc = 0 + currMn = 0 + currHr = 0 + DO WHILE (currTOD > 3600) + currTOD = currTOD - 3600 + currHr = currHr + 1 + ENDDO + DO WHILE (currTOD > 60) + currTOD = currTOD - 60 + currMn = currMn + 1 + ENDDO + currSc = currTOD + currHMS = (currHr*1000) + (currMn*100) + (currSc) + + IF ( firstDay ) THEN + newDay = .True. + newMonth = .True. + firstDay = .False. + ELSE IF ( currHMS < dT ) THEN + newDay = .True. + IF ( currDy == 1 ) THEN + newMonth = .True. + ELSE + newMonth = .False. + ENDIF + ELSE + newDay = .False. + newMonth = .False. + ENDIF + + ! Pass time values obtained from the ESMF environment to GEOS-Chem + CALL Accept_External_Date_Time( am_I_Root = rootChunk, & + value_NYMD = currYMD, & + value_NHMS = currHMS, & + value_YEAR = currYr, & + value_MONTH = currMo, & + value_DAY = currDy, & + value_DAYOFYR = INT(FLOOR(Calday)), & + value_HOUR = currHr, & + value_MINUTE = currMn, & + value_HELAPSED = 0.0e+0_f4, & + value_UTC = currUTC, & + RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Failed to update time in GEOS-Chem!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + CALL Accept_External_PEdge( am_I_Root = rootChunk, & + State_Met = State_Met(LCHNK), & + RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Failed to update pressure edges!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + ! Field : PS1_DRY, PS2_DRY + ! Description: Dry surface pressure at current and next timestep + ! Unit : hPa + ! Dimensions : nX, nY, nZ+1 + ! Note : 1. Use the CAM PSDry fields instead of using the + ! GEOS-Chem calculation + ! 2. As we are using online meteorology, we do not + ! have access to the fields at the next time step + ! Compute Pa/s tendency? (tmmf, 1/13/20) + State_Met(LCHNK)%PS1_DRY (1,:) = State%PSDry(:) * 0.01e+0_fp + State_Met(LCHNK)%PS2_DRY (1,:) = State%PSDry(:) * 0.01e+0_fp + + ! Field : PSC2_WET, PSC2_DRY + ! Description: Interpolated wet and dry surface pressure at the + ! current time + ! Unit : hPa + ! Dimensions : nX, nY, nZ+1 + ! Note : As we are using online meteorology, we do not + ! have access to the fields at the next time step + ! Compute Pa/s tendency? (tmmf, 1/13/20) + State_Met(LCHNK)%PSC2_WET = State_Met(LCHNK)%PS1_WET + State_Met(LCHNK)%PSC2_DRY = State_Met(LCHNK)%PS1_DRY + + CALL Set_Floating_Pressures( am_I_Root = rootChunk, & + State_Grid = State_Grid(LCHNK), & + State_Met = State_Met(LCHNK), & + RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Failed to set floating pressures!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + ! Set quantities of interest but do not change VMRs + ! This function updates: + ! ==================================================================== + ! (1) PEDGE : Moist air pressure at grid box bottom [hPa] + ! (2) PEDGE_DRY : Dry air partial pressure at box bottom [hPa] + ! (3) PMID : Moist air pressure at grid box centroid [hPa] + ! (4) PMID_DRY : Dry air partial pressure at box centroid [hPa] + ! (5) PMEAN : Altitude-weighted mean moist air pressure [hPa] + ! (6) PMEAN_DRY : Alt-weighted mean dry air partial pressure [hPa] + ! (7) DELP : Delta-P extent of grid box [hPa] + ! (Same for both moist and dry air since we + ! assume constant water vapor pressure + ! across box) + ! (8) AIRDEN : Mean grid box dry air density [kg/m^3] + ! (defined as total dry air mass/box vol) + ! (9) MAIRDEN : Mean grid box moist air density [kg/m^3] + ! (defined as total moist air mass/box vol) + ! (10) AD : Total dry air mass in grid box [kg] + ! (11) ADMOIST : Total moist air mass in grid box [kg] + ! (12) BXHEIGHT : Vertical height of grid box [m] + ! (13) AIRVOL : Volume of grid box [m^3] + ! (14) MOISTMW : Molecular weight of moist air in box [g/mol] + ! ==================================================================== + CALL AirQnt( am_I_Root = rootChunk, & + Input_Opt = Input_Opt, & + State_Chm = State_Chm(LCHNK), & + State_Grid = State_Grid(LCHNK), & + State_Met = State_Met(LCHNK), & + RC = RC, & + Update_Mixing_Ratio = .False. ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Failed to calculate air properties!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + ! Initialize strat chem if not already done. This has to be done here because + ! it needs to have non-zero values in State_Chm%AD, which only happens after + ! the first call to AirQnt + !IF ( (.not.SCHEM_READY) .and. Input_Opt%LSCHEM ) THEN + IF ( (.not.SCHEM_READY) .and. .True. ) THEN !TMMF + CALL Init_Strat_Chem( am_I_Root = rootChunk, & + Input_Opt = Input_Opt, & + State_Chm = State_Chm(LCHNK), & + State_Met = State_Met(LCHNK), & + State_Grid = State_Grid(LCHNK), & + RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Init_Strat_Chem"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + SCHEM_READY = .True. + ENDIF + + !============================================================== + ! ***** R U N H E M C O P H A S E 1 ***** + ! + ! Phase 1 updates the HEMCO clock and the content of the + ! HEMCO data list. This should be done before writing the + ! diagnostics organized in the HEMCO diagnostics structure, + ! and before using any of the HEMCO data list fields. + ! (ckeller, 4/1/15) + !============================================================== + ! Run HEMCO Phase 1 + !CALL Emissions_Run ( am_I_Root = MasterProc, & + ! Input_Opt = Input_Opt, & + ! State_Chm = State_Chm(LCHNK), & + ! State_Diag = State_Diag(LCHNK), & + ! State_Grid = State_Grid(LCHNK), & + ! State_Met = State_Met(LCHNK), & + ! EmisTime = EmisTime, & + ! Phase = 1, & + ! RC = RC ) + ! + !! Trap potential errors + !IF ( RC /= GC_SUCCESS ) THEN + ! ErrMsg = 'Error encountered in "Emissions_Run"!' + ! CALL Error_Stop( ErrMsg, ThisLoc ) + !ENDIF + + !---------------------------------------------------------- + ! %%% GET SOME NON-EMISSIONS DATA FIELDS VIA HEMCO %%% + ! + ! HEMCO can track non-emission data fields for chemistry + ! simulations. Put these subroutine calls after the + ! call to EMISSIONS_RUN, so that the HEMCO data structure + ! will be initialized. (bmy, 3/20/15) + ! + ! HEMCO data list is now updated further above, so can + ! take these calls out of the emissions sequence. + ! (ckeller, 4/01/15) + !---------------------------------------------------------- + !IF ( LCHEM .and. newMonth ) THEN + ! + ! ! The following only apply when photolysis is used, + ! ! that is for fullchem or aerosol simulations. + ! IF ( ITS_A_FULLCHEM_SIM .or. ITS_AN_AEROSOL_SIM ) THEN + ! + ! ! Copy UV Albedo data (for photolysis) into the + ! ! State_Met%UVALBEDO field. (bmy, 3/20/15) + ! CALL Get_UvAlbedo( am_I_Root = MasterProc, & + ! Input_Opt = Input_Opt, & + ! State_Met = State_Met(LCHNK), & + ! RC = RC ) + ! + ! ! Trap potential errors + ! IF ( RC /= GC_SUCCESS ) THEN + ! ErrMsg = 'Error encountered in "Get_UvAlbedo"!' + ! CALL Error_Stop( ErrMsg, ThisLoc ) + ! ENDIF + ! + ! IF ( Input_Opt%USE_TOMS_O3 ) THEN + ! ! Get TOMS overhead O3 columns for photolysis from + ! ! the HEMCO data structure (bmy, 3/20/15) + ! CALL Read_TOMS( am_I_Root = MasterProc, & + ! Input_Opt = Input_Opt, & + ! RC = RC ) + ! + ! ! Trap potential errors + ! IF ( RC /= GC_SUCCESS ) THEN + ! ErrMsg = 'Error encountered in "Read_TOMS"!' + ! CALL Error_Stop( ErrMsg, ThisLoc ) + ! ENDIF + ! ENDIF + ! + ! ENDIF + ! + ! ! Read data required for Hg2 gas-particle partitioning + ! ! (H Amos, 25 Oct 2011) + ! IF ( ITS_A_MERCURY_SIM ) THEN + ! CALL Read_Hg2_Partitioning( am_I_Root = MasterProc, & + ! Input_Opt = Input_Opt, & + ! State_Grid = State_Grid(LCHNK), & + ! State_Met = State_Met(LCHNK), & + ! MONTH = 1, & !TMMF + ! RC = RC ) + ! + ! ! Trap potential errors + ! IF ( RC /= GC_SUCCESS ) THEN + ! ErrMsg = + ! 'Error encountered in "Read_Hg2_Partitioning"!' + ! CALL Error_Stop( ErrMsg, ThisLoc ) + ! ENDIF + ! + ! ENDIF + !ENDIF + + !! Prescribe methane surface concentrations throughout PBL + !IF ( ITS_A_FULLCHEM_SIM .and. id_CH4 > 0 ) THEN + ! + ! ! Set CH4 concentrations + ! CALL SET_CH4( am_I_Root = MasterProc, & + ! Input_Opt = Input_Opt, & + ! State_Chm = State_Chm(LCHNK), & + ! State_Diag = State_Diag(LCHNK), & + ! State_Grid = State_Grid(LCHNK), & + ! State_Met = State_Met(LCHNK), & + ! RC = RC ) + ! + ! ! Trap potential errors + ! IF ( RC /= GC_SUCCESS ) THEN + ! ErrMsg = 'Error encountered in call to "SET_CH4"!' + ! CALL Error_Stop( ErrMsg, ThisLoc ) + ! ENDIF + !ENDIF + + ! Eventually initialize/reset wetdep + IF ( Input_Opt%LConv .OR. Input_Opt%LChem .OR. Input_Opt%LWetD ) THEN + CALL Setup_WetScav( am_I_Root = rootChunk, & + Input_Opt = Input_Opt, & + State_Chm = State_Chm(LCHNK), & + State_Grid = State_Grid(LCHNK), & + State_Met = State_Met(LCHNK), & + RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Setup_WetScav"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + ENDIF + + !============================================================== + ! ***** C O M P U T E P B L H E I G H T etc. ***** + !============================================================== + ! Move this call from the PBL mixing routines because the PBL + ! height is used by drydep and some of the emissions routines. + ! (ckeller, 3/5/15) + ! This function updates: + ! ==================================================================== + ! (1) InPbl : Logical indicating if we are in the PBL [-] + ! (2) PBL_TOP_L : Number of layers in the PBL [-] + ! (3) PBL_TOP_hPa: Pressure at the top of the PBL [hPa] + ! (4) PBL_TOP_m : PBL height [m] + ! (5) PBL_THICK : PBL thickness [hPa] + ! (6) F_OF_PBL : Fraction of grid box within the PBL [-] + ! (7) F_UNDER_PBLTOP: Fraction of grid box underneath the PBL top [-] + ! (8) PBL_MAX_L : Model level where PBL top occurs [-] + ! ==================================================================== + CALL Compute_PBL_Height( am_I_Root = rootChunk, & + State_Grid = State_Grid(LCHNK), & + State_Met = State_Met(LCHNK), & + RC = RC ) + + ! Trap potential errors + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Compute_PBL_Height"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + !-------------------------------------------------------------- + ! Test for emission timestep + ! Now always do emissions here, even for full-mixing + ! (ckeller, 3/5/15) + !-------------------------------------------------------------- + !================================================================== + ! ***** D R Y D E P O S I T I O N ***** + !================================================================== + !================================================================== + ! Compute dry deposition velocities + ! + ! CLM computes dry deposition velocities over land. + ! We need to merge the land component passed through cam_in and + ! the ocn/ice dry deposition velocities. + ! + ! If using the CLM velocities, two options show up: + ! 1. Compute dry deposition velocities over ocean and ice similarly + ! to the way MOZART does it (OCNDDVEL_MOZART) + ! 2. Use GEOS-Chem's dry deposition module to compute velocities + ! and then scale them with the ocean fraction (OCNDDVEL_GEOSCHEM) + ! + ! A third option would be to let GEOS-Chem compute dry deposition + ! velocity (ALLDDVEL_GEOSCHEM), thus overwriting the input from CLM + ! + ! drydep_method must be set to DD_XLND. + ! + ! The following options are currently supported: + ! - ALLDDVEL_GEOSCHEM + ! - OCNDDVEL_GEOSCHEM + ! - OCNDDVEL_MOZART + ! + ! The ALLDDVEL_GEOSCHEM coupled with LANDTYPE_CLM requires that CLM + ! passes land type information (land type and leaf area index). + !================================================================== + ! + ! State_Chm expects dry deposition velocities in m/s, whereas + ! CLM returns land deposition velocities in cm/s! + ! + ! For now, dry deposition velocities are only computed for gases + ! (which is what CLM deals with). Dry deposition for aerosols is + ! work in progress. + ! + ! Thibaud M. Fritz - 27 Feb 2020 + !================================================================== + + IF ( Input_Opt%LDryD ) THEN +#if ( LANDTYPE_CLM ) + ! Compute the Olson landmap fields of State_Met + ! (e.g. State_Met%IREG, State_Met%ILAND, etc.) + CALL Compute_Olson_Landmap( am_I_Root = rootChunk, & + Input_Opt = Input_Opt, & + State_Grid = State_Grid(LCHNK), & + State_Met = State_Met(LCHNK), & + RC = RC ) + + ! Trap potential errors + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Compute_Olson_Landmap"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + ! Compute State_Met%XLAI (for drydep) and State_Met%MODISLAI, + ! which is the average LAI per grid box (for soil NOx emissions) + CALL Compute_Xlai( am_I_Root = rootChunk, & + Input_Opt = Input_Opt, & + State_Grid = State_Grid(LCHNK), & + State_Met = State_Met(LCHNK), & + RC = RC ) + + ! Trap potential errors + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Compute_Xlai"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF +#endif + +#if ( ALLDDVEL_GEOSCHEM || OCNDDVEL_GEOSCHEM ) + + ! Compute drydep velocities and update State_Chm%DryDepVel + CALL Do_Drydep( am_I_Root = rootChunk, & + Input_Opt = Input_Opt, & + State_Chm = State_Chm(LCHNK), & + State_Diag = State_Diag(LCHNK), & + State_Grid = State_Grid(LCHNK), & + State_Met = State_Met(LCHNK), & + RC = RC ) + + ! Trap potential errors + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Do_Drydep"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + +#if ( OCNDDVEL_GEOSCHEM ) + + DO N = 1, nddvels + + !! Print debug + !IF ( rootChunk ) THEN + ! IF ( N == 1 ) THEN + ! Write(iulog,*) "Number of GC dry deposition species = ", & + ! SIZE(State_Chm(LCHNK)%DryDepVel(:,:,:),3) + ! Write(iulog,*) "Number of CESM dry deposition species = ", & + ! nddvels + ! ENDIF + ! Write(iulog,*) "N = ", N + ! Write(iulog,*) "drySpc_ndx = ", drySpc_ndx(N) + ! Write(iulog,*) "GC index = ", map2GC_dryDep(N) + ! IF ( map2GC_dryDep(N) > 0 ) THEN + ! Write(iulog,*) "GC name = ", TRIM(DEPNAME(map2GC_dryDep(N))) + ! ENDIF + ! Write(iulog,*) "dry Species= ", TRIM(drydep_list(N)) + ! IF ( drySpc_ndx(N) > 0 ) THEN + ! Write(iulog,*) "tracerName = ", TRIM(tracerNames(drySpc_ndx(N))) + ! ENDIF + ! Write(iulog,*) "CLM-depVel = ", & + ! MAXVAL(cam_in%depvel(:nY,N)) * 1.0e-02_fp, " [m/s]" + ! IF ( map2GC_dryDep(N) > 0 ) THEN + ! Write(iulog,*) "GC-depVel = ", & + ! MAXVAL(State_Chm(LCHNK)%DryDepVel(1,:nY,map2GC_dryDep(N))), " [m/s]" + ! ENDIF + !ENDIF + + IF ( map2GC_dryDep(N) > 0 ) THEN + ! State_Chm%DryDepVel is in m/s + State_Chm(LCHNK)%DryDepVel(1,:nY,map2GC_dryDep(N)) = & + ! This first bit corresponds to the dry deposition + ! velocities over land as computed from CLM and + ! converted to m/s. This is scaled by the fraction + ! of land. + cam_in%depVel(:nY,N) * 1.0e-02_fp & + * MAX(0._fp, 1.0_fp - State_Met(LCHNK)%FROCEAN(1,:nY)) & + ! This second bit corresponds to the dry deposition + ! velocities over ocean and sea ice as computed from + ! GEOS-Chem. This is scaled by the fraction of ocean + ! and sea ice. + + State_Chm(LCHNK)%DryDepVel(1,:nY,map2GC_dryDep(N)) & + * State_Met(LCHNK)%FROCEAN(1,:nY) + ENDIF + ENDDO + +#endif + +#elif ( OCNDDVEL_MOZART ) + ! This routine updates the deposition velocities from CLM in the + ! pointer lnd(LCHNK)%dvel as long as drydep_method == DD_XLND is + ! True. + CALL drydep_update( State, cam_in ) + + windSpeed(:nY) = SQRT( State%U(:nY,nZ)*State%U(:nY,nZ) + & + State%V(:nY,nZ)*State%V(:nY,nZ) ) + potT(:nY) = State%T(:nY,nZ) * (1._fp + qH2O(:nY,nZ)) + + CALL get_lat_all_p( LCHNK, nY, latndx ) + CALL get_lon_all_p( LCHNK, nY, lonndx ) + + CALL drydep_fromlnd( ocnfrac = cam_in%ocnfrac(:), & + icefrac = cam_in%icefrac(:), & + ncdate = currYMD, & + sfc_temp = cam_in%TS(:), & + pressure_sfc = State%PS(:), & + wind_speed = windSpeed(:), & + spec_hum = qH2O(:,nZ), & + air_temp = State%T(:,nZ), & + pressure_10m = State%PMid(:,nZ), & + rain = State_Met(LCHNK)%PRECTOT(1,:), & + snow = cam_in%Snowhland(:), & + solar_flux = State_Met(LCHNK)%SWGDN(1,:), & + dvelocity = MOZART_depVel(:,:), & + dflx = MOZART_depFlx(:,:), & + State_Chm = State_Chm(LCHNK), & + tv = potT(:), & + soilw = -99._fp, & + rh = relHum(:,nZ), & + ncol = nY, & + lonndx = lonndx(:), & + latndx = latndx(:), & + lchnk = LCHNK ) + + DO N = 1, nddvels + + !! Print debug + !IF ( rootChunk ) THEN + ! IF ( N == 1 ) THEN + ! Write(iulog,*) "Number of GC dry deposition species = ", & + ! SIZE(State_Chm(LCHNK)%DryDepVel(:,:,:),3) + ! Write(iulog,*) "Number of CESM dry deposition species = ", & + ! nddvels + ! ENDIF + ! Write(iulog,*) "N = ", N + ! Write(iulog,*) "drySpc_ndx = ", drySpc_ndx(N) + ! Write(iulog,*) "GC index = ", map2GC_dryDep(N) + ! IF ( map2GC_dryDep(N) > 0 ) THEN + ! Write(iulog,*) "GC name = ", TRIM(DEPNAME(map2GC_dryDep(N))) + ! ENDIF + ! Write(iulog,*) "dry Species= ", TRIM(drydep_list(N)) + ! IF ( drySpc_ndx(N) > 0 ) THEN + ! Write(iulog,*) "tracerName = ", TRIM(tracerNames(drySpc_ndx(N))) + ! ENDIF + ! Write(iulog,*) "CLM-depVel = ", & + ! MAXVAL(cam_in%depvel(:nY,N)) * 1.0e-02_fp, " [m/s]", LCHNK + ! IF ( drySpc_ndx(N) > 0 ) THEN + ! Write(iulog,*) "Merged depVel = ", & + ! MAXVAL(MOZART_depVel(:nY,drySpc_ndx(N))) * 1.0e-02_fp, " [m/s]", LCHNK + ! ENDIF + !ENDIF + + IF ( ( map2GC_dryDep(N) > 0 ) .AND. ( drySpc_ndx(N) > 0 ) ) THEN + ! State_Chm%DryDepVel is in m/s + State_Chm(LCHNK)%DryDepVel(1,:nY,map2GC_dryDep(N)) = & + MOZART_depVel(:nY,drySpc_ndx(N)) * 1.0e-02_fp + ENDIF + + ENDDO + +#else + ! We should be in one of the cases above as any exceptions should be + ! caught when running chem_readnl, but just for safety's safe: + CALL ENDRUN('Incorrect definitions for dry deposition velocities') +#endif + + CALL Update_DryDepSav( am_I_Root = rootChunk, & + Input_Opt = Input_Opt, & + State_Chm = State_Chm(LCHNK), & + State_Diag = State_Diag(LCHNK), & + State_Grid = State_Grid(LCHNK), & + State_Met = State_Met(LCHNK), & + RC = RC ) + + ENDIF + + !!=========================================================== + !! ***** E M I S S I O N S ***** + !! + !! NOTE: For a complete description of how emissions from + !! HEMCO are added into GEOS-Chem (and how they are mixed + !! into the boundary layer), please see the wiki page: + !! + !! http://wiki-geos-chem.org/Distributing_emissions_in_the_PBL + !!=========================================================== + ! + !! EMISSIONS_RUN will call HEMCO run phase 2. HEMCO run phase + !! only calculates emissions. All data has been read to disk + !! in phase 1 at the beginning of the time step. + !! (ckeller, 4/1/15) + !CALL Emissions_Run( am_I_Root = rootChunk, & + ! Input_Opt = Input_Opt, & + ! State_Chm = State_Chmk(LCHNK), & + ! State_Diag = State_Diag(LCHNK), & + ! State_Grid = State_Grid(LCHNK), & + ! State_Met = State_Met(LCHNK), & + ! TimeForEmis = TimeForEmis, & + ! Phase = 2, & + ! RC = RC ) + ! + !! Trap potential errors + !IF ( RC /= GC_SUCCESS ) THEN + ! ErrMsg = + ! 'Error encountered in "Emissions_Run"! after drydep!' + ! CALL Error_Stop( ErrMsg, ThisLoc ) + !ENDIF + + !=========================================================== + ! ***** M I X E D L A Y E R M I X I N G ***** + !=========================================================== + + ! Note: mixing routine expects tracers in v/v + ! DO_MIXING applies the tracer tendencies (dry deposition, + ! emission rates) to the tracer arrays and performs PBL + ! mixing. + ! In the non-local PBL scheme, dry deposition and emission + ! fluxes below the PBL are handled within the PBL mixing + ! routine. Otherwise, tracer concentrations are first updated + ! and the full-mixing is then applied. + ! (ckeller, 3/5/15) + ! NOTE: Tracer concentration units are converted locally + ! to [v/v dry air] for mixing. Eventually mixing should + ! be updated to use [kg/kg total air] (ewl, 9/18/15) + ! + ! This requires HEMCO. For now comment out. + ! Thibaud M. Fritz - 05/07/20 + !CALL Do_Mixing( am_I_Root = rootChunk, & + ! Input_Opt = Input_Opt, & + ! State_Chm = State_Chm(LCHNK), & + ! State_Diag = State_Diag(LCHNK), & + ! State_Grid = State_Grid(LCHNK), & + ! State_Met = State_Met(LCHNK), & + ! RC = RC ) + ! + !! Trap potential errors + !IF ( RC /= GC_SUCCESS ) THEN + ! ErrMsg = 'Error encountered in "Do_Mixing"!' + ! CALL Error_Stop( ErrMsg, ThisLoc ) + !ENDIF + + !!=========================================================== + !! ***** C L O U D C O N V E C T I O N ***** + !!=========================================================== + !IF ( LCONV ) THEN + ! + ! ! Call the appropriate convection routine + ! ! NOTE: Tracer concentration units are converted locally + ! ! to [kg/kg total air] for convection (ewl, 9/18/15) + ! CALL Do_Convection( am_I_Root = rootChunk, & + ! Input_Opt = Input_Opt, & + ! State_Chm = State_Chm(LCHNK), & + ! State_Diag = State_Diag(LCHNK), & + ! State_Grid = State_Grid(LCHNK), & + ! State_Met = State_Met(LCHNK), & + ! RC = RC ) + ! + ! ! Trap potential errors + ! IF ( RC /= GC_SUCCESS ) THEN + ! ErrMsg = 'Error encountered in "Do_Convection"!' + ! CALL Error_Stop( ErrMsg, ThisLoc ) + ! ENDIF + !ENDIF + + !============================================================== + ! ***** C H E M I S T R Y ***** + !============================================================== + ! Get the overhead column O3 for use with FAST-J + IF ( Input_Opt%Its_A_FullChem_Sim .OR. & + Input_Opt%Its_An_Aerosol_Sim ) THEN + + IF ( Input_Opt%LChem ) THEN + CALL Compute_Overhead_O3( am_I_Root = rootChunk, & + State_Grid = State_Grid(LCHNK), & + DAY = currDy, & + USE_O3_FROM_MET = Input_Opt%Use_O3_From_Met, & + TO3 = State_Met(LCHNK)%TO3 ) + ENDIF + ENDIF + + CALL Do_Chemistry( am_I_Root = rootChunk, & + Input_Opt = Input_Opt, & + State_Chm = State_Chm(LCHNK), & + State_Diag = State_Diag(LCHNK), & + State_Grid = State_Grid(LCHNK), & + State_Met = State_Met(LCHNK), & + RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Do_Chemistry"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + !============================================================== + ! ***** W E T D E P O S I T I O N (rainout + washout) ***** + !============================================================== + IF ( Input_Opt%LWetD ) THEN + + ! Do wet deposition + ! NOTE: Tracer concentration units are converted locally + ! to [kg/m2] in wet deposition to enable calculations + ! along the column (ewl, 9/18/15) + CALL Do_WetDep( am_I_Root = rootChunk, & + Input_Opt = Input_Opt, & + State_Chm = State_Chm(LCHNK), & + State_Diag = State_Diag(LCHNK), & + State_Grid = State_Grid(LCHNK), & + State_Met = State_Met(LCHNK), & + RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Do_WetDep"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + ENDIF + + ! Make sure State_Chm(lchnk) is back in kg/kg dry! + ! Reset H2O MMR to the initial value (no chemistry tendency in H2O just yet) + State_Chm(LCHNK)%Species(1,:,:,iH2O) = MMR_Beg(:,:,iH2O) + + ! Store unadvected species data + SlsData = 0.0e+0_r8 + DO N = 1, nSls + M = map2GC_Sls(N) + IF ( M > 0 ) THEN + DO J = 1, nY + DO K = 1, nZ + SlsData(J,nZ+1-K,N) = REAL(State_Chm(LCHNK)%Species(1,J,K,M),r8) + ENDDO + ENDDO + ENDIF + ENDDO + CALL Set_Short_Lived_Species( SlsData, LCHNK, nY, Pbuf ) + + ! Write diagnostic output + DO N = 1, pcnst + M = map2GC(N) + I = map2Idx(N) + IF ( M > 0 ) THEN + SpcName = tracerNames(I) + VMR = 0.0e+0_r8 + DO J = 1, nY + DO K = 1, nZ + VMR(J,nZ+1-K) = REAL(State_Chm(LCHNK)%Species(1,J,K,M),r8) * MWRatio(I) + ENDDO + ENDDO + CALL OutFld( TRIM(SpcName), VMR(:nY,:), nY, LCHNK ) + ENDIF + ENDDO + +#if defined( CLM40 ) + SpcName = 'lu_soil' + CALL OutFld( TRIM(SpcName), cam_in%lwtgcell(:,1), nY, LCHNK ) + SpcName = 'lu_landice' + CALL OutFld( TRIM(SpcName), cam_in%lwtgcell(:,2), nY, LCHNK ) + SpcName = 'lu_deeplake' + CALL OutFld( TRIM(SpcName), cam_in%lwtgcell(:,3), nY, LCHNK ) + SpcName = 'lu_shallowlake' + CALL OutFld( TRIM(SpcName), cam_in%lwtgcell(:,4), nY, LCHNK ) + SpcName = 'lu_wetland' + CALL OutFld( TRIM(SpcName), cam_in%lwtgcell(:,5), nY, LCHNK ) + SpcName = 'lu_urban' + CALL OutFld( TRIM(SpcName), cam_in%lwtgcell(:,6), nY, LCHNK ) + SpcName = 'lu_icemec' + CALL OutFld( TRIM(SpcName), cam_in%lwtgcell(:,7), nY, LCHNK ) + SpcName = 'lu_crop' + CALL OutFld( TRIM(SpcName), cam_in%lwtgcell(:,8), nY, LCHNK ) +#elif defined( CLM45 ) || defined( CLM50 ) + SpcName = 'lu_soil' + CALL OutFld( TRIM(SpcName), cam_in%lwtgcell(:,1), nY, LCHNK ) + SpcName = 'lu_crop' + CALL OutFld( TRIM(SpcName), cam_in%lwtgcell(:,2), nY, LCHNK ) + SpcName = 'lu_landice' + CALL OutFld( TRIM(SpcName), cam_in%lwtgcell(:,4), nY, LCHNK ) + SpcName = 'lu_deeplake' + CALL OutFld( TRIM(SpcName), cam_in%lwtgcell(:,5), nY, LCHNK ) + SpcName = 'lu_wetland' + CALL OutFld( TRIM(SpcName), cam_in%lwtgcell(:,6), nY, LCHNK ) + SpcName = 'lu_urban' + CALL OutFld( TRIM(SpcName), cam_in%lwtgcell(:,7) & + + cam_in%lwtgcell(:,8) & + + cam_in%lwtgcell(:,9), nY, LCHNK ) +#endif + SpcName = 'p_notveg' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,1), nY, LCHNK ) + SpcName = 'p_needle_eg_temp' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,2), nY, LCHNK ) + SpcName = 'p_needle_eg_bor' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,3), nY, LCHNK ) + SpcName = 'p_needle_dd_bor' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,4), nY, LCHNK ) + SpcName = 'p_broad_eg_trop' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,5), nY, LCHNK ) + SpcName = 'p_broad_eg_temp' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,6), nY, LCHNK ) + SpcName = 'p_broad_dd_trop' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,7), nY, LCHNK ) + SpcName = 'p_broad_dd_temp' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,8), nY, LCHNK ) + SpcName = 'p_broad_dd_bor' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,9), nY, LCHNK ) + SpcName = 'p_broad_eg_sh' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,10), nY, LCHNK ) + SpcName = 'p_broad_dd_temp_sh' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,11), nY, LCHNK ) + SpcName = 'p_broad_dd_bor_sh' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,12), nY, LCHNK ) + SpcName = 'p_c3_arctic_grass' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,13), nY, LCHNK ) + SpcName = 'p_c3_narctic_grass' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,14), nY, LCHNK ) + SpcName = 'p_c4_grass' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,15), nY, LCHNK ) + SpcName = 'p_c3_crop' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,16), nY, LCHNK ) + SpcName = 'p_c3_irrigated' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,17), nY, LCHNK ) +#if defined( CLM40 ) + SpcName = 'p_c3_corn' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,18), nY, LCHNK ) + SpcName = 'p_spring_cereal' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,19), nY, LCHNK ) + SpcName = 'p_winter_cereal' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,20), nY, LCHNK ) + SpcName = 'p_soybean' +#elif defined( CLM45 ) || defined( CLM50 ) + SpcName = 'p_temp_corn' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,18), nY, LCHNK ) + SpcName = 'p_irr_temp_corn' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,19), nY, LCHNK ) + SpcName = 'p_spring_wheat' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,20), nY, LCHNK ) + SpcName = 'p_irr_spring_wheat' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,21), nY, LCHNK ) + SpcName = 'p_winter_wheat' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,22), nY, LCHNK ) + SpcName = 'p_irr_winter_wheat' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,23), nY, LCHNK ) + SpcName = 'p_temp_soybean' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,24), nY, LCHNK ) + SpcName = 'p_irr_temp_soybean' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,25), nY, LCHNK ) + SpcName = 'p_barley' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,26), nY, LCHNK ) + SpcName = 'p_irr_barley' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,27), nY, LCHNK ) + SpcName = 'p_winter_barley' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,28), nY, LCHNK ) + SpcName = 'p_irr_winter_barley' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,29), nY, LCHNK ) + SpcName = 'p_rye' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,30), nY, LCHNK ) + SpcName = 'p_irr_rye' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,31), nY, LCHNK ) + SpcName = 'p_winter_rye' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,32), nY, LCHNK ) + SpcName = 'p_irr_winter_rye' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,33), nY, LCHNK ) + SpcName = 'p_cassava' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,34), nY, LCHNK ) + SpcName = 'p_irr_cassava' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,35), nY, LCHNK ) + SpcName = 'p_citrus' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,36), nY, LCHNK ) + SpcName = 'p_irr_citrus' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,37), nY, LCHNK ) + SpcName = 'p_cocoa' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,38), nY, LCHNK ) + SpcName = 'p_irr_cocoa' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,39), nY, LCHNK ) + SpcName = 'p_coffee' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,40), nY, LCHNK ) + SpcName = 'p_irr_coffee' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,41), nY, LCHNK ) + SpcName = 'p_cotton' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,42), nY, LCHNK ) + SpcName = 'p_irr_cotton' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,43), nY, LCHNK ) + SpcName = 'p_datepalm' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,44), nY, LCHNK ) + SpcName = 'p_irr_datepalm' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,45), nY, LCHNK ) + SpcName = 'p_foddergrass' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,46), nY, LCHNK ) + SpcName = 'p_irr_foddergrass' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,47), nY, LCHNK ) + SpcName = 'p_grapes' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,48), nY, LCHNK ) + SpcName = 'p_irr_grapes' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,49), nY, LCHNK ) + SpcName = 'p_groundnuts' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,50), nY, LCHNK ) + SpcName = 'p_irr_groundnuts' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,51), nY, LCHNK ) + SpcName = 'p_millet' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,52), nY, LCHNK ) + SpcName = 'p_irr_millet' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,53), nY, LCHNK ) + SpcName = 'p_oilpalm' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,54), nY, LCHNK ) + SpcName = 'p_irr_oilpalm' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,55), nY, LCHNK ) + SpcName = 'p_potatoes' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,56), nY, LCHNK ) + SpcName = 'p_irr_potatoes' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,57), nY, LCHNK ) + SpcName = 'p_pulses' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,58), nY, LCHNK ) + SpcName = 'p_irr_pulses' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,59), nY, LCHNK ) + SpcName = 'p_rapeseed' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,60), nY, LCHNK ) + SpcName = 'p_irr_rapessed' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,61), nY, LCHNK ) + SpcName = 'p_rice' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,62), nY, LCHNK ) + SpcName = 'p_irr_rice' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,63), nY, LCHNK ) + SpcName = 'p_sorghum' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,64), nY, LCHNK ) + SpcName = 'p_irr_sorghum' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,65), nY, LCHNK ) + SpcName = 'p_sugarbeet' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,66), nY, LCHNK ) + SpcName = 'p_irr_sugarbeet' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,67), nY, LCHNK ) + SpcName = 'p_sugarcane' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,68), nY, LCHNK ) + SpcName = 'p_irr_sugarcane' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,69), nY, LCHNK ) + SpcName = 'p_sunflower' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,70), nY, LCHNK ) + SpcName = 'p_irr_sunflower' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,71), nY, LCHNK ) + SpcName = 'p_miscanthus' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,72), nY, LCHNK ) + SpcName = 'p_irr_miscanthus' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,73), nY, LCHNK ) + SpcName = 'p_switchgrass' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,74), nY, LCHNK ) + SpcName = 'p_irr_switchgrass' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,75), nY, LCHNK ) + SpcName = 'p_trop_corn' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,76), nY, LCHNK ) + SpcName = 'p_irr_trop_corn' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,77), nY, LCHNK ) + SpcName = 'p_trop_soybean' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,78), nY, LCHNK ) + SpcName = 'p_irr_trop_soybean' + CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,79), nY, LCHNK ) +#endif + SpcName = 'pla_notveg' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,1), nY, LCHNK ) + SpcName = 'pla_needle_eg_temp' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,2), nY, LCHNK ) + SpcName = 'pla_needle_eg_bor' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,3), nY, LCHNK ) + SpcName = 'pla_needle_dd_bor' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,4), nY, LCHNK ) + SpcName = 'pla_broad_eg_trop' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,5), nY, LCHNK ) + SpcName = 'pla_broad_eg_temp' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,6), nY, LCHNK ) + SpcName = 'pla_broad_dd_trop' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,7), nY, LCHNK ) + SpcName = 'pla_broad_dd_temp' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,8), nY, LCHNK ) + SpcName = 'pla_broad_dd_bor' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,9), nY, LCHNK ) + SpcName = 'pla_broad_eg_sh' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,10), nY, LCHNK ) + SpcName = 'pla_broad_dd_temp_sh' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,11), nY, LCHNK ) + SpcName = 'pla_broad_dd_bor_sh' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,12), nY, LCHNK ) + SpcName = 'pla_c3_arctic_grass' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,13), nY, LCHNK ) + SpcName = 'pla_c3_narctic_grass' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,14), nY, LCHNK ) + SpcName = 'pla_c4_grass' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,15), nY, LCHNK ) + SpcName = 'pla_c3_crop' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,16), nY, LCHNK ) + SpcName = 'pla_c3_irrigated' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,17), nY, LCHNK ) +#if defined( CLM40 ) + SpcName = 'pla_c3_corn' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,18), nY, LCHNK ) + SpcName = 'pla_spring_cereal' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,19), nY, LCHNK ) + SpcName = 'pla_winter_cereal' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,20), nY, LCHNK ) + SpcName = 'pla_soybean' +#elif defined( CLM45 ) || defined( CLM50 ) + SpcName = 'pla_temp_corn' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,18), nY, LCHNK ) + SpcName = 'pla_irr_temp_corn' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,19), nY, LCHNK ) + SpcName = 'pla_spring_wheat' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,20), nY, LCHNK ) + SpcName = 'pla_irr_spring_wheat' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,21), nY, LCHNK ) + SpcName = 'pla_winter_wheat' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,22), nY, LCHNK ) + SpcName = 'pla_irr_winter_wheat' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,23), nY, LCHNK ) + SpcName = 'pla_temp_soybean' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,24), nY, LCHNK ) + SpcName = 'pla_irr_temp_soybean' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,25), nY, LCHNK ) + SpcName = 'pla_barley' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,26), nY, LCHNK ) + SpcName = 'pla_irr_barley' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,27), nY, LCHNK ) + SpcName = 'pla_winter_barley' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,28), nY, LCHNK ) + SpcName = 'pla_irr_winter_barley' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,29), nY, LCHNK ) + SpcName = 'pla_rye' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,30), nY, LCHNK ) + SpcName = 'pla_irr_rye' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,31), nY, LCHNK ) + SpcName = 'pla_winter_rye' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,32), nY, LCHNK ) + SpcName = 'pla_irr_winter_rye' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,33), nY, LCHNK ) + SpcName = 'pla_cassava' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,34), nY, LCHNK ) + SpcName = 'pla_irr_cassava' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,35), nY, LCHNK ) + SpcName = 'pla_citrus' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,36), nY, LCHNK ) + SpcName = 'pla_irr_citrus' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,37), nY, LCHNK ) + SpcName = 'pla_cocoa' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,38), nY, LCHNK ) + SpcName = 'pla_irr_cocoa' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,39), nY, LCHNK ) + SpcName = 'pla_coffee' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,40), nY, LCHNK ) + SpcName = 'pla_irr_coffee' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,41), nY, LCHNK ) + SpcName = 'pla_cotton' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,42), nY, LCHNK ) + SpcName = 'pla_irr_cotton' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,43), nY, LCHNK ) + SpcName = 'pla_datepalm' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,44), nY, LCHNK ) + SpcName = 'pla_irr_datepalm' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,45), nY, LCHNK ) + SpcName = 'pla_foddergrass' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,46), nY, LCHNK ) + SpcName = 'pla_irr_foddergrass' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,47), nY, LCHNK ) + SpcName = 'pla_grapes' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,48), nY, LCHNK ) + SpcName = 'pla_irr_grapes' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,49), nY, LCHNK ) + SpcName = 'pla_groundnuts' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,50), nY, LCHNK ) + SpcName = 'pla_irr_groundnuts' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,51), nY, LCHNK ) + SpcName = 'pla_millet' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,52), nY, LCHNK ) + SpcName = 'pla_irr_millet' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,53), nY, LCHNK ) + SpcName = 'pla_oilpalm' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,54), nY, LCHNK ) + SpcName = 'pla_irr_oilpalm' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,55), nY, LCHNK ) + SpcName = 'pla_potatoes' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,56), nY, LCHNK ) + SpcName = 'pla_irr_potatoes' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,57), nY, LCHNK ) + SpcName = 'pla_pulses' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,58), nY, LCHNK ) + SpcName = 'pla_irr_pulses' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,59), nY, LCHNK ) + SpcName = 'pla_rapeseed' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,60), nY, LCHNK ) + SpcName = 'pla_irr_rapessed' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,61), nY, LCHNK ) + SpcName = 'pla_rice' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,62), nY, LCHNK ) + SpcName = 'pla_irr_rice' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,63), nY, LCHNK ) + SpcName = 'pla_sorghum' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,64), nY, LCHNK ) + SpcName = 'pla_irr_sorghum' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,65), nY, LCHNK ) + SpcName = 'pla_sugarbeet' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,66), nY, LCHNK ) + SpcName = 'pla_irr_sugarbeet' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,67), nY, LCHNK ) + SpcName = 'pla_sugarcane' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,68), nY, LCHNK ) + SpcName = 'pla_irr_sugarcane' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,69), nY, LCHNK ) + SpcName = 'pla_sunflower' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,70), nY, LCHNK ) + SpcName = 'pla_irr_sunflower' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,71), nY, LCHNK ) + SpcName = 'pla_miscanthus' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,72), nY, LCHNK ) + SpcName = 'pla_irr_miscanthus' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,73), nY, LCHNK ) + SpcName = 'pla_switchgrass' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,74), nY, LCHNK ) + SpcName = 'pla_irr_switchgrass' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,75), nY, LCHNK ) + SpcName = 'pla_trop_corn' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,76), nY, LCHNK ) + SpcName = 'pla_irr_trop_corn' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,77), nY, LCHNK ) + SpcName = 'pla_trop_soybean' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,78), nY, LCHNK ) + SpcName = 'pla_irr_trop_soybean' + CALL OutFld( TRIM(SpcName), cam_in%lai(:,79), nY, LCHNK ) +#endif + + DO N = 1, nSls + SpcName = slsNames(n) + VMR = 0.0e+0_r8 + M = map2GC_Sls(n) + IF ( M > 0 ) THEN + DO J = 1, nY + DO K = 1, nZ + VMR(J,nZ+1-K) = REAL(State_Chm(LCHNK)%Species(1,J,K,M),r8) * SLSMWratio(N) + ENDDO + ENDDO + CALL OutFld( TRIM(SpcName), VMR(:nY,:), nY, LCHNK ) + ENDIF + ENDDO + + ! NOTE: Re-flip all the arrays vertically or suffer the consequences + ! ptend%q dimensions: [column, ?, species] + Ptend%Q(:,:,:) = 0.0e+0_r8 + MMR_End = 0.0e+0_r8 + DO N = 1, pcnst + M = map2GC(N) + IF (M > 0) THEN + I = 1 + DO J = 1, nY + DO K = 1, nZ + ! CURRENTLY KG/KG + MMR_End (J,K,M) = REAL(State_Chm(LCHNK)%Species(1,J,K,M),r8) + MMR_TEnd(J,K,M) = MMR_End(J,K,M) - MMR_Beg(J,K,M) + ptend%q(J,nZ+1-K,N) = (MMR_End(J,K,M)-MMR_Beg(J,K,M))/dT + ENDDO + ENDDO + ENDIF + ENDDO + + IF (PRESENT(fh2o)) THEN + fh2o(:nY) = 0.0e+0_r8 + !DO K = 1, nZ + ! fh2o(:nY) = fh2o(:nY) + Ptend%Q(:nY,K,iH2O)*State%Pdel(:nY,K)/Gravit + !ENDDO + ENDIF + + IF (rootChunk) WRITE(iulog,'(a)') ' GEOS-Chem chemistry step completed' + + end subroutine chem_timestep_tend + +!=============================================================================== + subroutine chem_init_cnst(name, latvals, lonvals, mask, q) + + CHARACTER(LEN=*), INTENT(IN) :: name ! constituent name + 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(OUT) :: q(:,:) ! kg tracer/kg dry air (NCOL, PVER + ! Used to initialize tracer fields if desired. + ! Will need a simple mapping structure as well as the CAM tracer registration + ! routines. + + INTEGER :: ILEV, NLEV, I + REAL(r8) :: QTemp, Min_MMR + + IF (MasterProc) WRITE(iulog,'(a)') 'GCCALL CHEM_INIT_CNST' + + NLEV = SIZE(Q, 2) + ! Retrieve a "background value" for this from the database + Min_MMR = 1.0e-38_r8 + DO I = 1, nTracers + IF (TRIM(tracerNames(I)).eq.TRIM(name)) THEN + Min_MMR = ref_MMR(i) + EXIT + ENDIF + ENDDO + + DO ILEV = 1, NLEV + WHERE(MASK) + ! Set to the minimum mixing ratio + Q(:,ILEV) = Min_MMR + END WHERE + ENDDO + + end subroutine chem_init_cnst + +!=============================================================================== + subroutine chem_final + + use Input_Opt_Mod, only : Cleanup_Input_Opt + use State_Chm_Mod, only : Cleanup_State_Chm + use State_Diag_Mod, only : Cleanup_State_Diag + use State_Grid_Mod, only : Cleanup_State_Grid + use State_Met_Mod, only : Cleanup_State_Met + use Error_Mod, only : Cleanup_Error + + use FlexChem_Mod, only : Cleanup_FlexChem + use UCX_Mod, only : Cleanup_UCX + use Drydep_Mod, only : Cleanup_Drydep + use WetScav_Mod, only : Cleanup_Wetscav + use Carbon_Mod, only : Cleanup_Carbon + use Dust_Mod, only : Cleanup_Dust + use Seasalt_Mod, only : Cleanup_Seasalt + use Aerosol_Mod, only : Cleanup_Aerosol + use TOMS_Mod, only : Cleanup_Toms + use Sulfate_Mod, only : Cleanup_Sulfate + use Pressure_Mod, only : Cleanup_Pressure + use Strat_Chem_Mod, only : Cleanup_Strat_Chem + use PBL_Mix_Mod, only : Cleanup_PBL_Mix + + use CMN_Size_Mod, only : Cleanup_CMN_Size + use CMN_O3_Mod, only : Cleanup_CMN_O3 + use CMN_FJX_Mod, only : Cleanup_CMN_FJX + + ! Special: cleans up after NDXX_Setup + use Diag_Mod, only : Cleanup_Diag + + use GC_Emissions_Mod, only: GC_Emissions_Final + + INTEGER :: I, RC + LOGICAL :: am_I_Root + + ! Finalize GEOS-Chem + IF (MasterProc) WRITE(iulog,'(a)') 'GCCALL CHEM_FINAL' + + CALL Cleanup_UCX( MasterProc ) + CALL Cleanup_Aerosol + CALL Cleanup_Carbon + CALL Cleanup_Drydep + CALL Cleanup_Dust + CALL Cleanup_FlexChem( am_I_Root, RC ) + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Cleanup_FlexChem"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + CALL Cleanup_PBL_Mix + CALL Cleanup_Pressure + CALL Cleanup_Seasalt + CALL Cleanup_Sulfate + CALL Cleanup_Strat_Chem + CALL Cleanup_Toms( MasterProc, RC ) + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Cleanup_Toms"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + CALL Cleanup_WetScav( MasterProc, RC) + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Cleanup_WetScav"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + CALL GC_Emissions_Final + + ! Call extra cleanup routines, from modules in Headers/ + CALL Cleanup_CMN_O3( MasterProc, RC ) + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Cleanup_CMN_O3"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + CALL Cleanup_CMN_SIZE( MasterProc, RC ) + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Cleanup_CMN_SIZE"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + CALL Cleanup_CMN_FJX( MasterProc, RC ) + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Cleanup_CMN_FJX"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + CALL Cleanup_Diag + + ! Cleanup Input_Opt + CALL Cleanup_Input_Opt( MasterProc, Input_Opt, RC ) + + ! Loop over each chunk and cleanup the variables + DO I = BEGCHUNK, ENDCHUNK + am_I_Root = ((I.eq.BEGCHUNK) .and. MasterProc) + + CALL Cleanup_State_Chm ( am_I_Root, State_Chm(I), RC ) + CALL Cleanup_State_Diag( am_I_Root, State_Diag(I), RC ) + CALL Cleanup_State_Grid( am_I_Root, State_Grid(I), RC ) + CALL Cleanup_State_Met ( am_I_Root, State_Met(I), RC ) + ENDDO + CALL Cleanup_Error + + ! Finally deallocate state variables + IF (ALLOCATED(State_Chm)) DEALLOCATE(State_Chm) + IF (ALLOCATED(State_Diag)) DEALLOCATE(State_Diag) + IF (ALLOCATED(State_Grid)) DEALLOCATE(State_Grid) + IF (ALLOCATED(State_Met)) DEALLOCATE(State_Met) + + IF (ALLOCATED(slvd_Lst )) DEALLOCATE(slvd_Lst) + IF (ALLOCATED(slvd_ref_MMR)) DEALLOCATE(slvd_ref_MMR) + + RETURN + + end subroutine chem_final +!=============================================================================== + subroutine chem_init_restart(File) + use pio, only : file_desc_t + TYPE(file_desc_t) :: File + + IF (MasterProc) WRITE(iulog,'(a)') 'GCCALL CHEM_INIT_RESTART' + + RETURN + + end subroutine chem_init_restart +!=============================================================================== + subroutine chem_write_restart( File ) + !use tracer_cnst, only: write_tracer_cnst_restart + !use tracer_srcs, only: write_tracer_srcs_restart + !use linoz_data, only: write_linoz_data_restart + use pio, only : file_desc_t + IMPLICIT NONE + TYPE(file_desc_t) :: File + + IF (MasterProc) WRITE(iulog,'(a)') 'GCCALL CHEM_WRITE_RESTART' + ! + ! data for offline tracers + ! + !call write_tracer_cnst_restart(File) + !call write_tracer_srcs_restart(File) + !call write_linoz_data_restart(File) + end subroutine chem_write_restart +!=============================================================================== + subroutine chem_read_restart( File ) + !use tracer_cnst, only: read_tracer_cnst_restart + !use tracer_srcs, only: read_tracer_srcs_restart + !use linoz_data, only: read_linoz_data_restart + + use pio, only : file_desc_t + IMPLICIT NONE + TYPE(file_desc_t) :: File + + if (MasterProc) WRITE(iulog,'(a)') 'GCCALL CHEM_READ_RESTART' + ! + ! data for offline tracers + ! + !call read_tracer_cnst_restart(File) + !call read_tracer_srcs_restart(File) + !call read_linoz_data_restart(File) + end subroutine chem_read_restart +!================================================================================ + subroutine chem_emissions( state, cam_in ) + use camsrfexch, only: cam_in_t + + use PhysConstants, only: PI, PI_180 + + ! Arguments: + + TYPE(physics_state), INTENT(IN) :: state ! Physics state variables + TYPE(cam_in_t), INTENT(INOUT) :: cam_in ! import state + + REAL(r8) :: Rlats(State%NCOL) + REAL(r8) :: Rlons(State%NCOL) + REAL(r8) :: Dlat, Dlon + REAL(r8) :: SFlx(State%NCOL,nTracers) + + INTEGER :: M, N, I + INTEGER :: LCHNK, NCOL + LOGICAL :: rootChunk + + LOGICAL, SAVE :: FIRST = .TRUE. + + ! LCHNK: which chunk we have on this process + LCHNK = State%LCHNK + ! NCOL: number of atmospheric columns on this chunk + NCOL = State%NCOL + rootChunk = ( MasterProc.and.(LCHNK.EQ.BEGCHUNK) ) + + SFlx(:,:) = 0.0e+0_r8 + Rlats(1:ncol) = State%Lat(1:NCOL) + Rlons(1:ncol) = State%Lon(1:NCOL) + + IF (FIRST) THEN + ENDIF + + !TMMF + ! Test: emit 1e-10 kg/m2/s of NO in a square around Europe + DO M = 1, PCNST + N = map2GC(M) + IF ((N>0).and.(N==iNO)) THEN + SFlx(:,N) = 0.0e+0_r8 + DO I = 1, NCOL + Dlat = Rlats(i) / REAL(PI_180,r8) + Dlon = Rlons(i) / REAL(PI_180,r8) + IF ((Dlat > 50.0e+0_r8).and.(Dlat < 60.0e+0_r8).and.(Dlon > -15.0e+0_r8).and.(Dlon < 5.0e+0_r8)) THEN + SFlx(I,N) = SFlx(I,N) + 1.0e-10_r8 + ENDIF + ENDDO + cam_in%CFlx(:NCOL,M) = cam_in%CFlx(:NCOL,M) + SFlx(:NCOL,N) + ENDIF + ENDDO + + end subroutine chem_emissions + +end module chemistry diff --git a/src/chemistry/pp_geoschem/clybry_fam.F90 b/src/chemistry/pp_geoschem/clybry_fam.F90 new file mode 100644 index 0000000000..d53a32fdf0 --- /dev/null +++ b/src/chemistry/pp_geoschem/clybry_fam.F90 @@ -0,0 +1,180 @@ +!----------------------------------------------------------------------- +! +! Manages the adjustment of ClOy and BrOy family components in response +! to conservation issues resulting from advection. +! +! Created by: Francis Vitt +! Date: 21 May 2008 +! Modified by Stacy Walters +! Date: 13 August 2008 +!----------------------------------------------------------------------- + +module clybry_fam + + use shr_kind_mod, only : r8 => shr_kind_r8 + use ppgrid, only : pcols, pver + use chem_mods, only : gas_pcnst, adv_mass + use constituents, only : pcnst + use short_lived_species,only: set_short_lived_species,get_short_lived_species + + implicit none + + save + + private + public :: clybry_fam_set + public :: clybry_fam_adj + public :: clybry_fam_init + + integer :: id_cly,id_bry + + integer :: id_cl,id_clo,id_hocl,id_cl2,id_cl2o2,id_oclo,id_hcl,id_clono2 + integer :: id_br,id_bro,id_hbr,id_brono2,id_brcl,id_hobr + + logical :: has_clybry + +contains + + !------------------------------------------ + !------------------------------------------ + subroutine clybry_fam_init + + !use mo_chem_utls, only : get_spc_ndx + implicit none + + integer :: ids(16) + + !id_cly = get_spc_ndx('CLY') + !id_bry = get_spc_ndx('BRY') + + !id_cl = get_spc_ndx('CL') + !id_clo = get_spc_ndx('CLO') + !id_hocl = get_spc_ndx('HOCL') + !id_cl2 = get_spc_ndx('CL2') + !id_cl2o2 = get_spc_ndx('CL2O2') + !id_oclo = get_spc_ndx('OCLO') + !id_hcl = get_spc_ndx('HCL') + !id_clono2 = get_spc_ndx('CLONO2') + + !id_br = get_spc_ndx('BR') + !id_bro = get_spc_ndx('BRO') + !id_hbr = get_spc_ndx('HBR') + !id_brono2 = get_spc_ndx('BRONO2') + !id_brcl = get_spc_ndx('BRCL') + !id_hobr = get_spc_ndx('HOBR') + + !ids = (/ id_cly,id_bry, & + ! id_cl,id_clo,id_hocl,id_cl2,id_cl2o2,id_oclo,id_hcl,id_clono2, & + ! id_br,id_bro,id_hbr,id_brono2,id_brcl,id_hobr /) + + !has_clybry = all( ids(:) > 0 ) + + endsubroutine clybry_fam_init + +!-------------------------------------------------------------- +! set the ClOy and BrOy mass mixing ratios +! - this is call before advection +!-------------------------------------------------------------- + subroutine clybry_fam_set( ncol, lchnk, map2chm, q, pbuf ) + + use time_manager, only : get_nstep + use physics_buffer, only : physics_buffer_desc + + implicit none + +!-------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------- + integer, intent(in) :: ncol, lchnk + integer, intent(in) :: map2chm(pcnst) + real(r8), intent(inout) :: q(pcols,pver,pcnst) + type(physics_buffer_desc), pointer :: pbuf(:) + + !real(r8) :: wrk(ncol,pver,2) + !real(r8) :: mmr(pcols,pver,gas_pcnst) + !integer :: n, m + + if (.not. has_clybry) return + + end subroutine clybry_fam_set + +!-------------------------------------------------------------- +! adjust the ClOy and BrOy individual family members +! - this is call after advection +!-------------------------------------------------------------- + subroutine clybry_fam_adj( ncol, lchnk, map2chm, q, pbuf ) + + use time_manager, only : is_first_step + use physics_buffer, only : physics_buffer_desc + + implicit none + +!-------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------- + integer, intent(in) :: ncol, lchnk + integer, intent(in) :: map2chm(pcnst) + real(r8), intent(inout) :: q(pcols,pver,pcnst) + type(physics_buffer_desc), pointer :: pbuf(:) + + end subroutine clybry_fam_adj + +!-------------------------------------------------------------- +! private methods +!-------------------------------------------------------------- + +!-------------------------------------------------------------- +! compute the mass mixing retio of ClOy +!-------------------------------------------------------------- + function cloy( q, pcols, ncol ) + +!-------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------- + integer, intent(in) :: pcols + integer, intent(in) :: ncol + real(r8), intent(in) :: q(pcols,pver,gas_pcnst) + +!-------------------------------------------------------------- +! ... function declaration +!-------------------------------------------------------------- + real(r8) :: cloy(ncol,pver) + +!-------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------- + real(r8) :: wrk(ncol) + integer :: k + + cloy = 0._r8 + + end function cloy + +!-------------------------------------------------------------- +! compute the mass mixing retio of BrOy +!-------------------------------------------------------------- + function broy( q, pcols, ncol ) + +!-------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------- + integer, intent(in) :: pcols + integer, intent(in) :: ncol + real(r8), intent(in) :: q(pcols,pver,gas_pcnst) + +!-------------------------------------------------------------- +! ... function declaration +!-------------------------------------------------------------- + real(r8) :: broy(ncol,pver) + +!-------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------- + real(r8) :: wrk(ncol) + integer :: k + + broy = 0._r8 + + end function broy + +end module clybry_fam diff --git a/src/chemistry/pp_geoschem/epp_ionization.F90 b/src/chemistry/pp_geoschem/epp_ionization.F90 new file mode 100644 index 0000000000..98276cd5f3 --- /dev/null +++ b/src/chemistry/pp_geoschem/epp_ionization.F90 @@ -0,0 +1,508 @@ +!------------------------------------------------------------------------------- +! Energetic Particle Precipitation (EPP) forcings module +! Manages ionization of the atmosphere due to energetic particles, which consists of +! solar protons events (SPE), galactic cosmic rays(GCR), medium energy electrons (MEE) +!------------------------------------------------------------------------------- +module epp_ionization + use shr_kind_mod, only : r8 => shr_kind_r8, cs => shr_kind_cs, cl=> shr_kind_cl + use spmd_utils, only : masterproc + use cam_abortutils, only : endrun + use cam_logfile, only : iulog + use phys_grid, only : pcols, pver, begchunk, endchunk, get_ncols_p + use pio, only : var_desc_t, file_desc_t + use pio, only : pio_get_var, pio_inq_varid, pio_get_att + use pio, only : pio_inq_varndims, pio_inq_vardimid, pio_inq_dimname, pio_inq_dimlen + use pio, only : PIO_NOWRITE + use cam_pio_utils, only : cam_pio_openfile + use ioFileMod, only : getfil + use input_data_utils, only : time_coordinate + + implicit none + private + + public :: epp_ionization_readnl ! read namelist variables + public :: epp_ionization_init ! initialization + public :: epp_ionization_adv ! read and time/space interpolate the data + public :: epp_ionization_ionpairs! ion pairs production rates + public :: epp_ionization_setmag ! update geomagnetic coordinates mapping + public :: epp_ionization_active + + character(len=cl) :: epp_all_filepath = 'NONE' + character(len=cs) :: epp_all_varname = 'epp_ion_rates' + character(len=cl) :: epp_mee_filepath = 'NONE' + character(len=cs) :: epp_mee_varname = 'iprm' + character(len=cl) :: epp_spe_filepath = 'NONE' + character(len=cs) :: epp_spe_varname = 'iprp' + character(len=cl) :: epp_gcr_filepath = 'NONE' + character(len=cs) :: epp_gcr_varname = 'iprg' + + logical, protected :: epp_ionization_active = .false. + + type input_obj_t + type(file_desc_t) :: fid + type(var_desc_t) :: vid + character(len=32) :: units + integer :: nlevs = 0 + integer :: nglats = 0 + real(r8), allocatable :: press(:) + real(r8), allocatable :: glats(:) + real(r8), allocatable :: gwght(:,:) ! (pcol, begchunk:endchunk) + integer, allocatable :: glatn(:,:) ! (pcol, begchunk:endchunk) + real(r8), allocatable :: indata(:,:,:,:) ! (pcol,nlevs,begchunk:endchunk,2) inputs at indexm and indexp + type(time_coordinate) :: time_coord + endtype input_obj_t + + type(input_obj_t), pointer :: epp_in => null() + type(input_obj_t), pointer :: spe_in => null() + type(input_obj_t), pointer :: mee_in => null() + type(input_obj_t), pointer :: gcr_in => null() + +contains + + !----------------------------------------------------------------------------- + !----------------------------------------------------------------------------- + subroutine epp_ionization_readnl(nlfile) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use spmd_utils, only: mpicom, mpi_character, masterprocid + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + !! Local variables + !integer :: unitn, ierr + !character(len=*), parameter :: subname = 'epp_ionization_readnl' + + !namelist /epp_ionization_nl/ epp_all_filepath, epp_all_varname, & + ! epp_mee_filepath, epp_mee_varname, epp_spe_filepath, epp_spe_varname, epp_gcr_filepath, epp_gcr_varname + + !! Read namelist + !if (masterproc) then + ! unitn = getunit() + ! open( unitn, file=trim(nlfile), status='old' ) + ! call find_group_name(unitn, 'epp_ionization_nl', status=ierr) + ! if (ierr == 0) then + ! read(unitn, epp_ionization_nl, iostat=ierr) + ! if (ierr /= 0) then + ! call endrun(subname // ':: ERROR reading namelist') + ! end if + ! end if + ! close(unitn) + ! call freeunit(unitn) + !end if + + !! Broadcast namelist variables + !call mpi_bcast(epp_all_filepath, len(epp_all_filepath), mpi_character, masterprocid, mpicom, ierr) + !call mpi_bcast(epp_mee_filepath, len(epp_mee_filepath), mpi_character, masterprocid, mpicom, ierr) + !call mpi_bcast(epp_spe_filepath, len(epp_spe_filepath), mpi_character, masterprocid, mpicom, ierr) + !call mpi_bcast(epp_gcr_filepath, len(epp_gcr_filepath), mpi_character, masterprocid, mpicom, ierr) + + !call mpi_bcast(epp_all_varname, len(epp_all_varname), mpi_character, masterprocid, mpicom, ierr) + !call mpi_bcast(epp_mee_varname, len(epp_mee_varname), mpi_character, masterprocid, mpicom, ierr) + !call mpi_bcast(epp_spe_varname, len(epp_spe_varname), mpi_character, masterprocid, mpicom, ierr) + !call mpi_bcast(epp_gcr_varname, len(epp_gcr_varname), mpi_character, masterprocid, mpicom, ierr) + + !epp_ionization_active = epp_all_filepath /= 'NONE' + !epp_ionization_active = epp_mee_filepath /= 'NONE' .or. epp_ionization_active + !epp_ionization_active = epp_spe_filepath /= 'NONE' .or. epp_ionization_active + !epp_ionization_active = epp_gcr_filepath /= 'NONE' .or. epp_ionization_active + + !if ( epp_ionization_active .and. masterproc ) then + ! write(iulog,*) subname//':: epp_all_filepath = '//trim(epp_all_filepath) + ! write(iulog,*) subname//':: epp_mee_filepath = '//trim(epp_mee_filepath) + ! write(iulog,*) subname//':: epp_spe_filepath = '//trim(epp_spe_filepath) + ! write(iulog,*) subname//':: epp_gcr_filepath = '//trim(epp_gcr_filepath) + !endif + + end subroutine epp_ionization_readnl + + !----------------------------------------------------------------------------- + !----------------------------------------------------------------------------- + subroutine epp_ionization_init() + !use cam_history, only : addfld + + !character(len=32) :: fldunits + !fldunits = '' + ! + !if (epp_all_filepath /= 'NONE') then + ! epp_in => create_input_obj(epp_all_filepath,epp_all_varname) + ! fldunits = trim(epp_in%units) + !else + ! if (epp_mee_filepath /= 'NONE') then + ! mee_in => create_input_obj(epp_mee_filepath,epp_mee_varname) + ! fldunits = trim(mee_in%units) + ! endif + ! if (epp_spe_filepath /= 'NONE') then + ! spe_in => create_input_obj(epp_spe_filepath,epp_spe_varname) + ! fldunits = trim(spe_in%units) + ! endif + ! if (epp_gcr_filepath /= 'NONE') then + ! gcr_in => create_input_obj(epp_gcr_filepath,epp_gcr_varname) + ! fldunits = trim(gcr_in%units) + ! endif + !endif + !call addfld( 'EPPions', (/ 'lev' /), 'A', fldunits, 'EPP ionization data' ) + + end subroutine epp_ionization_init + + !----------------------------------------------------------------------------- + !----------------------------------------------------------------------------- + subroutine epp_ionization_setmag( maglat ) + real(r8), intent(in) :: maglat(pcols,begchunk:endchunk) + + if (.not.epp_ionization_active) return + + !if ( associated(epp_in) ) then + ! call set_wghts(maglat,epp_in) + !else + ! if ( associated(mee_in) ) then + ! call set_wghts(maglat,mee_in) + ! endif + ! if ( associated(spe_in) ) then + ! call set_wghts(maglat,spe_in) + ! endif + ! if ( associated(gcr_in) ) then + ! call set_wghts(maglat,gcr_in) + ! endif + !endif + + end subroutine epp_ionization_setmag + + !----------------------------------------------------------------------------- + !----------------------------------------------------------------------------- + subroutine epp_ionization_adv + + if (.not.epp_ionization_active) return + + !if ( associated(epp_in) ) then + ! call update_input(epp_in) + !else + ! if ( associated(spe_in) ) then + ! call update_input(spe_in) + ! endif + ! if ( associated(gcr_in) ) then + ! call update_input(gcr_in) + ! endif + ! if ( associated(mee_in) ) then + ! call update_input(mee_in) + ! endif + !endif + + end subroutine epp_ionization_adv + + !----------------------------------------------------------------------------- + !----------------------------------------------------------------------------- + subroutine epp_ionization_ionpairs( ncol, lchnk, pmid, temp, ionpairs ) + + integer, intent(in) :: ncol, lchnk + real(r8), intent(in) :: pmid(:,:), temp(:,:) + real(r8), intent(out) :: ionpairs(:,:) ! ion pair production rate + + ionpairs = 0._r8 + if (.not.epp_ionization_active) return + + !if ( associated(epp_in) ) then + ! ionpairs(:ncol,:) = ionpairs(:ncol,:) + interp_ionpairs( ncol, lchnk, pmid, temp, epp_in ) + !else + ! if ( associated(spe_in) ) then + ! ionpairs(:ncol,:) = ionpairs(:ncol,:) + interp_ionpairs( ncol, lchnk, pmid, temp, spe_in ) + ! endif + ! if ( associated(gcr_in) ) then + ! ionpairs(:ncol,:) = ionpairs(:ncol,:) + interp_ionpairs( ncol, lchnk, pmid, temp, gcr_in ) + ! endif + ! if ( associated(mee_in) ) then + ! ionpairs(:ncol,:) = ionpairs(:ncol,:) + interp_ionpairs( ncol, lchnk, pmid, temp, mee_in ) + ! endif + !endif + + end subroutine epp_ionization_ionpairs + + ! private methods + !----------------------------------------------------------------------------- + !----------------------------------------------------------------------------- + subroutine update_input( input ) + type(input_obj_t), pointer :: input + + if ( input%time_coord%read_more() ) then + call input%time_coord%advance() + call read_next_data( input ) + else + call input%time_coord%advance() + endif + + end subroutine update_input + + !----------------------------------------------------------------------------- + !----------------------------------------------------------------------------- + subroutine read_next_data( input ) + type(input_obj_t), pointer :: input + + !! read data corresponding surrounding time indices + !if ( input%nglats > 0 ) then + ! call read_2d_profile( input ) + !else + ! call read_1d_profile( input ) + !endif + + end subroutine read_next_data + + !----------------------------------------------------------------------------- + !----------------------------------------------------------------------------- + function interp_ionpairs( ncol, lchnk, pmid, temp, input ) result( ionpairs ) + use interpolate_data, only : lininterp + use physconst, only : rairv + use cam_history, only : outfld + + integer, intent(in) :: ncol, lchnk + real(r8), intent(in) :: pmid(:,:) ! Pa + real(r8), intent(in) :: temp(:,:) ! K + type(input_obj_t), pointer :: input + real(r8) :: ionpairs(ncol,pver) + + real(r8) :: fctr1, fctr2 + real(r8) :: wrk(ncol,input%nlevs) + real(r8) :: ions_diags(ncol,pver) ! for diagnostics + integer :: i + + !if (input%time_coord%time_interp) then + ! ! time interpolate + ! fctr1 = input%time_coord%wghts(1) + ! fctr2 = input%time_coord%wghts(2) + ! wrk(:ncol,:) = fctr1*input%indata(:ncol,:,lchnk,1) + fctr2*input%indata(:ncol,:,lchnk,2) + !else + ! wrk(:ncol,:) = input%indata(:ncol,:,lchnk,1) + !endif + + !! vertical interpolate ... + !! interpolate to model levels + !do i = 1,ncol + + ! ! interpolate over log pressure + ! call lininterp( wrk(i,:input%nlevs), log(input%press(:input%nlevs)*1.e2_r8), input%nlevs, & + ! ionpairs(i,:pver), log(pmid(i,:pver)), pver ) + ! ions_diags(i,:pver) = ionpairs(i,:pver) + ! + ! if ( index(trim(input%units), 'g^-1') > 0 ) then + ! ! convert to ionpairs/cm3/sec + ! ionpairs(i,:pver) = ionpairs(i,:pver) *(1.e-3_r8*pmid(i,:pver)/(rairv(i,:pver,lchnk)*temp(i,:pver))) + ! endif + !enddo + + !call outfld( 'EPPions', ions_diags(:ncol,:), ncol, lchnk ) + + end function interp_ionpairs + + !----------------------------------------------------------------------------- + ! read 2D profile (geomag-lat vs press) and transfer to geographic grid + !----------------------------------------------------------------------------- + subroutine read_2d_profile( input ) + + type(input_obj_t), pointer :: input + + ! local vars + real(r8) :: wrk2d( input%nglats, input%nlevs, 2 ) + integer :: t, c, i, ntimes, ncols, ierr + real(r8) :: wght1, wght2 + integer :: gndx1, gndx2 + integer :: cnt(3), strt(3) + + !if (input%time_coord%time_interp) then + ! ntimes = 2 + !else + ! ntimes = 1 + !endif + + !cnt(1) = input%nglats + !cnt(2) = input%nlevs + !cnt(3) = ntimes + + !strt(:) = 1 + !strt(3) = input%time_coord%indxs(1) + + !ierr = pio_get_var( input%fid, input%vid, strt, cnt, wrk2d ) + + !do t = 1,ntimes + ! do c=begchunk,endchunk + ! ncols = get_ncols_p(c) + ! do i = 1,ncols + ! gndx1 = input%glatn(i,c) + ! if (gndx1>0) then + ! wght1 = input%gwght(i,c) + ! gndx2 = gndx1+1 + ! if (gndx2.le.input%nglats) then + ! wght2 = 1._r8-wght1 + ! input%indata(i,:,c,t) = wght1*wrk2d(gndx1,:,t) & + ! + wght2*wrk2d(gndx2,:,t) + ! else + ! input%indata(i,:,c,t) = wght1*wrk2d(gndx1,:,t) + ! endif + ! else + ! input%indata(i,:,c,t) = 0._r8 + ! endif + ! end do + ! end do + !end do + + end subroutine read_2d_profile + + !----------------------------------------------------------------------------- + ! read 1D vertical profile and transfer to geographic grid poleward of 60 degrees geomag-lat + !----------------------------------------------------------------------------- + subroutine read_1d_profile( input ) + + type(input_obj_t), pointer :: input + + ! local vars + real(r8) :: wrk( input%nlevs, 2 ) + integer :: t, c, i, ntimes, ncols, ierr + integer :: cnt(2), strt(2) + + !if (input%time_coord%time_interp) then + ! ntimes = 2 + !else + ! ntimes = 1 + !endif + + !cnt(1) = input%nlevs + !cnt(2) = ntimes + + !strt(:) = 1 + !strt(2) = input%time_coord%indxs(1) + + !ierr = pio_get_var( input%fid, input%vid, strt, cnt, wrk ) + + !do t = 1,ntimes + ! do c=begchunk,endchunk + ! ncols = get_ncols_p(c) + ! do i = 1,ncols + ! input%indata(i,:,c,t) = input%gwght(i,c)*wrk(:,t) + ! end do + ! end do + !end do + + end subroutine read_1d_profile + + !----------------------------------------------------------------------------- + !----------------------------------------------------------------------------- + function create_input_obj( path, varname ) result(in_obj) + use infnan, only : nan, assignment(=) + + character(*), intent(in) :: path + character(*), intent(in) :: varname + type(input_obj_t), pointer :: in_obj + + character(len=cl) :: filen + character(len=cl) :: data_units + character(len=cs) :: dimname + integer :: i, ierr + integer, allocatable :: dimids(:) + integer :: pres_did, pres_vid, glat_did, glat_vid, ndims + + if (path .eq. 'NONE') return + + !allocate(in_obj) + + !call in_obj%time_coord%initialize( path ) + + !call getfil( path, filen, 0 ) + !call cam_pio_openfile( in_obj%fid, filen, PIO_NOWRITE ) + + !ierr = pio_inq_varid( in_obj%fid, varname, in_obj%vid ) + + !ierr = pio_get_att( in_obj%fid, in_obj%vid, 'units', data_units) + !in_obj%units = trim(data_units(1:32)) + + !ierr = pio_inq_varndims( in_obj%fid, in_obj%vid, ndims ) + !allocate( dimids(ndims) ) + + !ierr = pio_inq_vardimid( in_obj%fid, in_obj%vid, dimids) + !pres_did = -1 + !glat_did = -1 + !do i = 1,ndims + ! ierr = pio_inq_dimname( in_obj%fid, dimids(i), dimname ) + ! select case( trim(dimname(1:4)) ) + ! case ( 'pres', 'lev', 'plev' ) + ! pres_did = dimids(i) + ! ierr = pio_inq_varid( in_obj%fid, dimname, pres_vid) + ! case ( 'glat' ) + ! glat_did = dimids(i) + ! ierr = pio_inq_varid( in_obj%fid, dimname, glat_vid) + ! case default + ! end select + !end do + + !deallocate( dimids ) + + !if (pres_did>0) then + ! ierr = pio_inq_dimlen( in_obj%fid, pres_did, in_obj%nlevs ) + ! allocate( in_obj%press(in_obj%nlevs) ) + ! ierr = pio_get_var( in_obj%fid, pres_vid, in_obj%press ) + !endif + !if (glat_did>0) then + ! ierr = pio_inq_dimlen( in_obj%fid, glat_did, in_obj%nglats ) + ! allocate( in_obj%glats(in_obj%nglats) ) + ! ierr = pio_get_var( in_obj%fid, glat_vid, in_obj%glats ) + ! allocate( in_obj%glatn(pcols,begchunk:endchunk) ) + !endif + ! + !allocate( in_obj%gwght(pcols,begchunk:endchunk) ) + + !if (in_obj%time_coord%time_interp) then + ! allocate( in_obj%indata(pcols,in_obj%nlevs,begchunk:endchunk,2) ) + !else + ! allocate( in_obj%indata(pcols,in_obj%nlevs,begchunk:endchunk,1) ) + !endif + !in_obj%indata = nan + + end function create_input_obj + + !----------------------------------------------------------------------- + !----------------------------------------------------------------------- + subroutine set_wghts( maglat, input ) + + real(r8), intent(in) :: maglat(pcols,begchunk:endchunk) + type(input_obj_t), pointer :: input + + integer :: i, c, ncols, imag + + !if (input%nglats>1) then ! read in general EPP 2D ionpairs production rates + ! do c = begchunk,endchunk + ! ncols = get_ncols_p(c) + ! col_loop: do i = 1,ncols + ! if ( maglat(i,c) .lt. input%glats(1) ) then + ! input%glatn(i,c) = 1 + ! input%gwght(i,c) = 1._r8 + ! elseif ( maglat(i,c) .gt. input%glats(input%nglats) ) then + ! input%glatn(i,c) = input%nglats + ! input%gwght(i,c) = 1._r8 + ! else + ! mag_loop: do imag = 1,input%nglats-1 + ! if ( maglat(i,c) .ge. input%glats(imag) .and. & + ! maglat(i,c) .lt. input%glats(imag+1) ) then + ! input%gwght(i,c) = (input%glats(imag+1)-maglat(i,c) ) & + ! / (input%glats(imag+1)-input%glats(imag)) + ! input%glatn(i,c) = imag + ! exit mag_loop + ! endif + ! enddo mag_loop + ! endif + ! enddo col_loop + ! enddo + !else ! read in 1D SPE ionpairs profile ... + ! do c = begchunk,endchunk + ! ncols = get_ncols_p(c) + ! do i = 1,ncols + ! if ( abs(maglat(i,c)) .ge. 60._r8 ) then ! poleward of 60 degrees + ! input%gwght(i,c) = 1._r8 + ! else + ! input%gwght(i,c) = 0._r8 + ! endif + ! enddo + ! enddo + !endif + + !call read_next_data( input ) ! update the inputs when wghts are updated + + end subroutine set_wghts + +end module epp_ionization diff --git a/src/chemistry/pp_geoschem/gc_emissions.F90 b/src/chemistry/pp_geoschem/gc_emissions.F90 new file mode 100644 index 0000000000..05841a9e66 --- /dev/null +++ b/src/chemistry/pp_geoschem/gc_emissions.F90 @@ -0,0 +1,76 @@ +!================================================================================================ +! This is the "GEOS-Chem" chemistry emissions interface +!================================================================================================ +module GC_Emissions_Mod + + use Shr_kind_mod, only : r8 => shr_kind_r8 + use Spmd_utils, only : MasterProc, myCPU=>iam, nCPUs=>npes + use Cam_logfile, only : iulog + use Cam_abortutils, only : endrun + + use Chem_mods, only : NTracers + use Chem_mods, only : TracerNames + use Chem_mods, only : Map2GC + + use Tracer_data, only : trfld,trfile + + IMPLICIT NONE + + TYPE :: Emission + INTEGER :: Spc_Ndx + REAL(r8) :: MW + 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 + ENDTYPE Emission + + PRIVATE + + PUBLIC :: GC_Emissions_Init + PUBLIC :: GC_Emissions_Calc + PUBLIC :: GC_Emissions_Final + + ! Stand-in: emissions + TYPE(Emission), ALLOCATABLE :: Emissions(:) + INTEGER :: N_Emis_Files + +!================================================================================================ +contains +!================================================================================================ + + subroutine GC_Emissions_Init + + INTEGER :: Ierr + + N_Emis_Files=1 + ALLOCATE(Emissions(N_Emis_Files), STAT=IERR) + IF (IERR.NE.0) CALL ENDRUN('Could not allocate GC emissions') + + end subroutine GC_Emissions_Init + + subroutine GC_Emissions_Calc(Eflx) + + ! Emissions in kg/m2/s + ! Dimensions: [N columns x K levels x C constituents ] + REAL(r8), INTENT(OUT) :: EFlx(:,:,:) + INTEGER :: I_Trc, I_Emis + + EFlx(:,:,:) = 0.0e+0_r8 + DO I_Emis = 1, N_Emis_Files + ! Read emissions file + DO I_Trc = 1, NTracers + ENDDO + ENDDO + + end subroutine GC_Emissions_Calc + + subroutine GC_Emissions_Final + IF (ALLOCATED(Emissions)) DEALLOCATE(Emissions) + end subroutine GC_Emissions_Final + + end module GC_Emissions_Mod diff --git a/src/chemistry/pp_geoschem/getLandTypes.F90 b/src/chemistry/pp_geoschem/getLandTypes.F90 new file mode 100644 index 0000000000..9852d706f5 --- /dev/null +++ b/src/chemistry/pp_geoschem/getLandTypes.F90 @@ -0,0 +1,218 @@ +!------------------------------------------------------------------------------ +!BOP +! +! !ROUTINE: getLandTypes.F90 +! +! !DESCRIPTION: Subroutine getLandTypes converts the land types and leaf +! area indices from the land model to the LandTypeFrac and XLAI_NATIVE +! arrays in GEOS-Chem. +! +! !INTERFACE: +! + SUBROUTINE getLandTypes( cam_in, nY, State_Met ) +! +! !USES: +! + USE camsrfexch, ONLY : cam_in_t + USE State_Met_Mod, ONLY : MetState + USE seq_drydep_mod, ONLY : NPatch + USE shr_kind_mod, ONLY : r8 => shr_kind_r8 + USE PRECISION_MOD, ONLY : fp, f4 ! Flexible precision + USE CMN_SIZE_Mod, ONLY : NSURFTYPE + USE cam_abortutils, ONLY : endrun + IMPLICIT NONE +! +! !INPUT PARAMETERS: +! + TYPE(cam_in_t), INTENT(IN ) :: cam_in ! CAM + INTEGER, INTENT(IN ) :: nY ! Number of grid cells on chunk +! +! !INPUT/OUTPUT PARAMETERS: +! + TYPE(MetState), INTENT(INOUT) :: State_Met +! +! !REVISION HISTORY: +! 8 May 2020 - Thibaud M. Fritz - Initial version +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: +! + INTEGER :: J, T + REAL(r8) :: waterFrac, landFrac + +#if defined( CLM40 ) + + ! Mapping for CLM4.0 + ! -----------------------------------|-------------------------------------- + ! Olson land type | CLM land type + ! -----------------------------------|-------------------------------------- + ! Inland/sea water (ID = 1) | Ocean fraction + ! | Deeplake & Shallowlake (LUID =3/4) + ! Urban (ID = 2) | Urban - Not Applied (LUID = 6) + ! Low Sparse Grassland (ID = 3) | + ! Coniferous Forest (ID = 4) | + ! Deciduous Conifer Forest (ID = 5) | Needleleaf Deciduous Bor. (PAID = 3) + ! Deciduous Broadleaf For. (ID = 6) | + ! Evergreen Broadleaf For. (ID = 7) | + ! Tall Grasses and Shrubs (ID = 8) | + ! Bare Desert (ID = 9) | Not veg. \ Ice (PAID = 0\LUID = 2) + ! Upland Tundra (ID = 10) | Broadleaf Deciduous Bore. (PAID = 11) + ! Irrigated Grassland (ID = 11) | C3 Irrigated (PAID = 16) + ! Semi Desert (ID = 12) | + ! Glacier ice (ID = 13) | Land ice (LUID = 2) + ! Wooded Wet Swamp (ID = 14) | + ! - (ID = 15) | + ! - (ID = 16) | + ! Shrub Evergreen (ID = 17) | + ! - (ID = 18) | + ! Shrub Deciduous (ID = 19) | + ! Evergreen Forest and Fi. (ID = 20) | + ! Cool Rain Forest (ID = 21) | + ! Conifer Boreal Forest (ID = 22) | Needleleaf Evergreen Bor. (PAID = 2) + ! Cool Conifer Forest (ID = 23) | + ! Cool Mixed Forest (ID = 24) | Broadleaf Deciduous Bore. (PAID = 8) + ! Mixed Forest (ID = 25) | + ! Cool Broadleaf Forest (ID = 26) | Broadleaf Deciduous Temp. (PAID = 7) + ! Deciduous Broadleaf For. (ID = 27) | + ! Conifer Forest (ID = 28) | Needleleaf Evergreen Tem. (PAID = 1) + ! Montane Tropical Forests (ID = 29) | + ! Seasonal Tropical Fores. (ID = 30) | + ! Cool Crops and Towns (ID = 31) | Winter Temp. Cereal (PAID = 19) + ! Crops and Town (ID = 32) | C3 Crop (PAID = 15) + ! | Spring Temp. Cereal (PAID = 18) + ! Dry Tropical Woods (ID = 33) | + ! Tropical Rainforest (ID = 34) | Broadleaf Evergreen Trop. (PAID = 4) + ! Tropical Degraded Forest (ID = 35) | + ! Corn and Beans Cropland (ID = 36) | Corn (PAID = 17) + ! | Soybean (PAID = 20) + ! Rice Paddy and Field (ID = 37) | + ! Hot Irrigated Cropland (ID = 38) | + ! Cool Irrigated Cropland (ID = 39) | + ! - (ID = 40) | + ! Cool Grasses and Shrubs (ID = 41) | + ! Hot and Mild Grasses and (ID = 42) | C3 Non-Arctic Grass (PAID = 13) + ! Cold Grassland (ID = 43) | C3 Arctic Grass (PAID = 12) + ! Savanna (Woods) (ID = 44) | Broadleaf Deciduous Trop. (PAID = 6) + ! | C4 Grass (PAID = 14) + ! Mire, Bog, Fen (ID = 45) | Wetland - Not Applied (LUID = 5) + ! Marsh Wetland (ID = 46) | + ! Mediterranean Scrub (ID = 47) | Broadleaf Evergreen Shru. (PAID = 9) + ! Dry Woody Scrub (ID = 48) | + ! - (ID = 49) | + ! - (ID = 50) | + ! - (ID = 51) | + ! Semi Desert Shrubs (ID = 52) | Broadleaf Deciduous Temp. (PAID = 10) + ! Semi Desert Sage (ID = 53) | + ! Barren Tundra (ID = 54) | + ! Cool Southern Hemisphere (ID = 55) | Broadleaf Evergreen Temp. (PAID = 5) + ! Cool Fields and Woods (ID = 56) | + ! Forest and Field (ID = 57) | + ! Cool Forest and Field (ID = 58) | + ! Fields and Woody Savanna (ID = 59) | + ! Succulent and Thorn Scr. (ID = 60) | + ! Small Leaf Mixed Woods (ID = 61) | + ! Deciduous and Mixed Bor. (ID = 62) | + ! Narrow Conifers (ID = 63) | + ! Wooded Tundra (ID = 64) | + ! Heath Scrub (ID = 65) | + ! - (ID = 66) | + ! - (ID = 67) | + ! - (ID = 68) | + ! - (ID = 69) | + ! Polar and Alpine Desert (ID = 70) | + ! - (ID = 71) | + ! - (ID = 72) | + ! Mangrove (ID = 73) | + + !================================================================== + ! The urban and wetland land unit types seem to be already + ! accounted for in patches, as it introduces total land fractions + ! (summed over all types) greater than 100%. + ! Thibaud M. Fritz - 06 May 2020 + !================================================================== + + DO J = 1, nY + waterFrac = cam_in%ocnFrac(J) + cam_in%iceFrac(J) & + + cam_in%lwtgcell(J,3) + cam_in%lwtgcell(J,4) + landFrac = 1.0e+0_fp - waterFrac + + ! Initialize fraction land for this grid cell + State_Met%LandTypeFrac(1,J, 1) = waterFrac + !State_Met%LandTypeFrac(1,J, 2) = cam_in%lwtgcell(J, 6) + State_Met%LandTypeFrac(1,J, 9) = cam_in%pwtgcell(J, 1) & + - cam_in%lwtgcell(J, 2) + State_Met%LandTypeFrac(1,J,10) = cam_in%pwtgcell(J,12) + State_Met%LandTypeFrac(1,J,13) = cam_in%lwtgcell(J, 2) + State_Met%LandTypeFrac(1,J,24) = cam_in%pwtgcell(J, 9) + State_Met%LandTypeFrac(1,J,26) = cam_in%pwtgcell(J, 8) + !State_Met%LandTypeFrac(1,J,45) = cam_in%lwtgcell(J, 5) + State_Met%LandTypeFrac(1,J,52) = cam_in%pwtgcell(J,11) + State_Met%LandTypeFrac(1,J,47) = cam_in%pwtgcell(J,10) + State_Met%LandTypeFrac(1,J,55) = cam_in%pwtgcell(J, 6) + State_Met%LandTypeFrac(1,J,34) = cam_in%pwtgcell(J, 5) + State_Met%LandTypeFrac(1,J,43) = cam_in%pwtgcell(J,13) + State_Met%LandTypeFrac(1,J,42) = cam_in%pwtgcell(J,14) + State_Met%LandTypeFrac(1,J,32) = cam_in%pwtgcell(J,16) + State_Met%LandTypeFrac(1,J,44) = cam_in%pwtgcell(J,15) + State_Met%LandTypeFrac(1,J, 5) = cam_in%pwtgcell(J, 4) + State_Met%LandTypeFrac(1,J,22) = cam_in%pwtgcell(J, 3) + State_Met%LandTypeFrac(1,J,28) = cam_in%pwtgcell(J, 2) + State_Met%LandTypeFrac(1,J,44) = & + State_Met%LandTypeFrac(1,J,44) + cam_in%pwtgcell(J, 7) + State_Met%LandTypeFrac(1,J,11) = cam_in%pwtgcell(J,17) + State_Met%LandTypeFrac(1,J,36) = cam_in%pwtgcell(J,18) + State_Met%LandTypeFrac(1,J,31) = cam_in%pwtgcell(J,20) + State_Met%LandTypeFrac(1,J,32) = & + State_Met%LandTypeFrac(1,J,32) + cam_in%pwtgcell(J,19) + State_Met%LandTypeFrac(1,J,36) = & + State_Met%LandTypeFrac(1,J,36) + cam_in%pwtgcell(J,21) + + State_Met%XLAI_NATIVE(1,J,10) = cam_in%lai(J,12) + State_Met%XLAI_NATIVE(1,J,24) = cam_in%lai(J, 9) + State_Met%XLAI_NATIVE(1,J,26) = cam_in%lai(J, 8) + State_Met%XLAI_NATIVE(1,J,52) = cam_in%lai(J,11) + State_Met%XLAI_NATIVE(1,J,47) = cam_in%lai(J,10) + State_Met%XLAI_NATIVE(1,J,55) = cam_in%lai(J, 6) + State_Met%XLAI_NATIVE(1,J,34) = cam_in%lai(J, 5) + State_Met%XLAI_NATIVE(1,J,43) = cam_in%lai(J,13) + State_Met%XLAI_NATIVE(1,J,42) = cam_in%lai(J,14) + State_Met%XLAI_NATIVE(1,J,32) = cam_in%lai(J,16) + State_Met%XLAI_NATIVE(1,J,44) = cam_in%lai(J,15) + State_Met%XLAI_NATIVE(1,J, 5) = cam_in%lai(J, 4) + State_Met%XLAI_NATIVE(1,J,22) = cam_in%lai(J, 3) + State_Met%XLAI_NATIVE(1,J,28) = cam_in%lai(J, 2) + State_Met%XLAI_NATIVE(1,J,44) = & + State_Met%XLAI_NATIVE(1,J,44) + cam_in%lai(J, 7) + State_Met%XLAI_NATIVE(1,J,11) = cam_in%lai(J,17) + State_Met%XLAI_NATIVE(1,J,36) = cam_in%lai(J,18) + State_Met%XLAI_NATIVE(1,J,31) = cam_in%lai(J,20) + State_Met%XLAI_NATIVE(1,J,32) = & + State_Met%XLAI_NATIVE(1,J,32) + cam_in%lai(J,19) + State_Met%XLAI_NATIVE(1,J,36) = & + State_Met%XLAI_NATIVE(1,J,36) + cam_in%lai(J,21) + + DO T = 2, NSURFTYPE + State_Met%LandTypeFrac(1,J,T) = & + State_Met%LandTypeFrac(1,J,T) * landFrac + + State_Met%XLAI_NATIVE(1,J,T) = & + State_Met%XLAI_NATIVE(1,J,T) * landFrac + + ! Make sure that the land type fractions do not exceed 1 + IF ( State_Met%LandTypeFrac(1,J,T) > 1.0e+0_fp ) THEN + State_Met%LandTypeFrac(1,J,T) = 1.0e+0_fp + ELSEIF ( State_Met%LandTypeFrac(1,J,T) < 0.0e+0_fp ) THEN + State_Met%LandTypeFrac(1,J,T) = 0.0e+0_fp + ENDIF + ENDDO + + ENDDO +#elif defined( CLM45 ) || defined( CLM50 ) +#else + CALL endrun('Cannot figure out which version of CLM') +#endif + + END SUBROUTINE getLandTypes +!EOC diff --git a/src/chemistry/pp_geoschem/mo_apex.F90 b/src/chemistry/pp_geoschem/mo_apex.F90 new file mode 100644 index 0000000000..0737f7e278 --- /dev/null +++ b/src/chemistry/pp_geoschem/mo_apex.F90 @@ -0,0 +1,314 @@ +module mo_apex + +!------------------------------------------------------------------------------- +! Purpose: +! +! Calculate apex coordinates and magnetic field magnitudes +! at global geographic grid for year of current model run. +! +! Method: +! +! The magnetic field parameters output by this module are time and height +! independent. They are chunked for waccm physics, i.e., allocated as +! (pcols,begchunk:endchunk) +! Interface sub apexmag is called once per run from sub inti. +! Sub apexmag may be called for years 1900 through 2005. +! This module is dependent on routines in apex_subs.F (modified IGRF model). +! Apex_subs has several authors, but has been modified and maintained +! in recent years by Roy Barnes (bozo@ucar.edu). +! Subs apxmka and apxmall are called with the current lat x lon grid +! resolution. +! +! Author: Ben Foster, foster@ucar.edu (Nov, 2003) +!------------------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + use ppgrid, only: pcols, begchunk, endchunk ! physics grid + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + use spmd_utils, only: masterproc + !use apex, only: apex_mka, apex_mall, apex_dypol, apex_set_igrf + !use apex, only: apex_beg_yr, apex_end_yr + implicit none + + private + public :: mo_apex_readnl + public :: mo_apex_init + public :: mo_apex_init1 + public :: alatm, alonm, bnorth, beast, bdown, bmag + public :: d1vec, d2vec, colatp, elonp + public :: maglon0 ! geographic longitude at the equator where geomagnetic longitude is zero (radians) + + ! year to initialize apex + real(r8), public, protected :: geomag_year = -1._r8 + logical, public, protected :: geomag_year_updated = .true. + + integer :: fixed_geomag_year = -1 + +!------------------------------------------------------------------------------- +! Magnetic field output arrays, chunked for physics: +! (these are allocated (pcols,begchunk:endchunk) by sub allocate_arrays) +!------------------------------------------------------------------------------- + real(r8), protected, allocatable, dimension(:,:) :: & ! (pcols,begchunk:endchunk) + alatm, & ! apex mag latitude at each geographic grid point (radians) + alonm, & ! apex mag longitude at each geographic grid point (radians) + bnorth, & ! northward component of magnetic field + beast, & ! eastward component of magnetic field + bdown, & ! downward component of magnetic field + bmag ! magnitude of magnetic field + real(r8), protected, allocatable, dimension(:,:,:) :: & ! (3,pcols,begchunk:endchunk) + d1vec, & ! base vectors more-or-less magnetic eastward direction + d2vec ! base vectors more-or-less magnetic downward/equatorward direction + real(r8), protected :: & + colatp, & ! geocentric colatitude of geomagnetic dipole north pole (deg) + elonp ! East longitude of geomagnetic dipole north pole (deg) + + real(r8), protected :: maglon0 + + character(len=256) :: igrf_geomag_coefs_file = 'igrf_geomag_coefs_file' + +contains + +!====================================================================== +!====================================================================== +subroutine mo_apex_readnl(nlfile) + + use namelist_utils, only : find_group_name + use units, only : getunit, freeunit + 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 = 'mo_apex_readnl' + + !namelist /geomag_nl/ fixed_geomag_year, igrf_geomag_coefs_file + + !! Read namelist + !if (masterproc) then + ! unitn = getunit() + ! open( unitn, file=trim(nlfile), status='old' ) + ! call find_group_name(unitn, 'geomag_nl', status=ierr) + ! if (ierr == 0) then + ! read(unitn, geomag_nl, iostat=ierr) + ! if (ierr /= 0) then + ! call endrun(subname // ':: ERROR reading namelist') + ! end if + ! end if + ! close(unitn) + ! call freeunit(unitn) + !end if + + !! Broadcast namelist variables + !call mpi_bcast(fixed_geomag_year, 1, mpi_integer, masterprocid, mpicom, ierr) + !call mpi_bcast(igrf_geomag_coefs_file, len(igrf_geomag_coefs_file), mpi_character, masterprocid, mpicom, ierr) + +end subroutine mo_apex_readnl + +!====================================================================== +!====================================================================== +subroutine mo_apex_init1() + use time_manager, only: get_curr_date + use dyn_grid, only: get_horiz_grid_dim_d + + +end subroutine mo_apex_init1 + +!====================================================================== +!====================================================================== +subroutine mo_apex_init(phys_state) +!------------------------------------------------------------------------------- +! Driver for apex code to calculate apex magnetic coordinates at +! current geographic spatial resolution for given year. This calls +! routines in apex_subs.F. +! +! This is called once per run from sub inti. +!------------------------------------------------------------------------------- + + use physconst,only : pi + use physics_types, only: physics_state + !use epp_ionization,only: epp_ionization_setmag + + ! Input/output arguments + type(physics_state), intent(in), dimension(begchunk:endchunk) :: phys_state + +!!------------------------------------------------------------------------------- +!! Local variables +!!------------------------------------------------------------------------------- +! real(r8), parameter :: re = 6.378165e8_r8 ! earth radius (cm) +! real(r8), parameter :: h0 = 9.0e6_r8 ! base height (90 km) +! real(r8), parameter :: hs = 1.3e7_r8 +! real(r8), parameter :: eps = 1.e-6_r8 ! epsilon +! real(r8), parameter :: cm2km = 1.e-5_r8 +! +! integer :: c, i, ist ! indices +! integer :: ncol +! +! real(r8) :: alt, hr, alon, alat, & ! apxmall args +! vmp, w, d, be3, sim, xlatqd, f, si, collat, collon +! +!!------------------------------------------------------------------------------- +!! Non-scalar arguments returned by APXMALL: +!!------------------------------------------------------------------------------- +! real(r8) :: bhat(3) +! real(r8) :: d3(3) +! real(r8) :: e1(3), e2(3), e3(3) +! real(r8) :: f1(2), f2(2) +! +! real(r8) :: bg(3), d1g(3), d2g(3), bmg +! +! real(r8) :: rdum +! +! real(r8) :: maglat(pcols,begchunk:endchunk) +! +! real(r8), parameter :: rtd = 180._r8/pi ! radians to degrees +! real(r8), parameter :: dtr = pi/180._r8 ! degrees to radians +! +! call mo_apex_init1() +! if ((.not.geomag_year_updated) .and. (allocated(alatm))) return +! +!!------------------------------------------------------------------------------- +!! Allocate output arrays +!!------------------------------------------------------------------------------- +! call allocate_arrays() +! +! alt = hs*cm2km ! altitude for apxmall (km) +! hr = alt ! reference altitude (km) +! +!!------------------------------------------------------------------------------ +!! Apex coords alon, alat are returned for each geographic grid point: +!! first form global arrays +!!------------------------------------------------------------------------------ +! do c = begchunk, endchunk +! ncol = phys_state(c)%ncol +! do i = 1,ncol +! collat = phys_state(c)%lat(i)*rtd ! latitude of current column (deg) +! collon = phys_state(c)%lon(i)*rtd ! latitude of current column (deg) +! if ( collon < -180._r8 ) collon = collon+360._r8 +! if ( collon > 180._r8 ) collon = collon-360._r8 +! call apex_mall( & +! collat, collon, alt, hr, & ! Inputs +! bg, bhat, bmag(i,c), si, & ! Mag Fld +! alon, alat, & ! Apex lon,lat output +! vmp, w, d, be3, sim, d1vec(:,i,c), d2vec(:,i,c), d3, e1, e2, e3, & ! Mod Apex +! xlatqd, f, f1, f2, ist ) ! Qsi-Dpl +! if( ist /= 0 ) then +! write(iulog,"(/,'>>> mo_apex_init: Error from apxmall: ist=',i4)") ist +! call endrun('mo_apex_init: Error from apxmall') +! end if +! beast (i,c) = bg(1) +! bnorth(i,c) = bg(2) +! bdown (i,c) = -bg(3) +! alonm (i,c) = alon*dtr ! mag lons (radians) +! alatm (i,c) = alat*dtr ! mag lats (radians) +! maglat(i,c) = alat ! mag lats (degrees) +! enddo +! enddo +! +! ! find geograghic latitude ( maglon0 ) where the geomagnetic latitude is zero at the equator +! ! by first extracting the geographic coordinates at zero degrees longitude ... +! collat = 0._r8 +! collon = 0._r8 +! call apex_mall( & +! collat, collon, alt, hr, & ! Inputs +! bg, bhat, bmg, si, & ! Mag Fld +! alon, alat, & ! Apex lon,lat output +! vmp, w, d, be3, sim, d1g, d2g, d3, e1, e2, e3, & ! Mod Apex +! xlatqd, f, f1, f2, ist ) ! Qsi-Dpl +! +! if( ist /= 0 ) then +! write(iulog,"(/,'>>> mo_apex_init: Error from apxmall: ist=',i4)") ist +! call endrun('mo_apex_init: Error from apxmall') +! end if +! +! maglon0 = -alon*dtr ! (radians) geograghic latitude where the geomagnetic latitude is zero +! ! where longitude ranges from -180E to 180E +! +! call apex_dypol( colatp, elonp, rdum ) ! get geomagnetic dipole north pole +! +! if (masterproc) then +! write(iulog, "('mo_apex_init: colatp,elonp ', 2f12.6)") colatp, elonp +! write(iulog, "('mo_apex_init: Calculated apex magnetic coordinates for year AD ',f8.2)") geomag_year +! endif +! +! call epp_ionization_setmag(maglat) + +end subroutine mo_apex_init + +subroutine allocate_arrays +!!------------------------------------------------------------------------------ +!! Allocate module output arrays for chunked physics grid. +!!------------------------------------------------------------------------------ +! +!!------------------------------------------------------------------------------ +!! local variables +!!------------------------------------------------------------------------------ +! integer :: istat ! status of allocate statements +! +! if (.not.allocated(alatm)) then +! allocate(alatm(pcols,begchunk:endchunk),stat=istat) +! if (istat /= 0) then +! write(iulog,"('>>> allocate_arrays: allocate of alatm failed: istat=',i5)") istat +! call endrun +! end if +! end if +! +! if (.not.allocated(alonm)) then +! allocate(alonm(pcols,begchunk:endchunk),stat=istat) +! if (istat /= 0) then +! write(iulog,"('>>> allocate_arrays: allocate of alonm failed: istat=',i5)") istat +! call endrun +! end if +! end if +! +! if (.not.allocated(bnorth)) then +! allocate(bnorth(pcols,begchunk:endchunk),stat=istat) +! if (istat /= 0) then +! write(iulog,"('>>> allocate_arrays: allocate of bnorth failed: istat=',i5)") istat +! call endrun +! end if +! end if +! +! if (.not.allocated(beast)) then +! allocate(beast(pcols,begchunk:endchunk),stat=istat) +! if (istat /= 0) then +! write(iulog,"('>>> allocate_arrays: allocate of beast failed: istat=',i5)") istat +! call endrun +! end if +! end if +! +! if (.not.allocated(bdown)) then +! allocate(bdown(pcols,begchunk:endchunk),stat=istat) +! if (istat /= 0) then +! write(iulog,"('>>> allocate_arrays: allocate of bdown failed: istat=',i5)") istat +! call endrun +! end if +! end if +! +! if (.not.allocated(bmag)) then +! allocate(bmag(pcols,begchunk:endchunk),stat=istat) +! if (istat /= 0) then +! write(iulog,"('>>> allocate_arrays: allocate of bmag failed: istat=',i5)") istat +! call endrun +! end if +! end if +! if (.not.allocated(d1vec)) then +! allocate(d1vec(3,pcols,begchunk:endchunk),stat=istat) +! if (istat /= 0) then +! write(iulog,"('>>> allocate_arrays: allocate of d1vec failed: istat=',i5)") istat +! call endrun +! endif +! endif +! +! if (.not.allocated(d2vec)) then +! allocate(d2vec(3,pcols,begchunk:endchunk),stat=istat) +! if (istat /= 0) then +! write(iulog,"('>>> allocate_arrays: allocate of d2vec failed: istat=',i5)") istat +! call endrun +! endif +! endif +! +end subroutine allocate_arrays + +end module mo_apex diff --git a/src/chemistry/pp_geoschem/mo_chem_utls.F90 b/src/chemistry/pp_geoschem/mo_chem_utls.F90 new file mode 100644 index 0000000000..1d709c09dc --- /dev/null +++ b/src/chemistry/pp_geoschem/mo_chem_utls.F90 @@ -0,0 +1,162 @@ + +module mo_chem_utls + + private + public :: get_spc_ndx!, get_het_ndx, get_extfrc_ndx, get_rxt_ndx, get_inv_ndx + + save + +contains + + integer function get_spc_ndx( spc_name ) + !----------------------------------------------------------------------- + ! ... return overall species index associated with spc_name + !----------------------------------------------------------------------- + + use chem_mods, only : nTracers, tracnam => tracerNames + use string_utils, only : to_upper + + implicit none + + !----------------------------------------------------------------------- + ! ... dummy arguments + !----------------------------------------------------------------------- + character(len=*), intent(in) :: spc_name + + !----------------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------------- + integer :: m + + get_spc_ndx = -1 + do m = 1, nTracers + if( trim( spc_name ) == trim( to_upper( tracnam(m) ) ) ) then + get_spc_ndx = m + exit + end if + end do + + end function get_spc_ndx + +! integer function get_inv_ndx( invariant ) +! !----------------------------------------------------------------------- +! ! ... return overall external frcing index associated with spc_name +! !----------------------------------------------------------------------- +! +! use chem_mods, only : nfs, inv_lst +! +! implicit none +! +! !----------------------------------------------------------------------- +! ! ... dummy arguments +! !----------------------------------------------------------------------- +! character(len=*), intent(in) :: invariant +! +! !----------------------------------------------------------------------- +! ! ... local variables +! !----------------------------------------------------------------------- +! integer :: m +! +! get_inv_ndx = -1 +! do m = 1,nfs +! if( trim( invariant ) == trim( inv_lst(m) ) ) then +! get_inv_ndx = m +! exit +! end if +! end do +! +! end function get_inv_ndx +! +! integer function get_het_ndx( het_name ) +! !----------------------------------------------------------------------- +! ! ... return overall het process index associated with spc_name +! !----------------------------------------------------------------------- +! +! use gas_wetdep_opts,only : gas_wetdep_method, gas_wetdep_list, gas_wetdep_cnt +! +! implicit none +! +! !----------------------------------------------------------------------- +! ! ... dummy arguments +! !----------------------------------------------------------------------- +! character(len=*), intent(in) :: het_name +! +! !----------------------------------------------------------------------- +! ! ... local variables +! !----------------------------------------------------------------------- +! integer :: m +! +! get_het_ndx=-1 +! +! do m=1,gas_wetdep_cnt +! +! if( trim( het_name ) == trim( gas_wetdep_list(m) ) ) then +! get_het_ndx = get_spc_ndx( gas_wetdep_list(m) ) +! return +! endif +! +! enddo +! +! end function get_het_ndx +! +! integer function get_extfrc_ndx( frc_name ) +! !----------------------------------------------------------------------- +! ! ... return overall external frcing index associated with spc_name +! !----------------------------------------------------------------------- +! +! use chem_mods, only : extcnt, extfrc_lst +! +! implicit none +! +! !----------------------------------------------------------------------- +! ! ... dummy arguments +! !----------------------------------------------------------------------- +! character(len=*), intent(in) :: frc_name +! +! !----------------------------------------------------------------------- +! ! ... local variables +! !----------------------------------------------------------------------- +! integer :: m +! +! get_extfrc_ndx = -1 +! if( extcnt > 0 ) then +! do m = 1,max(1,extcnt) +! if( trim( frc_name ) == trim( extfrc_lst(m) ) ) then +! get_extfrc_ndx = m +! exit +! end if +! end do +! end if +! +! end function get_extfrc_ndx +! +! integer function get_rxt_ndx( rxt_tag ) +! !----------------------------------------------------------------------- +! ! ... return overall external frcing index associated with spc_name +! !----------------------------------------------------------------------- +! +! use chem_mods, only : rxt_tag_cnt, rxt_tag_lst, rxt_tag_map +! +! implicit none +! +! !----------------------------------------------------------------------- +! ! ... dummy arguments +! !----------------------------------------------------------------------- +! character(len=*), intent(in) :: rxt_tag +! +! !----------------------------------------------------------------------- +! ! ... local variables +! !----------------------------------------------------------------------- +! integer :: m +! +! get_rxt_ndx = -1 +! do m = 1,rxt_tag_cnt +! if( trim( rxt_tag ) == trim( rxt_tag_lst(m) ) ) then +! get_rxt_ndx = rxt_tag_map(m) +! exit +! end if +! end do +! +! end function get_rxt_ndx + +end module mo_chem_utls diff --git a/src/chemistry/pp_geoschem/mo_drydep.F90 b/src/chemistry/pp_geoschem/mo_drydep.F90 new file mode 100644 index 0000000000..50656ef30b --- /dev/null +++ b/src/chemistry/pp_geoschem/mo_drydep.F90 @@ -0,0 +1,3303 @@ +module mo_drydep + + !--------------------------------------------------------------------- + ! ... Dry deposition velocity input data and code for netcdf input + !--------------------------------------------------------------------- + +!LKE (10/11/2010): added HCN, CH3CN, HCOOH +!LKE (7/30/2015): added new TS1 species (phenooh, iepox, noa, etc.) + + use shr_kind_mod, only : r8 => shr_kind_r8, shr_kind_cl + !use chem_mods, only : gas_pcnst !This needs to be replaced by nTracersMax + use pmgrid, only : plev, plevp + use spmd_utils, only : masterproc, iam + use ppgrid, only : pcols, begchunk, endchunk + !use mo_tracname, only : solsym !This is replaced by tracerNames + use chem_mods, only : tracerNames, nTracersMax, nTracers, drySpc_ndx + use cam_abortutils, only : endrun + use ioFileMod, only : getfil + use pio + use cam_pio_utils, only : cam_pio_openfile, cam_pio_closefile + use cam_logfile, only : iulog + use dyn_grid, only : get_dyn_grid_parm, get_horiz_grid_d + use scamMod, only : single_column + + use seq_drydep_mod, only : nddvels => n_drydep, drydep_list, mapping + use physconst, only : karman + + use State_Chm_Mod, only : ChmState ! Derived type for Chemistry State object + + implicit none + + save + + interface drydep_inti + module procedure dvel_inti_table + module procedure dvel_inti_xactive + module procedure dvel_inti_fromlnd + end interface + + interface drydep + !module procedure drydep_table + module procedure drydep_xactive + module procedure drydep_fromlnd + end interface + + private + public :: drydep_inti, drydep, set_soilw, chk_soilw, has_drydep + public :: drydep_update + public :: drydep_fromlnd + public :: n_land_type, fraction_landuse, drydep_srf_file + + real(r8) :: dels + real(r8), allocatable :: days(:) ! day of year for soilw + real(r8), allocatable :: dvel(:,:,:,:) ! depvel array interpolated to model grid + real(r8), allocatable :: dvel_interp(:,:,:) ! depvel array interpolated to grid and time + integer :: last, next ! day indicies + integer :: ndays ! # of days in soilw file + !integer :: map(gas_pcnst) ! indices for drydep species + integer :: map(nTracersMax) ! indices for drydep species + integer :: nspecies ! number of depvel species in input file + + integer :: pan_ndx, mpan_ndx, no2_ndx, hno3_ndx, o3_ndx, & + h2o2_ndx, onit_ndx, onitr_ndx, ch4_ndx, ch2o_ndx, & + ch3ooh_ndx, pooh_ndx, ch3coooh_ndx, c2h5ooh_ndx, eooh_ndx, & + c3h7ooh_ndx, rooh_ndx, ch3cocho_ndx, co_ndx, ch3coch3_ndx, & + no_ndx, ho2no2_ndx, glyald_ndx, hyac_ndx, ch3oh_ndx, c2h5oh_ndx, & + hydrald_ndx, h2_ndx, Pb_ndx, o3s_ndx, o3inert_ndx, macrooh_ndx, & + xooh_ndx, ch3cho_ndx, isopooh_ndx + integer :: alkooh_ndx, mekooh_ndx, tolooh_ndx, terpooh_ndx, ch3cooh_ndx + integer :: soa_ndx, so4_ndx, cb1_ndx, cb2_ndx, oc1_ndx, oc2_ndx, nh3_ndx, nh4no3_ndx, & + sa1_ndx, sa2_ndx, sa3_ndx, sa4_ndx, nh4_ndx + integer :: soam_ndx, soai_ndx, soat_ndx, soab_ndx, soax_ndx, & + sogm_ndx, sogi_ndx, sogt_ndx, sogb_ndx, sogx_ndx + + logical :: alkooh_dd, mekooh_dd, tolooh_dd, terpooh_dd, ch3cooh_dd + logical :: soa_dd, so4_dd, cb1_dd, cb2_dd, oc1_dd, oc2_dd, nh3_dd, nh4no3_dd, & + sa1_dd, sa2_dd, sa3_dd, sa4_dd, nh4_dd + logical :: soam_dd, soai_dd, soat_dd, soab_dd, soax_dd, & + sogm_dd, sogi_dd, sogt_dd, sogb_dd, sogx_dd + + logical :: pan_dd, mpan_dd, no2_dd, hno3_dd, o3_dd, isopooh_dd, ch4_dd,& + h2o2_dd, onit_dd, onitr_dd, ch2o_dd, macrooh_dd, xooh_dd, & + ch3ooh_dd, pooh_dd, ch3coooh_dd, c2h5ooh_dd, eooh_dd, ch3cho_dd, c2h5oh_dd, & + c3h7ooh_dd, rooh_dd, ch3cocho_dd, co_dd, ch3coch3_dd, & + glyald_dd, hyac_dd, ch3oh_dd, hydrald_dd, h2_dd, Pb_dd, o3s_dd, o3inert_dd + + integer :: so2_ndx + integer :: ch3cn_ndx, hcn_ndx, hcooh_ndx + logical :: ch3cn_dd, hcn_dd, hcooh_dd + + integer :: o3a_ndx,xpan_ndx,xmpan_ndx,xno2_ndx,xhno3_ndx,xonit_ndx,xonitr_ndx,xno_ndx,xho2no2_ndx,xnh4no3_ndx + logical :: o3a_dd, xpan_dd, xmpan_dd, xno2_dd, xhno3_dd, xonit_dd, xonitr_dd, xno_dd, xho2no2_dd, xnh4no3_dd + +!lke-TS1 + integer :: phenooh_ndx, benzooh_ndx, c6h5ooh_ndx, bzooh_ndx, xylolooh_ndx, xylenooh_ndx + integer :: terp2ooh_ndx, terprod1_ndx, terprod2_ndx, hmprop_ndx, mboooh_ndx, hpald_ndx, iepox_ndx + integer :: noa_ndx, alknit_ndx, isopnita_ndx, isopnitb_ndx, honitr_ndx, isopnooh_ndx + integer :: nc4cho_ndx, nc4ch2oh_ndx, terpnit_ndx, nterpooh_ndx + logical :: phenooh_dd, benzooh_dd, c6h5ooh_dd, bzooh_dd, xylolooh_dd, xylenooh_dd + logical :: terp2ooh_dd, terprod1_dd, terprod2_dd, hmprop_dd, mboooh_dd, hpald_dd, iepox_dd + logical :: noa_dd, alknit_dd, isopnita_dd, isopnitb_dd, honitr_dd, isopnooh_dd + logical :: nc4cho_dd, nc4ch2oh_dd, terpnit_dd, nterpooh_dd + + integer :: cohc_ndx=-1, come_ndx=-1 + integer, parameter :: NTAGS = 50 + integer :: cotag_ndx(NTAGS) + integer :: tag_cnt + + integer :: & + o3_tab_ndx = -1, & + h2o2_tab_ndx = -1, & + ch3ooh_tab_ndx = -1, & + co_tab_ndx = -1, & + ch3cho_tab_ndx = -1 + logical :: & + o3_in_tab = .false., & + h2o2_in_tab = .false., & + ch3ooh_in_tab = .false., & + co_in_tab = .false., & + ch3cho_in_tab = .false. + + real(r8), parameter :: small_value = 1.e-36_r8 + real(r8), parameter :: large_value = 1.e36_r8 + real(r8), parameter :: diffm = 1.789e-5_r8 + real(r8), parameter :: diffk = 1.461e-5_r8 + real(r8), parameter :: difft = 2.060e-5_r8 + real(r8), parameter :: vonkar = karman + real(r8), parameter :: ric = 0.2_r8 + real(r8), parameter :: r = 287.04_r8 + real(r8), parameter :: cp = 1004._r8 + real(r8), parameter :: grav = 9.81_r8 + real(r8), parameter :: p00 = 100000._r8 + real(r8), parameter :: wh2o = 18.0153_r8 + real(r8), parameter :: ph = 1.e-5_r8 + real(r8), parameter :: ph_inv = 1._r8/ph + real(r8), parameter :: rovcp = r/cp + + integer, pointer :: index_season_lai(:,:) + + !logical, public :: has_dvel(gas_pcnst) = .false. + !integer :: map_dvel(gas_pcnst) = 0 + logical, public :: has_dvel(nTracersMax) = .false. + integer :: map_dvel(nTracersMax) = 0 + real(r8) , allocatable :: soilw_3d(:,:,:) + + logical, parameter :: dyn_soilw = .false. + + real(r8), allocatable :: fraction_landuse(:,:,:) + real(r8), allocatable, dimension(:,:,:) :: dep_ra ! [s/m] aerodynamic resistance + real(r8), allocatable, dimension(:,:,:) :: dep_rb ! [s/m] resistance across sublayer + integer, parameter :: n_land_type = 11 + + real(r8), public :: crb + + type lnd_dvel_type + real(r8), pointer :: dvel(:,:) ! deposition velocity over land (cm/s) + end type lnd_dvel_type + + type(lnd_dvel_type), allocatable :: lnd(:) + character(len=SHR_KIND_CL) :: drydep_srf_file + +contains + + !--------------------------------------------------------------------------- + !--------------------------------------------------------------------------- + subroutine dvel_inti_fromlnd + use cam_abortutils, only : endrun + use seq_drydep_mod, only : dfoxd + + implicit none + + allocate( lnd(begchunk:endchunk) ) + + crb = (difft/diffm)**(2._r8/3._r8) !.666666_r8 + + endsubroutine dvel_inti_fromlnd + + !------------------------------------------------------------------------------------- + !------------------------------------------------------------------------------------- + subroutine drydep_update( state, cam_in ) + use physics_types, only : physics_state + use camsrfexch, only : cam_in_t + use seq_drydep_mod, only : drydep_method, DD_XLND + + type(physics_state), intent(in) :: state ! Physics state variables + type(cam_in_t), intent(in) :: cam_in + integer :: ispec + + if (nddvels<1) return + if (drydep_method /= DD_XLND) return + + lnd(state%lchnk)%dvel => cam_in%depvel + + end subroutine drydep_update + + !------------------------------------------------------------------------------------- + !------------------------------------------------------------------------------------- + subroutine drydep_fromlnd( ocnfrac, icefrac, ncdate, sfc_temp, pressure_sfc, & + wind_speed, spec_hum, air_temp, pressure_10m, rain, & + snow, solar_flux, dvelocity, dflx, State_Chm, & + tv, soilw, rh, ncol, lonndx, latndx, lchnk ) + + !------------------------------------------------------------------------------------- + ! combines the deposition velocities provided by the land model with deposition + ! velocities over ocean and sea ice + !------------------------------------------------------------------------------------- + + use ppgrid, only : pcols + +#if (defined OFFLINE_DYN) + use metdata, only: get_met_fields +#endif + + implicit none + + !------------------------------------------------------------------------------------- + ! ... dummy arguments + !------------------------------------------------------------------------------------- + + real(r8), intent(in) :: icefrac(pcols) + real(r8), intent(in) :: ocnfrac(pcols) + + integer, intent(in) :: ncol + integer, intent(in) :: ncdate ! present date (yyyymmdd) + real(r8), intent(in) :: sfc_temp(pcols) ! surface temperature (K) + real(r8), intent(in) :: pressure_sfc(pcols) ! surface pressure (Pa) + real(r8), intent(in) :: wind_speed(pcols) ! 10 meter wind speed (m/s) + real(r8), intent(in) :: spec_hum(pcols) ! specific humidity (kg/kg) + real(r8), intent(in) :: rh(ncol,1) ! relative humidity + real(r8), intent(in) :: air_temp(pcols) ! surface air temperature (K) + real(r8), intent(in) :: pressure_10m(pcols) ! 10 meter pressure (Pa) + real(r8), intent(in) :: rain(pcols) + real(r8), intent(in) :: snow(pcols) ! snow height (m) + real(r8), intent(in) :: soilw(pcols) ! soil moisture fraction + real(r8), intent(in) :: solar_flux(pcols) ! direct shortwave radiation at surface (W/m^2) + real(r8), intent(in) :: tv(pcols) ! potential temperature + type(ChmState), intent(in):: State_Chm ! GEOS-Chem State Chem + real(r8), intent(out) :: dvelocity(ncol,nTracersMax) ! deposition velocity (cm/s) + real(r8), intent(inout) :: dflx(pcols,nTracersMax) ! deposition flux (/cm^2/s) + + integer, intent(in) :: latndx(pcols) ! chunk latitude indicies + integer, intent(in) :: lonndx(pcols) ! chunk longitude indicies + integer, intent(in) :: lchnk ! chunk number + + !------------------------------------------------------------------------------------- + ! ... local variables + !------------------------------------------------------------------------------------- + real(r8) :: ocnice_dvel(ncol,nTracersMax) + real(r8) :: ocnice_dflx(pcols,nTracersMax) + + real(r8), dimension(ncol) :: term ! work array + integer :: ispec + real(r8) :: lndfrac(pcols) +#if (defined OFFLINE_DYN) + real(r8) :: met_ocnfrac(pcols) + real(r8) :: met_icefrac(pcols) +#endif + integer :: i + + lndfrac(:ncol) = 1._r8 - ocnfrac(:ncol) - icefrac(:ncol) + + where( lndfrac(:ncol) < 0._r8 ) + lndfrac(:ncol) = 0._r8 + endwhere + +#if (defined OFFLINE_DYN) + call get_met_fields(lndfrac, met_ocnfrac, met_icefrac, lchnk, ncol) +#endif + + !------------------------------------------------------------------------------------- + ! ... initialize + !------------------------------------------------------------------------------------- + dvelocity(:,:) = 0._r8 + + !------------------------------------------------------------------------------------- + ! ... compute the dep velocities over ocean and sea ice + ! land type 7 is used for ocean + ! land type 8 is used for sea ice + !------------------------------------------------------------------------------------- + call drydep_xactive( ncdate, sfc_temp, pressure_sfc, & + wind_speed, spec_hum, air_temp, pressure_10m, rain, & + snow, solar_flux, ocnice_dvel, ocnice_dflx, & + State_Chm, tv, soilw, & + rh, ncol, lonndx, latndx, lchnk, & +#if (defined OFFLINE_DYN) + ocnfrc=met_ocnfrac,icefrc=met_icefrac, beglandtype=7, endlandtype=8 ) +#else + ocnfrc=ocnfrac,icefrc=icefrac, beglandtype=7, endlandtype=8 ) +#endif + term(:ncol) = 1.e-2_r8 * pressure_10m(:ncol) / (r*tv(:ncol)) + + do ispec = 1, nddvels + !------------------------------------------------------------------------------------- + ! ... merge the land component with the non-land component + ! ocn and ice already have fractions factored in + !------------------------------------------------------------------------------------- + if ( drySpc_ndx(ispec) > 0 ) then + !Write(6,*) " Spec = ", drydep_list(iSpec), lchnk + !Write(6,*) " lndfrac = ", MAXVAL(lndfrac(:)), lchnk + !Write(6,*) " lndfrac = ", MINVAL(lndfrac(:)), lchnk + !Write(6,*) " lndvel = ", MAXVAL(lnd(lchnk)%dvel(:,iSpec)), " [cm/s]", lchnk + !Write(6,*) " ocnvel = ", MAXVAL(ocnice_dvel(:,drySpc_ndx(iSpec))), " [cm/s]", lchnk + dvelocity(:ncol,drySpc_ndx(ispec)) = lnd(lchnk)%dvel(:ncol,ispec)*lndfrac(:ncol) & + + ocnice_dvel(:ncol,drySpc_ndx(ispec)) + !Write(6,*) " dvel = ", MAXVAL(dvelocity(:,drySpc_ndx(iSpec))), " [cm/s]", lchnk + endif + enddo + + !------------------------------------------------------------------------------------- + ! ... special adjustments + !------------------------------------------------------------------------------------- + if( mpan_ndx>0 ) then + dvelocity(:ncol,mpan_ndx) = dvelocity(:ncol,mpan_ndx)/3._r8 + endif + if( xmpan_ndx>0 ) then + dvelocity(:ncol,xmpan_ndx) = dvelocity(:ncol,xmpan_ndx)/3._r8 + endif + if( hcn_ndx>0 ) then + dvelocity(:ncol,hcn_ndx) = ocnice_dvel(:ncol,hcn_ndx) ! should be zero over land + endif + if( ch3cn_ndx>0 ) then + dvelocity(:ncol,ch3cn_ndx) = ocnice_dvel(:ncol,ch3cn_ndx) ! should be zero over land + endif + + ! HCOOH, use CH3COOH dep.vel + if( hcooh_ndx > 0 .and. ch3cooh_ndx > 0 ) then + if( has_dvel(hcooh_ndx) ) then + dvelocity(:ncol,hcooh_ndx) = dvelocity(:ncol,ch3cooh_ndx) + end if + end if + + !------------------------------------------------------------------------------------- + ! ... assign CO tags to CO + ! put this kludge in for now ... + ! -- should be able to set all these via the table mapping in seq_drydep_mod + !------------------------------------------------------------------------------------- + if( cohc_ndx>0 .and. co_ndx>0 ) then + dvelocity(:ncol,cohc_ndx) = dvelocity(:ncol,co_ndx) + dflx(:ncol,cohc_ndx) = dvelocity(:ncol,co_ndx) * term(:ncol) * State_Chm%Species(1,:ncol,plev,cohc_ndx) + endif + if( come_ndx>0 .and. co_ndx>0 ) then + dvelocity(:ncol,come_ndx) = dvelocity(:ncol,co_ndx) + dflx(:ncol,come_ndx) = dvelocity(:ncol,co_ndx) * term(:ncol) * State_Chm%Species(1,:ncol,plev,come_ndx) + endif + + if ( co_ndx>0 ) then + do i=1,tag_cnt + dvelocity(:ncol,cotag_ndx(i)) = dvelocity(:ncol,co_ndx) + dflx(:ncol,cotag_ndx(i)) = dvelocity(:ncol,co_ndx) * term(:ncol) * State_Chm%Species(1,:ncol,plev,cotag_ndx(i)) + enddo + endif + + do ispec = 1,nddvels + !------------------------------------------------------------------------------------- + ! ... compute the deposition flux + !------------------------------------------------------------------------------------- + if ( drySpc_ndx(ispec) > 0 ) then + dflx(:ncol,drySpc_ndx(ispec)) = dvelocity(:ncol,drySpc_ndx(ispec)) * term(:ncol) * State_Chm%Species(1,:ncol,plev,drySpc_ndx(ispec)) + endif + end do + + end subroutine drydep_fromlnd + + !--------------------------------------------------------------------------- + !--------------------------------------------------------------------------- + subroutine dvel_inti_table( depvel_file ) + !--------------------------------------------------------------------------- + ! ... Initialize module, depvel arrays, and a few other variables. + ! The depvel fields will be linearly interpolated to the correct time + !--------------------------------------------------------------------------- + + use mo_constants, only : d2r, r2d + use ioFileMod, only : getfil + use string_utils, only : to_lower, GLC + use mo_chem_utls, only : get_spc_ndx + use constituents, only : pcnst + use chem_mods, only : drySpc_ndx + use interpolate_data, only : lininterp_init, lininterp, lininterp_finish,interp_type + use mo_constants, only : pi + use phys_grid, only : get_ncols_p, get_rlat_all_p, get_rlon_all_p + + implicit none + + character(len=*), intent(in) :: depvel_file + + !--------------------------------------------------------------------------- + ! ... Local variables + !--------------------------------------------------------------------------- + integer :: nlat, nlon, nmonth, ndims + integer :: dimid_lat, dimid_lon, dimid_species, dimid_time + integer :: dimid(4), count(4), start(4) + integer :: m, ispecies, nchar, ierr + real(r8) :: scale_factor + + real(r8), allocatable :: dvel_lats(:), dvel_lons(:) + real(r8), allocatable :: dvel_in(:,:,:,:) ! input depvel array + character(len=50) :: units + character(len=20), allocatable :: species_names(:) ! names of depvel species + logical :: found + type(file_desc_t) :: piofile + type(var_desc_t) :: vid, vid_dvel + + character(len=shr_kind_cl) :: locfn + integer :: mm,n + + integer :: i, c, ncols + real(r8) :: to_lats(pcols), to_lons(pcols) + type(interp_type) :: lon_wgts, lat_wgts + real(r8), parameter :: zero=0._r8, twopi=2._r8*pi + + mm = 1 + do m = 1,pcnst + if ( len_trim(drydep_list(m))==0 ) exit + n = drySpc_ndx(m) + !n = get_spc_ndx(drydep_list(m)) + if ( n < 1 ) then + write(iulog,*) 'drydep_inti: '//drydep_list(m)//' is not included in species set' + call endrun('drydep_init: invalid dry deposition species') + endif + enddo + + if( masterproc ) then + write(iulog,*) 'drydep_inti: following species have dry deposition' + do i=1,nddvels + if( len_trim(drydep_list(i)) > 0 ) then + write(iulog,*) 'drydep_inti: '//trim(drydep_list(i))//' is requested to have dry dep' + endif + enddo + write(iulog,*) 'drydep_inti:' + endif + + if ( nddvels < 1 ) return + + !--------------------------------------------------------------------------- + ! ... Setup species maps + !--------------------------------------------------------------------------- + o3a_ndx = get_spc_ndx( 'O3A') + xpan_ndx = get_spc_ndx( 'XPAN') + xmpan_ndx = get_spc_ndx( 'XMPAN') + xno2_ndx = get_spc_ndx( 'XNO2') + xhno3_ndx = get_spc_ndx( 'XHNO3') + xonit_ndx = get_spc_ndx( 'XONIT') + xonitr_ndx = get_spc_ndx( 'XONITR') + xno_ndx = get_spc_ndx( 'XNO') + xho2no2_ndx = get_spc_ndx( 'XHO2NO2') + o3a_dd = has_drydep( 'O3A') + xpan_dd = has_drydep( 'XPAN') + xmpan_dd = has_drydep( 'XMPAN') + xno2_dd = has_drydep( 'XNO2') + xhno3_dd = has_drydep( 'XHNO3') + xonit_dd = has_drydep( 'XONIT') + xonitr_dd = has_drydep( 'XONITR') + xno_dd = has_drydep( 'XNO') + xho2no2_dd = has_drydep( 'XHO2NO2') + + pan_ndx = get_spc_ndx( 'PAN') + mpan_ndx = get_spc_ndx( 'MPAN') + no2_ndx = get_spc_ndx( 'NO2') + hno3_ndx = get_spc_ndx( 'HNO3') + co_ndx = get_spc_ndx( 'CO') + o3_ndx = get_spc_ndx( 'O3') + if( o3_ndx < 1 ) then + o3_ndx = get_spc_ndx( 'OX') + end if + h2o2_ndx = get_spc_ndx( 'H2O2') + onit_ndx = get_spc_ndx( 'ONIT') + onitr_ndx = get_spc_ndx( 'ONITR') + ch4_ndx = get_spc_ndx( 'CH4') + ch2o_ndx = get_spc_ndx( 'CH2O') + ch3ooh_ndx = get_spc_ndx( 'CH3OOH') + ch3cho_ndx = get_spc_ndx( 'CH3CHO') + ch3cocho_ndx = get_spc_ndx( 'CH3COCHO') + pooh_ndx = get_spc_ndx( 'POOH') + ch3coooh_ndx = get_spc_ndx( 'CH3COOOH') + c2h5ooh_ndx = get_spc_ndx( 'C2H5OOH') + eooh_ndx = get_spc_ndx( 'EOOH') + c3h7ooh_ndx = get_spc_ndx( 'C3H7OOH') + rooh_ndx = get_spc_ndx( 'ROOH') + ch3coch3_ndx = get_spc_ndx( 'CH3COCH3') + no_ndx = get_spc_ndx( 'NO') + ho2no2_ndx = get_spc_ndx( 'HO2NO2') + glyald_ndx = get_spc_ndx( 'GLYALD') + hyac_ndx = get_spc_ndx( 'HYAC') + ch3oh_ndx = get_spc_ndx( 'CH3OH') + c2h5oh_ndx = get_spc_ndx( 'C2H5OH') + macrooh_ndx = get_spc_ndx( 'MACROOH') + isopooh_ndx = get_spc_ndx( 'ISOPOOH') + xooh_ndx = get_spc_ndx( 'XOOH') + hydrald_ndx = get_spc_ndx( 'HYDRALD') + h2_ndx = get_spc_ndx( 'H2') + Pb_ndx = get_spc_ndx( 'Pb') + o3s_ndx = get_spc_ndx( 'O3S') + o3inert_ndx = get_spc_ndx( 'O3INERT') + alkooh_ndx = get_spc_ndx( 'ALKOOH') + mekooh_ndx = get_spc_ndx( 'MEKOOH') + tolooh_ndx = get_spc_ndx( 'TOLOOH') + terpooh_ndx = get_spc_ndx( 'TERPOOH') + ch3cooh_ndx = get_spc_ndx( 'CH3COOH') + soam_ndx = get_spc_ndx( 'SOAM' ) + soai_ndx = get_spc_ndx( 'SOAI' ) + soat_ndx = get_spc_ndx( 'SOAT' ) + soab_ndx = get_spc_ndx( 'SOAB' ) + soax_ndx = get_spc_ndx( 'SOAX' ) + sogm_ndx = get_spc_ndx( 'SOGM' ) + sogi_ndx = get_spc_ndx( 'SOGI' ) + sogt_ndx = get_spc_ndx( 'SOGT' ) + sogb_ndx = get_spc_ndx( 'SOGB' ) + sogx_ndx = get_spc_ndx( 'SOGX' ) + soa_ndx = get_spc_ndx( 'SOA' ) + so4_ndx = get_spc_ndx( 'SO4' ) + cb1_ndx = get_spc_ndx( 'CB1' ) + cb2_ndx = get_spc_ndx( 'CB2' ) + oc1_ndx = get_spc_ndx( 'OC1' ) + oc2_ndx = get_spc_ndx( 'OC2' ) + nh3_ndx = get_spc_ndx( 'NH3' ) + nh4no3_ndx = get_spc_ndx( 'NH4NO3' ) + xnh4no3_ndx = get_spc_ndx( 'XNH4NO3' ) + sa1_ndx = get_spc_ndx( 'SA1' ) + sa2_ndx = get_spc_ndx( 'SA2' ) + sa3_ndx = get_spc_ndx( 'SA3' ) + sa4_ndx = get_spc_ndx( 'SA4' ) + nh4_ndx = get_spc_ndx( 'NH4' ) + alkooh_dd = has_drydep( 'ALKOOH') + mekooh_dd = has_drydep( 'MEKOOH') + tolooh_dd = has_drydep( 'TOLOOH') + terpooh_dd = has_drydep( 'TERPOOH') + ch3cooh_dd = has_drydep( 'CH3COOH') + soam_dd = has_drydep( 'SOAM' ) + soai_dd = has_drydep( 'SOAI' ) + soat_dd = has_drydep( 'SOAT' ) + soab_dd = has_drydep( 'SOAB' ) + soax_dd = has_drydep( 'SOAX' ) + sogm_dd = has_drydep( 'SOGM' ) + sogi_dd = has_drydep( 'SOGI' ) + sogt_dd = has_drydep( 'SOGT' ) + sogb_dd = has_drydep( 'SOGB' ) + sogx_dd = has_drydep( 'SOGX' ) + soa_dd = has_drydep( 'SOA' ) + so4_dd = has_drydep( 'SO4' ) + cb1_dd = has_drydep( 'CB1' ) + cb2_dd = has_drydep( 'CB2' ) + oc1_dd = has_drydep( 'OC1' ) + oc2_dd = has_drydep( 'OC2' ) + nh3_dd = has_drydep( 'NH3' ) + nh4no3_dd = has_drydep( 'NH4NO3' ) + xnh4no3_dd = has_drydep( 'XNH4NO3' ) + sa1_dd = has_drydep( 'SA1' ) + sa2_dd = has_drydep( 'SA2' ) + sa3_dd = has_drydep( 'SA3' ) + sa4_dd = has_drydep( 'SA4' ) + nh4_dd = has_drydep( 'NH4' ) + pan_dd = has_drydep( 'PAN') + mpan_dd = has_drydep( 'MPAN') + no2_dd = has_drydep( 'NO2') + hno3_dd = has_drydep( 'HNO3') + co_dd = has_drydep( 'CO') + o3_dd = has_drydep( 'O3') + if( .not. o3_dd ) then + o3_dd = has_drydep( 'OX') + end if + h2o2_dd = has_drydep( 'H2O2') + onit_dd = has_drydep( 'ONIT') + onitr_dd = has_drydep( 'ONITR') + ch4_dd = has_drydep( 'CH4') + ch2o_dd = has_drydep( 'CH2O') + ch3ooh_dd = has_drydep( 'CH3OOH') + ch3cho_dd = has_drydep( 'CH3CHO') + c2h5oh_dd = has_drydep( 'C2H5OH') + eooh_dd = has_drydep( 'EOOH') + ch3cocho_dd = has_drydep( 'CH3COCHO') + pooh_dd = has_drydep( 'POOH') + ch3coooh_dd = has_drydep( 'CH3COOOH') + c2h5ooh_dd = has_drydep( 'C2H5OOH') + c3h7ooh_dd = has_drydep( 'C3H7OOH') + rooh_dd = has_drydep( 'ROOH') + ch3coch3_dd = has_drydep( 'CH3COCH3') + glyald_dd = has_drydep( 'GLYALD') + hyac_dd = has_drydep( 'HYAC') + ch3oh_dd = has_drydep( 'CH3OH') + macrooh_dd = has_drydep( 'MACROOH') + isopooh_dd = has_drydep( 'ISOPOOH') + xooh_dd = has_drydep( 'XOOH') + hydrald_dd = has_drydep( 'HYDRALD') + h2_dd = has_drydep( 'H2') + Pb_dd = has_drydep( 'Pb') + o3s_dd = has_drydep( 'O3S') + o3inert_dd = has_drydep( 'O3INERT') + ch3cn_dd = has_drydep( 'CH3CN') + hcn_dd = has_drydep( 'HCN') + hcooh_dd = has_drydep( 'HCOOH') + ch3cn_ndx = get_spc_ndx( 'CH3CN') + hcn_ndx = get_spc_ndx( 'HCN') + hcooh_ndx = get_spc_ndx( 'HCOOH' ) + + if( masterproc ) then + write(iulog,*) 'dvel_inti: diagnostics' + write(iulog,'(10i5)') pan_ndx, mpan_ndx, no2_ndx, hno3_ndx, o3_ndx, & + h2o2_ndx, onit_ndx, onitr_ndx, ch4_ndx, ch2o_ndx, & + ch3ooh_ndx, pooh_ndx, ch3coooh_ndx, c2h5ooh_ndx, eooh_ndx, & + c3h7ooh_ndx, rooh_ndx, ch3cocho_ndx, co_ndx, ch3coch3_ndx, & + no_ndx, ho2no2_ndx, glyald_ndx, hyac_ndx, ch3oh_ndx, c2h5oh_ndx, & + hydrald_ndx, h2_ndx, Pb_ndx, o3s_ndx, o3inert_ndx, macrooh_ndx, & + xooh_ndx, ch3cho_ndx, isopooh_ndx, noa_ndx, alknit_ndx, isopnita_ndx, & + honitr_ndx, isopnooh_ndx, nc4cho_ndx, nc4ch2oh_ndx, terpnit_ndx, nterpooh_ndx + write(iulog,*) pan_dd, mpan_dd, no2_dd, hno3_dd, o3_dd, isopooh_dd, ch4_dd,& + h2o2_dd, onit_dd, onitr_dd, ch2o_dd, macrooh_dd, xooh_dd, & + ch3ooh_dd, pooh_dd, ch3coooh_dd, c2h5ooh_dd, eooh_dd, ch3cho_dd, c2h5oh_dd, & + c3h7ooh_dd, rooh_dd, ch3cocho_dd, co_dd, ch3coch3_dd, & + glyald_dd, hyac_dd, ch3oh_dd, hydrald_dd, h2_dd, Pb_dd, o3s_dd, o3inert_dd, & + noa_dd, alknit_dd, isopnita_dd, & + honitr_dd, isopnooh_dd, nc4cho_dd, nc4ch2oh_dd, terpnit_dd, nterpooh_dd + endif + !--------------------------------------------------------------------------- + ! ... Open NetCDF file + !--------------------------------------------------------------------------- + call getfil (depvel_file, locfn, 0) + call cam_pio_openfile (piofile, trim(locfn), PIO_NOWRITE) + + !--------------------------------------------------------------------------- + ! ... Get variable ID for dep vel array + !--------------------------------------------------------------------------- + ierr = pio_inq_varid( piofile, 'dvel', vid_dvel ) + + !--------------------------------------------------------------------------- + ! ... Inquire about dimensions + !--------------------------------------------------------------------------- + ierr = pio_inq_dimid( piofile, 'lon', dimid_lon ) + ierr = pio_inq_dimlen( piofile, dimid_lon, nlon ) + ierr = pio_inq_dimid( piofile, 'lat', dimid_lat ) + ierr = pio_inq_dimlen( piofile, dimid_lat, nlat ) + ierr = pio_inq_dimid( piofile, 'species', dimid_species ) + ierr = pio_inq_dimlen( piofile, dimid_species, nspecies ) + ierr = pio_inq_dimid( piofile, 'time', dimid_time ) + ierr = pio_inq_dimlen( piofile, dimid_time, nmonth ) + if(masterproc) write(iulog,*) 'dvel_inti: dimensions (nlon,nlat,nspecies,nmonth) = ',nlon,nlat,nspecies,nmonth + + !--------------------------------------------------------------------------- + ! ... Check dimensions of dvel variable. Must be (lon, lat, species, month). + !--------------------------------------------------------------------------- + ierr = pio_inq_varndims( piofile, vid_dvel, ndims ) + + if( masterproc .and. ndims /= 4 ) then + write(iulog,*) 'dvel_inti: dvel has ',ndims,' dimensions. Expecting 4.' + call endrun + end if + ierr = pio_inq_vardimid( piofile, vid_dvel, dimid ) + + if( dimid(1) /= dimid_lon .or. dimid(2) /= dimid_lat .or. & + dimid(3) /= dimid_species .or. dimid(4) /= dimid_time ) then + write(iulog,*) 'dvel_inti: Dimensions in wrong order for dvel' + write(iulog,*) '... Expecting (lon, lat, species, month)' + call endrun + end if + + !--------------------------------------------------------------------------- + ! ... Allocate depvel lats, lons and read + !--------------------------------------------------------------------------- + allocate( dvel_lats(nlat), stat=ierr ) + if( ierr /= 0 ) then + write(iulog,*) 'dvel_inti: Failed to allocate dvel_lats vector' + call endrun + end if + allocate( dvel_lons(nlon), stat=ierr ) + if( ierr /= 0 ) then + write(iulog,*) 'dvel_inti: Failed to allocate dvel_lons vector' + call endrun + end if + + ierr = pio_inq_varid( piofile, 'lat', vid ) + ierr = pio_get_var( piofile, vid, dvel_lats ) + ierr = pio_inq_varid( piofile, 'lon', vid ) + ierr = pio_get_var( piofile, vid, dvel_lons ) + + !--------------------------------------------------------------------------- + ! ... Set the transform from inputs lats to simulation lats + !--------------------------------------------------------------------------- + dvel_lats(:nlat) = d2r * dvel_lats(:nlat) + dvel_lons(:nlon) = d2r * dvel_lons(:nlon) + + !--------------------------------------------------------------------------- + ! ... Allocate dvel and read data from file + !--------------------------------------------------------------------------- + allocate( dvel_in(nlon, nlat ,nspecies, nmonth), stat=ierr ) + if( ierr /= 0 ) then + write(iulog,*) 'dvel_inti: Failed to allocate dvel_in' + call endrun + end if + start = (/ 1, 1, 1, 1 /) + count = (/ nlon, nlat, nspecies, nmonth /) + + ierr = pio_get_var( piofile, vid_dvel, start, count, dvel_in ) + + + !--------------------------------------------------------------------------- + ! ... Check units of deposition velocity. If necessary, convert to cm/s. + !--------------------------------------------------------------------------- + units(:) = ' ' + ierr = pio_get_att( piofile, vid_dvel, 'units', units ) + if( to_lower(trim(units(:GLC(units)))) == 'm/s' ) then +#ifdef DEBUG + if(masterproc) write(iulog,*) 'dvel_inti: depvel units = m/s. Converting to cm/s' +#endif + scale_factor = 100._r8 + elseif( to_lower(trim(units(:GLC(units)))) == 'cm/s' ) then +#ifdef DEBUG + if(masterproc) write(iulog,*) 'dvel_inti: depvel units = cm/s' +#endif + scale_factor = 1._r8 + else +#ifdef DEBUG + if(masterproc) then + write(iulog,*) 'dvel_inti: Warning! depvel units unknown = ', to_lower(trim(units)) + write(iulog,*) ' ... proceeding with scale_factor=1' + end if +#endif + scale_factor = 1._r8 + end if + + dvel_in(:,:,:,:) = scale_factor*dvel_in(:,:,:,:) + + !--------------------------------------------------------------------------- + ! ... Regrid deposition velocities + !--------------------------------------------------------------------------- + allocate( dvel(pcols,begchunk:endchunk,nspecies,nmonth),stat=ierr ) + if( ierr /= 0 ) then + write(iulog,*) 'dvel_inti: Failed to allocate dvel' + call endrun + end if + + do c=begchunk,endchunk + ncols = get_ncols_p(c) + call get_rlat_all_p(c, pcols, to_lats) + call get_rlon_all_p(c, pcols, to_lons) + call lininterp_init(dvel_lons, nlon, to_lons, ncols, 2, lon_wgts, zero, twopi) + call lininterp_init(dvel_lats, nlat, to_lats, ncols, 1, lat_wgts) + + do ispecies = 1,nspecies + do m = 1,12 + call lininterp( dvel_in( :,:,ispecies,m ), nlon, nlat, dvel(:,c,ispecies,m), ncols,lon_wgts,lat_wgts) + end do + end do + + call lininterp_finish(lat_wgts) + call lininterp_finish(lon_wgts) + end do + + deallocate( dvel_in ) + deallocate( dvel_lats, dvel_lons ) + + !--------------------------------------------------------------------------- + ! ... Read in species names and determine mapping to tracer numbers + !--------------------------------------------------------------------------- + allocate( species_names(nspecies), stat=ierr ) + if( ierr /= 0 ) then + write(iulog,*) 'dvel_inti: species_names allocation error = ',ierr + call endrun + end if + ierr = pio_inq_varid( piofile, 'species_name', vid ) + ierr = pio_inq_varndims( piofile, vid, ndims ) + + ierr = pio_inq_vardimid( piofile, vid, dimid ) + + ierr = pio_inq_dimlen( piofile, dimid(1), nchar ) + map(:) = 0 + do ispecies = 1,nspecies + start(:2) = (/ 1, ispecies /) + count(:2) = (/ nchar, 1 /) + species_names(ispecies)(:) = ' ' + ierr = pio_get_var( piofile, vid, start(1:2), count(1:2), species_names(ispecies:ispecies) ) + if( species_names(ispecies) == 'O3' ) then + o3_in_tab = .true. + o3_tab_ndx = ispecies + else if( species_names(ispecies) == 'H2O2' ) then + h2o2_in_tab = .true. + h2o2_tab_ndx = ispecies + else if( species_names(ispecies) == 'CH3OOH' ) then + ch3ooh_in_tab = .true. + ch3ooh_tab_ndx = ispecies + else if( species_names(ispecies) == 'CO' ) then + co_in_tab = .true. + co_tab_ndx = ispecies + else if( species_names(ispecies) == 'CH3CHO' ) then + ch3cho_in_tab = .true. + ch3cho_tab_ndx = ispecies + end if + found = .false. + do m = 1, nTracers + if( species_names(ispecies) == tracerNames(m) .or. & + (species_names(ispecies) == 'O3' .and. tracerNames(m) == 'OX') .or. & + (species_names(ispecies) == 'HNO4' .and. tracerNames(m) == 'HO2NO2') ) then + if ( has_drydep( tracerNames(m) ) ) then + map(m) = ispecies + found = .true. +#ifdef DEBUG + if( masterproc ) then + write(iulog,*) 'dvel_inti: ispecies, m, tracnam = ',ispecies,m,trim(tracerNames(m)) + end if +#endif + exit + end if + end if + end do + if( .not. found ) then + write(iulog,*) 'dvel_inti: Warning! DVEL species ',trim(species_names(ispecies)),' not found' + endif + end do + deallocate( species_names ) + + call cam_pio_closefile( piofile ) + + !--------------------------------------------------------------------------- + ! ... Allocate dvel_interp array + !--------------------------------------------------------------------------- + allocate( dvel_interp(pcols,begchunk:endchunk,nspecies),stat=ierr ) + if( ierr /= 0 ) then + write(iulog,*) 'dvel_inti: Failed to allocate dvel_interp; error = ',ierr + call endrun + end if + + end subroutine dvel_inti_table + + !------------------------------------------------------------------------------------- + !------------------------------------------------------------------------------------- + subroutine interpdvel( calday, ncol, lchnk ) + !--------------------------------------------------------------------------- + ! ... Interpolate the fields whose values are required at the + ! begining of a timestep. + !--------------------------------------------------------------------------- + + use time_manager, only : get_calday + + implicit none + + !--------------------------------------------------------------------------- + ! ... Dummy arguments + !--------------------------------------------------------------------------- + real(r8), intent(in) :: calday ! Interpolate the input data to calday + integer, intent(in) :: ncol, lchnk + + !--------------------------------------------------------------------------- + ! ... Local variables + !--------------------------------------------------------------------------- + integer :: m, last, next + integer :: dates(12) = (/ 116, 214, 316, 415, 516, 615, & + 716, 816, 915, 1016, 1115, 1216 /) + real(r8) :: calday_loc, last_days, next_days + real(r8), save :: dys(12) + logical, save :: entered = .false. + + if( .not. entered ) then + do m = 1,12 + dys(m) = get_calday( dates(m), 0 ) + end do + entered = .true. + end if + + if( calday < dys(1) ) then + next = 1 + last = 12 + else if( calday >= dys(12) ) then + next = 1 + last = 12 + else + do m = 11,1,-1 + if( calday >= dys(m) ) then + exit + end if + end do + last = m + next = m + 1 + end if + + last_days = dys( last ) + next_days = dys( next ) + calday_loc = calday + + if( next_days < last_days ) then + next_days = next_days + 365._r8 + end if + if( calday_loc < last_days ) then + calday_loc = calday_loc + 365._r8 + end if + + do m = 1,nspecies + call intp2d( last_days, next_days, calday_loc, ncol, lchnk, & + dvel(:,lchnk,m,last), & + dvel(:,lchnk,m,next), & + dvel_interp(:,lchnk,m) ) + end do + + end subroutine interpdvel + + !------------------------------------------------------------------------------------- + !------------------------------------------------------------------------------------- + subroutine intp2d( t1, t2, tint, ncol, lchnk, f1, f2, fint ) + !----------------------------------------------------------------------- + ! ... Linearly interpolate between f1(t1) and f2(t2) to fint(tint). + !----------------------------------------------------------------------- + + implicit none + + !----------------------------------------------------------------------- + ! ... Dummy arguments + !----------------------------------------------------------------------- + real(r8), intent(in) :: & + t1, & ! time level of f1 + t2, & ! time level of f2 + tint ! interpolant time + real(r8), dimension(pcols), intent(in) :: & + f1, & ! field at time t1 + f2 ! field at time t2 + + integer, intent(in) :: ncol, lchnk + + real(r8), intent(out) :: & + fint(pcols) ! field at time tint + + + !----------------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------------- + real(r8) :: factor + + factor = (tint - t1)/(t2 - t1) + + fint(:ncol) = f1(:ncol) + (f2(:ncol) - f1(:ncol))*factor + + end subroutine intp2d + + !------------------------------------------------------------------------------------- + !------------------------------------------------------------------------------------- + !subroutine drydep_table( calday, tsurf, zen_angle, & + ! depvel, dflx, q, p, & + ! tv, ncol, icefrac, ocnfrac, lchnk ) + ! !-------------------------------------------------------- + ! ! ... Form the deposition velocities for this + ! ! latitude slice + ! !-------------------------------------------------------- + + ! use physconst, only : rair,pi + ! use dycore, only : dycore_is + + ! implicit none + + ! !-------------------------------------------------------- + ! ! ... Dummy arguments + ! !-------------------------------------------------------- + ! integer, intent(in) :: ncol ! columns in chunk + ! real(r8), intent(in) :: q(pcols,plev,gas_pcnst) ! tracer mmr (kg/kg) + ! real(r8), intent(in) :: p(pcols) ! midpoint pressure in surface layer (Pa) + ! real(r8), intent(in) :: tv(pcols) ! virtual temperature in surface layer (K) + ! real(r8), intent(in) :: calday ! time of year in days + ! real(r8), intent(in) :: tsurf(pcols) ! surface temperature (K) + ! real(r8), intent(in) :: zen_angle(ncol) ! zenith angle (radians) + ! real(r8), intent(inout) :: dflx(pcols,gas_pcnst) ! flux due to dry deposition (kg/m^2/sec) + ! real(r8), intent(out) :: depvel(ncol,gas_pcnst) ! deposition vel (cm/s) + + ! real(r8), intent(in) :: icefrac(pcols) ! sea-ice areal fraction + ! real(r8), intent(in) :: ocnfrac(pcols) ! ocean areal fraction + ! + ! integer, intent(in) :: lchnk + ! !----------------------------------------------------------------------- + ! ! ... Local variables + ! !----------------------------------------------------------------------- + ! integer :: m, i + ! real(r8), dimension(ncol) :: vel, glace, temp_fac, wrk, tmp + ! real(r8), dimension(ncol) :: o3_tab_dvel + ! real(r8), dimension(ncol) :: ocean + + ! real(r8), parameter :: pid2 = .5_r8 * pi + + ! if(dycore_is('UNSTRUCTURED')) then + ! call endrun( 'Option not supported for unstructured atmosphere grids ') + ! end if + + ! !----------------------------------------------------------------------- + ! ! ... Note the factor 1.e-2 in the wrk array calculation is + ! ! to transform the incoming dep vel from cm/s to m/s + ! !----------------------------------------------------------------------- + ! wrk(:ncol) = 1.e-2_r8 * p(:ncol) / (rair * tv(:ncol)) + + ! !-------------------------------------------------------- + ! ! ... Initialize all deposition velocities to zero + ! !-------------------------------------------------------- + ! depvel(:,:) = 0._r8 + + ! !-------------------------------------------------------- + ! ! ... Time interpolate primary depvel array + ! ! (also seaice and npp) + ! !-------------------------------------------------------- + ! call interpdvel( calday, ncol, lchnk ) + + ! if( o3_in_tab ) then + ! do i=1,ncol + ! o3_tab_dvel(i) = dvel_interp(i,lchnk,o3_tab_ndx) + ! enddo + ! end if + + ! !-------------------------------------------------------- + ! ! ... Set deposition velocities + ! !-------------------------------------------------------- + ! do m = 1,gas_pcnst + ! if( map(m) /= 0 ) then + ! do i = 1,ncol + ! depvel(i,m) = dvel_interp(i,lchnk,map(m)) + ! dflx(i,m) = wrk(i) * depvel(i,m) * q(i,plev,m) + ! enddo + ! end if + ! end do + + ! !-------------------------------------------------------- + ! ! ... Set some variables needed for some dvel calculations + ! !-------------------------------------------------------- + ! temp_fac(:ncol) = min( 1._r8, max( 0._r8, (tsurf(:ncol) - 268._r8) / 5._r8 ) ) + ! ocean(:ncol) = icefrac(:ncol)+ocnfrac(:ncol) + ! glace(:ncol) = icefrac(:ncol) + (1._r8 - ocean(:ncol)) * (1._r8 - temp_fac(:ncol)) + ! glace(:ncol) = min( 1._r8,glace(:ncol) ) + + ! !-------------------------------------------------------- + ! ! ... Set pan & mpan + ! !-------------------------------------------------------- + ! if( o3_in_tab ) then + ! tmp(:ncol) = o3_tab_dvel(:ncol) / 3._r8 + ! else + ! tmp(:) = 0._r8 + ! end if + ! if( pan_dd ) then + ! if( map(pan_ndx) == 0 ) then + ! depvel(:ncol,pan_ndx) = tmp(:ncol) + ! dflx(:ncol,pan_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,pan_ndx) + ! end if + ! end if + ! if( mpan_dd ) then + ! if( map(mpan_ndx) == 0 ) then + ! depvel(:ncol,mpan_ndx) = tmp(:ncol) + ! dflx(:ncol,mpan_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,mpan_ndx) + ! end if + ! end if + + ! !-------------------------------------------------------- + ! ! ... Set no2 dvel + ! !-------------------------------------------------------- + ! if( no2_dd ) then + ! if( map(no2_ndx) == 0 .and. o3_in_tab ) then + ! depvel(:ncol,no2_ndx) = (.6_r8*o3_tab_dvel(:ncol) + .055_r8*ocean(:ncol)) * .9_r8 + ! dflx(:ncol,no2_ndx) = wrk(:) * depvel(:ncol,no2_ndx) * q(:ncol,plev,no2_ndx) + ! end if + ! end if + + ! !-------------------------------------------------------- + ! ! ... Set hno3 dvel + ! !-------------------------------------------------------- + ! tmp(:ncol) = (2._r8 - ocnfrac(:ncol)) * (1._r8 - glace(:ncol)) + .05_r8 * glace(:ncol) + ! if( hno3_dd ) then + ! if( map(hno3_ndx) == 0 ) then + ! depvel(:ncol,hno3_ndx) = tmp(:ncol) + ! dflx(:ncol,hno3_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,hno3_ndx) + ! else + ! tmp(:ncol) = depvel(:ncol,hno3_ndx) + ! end if + ! end if + ! if( onitr_dd ) then + ! if( map(onitr_ndx) == 0 ) then + ! depvel(:ncol,onitr_ndx) = tmp(:ncol) + ! dflx(:ncol,onitr_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,onitr_ndx) + ! end if + ! end if + ! if( isopooh_dd ) then + ! if( map(isopooh_ndx) == 0 ) then + ! depvel(:ncol,isopooh_ndx) = tmp(:ncol) + ! dflx(:ncol,isopooh_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,isopooh_ndx) + ! end if + ! end if + + ! !-------------------------------------------------------- + ! ! ... Set h2o2 dvel + ! !-------------------------------------------------------- + ! if( .not. h2o2_in_tab ) then + ! if( o3_in_tab ) then + ! tmp(:ncol) = .05_r8*glace(:ncol) + ocean(:ncol) - icefrac(:ncol) & + ! + (1._r8 - (glace(:) + ocean(:ncol)) + icefrac(:ncol)) & + ! *max( 1._r8,1._r8/(.5_r8 + 1._r8/(6._r8*o3_tab_dvel(:ncol))) ) + ! else + ! tmp(:ncol) = 0._r8 + ! end if + ! else + ! do i=1,ncol + ! tmp(i) = dvel_interp(i,lchnk,h2o2_tab_ndx) + ! enddo + ! end if + ! if( h2o2_dd ) then + ! if( map(h2o2_ndx) == 0 ) then + ! depvel(:ncol,h2o2_ndx) = tmp(:ncol) + ! dflx(:ncol,h2o2_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,h2o2_ndx) + ! end if + ! end if + ! !-------------------------------------------------------- + ! ! ... Set hcn dvel + ! !-------------------------------------------------------- + ! if( hcn_dd ) then + ! if( map(hcn_ndx) == 0 ) then + ! depvel(:ncol,hcn_ndx) = ocnfrac(:ncol)*0.2_r8 + ! endif + ! endif + ! !-------------------------------------------------------- + ! ! ... Set ch3cn dvel + ! !-------------------------------------------------------- + ! if( ch3cn_dd ) then + ! if( map(ch3cn_ndx) == 0 ) then + ! depvel(:,ch3cn_ndx) = ocnfrac(:ncol)*0.2_r8 + ! endif + ! endif + ! !-------------------------------------------------------- + ! ! ... Set onit + ! !-------------------------------------------------------- + ! if( onit_dd ) then + ! if( map(onit_ndx) == 0 ) then + ! depvel(:ncol,onit_ndx) = tmp(:ncol) + ! dflx(:ncol,onit_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,onit_ndx) + ! end if + ! end if + ! if( ch3cocho_dd ) then + ! if( map(ch3cocho_ndx) == 0 ) then + ! depvel(:ncol,ch3cocho_ndx) = tmp(:ncol) + ! dflx(:ncol,ch3cocho_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,ch3cocho_ndx) + ! end if + ! end if + ! if( ch3ooh_in_tab ) then + ! do i=1,ncol + ! tmp(i) = dvel_interp(i,lchnk,ch3ooh_tab_ndx) + ! enddo + ! else + ! tmp(:ncol) = .5_r8 * tmp(:ncol) + ! end if + ! if( ch3ooh_dd ) then + ! if( map(ch3ooh_ndx) == 0 ) then + ! depvel(:ncol,ch3ooh_ndx) = tmp(:ncol) + ! dflx(:ncol,ch3ooh_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,ch3ooh_ndx) + ! end if + ! end if + ! if( pooh_dd ) then + ! if( map(pooh_ndx) == 0 ) then + ! depvel(:ncol,pooh_ndx) = tmp(:ncol) + ! dflx(:ncol,pooh_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,pooh_ndx) + ! end if + ! end if + ! if( ch3coooh_dd ) then + ! if( map(ch3coooh_ndx) == 0 ) then + ! depvel(:ncol,ch3coooh_ndx) = tmp(:ncol) + ! dflx(:ncol,ch3coooh_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,ch3coooh_ndx) + ! end if + ! end if + ! if( c2h5ooh_dd ) then + ! if( map(c2h5ooh_ndx) == 0 ) then + ! depvel(:ncol,c2h5ooh_ndx) = tmp(:ncol) + ! dflx(:ncol,c2h5ooh_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,c2h5ooh_ndx) + ! end if + ! end if + ! if( c3h7ooh_dd ) then + ! if( map(c3h7ooh_ndx) == 0 ) then + ! depvel(:ncol,c3h7ooh_ndx) = tmp(:ncol) + ! dflx(:ncol,c3h7ooh_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,c3h7ooh_ndx) + ! end if + ! end if + ! if( rooh_dd ) then + ! if( map(rooh_ndx) == 0 ) then + ! depvel(:ncol,rooh_ndx) = tmp(:ncol) + ! dflx(:ncol,rooh_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,rooh_ndx) + ! end if + ! end if + ! if( macrooh_dd ) then + ! if( map(macrooh_ndx) == 0 ) then + ! depvel(:ncol,macrooh_ndx) = tmp(:ncol) + ! dflx(:ncol,macrooh_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,macrooh_ndx) + ! end if + ! end if + ! if( xooh_dd ) then + ! if( map(xooh_ndx) == 0 ) then + ! depvel(:ncol,xooh_ndx) = tmp(:ncol) + ! dflx(:ncol,xooh_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,xooh_ndx) + ! end if + ! end if + ! if( ch3oh_dd ) then + ! if( map(ch3oh_ndx) == 0 ) then + ! depvel(:ncol,ch3oh_ndx) = tmp(:ncol) + ! dflx(:ncol,ch3oh_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,ch3oh_ndx) + ! end if + ! end if + ! if( c2h5oh_dd ) then + ! if( map(c2h5oh_ndx) == 0 ) then + ! depvel(:ncol,c2h5oh_ndx) = tmp(:ncol) + ! dflx(:ncol,c2h5oh_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,c2h5oh_ndx) + ! end if + ! end if + ! if( alkooh_dd ) then + ! if( map(alkooh_ndx) == 0 ) then + ! depvel(:ncol,alkooh_ndx) = tmp(:ncol) + ! dflx(:ncol,alkooh_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,alkooh_ndx) + ! end if + ! end if + ! if( mekooh_dd ) then + ! if( map(mekooh_ndx) == 0 ) then + ! depvel(:ncol,mekooh_ndx) = tmp(:ncol) + ! dflx(:ncol,mekooh_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,mekooh_ndx) + ! end if + ! end if + ! if( tolooh_dd ) then + ! if( map(tolooh_ndx) == 0 ) then + ! depvel(:ncol,tolooh_ndx) = tmp(:ncol) + ! dflx(:ncol,tolooh_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,tolooh_ndx) + ! end if + ! end if + ! if( o3_in_tab ) then + ! tmp(:ncol) = o3_tab_dvel(:ncol) + ! else + ! tmp(:ncol) = 0._r8 + ! end if + ! if( ch2o_dd ) then + ! if( map(ch2o_ndx) == 0 ) then + ! depvel(:ncol,ch2o_ndx) = tmp(:ncol) + ! dflx(:ncol,ch2o_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,ch2o_ndx) + ! end if + ! end if + + ! if( hydrald_dd ) then + ! if( map(hydrald_ndx) == 0 ) then + ! depvel(:ncol,hydrald_ndx) = tmp(:ncol) + ! dflx(:ncol,hydrald_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,hydrald_ndx) + ! end if + ! end if + ! if( ch3cooh_dd ) then + ! if( map(ch3cooh_ndx) == 0 ) then + ! depvel(:ncol,ch3cooh_ndx) = depvel(:ncol,ch2o_ndx) + ! dflx(:ncol,ch3cooh_ndx) = wrk(:ncol) * depvel(:ncol,ch3cooh_ndx) * q(:ncol,plev,ch3cooh_ndx) + ! end if + ! end if + ! if( eooh_dd ) then + ! if( map(eooh_ndx) == 0 ) then + ! depvel(:ncol,eooh_ndx) = depvel(:ncol,ch2o_ndx) + ! dflx(:ncol,eooh_ndx) = wrk(:ncol) * depvel(:ncol,eooh_ndx) * q(:ncol,plev,eooh_ndx) + ! end if + ! end if + ! ! HCOOH - set to CH3COOH + ! if( hcooh_dd ) then + ! if( map(hcooh_ndx) == 0 ) then + ! depvel(:ncol,hcooh_ndx) = depvel(:ncol,ch2o_ndx) + ! dflx(:ncol,hcooh_ndx) = wrk(:ncol) * depvel(:ncol,hcooh_ndx) * q(:ncol,plev,hcooh_ndx) + ! end if + ! end if + + ! !-------------------------------------------------------- + ! ! ... Set co and related species dep vel + ! !-------------------------------------------------------- + ! if( co_in_tab ) then + ! do i=1,ncol + ! tmp(i) = dvel_interp(i,lchnk,co_tab_ndx) + ! enddo + ! else + ! tmp(:) = 0._r8 + ! end if + ! if( co_dd ) then + ! if( map(co_ndx) == 0 ) then + ! depvel(:ncol,co_ndx) = tmp(:ncol) + ! dflx(:ncol,co_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,co_ndx) + ! end if + ! end if + ! if( ch3coch3_dd ) then + ! if( map(ch3coch3_ndx) == 0 ) then + ! depvel(:ncol,ch3coch3_ndx) = tmp(:ncol) + ! dflx(:ncol,ch3coch3_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,ch3coch3_ndx) + ! end if + ! end if + ! if( hyac_dd ) then + ! if( map(hyac_ndx) == 0 ) then + ! depvel(:ncol,hyac_ndx) = tmp(:ncol) + ! dflx(:ncol,hyac_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,hyac_ndx) + ! end if + ! end if + ! if( h2_dd ) then + ! if( map(h2_ndx) == 0 ) then + ! depvel(:ncol,h2_ndx) = tmp(:ncol) * 1.5_r8 ! Hough(1991) + ! dflx(:ncol,h2_ndx) = wrk(:ncol) * depvel(:ncol,h2_ndx) * q(:ncol,plev,h2_ndx) + ! end if + ! end if + + ! !-------------------------------------------------------- + ! ! ... Set glyald + ! !-------------------------------------------------------- + ! if( glyald_dd ) then + ! if( map(glyald_ndx) == 0 ) then + ! if( ch3cho_dd ) then + ! depvel(:ncol,glyald_ndx) = depvel(:ncol,ch3cho_ndx) + ! else if( ch3cho_in_tab ) then + ! do i=1,ncol + ! depvel(i,glyald_ndx) = dvel_interp(i,lchnk,ch3cho_tab_ndx) + ! enddo + ! else + ! depvel(:ncol,glyald_ndx) = 0._r8 + ! end if + ! dflx(:ncol,glyald_ndx) = wrk(:ncol) * depvel(:ncol,glyald_ndx) * q(:ncol,plev,glyald_ndx) + ! end if + ! end if + + ! !-------------------------------------------------------- + ! ! ... Lead deposition + ! !-------------------------------------------------------- + ! if( Pb_dd ) then + ! if( map(Pb_ndx) == 0 ) then + ! depvel(:ncol,Pb_ndx) = ocean(:ncol) * .05_r8 + (1._r8 - ocean(:ncol)) * .2_r8 + ! dflx(:ncol,Pb_ndx) = wrk(:ncol) * depvel(:ncol,Pb_ndx) * q(:ncol,plev,Pb_ndx) + ! end if + ! end if + + ! !-------------------------------------------------------- + ! ! ... diurnal dependence for OX dvel + ! !-------------------------------------------------------- + ! if( o3_dd .or. o3s_dd .or. o3inert_dd ) then + ! if( o3_dd .or. o3_in_tab ) then + ! if( o3_dd ) then + ! tmp(:ncol) = max( 1._r8,sqrt( (depvel(:ncol,o3_ndx) - .2_r8)**3/.27_r8 + 4._r8*depvel(:ncol,o3_ndx) + .67_r8 ) ) + ! vel(:ncol) = depvel(:ncol,o3_ndx) + ! else if( o3_in_tab ) then + ! tmp(:ncol) = max( 1._r8,sqrt( (o3_tab_dvel(:ncol) - .2_r8)**3/.27_r8 + 4._r8*o3_tab_dvel(:ncol) + .67_r8 ) ) + ! vel(:ncol) = o3_tab_dvel(:ncol) + ! end if + ! where( abs( zen_angle(:) ) > pid2 ) + ! vel(:) = vel(:) / tmp(:) + ! elsewhere + ! vel(:) = vel(:) * tmp(:) + ! endwhere + + ! else + ! vel(:ncol) = 0._r8 + ! end if + ! if( o3_dd ) then + ! depvel(:ncol,o3_ndx) = vel(:ncol) + ! dflx(:ncol,o3_ndx) = wrk(:ncol) * vel(:ncol) * q(:ncol,plev,o3_ndx) + ! end if + ! !-------------------------------------------------------- + ! ! ... Set stratospheric O3 deposition + ! !-------------------------------------------------------- + ! if( o3s_dd ) then + ! depvel(:ncol,o3s_ndx) = vel(:ncol) + ! dflx(:ncol,o3s_ndx) = wrk(:ncol) * vel(:ncol) * q(:ncol,plev,o3s_ndx) + ! end if + ! if( o3inert_dd ) then + ! depvel(:ncol,o3inert_ndx) = vel(:ncol) + ! dflx(:ncol,o3inert_ndx) = wrk(:ncol) * vel(:ncol) * q(:ncol,plev,o3inert_ndx) + ! end if + ! end if + + ! if( xno2_dd ) then + ! if( map(xno2_ndx) == 0 ) then + ! depvel(:ncol,xno2_ndx) = depvel(:ncol,no2_ndx) + ! dflx(:ncol,xno2_ndx) = wrk(:ncol) * depvel(:ncol,xno2_ndx) * q(:ncol,plev,xno2_ndx) + ! end if + ! endif + ! if( o3a_dd ) then + ! if( map(o3a_ndx) == 0 ) then + ! depvel(:ncol,o3a_ndx) = depvel(:ncol,o3_ndx) + ! dflx(:ncol,o3a_ndx) = wrk(:ncol) * depvel(:ncol,o3a_ndx) * q(:ncol,plev,o3a_ndx) + ! end if + ! endif + ! if( xhno3_dd ) then + ! if( map(xhno3_ndx) == 0 ) then + ! depvel(:ncol,xhno3_ndx) = depvel(:ncol,hno3_ndx) + ! dflx(:ncol,xhno3_ndx) = wrk(:ncol) * depvel(:ncol,xhno3_ndx) * q(:ncol,plev,xhno3_ndx) + ! end if + ! endif + ! if( xnh4no3_dd ) then + ! if( map(xnh4no3_ndx) == 0 ) then + ! depvel(:ncol,xnh4no3_ndx) = depvel(:ncol,nh4no3_ndx) + ! dflx(:ncol,xnh4no3_ndx) = wrk(:ncol) * depvel(:ncol,xnh4no3_ndx) * q(:ncol,plev,xnh4no3_ndx) + ! end if + ! endif + ! if( xpan_dd ) then + ! if( map(xpan_ndx) == 0 ) then + ! depvel(:ncol,xpan_ndx) = depvel(:ncol,pan_ndx) + ! dflx(:ncol,xpan_ndx) = wrk(:ncol) * depvel(:ncol,xpan_ndx) * q(:ncol,plev,xpan_ndx) + ! end if + ! endif + ! if( xmpan_dd ) then + ! if( map(xmpan_ndx) == 0 ) then + ! depvel(:ncol,xmpan_ndx) = depvel(:ncol,mpan_ndx) + ! dflx(:ncol,xmpan_ndx) = wrk(:ncol) * depvel(:ncol,xmpan_ndx) * q(:ncol,plev,xmpan_ndx) + ! end if + ! endif + ! if( xonit_dd ) then + ! if( map(xonit_ndx) == 0 ) then + ! depvel(:ncol,xonit_ndx) = depvel(:ncol,onit_ndx) + ! dflx(:ncol,xonit_ndx) = wrk(:ncol) * depvel(:ncol,xonit_ndx) * q(:ncol,plev,xonit_ndx) + ! end if + ! endif + ! if( xonitr_dd ) then + ! if( map(xonitr_ndx) == 0 ) then + ! depvel(:ncol,xonitr_ndx) = depvel(:ncol,onitr_ndx) + ! dflx(:ncol,xonitr_ndx) = wrk(:ncol) * depvel(:ncol,xonitr_ndx) * q(:ncol,plev,xonitr_ndx) + ! end if + ! endif + ! if( xno_dd ) then + ! if( map(xno_ndx) == 0 ) then + ! depvel(:ncol,xno_ndx) = depvel(:ncol,no_ndx) + ! dflx(:ncol,xno_ndx) = wrk(:ncol) * depvel(:ncol,xno_ndx) * q(:ncol,plev,xno_ndx) + ! end if + ! endif + ! if( xho2no2_dd ) then + ! if( map(xho2no2_ndx) == 0 ) then + ! depvel(:ncol,xho2no2_ndx) = depvel(:ncol,ho2no2_ndx) + ! dflx(:ncol,xho2no2_ndx) = wrk(:ncol) * depvel(:ncol,xho2no2_ndx) * q(:ncol,plev,xho2no2_ndx) + ! end if + ! endif + ! !lke-TS1 + ! if( phenooh_dd ) then + ! if( map(phenooh_ndx) == 0 ) then + ! depvel(:ncol,phenooh_ndx) = depvel(:ncol,ch3ooh_ndx) + ! dflx(:ncol,phenooh_ndx) = wrk(:ncol) * depvel(:ncol,phenooh_ndx) * q(:ncol,plev,phenooh_ndx) + ! end if + ! endif + ! if( benzooh_dd ) then + ! if( map(benzooh_ndx) == 0 ) then + ! depvel(:ncol,benzooh_ndx) = depvel(:ncol,ch3ooh_ndx) + ! dflx(:ncol,benzooh_ndx) = wrk(:ncol) * depvel(:ncol,benzooh_ndx) * q(:ncol,plev,benzooh_ndx) + ! end if + ! endif + ! if( c6h5ooh_dd ) then + ! if( map(c6h5ooh_ndx) == 0 ) then + ! depvel(:ncol,c6h5ooh_ndx) = depvel(:ncol,ch3ooh_ndx) + ! dflx(:ncol,c6h5ooh_ndx) = wrk(:ncol) * depvel(:ncol,c6h5ooh_ndx) * q(:ncol,plev,c6h5ooh_ndx) + ! end if + ! endif + ! if( bzooh_dd ) then + ! if( map(bzooh_ndx) == 0 ) then + ! depvel(:ncol,bzooh_ndx) = depvel(:ncol,ch3ooh_ndx) + ! dflx(:ncol,bzooh_ndx) = wrk(:ncol) * depvel(:ncol,bzooh_ndx) * q(:ncol,plev,bzooh_ndx) + ! end if + ! endif + ! if( xylolooh_dd ) then + ! if( map(xylolooh_ndx) == 0 ) then + ! depvel(:ncol,xylolooh_ndx) = depvel(:ncol,ch3ooh_ndx) + ! dflx(:ncol,xylolooh_ndx) = wrk(:ncol) * depvel(:ncol,xylolooh_ndx) * q(:ncol,plev,xylolooh_ndx) + ! end if + ! endif + ! if( xylenooh_dd ) then + ! if( map(xylenooh_ndx) == 0 ) then + ! depvel(:ncol,xylenooh_ndx) = depvel(:ncol,ch3ooh_ndx) + ! dflx(:ncol,xylenooh_ndx) = wrk(:ncol) * depvel(:ncol,xylenooh_ndx) * q(:ncol,plev,xylenooh_ndx) + ! end if + ! endif + ! if( terpooh_dd ) then + ! if( map(terpooh_ndx) == 0 ) then + ! depvel(:ncol,terpooh_ndx) = depvel(:ncol,isopooh_ndx) + ! dflx(:ncol,terpooh_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,terpooh_ndx) + ! end if + ! end if + ! if( terp2ooh_dd ) then + ! if( map(terp2ooh_ndx) == 0 ) then + ! depvel(:ncol,terp2ooh_ndx) = depvel(:ncol,isopooh_ndx) + ! dflx(:ncol,terp2ooh_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,terp2ooh_ndx) + ! end if + ! end if + ! if( terprod1_dd ) then + ! if( map(terprod1_ndx) == 0 ) then + ! depvel(:ncol,terprod1_ndx) = depvel(:ncol,hyac_ndx) + ! dflx(:ncol,terprod1_ndx) = wrk(:ncol) * depvel(:ncol,terprod1_ndx) * q(:ncol,plev,terprod1_ndx) + ! end if + ! endif + ! if( terprod2_dd ) then + ! if( map(terprod2_ndx) == 0 ) then + ! depvel(:ncol,terprod2_ndx) = depvel(:ncol,hyac_ndx) + ! dflx(:ncol,terprod2_ndx) = wrk(:ncol) * depvel(:ncol,terprod2_ndx) * q(:ncol,plev,terprod2_ndx) + ! end if + ! endif + ! if( hmprop_dd ) then + ! if( map(hmprop_ndx) == 0 ) then + ! depvel(:ncol,hmprop_ndx) = depvel(:ncol,glyald_ndx) + ! dflx(:ncol,hmprop_ndx) = wrk(:ncol) * depvel(:ncol,hmprop_ndx) * q(:ncol,plev,hmprop_ndx) + ! end if + ! endif + ! if( mboooh_dd ) then + ! if( map(mboooh_ndx) == 0 ) then + ! depvel(:ncol,mboooh_ndx) = depvel(:ncol,isopooh_ndx) + ! dflx(:ncol,mboooh_ndx) = wrk(:ncol) * depvel(:ncol,mboooh_ndx) * q(:ncol,plev,mboooh_ndx) + ! end if + ! endif + ! if( hpald_dd ) then + ! if( map(hpald_ndx) == 0 ) then + ! depvel(:ncol,hpald_ndx) = depvel(:ncol,ch3ooh_ndx) + ! dflx(:ncol,hpald_ndx) = wrk(:ncol) * depvel(:ncol,hpald_ndx) * q(:ncol,plev,hpald_ndx) + ! end if + ! endif + ! if( iepox_dd ) then + ! if( map(iepox_ndx) == 0 ) then + ! depvel(:ncol,iepox_ndx) = depvel(:ncol,hyac_ndx) + ! dflx(:ncol,iepox_ndx) = wrk(:ncol) * depvel(:ncol,iepox_ndx) * q(:ncol,plev,iepox_ndx) + ! end if + ! endif + ! if( noa_dd ) then + ! if( map(noa_ndx) == 0 ) then + ! depvel(:ncol,noa_ndx) = depvel(:ncol,h2o2_ndx) + ! dflx(:ncol,noa_ndx) = wrk(:ncol) * depvel(:ncol,noa_ndx) * q(:ncol,plev,noa_ndx) + ! end if + ! endif + ! if( alknit_dd ) then + ! if( map(alknit_ndx) == 0 ) then + ! depvel(:ncol,alknit_ndx) = depvel(:ncol,h2o2_ndx) + ! dflx(:ncol,alknit_ndx) = wrk(:ncol) * depvel(:ncol,alknit_ndx) * q(:ncol,plev,alknit_ndx) + ! end if + ! endif + ! if( isopnita_dd ) then + ! if( map(isopnita_ndx) == 0 ) then + ! depvel(:ncol,isopnita_ndx) = depvel(:ncol,h2o2_ndx) + ! dflx(:ncol,isopnita_ndx) = wrk(:ncol) * depvel(:ncol,isopnita_ndx) * q(:ncol,plev,isopnita_ndx) + ! end if + ! endif + ! if( isopnitb_dd ) then + ! if( map(isopnitb_ndx) == 0 ) then + ! depvel(:ncol,isopnitb_ndx) = depvel(:ncol,h2o2_ndx) + ! dflx(:ncol,isopnitb_ndx) = wrk(:ncol) * depvel(:ncol,isopnitb_ndx) * q(:ncol,plev,isopnitb_ndx) + ! end if + ! endif + ! if( honitr_dd ) then + ! if( map(honitr_ndx) == 0 ) then + ! depvel(:ncol,honitr_ndx) = depvel(:ncol,h2o2_ndx) + ! dflx(:ncol,honitr_ndx) = wrk(:ncol) * depvel(:ncol,honitr_ndx) * q(:ncol,plev,honitr_ndx) + ! end if + ! endif + ! if( isopnooh_dd ) then + ! if( map(isopnooh_ndx) == 0 ) then + ! depvel(:ncol,isopnooh_ndx) = depvel(:ncol,h2o2_ndx) + ! dflx(:ncol,isopnooh_ndx) = wrk(:ncol) * depvel(:ncol,isopnooh_ndx) * q(:ncol,plev,isopnooh_ndx) + ! end if + ! endif + ! if( nc4cho_dd ) then + ! if( map(nc4cho_ndx) == 0 ) then + ! depvel(:ncol,nc4cho_ndx) = depvel(:ncol,h2o2_ndx) + ! dflx(:ncol,nc4cho_ndx) = wrk(:ncol) * depvel(:ncol,nc4cho_ndx) * q(:ncol,plev,nc4cho_ndx) + ! end if + ! endif + ! if( nc4ch2oh_dd ) then + ! if( map(nc4ch2oh_ndx) == 0 ) then + ! depvel(:ncol,nc4ch2oh_ndx) = depvel(:ncol,h2o2_ndx) + ! dflx(:ncol,nc4ch2oh_ndx) = wrk(:ncol) * depvel(:ncol,nc4ch2oh_ndx) * q(:ncol,plev,nc4ch2oh_ndx) + ! end if + ! endif + ! if( terpnit_dd ) then + ! if( map(terpnit_ndx) == 0 ) then + ! depvel(:ncol,terpnit_ndx) = depvel(:ncol,h2o2_ndx) + ! dflx(:ncol,terpnit_ndx) = wrk(:ncol) * depvel(:ncol,terpnit_ndx) * q(:ncol,plev,terpnit_ndx) + ! end if + ! endif + ! if( nterpooh_dd ) then + ! if( map(nterpooh_ndx) == 0 ) then + ! depvel(:ncol,nterpooh_ndx) = depvel(:ncol,h2o2_ndx) + ! dflx(:ncol,nterpooh_ndx) = wrk(:ncol) * depvel(:ncol,nterpooh_ndx) * q(:ncol,plev,nterpooh_ndx) + ! end if + ! endif + + + !end subroutine drydep_table + + !------------------------------------------------------------------------------------- + !------------------------------------------------------------------------------------- + subroutine dvel_inti_xactive( depvel_lnd_file, clim_soilw_file, season_wes_file ) + !------------------------------------------------------------------------------------- + ! ... intialize interactive drydep + !------------------------------------------------------------------------------------- + use dycore, only : dycore_is + use mo_constants, only : r2d + use chem_mods, only : adv_mass + use mo_chem_utls, only : get_spc_ndx ! Replaced, TMMF + use seq_drydep_mod,only : drydep_method, DD_XATM, DD_XLND + use phys_control, only : phys_getopts + + implicit none + + !------------------------------------------------------------------------------------- + ! ... dummy arguments + !------------------------------------------------------------------------------------- + character(len=*), intent(in) :: depvel_lnd_file, clim_soilw_file, season_wes_file + + !------------------------------------------------------------------------------------- + ! ... local variables + !------------------------------------------------------------------------------------- + integer :: i, j, ii, jj, jl, ju + integer :: nlon_veg, nlat_veg, npft_veg + integer :: nlat_lai, npft_lai, pos_min, imin + integer :: dimid + integer :: m, n, l, id + integer :: length1, astat + integer, allocatable :: wk_lai(:,:,:) + integer, allocatable :: index_season_lai_j(:,:) + integer :: k, num_max, k_max + integer :: num_seas(5) + integer :: plon, plat + integer :: ierr, ndx + + real(r8) :: spc_mass + real(r8) :: diff_min, target_lat + real(r8), allocatable :: vegetation_map(:,:,:) + real(r8), pointer :: soilw_map(:,:,:) + real(r8), allocatable :: work(:,:) + real(r8), allocatable :: landmask(:,:) + real(r8), allocatable :: urban(:,:) + real(r8), allocatable :: lake(:,:) + real(r8), allocatable :: wetland(:,:) + real(r8), allocatable :: lon_veg(:) + real(r8), allocatable :: lon_veg_edge(:) + real(r8), allocatable :: lat_veg(:) + real(r8), allocatable :: lat_veg_edge(:) + real(r8), allocatable :: lat_lai(:) + real(r8), allocatable :: clat(:) + character(len=32) :: test_name + character(len=4) :: tag_name + type(file_desc_t) :: piofile + type(var_desc_t) :: vid + logical :: do_soilw + + character(len=shr_kind_cl) :: locfn + logical :: prog_modal_aero + + ! determine if modal aerosols are active so that fraction_landuse array is initialized for modal aerosal dry dep + call phys_getopts(prog_modal_aero_out=prog_modal_aero) + + call dvel_inti_fromlnd() + + if( masterproc ) then + write(iulog,*) 'drydep_inti: following species have dry deposition' + do i=1,nddvels + if( len_trim(drydep_list(i)) > 0 ) then + write(iulog,*) 'drydep_inti: '//trim(drydep_list(i))//' is requested to have dry dep' + endif + enddo + write(iulog,*) 'drydep_inti:' + endif + + !------------------------------------------------------------------------------------- + ! ... get species indices + !------------------------------------------------------------------------------------- + xpan_ndx = get_spc_ndx( 'XPAN' ) + xmpan_ndx = get_spc_ndx( 'XMPAN' ) + o3a_ndx = get_spc_ndx( 'O3A' ) + + ch4_ndx = get_spc_ndx( 'CH4' ) + h2_ndx = get_spc_ndx( 'H2' ) + co_ndx = get_spc_ndx( 'CO' ) + Pb_ndx = get_spc_ndx( 'Pb' ) + pan_ndx = get_spc_ndx( 'PAN' ) + mpan_ndx = get_spc_ndx( 'MPAN' ) + o3_ndx = get_spc_ndx( 'OX' ) + if( o3_ndx < 0 ) then + o3_ndx = get_spc_ndx( 'O3' ) + end if + so2_ndx = get_spc_ndx( 'SO2' ) + alkooh_ndx = get_spc_ndx( 'ALKOOH') + mekooh_ndx = get_spc_ndx( 'MEKOOH') + tolooh_ndx = get_spc_ndx( 'TOLOOH') + terpooh_ndx = get_spc_ndx( 'TERPOOH') + ch3cooh_ndx = get_spc_ndx( 'CH3COOH') + soa_ndx = get_spc_ndx( 'SOA' ) + so4_ndx = get_spc_ndx( 'SO4' ) + cb1_ndx = get_spc_ndx( 'CB1' ) + cb2_ndx = get_spc_ndx( 'CB2' ) + oc1_ndx = get_spc_ndx( 'OC1' ) + oc2_ndx = get_spc_ndx( 'OC2' ) + nh3_ndx = get_spc_ndx( 'NH3' ) + nh4no3_ndx = get_spc_ndx( 'NH4NO3' ) + sa1_ndx = get_spc_ndx( 'SA1' ) + sa2_ndx = get_spc_ndx( 'SA2' ) + sa3_ndx = get_spc_ndx( 'SA3' ) + sa4_ndx = get_spc_ndx( 'SA4' ) + nh4_ndx = get_spc_ndx( 'NH4' ) + alkooh_dd = has_drydep( 'ALKOOH') + mekooh_dd = has_drydep( 'MEKOOH') + tolooh_dd = has_drydep( 'TOLOOH') + terpooh_dd = has_drydep( 'TERPOOH') + ch3cooh_dd = has_drydep( 'CH3COOH') + soa_dd = has_drydep( 'SOA' ) + so4_dd = has_drydep( 'SO4' ) + cb1_dd = has_drydep( 'CB1' ) + cb2_dd = has_drydep( 'CB2' ) + oc1_dd = has_drydep( 'OC1' ) + oc2_dd = has_drydep( 'OC2' ) + nh3_dd = has_drydep( 'NH3' ) + nh4no3_dd = has_drydep( 'NH4NO3' ) + sa1_dd = has_drydep( 'SA1' ) + sa2_dd = has_drydep( 'SA2' ) + sa3_dd = has_drydep( 'SA3' ) + sa4_dd = has_drydep( 'SA4' ) + nh4_dd = has_drydep( 'NH4' ) +! + soam_ndx = get_spc_ndx( 'SOAM' ) + soai_ndx = get_spc_ndx( 'SOAI' ) + soat_ndx = get_spc_ndx( 'SOAT' ) + soab_ndx = get_spc_ndx( 'SOAB' ) + soax_ndx = get_spc_ndx( 'SOAX' ) + sogm_ndx = get_spc_ndx( 'SOGM' ) + sogi_ndx = get_spc_ndx( 'SOGI' ) + sogt_ndx = get_spc_ndx( 'SOGT' ) + sogb_ndx = get_spc_ndx( 'SOGB' ) + sogx_ndx = get_spc_ndx( 'SOGX' ) + soam_dd = has_drydep ( 'SOAM' ) + soai_dd = has_drydep ( 'SOAI' ) + soat_dd = has_drydep ( 'SOAT' ) + soab_dd = has_drydep ( 'SOAB' ) + soax_dd = has_drydep ( 'SOAX' ) + sogm_dd = has_drydep ( 'SOGM' ) + sogi_dd = has_drydep ( 'SOGI' ) + sogt_dd = has_drydep ( 'SOGT' ) + sogb_dd = has_drydep ( 'SOGB' ) + sogx_dd = has_drydep ( 'SOGX' ) +! + hcn_ndx = get_spc_ndx( 'HCN') + ch3cn_ndx = get_spc_ndx( 'CH3CN') + +!lke-TS1 + phenooh_ndx = get_spc_ndx( 'PHENOOH') + benzooh_ndx = get_spc_ndx( 'BENZOOH') + c6h5ooh_ndx = get_spc_ndx( 'C6H5OOH') + bzooh_ndx = get_spc_ndx( 'BZOOH') + xylolooh_ndx = get_spc_ndx( 'XYLOLOOH') + xylenooh_ndx = get_spc_ndx( 'XYLENOOH') + terp2ooh_ndx = get_spc_ndx( 'TERP2OOH') + terprod1_ndx = get_spc_ndx( 'TERPROD1') + terprod2_ndx = get_spc_ndx( 'TERPROD2') + hmprop_ndx = get_spc_ndx( 'HMPROP') + mboooh_ndx = get_spc_ndx( 'MBOOOH') + hpald_ndx = get_spc_ndx( 'HPALD') + iepox_ndx = get_spc_ndx( 'IEPOX') + noa_ndx = get_spc_ndx( 'NOA') + alknit_ndx = get_spc_ndx( 'ALKNIT') + isopnita_ndx = get_spc_ndx( 'ISOPNITA') + isopnitb_ndx = get_spc_ndx( 'ISOPNITB') + honitr_ndx = get_spc_ndx( 'HONITR') + isopnooh_ndx = get_spc_ndx( 'ISOPNOOH') + nc4cho_ndx = get_spc_ndx( 'NC4CHO') + nc4ch2oh_ndx = get_spc_ndx( 'NC4CH2OH') + terpnit_ndx = get_spc_ndx( 'TERPNIT') + nterpooh_ndx = get_spc_ndx( 'NTERPOOH') + phenooh_dd = has_drydep( 'PHENOOH') + benzooh_dd = has_drydep( 'BENZOOH') + c6h5ooh_dd = has_drydep( 'C6H5OOH') + bzooh_dd = has_drydep( 'BZOOH') + xylolooh_dd = has_drydep( 'XYLOLOOH') + xylenooh_dd = has_drydep( 'XYLENOOH') + terp2ooh_dd = has_drydep( 'TERP2OOH') + terprod1_dd = has_drydep( 'TERPROD1') + terprod2_dd = has_drydep( 'TERPROD2') + hmprop_dd = has_drydep( 'HMPROP') + mboooh_dd = has_drydep( 'MBOOOH') + hpald_dd = has_drydep( 'HPALD') + iepox_dd = has_drydep( 'IEPOX') + noa_dd = has_drydep( 'NOA') + alknit_dd = has_drydep( 'ALKNIT') + isopnita_dd = has_drydep( 'ISOPNITA') + isopnitb_dd = has_drydep( 'ISOPNITB') + honitr_dd = has_drydep( 'HONITR') + isopnooh_dd = has_drydep( 'ISOPNOOH') + nc4cho_dd = has_drydep( 'NC4CHO') + nc4ch2oh_dd = has_drydep( 'NC4CH2OH') + terpnit_dd = has_drydep( 'TERPNIT') + nterpooh_dd = has_drydep( 'NTERPOOH') +! + cohc_ndx = get_spc_ndx( 'COhc' ) + come_ndx = get_spc_ndx( 'COme' ) + + tag_cnt=0 + cotag_ndx(:)=-1 + do i = 1,NTAGS + write(tag_name,'(a2,i2.2)') 'CO',i + ndx = get_spc_ndx(tag_name) + if (ndx>0) then + tag_cnt = tag_cnt+1 + cotag_ndx(tag_cnt) = ndx + endif + enddo + + o3s_ndx = get_spc_ndx( 'O3S' ) + + do i=1,nddvels + if ( ( mapping(i) > 0 ) .and. ( drySpc_ndx(i) > 0 ) ) then + m = drySpc_ndx(i) + has_dvel(m) = .true. + map_dvel(m) = i + endif + enddo + + if( all( .not. has_dvel(:) ) ) then + return + end if + + !--------------------------------------------------------------------------- + ! ... allocate module variables + !--------------------------------------------------------------------------- + allocate( dep_ra(pcols,n_land_type,begchunk:endchunk),stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'dvel_inti: failed to allocate dep_ra; error = ',astat + call endrun + end if + allocate( dep_rb(pcols,n_land_type,begchunk:endchunk),stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'dvel_inti: failed to allocate dep_rb; error = ',astat + call endrun + end if + + if (drydep_method == DD_XLND .and. (.not.prog_modal_aero)) then + return + endif + + do_soilw = .not. dyn_soilw .and. (has_drydep( 'H2' ) .or. has_drydep( 'CO' )) + allocate( fraction_landuse(pcols,n_land_type, begchunk:endchunk),stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'dvel_inti: failed to allocate fraction_landuse; error = ',astat + call endrun + end if + if(do_soilw) then + allocate(soilw_3d(pcols,12,begchunk:endchunk),stat=astat) + if( astat /= 0 ) then + write(iulog,*) 'dvel_inti: failed to allocate soilw_3d error = ',astat + call endrun + end if + end if + + plon = get_dyn_grid_parm('plon') + plat = get_dyn_grid_parm('plat') + allocate( index_season_lai_j(n_land_type,12),stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'dvel_inti: failed to allocate index_season_lai_j; error = ',astat + call endrun + end if + if(dycore_is('UNSTRUCTURED') ) then + call get_landuse_and_soilw_from_file(do_soilw) + allocate( index_season_lai(plon,12),stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'dvel_inti: failed to allocate index_season_lai; error = ',astat + call endrun + end if + else + allocate( index_season_lai(plat,12),stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'dvel_inti: failed to allocate index_season_lai; error = ',astat + call endrun + end if + !--------------------------------------------------------------------------- + ! ... read landuse map + !--------------------------------------------------------------------------- + call getfil (depvel_lnd_file, locfn, 0) + call cam_pio_openfile (piofile, trim(locfn), PIO_NOWRITE) + !--------------------------------------------------------------------------- + ! ... get the dimensions + !--------------------------------------------------------------------------- + ierr = pio_inq_dimid( piofile, 'lon', dimid ) + ierr = pio_inq_dimlen( piofile, dimid, nlon_veg ) + ierr = pio_inq_dimid( piofile, 'lat', dimid ) + ierr = pio_inq_dimlen( piofile, dimid, nlat_veg ) + ierr = pio_inq_dimid( piofile, 'pft', dimid ) + ierr = pio_inq_dimlen( piofile, dimid, npft_veg ) + !--------------------------------------------------------------------------- + ! ... allocate arrays + !--------------------------------------------------------------------------- + allocate( vegetation_map(nlon_veg,nlat_veg,npft_veg), work(nlon_veg,nlat_veg), stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'dvel_inti: failed to allocate vegation_map; error = ',astat + call endrun + end if + allocate( urban(nlon_veg,nlat_veg), lake(nlon_veg,nlat_veg), & + landmask(nlon_veg,nlat_veg), wetland(nlon_veg,nlat_veg), stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'dvel_inti: failed to allocate vegation_map; error = ',astat + call endrun + end if + allocate( lon_veg(nlon_veg), lat_veg(nlat_veg), & + lon_veg_edge(nlon_veg+1), lat_veg_edge(nlat_veg+1), stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'dvel_inti: failed to allocate vegation lon, lat arrays; error = ',astat + call endrun + end if + !--------------------------------------------------------------------------- + ! ... read the vegetation map and landmask + !--------------------------------------------------------------------------- + ierr = pio_inq_varid( piofile, 'PCT_PFT', vid ) + ierr = pio_get_var( piofile, vid, vegetation_map ) + + ierr = pio_inq_varid( piofile, 'LANDMASK', vid ) + ierr = pio_get_var( piofile, vid, landmask ) + + ierr = pio_inq_varid( piofile, 'PCT_URBAN', vid ) + ierr = pio_get_var( piofile, vid, urban ) + + ierr = pio_inq_varid( piofile, 'PCT_LAKE', vid ) + ierr = pio_get_var( piofile, vid, lake ) + + ierr = pio_inq_varid( piofile, 'PCT_WETLAND', vid ) + ierr = pio_get_var( piofile, vid, wetland ) + + call cam_pio_closefile( piofile ) + + !--------------------------------------------------------------------------- + ! scale vegetation, urban, lake, and wetland to fraction + !--------------------------------------------------------------------------- + vegetation_map(:,:,:) = .01_r8 * vegetation_map(:,:,:) + wetland(:,:) = .01_r8 * wetland(:,:) + lake(:,:) = .01_r8 * lake(:,:) + urban(:,:) = .01_r8 * urban(:,:) +#ifdef DEBUG + if(masterproc) then + write(iulog,*) 'minmax vegetation_map ',minval(vegetation_map),maxval(vegetation_map) + write(iulog,*) 'minmax wetland ',minval(wetland),maxval(wetland) + write(iulog,*) 'minmax landmask ',minval(landmask),maxval(landmask) + end if +#endif + !--------------------------------------------------------------------------- + ! ... define lat-lon of vegetation map (1x1) + !--------------------------------------------------------------------------- + lat_veg(:) = (/ (-89.5_r8 + (i-1),i=1,nlat_veg ) /) + lon_veg(:) = (/ ( 0.5_r8 + (i-1),i=1,nlon_veg ) /) + lat_veg_edge(:) = (/ (-90.0_r8 + (i-1),i=1,nlat_veg+1) /) + lon_veg_edge(:) = (/ ( 0.0_r8 + (i-1),i=1,nlon_veg+1) /) + !--------------------------------------------------------------------------- + ! ... read soilw table if necessary + !--------------------------------------------------------------------------- + + if( do_soilw ) then + call soilw_inti( clim_soilw_file, nlon_veg, nlat_veg, soilw_map ) + end if + + !--------------------------------------------------------------------------- + ! ... regrid to model grid + !--------------------------------------------------------------------------- + + call interp_map( plon, plat, nlon_veg, nlat_veg, npft_veg, lat_veg, lat_veg_edge, & + lon_veg, lon_veg_edge, landmask, urban, lake, & + wetland, vegetation_map, soilw_map, do_soilw ) + + deallocate( vegetation_map, work, stat=astat ) + deallocate( lon_veg, lat_veg, lon_veg_edge, lat_veg_edge, stat=astat ) + deallocate( landmask, urban, lake, wetland, stat=astat ) + if( do_soilw ) then + deallocate( soilw_map, stat=astat ) + end if + endif ! Unstructured grid + + if (drydep_method == DD_XLND) then + return + endif + + !--------------------------------------------------------------------------- + ! ... read LAI based season indeces + !--------------------------------------------------------------------------- + call getfil (season_wes_file, locfn, 0) + call cam_pio_openfile (piofile, trim(locfn), PIO_NOWRITE) + !--------------------------------------------------------------------------- + ! ... get the dimensions + !--------------------------------------------------------------------------- + ierr = pio_inq_dimid( piofile, 'lat', dimid ) + ierr = pio_inq_dimlen( piofile, dimid, nlat_lai ) + ierr = pio_inq_dimid( piofile, 'pft', dimid ) + ierr = pio_inq_dimlen( piofile, dimid, npft_lai ) + !--------------------------------------------------------------------------- + ! ... allocate arrays + !--------------------------------------------------------------------------- + allocate( lat_lai(nlat_lai), wk_lai(nlat_lai,npft_lai,12), stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'dvel_inti: failed to allocate vegation_map; error = ',astat + call endrun + end if + !--------------------------------------------------------------------------- + ! ... read the latitude and the season indicies + !--------------------------------------------------------------------------- + ierr = pio_inq_varid( piofile, 'lat', vid ) + ierr = pio_get_var( piofile, vid, lat_lai ) + + ierr = pio_inq_varid( piofile, 'season_wes', vid ) + ierr = pio_get_var( piofile, vid, wk_lai ) + + call cam_pio_closefile( piofile ) + + + if(dycore_is('UNSTRUCTURED') ) then + ! For unstructured grids plon is the 1d horizontal grid size and plat=1 + allocate(clat(plon)) + call get_horiz_grid_d(plon, clat_d_out=clat) + jl = 1 + ju = plon + else + allocate(clat(plat)) + call get_horiz_grid_d(plat, clat_d_out=clat) + jl = 1 + ju = plat + end if + imin = 1 + do j = 1,ju + diff_min = 10._r8 + pos_min = -99 + target_lat = clat(j)*r2d + do i = imin,nlat_lai + if( abs(lat_lai(i) - target_lat) < diff_min ) then + diff_min = abs(lat_lai(i) - target_lat) + pos_min = i + end if + end do + if( pos_min < 0 ) then + write(iulog,*) 'dvel_inti: cannot find ',target_lat,' at j,pos_min,diff_min = ',j,pos_min,diff_min + write(iulog,*) 'dvel_inti: imin,nlat_lai = ',imin,nlat_lai + write(iulog,*) 'dvel_inti: lat_lai' + write(iulog,'(1p,10g12.5)') lat_lai(:) + call endrun + end if + if(dycore_is('UNSTRUCTURED') ) then + imin=1 + else + imin = pos_min + end if + index_season_lai_j(:,:) = wk_lai(pos_min,:,:) + + !--------------------------------------------------------------------------- + ! specify the season as the most frequent in the 11 vegetation classes + ! this was done to remove a banding problem in dvel (JFL Oct 04) + !--------------------------------------------------------------------------- + do m = 1,12 + num_seas = 0 + do l = 1,11 + do k = 1,5 + if( index_season_lai_j(l,m) == k ) then + num_seas(k) = num_seas(k) + 1 + exit + end if + end do + end do + + num_max = -1 + do k = 1,5 + if( num_seas(k) > num_max ) then + num_max = num_seas(k) + k_max = k + endif + end do + + index_season_lai(j,m) = k_max + end do + end do + + deallocate( lat_lai, wk_lai, clat, index_season_lai_j) + + end subroutine dvel_inti_xactive + + !------------------------------------------------------------------------------------- + subroutine get_landuse_and_soilw_from_file(do_soilw) + use ncdio_atm, only : infld + logical, intent(in) :: do_soilw + logical :: readvar + + type(file_desc_t) :: piofile + character(len=shr_kind_cl) :: locfn + logical :: lexist + + call getfil (drydep_srf_file, locfn, 1, lexist) + if(lexist) then + call cam_pio_openfile(piofile, locfn, PIO_NOWRITE) + + call infld('fraction_landuse', piofile, 'ncol','class',1,pcols,1,n_land_type, begchunk,endchunk, & + fraction_landuse, readvar, gridname='physgrid') + if (.not. readvar) then + write(iulog,*)'**************************************' + write(iulog,*)'get_landuse_and_soilw_from_file: INFO:' + write(iulog,*)' fraction_landuse not read from file: ' + write(iulog,*)' ', trim(locfn) + write(iulog,*)' setting all values to zero' + write(iulog,*)'**************************************' + fraction_landuse = 0._r8 + end if + + if(do_soilw) then + call infld('soilw', piofile, 'ncol','month',1,pcols,1,12, begchunk,endchunk, & + soilw_3d, readvar, gridname='physgrid') + end if + + call cam_pio_closefile(piofile) + else + call endrun('Unstructured grids require drydep_srf_file ') + end if + + + end subroutine get_landuse_and_soilw_from_file + + !------------------------------------------------------------------------------------- + subroutine interp_map( plon, plat, nlon_veg, nlat_veg, npft_veg, lat_veg, lat_veg_edge, & + lon_veg, lon_veg_edge, landmask, urban, lake, & + wetland, vegetation_map, soilw_map, do_soilw ) + + use mo_constants, only : r2d + use scamMod, only : latiop,loniop,scmlat,scmlon,scm_cambfb_mode + use shr_scam_mod , only: shr_scam_getCloseLatLon ! Standardized system subroutines + use cam_initfiles, only: initial_file_get_id + use dycore, only : dycore_is + use phys_grid, only : scatter_field_to_chunk + implicit none + + !------------------------------------------------------------------------------------- + ! ... dummy arguments + !------------------------------------------------------------------------------------- + integer, intent(in) :: plon, plat, nlon_veg, nlat_veg, npft_veg + real(r8), pointer :: soilw_map(:,:,:) + real(r8), intent(in) :: landmask(nlon_veg,nlat_veg) + real(r8), intent(in) :: urban(nlon_veg,nlat_veg) + real(r8), intent(in) :: lake(nlon_veg,nlat_veg) + real(r8), intent(in) :: wetland(nlon_veg,nlat_veg) + real(r8), intent(in) :: vegetation_map(nlon_veg,nlat_veg,npft_veg) + real(r8), intent(in) :: lon_veg(nlon_veg) + real(r8), intent(in) :: lon_veg_edge(nlon_veg+1) + real(r8), intent(in) :: lat_veg(nlat_veg) + real(r8), intent(in) :: lat_veg_edge(nlat_veg+1) + logical, intent(in) :: do_soilw + + !------------------------------------------------------------------------------------- + ! ... local variables + !------------------------------------------------------------------------------------- + real(r8) :: closelat,closelon + integer :: latidx,lonidx + + integer, parameter :: veg_ext = 20 + type(file_desc_t), pointer :: piofile + integer :: i, j, ii, jj, jl, ju, i_ndx, n + integer, dimension(plon+1) :: ind_lon + integer, dimension(plat+1) :: ind_lat + real(r8) :: total_land + real(r8), dimension(plon+1) :: lon_edge + real(r8), dimension(plat+1) :: lat_edge + real(r8) :: lat1, lat2, lon1, lon2 + real(r8) :: x1, x2, y1, y2, dx, dy + real(r8) :: area, total_area + real(r8), dimension(npft_veg+3) :: fraction + real(r8) :: total_soilw_area + real(r8) :: fraction_soilw + real(r8) :: total_soilw(12) + + real(r8), dimension(-veg_ext:nlon_veg+veg_ext) :: lon_veg_edge_ext + integer, dimension(-veg_ext:nlon_veg+veg_ext) :: mapping_ext + + real(r8), allocatable :: lam(:), phi(:), garea(:) + + logical, parameter :: has_npole = .true. + integer :: ploniop,platiop + real(r8) :: tmp_frac_lu(plon,n_land_type,plat), tmp_soilw_3d(plon,12,plat) + + if(dycore_is('UNSTRUCTURED') ) then + ! For unstructured grids plon is the 1d horizontal grid size and plat=1 + allocate(lam(plon), phi(plon)) + call get_horiz_grid_d(plon, clat_d_out=phi) + else + allocate(lam(plon), phi(plat)) + call get_horiz_grid_d(plat, clat_d_out=phi) + endif + call get_horiz_grid_d(plon, clon_d_out=lam) + + + jl = 1 + ju = plon + + if (single_column) then + if (scm_cambfb_mode) then + piofile => initial_file_get_id() + call shr_scam_getCloseLatLon(piofile%fh,scmlat,scmlon,closelat,closelon,latidx,lonidx) + ploniop=size(loniop) + platiop=size(latiop) + else + latidx=1 + lonidx=1 + ploniop=1 + platiop=1 + end if + + lon_edge(1) = loniop(lonidx) * r2d - .5_r8*(loniop(2) - loniop(1)) * r2d + + if (lonidx.lt.ploniop) then + lon_edge(2) = loniop(lonidx+1) * r2d - .5_r8*(loniop(2) - loniop(1)) * r2d + else + lon_edge(2) = lon_edge(1) + (loniop(2) - loniop(1)) * r2d + end if + + lat_edge(1) = latiop(latidx) * r2d - .5_r8*(latiop(2) - latiop(1)) * r2d + + if (latidx.lt.platiop) then + lat_edge(2) = latiop(latidx+1) * r2d - .5_r8*(latiop(2) - latiop(1)) * r2d + else + lat_edge(2) = lat_edge(1) + (latiop(2) - latiop(1)) * r2d + end if + else + do i = 1,plon + lon_edge(i) = lam(i) * r2d - .5_r8*(lam(2) - lam(1)) * r2d + end do + lon_edge(plon+1) = lon_edge(plon) + (lam(2) - lam(1)) * r2d + if( .not. has_npole ) then + do j = 1,plat+1 + lat_edge(j) = phi(j) * r2d - .5_r8*(phi(2) - phi(1)) * r2d + end do + else + do j = 1,plat + lat_edge(j) = phi(j) * r2d - .5_r8*(phi(2) - phi(1)) * r2d + end do + lat_edge(plat+1) = lat_edge(plat) + (phi(2) - phi(1)) * r2d + end if + end if + do j = 1,plat+1 + lat_edge(j) = min( lat_edge(j), 90._r8 ) + lat_edge(j) = max( lat_edge(j),-90._r8 ) + end do + + !------------------------------------------------------------------------------------- + ! wrap around the longitudes + !------------------------------------------------------------------------------------- + do i = -veg_ext,0 + lon_veg_edge_ext(i) = lon_veg_edge(nlon_veg+i) - 360._r8 + mapping_ext (i) = nlon_veg+i + end do + do i = 1,nlon_veg + lon_veg_edge_ext(i) = lon_veg_edge(i) + mapping_ext (i) = i + end do + do i = nlon_veg+1,nlon_veg+veg_ext + lon_veg_edge_ext(i) = lon_veg_edge(i-nlon_veg) + 360._r8 + mapping_ext (i) = i-nlon_veg + end do +#ifdef DEBUG + write(iulog,*) 'interp_map : lon_edge ',lon_edge + write(iulog,*) 'interp_map : lat_edge ',lat_edge + write(iulog,*) 'interp_map : mapping_ext ',mapping_ext +#endif + do j = 1,plon+1 + lon1 = lon_edge(j) + do i = -veg_ext,nlon_veg+veg_ext + dx = lon_veg_edge_ext(i ) - lon1 + dy = lon_veg_edge_ext(i+1) - lon1 + if( dx*dy <= 0._r8 ) then + ind_lon(j) = i + exit + end if + end do + end do + + do j = 1,plat+1 + lat1 = lat_edge(j) + do i = 1,nlat_veg + dx = lat_veg_edge(i ) - lat1 + dy = lat_veg_edge(i+1) - lat1 + if( dx*dy <= 0._r8 ) then + ind_lat(j) = i + exit + end if + end do + end do +#ifdef DEBUG + write(iulog,*) 'interp_map : ind_lon ',ind_lon + write(iulog,*) 'interp_map : ind_lat ',ind_lat +#endif + lat_loop : do j = 1,plat + lon_loop : do i = 1,plon + total_area = 0._r8 + fraction = 0._r8 + total_soilw(:) = 0._r8 + total_soilw_area = 0._r8 + do jj = ind_lat(j),ind_lat(j+1) + y1 = max( lat_edge(j),lat_veg_edge(jj) ) + y2 = min( lat_edge(j+1),lat_veg_edge(jj+1) ) + dy = (y2 - y1)/(lat_veg_edge(jj+1) - lat_veg_edge(jj)) + do ii =ind_lon(i),ind_lon(i+1) + i_ndx = mapping_ext(ii) + x1 = max( lon_edge(i),lon_veg_edge_ext(ii) ) + x2 = min( lon_edge(i+1),lon_veg_edge_ext(ii+1) ) + dx = (x2 - x1)/(lon_veg_edge_ext(ii+1) - lon_veg_edge_ext(ii)) + area = dx * dy + total_area = total_area + area + !----------------------------------------------------------------- + ! ... special case for ocean grid point + !----------------------------------------------------------------- + if( nint(landmask(i_ndx,jj)) == 0 ) then + fraction(npft_veg+1) = fraction(npft_veg+1) + area + else + do n = 1,npft_veg + fraction(n) = fraction(n) + vegetation_map(i_ndx,jj,n) * area + end do + fraction(npft_veg+1) = fraction(npft_veg+1) + area * lake (i_ndx,jj) + fraction(npft_veg+2) = fraction(npft_veg+2) + area * wetland(i_ndx,jj) + fraction(npft_veg+3) = fraction(npft_veg+3) + area * urban (i_ndx,jj) + !----------------------------------------------------------------- + ! ... check if land accounts for the whole area. + ! If not, the remaining area is in the ocean + !----------------------------------------------------------------- + total_land = sum(vegetation_map(i_ndx,jj,:)) & + + urban (i_ndx,jj) & + + lake (i_ndx,jj) & + + wetland(i_ndx,jj) + if( total_land < 1._r8 ) then + fraction(npft_veg+1) = fraction(npft_veg+1) + (1._r8 - total_land) * area + end if + !------------------------------------------------------------------------------------- + ! ... compute weighted average of soilw over grid (non-water only) + !------------------------------------------------------------------------------------- + if( do_soilw ) then + fraction_soilw = total_land - (lake(i_ndx,jj) + wetland(i_ndx,jj)) + total_soilw_area = total_soilw_area + fraction_soilw * area + total_soilw(:) = total_soilw(:) + fraction_soilw * area * soilw_map(i_ndx,jj,:) + end if + end if + end do + end do + !------------------------------------------------------------------------------------- + ! ... divide by total area of grid box + !------------------------------------------------------------------------------------- + fraction(:) = fraction(:)/total_area + !------------------------------------------------------------------------------------- + ! ... make sure we don't have too much or too little + !------------------------------------------------------------------------------------- + if( abs( sum(fraction) - 1._r8) > .001_r8 ) then + fraction(:) = fraction(:)/sum(fraction) + end if + !------------------------------------------------------------------------------------- + ! ... map to Wesely land classification + !------------------------------------------------------------------------------------- + + + + + tmp_frac_lu(i, 1, j) = fraction(20) ! Urban + tmp_frac_lu(i, 2, j) = sum(fraction(16:17)) ! + tmp_frac_lu(i, 3, j) = sum(fraction(13:15)) ! + tmp_frac_lu(i, 4, j) = sum(fraction( 5: 9)) ! + tmp_frac_lu(i, 5, j) = sum(fraction( 2: 4)) ! + tmp_frac_lu(i, 6, j) = fraction(19) ! Wetland + tmp_frac_lu(i, 7, j) = fraction(18) ! Lake + tmp_frac_lu(i, 8, j) = fraction( 1) ! + tmp_frac_lu(i, 9, j) = 0._r8 + tmp_frac_lu(i,10, j) = 0._r8 + tmp_frac_lu(i,11, j) = sum(fraction(10:12)) ! + if( do_soilw ) then + if( total_soilw_area > 0._r8 ) then + tmp_soilw_3d(i,:,j) = total_soilw(:)/total_soilw_area + else + tmp_soilw_3d(i,:,j) = -99._r8 + end if + end if + end do lon_loop + end do lat_loop + !------------------------------------------------------------------------------------- + ! ... reshape according to lat-lon blocks + !------------------------------------------------------------------------------------- + call scatter_field_to_chunk(1,n_land_type,1,plon,tmp_frac_lu,fraction_landuse) + if(do_soilw) call scatter_field_to_chunk(1,12,1,plon,tmp_soilw_3d,soilw_3d) + !------------------------------------------------------------------------------------- + ! ... make sure there are no out of range values + !------------------------------------------------------------------------------------- + where (fraction_landuse < 0._r8) fraction_landuse = 0._r8 + where (fraction_landuse > 1._r8) fraction_landuse = 1._r8 + + end subroutine interp_map + + !------------------------------------------------------------------------------------- + !------------------------------------------------------------------------------------- + subroutine drydep_xactive( ncdate, sfc_temp, pressure_sfc, & + wind_speed, spec_hum, air_temp, pressure_10m, rain, & + snow, solar_flux, dvel, dflx, State_Chm, & + tv, soilw, rh, ncol, lonndx, latndx, lchnk, & + ocnfrc, icefrc, beglandtype, endlandtype ) + !------------------------------------------------------------------------------------- + ! code based on wesely (atmospheric environment, 1989, vol 23, p. 1293-1304) for + ! calculation of r_c, and on walcek et. al. (atmospheric enviroment, 1986, + ! vol. 20, p. 949-964) for calculation of r_a and r_b + ! + ! as suggested in walcek (u_i)(u*_i) = (u_a)(u*_a) + ! is kept constant where i represents a subgrid environment and a the + ! grid average environment. thus the calculation proceeds as follows: + ! va the grid averaged wind is calculated on dots + ! z0(i) the grid averaged roughness coefficient is calculated + ! ri(i) the grid averaged richardson number is calculated + ! --> the grid averaged (u_a)(u*_a) is calculated + ! --> subgrid scale u*_i is calculated assuming (u_i) given as above + ! --> final deposotion velocity is weighted average of subgrid scale velocities + ! + ! code written by P. Hess, rewritten in fortran 90 by JFL (August 2000) + ! modified by JFL to be used in MOZART-2 (October 2002) + !------------------------------------------------------------------------------------- + + use seq_drydep_mod, only: z0, rgso, rgss, h2_a, h2_b, h2_c, ri, rclo, rcls, rlu, rac + use seq_drydep_mod, only: seq_drydep_setHCoeff, foxd, drat + use physconst, only: tmelt + use seq_drydep_mod, only: drydep_method, DD_XLND + + implicit none + + !------------------------------------------------------------------------------------- + ! ... dummy arguments + !------------------------------------------------------------------------------------- + integer, intent(in) :: ncol + integer, intent(in) :: ncdate ! present date (yyyymmdd) + real(r8), intent(in) :: sfc_temp(pcols) ! surface temperature (K) + real(r8), intent(in) :: pressure_sfc(pcols) ! surface pressure (Pa) + real(r8), intent(in) :: wind_speed(pcols) ! 10 meter wind speed (m/s) + real(r8), intent(in) :: spec_hum(pcols) ! specific humidity (kg/kg) + real(r8), intent(in) :: rh(ncol,1) ! relative humidity + real(r8), intent(in) :: air_temp(pcols) ! surface air temperature (K) + real(r8), intent(in) :: pressure_10m(pcols) ! 10 meter pressure (Pa) + real(r8), intent(in) :: rain(pcols) + real(r8), intent(in) :: snow(pcols) ! snow height (m) + real(r8), intent(in) :: soilw(pcols) ! soil moisture fraction + real(r8), intent(in) :: solar_flux(pcols) ! direct shortwave radiation at surface (W/m^2) + real(r8), intent(in) :: tv(pcols) ! potential temperature + type(ChmState), intent(in):: State_Chm ! GEOS-Chem State Chem + real(r8), intent(out) :: dvel(ncol,nTracersMax) ! deposition velocity (cm/s) + real(r8), intent(inout) :: dflx(pcols,nTracersMax) ! deposition flux (/cm^2/s) + + integer, intent(in) :: latndx(pcols) ! chunk latitude indicies + integer, intent(in) :: lonndx(pcols) ! chunk longitude indicies + integer, intent(in) :: lchnk ! chunk number + + integer, intent(in), optional :: beglandtype + integer, intent(in), optional :: endlandtype + + real(r8), intent(in), optional :: ocnfrc(pcols) + real(r8), intent(in), optional :: icefrc(pcols) + + !------------------------------------------------------------------------------------- + ! ... local variables + !------------------------------------------------------------------------------------- + real(r8), parameter :: scaling_to_cm_per_s = 100._r8 + real(r8), parameter :: rain_threshold = 1.e-7_r8 ! of the order of 1cm/day expressed in m/s + + integer :: i, ispec, lt, m + integer :: sndx + integer :: month + + real(r8) :: slope = 0._r8 + real(r8) :: z0water ! revised z0 over water + real(r8) :: p ! pressure at midpoint first layer + real(r8) :: pg ! surface pressure + real(r8) :: es ! saturation vapor pressure + real(r8) :: ws ! saturation mixing ratio + real(r8) :: hvar ! constant to compute xmol + real(r8) :: h ! constant to compute xmol + real(r8) :: psih ! stability correction factor + real(r8) :: rs ! constant for calculating rsmx + real(r8) :: rmx ! resistance by vegetation + real(r8) :: zovl ! ratio of z to m-o length + real(r8) :: cvarb ! cvar averaged over landtypes + real(r8) :: bb ! b averaged over landtypes + real(r8) :: ustarb ! ustar averaged over landtypes + real(r8) :: tc(ncol) ! temperature in celsius + real(r8) :: cts(ncol) ! correction to rlu rcl and rgs for frost + + !------------------------------------------------------------------------------------- + ! local arrays: dependent on location and species + !------------------------------------------------------------------------------------- + real(r8), dimension(ncol,nddvels) :: heff + + !------------------------------------------------------------------------------------- + ! local arrays: dependent on location only + !------------------------------------------------------------------------------------- + integer :: index_season(ncol,n_land_type) + real(r8), dimension(ncol) :: tha ! atmospheric virtual potential temperature + real(r8), dimension(ncol) :: thg ! ground virtual potential temperature + real(r8), dimension(ncol) :: z ! height of lowest level + real(r8), dimension(ncol) :: va ! magnitude of v on cross points + real(r8), dimension(ncol) :: ribn ! richardson number + real(r8), dimension(ncol) :: qs ! saturation specific humidity + real(r8), dimension(ncol) :: crs ! multiplier to calculate crs + real(r8), dimension(ncol) :: rdc ! part of lower canopy resistance + real(r8), dimension(ncol) :: uustar ! u*ustar (assumed constant over grid) + real(r8), dimension(ncol) :: z0b ! average roughness length over grid + real(r8), dimension(ncol) :: wrk ! work array + real(r8), dimension(ncol) :: term ! work array + real(r8), dimension(ncol) :: resc ! work array + real(r8), dimension(ncol) :: lnd_frc ! work array + logical, dimension(ncol) :: unstable + logical, dimension(ncol) :: has_rain + logical, dimension(ncol) :: has_dew + + !------------------------------------------------------------------------------------- + ! local arrays: dependent on location and landtype + !------------------------------------------------------------------------------------- + real(r8), dimension(ncol,n_land_type) :: rds ! resistance for deposition of sulfate + real(r8), dimension(ncol,n_land_type) :: b ! buoyancy parameter for unstable conditions + real(r8), dimension(ncol,n_land_type) :: cvar ! height parameter + real(r8), dimension(ncol,n_land_type) :: ustar ! friction velocity + real(r8), dimension(ncol,n_land_type) :: xmol ! monin-obukhov length + + !------------------------------------------------------------------------------------- + ! local arrays: dependent on location, landtype and species + !------------------------------------------------------------------------------------- + real(r8), dimension(ncol,n_land_type,nTracersMax) :: rsmx ! vegetative resistance (plant mesophyll) + real(r8), dimension(ncol,n_land_type,nTracersMax) :: rclx ! lower canopy resistance + real(r8), dimension(ncol,n_land_type,nTracersMax) :: rlux ! vegetative resistance (upper canopy) + real(r8), dimension(ncol,n_land_type) :: rlux_o3 ! vegetative resistance (upper canopy) + real(r8), dimension(ncol,n_land_type,nTracersMax) :: rgsx ! ground resistance + real(r8) :: pmid(ncol,1) ! for seasalt aerosols + real(r8) :: tfld(ncol,1) ! for seasalt aerosols + real(r8) :: fact, vds + real(r8) :: rc ! combined surface resistance + real(r8) :: var_soilw, dv_soil_h2, fact_h2 ! h2 dvel wrking variables + logical :: fr_lnduse(ncol,n_land_type) ! wrking array + real(r8) :: dewm ! multiplier for rs when dew occurs + + real(r8) :: lcl_frc_landuse(ncol,n_land_type) + + integer :: beglt, endlt + + !------------------------------------------------------------------------------------- + ! jfl : mods for PAN + !------------------------------------------------------------------------------------- + real(r8) :: dv_pan + real(r8) :: c0_pan(11) = (/ 0.000_r8, 0.006_r8, 0.002_r8, 0.009_r8, 0.015_r8, & + 0.006_r8, 0.000_r8, 0.000_r8, 0.000_r8, 0.002_r8, 0.002_r8 /) + real(r8) :: k_pan (11) = (/ 0.000_r8, 0.010_r8, 0.005_r8, 0.004_r8, 0.003_r8, & + 0.005_r8, 0.000_r8, 0.000_r8, 0.000_r8, 0.075_r8, 0.002_r8 /) + + if (present( beglandtype)) then + beglt = beglandtype + else + beglt = 1 + endif + if (present( endlandtype)) then + endlt = endlandtype + else + endlt = n_land_type + endif + + !------------------------------------------------------------------------------------- + ! initialize + !------------------------------------------------------------------------------------- + do m = 1,nTracersMax + dvel(:,m) = 0._r8 + end do + + if( all( .not. has_dvel(:) ) ) then + return + end if + + !------------------------------------------------------------------------------------- + ! define species-dependent parameters (temperature dependent) + !------------------------------------------------------------------------------------- + call seq_drydep_setHCoeff( ncol, sfc_temp, heff ) + + do lt = 1,n_land_type + dep_ra (:,lt,lchnk) = 0._r8 + dep_rb (:,lt,lchnk) = 0._r8 + rds(:,lt) = 0._r8 + end do + + !------------------------------------------------------------------------------------- + ! ... set month + !------------------------------------------------------------------------------------- + month = mod( ncdate,10000 )/100 + + !------------------------------------------------------------------------------------- + ! define which season (relative to Northern hemisphere climate) + !------------------------------------------------------------------------------------- + + !------------------------------------------------------------------------------------- + ! define season index based on fixed LAI + !------------------------------------------------------------------------------------- + if ( drydep_method == DD_XLND ) then + index_season = 4 + else + do i = 1,ncol + index_season(i,:) = index_season_lai(latndx(i),month) + end do + endif + !------------------------------------------------------------------------------------- + ! special case for snow covered terrain + !------------------------------------------------------------------------------------- + do i = 1,ncol + if( snow(i) > .01_r8 ) then + index_season(i,:) = 4 + end if + end do + !------------------------------------------------------------------------------------- + ! scale rain and define logical arrays + !------------------------------------------------------------------------------------- + has_rain(:ncol) = rain(:ncol) > rain_threshold + + !------------------------------------------------------------------------------------- + ! loop over longitude points + !------------------------------------------------------------------------------------- + col_loop : do i = 1,ncol + p = pressure_10m(i) + pg = pressure_sfc(i) + !------------------------------------------------------------------------------------- + ! potential temperature + !------------------------------------------------------------------------------------- + tha(i) = air_temp(i) * (p00/p )**rovcp * (1._r8 + .61_r8*spec_hum(i)) + thg(i) = sfc_temp(i) * (p00/pg)**rovcp * (1._r8 + .61_r8*spec_hum(i)) + !------------------------------------------------------------------------------------- + ! height of 1st level + !------------------------------------------------------------------------------------- + z(i) = - r/grav * air_temp(i) * (1._r8 + .61_r8*spec_hum(i)) * log(p/pg) + !------------------------------------------------------------------------------------- + ! wind speed + !------------------------------------------------------------------------------------- + va(i) = max( .01_r8,wind_speed(i) ) + !------------------------------------------------------------------------------------- + ! Richardson number + !------------------------------------------------------------------------------------- + ribn(i) = z(i) * grav * (tha(i) - thg(i))/thg(i) / (va(i)*va(i)) + ribn(i) = min( ribn(i),ric ) + unstable(i) = ribn(i) < 0._r8 + !------------------------------------------------------------------------------------- + ! saturation vapor pressure (Pascals) + ! saturation mixing ratio + ! saturation specific humidity + !------------------------------------------------------------------------------------- + es = 611._r8*exp( 5414.77_r8*(sfc_temp(i) - tmelt)/(tmelt*sfc_temp(i)) ) + ws = .622_r8*es/(pg - es) + qs(i) = ws/(1._r8 + ws) + has_dew(i) = .false. + if( qs(i) <= spec_hum(i) ) then + has_dew(i) = .true. + end if + if( sfc_temp(i) < tmelt ) then + has_dew(i) = .false. + end if + !------------------------------------------------------------------------------------- + ! constant in determining rs + !------------------------------------------------------------------------------------- + tc(i) = sfc_temp(i) - tmelt + if( sfc_temp(i) > tmelt .and. sfc_temp(i) < 313.15_r8 ) then + crs(i) = (1._r8 + (200._r8/(solar_flux(i) + .1_r8))**2) * (400._r8/(tc(i)*(40._r8 - tc(i)))) + else + crs(i) = large_value + end if + !------------------------------------------------------------------------------------- + ! rdc (lower canopy res) + !------------------------------------------------------------------------------------- + rdc(i) = 100._r8*(1._r8 + 1000._r8/(solar_flux(i) + 10._r8))/(1._r8 + 1000._r8*slope) + end do col_loop + + !------------------------------------------------------------------------------------- + ! ... form working arrays + !------------------------------------------------------------------------------------- + do lt = 1,n_land_type + do i=1,ncol + if ( drydep_method == DD_XLND ) then + lcl_frc_landuse(i,lt) = 0._r8 + else + lcl_frc_landuse(i,lt) = fraction_landuse(i,lt,lchnk) + endif + enddo + end do + if ( present(ocnfrc) .and. present(icefrc) ) then + do i=1,ncol + ! land type 7 is used for ocean + ! land type 8 is used for sea ice + lcl_frc_landuse(i,7) = ocnfrc(i) + lcl_frc_landuse(i,8) = icefrc(i) + enddo + endif + do lt = 1,n_land_type + do i=1,ncol + fr_lnduse(i,lt) = lcl_frc_landuse(i,lt) > 0._r8 + enddo + end do + + !------------------------------------------------------------------------------------- + ! find grid averaged z0: z0bar (the roughness length) z_o=exp[S(f_i*ln(z_oi))] + ! this is calculated so as to find u_i, assuming u*u=u_i*u_i + !------------------------------------------------------------------------------------- + z0b(:) = 0._r8 + do lt = 1,n_land_type + do i = 1,ncol + if( fr_lnduse(i,lt) ) then + z0b(i) = z0b(i) + lcl_frc_landuse(i,lt) * log( z0(index_season(i,lt),lt) ) + end if + end do + end do + + !------------------------------------------------------------------------------------- + ! find the constant velocity uu*=(u_i)(u*_i) + !------------------------------------------------------------------------------------- + do i = 1,ncol + z0b(i) = exp( z0b(i) ) + cvarb = vonkar/log( z(i)/z0b(i) ) + !------------------------------------------------------------------------------------- + ! unstable and stable cases + !------------------------------------------------------------------------------------- + if( unstable(i) ) then + bb = 9.4_r8*(cvarb**2)*sqrt( abs(ribn(i))*z(i)/z0b(i) ) + ustarb = cvarb * va(i) * sqrt( 1._r8 - (9.4_r8*ribn(i)/(1._r8 + 7.4_r8*bb)) ) + else + ustarb = cvarb * va(i)/(1._r8 + 4.7_r8*ribn(i)) + end if + uustar(i) = va(i)*ustarb + end do + + !------------------------------------------------------------------------------------- + ! calculate the friction velocity for each land type u_i=uustar/u*_i + !------------------------------------------------------------------------------------- + do lt = beglt,endlt + do i = 1,ncol + if( fr_lnduse(i,lt) ) then + if( unstable(i) ) then + cvar(i,lt) = vonkar/log( z(i)/z0(index_season(i,lt),lt) ) + b(i,lt) = 9.4_r8*(cvar(i,lt)**2)* sqrt( abs(ribn(i))*z(i)/z0(index_season(i,lt),lt) ) + ustar(i,lt) = sqrt( cvar(i,lt)*uustar(i)*sqrt( 1._r8 - (9.4_r8*ribn(i)/(1._r8 + 7.4_r8*b(i,lt))) ) ) + else + cvar(i,lt) = vonkar/log( z(i)/z0(index_season(i,lt),lt) ) + ustar(i,lt) = sqrt( cvar(i,lt)*uustar(i)/(1._r8 + 4.7_r8*ribn(i)) ) + end if + end if + end do + end do + + !------------------------------------------------------------------------------------- + ! revise calculation of friction velocity and z0 over water + !------------------------------------------------------------------------------------- + lt = 7 + do i = 1,ncol + if( fr_lnduse(i,lt) ) then + if( unstable(i) ) then + z0water = (.016_r8*(ustar(i,lt)**2)/grav) + diffk/(9.1_r8*ustar(i,lt)) + cvar(i,lt) = vonkar/(log( z(i)/z0water )) + b(i,lt) = 9.4_r8*(cvar(i,lt)**2)*sqrt( abs(ribn(i))*z(i)/z0water ) + ustar(i,lt) = sqrt( cvar(i,lt)*uustar(i)* sqrt( 1._r8 - (9.4_r8*ribn(i)/(1._r8+ 7.4_r8*b(i,lt))) ) ) + else + z0water = (.016_r8*(ustar(i,lt)**2)/grav) + diffk/(9.1_r8*ustar(i,lt)) + cvar(i,lt) = vonkar/(log(z(i)/z0water)) + ustar(i,lt) = sqrt( cvar(i,lt)*uustar(i)/(1._r8 + 4.7_r8*ribn(i)) ) + end if + end if + end do + + !------------------------------------------------------------------------------------- + ! compute monin-obukhov length for unstable and stable conditions/ sublayer resistance + !------------------------------------------------------------------------------------- + do lt = beglt,endlt + do i = 1,ncol + if( fr_lnduse(i,lt) ) then + hvar = (va(i)/0.74_r8) * (tha(i) - thg(i)) * (cvar(i,lt)**2) + if( unstable(i) ) then ! unstable + h = hvar*(1._r8 - (9.4_r8*ribn(i)/(1._r8 + 5.3_r8*b(i,lt)))) + else + h = hvar/((1._r8+4.7_r8*ribn(i))**2) + end if + xmol(i,lt) = thg(i) * ustar(i,lt) * ustar(i,lt) / (vonkar * grav * h) + end if + end do + end do + + !------------------------------------------------------------------------------------- + ! psih + !------------------------------------------------------------------------------------- + do lt = beglt,endlt + do i = 1,ncol + if( fr_lnduse(i,lt) ) then + if( xmol(i,lt) < 0._r8 ) then + zovl = z(i)/xmol(i,lt) + zovl = max( -1._r8,zovl ) + psih = exp( .598_r8 + .39_r8*log( -zovl ) - .09_r8*(log( -zovl ))**2 ) + vds = 2.e-3_r8*ustar(i,lt) * (1._r8 + (300/(-xmol(i,lt)))**0.666_r8) + else + zovl = z(i)/xmol(i,lt) + zovl = min( 1._r8,zovl ) + psih = -5._r8 * zovl + vds = 2.e-3_r8*ustar(i,lt) + end if + dep_ra (i,lt,lchnk) = (vonkar - psih*cvar(i,lt))/(ustar(i,lt)*vonkar*cvar(i,lt)) + dep_rb (i,lt,lchnk) = (2._r8/(vonkar*ustar(i,lt))) * crb + rds(i,lt) = 1._r8/vds + end if + end do + end do + + !------------------------------------------------------------------------------------- + ! surface resistance : depends on both land type and species + ! land types are computed seperately, then resistance is computed as average of values + ! following wesely rc=(1/(rs+rm) + 1/rlu +1/(rdc+rcl) + 1/(rac+rgs))**-1 + ! + ! compute rsmx = 1/(rs+rm) : multiply by 3 if surface is wet + !------------------------------------------------------------------------------------- + species_loop1 : do ispec = 1,nTracersMax + if( has_dvel(ispec) ) then + m = map_dvel(ispec) + do lt = beglt,endlt + do i = 1,ncol + if( fr_lnduse(i,lt) ) then + sndx = index_season(i,lt) + if( ispec == o3_ndx .or. ispec == o3a_ndx .or. ispec == so2_ndx ) then + rmx = 0._r8 + else + rmx = 1._r8/(heff(i,m)/3000._r8 + 100._r8*foxd(m)) + end if + cts(i) = 1000._r8*exp( - tc(i) - 4._r8 ) ! correction for frost + rgsx(i,lt,ispec) = cts(i) + 1._r8/((heff(i,m)/(1.e5_r8*rgss(sndx,lt))) + (foxd(m)/rgso(sndx,lt))) + !------------------------------------------------------------------------------------- + ! special case for H2 and CO;; CH4 is set ot a fraction of dv(H2) + !------------------------------------------------------------------------------------- + if( ispec == h2_ndx .or. ispec == co_ndx .or. ispec == ch4_ndx ) then + if( ispec == co_ndx ) then + fact_h2 = 1.0_r8 + elseif ( ispec == h2_ndx ) then + fact_h2 = 0.5_r8 + elseif ( ispec == ch4_ndx ) then + fact_h2 = 50.0_r8 + end if + !------------------------------------------------------------------------------------- + ! no deposition on snow, ice, desert, and water + !------------------------------------------------------------------------------------- + if( lt == 1 .or. lt == 7 .or. lt == 8 .or. sndx == 4 ) then + rgsx(i,lt,ispec) = large_value + else + var_soilw = max( .1_r8,min( soilw(i),.3_r8 ) ) + if( lt == 3 ) then + var_soilw = log( var_soilw ) + end if + dv_soil_h2 = h2_c(lt) + var_soilw*(h2_b(lt) + var_soilw*h2_a(lt)) + if( dv_soil_h2 > 0._r8 ) then + rgsx(i,lt,ispec) = fact_h2/(dv_soil_h2*1.e-4_r8) + end if + end if + end if + if( lt == 7 ) then + rclx(i,lt,ispec) = large_value + rsmx(i,lt,ispec) = large_value + rlux(i,lt,ispec) = large_value + else + rs = ri(sndx,lt)*crs(i) + if ( has_dew(i) .or. has_rain(i) ) then + dewm = 3._r8 + else + dewm = 1._r8 + end if + rsmx(i,lt,ispec) = (dewm*rs*drat(m) + rmx) + !------------------------------------------------------------------------------------- + ! jfl : special case for PAN + !------------------------------------------------------------------------------------- + if( ispec == pan_ndx .or. ispec == xpan_ndx ) then + dv_pan = c0_pan(lt) * (1._r8 - exp( -k_pan(lt)*(dewm*rs*drat(m))*1.e-2_r8 )) + if( dv_pan > 0._r8 .and. sndx /= 4 ) then + rsmx(i,lt,ispec) = ( 1._r8/dv_pan ) + end if + end if + rclx(i,lt,ispec) = cts(i) + 1._r8/((heff(i,m)/(1.e5_r8*rcls(sndx,lt))) + (foxd(m)/rclo(sndx,lt))) + rlux(i,lt,ispec) = cts(i) + rlu(sndx,lt)/(1.e-5_r8*heff(i,m) + foxd(m)) + end if + end if + end do + end do + end if + end do species_loop1 + + do lt = beglt,endlt + if( lt /= 7 ) then + do i = 1,ncol + if( fr_lnduse(i,lt) ) then + sndx = index_season(i,lt) + !------------------------------------------------------------------------------------- + ! ... no effect if sfc_temp < O C + !------------------------------------------------------------------------------------- + if( sfc_temp(i) > tmelt ) then + if( has_dew(i) ) then + rlux_o3(i,lt) = 3000._r8*rlu(sndx,lt)/(1000._r8 + rlu(sndx,lt)) + if( o3_ndx > 0 ) then + rlux(i,lt,o3_ndx) = rlux_o3(i,lt) + endif + if( o3a_ndx > 0 ) then + rlux(i,lt,o3a_ndx) = rlux_o3(i,lt) + endif + end if + if( has_rain(i) ) then + ! rlux(i,lt,o3_ndx) = 1./(1.e-3 + (1./(3.*rlu(sndx,lt)))) + rlux_o3(i,lt) = 3000._r8*rlu(sndx,lt)/(1000._r8 + 3._r8*rlu(sndx,lt)) + if( o3_ndx > 0 ) then + rlux(i,lt,o3_ndx) = rlux_o3(i,lt) + endif + if( o3a_ndx > 0 ) then + rlux(i,lt,o3a_ndx) = rlux_o3(i,lt) + endif + end if + end if + + if ( o3_ndx > 0 ) then + rclx(i,lt,o3_ndx) = cts(i) + rclo(index_season(i,lt),lt) + rlux(i,lt,o3_ndx) = cts(i) + rlux(i,lt,o3_ndx) + end if + if ( o3a_ndx > 0 ) then + rclx(i,lt,o3a_ndx) = cts(i) + rclo(index_season(i,lt),lt) + rlux(i,lt,o3a_ndx) = cts(i) + rlux(i,lt,o3a_ndx) + end if + + end if + end do + end if + end do + + species_loop2 : do ispec = 1,nTracersMax + m = map_dvel(ispec) + if( has_dvel(ispec) ) then + if( ispec /= o3_ndx .and. ispec /= o3a_ndx .and. ispec /= so2_ndx ) then + do lt = beglt,endlt + if( lt /= 7 ) then + do i = 1,ncol + if( fr_lnduse(i,lt) ) then + !------------------------------------------------------------------------------------- + ! no effect if sfc_temp < O C + !------------------------------------------------------------------------------------- + if( sfc_temp(i) > tmelt ) then + if( has_dew(i) ) then + rlux(i,lt,ispec) = 1._r8/((1._r8/(3._r8*rlux(i,lt,ispec))) & + + 1.e-7_r8*heff(i,m) + foxd(m)/rlux_o3(i,lt)) + end if + end if + + end if + end do + end if + end do + else if( ispec == so2_ndx ) then + do lt = beglt,endlt + if( lt /= 7 ) then + do i = 1,ncol + if( fr_lnduse(i,lt) ) then + !------------------------------------------------------------------------------------- + ! no effect if sfc_temp < O C + !------------------------------------------------------------------------------------- + if( sfc_temp(i) > tmelt ) then + if( qs(i) <= spec_hum(i) ) then + rlux(i,lt,ispec) = 100._r8 + end if + if( has_rain(i) ) then + ! rlux(i,lt,ispec) = 1./(2.e-4 + (1./(3.*rlu(index_season(i,lt),lt)))) + rlux(i,lt,ispec) = 15._r8*rlu(index_season(i,lt),lt)/(5._r8 + 3.e-3_r8*rlu(index_season(i,lt),lt)) + end if + end if + rclx(i,lt,ispec) = cts(i) + rcls(index_season(i,lt),lt) + rlux(i,lt,ispec) = cts(i) + rlux(i,lt,ispec) + + end if + end do + end if + end do + do i = 1,ncol + if( fr_lnduse(i,1) .and. (has_dew(i) .or. has_rain(i)) ) then + rlux(i,1,ispec) = 50._r8 + end if + end do + end if + end if + end do species_loop2 + + !------------------------------------------------------------------------------------- + ! compute rc + !------------------------------------------------------------------------------------- + term(:ncol) = 1.e-2_r8 * pressure_10m(:ncol) / (r*tv(:ncol)) + species_loop3 : do ispec = 1,nTracersMax + if( has_dvel(ispec) ) then + wrk(:) = 0._r8 + lt_loop: do lt = beglt,endlt + do i = 1,ncol + if (fr_lnduse(i,lt)) then + resc(i) = 1._r8/( 1._r8/rsmx(i,lt,ispec) + 1._r8/rlux(i,lt,ispec) & + + 1._r8/(rdc(i) + rclx(i,lt,ispec)) & + + 1._r8/(rac(index_season(i,lt),lt) + rgsx(i,lt,ispec))) + + resc(i) = max( 10._r8,resc(i) ) + + lnd_frc(i) = lcl_frc_landuse(i,lt) + endif + enddo + !------------------------------------------------------------------------------------- + ! ... compute average deposition velocity + !------------------------------------------------------------------------------------- + select case( tracerNames(ispec) ) + case( 'SO2' ) + if( lt == 7 ) then + where( fr_lnduse(:ncol,lt) ) + ! assume no surface resistance for SO2 over water` + wrk(:) = wrk(:) + lnd_frc(:)/(dep_ra(:ncol,lt,lchnk) + dep_rb(:ncol,lt,lchnk)) + endwhere + else + where( fr_lnduse(:ncol,lt) ) + wrk(:) = wrk(:) + lnd_frc(:)/(dep_ra(:ncol,lt,lchnk) + dep_rb(:ncol,lt,lchnk) + resc(:)) + endwhere + end if + + ! JFL - increase in dry deposition of SO2 to improve bias over US/Europe + wrk(:) = wrk(:) * 2._r8 + + case( 'SO4' ) + where( fr_lnduse(:ncol,lt) ) + wrk(:) = wrk(:) + lnd_frc(:)/(dep_ra(:ncol,lt,lchnk) + rds(:,lt)) + endwhere + case( 'NH4', 'NH4NO3', 'XNH4NO3' ) + where( fr_lnduse(:ncol,lt) ) + wrk(:) = wrk(:) + lnd_frc(:)/(dep_ra(:ncol,lt,lchnk) + 0.5_r8*rds(:,lt)) + endwhere + + !------------------------------------------------------------------------------------- + ! ... special case for Pb (for consistency with offline code) + !------------------------------------------------------------------------------------- + case( 'Pb' ) + if( lt == 7 ) then + where( fr_lnduse(:ncol,lt) ) + wrk(:) = wrk(:) + lnd_frc(:) * 0.05e-2_r8 + endwhere + else + where( fr_lnduse(:ncol,lt) ) + wrk(:ncol) = wrk(:ncol) + lnd_frc(:ncol) * 0.2e-2_r8 + endwhere + end if + + !------------------------------------------------------------------------------------- + ! ... special case for carbon aerosols + !------------------------------------------------------------------------------------- + case( 'CB1', 'CB2', 'OC1', 'OC2', 'SOAM', 'SOAI', 'SOAT', 'SOAB','SOAX' ) + if ( drydep_method == DD_XLND ) then + where( fr_lnduse(:ncol,lt) ) + wrk(:ncol) = wrk(:ncol) + lnd_frc(:ncol) * 0.10e-2_r8 + endwhere + else + wrk(:ncol) = 0.10e-2_r8 + endif + + !------------------------------------------------------------------------------------- + ! deposition over ocean for HCN, CH3CN + ! velocity estimated from aircraft measurements (E.Apel, INTEX-B) + !------------------------------------------------------------------------------------- + case( 'HCN','CH3CN' ) + if( lt == 7 ) then ! over ocean only + where( fr_lnduse(:ncol,lt) .and. snow(:ncol) < 0.01_r8 ) + wrk(:ncol) = wrk(:ncol) + lnd_frc(:ncol) * 0.2e-2_r8 + endwhere + end if + case default + where( fr_lnduse(:ncol,lt) ) + wrk(:ncol) = wrk(:ncol) + lnd_frc(:ncol)/(dep_ra(:ncol,lt,lchnk) + dep_rb(:ncol,lt,lchnk) + resc(:ncol)) + endwhere + end select + end do lt_loop + dvel(:ncol,ispec) = wrk(:ncol) * scaling_to_cm_per_s + dflx(:ncol,ispec) = term(:ncol) * dvel(:ncol,ispec) * State_Chm%Species(1,:ncol,plev,ispec) + end if + + end do species_loop3 + + if ( beglt > 1 ) return + + !------------------------------------------------------------------------------------- + ! ... special adjustments + !------------------------------------------------------------------------------------- + if( mpan_ndx > 0 ) then + if( has_dvel(mpan_ndx) ) then + dvel(:ncol,mpan_ndx) = dvel(:ncol,mpan_ndx)/3._r8 + dflx(:ncol,mpan_ndx) = term(:ncol) * dvel(:ncol,mpan_ndx) * State_Chm%Species(1,:ncol,plev,mpan_ndx) + end if + end if + if( xmpan_ndx > 0 ) then + if( has_dvel(xmpan_ndx) ) then + dvel(:ncol,xmpan_ndx) = dvel(:ncol,xmpan_ndx)/3._r8 + dflx(:ncol,xmpan_ndx) = term(:ncol) * dvel(:ncol,xmpan_ndx) * State_Chm%Species(1,:ncol,plev,xmpan_ndx) + end if + end if + + ! HCOOH, use CH3COOH dep.vel + if( hcooh_ndx > 0) then + if( has_dvel(hcooh_ndx) ) then + dvel(:ncol,hcooh_ndx) = dvel(:ncol,ch3cooh_ndx) + dflx(:ncol,hcooh_ndx) = term(:ncol) * dvel(:ncol,hcooh_ndx) * State_Chm%Species(1,:ncol,plev,hcooh_ndx) + end if + end if +! +! SOG species +! + if( sogm_ndx > 0) then + if( has_dvel(sogm_ndx) ) then + dvel(:ncol,sogm_ndx) = dvel(:ncol,ch3cooh_ndx) + dflx(:ncol,sogm_ndx) = term(:ncol) * dvel(:ncol,sogm_ndx) * State_Chm%Species(1,:ncol,plev,sogm_ndx) + end if + end if + if( sogi_ndx > 0) then + if( has_dvel(sogi_ndx) ) then + dvel(:ncol,sogi_ndx) = dvel(:ncol,ch3cooh_ndx) + dflx(:ncol,sogi_ndx) = term(:ncol) * dvel(:ncol,sogi_ndx) * State_Chm%Species(1,:ncol,plev,sogi_ndx) + end if + end if + if( sogt_ndx > 0) then + if( has_dvel(sogt_ndx) ) then + dvel(:ncol,sogt_ndx) = dvel(:ncol,ch3cooh_ndx) + dflx(:ncol,sogt_ndx) = term(:ncol) * dvel(:ncol,sogt_ndx) * State_Chm%Species(1,:ncol,plev,sogt_ndx) + end if + end if + if( sogb_ndx > 0) then + if( has_dvel(sogb_ndx) ) then + dvel(:ncol,sogb_ndx) = dvel(:ncol,ch3cooh_ndx) + dflx(:ncol,sogb_ndx) = term(:ncol) * dvel(:ncol,sogb_ndx) * State_Chm%Species(1,:ncol,plev,sogb_ndx) + end if + end if + if( sogx_ndx > 0) then + if( has_dvel(sogx_ndx) ) then + dvel(:ncol,sogx_ndx) = dvel(:ncol,ch3cooh_ndx) + dflx(:ncol,sogx_ndx) = term(:ncol) * dvel(:ncol,sogx_ndx) * State_Chm%Species(1,:ncol,plev,sogx_ndx) + end if + end if +! + end subroutine drydep_xactive + + !------------------------------------------------------------------------------------- + !------------------------------------------------------------------------------------- + subroutine soilw_inti( ncfile, nlon_veg, nlat_veg, soilw_map ) + !------------------------------------------------------------------ + ! ... read primary soil moisture table + !------------------------------------------------------------------ + + use time_manager, only : get_calday + + implicit none + + !------------------------------------------------------------------ + ! ... dummy args + !------------------------------------------------------------------ + integer, intent(in) :: & + nlon_veg, & + nlat_veg + real(r8), pointer :: soilw_map(:,:,:) + character(len=*), intent(in) :: ncfile ! file name of netcdf file containing data + + !------------------------------------------------------------------ + ! ... local variables + !------------------------------------------------------------------ + integer :: gndx = 0 + integer :: nlat, & ! # of lats in soilw file + nlon ! # of lons in soilw file + integer :: i, ip, k, m + integer :: j, jl, ju + integer :: lev, day, ierr + type(file_desc_t) :: piofile + type(var_desc_t) :: vid + + integer :: dimid_lat, dimid_lon, dimid_time + integer :: dates(12) = (/ 116, 214, 316, 415, 516, 615, & + 716, 816, 915, 1016, 1115, 1216 /) + + character(len=shr_kind_cl) :: locfn + + !----------------------------------------------------------------------- + ! ... open netcdf file + !----------------------------------------------------------------------- + call getfil (ncfile, locfn, 0) + call cam_pio_openfile (piofile, trim(locfn), PIO_NOWRITE) + + !----------------------------------------------------------------------- + ! ... get longitudes + !----------------------------------------------------------------------- + ierr = pio_inq_dimid( piofile, 'lon', dimid_lon ) + ierr = pio_inq_dimlen( piofile, dimid_lon, nlon ) + if( nlon /= nlon_veg ) then + write(iulog,*) 'soilw_inti: soil and vegetation lons differ; ',nlon, nlon_veg + call endrun + end if + !----------------------------------------------------------------------- + ! ... get latitudes + !----------------------------------------------------------------------- + ierr = pio_inq_dimid( piofile, 'lat', dimid_lat ) + ierr = pio_inq_dimlen( piofile, dimid_lat, nlat ) + if( nlat /= nlat_veg ) then + write(iulog,*) 'soilw_inti: soil and vegetation lats differ; ',nlat, nlat_veg + call endrun + end if + !----------------------------------------------------------------------- + ! ... set times (days of year) + !----------------------------------------------------------------------- + ierr = pio_inq_dimid( piofile, 'time', dimid_time ) + ierr = pio_inq_dimlen( piofile, dimid_time, ndays ) + if( ndays /= 12 ) then + write(iulog,*) 'soilw_inti: dataset not a cyclical year' + call endrun + end if + allocate( days(ndays),stat=ierr ) + if( ierr /= 0 ) then + write(iulog,*) 'soilw_inti: days allocation error = ',ierr + call endrun + end if + do m = 1,min(12,ndays) + days(m) = get_calday( dates(m), 0 ) + end do + + !------------------------------------------------------------------ + ! ... allocate arrays + !------------------------------------------------------------------ + allocate( soilw_map(nlon,nlat,ndays), stat=ierr ) + if( ierr /= 0 ) then + write(iulog,*) 'soilw_inti: soilw_map allocation error = ',ierr + call endrun + end if + + !------------------------------------------------------------------ + ! ... read in the soil moisture + !------------------------------------------------------------------ + ierr = pio_inq_varid( piofile, 'SOILW', vid ) + ierr = pio_get_var( piofile, vid, soilw_map ) + !------------------------------------------------------------------ + ! ... close file + !------------------------------------------------------------------ + call cam_pio_closefile( piofile ) + + end subroutine soilw_inti + + !------------------------------------------------------------------------------------- + !------------------------------------------------------------------------------------- + subroutine chk_soilw( calday ) + !-------------------------------------------------------------------- + ! ... check timing for ub values + !-------------------------------------------------------------------- + + use mo_constants, only : dayspy + + implicit none + + !-------------------------------------------------------------------- + ! ... dummy args + !-------------------------------------------------------------------- + real(r8), intent(in) :: calday + + !-------------------------------------------------------------------- + ! ... local variables + !-------------------------------------------------------------------- + integer :: m, upper + real(r8) :: numer, denom + + !-------------------------------------------------------- + ! ... setup the time interpolation + !-------------------------------------------------------- + if( calday < days(1) ) then + next = 1 + last = ndays + else + if( days(ndays) < dayspy ) then + upper = ndays + else + upper = ndays - 1 + end if + do m = upper,1,-1 + if( calday >= days(m) ) then + exit + end if + end do + last = m + next = mod( m,ndays ) + 1 + end if + numer = calday - days(last) + denom = days(next) - days(last) + if( numer < 0._r8 ) then + numer = dayspy + numer + end if + if( denom < 0._r8 ) then + denom = dayspy + denom + end if + dels = max( min( 1._r8,numer/denom ),0._r8 ) + + end subroutine chk_soilw + + !------------------------------------------------------------------------------------- + !------------------------------------------------------------------------------------- + subroutine set_soilw( soilw, lchnk, calday ) + !-------------------------------------------------------------------- + ! ... set the soil moisture + !-------------------------------------------------------------------- + + implicit none + + !-------------------------------------------------------------------- + ! ... dummy args + !-------------------------------------------------------------------- + real(r8), intent(inout) :: soilw(pcols) + integer, intent(in) :: lchnk ! chunk indice + real(r8), intent(in) :: calday + + + integer :: i, ilon,ilat + + call chk_soilw( calday ) + + soilw(:) = soilw_3d(:,last,lchnk) + dels *( soilw_3d(:,next,lchnk) - soilw_3d(:,last,lchnk)) + + end subroutine set_soilw + + !------------------------------------------------------------------------------------- + !------------------------------------------------------------------------------------- + function has_drydep( name ) + + implicit none + + character(len=*), intent(in) :: name + + logical :: has_drydep + integer :: i + + has_drydep = .false. + + do i=1,nddvels + if ( trim(name) == trim(drydep_list(i)) ) then + has_drydep = .true. + exit + endif + enddo + + endfunction has_drydep + +end module mo_drydep diff --git a/src/chemistry/pp_geoschem/mo_gas_phase_chemdr.F90 b/src/chemistry/pp_geoschem/mo_gas_phase_chemdr.F90 new file mode 100644 index 0000000000..a881683024 --- /dev/null +++ b/src/chemistry/pp_geoschem/mo_gas_phase_chemdr.F90 @@ -0,0 +1,1180 @@ +module mo_gas_phase_chemdr + + use shr_kind_mod, only : r8 => shr_kind_r8 + use shr_const_mod, only : pi => shr_const_pi + use constituents, only : pcnst + use cam_history, only : fieldname_len + use chem_mods, only : phtcnt, rxntot, gas_pcnst + use chem_mods, only : rxt_tag_cnt, rxt_tag_lst, rxt_tag_map, extcnt, num_rnts + !use dust_model, only : dust_names, ndust => dust_nbin + use ppgrid, only : pcols, pver + use phys_control, only : phys_getopts + use carma_flags_mod, only : carma_hetchem_feedback + use chem_prod_loss_diags, only: chem_prod_loss_diags_init, chem_prod_loss_diags_out + + implicit none + save + + private + public :: gas_phase_chemdr, gas_phase_chemdr_inti + public :: map2chm + + integer :: map2chm(pcnst) = 0 ! index map to/from chemistry/constituents list + + integer :: synoz_ndx, so4_ndx, h2o_ndx, o2_ndx, o_ndx, hno3_ndx, hcl_ndx, dst_ndx, cldice_ndx, snow_ndx + integer :: o3_ndx, o3s_ndx + integer :: het1_ndx + integer :: ndx_cldfr, ndx_cmfdqr, ndx_nevapr, ndx_cldtop, ndx_prain + integer :: ndx_h2so4 +! +! CCMI +! + integer :: st80_25_ndx + integer :: st80_25_tau_ndx + integer :: aoa_nh_ndx + integer :: aoa_nh_ext_ndx + integer :: nh_5_ndx + integer :: nh_50_ndx + integer :: nh_50w_ndx + integer :: sad_pbf_ndx + integer :: cb1_ndx,cb2_ndx,oc1_ndx,oc2_ndx,dst1_ndx,dst2_ndx,sslt1_ndx,sslt2_ndx + integer :: soa_ndx,soai_ndx,soam_ndx,soat_ndx,soab_ndx,soax_ndx + + character(len=fieldname_len),dimension(rxt_tag_cnt) :: tag_names + character(len=fieldname_len),dimension(extcnt) :: extfrc_name + + logical :: pm25_srf_diag + logical :: pm25_srf_diag_soa + + logical :: convproc_do_aer + integer :: ele_temp_ndx, ion_temp_ndx + +contains + + subroutine gas_phase_chemdr_inti() + + !use mo_chem_utls, only : get_spc_ndx, get_extfrc_ndx, get_rxt_ndx + use cam_history, only : addfld,add_default,horiz_only + !use mo_chm_diags, only : chm_diags_inti + use constituents, only : cnst_get_ind + use physics_buffer, only : pbuf_get_index + use rate_diags, only : rate_diags_init + use cam_abortutils, only : endrun + + implicit none + + character(len=3) :: string + integer :: n, m, err, ii + logical :: history_cesm_forcing + character(len=16) :: unitstr + !----------------------------------------------------------------------- + logical :: history_scwaccm_forcing + + call phys_getopts( history_scwaccm_forcing_out = history_scwaccm_forcing ) + + call phys_getopts( convproc_do_aer_out = convproc_do_aer, history_cesm_forcing_out=history_cesm_forcing ) + + !ndx_h2so4 = get_spc_ndx('H2SO4') +! +! CCMI +! + !st80_25_ndx = get_spc_ndx ('ST80_25') + !st80_25_tau_ndx = get_rxt_ndx ('ST80_25_tau') + !aoa_nh_ndx = get_spc_ndx ('AOA_NH') + !aoa_nh_ext_ndx = get_extfrc_ndx('AOA_NH') + !nh_5_ndx = get_spc_ndx('NH_5') + !nh_50_ndx = get_spc_ndx('NH_50') + !nh_50w_ndx = get_spc_ndx('NH_50W') +! + !cb1_ndx = get_spc_ndx('CB1') + !cb2_ndx = get_spc_ndx('CB2') + !oc1_ndx = get_spc_ndx('OC1') + !oc2_ndx = get_spc_ndx('OC2') + !dst1_ndx = get_spc_ndx('DST01') + !dst2_ndx = get_spc_ndx('DST02') + !sslt1_ndx = get_spc_ndx('SSLT01') + !sslt2_ndx = get_spc_ndx('SSLT02') + !soa_ndx = get_spc_ndx('SOA') + !soam_ndx = get_spc_ndx('SOAM') + !soai_ndx = get_spc_ndx('SOAI') + !soat_ndx = get_spc_ndx('SOAT') + !soab_ndx = get_spc_ndx('SOAB') + !soax_ndx = get_spc_ndx('SOAX') + + !pm25_srf_diag = cb1_ndx>0 .and. cb2_ndx>0 .and. oc1_ndx>0 .and. oc2_ndx>0 & + ! .and. dst1_ndx>0 .and. dst2_ndx>0 .and. sslt1_ndx>0 .and. sslt2_ndx>0 & + ! .and. soa_ndx>0 + + !pm25_srf_diag_soa = cb1_ndx>0 .and. cb2_ndx>0 .and. oc1_ndx>0 .and. oc2_ndx>0 & + ! .and. dst1_ndx>0 .and. dst2_ndx>0 .and. sslt1_ndx>0 .and. sslt2_ndx>0 & + ! .and. soam_ndx>0 .and. soai_ndx>0 .and. soat_ndx>0 .and. soab_ndx>0 .and. soax_ndx>0 + ! + !if ( pm25_srf_diag .or. pm25_srf_diag_soa) then + ! call addfld('PM25_SRF',horiz_only,'I','kg/kg','bottom layer PM2.5 mixing ratio' ) + !endif + !call addfld('U_SRF',horiz_only,'I','m/s','bottom layer wind velocity' ) + !call addfld('V_SRF',horiz_only,'I','m/s','bottom layer wind velocity' ) + !call addfld('Q_SRF',horiz_only,'I','kg/kg','bottom layer specific humidity' ) +! + !het1_ndx= get_rxt_ndx('het1') + !o3_ndx = get_spc_ndx('O3') + !o3s_ndx = get_spc_ndx('O3S') + !o_ndx = get_spc_ndx('O') + !o2_ndx = get_spc_ndx('O2') + !so4_ndx = get_spc_ndx('SO4') + !h2o_ndx = get_spc_ndx('H2O') + !hno3_ndx = get_spc_ndx('HNO3') + !hcl_ndx = get_spc_ndx('HCL') + !dst_ndx = get_spc_ndx( dust_names(1) ) + !synoz_ndx = get_extfrc_ndx( 'SYNOZ' ) + !call cnst_get_ind( 'CLDICE', cldice_ndx ) + !call cnst_get_ind( 'SNOWQM', snow_ndx, abort=.false. ) + + + !do m = 1,extcnt + ! WRITE(UNIT=string, FMT='(I2.2)') m + ! extfrc_name(m) = 'extfrc_'// trim(string) + ! call addfld( extfrc_name(m), (/ 'lev' /), 'I', ' ', 'ext frcing' ) + !end do + + !do n = 1,rxt_tag_cnt + ! tag_names(n) = trim(rxt_tag_lst(n)) + ! if (n<=phtcnt) then + ! call addfld( tag_names(n), (/ 'lev' /), 'I', '/s', 'photolysis rate constant' ) + ! else + ! ii = n-phtcnt + ! select case(num_rnts(ii)) + ! case(1) + ! unitstr='/s' + ! case(2) + ! unitstr='cm3/molecules/s' + ! case(3) + ! unitstr='cm6/molecules2/s' + ! case default + ! call endrun('gas_phase_chemdr_inti: invalid value in num_rnts used to set units in reaction rate constant') + ! end select + ! call addfld( tag_names(n), (/ 'lev' /), 'I', unitstr, 'reaction rate constant' ) + ! endif + ! if (history_scwaccm_forcing) then + ! select case (trim(tag_names(n))) + ! case ('jh2o_a', 'jh2o_b', 'jh2o_c' ) + ! call add_default( tag_names(n), 1, ' ') + ! end select + ! endif + !enddo + + !call addfld( 'DTCBS', horiz_only, 'I', ' ','photolysis diagnostic black carbon OD' ) + !call addfld( 'DTOCS', horiz_only, 'I', ' ','photolysis diagnostic organic carbon OD' ) + !call addfld( 'DTSO4', horiz_only, 'I', ' ','photolysis diagnostic SO4 OD' ) + !call addfld( 'DTSOA', horiz_only, 'I', ' ','photolysis diagnostic SOA OD' ) + !call addfld( 'DTANT', horiz_only, 'I', ' ','photolysis diagnostic NH4SO4 OD' ) + !call addfld( 'DTSAL', horiz_only, 'I', ' ','photolysis diagnostic salt OD' ) + !call addfld( 'DTDUST', horiz_only, 'I', ' ','photolysis diagnostic dust OD' ) + !call addfld( 'DTTOTAL', horiz_only, 'I', ' ','photolysis diagnostic total aerosol OD' ) + !call addfld( 'FRACDAY', horiz_only, 'I', ' ','photolysis diagnostic fraction of day' ) + + !call addfld( 'QDSAD', (/ 'lev' /), 'I', '/s', 'water vapor sad delta' ) + !call addfld( 'SAD_STRAT', (/ 'lev' /), 'I', 'cm2/cm3', 'stratospheric aerosol SAD' ) + !call addfld( 'SAD_SULFC', (/ 'lev' /), 'I', 'cm2/cm3', 'chemical sulfate aerosol SAD' ) + !call addfld( 'SAD_SAGE', (/ 'lev' /), 'I', 'cm2/cm3', 'SAGE sulfate aerosol SAD' ) + !call addfld( 'SAD_LNAT', (/ 'lev' /), 'I', 'cm2/cm3', 'large-mode NAT aerosol SAD' ) + !call addfld( 'SAD_ICE', (/ 'lev' /), 'I', 'cm2/cm3', 'water-ice aerosol SAD' ) + !call addfld( 'RAD_SULFC', (/ 'lev' /), 'I', 'cm', 'chemical sad sulfate' ) + !call addfld( 'RAD_LNAT', (/ 'lev' /), 'I', 'cm', 'large nat radius' ) + !call addfld( 'RAD_ICE', (/ 'lev' /), 'I', 'cm', 'sad ice' ) + !call addfld( 'SAD_TROP', (/ 'lev' /), 'I', 'cm2/cm3', 'tropospheric aerosol SAD' ) + !call addfld( 'SAD_AERO', (/ 'lev' /), 'I', 'cm2/cm3', 'aerosol surface area density' ) + !if (history_cesm_forcing) then + ! call add_default ('SAD_AERO',8,' ') + !endif + !call addfld( 'REFF_AERO', (/ 'lev' /), 'I', 'cm', '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') + !call addfld( 'HNO3_TOTAL', (/ 'lev' /), 'I', 'mol/mol', 'total HNO3' ) + !call addfld( 'HNO3_STS', (/ 'lev' /), 'I', 'mol/mol', 'STS condensed HNO3' ) + !call addfld( 'HNO3_NAT', (/ 'lev' /), 'I', 'mol/mol', 'NAT condensed HNO3' ) + !call addfld( 'HNO3_GAS', (/ 'lev' /), 'I', 'mol/mol', 'gas-phase hno3' ) + !call addfld( 'H2O_GAS', (/ 'lev' /), 'I', 'mol/mol', 'gas-phase h2o' ) + !call addfld( 'HCL_TOTAL', (/ 'lev' /), 'I', 'mol/mol', 'total hcl' ) + !call addfld( 'HCL_GAS', (/ 'lev' /), 'I', 'mol/mol', 'gas-phase hcl' ) + !call addfld( 'HCL_STS', (/ 'lev' /), 'I', 'mol/mol', 'STS condensed HCL' ) + + !if (het1_ndx>0) then + ! call addfld( 'het1_total', (/ 'lev' /), 'I', '/s', 'total N2O5 + H2O het rate constant' ) + !endif + !call addfld( 'SZA', horiz_only, 'I', 'degrees', 'solar zenith angle' ) + + !call chm_diags_inti() + !call rate_diags_init() + +!----------------------------------------------------------------------- +! get pbuf indicies +!----------------------------------------------------------------------- + !ndx_cldfr = pbuf_get_index('CLD') + !ndx_cmfdqr = pbuf_get_index('RPRDTOT') + !ndx_nevapr = pbuf_get_index('NEVAPR') + !ndx_prain = pbuf_get_index('PRAIN') + !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 + + !! diagnostics for stratospheric heterogeneous reactions + !call addfld( 'GAMMA_HET1', (/ 'lev' /), 'I', '1', 'Reaction Probability' ) + !call addfld( 'GAMMA_HET2', (/ 'lev' /), 'I', '1', 'Reaction Probability' ) + !call addfld( 'GAMMA_HET3', (/ 'lev' /), 'I', '1', 'Reaction Probability' ) + !call addfld( 'GAMMA_HET4', (/ 'lev' /), 'I', '1', 'Reaction Probability' ) + !call addfld( 'GAMMA_HET5', (/ 'lev' /), 'I', '1', 'Reaction Probability' ) + !call addfld( 'GAMMA_HET6', (/ 'lev' /), 'I', '1', 'Reaction Probability' ) + !call addfld( 'WTPER', (/ 'lev' /), 'I', '%', 'H2SO4 Weight Percent' ) + + !call chem_prod_loss_diags_init + + end subroutine gas_phase_chemdr_inti + + +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- + subroutine gas_phase_chemdr(lchnk, ncol, imozart, q, & + phis, zm, zi, calday, & + tfld, pmid, pdel, pint, & + cldw, troplev, troplevchem, & + ncldwtr, ufld, vfld, & + delt, ps, xactive_prates, & + fsds, ts, asdir, ocnfrac, icefrac, & + precc, precl, snowhland, ghg_chem, latmapback, & + drydepflx, wetdepflx, cflx, fire_sflx, fire_ztop, nhx_nitrogen_flx, noy_nitrogen_flx, qtend, pbuf) + + !----------------------------------------------------------------------- + ! ... Chem_solver advances the volumetric mixing ratio + ! forward one time step via a combination of explicit, + ! ebi, hov, fully implicit, and/or rodas algorithms. + !----------------------------------------------------------------------- + + use chem_mods, only : nabscol, nfs, indexm, clscnt4 + use physconst, only : rga + !use mo_photo, only : set_ub_col, setcol, table_photo, xactive_photo + !use mo_exp_sol, only : exp_sol + !use mo_imp_sol, only : imp_sol + !use mo_setrxt, only : setrxt + !use mo_adjrxt, only : adjrxt + !use mo_phtadj, only : phtadj + !use llnl_O1D_to_2OH_adj,only : O1D_to_2OH_adj + !use mo_usrrxt, only : usrrxt + !use mo_setinv, only : setinv + !use mo_negtrc, only : negtrc + !use mo_sulf, only : sulf_interp + !use mo_setext, only : setext + !use fire_emissions, only : fire_emissions_vrt + !use mo_sethet, only : sethet + !use mo_drydep, only : drydep, set_soilw + !use seq_drydep_mod, only : DD_XLND, DD_XATM, DD_TABL, drydep_method + !use mo_fstrat, only : set_fstrat_vals, set_fstrat_h2o + !use noy_ubc, only : noy_ubc_set + !use mo_flbc, only : flbc_set + !use phys_grid, only : get_rlat_all_p, get_rlon_all_p, get_lat_all_p, get_lon_all_p + !use mo_mean_mass, only : set_mean_mass + !use cam_history, only : outfld + !use wv_saturation, only : qsat + !use constituents, only : cnst_mw + !use mo_drydep, only : has_drydep + !use time_manager, only : get_ref_date + !use mo_ghg_chem, only : ghg_chem_set_rates, ghg_chem_set_flbc + !use mo_sad, only : sad_strat_calc + !use charge_neutrality, only : charge_balance + !use mo_strato_rates, only : ratecon_sfstrat + !use mo_aero_settling, only : strat_aer_settling + !use shr_orb_mod, only : shr_orb_decl + !use cam_control_mod, only : lambm0, eccen, mvelpp, obliqr + !use mo_strato_rates, only : has_strato_chem + !use short_lived_species,only: set_short_lived_species,get_short_lived_species + !use mo_chm_diags, only : chm_diags, het_diags + !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 infnan, only : nan, assignment(=) + !use rate_diags, only : rate_diags_calc + !use mo_mass_xforms, only : mmr2vmr, vmr2mmr, h2o_to_vmr, mmr2vmri + !use orbit, only : zenith +! +! LINOZ +! + !use lin_strat_chem, only : do_lin_strat_chem, lin_strat_chem_solve + !use linoz_data, only : has_linoz_data +! +! for aqueous chemistry and aerosol growth +! + !use aero_model, only : aero_model_gasaerexch + + !use aero_model, only : aero_model_strat_surfarea + + implicit none + + !----------------------------------------------------------------------- + ! ... Dummy arguments + !----------------------------------------------------------------------- + integer, intent(in) :: lchnk ! chunk index + integer, intent(in) :: ncol ! number columns in chunk + integer, intent(in) :: imozart ! gas phase start index in q + real(r8), intent(in) :: delt ! timestep (s) + real(r8), intent(in) :: calday ! day of year + real(r8), intent(in) :: ps(pcols) ! surface pressure + real(r8), intent(in) :: phis(pcols) ! surface geopotential + real(r8),target,intent(in) :: tfld(pcols,pver) ! midpoint temperature (K) + real(r8), intent(in) :: pmid(pcols,pver) ! midpoint pressures (Pa) + real(r8), intent(in) :: pdel(pcols,pver) ! pressure delta about midpoints (Pa) + real(r8), intent(in) :: ufld(pcols,pver) ! zonal velocity (m/s) + real(r8), intent(in) :: vfld(pcols,pver) ! meridional velocity (m/s) + real(r8), intent(in) :: cldw(pcols,pver) ! cloud water (kg/kg) + real(r8), intent(in) :: ncldwtr(pcols,pver) ! droplet number concentration (#/kg) + real(r8), intent(in) :: zm(pcols,pver) ! midpoint geopotential height above the surface (m) + real(r8), intent(in) :: zi(pcols,pver+1) ! interface geopotential height above the surface (m) + real(r8), intent(in) :: pint(pcols,pver+1) ! interface pressures (Pa) + real(r8), intent(in) :: q(pcols,pver,pcnst) ! species concentrations (kg/kg) + real(r8),pointer, intent(in) :: fire_sflx(:,:) ! fire emssions surface flux (kg/m^2/s) + real(r8),pointer, intent(in) :: fire_ztop(:) ! top of vertical distribution of fire emssions (m) + logical, intent(in) :: xactive_prates + real(r8), intent(in) :: fsds(pcols) ! longwave down at sfc + real(r8), intent(in) :: icefrac(pcols) ! sea-ice areal fraction + real(r8), intent(in) :: ocnfrac(pcols) ! ocean areal fraction + real(r8), intent(in) :: asdir(pcols) ! albedo: shortwave, direct + real(r8), intent(in) :: ts(pcols) ! sfc temp (merged w/ocean if coupled) + real(r8), intent(in) :: precc(pcols) ! + real(r8), intent(in) :: precl(pcols) ! + real(r8), intent(in) :: snowhland(pcols) ! + logical, intent(in) :: ghg_chem + integer, intent(in) :: latmapback(pcols) + integer, intent(in) :: troplev(pcols) ! trop/strat separation vertical index + integer, intent(in) :: troplevchem(pcols) ! trop/strat chemistry separation vertical index + real(r8), intent(inout) :: qtend(pcols,pver,pcnst) ! species tendencies (kg/kg/s) + real(r8), intent(inout) :: cflx(pcols,pcnst) ! constituent surface flux (kg/m^2/s) + real(r8), intent(out) :: drydepflx(pcols,pcnst) ! dry deposition flux (kg/m^2/s) + real(r8), intent(in) :: wetdepflx(pcols,pcnst) ! wet deposition flux (kg/m^2/s) + real(r8), intent(out) :: nhx_nitrogen_flx(pcols) + real(r8), intent(out) :: noy_nitrogen_flx(pcols) + + type(physics_buffer_desc), pointer :: pbuf(:) + + !!----------------------------------------------------------------------- + !! ... Local variables + !!----------------------------------------------------------------------- + !real(r8), parameter :: m2km = 1.e-3_r8 + !real(r8), parameter :: Pa2mb = 1.e-2_r8 + + !real(r8), pointer :: prain(:,:) + !real(r8), pointer :: nevapr(:,:) + !real(r8), pointer :: cmfdqr(:,:) + !real(r8), pointer :: cldfr(:,:) + !real(r8), pointer :: cldtop(:) + + !integer :: i, k, m, n + !integer :: tim_ndx + !real(r8) :: delt_inverse + !real(r8) :: esfact + !integer :: latndx(pcols) ! chunk lat indicies + !integer :: lonndx(pcols) ! chunk lon indicies + !real(r8) :: invariants(ncol,pver,nfs) + !real(r8) :: col_dens(ncol,pver,max(1,nabscol)) ! column densities (molecules/cm^2) + !real(r8) :: col_delta(ncol,0:pver,max(1,nabscol)) ! layer column densities (molecules/cm^2) + !real(r8) :: extfrc(ncol,pver,max(1,extcnt)) + !real(r8) :: vmr(ncol,pver,gas_pcnst) ! xported species (vmr) + !real(r8) :: reaction_rates(ncol,pver,max(1,rxntot)) ! reaction rates + !real(r8) :: depvel(ncol,gas_pcnst) ! dry deposition velocity (cm/s) + !real(r8) :: het_rates(ncol,pver,max(1,gas_pcnst)) ! washout rate (1/s) + !real(r8), dimension(ncol,pver) :: & + ! h2ovmr, & ! water vapor volume mixing ratio + ! mbar, & ! mean wet atmospheric mass ( amu ) + ! zmid, & ! midpoint geopotential in km + ! zmidr, & ! midpoint geopotential in km realitive to surf + ! sulfate, & ! trop sulfate aerosols + ! pmb ! pressure at midpoints ( hPa ) + !real(r8), dimension(ncol,pver) :: & + ! cwat, & ! cloud water mass mixing ratio (kg/kg) + ! wrk + !real(r8), dimension(ncol,pver+1) :: & + ! zintr ! interface geopotential in km realitive to surf + !real(r8), dimension(ncol,pver+1) :: & + ! zint ! interface geopotential in km + !real(r8), dimension(ncol) :: & + ! zen_angle, & ! solar zenith angles + ! zsurf, & ! surface height (m) + ! rlats, rlons ! chunk latitudes and longitudes (radians) + !real(r8) :: sza(ncol) ! solar zenith angles (degrees) + !real(r8), parameter :: rad2deg = 180._r8/pi ! radians to degrees conversion factor + !real(r8) :: relhum(ncol,pver) ! relative humidity + !real(r8) :: satv(ncol,pver) ! wrk array for relative humidity + !real(r8) :: satq(ncol,pver) ! wrk array for relative humidity + + !integer :: j + !integer :: ltrop_sol(pcols) ! tropopause vertical index used in chem solvers + !real(r8), pointer :: strato_sad(:,:) ! stratospheric sad (1/cm) + + !real(r8) :: sad_trop(pcols,pver) ! total tropospheric sad (cm^2/cm^3) + !real(r8) :: reff(pcols,pver) ! aerosol effective radius (cm) + !real(r8) :: reff_strat(pcols,pver) ! stratospheric aerosol effective radius (cm) + + !real(r8) :: tvs(pcols) + !integer :: ncdate,yr,mon,day,sec + !real(r8) :: wind_speed(pcols) ! surface wind speed (m/s) + !logical, parameter :: dyn_soilw = .false. + !logical :: table_soilw + !real(r8) :: soilw(pcols) + !real(r8) :: prect(pcols) + !real(r8) :: sflx(pcols,gas_pcnst) + !real(r8) :: wetdepflx_diag(pcols,gas_pcnst) + !real(r8) :: dust_vmr(ncol,pver,ndust) + !real(r8) :: dt_diag(pcols,8) ! od diagnostics + !real(r8) :: fracday(pcols) ! fraction of day + !real(r8) :: o2mmr(ncol,pver) ! o2 concentration (kg/kg) + !real(r8) :: ommr(ncol,pver) ! o concentration (kg/kg) + !real(r8) :: mmr(pcols,pver,gas_pcnst) ! chem working concentrations (kg/kg) + !real(r8) :: mmr_new(pcols,pver,gas_pcnst) ! chem working concentrations (kg/kg) + !real(r8) :: hno3_gas(ncol,pver) ! hno3 gas phase concentration (mol/mol) + !real(r8) :: hno3_cond(ncol,pver,2) ! hno3 condensed phase concentration (mol/mol) + !real(r8) :: hcl_gas(ncol,pver) ! hcl gas phase concentration (mol/mol) + !real(r8) :: hcl_cond(ncol,pver) ! hcl condensed phase concentration (mol/mol) + !real(r8) :: h2o_gas(ncol,pver) ! h2o gas phase concentration (mol/mol) + !real(r8) :: h2o_cond(ncol,pver) ! h2o condensed phase concentration (mol/mol) + !real(r8) :: cldice(pcols,pver) ! cloud water "ice" (kg/kg) + !real(r8) :: radius_strat(ncol,pver,3) ! radius of sulfate, nat, & ice ( cm ) + !real(r8) :: sad_strat(ncol,pver,3) ! surf area density of sulfate, nat, & ice ( cm^2/cm^3 ) + !real(r8) :: mmr_tend(pcols,pver,gas_pcnst) ! chemistry species tendencies (kg/kg/s) + !real(r8) :: qh2o(pcols,pver) ! specific humidity (kg/kg) + !real(r8) :: delta + + ! !for aerosol formation.... + !real(r8) :: del_h2so4_gasprod(ncol,pver) + !real(r8) :: vmr0(ncol,pver,gas_pcnst) + +! +! CCMI +! + !real(r8) :: xlat + !real(r8) :: pm25(ncol) + + !real(r8) :: dlats(ncol) + + !real(r8), dimension(ncol,pver) :: & ! aerosol reaction diagnostics + ! gprob_n2o5, & + ! gprob_cnt_hcl, & + ! gprob_cnt_h2o, & + ! gprob_bnt_h2o, & + ! gprob_hocl_hcl, & + ! gprob_hobr_hcl, & + ! wtper + + !real(r8), pointer :: ele_temp_fld(:,:) ! electron temperature pointer + !real(r8), pointer :: ion_temp_fld(:,:) ! ion temperature pointer + !real(r8) :: prod_out(ncol,pver,max(1,clscnt4)) + !real(r8) :: loss_out(ncol,pver,max(1,clscnt4)) + + !if ( ele_temp_ndx>0 .and. ion_temp_ndx>0 ) then + ! call pbuf_get_field(pbuf, ele_temp_ndx, ele_temp_fld) + ! call pbuf_get_field(pbuf, ion_temp_ndx, ion_temp_fld) + !else + ! ele_temp_fld => tfld + ! ion_temp_fld => tfld + !endif + + !! initialize to NaN to hopefully catch user defined rxts that go unset + !reaction_rates(:,:,:) = nan + + !Dummy output + qtend = 0.0e+0_r8 + cflx = 0.0e+0_r8 + drydepflx = 0.0e+0_r8 + + !delt_inverse = 1._r8 / delt + !!----------------------------------------------------------------------- + !! ... Get chunck latitudes and longitudes + !!----------------------------------------------------------------------- + !call get_lat_all_p( lchnk, ncol, latndx ) + !call get_lon_all_p( lchnk, ncol, lonndx ) + !call get_rlat_all_p( lchnk, ncol, rlats ) + !call get_rlon_all_p( lchnk, ncol, rlons ) + !tim_ndx = pbuf_old_tim_idx() + !call pbuf_get_field(pbuf, ndx_prain, prain, start=(/1,1/), kount=(/ncol,pver/)) + !call pbuf_get_field(pbuf, ndx_cldfr, cldfr, start=(/1,1,tim_ndx/), kount=(/ncol,pver,1/) ) + !call pbuf_get_field(pbuf, ndx_cmfdqr, cmfdqr, start=(/1,1/), kount=(/ncol,pver/)) + !call pbuf_get_field(pbuf, ndx_nevapr, nevapr, start=(/1,1/), kount=(/ncol,pver/)) + !call pbuf_get_field(pbuf, ndx_cldtop, cldtop ) + + !reff_strat(:,:) = 0._r8 + + !dlats(:) = rlats(:)*rad2deg ! convert to degrees + + !!----------------------------------------------------------------------- + !! ... Calculate cosine of zenith angle + !! then cast back to angle (radians) + !!----------------------------------------------------------------------- + !call zenith( calday, rlats, rlons, zen_angle, ncol ) + !zen_angle(:) = acos( zen_angle(:) ) + + !sza(:) = zen_angle(:) * rad2deg + !call outfld( 'SZA', sza, ncol, lchnk ) + + !!----------------------------------------------------------------------- + !! ... Xform geopotential height from m to km + !! and pressure from Pa to mb + !!----------------------------------------------------------------------- + !zsurf(:ncol) = rga * phis(:ncol) + !do k = 1,pver + ! zintr(:ncol,k) = m2km * zi(:ncol,k) + ! zmidr(:ncol,k) = m2km * zm(:ncol,k) + ! zmid(:ncol,k) = m2km * (zm(:ncol,k) + zsurf(:ncol)) + ! zint(:ncol,k) = m2km * (zi(:ncol,k) + zsurf(:ncol)) + ! pmb(:ncol,k) = Pa2mb * pmid(:ncol,k) + !end do + !zint(:ncol,pver+1) = m2km * (zi(:ncol,pver+1) + zsurf(:ncol)) + !zintr(:ncol,pver+1)= m2km * zi(:ncol,pver+1) + + !!----------------------------------------------------------------------- + !! ... map incoming concentrations to working array + !!----------------------------------------------------------------------- + !do m = 1,pcnst + ! n = map2chm(m) + ! if( n > 0 ) then + ! mmr(:ncol,:,n) = q(:ncol,:,m) + ! end if + !end do + + !call get_short_lived_species( mmr, lchnk, ncol, pbuf ) + + !!----------------------------------------------------------------------- + !! ... Set atmosphere mean mass + !!----------------------------------------------------------------------- + !call set_mean_mass( ncol, mmr, mbar ) + + !!----------------------------------------------------------------------- + !! ... Xform from mmr to vmr + !!----------------------------------------------------------------------- + !call mmr2vmr( mmr(:ncol,:,:), vmr(:ncol,:,:), mbar(:ncol,:), ncol ) + +! +! CCMI +! +! reset STE tracer to specific vmr of 200 ppbv +! + !if ( st80_25_ndx > 0 ) then + ! where ( pmid(:ncol,:) < 80.e+2_r8 ) + ! vmr(:ncol,:,st80_25_ndx) = 200.e-9_r8 + ! end where + !end if +! +! reset AOA_NH, NH_5, NH_50, NH_50W surface mixing ratios between 30N and 50N +! + !if ( aoa_nh_ndx>0 ) then + ! do j=1,ncol + ! xlat = dlats(j) + ! if ( xlat >= 30._r8 .and. xlat <= 50._r8 ) then + ! vmr(j,pver,aoa_nh_ndx) = 0._r8 + ! end if + ! end do + !end if + !if ( nh_5_ndx>0 ) then + ! do j=1,ncol + ! xlat = dlats(j) + ! if ( xlat >= 30._r8 .and. xlat <= 50._r8 ) then + ! vmr(j,pver,nh_5_ndx) = 100.e-9_r8 + ! end if + ! end do + !end if + !if ( nh_50_ndx>0 ) then + ! do j=1,ncol + ! xlat = dlats(j) + ! if ( xlat >= 30._r8 .and. xlat <= 50._r8 ) then + ! vmr(j,pver,nh_50_ndx) = 100.e-9_r8 + ! end if + ! end do + !end if + !if ( nh_50w_ndx>0 ) then + ! do j=1,ncol + ! xlat = dlats(j) + ! if ( xlat >= 30._r8 .and. xlat <= 50._r8 ) then + ! vmr(j,pver,nh_50w_ndx) = 100.e-9_r8 + ! end if + ! end do + !end if + + !if (h2o_ndx>0) then + ! !----------------------------------------------------------------------- + ! ! ... store water vapor in wrk variable + ! !----------------------------------------------------------------------- + ! qh2o(:ncol,:) = mmr(:ncol,:,h2o_ndx) + ! h2ovmr(:ncol,:) = vmr(:ncol,:,h2o_ndx) + !else + ! qh2o(:ncol,:) = q(:ncol,:,1) + ! !----------------------------------------------------------------------- + ! ! ... Xform water vapor from mmr to vmr and set upper bndy values + ! !----------------------------------------------------------------------- + ! call h2o_to_vmr( q(:ncol,:,1), h2ovmr(:ncol,:), mbar(:ncol,:), ncol ) + + ! call set_fstrat_h2o( h2ovmr, pmid, troplev, calday, ncol, lchnk ) + + !endif + + !!----------------------------------------------------------------------- + !! ... force ion/electron balance + !!----------------------------------------------------------------------- + !call charge_balance( ncol, vmr ) + + !!----------------------------------------------------------------------- + !! ... Set the "invariants" + !!----------------------------------------------------------------------- + !call setinv( invariants, tfld, h2ovmr, vmr, pmid, ncol, lchnk, pbuf ) + + !!----------------------------------------------------------------------- + !! ... stratosphere aerosol surface area + !!----------------------------------------------------------------------- + !if (sad_pbf_ndx>0) then + ! call pbuf_get_field(pbuf, sad_pbf_ndx, strato_sad) + !else + ! allocate(strato_sad(pcols,pver)) + ! 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 ) + + !endif + + !stratochem: if ( has_strato_chem ) then + ! !----------------------------------------------------------------------- + ! ! ... initialize condensed and gas phases; all hno3 to gas + ! !----------------------------------------------------------------------- + ! hcl_cond(:,:) = 0.0_r8 + ! hcl_gas (:,:) = 0.0_r8 + ! do k = 1,pver + ! hno3_gas(:,k) = vmr(:,k,hno3_ndx) + ! h2o_gas(:,k) = h2ovmr(:,k) + ! hcl_gas(:,k) = vmr(:,k,hcl_ndx) + ! wrk(:,k) = h2ovmr(:,k) + ! if (snow_ndx>0) then + ! cldice(:ncol,k) = q(:ncol,k,cldice_ndx) + q(:ncol,k,snow_ndx) + ! else + ! cldice(:ncol,k) = q(:ncol,k,cldice_ndx) + ! endif + ! end do + ! do m = 1,2 + ! do k = 1,pver + ! hno3_cond(:,k,m) = 0._r8 + ! end do + ! end do + + ! call mmr2vmri( cldice(:ncol,:), h2o_cond(:ncol,:), mbar(:ncol,:), cnst_mw(cldice_ndx), ncol ) + + ! !----------------------------------------------------------------------- + ! ! ... call SAD routine + ! !----------------------------------------------------------------------- + ! call sad_strat_calc( lchnk, invariants(:ncol,:,indexm), pmb, tfld, hno3_gas, & + ! hno3_cond, h2o_gas, h2o_cond, hcl_gas, hcl_cond, strato_sad(:ncol,:), radius_strat, & + ! sad_strat, ncol, pbuf ) + +! ! NOTE: output of total HNO3 is before vmr is set to gas-phase. + ! call outfld( 'HNO3_TOTAL', vmr(:ncol,:,hno3_ndx), ncol ,lchnk ) + + + ! do k = 1,pver + ! vmr(:,k,hno3_ndx) = hno3_gas(:,k) + ! h2ovmr(:,k) = h2o_gas(:,k) + ! vmr(:,k,h2o_ndx) = h2o_gas(:,k) + ! wrk(:,k) = (h2ovmr(:,k) - wrk(:,k))*delt_inverse + ! end do + + ! call outfld( 'QDSAD', wrk(:,:), ncol, lchnk ) +! + ! call outfld( 'SAD_STRAT', strato_sad(:ncol,:), ncol, lchnk ) + ! call outfld( 'SAD_SULFC', sad_strat(:,:,1), ncol, lchnk ) + ! call outfld( 'SAD_LNAT', sad_strat(:,:,2), ncol, lchnk ) + ! call outfld( 'SAD_ICE', sad_strat(:,:,3), ncol, lchnk ) +! + ! call outfld( 'RAD_SULFC', radius_strat(:,:,1), ncol, lchnk ) + ! call outfld( 'RAD_LNAT', radius_strat(:,:,2), ncol, lchnk ) + ! call outfld( 'RAD_ICE', radius_strat(:,:,3), ncol, lchnk ) +! + ! call outfld( 'HNO3_GAS', vmr(:ncol,:,hno3_ndx), ncol, lchnk ) + ! call outfld( 'HNO3_STS', hno3_cond(:,:,1), ncol, lchnk ) + ! call outfld( 'HNO3_NAT', hno3_cond(:,:,2), ncol, lchnk ) +! + ! call outfld( 'HCL_TOTAL', vmr(:ncol,:,hcl_ndx), ncol, lchnk ) + ! call outfld( 'HCL_GAS', hcl_gas (:,:), ncol ,lchnk ) + ! call outfld( 'HCL_STS', hcl_cond(:,:), ncol ,lchnk ) + + ! !----------------------------------------------------------------------- + ! ! ... call aerosol reaction rates + ! !----------------------------------------------------------------------- + ! call ratecon_sfstrat( ncol, invariants(:,:,indexm), pmid, tfld, & + ! radius_strat(:,:,1), sad_strat(:,:,1), sad_strat(:,:,2), & + ! sad_strat(:,:,3), h2ovmr, vmr, reaction_rates, & + ! gprob_n2o5, gprob_cnt_hcl, gprob_cnt_h2o, gprob_bnt_h2o, & + ! gprob_hocl_hcl, gprob_hobr_hcl, wtper ) + + ! call outfld( 'GAMMA_HET1', gprob_n2o5 (:ncol,:), ncol, lchnk ) + ! call outfld( 'GAMMA_HET2', gprob_cnt_h2o (:ncol,:), ncol, lchnk ) + ! call outfld( 'GAMMA_HET3', gprob_bnt_h2o (:ncol,:), ncol, lchnk ) + ! call outfld( 'GAMMA_HET4', gprob_cnt_hcl (:ncol,:), ncol, lchnk ) + ! call outfld( 'GAMMA_HET5', gprob_hocl_hcl(:ncol,:), ncol, lchnk ) + ! call outfld( 'GAMMA_HET6', gprob_hobr_hcl(:ncol,:), ncol, lchnk ) + ! call outfld( 'WTPER', wtper (:ncol,:), ncol, lchnk ) + + !endif stratochem + +! ! NOTE: For gas-phase solver only. +! ! ratecon_sfstrat needs total hcl. + !if (hcl_ndx>0) then + ! vmr(:,:,hcl_ndx) = hcl_gas(:,:) + !endif + + !!----------------------------------------------------------------------- + !! ... Set the column densities at the upper boundary + !!----------------------------------------------------------------------- + !call set_ub_col( col_delta, vmr, invariants, pint(:,1), pdel, ncol, lchnk) + + !!----------------------------------------------------------------------- + !! ... Set rates for "tabular" and user specified reactions + !!----------------------------------------------------------------------- + !call setrxt( reaction_rates, tfld, invariants(1,1,indexm), ncol ) + ! + !sulfate(:,:) = 0._r8 + !if ( .not. carma_hetchem_feedback ) then + ! if( so4_ndx < 1 ) then ! get offline so4 field if not prognostic + ! call sulf_interp( ncol, lchnk, sulfate ) + ! else + ! sulfate(:,:) = vmr(:,:,so4_ndx) + ! endif + !endif + ! + !!----------------------------------------------------------------- + !! ... zero out sulfate above tropopause + !!----------------------------------------------------------------- + !do k = 1, pver + ! do i = 1, ncol + ! if (k < troplevchem(i)) then + ! sulfate(i,k) = 0.0_r8 + ! end if + ! end do + !end do + + !call outfld( 'SULF_TROP', sulfate(:ncol,:), ncol, lchnk ) + + !!----------------------------------------------------------------- + !! ... compute the relative humidity + !!----------------------------------------------------------------- + !call qsat(tfld(:ncol,:), pmid(:ncol,:), satv, satq) + + !do k = 1,pver + ! relhum(:,k) = .622_r8 * h2ovmr(:,k) / satq(:,k) + ! relhum(:,k) = max( 0._r8,min( 1._r8,relhum(:,k) ) ) + !end do + ! + !cwat(:ncol,:pver) = cldw(:ncol,:pver) + + !call usrrxt( 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 ) + + !call outfld( 'SAD_TROP', sad_trop(:ncol,:), ncol, lchnk ) + + !! Add trop/strat components of SAD for output + !sad_trop(:ncol,:)=sad_trop(:ncol,:)+strato_sad(:ncol,:) + !call outfld( 'SAD_AERO', sad_trop(:ncol,:), ncol, lchnk ) + + !! Add trop/strat components of effective radius for output + !reff(:ncol,:)=reff(:ncol,:)+reff_strat(:ncol,:) + !call outfld( 'REFF_AERO', reff(:ncol,:), ncol, lchnk ) + + !if (het1_ndx>0) then + ! call outfld( 'het1_total', reaction_rates(:,:,het1_ndx), ncol, lchnk ) + !endif + + !if (ghg_chem) then + ! call ghg_chem_set_rates( reaction_rates, latmapback, zen_angle, ncol, lchnk ) + !endif + + !do i = phtcnt+1,rxt_tag_cnt + ! call outfld( tag_names(i), reaction_rates(:ncol,:,rxt_tag_map(i)), ncol, lchnk ) + !enddo + + !call adjrxt( reaction_rates, invariants, invariants(1,1,indexm), ncol,pver ) + + !!----------------------------------------------------------------------- + !! ... Compute the photolysis rates at time = t(n+1) + !!----------------------------------------------------------------------- + !!----------------------------------------------------------------------- + !! ... Set the column densities + !!----------------------------------------------------------------------- + !call setcol( col_delta, col_dens, vmr, pdel, ncol ) + + !!----------------------------------------------------------------------- + !! ... Calculate the photodissociation rates + !!----------------------------------------------------------------------- + + !esfact = 1._r8 + !call shr_orb_decl( calday, eccen, mvelpp, lambm0, obliqr , & + ! delta, esfact ) + + + !if ( xactive_prates ) then + ! if ( dst_ndx > 0 ) then + ! dust_vmr(:ncol,:,1:ndust) = vmr(:ncol,:,dst_ndx:dst_ndx+ndust-1) + ! else + ! dust_vmr(:ncol,:,:) = 0._r8 + ! endif + + ! !----------------------------------------------------------------- + ! ! ... compute the photolysis rates + ! !----------------------------------------------------------------- + ! call xactive_photo( reaction_rates, vmr, tfld, cwat, cldfr, & + ! pmid, zmidr, col_dens, zen_angle, asdir, & + ! invariants(1,1,indexm), ps, ts, & + ! esfact, relhum, dust_vmr, dt_diag, fracday, ncol, lchnk ) + + ! call outfld('DTCBS', dt_diag(:ncol,1), ncol, lchnk ) + ! call outfld('DTOCS', dt_diag(:ncol,2), ncol, lchnk ) + ! call outfld('DTSO4', dt_diag(:ncol,3), ncol, lchnk ) + ! call outfld('DTANT', dt_diag(:ncol,4), ncol, lchnk ) + ! call outfld('DTSAL', dt_diag(:ncol,5), ncol, lchnk ) + ! call outfld('DTDUST', dt_diag(:ncol,6), ncol, lchnk ) + ! call outfld('DTSOA', dt_diag(:ncol,7), ncol, lchnk ) + ! call outfld('DTTOTAL', dt_diag(:ncol,8), ncol, lchnk ) + ! call outfld('FRACDAY', fracday(:ncol), ncol, lchnk ) + + !else + ! !----------------------------------------------------------------- + ! ! ... lookup the photolysis rates from table + ! !----------------------------------------------------------------- + ! call table_photo( reaction_rates, pmid, pdel, tfld, zmid, zint, & + ! col_dens, zen_angle, asdir, cwat, cldfr, & + ! esfact, vmr, invariants, ncol, lchnk, pbuf ) + !endif + + !do i = 1,phtcnt + ! call outfld( tag_names(i), reaction_rates(:ncol,:,rxt_tag_map(i)), ncol, lchnk ) + !enddo + + !!----------------------------------------------------------------------- + !! ... Adjust the photodissociation rates + !!----------------------------------------------------------------------- + !call O1D_to_2OH_adj( reaction_rates, invariants, invariants(:,:,indexm), ncol, tfld ) + !call phtadj( reaction_rates, invariants, invariants(:,:,indexm), ncol,pver ) + + !!----------------------------------------------------------------------- + !! ... Compute the extraneous frcing at time = t(n+1) + !!----------------------------------------------------------------------- + !if ( o2_ndx > 0 .and. o_ndx > 0 ) then + ! do k = 1,pver + ! o2mmr(:ncol,k) = mmr(:ncol,k,o2_ndx) + ! ommr(:ncol,k) = mmr(:ncol,k,o_ndx) + ! end do + !endif + !call setext( extfrc, zint, zintr, cldtop, & + ! zmid, lchnk, tfld, o2mmr, ommr, & + ! pmid, mbar, rlats, calday, ncol, rlons, pbuf ) + !! include forcings from fire emissions ... + !call fire_emissions_vrt( ncol, lchnk, zint, fire_sflx, fire_ztop, extfrc ) + + !do m = 1,extcnt + ! if( m /= synoz_ndx .and. m /= aoa_nh_ext_ndx ) then + ! do k = 1,pver + ! extfrc(:ncol,k,m) = extfrc(:ncol,k,m) / invariants(:ncol,k,indexm) + ! end do + ! endif + ! call outfld( extfrc_name(m), extfrc(:ncol,:,m), ncol, lchnk ) + !end do + + !!----------------------------------------------------------------------- + !! ... Form the washout rates + !!----------------------------------------------------------------------- + !if ( gas_wetdep_method=='MOZ' ) then + ! call sethet( het_rates, pmid, zmid, phis, tfld, & + ! cmfdqr, prain, nevapr, delt, invariants(:,:,indexm), & + ! vmr, ncol, lchnk ) + ! if (.not. convproc_do_aer) then + ! call het_diags( het_rates(:ncol,:,:), mmr(:ncol,:,:), pdel(:ncol,:), lchnk, ncol ) + ! endif + !else + ! het_rates = 0._r8 + !end if +! +! CCMI +! +! set loss to below the tropopause only +! + !if ( st80_25_tau_ndx > 0 ) then + ! do i = 1,ncol + ! reaction_rates(i,1:troplev(i),st80_25_tau_ndx) = 0._r8 + ! enddo + !end if + + !if ( has_linoz_data ) then + ! ltrop_sol(:ncol) = troplev(:ncol) + !else + ! ltrop_sol(:ncol) = 0 ! apply solver to all levels + !endif + + !! save h2so4 before gas phase chem (for later new particle nucleation) + !if (ndx_h2so4 > 0) then + ! del_h2so4_gasprod(1:ncol,:) = vmr(1:ncol,:,ndx_h2so4) + !else + ! del_h2so4_gasprod(:,:) = 0.0_r8 + !endif + + !vmr0(:ncol,:,:) = vmr(:ncol,:,:) ! mixing ratios before chemistry changes + + !!======================================================================= + !! ... Call the class solution algorithms + !!======================================================================= + !!----------------------------------------------------------------------- + !! ... Solve for "Explicit" species + !!----------------------------------------------------------------------- + !call exp_sol( vmr, reaction_rates, het_rates, extfrc, delt, invariants(1,1,indexm), ncol, lchnk, ltrop_sol ) + + !!----------------------------------------------------------------------- + !! ... Solve for "Implicit" species + !!----------------------------------------------------------------------- + !if ( has_strato_chem ) wrk(:,:) = vmr(:,:,h2o_ndx) + !call t_startf('imp_sol') + !! + !call imp_sol( vmr, reaction_rates, het_rates, extfrc, delt, & + ! ncol,pver, lchnk, prod_out, loss_out ) + + !call t_stopf('imp_sol') + + !call chem_prod_loss_diags_out( ncol, lchnk, vmr, reaction_rates, prod_out, loss_out, invariants(:ncol,:,indexm) ) + !if( h2o_ndx>0) call outfld( 'H2O_GAS', vmr(1,1,h2o_ndx), ncol ,lchnk ) + + !! reset O3S to O3 in the stratosphere ... + !if ( o3_ndx > 0 .and. o3s_ndx > 0 ) then + ! do i = 1,ncol + ! vmr(i,1:troplev(i),o3s_ndx) = vmr(i,1:troplev(i),o3_ndx) + ! end do + !end if + + !if (convproc_do_aer) then + ! call vmr2mmr( vmr(:ncol,:,:), mmr_new(:ncol,:,:), mbar(:ncol,:), ncol ) + ! ! mmr_new = average of mmr values before and after imp_sol + ! mmr_new(:ncol,:,:) = 0.5_r8*( mmr(:ncol,:,:) + mmr_new(:ncol,:,:) ) + ! call het_diags( het_rates(:ncol,:,:), mmr_new(:ncol,:,:), pdel(:ncol,:), lchnk, ncol ) + !endif + + !! save h2so4 change by gas phase chem (for later new particle nucleation) + !if (ndx_h2so4 > 0) then + ! del_h2so4_gasprod(1:ncol,:) = vmr(1:ncol,:,ndx_h2so4) - del_h2so4_gasprod(1:ncol,:) + !endif + +! +! Aerosol processes ... +! + + !call aero_model_gasaerexch( imozart-1, ncol, lchnk, troplevchem, delt, reaction_rates, & + ! tfld, pmid, pdel, mbar, relhum, & + ! zm, qh2o, cwat, cldfr, ncldwtr, & + ! invariants(:,:,indexm), invariants, del_h2so4_gasprod, & + ! vmr0, vmr, pbuf ) + + !if ( has_strato_chem ) then + + ! wrk(:ncol,:) = (vmr(:ncol,:,h2o_ndx) - wrk(:ncol,:))*delt_inverse + ! call outfld( 'QDCHEM', wrk(:ncol,:), ncol, lchnk ) + ! call outfld( 'HNO3_GAS', vmr(:ncol,:,hno3_ndx), ncol ,lchnk ) + + ! !----------------------------------------------------------------------- + ! ! ... aerosol settling + ! ! first settle hno3(2) using radius ice + ! ! secnd settle hno3(3) using radius large nat + ! !----------------------------------------------------------------------- + ! wrk(:,:) = vmr(:,:,h2o_ndx) +#ifdef ALT_SETTL + ! where( h2o_cond(:,:) > 0._r8 ) + ! settl_rad(:,:) = radius_strat(:,:,3) + ! elsewhere + ! settl_rad(:,:) = 0._r8 + ! endwhere + ! call strat_aer_settling( invariants(1,1,indexm), pmid, delt, zmid, tfld, & + ! hno3_cond(1,1,2), settl_rad, ncol, lchnk, 1 ) + + ! where( h2o_cond(:,:) == 0._r8 ) + ! settl_rad(:,:) = radius_strat(:,:,2) + ! elsewhere + ! settl_rad(:,:) = 0._r8 + ! endwhere + ! call strat_aer_settling( invariants(1,1,indexm), pmid, delt, zmid, tfld, & + ! hno3_cond(1,1,2), settl_rad, ncol, lchnk, 2 ) +#else + ! call strat_aer_settling( invariants(1,1,indexm), pmid, delt, zmid, tfld, & + ! hno3_cond(1,1,2), radius_strat(1,1,2), ncol, lchnk, 2 ) +#endif + + !----------------------------------------------------------------------- + ! ... reform total hno3 and hcl = gas + all condensed + !----------------------------------------------------------------------- +! NOTE: vmr for hcl and hno3 is gas-phase at this point. +! hno3_cond(:,k,1) = STS; hno3_cond(:,k,2) = NAT + + ! do k = 1,pver + ! vmr(:,k,hno3_ndx) = vmr(:,k,hno3_ndx) + hno3_cond(:,k,1) & + ! + hno3_cond(:,k,2) + ! vmr(:,k,hcl_ndx) = vmr(:,k,hcl_ndx) + hcl_cond(:,k) + ! + ! end do + + ! wrk(:,:) = (vmr(:,:,h2o_ndx) - wrk(:,:))*delt_inverse + ! call outfld( 'QDSETT', wrk(:,:), ncol, lchnk ) + + !endif + +! +! LINOZ +! + !if ( do_lin_strat_chem ) then + ! call lin_strat_chem_solve( ncol, lchnk, vmr(:,:,o3_ndx), col_dens(:,:,1), tfld, zen_angle, pmid, delt, rlats, troplev ) + !end if + + !!----------------------------------------------------------------------- + !! ... Check for negative values and reset to zero + !!----------------------------------------------------------------------- + !call negtrc( 'After chemistry ', vmr, ncol ) + + !!----------------------------------------------------------------------- + !! ... Set upper boundary mmr values + !!----------------------------------------------------------------------- + !call set_fstrat_vals( vmr, pmid, pint, troplev, calday, ncol,lchnk ) + + !!----------------------------------------------------------------------- + !! ... Set fixed lower boundary mmr values + !!----------------------------------------------------------------------- + !call flbc_set( vmr, ncol, lchnk, map2chm ) + + !!----------------------------------------------------------------------- + !! set NOy UBC + !!----------------------------------------------------------------------- + !call noy_ubc_set( lchnk, ncol, vmr ) + + !if ( ghg_chem ) then + ! call ghg_chem_set_flbc( vmr, ncol ) + !endif + + !!----------------------------------------------------------------------- + !! force ion/electron balance -- ext forcings likely do not conserve charge + !!----------------------------------------------------------------------- + !call charge_balance( ncol, vmr ) + + !!----------------------------------------------------------------------- + !! ... Xform from vmr to mmr + !!----------------------------------------------------------------------- + !call vmr2mmr( vmr(:ncol,:,:), mmr_tend(:ncol,:,:), mbar(:ncol,:), ncol ) + + !call set_short_lived_species( mmr_tend, lchnk, ncol, pbuf ) + + !!----------------------------------------------------------------------- + !! ... Form the tendencies + !!----------------------------------------------------------------------- + !do m = 1,gas_pcnst + ! mmr_new(:ncol,:,m) = mmr_tend(:ncol,:,m) + ! mmr_tend(:ncol,:,m) = (mmr_tend(:ncol,:,m) - mmr(:ncol,:,m))*delt_inverse + !enddo + + !do m = 1,pcnst + ! n = map2chm(m) + ! if( n > 0 ) then + ! qtend(:ncol,:,m) = qtend(:ncol,:,m) + mmr_tend(:ncol,:,n) + ! end if + !end do + + !tvs(:ncol) = tfld(:ncol,pver) * (1._r8 + qh2o(:ncol,pver)) + + !sflx(:,:) = 0._r8 + !call get_ref_date(yr, mon, day, sec) + !ncdate = yr*10000 + mon*100 + day + !wind_speed(:ncol) = sqrt( ufld(:ncol,pver)*ufld(:ncol,pver) + vfld(:ncol,pver)*vfld(:ncol,pver) ) + !prect(:ncol) = precc(:ncol) + precl(:ncol) + + !if ( drydep_method == DD_XLND ) then + ! soilw = -99 + ! call drydep( ocnfrac, icefrac, ncdate, ts, ps, & + ! wind_speed, qh2o(:,pver), tfld(:,pver), pmid(:,pver), prect, & + ! snowhland, fsds, depvel, sflx, mmr, & + ! tvs, soilw, relhum(:,pver:pver), ncol, lonndx, latndx, lchnk ) + !else if ( drydep_method == DD_XATM ) then + ! table_soilw = has_drydep( 'H2' ) .or. has_drydep( 'CO' ) + ! if( .not. dyn_soilw .and. table_soilw ) then + ! call set_soilw( soilw, lchnk, calday ) + ! end if + ! call drydep( ncdate, ts, ps, & + ! wind_speed, qh2o(:,pver), tfld(:,pver), pmid(:,pver), prect, & + ! snowhland, fsds, depvel, sflx, mmr, & + ! tvs, soilw, relhum(:,pver:pver), ncol, lonndx, latndx, lchnk ) + !else if ( drydep_method == DD_TABL ) then + ! call drydep( calday, ts, zen_angle, & + ! depvel, sflx, mmr, pmid(:,pver), & + ! tvs, ncol, icefrac, ocnfrac, lchnk ) + !endif + + !drydepflx(:,:) = 0._r8 + !do m = 1,pcnst + ! n = map2chm( m ) + ! if ( n > 0 ) then + ! cflx(:ncol,m) = cflx(:ncol,m) - sflx(:ncol,n) + ! drydepflx(:ncol,m) = sflx(:ncol,n) + ! wetdepflx_diag(:ncol,n) = wetdepflx(:ncol,m) + ! endif + !end do + + !call chm_diags( lchnk, ncol, vmr(:ncol,:,:), mmr_new(:ncol,:,:), & + ! reaction_rates(:ncol,:,:), invariants(:ncol,:,:), depvel(:ncol,:), sflx(:ncol,:), & + ! mmr_tend(:ncol,:,:), pdel(:ncol,:), pmid(:ncol,:), troplev(:ncol), wetdepflx_diag(:ncol,:), & + ! nhx_nitrogen_flx(:ncol), noy_nitrogen_flx(:ncol) ) + + !call rate_diags_calc( reaction_rates(:,:,:), vmr(:,:,:), invariants(:,:,indexm), ncol, lchnk ) +! +! jfl +! +! surface vmr +! + !if ( pm25_srf_diag ) then + ! pm25(:ncol) = mmr_new(:ncol,pver,cb1_ndx) & + ! + mmr_new(:ncol,pver,cb2_ndx) & + ! + mmr_new(:ncol,pver,oc1_ndx) & + ! + mmr_new(:ncol,pver,oc2_ndx) & + ! + mmr_new(:ncol,pver,dst1_ndx) & + ! + mmr_new(:ncol,pver,dst2_ndx) & + ! + mmr_new(:ncol,pver,sslt1_ndx) & + ! + mmr_new(:ncol,pver,sslt2_ndx) & + ! + mmr_new(:ncol,pver,soa_ndx) & + ! + mmr_new(:ncol,pver,so4_ndx) + ! call outfld('PM25_SRF',pm25(:ncol) , ncol, lchnk ) + !endif + !if ( pm25_srf_diag_soa ) then + ! pm25(:ncol) = mmr_new(:ncol,pver,cb1_ndx) & + ! + mmr_new(:ncol,pver,cb2_ndx) & + ! + mmr_new(:ncol,pver,oc1_ndx) & + ! + mmr_new(:ncol,pver,oc2_ndx) & + ! + mmr_new(:ncol,pver,dst1_ndx) & + ! + mmr_new(:ncol,pver,dst2_ndx) & + ! + mmr_new(:ncol,pver,sslt1_ndx) & + ! + mmr_new(:ncol,pver,sslt2_ndx) & + ! + mmr_new(:ncol,pver,soam_ndx) & + ! + mmr_new(:ncol,pver,soai_ndx) & + ! + mmr_new(:ncol,pver,soat_ndx) & + ! + mmr_new(:ncol,pver,soab_ndx) & + ! + mmr_new(:ncol,pver,soax_ndx) & + ! + mmr_new(:ncol,pver,so4_ndx) + ! call outfld('PM25_SRF',pm25(:ncol) , ncol, lchnk ) + !endif +! +! + !call outfld('Q_SRF',qh2o(:ncol,pver) , ncol, lchnk ) + !call outfld('U_SRF',ufld(:ncol,pver) , ncol, lchnk ) + !call outfld('V_SRF',vfld(:ncol,pver) , ncol, lchnk ) + +! + !if (.not.sad_pbf_ndx>0) then + ! deallocate(strato_sad) + !endif + + end subroutine gas_phase_chemdr + +end module mo_gas_phase_chemdr diff --git a/src/chemistry/pp_geoschem/mo_lightning.F90 b/src/chemistry/pp_geoschem/mo_lightning.F90 new file mode 100644 index 0000000000..206c1e7fc6 --- /dev/null +++ b/src/chemistry/pp_geoschem/mo_lightning.F90 @@ -0,0 +1,182 @@ +module mo_lightning + !---------------------------------------------------------------------- + ! ... the lightning module + !---------------------------------------------------------------------- + + use shr_kind_mod, only : r8 => shr_kind_r8 + use ppgrid, only : begchunk, endchunk, pcols, pver + use phys_grid, only : ngcols_p + use cam_abortutils, only : endrun + use cam_logfile, only : iulog + use spmd_utils, only : masterproc, mpicom + + implicit none + + private + public :: lightning_inti + public :: lightning_no_prod + public :: prod_no + + save + + real(r8) :: csrf + real(r8) :: factor = 0.1_r8 ! user-controlled scaling factor to achieve arbitrary no prod. + real(r8) :: geo_factor ! grid cell area factor + real(r8) :: vdist(16,3) ! vertical distribution of lightning + real(r8), allocatable :: prod_no(:,:,:) + real(r8), allocatable :: glob_prod_no_col(:,:) + real(r8), allocatable :: flash_freq(:,:) + integer :: no_ndx,xno_ndx + logical :: has_no_lightning_prod = .false. + +contains + + subroutine lightning_inti( lght_no_prd_factor ) + !---------------------------------------------------------------------- + ! ... initialize the lightning module + !---------------------------------------------------------------------- + use mo_constants, only : pi + use ioFileMod, only : getfil + !use mo_chem_utls, only : get_spc_ndx + + use cam_history, only : addfld, add_default, horiz_only + use dyn_grid, only : get_dyn_grid_parm + use phys_control, only : phys_getopts + + implicit none + + !---------------------------------------------------------------------- + ! ... dummy args + !---------------------------------------------------------------------- + real(r8), intent(in) :: lght_no_prd_factor ! lightning no production factor + + !!---------------------------------------------------------------------- + !! ... local variables + !!---------------------------------------------------------------------- + !integer :: astat + !integer :: ncid + !integer :: dimid + !integer :: vid + !integer :: gndx + !integer :: jl, ju + !integer :: nlat, nlon + !integer :: plon, plat + !real(r8), allocatable :: lats(:) + !real(r8), allocatable :: lons(:) + !real(r8), allocatable :: landmask(:,:) + !character(len=256) :: locfn + !logical :: history_cesm_forcing + + !call phys_getopts( history_cesm_forcing_out = history_cesm_forcing ) + + !no_ndx = get_spc_ndx('NO') + !xno_ndx = get_spc_ndx('XNO') + + !has_no_lightning_prod = no_ndx>0 .or. xno_ndx>0 + !if (.not.has_no_lightning_prod) return + + ! + !if( lght_no_prd_factor /= 1._r8 ) then + ! factor = factor*lght_no_prd_factor + !end if + + + !if (masterproc) write(iulog,*) 'lght_inti: lightning no production scaling factor = ',factor + + !!---------------------------------------------------------------------- + !! ... vdist(kk,itype) = % of lightning nox between (kk-1) and (kk) + !! km for profile itype + !!---------------------------------------------------------------------- + !vdist(:,1) = (/ 3.0_r8, 3.0_r8, 3.0_r8, 3.0_r8, 3.4_r8, 3.5_r8, 3.6_r8, 4.0_r8, & ! midlat cont + ! 5.0_r8, 7.0_r8, 9.0_r8, 14.0_r8, 16.0_r8, 14.0_r8, 8.0_r8, 0.5_r8 /) + !vdist(:,2) = (/ 2.5_r8, 2.5_r8, 2.5_r8, 2.5_r8, 2.5_r8, 2.5_r8, 2.5_r8, 6.1_r8, & ! trop marine + ! 17.0_r8, 15.4_r8, 14.5_r8, 13.0_r8, 12.5_r8, 2.8_r8, 0.9_r8, 0.3_r8 /) + !vdist(:,3) = (/ 2.0_r8, 2.0_r8, 2.0_r8, 1.5_r8, 1.5_r8, 1.5_r8, 3.0_r8, 5.8_r8, & ! trop cont + ! 7.6_r8, 9.6_r8, 11.0_r8, 14.0_r8, 14.0_r8, 14.0_r8, 8.2_r8, 2.3_r8 /) + + !allocate( prod_no(pcols,pver,begchunk:endchunk),stat=astat ) + !if( astat /= 0 ) then + ! write(iulog,*) 'lght_inti: failed to allocate prod_no; error = ',astat + ! call endrun + !end if + !allocate( flash_freq(pcols,begchunk:endchunk),stat=astat ) + !if( astat /= 0 ) then + ! write(iulog,*) 'lght_inti: failed to allocate flash_freq; error = ',astat + ! call endrun + !end if + !allocate( glob_prod_no_col(pcols,begchunk:endchunk),stat=astat ) + !if( astat /= 0 ) then + ! write(iulog,*) 'lght_inti: failed to allocate glob_prod_no_col; error = ',astat + ! call endrun + !end if + !prod_no(:,:,:) = 0._r8 + !flash_freq(:,:) = 0._r8 + !geo_factor = ngcols_p/(4._r8*pi) + + + !call addfld( 'LNO_COL_PROD', horiz_only, 'I', 'TG N/YR', 'lighting column NO source' ) + !call addfld( 'LNO_PROD', (/ 'lev' /), 'I', '/cm3/s', 'lighting insitu NO source' ) + !call addfld( 'FLASHFRQ', horiz_only, 'I', '1/MIN', 'lighting flash rate' ) ! flash frequency in grid box per minute (PPP) + !call addfld( 'FLASHENGY', horiz_only, 'I', ' ', 'lighting flash rate' ) ! flash frequency in grid box per minute (PPP) + !call addfld( 'CLDHGT', horiz_only, 'I', 'KM', 'cloud top height' ) ! cloud top height + !call addfld( 'DCHGZONE', horiz_only, 'I', 'KM', 'depth of discharge zone' ) ! depth of discharge zone + !call addfld( 'CGIC', horiz_only, 'I', 'RATIO', 'ratio of cloud-ground/intracloud discharges' ) ! ratio of cloud-ground/intracloud discharges + + !if ( history_cesm_forcing ) then + ! call add_default('LNO_COL_PROD',1,' ') + !endif + + end subroutine lightning_inti + + subroutine lightning_no_prod( state, pbuf2d, cam_in ) + !---------------------------------------------------------------------- + ! ... set no production from lightning + !---------------------------------------------------------------------- + use physics_types, only : physics_state + + use physics_buffer, only : pbuf_get_index, physics_buffer_desc, pbuf_get_field, pbuf_get_chunk + use physconst, only : rga + use phys_grid, only : get_rlat_all_p, get_lat_all_p, get_lon_all_p, get_wght_all_p + use cam_history, only : outfld + use camsrfexch, only : cam_in_t + use shr_reprosum_mod, only : shr_reprosum_calc + !use mo_constants, only : rearth, d2r + implicit none + + !---------------------------------------------------------------------- + ! ... dummy args + !---------------------------------------------------------------------- + type(physics_state), intent(in) :: state(begchunk:endchunk) ! physics state + + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + type(cam_in_t), intent(in) :: cam_in(begchunk:endchunk) ! physics state + + !---------------------------------------------------------------------- + ! ... local variables + !---------------------------------------------------------------------- + + !---------------------------------------------------------------------- + ! ... parameters to determine cg/ic ratio [price and rind, 1993] + !---------------------------------------------------------------------- + + if (.not.has_no_lightning_prod) return + + ! < === INSERT CALCULATION HERE === > + + !!-------------------------------------------------------------------------------- + !! ... output lightning no production to history file + !!-------------------------------------------------------------------------------- + !do c = begchunk,endchunk + ! lchnk = state(c)%lchnk + ! call outfld( 'LNO_PROD', prod_no(:,:,c), pcols, lchnk ) + ! call outfld( 'LNO_COL_PROD', glob_prod_no_col(:,c), pcols, lchnk ) + ! call outfld( 'FLASHFRQ', flash_freq(:,c), pcols, lchnk ) + ! call outfld( 'FLASHENGY', flash_energy(:,c), pcols, lchnk ) + ! call outfld( 'CLDHGT', cldhgt(:,c), pcols, lchnk ) + ! call outfld( 'DCHGZONE', dchgzone(:,c), pcols, lchnk ) + ! call outfld( 'CGIC', cgic(:,c), pcols, lchnk ) + !enddo + + end subroutine lightning_no_prod + +end module mo_lightning diff --git a/src/chemistry/pp_geoschem/mo_sim_dat.F90 b/src/chemistry/pp_geoschem/mo_sim_dat.F90 new file mode 100644 index 0000000000..38b193b66b --- /dev/null +++ b/src/chemistry/pp_geoschem/mo_sim_dat.F90 @@ -0,0 +1,839 @@ + + 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(:) = (/ 30, 0, 0, 191, 0 /) + + cls_rxt_cnt(:,1) = (/ 37, 61, 0, 30 /) + cls_rxt_cnt(:,4) = (/ 23, 174, 326, 191 /) + + solsym(:273) = (/ 'CH2I2 ','CH2ICL ','CH2IBR ', & + 'NITs ','NIT ','AERI ', & + 'CO2 ','INDIOL ','ISALA ', & + 'ISALC ','ISN1OA ','ISN1OG ', & + 'LBRO2H ','LBRO2N ','LISOPOH ', & + 'LISOPNO3 ','LTRO2H ','LTRO2N ', & + 'LVOCOA ','LVOC ','LXRO2H ', & + 'LXRO2N ','MSA ','PYAC ', & + 'SO4H1 ','SO4H2 ','SOAGX ', & + 'SOAIE ','SOAME ','IMAE ', & + 'SOAMG ','POx ','LOx ', & + 'PCO ','LCO ','PSO4 ', & + 'LCH4 ','PH2O2 ','I2O4 ', & + 'DHDN ','DHDC ','I2O2 ', & + 'MONITA ','BENZ ','CH3CCL3 ', & + 'H1301 ','H2402 ','I2O3 ', & + 'PMNN ','PPN ','TOLU ', & + 'BRNO2 ','CCL4 ','CFC11 ', & + 'CFC12 ','CFC113 ','CFC114 ', & + 'CFC115 ','CH3I ','H1211 ', & + 'IBR ','IEPOXD ','INO ', & + 'N2O ','TRO2 ','BRO2 ', & + 'IEPOXA ','IEPOXB ','IONITA ', & + 'N ','OCS ','XRO2 ', & + 'HI ','MAP ','ICL ', & + 'IMAO3 ','MPN ','CHBR3 ', & + 'CHCL3 ','CL2O2 ','CH2BR2 ', & + 'CH2CL2 ','HCFC141b ','HCFC142b ', & + 'IONO ','HCFC123 ','HCFC22 ', & + 'OIO ','RA3P ','RB3P ', & + 'XYLE ','DMS ','CLNO2 ', & + 'ETP ','CH3BR ','CH3CL ', & + 'HNO4 ','CLOO ','OCLO ', & + 'PAN ','RP ','HNO2 ', & + 'ALK4 ','PP ','PRPN ', & + 'SO4 ','BRCL ','PIP ', & + 'R4P ','HPALD ','C3H8 ', & + 'DHPCARP ','HOI ','HC187 ', & + 'HPC52O2 ','VRP ','ATOOH ', & + 'BR2 ','IAP ','MOBA ', & + 'HONIT ','DHMOB ','RIPB ', & + 'MP ','ISNP ','BRSALA ', & + 'BRSALC ','MAOP ','MRP ', & + 'RIPA ','RIPD ','EOH ', & + 'ETHLN ','N2O5 ','INPN ', & + 'MTPA ','MTPO ','NPMN ', & + 'C2H6 ','IONO2 ','MOBAOO ', & + 'DIBOO ','LIMO ','IPMN ', & + 'H ','MACRNO2 ','BRNO3 ', & + 'ROH ','MONITS ','CL2 ', & + 'I2 ','ISOPNB ','ISNOHOO ', & + 'CH4 ','MVKOO ','ISNOOB ', & + 'GAOO ','CH3CHOO ','MGLYOO ', & + 'IEPOXOO ','GLYX ','MVKN ', & + 'MGLOO ','PRN1 ','MONITU ', & + 'A3O2 ','PROPNN ','ISNOOA ', & + 'MAN2 ','PO2 ','ISOPNDO2 ', & + 'HCOOH ','B3O2 ','MACROO ', & + 'R4N1 ','MAOPO2 ','ISOP ', & + 'H2O2 ','ATO2 ','I ', & + 'RCO3 ','OLNN ','OLND ', & + 'LIMO2 ','MACRN ','IO ', & + 'KO2 ','HOBR ','ISOPNBO2 ', & + 'HC5OO ','PIO2 ','HNO3 ', & + 'ISOPND ','NMAO3 ','ACTA ', & + 'HOCL ','VRO2 ','ISN1 ', & + 'CH2OO ','GLYC ','CLNO3 ', & + 'MGLY ','ACET ','HC5 ', & + 'RIO2 ','INO2 ','R4O2 ', & + 'ETO2 ','R4N2 ','HAC ', & + 'MRO2 ','BRO ','PRPE ', & + 'RCHO ','MEK ','MACR ', & + 'CH2O ','ALD2 ','MVK ', & + 'MCO3 ','SO2 ','HCL ', & + 'HBR ','H2O ','CLO ', & + 'HO2 ','OH ','BR ', & + 'O ','NO2 ','MO2 ', & + 'NO3 ','NO ','O3 ', & + 'CL ','CO ','O1D ', & + 'H2 ','MOH ','N2 ', & + 'O2 ','RCOOH ','SO4s ', & + 'NH3 ','NH4 ','BCPI ', & + 'OCPI ','BCPO ','OCPO ', & + 'DST1 ','DST2 ','DST3 ', & + 'DST4 ','SALA ','SALC ', & + 'TSOG1 ','TSOG2 ','TSOG3 ', & + 'TSOG0 ','TSOA1 ','TSOA2 ', & + 'TSOA3 ','TSOA0 ','ASOG1 ', & + 'ASOG2 ','ASOG3 ','ASOAN ', & + 'ASOA1 ','ASOA2 ','ASOA3 ', & + 'SOAP ','SOAS ','PFE ' /) + + adv_mass(:221) = (/ 133.141340_r8, 104.142600_r8, 28.010400_r8, 12.011000_r8, 12.011000_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, 135.064039_r8, 135.064039_r8, 135.064039_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, 58.442468_r8, 58.442468_r8, 58.442468_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, 1.007400_r8, 1.007400_r8, & + 1.007400_r8, 1.007400_r8, 15.999400_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, 12.011000_r8, 12.011000_r8, 92.090400_r8, & + 90.075600_r8, 32.066000_r8, 146.056419_r8, 48.065400_r8, 64.064800_r8, & + 80.064200_r8, 115.107340_r8, 115.107340_r8, 115.107340_r8, 250.445000_r8, & + 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, & + 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_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, 186.241400_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, 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, 119.093400_r8, 115.063800_r8, & + 101.079200_r8, 117.078600_r8, 103.094000_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, 149.118600_r8, 187.166400_r8, 203.165800_r8, & + 18.014200_r8 /) + + crb_mass(:221) = (/ 60.055000_r8, 60.055000_r8, 12.011000_r8, 12.011000_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, 0.000000_r8, 0.000000_r8, 0.000000_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, 0.000000_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, 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, 12.011000_r8, 12.011000_r8, 36.033000_r8, & + 36.033000_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, 180.165000_r8, & + 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, & + 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_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, 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, 48.044000_r8, 48.044000_r8, & + 48.044000_r8, 48.044000_r8, 48.044000_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, 60.055000_r8, 96.088000_r8, 96.088000_r8, & + 0.000000_r8 /) + + fix_mass(: 3) = (/ 0.00000000_r8, 28.0134800_r8, 31.9988000_r8 /) + + clsmap(: 30,1) = (/ 3, 21, 33, 34, 35, 36, 37, 38, 39, 40, & + 41, 43, 44, 46, 54, 55, 61, 63, 71, 78, & + 82, 83, 84, 113, 122, 123, 148, 170, 185, 186 /) + clsmap(:191,4) = (/ 1, 2, 4, 5, 6, 7, 8, 9, 10, 11, & + 12, 13, 14, 15, 16, 17, 18, 19, 20, 22, & + 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, & + 42, 45, 47, 48, 49, 50, 51, 52, 53, 56, & + 57, 58, 59, 60, 62, 64, 65, 66, 67, 68, & + 69, 70, 72, 73, 74, 75, 76, 77, 79, 80, & + 81, 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, 114, & + 115, 116, 117, 118, 119, 120, 121, 124, 125, 126, & + 127, 128, 129, 130, 131, 132, 133, 134, 135, 136, & + 137, 138, 139, 140, 141, 142, 143, 144, 145, 146, & + 147, 149, 150, 151, 152, 153, 154, 155, 156, 157, & + 158, 159, 160, 161, 162, 163, 164, 165, 166, 167, & + 168, 169, 171, 172, 173, 174, 175, 176, 177, 178, & + 179, 180, 181, 182, 183, 184, 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 /) + + permute(:191,4) = (/ 121, 120, 1, 2, 144, 46, 85, 47, 86, 96, & + 68, 117, 75, 60, 81, 174, 61, 187, 110, 62, & + 78, 70, 111, 64, 79, 71, 149, 90, 39, 65, & + 189, 161, 38, 147, 166, 108, 102, 134, 91, 184, & + 45, 36, 183, 148, 155, 40, 50, 52, 69, 3, & + 4, 5, 41, 132, 151, 142, 176, 162, 114, 42, & + 138, 177, 49, 133, 57, 175, 83, 131, 136, 154, & + 58, 156, 72, 43, 139, 113, 107, 164, 89, 123, & + 34, 165, 73, 104, 74, 106, 145, 169, 82, 67, & + 84, 152, 6, 7, 8, 37, 9, 190, 185, 179, & + 141, 87, 10, 11, 12, 13, 188, 186, 76, 80, & + 59, 97, 44, 98, 48, 77, 14, 15, 109, 88, & + 103, 167, 140, 63, 16, 17, 18, 19, 20, 21, & + 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, & + 32, 33, 35, 53, 115, 118, 99, 150, 153, 116, & + 51, 54, 55, 124, 56, 92, 105, 146, 100, 93, & + 137, 135, 119, 173, 182, 129, 112, 66, 125, 178, & + 94, 168, 171, 170, 126, 172, 143, 122, 159, 180, & + 181, 95, 130, 160, 158, 157, 127, 163, 128, 101, & + 191 /) + + diag_map(:191) = (/ 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, 39, 45, 46, 49, 52, 55, 59, & + 62, 65, 68, 71, 74, 81, 87, 91, 96, 100, & + 109, 116, 121, 125, 134, 142, 147, 150, 155, 158, & + 161, 164, 168, 172, 176, 180, 184, 190, 193, 199, & + 205, 211, 214, 219, 224, 229, 234, 240, 245, 250, & + 258, 266, 272, 278, 284, 290, 296, 302, 308, 314, & + 320, 326, 334, 340, 347, 353, 356, 363, 367, 376, & + 384, 391, 397, 403, 409, 415, 423, 431, 435, 443, & + 451, 459, 467, 476, 483, 494, 503, 507, 515, 522, & + 533, 544, 552, 563, 576, 583, 594, 610, 621, 630, & + 640, 649, 657, 661, 666, 677, 687, 695, 709, 726, & + 732, 739, 744, 761, 787, 809, 819, 827, 841, 856, & + 865, 874, 886, 898, 911, 915, 928, 950, 969, 985, & + 996,1007,1024,1044,1060,1072,1083,1108,1130,1153, & + 1186,1205,1236,1250,1263,1276,1296,1390,1448,1473, & + 1621,1672,1699,1734,1776,1837,1862,1893,1917,1996, & + 2022 /) + + extfrc_lst(: 17) = (/ 'so4_a2 ','NO ','NO2 ','SO2 ','SVOC ', & + 'pom_a1 ','pom_a4 ','so4_a1 ','CO ','bc_a1 ', & + 'bc_a4 ','num_a1 ','num_a2 ','num_a4 ','OH ', & + 'N ','AOA_NH ' /) + + frc_from_dataset(: 17) = (/ .true., .true., .true., .true., .true., & + .true., .true., .true., .true., .true., & + .true., .true., .true., .true., .false., & + .false., .false. /) + + inv_lst(: 3) = (/ 'M ', 'N2 ', 'O2 ' /) + + slvd_lst(: 34) = (/ 'ACBZO2 ', 'ALKO2 ', 'BENZO2 ', 'BZOO ', 'C2H5O2 ', & + 'C3H7O2 ', 'C6H5O2 ', 'CH3CO3 ', 'CH3O2 ', 'DICARBO2 ', & + 'ENEO2 ', 'EO ', 'EO2 ', 'HO2 ', 'HOCH2OO ', & + 'ISOPAO2 ', 'ISOPBO2 ', 'MACRO2 ', 'MALO2 ', 'MCO3 ', & + 'MDIALO2 ', 'MEKO2 ', 'NTERPO2 ', 'O1D ', 'OH ', & + 'PHENO2 ', 'PO2 ', 'RO2 ', 'TERP2O2 ', 'TERPO2 ', & + 'TOLO2 ', 'XO2 ', 'XYLENO2 ', '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 ', 'jsoa1_a1 ', & + 'jsoa1_a2 ', 'jsoa2_a1 ', & + 'jsoa2_a2 ', 'jsoa3_a1 ', & + 'jsoa3_a2 ', 'jsoa4_a1 ', & + 'jsoa4_a2 ', 'jsoa5_a1 ', & + 'jsoa5_a2 ', '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 ' /) + rxt_tag_lst( 201: 400) = (/ '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 ', '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 ' /) + rxt_tag_lst( 401: 528) = (/ 'BENZOOH_OH ', 'BZALD_OH ', & + 'BZOO_HO2 ', 'BZOOH_OH ', & + 'BZOO_NO ', 'C6H5O2_HO2 ', & + 'C6H5O2_NO ', 'C6H5OOH_OH ', & + 'CRESOL_OH ', 'DICARBO2_HO2 ', & + '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 ', '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_SO2_OH ', & + 'usr_SO3_H2O ', 'DMS_NO3 ', & + 'DMS_OHa ', 'NH3_OH ', & + 'usr_DMS_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 ', & + 'BCARY_O3_vbs ', 'BCARY_OH_vbs ', & + 'BENZENE_OH_vbs ', 'ISOP_NO3_vbs ', & + 'ISOP_O3_vbs ', 'ISOP_OH_vbs ', & + 'IVOC_OH ', 'MTERP_NO3_vbs ', & + 'MTERP_O3_vbs ', 'MTERP_OH_vbs ', & + 'SVOC_OH ', 'TOLUENE_OH_vbs ', & + 'XYLENES_OH_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 /) + 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 ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', 'jno2 ', 'jno2 ', 'jno2 ', & + 'jno2 ', 'jno2 ', 'jno2 ', 'jno2 ', & + 'jno2 ', 'jno2 ', 'jno2 ' /) + 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, 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, .0004_r8, .0004_r8, & + .0004_r8, .0004_r8, .0004_r8, .0004_r8, .0004_r8, & + .0004_r8, .0004_r8, .0004_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(:) = (/ 126, 129, 130, 131, 134, & + 137, 138, 139, 140, 143, & + 144, 145, 148, 150, 154, & + 155, 163, 164 /) + 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, 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_geoschem/rate_diags.F90 b/src/chemistry/pp_geoschem/rate_diags.F90 new file mode 100644 index 0000000000..40b5fa6dde --- /dev/null +++ b/src/chemistry/pp_geoschem/rate_diags.F90 @@ -0,0 +1,177 @@ +!-------------------------------------------------------------------------------- +! Manages writing reaction rates to history +!-------------------------------------------------------------------------------- +module rate_diags + + use shr_kind_mod, only : r8 => shr_kind_r8 + use shr_kind_mod, only : CL => SHR_KIND_CL + use cam_history, only : fieldname_len + use cam_history, only : addfld, add_default + use cam_history, only : outfld + use chem_mods, only : rxt_tag_cnt, rxt_tag_lst, rxt_tag_map + use ppgrid, only : pver + use spmd_utils, only : masterproc + use cam_abortutils, only : endrun +! use sums_utils, only : sums_grp_t, parse_sums + + implicit none + private + public :: rate_diags_init + public :: rate_diags_calc + public :: rate_diags_readnl + + character(len=fieldname_len) :: rate_names(rxt_tag_cnt) + +! integer :: ngrps = 0 +! type(sums_grp_t), allocatable :: grps(:) + + integer, parameter :: maxlines = 200 + character(len=CL), allocatable :: rxn_rate_sums(:) + +contains + +!------------------------------------------------------------------- +!------------------------------------------------------------------- + subroutine rate_diags_readnl(nlfile) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use spmd_utils, only: mpicom, mpi_character, masterprocid + + ! args + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + + namelist /rxn_rate_diags_nl/ rxn_rate_sums + + allocate( rxn_rate_sums( maxlines ) ) + rxn_rate_sums(:) = ' ' + + !! Read namelist + !if (masterproc) then + ! unitn = getunit() + ! open( unitn, file=trim(nlfile), status='old' ) + ! call find_group_name(unitn, 'rxn_rate_diags_nl', status=ierr) + ! if (ierr == 0) then + ! read(unitn, rxn_rate_diags_nl, iostat=ierr) + ! if (ierr /= 0) then + ! call endrun('rate_diags_readnl:: ERROR reading namelist') + ! end if + ! end if + ! close(unitn) + ! call freeunit(unitn) + !end if + + ! Broadcast namelist variables + call mpi_bcast(rxn_rate_sums,len(rxn_rate_sums(1))*maxlines, mpi_character, masterprocid, mpicom, ierr) + + end subroutine rate_diags_readnl +!-------------------------------------------------------------------------------- +!-------------------------------------------------------------------------------- + subroutine rate_diags_init + use phys_control, only : phys_getopts + + integer :: i, len, pos + character(len=64) :: name + logical :: history_scwaccm_forcing + + call phys_getopts( history_scwaccm_forcing_out = history_scwaccm_forcing ) + + !do i = 1,rxt_tag_cnt + ! pos = 0 + ! pos = index(rxt_tag_lst(i),'tag_') + ! if (pos <= 0) pos = index(rxt_tag_lst(i),'usr_') + ! if (pos <= 0) pos = index(rxt_tag_lst(i),'cph_') + ! if (pos <= 0) pos = index(rxt_tag_lst(i),'ion_') + ! if (pos>0) then + ! name = 'r_'//trim(rxt_tag_lst(i)(5:)) + ! else + ! name = 'r_'//trim(rxt_tag_lst(i)(1:)) + ! endif + ! len = min(fieldname_len,len_trim(name)) + ! rate_names(i) = trim(name(1:len)) + ! call addfld(rate_names(i), (/ 'lev' /),'A', 'molecules/cm3/sec','reaction rate') + ! if (history_scwaccm_forcing .and. rate_names(i) == 'r_O1D_H2O') then + ! call add_default( rate_names(i), 1, ' ') + ! endif + !enddo + + !! parse the terms of the summations + !call parse_sums(rxn_rate_sums, ngrps, grps) + !deallocate( rxn_rate_sums ) + + !do i = 1, ngrps + ! call addfld( grps(i)%name, (/ 'lev' /),'A', 'molecules/cm3/sec','reaction rate group') + !enddo + + end subroutine rate_diags_init + +!-------------------------------------------------------------------------------- +!-------------------------------------------------------------------------------- + subroutine rate_diags_calc( rxt_rates, vmr, m, ncol, lchnk ) + + !use mo_rxt_rates_conv, only: set_rates + + real(r8), intent(inout) :: rxt_rates(:,:,:) ! 'molec/cm3/sec' + real(r8), intent(in) :: vmr(:,:,:) + real(r8), intent(in) :: m(:,:) ! air density (molecules/cm3) + integer, intent(in) :: ncol, lchnk + + !integer :: i, j, ndx + !real(r8) :: group_rate(ncol,pver) + + rxt_rates(:,:,:) = 0.0e+0_r8 + + !call set_rates( rxt_rates, vmr, ncol ) + + !! output individual tagged rates + !do i = 1, rxt_tag_cnt + ! ! convert from vmr/sec to molecules/cm3/sec + ! rxt_rates(:ncol,:,rxt_tag_map(i)) = rxt_rates(:ncol,:,rxt_tag_map(i)) * m(:ncol,:) + ! call outfld( rate_names(i), rxt_rates(:ncol,:,rxt_tag_map(i)), ncol, lchnk ) + !enddo + + !! output rate groups ( or families ) + !do i = 1, ngrps + ! group_rate(:,:) = 0._r8 + ! do j = 1, grps(i)%nmembers + ! ndx = lookup_tag_ndx(grps(i)%term(j)) + ! group_rate(:ncol,:) = group_rate(:ncol,:) + grps(i)%multipler(j)*rxt_rates(:ncol,:,ndx) + ! enddo + ! call outfld( grps(i)%name, group_rate(:ncol,:), ncol, lchnk ) + !end do + + end subroutine rate_diags_calc + +!------------------------------------------------------------------- +! Private routines : +!------------------------------------------------------------------- +!------------------------------------------------------------------- + +!------------------------------------------------------------------- +! finds the index corresponging to a given reacton name +!------------------------------------------------------------------- + function lookup_tag_ndx( name ) result( ndx ) + character(len=*) :: name + integer :: ndx + + integer :: i + + ndx = -1 + + !findloop: do i = 1,rxt_tag_cnt + ! if (trim(name) .eq. trim(rate_names(i)(3:))) then + ! ndx = i + ! return + ! endif + !end do findloop + + !if (ndx<0) then + ! call endrun('rate_diags: not able to find rxn tag name: '//trim(name)) + !endif + + end function lookup_tag_ndx + +end module rate_diags diff --git a/src/chemistry/pp_geoschem/short_lived_species.F90 b/src/chemistry/pp_geoschem/short_lived_species.F90 new file mode 100644 index 0000000000..b4dc6d55ff --- /dev/null +++ b/src/chemistry/pp_geoschem/short_lived_species.F90 @@ -0,0 +1,229 @@ +!--------------------------------------------------------------------- +! Manages the storage of non-transported short-lived chemical species +! in the physics buffer. +! +! Created by: Francis Vitt -- 20 Aug 2008 +!--------------------------------------------------------------------- +module short_lived_species + + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : slvd_lst, nslvd, gas_pcnst, slvd_ref_mmr + use cam_logfile, only : iulog + use ppgrid, only : pcols, pver, begchunk, endchunk + use spmd_utils, only : masterproc + + + implicit none + + save + private + !public :: map + public :: register_short_lived_species + public :: short_lived_species_initic + public :: short_lived_species_writeic + public :: initialize_short_lived_species + public :: set_short_lived_species + public :: get_short_lived_species + public :: slvd_index + public :: pbf_idx + + integer :: pbf_idx + !integer :: map(nslvd) + + character(len=16), parameter :: pbufname = 'ShortLivedSpecies' + +contains + +!--------------------------------------------------------------------- +!--------------------------------------------------------------------- + subroutine register_short_lived_species + use physics_buffer, only : pbuf_add_field, dtype_r8 + + implicit none + + integer :: m + + if ( nslvd < 1 ) return + + call pbuf_add_field(pbufname,'global',dtype_r8,(/pcols,pver,nslvd/),pbf_idx) + + end subroutine register_short_lived_species + +!--------------------------------------------------------------------- +!--------------------------------------------------------------------- + subroutine short_lived_species_initic +#ifdef WACCMX_IONOS + use cam_history, only : addfld, add_default + + integer :: m + character(len=24) :: varname + + do m=1,nslvd + varname = trim(slvd_lst(m))//'&IC' + call addfld (varname, (/ 'lev' /),'I','kg/kg',trim(varname)//' not-transported species',gridname='physgrid') + call add_default (varname,0, 'I') + enddo +#endif + end subroutine short_lived_species_initic + +!--------------------------------------------------------------------- +!--------------------------------------------------------------------- + subroutine short_lived_species_writeic( lchnk, pbuf ) + use cam_history, only : outfld, write_inithist + use physics_buffer, only : physics_buffer_desc, pbuf_get_field + + integer , intent(in) :: lchnk ! chunk identifier + type(physics_buffer_desc), pointer :: pbuf(:) +#ifdef WACCMX_IONOS + real(r8),pointer :: tmpptr(:,:) + integer :: m + character(len=24) :: varname + + if ( write_inithist() ) then + do m=1,nslvd + varname = trim(slvd_lst(m))//'&IC' + call pbuf_get_field(pbuf, pbf_idx, tmpptr, start=(/1,1,m/), kount=(/ pcols,pver,1 /)) + call outfld(varname, tmpptr, pcols,lchnk) + enddo + endif +#endif + end subroutine short_lived_species_writeic + +!--------------------------------------------------------------------- +!--------------------------------------------------------------------- + subroutine initialize_short_lived_species(ncid_ini, pbuf2d) + use cam_grid_support, only : cam_grid_check, cam_grid_id + use cam_grid_support, only : cam_grid_get_dim_names + use cam_abortutils, only : endrun + !use mo_tracname, only : solsym !TMMF + use ncdio_atm, only : infld + use pio, only : file_desc_t + use physics_buffer, only : physics_buffer_desc, pbuf_set_field, pbuf_get_chunk, pbuf_get_field + + implicit none + + type(file_desc_t), intent(inout) :: ncid_ini + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + integer :: m,n,lchnk + integer :: grid_id + character(len=255) :: fieldname + character(len=4) :: dim1name, dim2name + logical :: found + real(r8),pointer :: tmpptr(:,:,:) ! temporary pointer + real(r8),pointer :: tmpptr2(:,:,:) ! temporary pointer + character(len=*), parameter :: subname='INITIALIZE_SHORT_LIVED_SPECIES' + + if ( nslvd < 1 ) return + + found = .false. + + grid_id = cam_grid_id('physgrid') + if (.not. cam_grid_check(grid_id)) then + call endrun(trim(subname)//': Internal error, no "physgrid" grid') + end if + call cam_grid_get_dim_names(grid_id, dim1name, dim2name) + + call pbuf_set_field(pbuf2d, pbf_idx, 0._r8) + + allocate(tmpptr(pcols,pver,begchunk:endchunk)) + + do m=1,nslvd + !n = map(m) + !fieldname = solsym(n) + write(fieldname,'(a,a)') trim(slvd_lst(m)) + call infld( fieldname,ncid_ini,dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, & + tmpptr, found, gridname='physgrid') + + if (.not.found) then + !tmpptr(:,:,:) = 1.e-36_r8 + tmpptr(:,:,:) = slvd_ref_mmr(m) + endif + + call pbuf_set_field(pbuf2d, pbf_idx, tmpptr, start=(/1,1,m/),kount=(/pcols,pver,1/)) + + if (MasterProc) write(iulog,'(a20,a)') TRIM(fieldname), ' is set to short-lived' + ! DEBUG: remove as this will be confusing to most due to the negative + ! dummy MW which was used to calculate the reference MMR + if (MasterProc) write(iulog,'(a, E16.5E4)') ' --> reference MMR: ', slvd_ref_mmr(m) + + enddo + + deallocate(tmpptr) + + end subroutine initialize_short_lived_species + +!--------------------------------------------------------------------- +!--------------------------------------------------------------------- + subroutine set_short_lived_species( q, lchnk, ncol, pbuf ) + + use physics_buffer, only : physics_buffer_desc, pbuf_set_field + + implicit none + + real(r8), intent(in) :: q(pcols,pver,nslvd) + integer, intent(in) :: lchnk, ncol + type(physics_buffer_desc), pointer :: pbuf(:) + + integer :: m,n + + if ( nslvd < 1 ) return + + do m=1,nslvd + !n = map(m) + !call pbuf_set_field(pbuf, pbf_idx, q(:,:,m), start=(/1,1,n/),kount=(/pcols,pver,1/)) + call pbuf_set_field(pbuf, pbf_idx, q(:,:,m), start=(/1,1,m/),kount=(/pcols,pver,1/)) + enddo + + end subroutine set_short_lived_species + +!--------------------------------------------------------------------- +!--------------------------------------------------------------------- + subroutine get_short_lived_species( q, lchnk, ncol, pbuf ) + use physics_buffer, only : physics_buffer_desc, pbuf_get_field + + implicit none + + real(r8), intent(inout) :: q(pcols,pver,nslvd) + integer, intent(in) :: lchnk, ncol + type(physics_buffer_desc), pointer :: pbuf(:) + real(r8),pointer :: tmpptr(:,:) + + + integer :: m,n + + if ( nslvd < 1 ) return + + do m=1,nslvd + !n = map(m) + call pbuf_get_field(pbuf, pbf_idx, tmpptr, start=(/1,1,m/), kount=(/ pcols,pver,1 /)) + !q(:ncol,:,n) = tmpptr(:ncol,:) + q(:ncol,:,m) = tmpptr(:ncol,:) + enddo + + endsubroutine get_short_lived_species + +!--------------------------------------------------------------------- +!--------------------------------------------------------------------- + function slvd_index( name ) + implicit none + + character(len=*) :: name + integer :: slvd_index + + integer :: m + + slvd_index = -1 + + if ( nslvd < 1 ) return + + do m=1,nslvd + if ( name == slvd_lst(m) ) then + slvd_index = m + return + endif + enddo + + endfunction slvd_index + +end module short_lived_species diff --git a/src/chemistry/pp_geoschem/upper_bc.F90 b/src/chemistry/pp_geoschem/upper_bc.F90 new file mode 100644 index 0000000000..61f4dab886 --- /dev/null +++ b/src/chemistry/pp_geoschem/upper_bc.F90 @@ -0,0 +1,243 @@ + +module upper_bc + +!--------------------------------------------------------------------------------- +! Module to compute the upper boundary condition for temperature (dry static energy) +! and trace gases. Uses the MSIS model, and SNOE and TIME GCM data. +! +! original code by Stacy Walters +! adapted by B. A. Boville +!--------------------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + use shr_const_mod,only: grav => shr_const_g, & ! gravitational constant (m/s^2) + kboltz => shr_const_boltz, & ! Boltzmann constant + pi => shr_const_pi, & ! pi + rEarth => shr_const_rearth ! Earth radius + use ppgrid, only: pcols, pver, pverp + use constituents, only: pcnst + use cam_logfile, only: iulog + use spmd_utils, only: masterproc + use ref_pres, only: ptop_ref + + implicit none + private + save +! +! Public interfaces +! + public :: ubc_defaultopts ! set default values of namelist variables + public :: ubc_setopts ! get namelist input + public :: ubc_init ! global initialization + public :: ubc_timestep_init ! time step initialization + public :: ubc_get_vals ! get ubc values for this step + +! Namelist variables + character(len=256) :: snoe_ubc_file = ' ' + real(r8) :: t_pert_ubc = 0._r8 + real(r8) :: no_xfac_ubc = 1._r8 + + character(len=256) :: tgcm_ubc_file = ' ' + integer :: tgcm_ubc_cycle_yr = 0 + integer :: tgcm_ubc_fixed_ymd = 0 + integer :: tgcm_ubc_fixed_tod = 0 + integer :: f_ndx, hf_ndx + character(len=32) :: tgcm_ubc_data_type = 'CYCLICAL' + + logical :: apply_upper_bc = .true. + +!================================================================================================ +contains +!================================================================================================ + +subroutine ubc_defaultopts(tgcm_ubc_file_out, tgcm_ubc_data_type_out, tgcm_ubc_cycle_yr_out, tgcm_ubc_fixed_ymd_out, & + tgcm_ubc_fixed_tod_out, snoe_ubc_file_out, t_pert_ubc_out, no_xfac_ubc_out) +!----------------------------------------------------------------------- +! Purpose: Return default runtime options +!----------------------------------------------------------------------- + + real(r8), intent(out), optional :: t_pert_ubc_out + real(r8), intent(out), optional :: no_xfac_ubc_out + character(len=*), intent(out), optional :: tgcm_ubc_file_out + character(len=*), intent(out), optional :: snoe_ubc_file_out + integer , intent(out), optional :: tgcm_ubc_cycle_yr_out + integer , intent(out), optional :: tgcm_ubc_fixed_ymd_out + integer , intent(out), optional :: tgcm_ubc_fixed_tod_out + character(len=*), intent(out), optional :: tgcm_ubc_data_type_out + +!----------------------------------------------------------------------- + + if ( present(tgcm_ubc_file_out) ) then + tgcm_ubc_file_out = tgcm_ubc_file + endif + if ( present(tgcm_ubc_data_type_out) ) then + tgcm_ubc_data_type_out = tgcm_ubc_data_type + endif + if ( present(tgcm_ubc_cycle_yr_out) ) then + tgcm_ubc_cycle_yr_out = tgcm_ubc_cycle_yr + endif + if ( present(tgcm_ubc_fixed_ymd_out) ) then + tgcm_ubc_fixed_ymd_out = tgcm_ubc_fixed_ymd + endif + if ( present(tgcm_ubc_fixed_tod_out) ) then + tgcm_ubc_fixed_tod_out = tgcm_ubc_fixed_tod + endif + if ( present(snoe_ubc_file_out) ) then + snoe_ubc_file_out = snoe_ubc_file + endif + if ( present(t_pert_ubc_out) ) then + t_pert_ubc_out = t_pert_ubc + endif + if ( present(no_xfac_ubc_out) ) then + no_xfac_ubc_out = no_xfac_ubc + endif + +end subroutine ubc_defaultopts + +!================================================================================================ + +subroutine ubc_setopts(tgcm_ubc_file_in, tgcm_ubc_data_type_in, tgcm_ubc_cycle_yr_in, tgcm_ubc_fixed_ymd_in, & + tgcm_ubc_fixed_tod_in, snoe_ubc_file_in, t_pert_ubc_in, no_xfac_ubc_in) +!----------------------------------------------------------------------- +! Purpose: Set runtime options +!----------------------------------------------------------------------- + + use cam_abortutils, only : endrun + + real(r8), intent(in), optional :: t_pert_ubc_in + real(r8), intent(in), optional :: no_xfac_ubc_in + character(len=*), intent(in), optional :: tgcm_ubc_file_in + character(len=*), intent(in), optional :: snoe_ubc_file_in + integer , intent(in), optional :: tgcm_ubc_cycle_yr_in + integer , intent(in), optional :: tgcm_ubc_fixed_ymd_in + integer , intent(in), optional :: tgcm_ubc_fixed_tod_in + character(len=*), intent(in), optional :: tgcm_ubc_data_type_in + +!----------------------------------------------------------------------- + + if ( present(tgcm_ubc_file_in) ) then + tgcm_ubc_file = tgcm_ubc_file_in + endif + if ( present(tgcm_ubc_data_type_in) ) then + tgcm_ubc_data_type = tgcm_ubc_data_type_in + endif + if ( present(tgcm_ubc_cycle_yr_in) ) then + tgcm_ubc_cycle_yr = tgcm_ubc_cycle_yr_in + endif + if ( present(tgcm_ubc_fixed_ymd_in) ) then + tgcm_ubc_fixed_ymd = tgcm_ubc_fixed_ymd_in + endif + if ( present(tgcm_ubc_fixed_tod_in) ) then + tgcm_ubc_fixed_tod = tgcm_ubc_fixed_tod_in + endif + if ( present(snoe_ubc_file_in) ) then + snoe_ubc_file = snoe_ubc_file_in + endif + if ( present(t_pert_ubc_in) ) then + t_pert_ubc = t_pert_ubc_in + endif + if ( present(no_xfac_ubc_in) ) then + no_xfac_ubc = no_xfac_ubc_in + if( no_xfac_ubc < 0._r8 ) then + write(iulog,*) 'ubc_setopts: no_xfac_ubc = ',no_xfac_ubc,' must be >= 0' + call endrun + end if + endif + +end subroutine ubc_setopts + +!=============================================================================== + + subroutine ubc_init() +!----------------------------------------------------------------------- +! Initialization of time independent fields for the upper boundary condition +! Calls initialization routine for MSIS, TGCM and SNOE +!----------------------------------------------------------------------- + + ! Assume we are running in a simulation with ptop >= 1 Pa + apply_upper_bc = .false. + + if (.not.apply_upper_bc) return + + end subroutine ubc_init + +!=============================================================================== + + subroutine ubc_timestep_init(pbuf2d, state) +!----------------------------------------------------------------------- +! timestep dependent setting +!----------------------------------------------------------------------- + + use solar_parms_data, only: kp=>solar_parms_kp, ap=>solar_parms_ap, f107=>solar_parms_f107 + use solar_parms_data, only: f107a=>solar_parms_f107a, f107p=>solar_parms_f107p + use physics_types, only: physics_state + use ppgrid, only: begchunk, endchunk + use physics_buffer, only: physics_buffer_desc + + type(physics_state), intent(in) :: state(begchunk:endchunk) + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + if (.not.apply_upper_bc) return + + end subroutine ubc_timestep_init + +!=============================================================================== + + subroutine ubc_get_vals (lchnk, ncol, pint, zi, t, q, omega, phis, & + msis_temp, ubc_mmr, ubc_flux) + +!----------------------------------------------------------------------- +! interface routine for vertical diffusion and pbl scheme +!----------------------------------------------------------------------- + use cam_abortutils, only: endrun + use physconst, only: avogad, rairv, mbarv, rga ! Avogadro, gas constant, mean mass, universal gas constant + use phys_control, only: waccmx_is + use constituents, only: cnst_get_ind, cnst_mw, cnst_fixed_ubc ! Needed for ubc_flux + +!------------------------------Arguments-------------------------------- + integer, intent(in) :: lchnk ! chunk identifier + integer, intent(in) :: ncol ! number of atmospheric columns + real(r8), intent(in) :: pint(pcols,pverp) ! interface pressures + real(r8), intent(in) :: zi(pcols,pverp) ! interface geoptl height above sfc + real(r8), intent(in) :: t(pcols,pver) ! midpoint temperature + real(r8), intent(in),target :: q(pcols,pver,pcnst) ! contituent mixing ratios (kg/kg) + real(r8), intent(in) :: omega(pcols,pver) ! Vertical pressure velocity (Pa/s) + real(r8), intent(in) :: phis(pcols) ! Surface geopotential (m2/s2) + + real(r8), intent(out) :: msis_temp(pcols) ! upper bndy temperature (K) + real(r8), intent(out) :: ubc_mmr(pcols,pcnst) ! upper bndy mixing ratios (kg/kg) + real(r8), intent(out) :: ubc_flux(pcols,pcnst) ! upper bndy flux (kg/s/m^2) + +!---------------------------Local storage------------------------------- + integer :: m ! constituent index + integer :: ierr ! error flag for allocates + integer :: indx_H ! cnst index for H + integer :: indx_HE ! cnst index for He + integer :: iCol ! column loop counter + + real(r8), parameter :: m2km = 1.e-3_r8 ! meter to km + real(r8) :: rho_top(pcols) ! density at top interface + real(r8) :: z_top(pcols) ! height of top interface (km) + + real(r8), parameter :: hfluxlimitfac = 0.72_r8 ! Hydrogen upper boundary flux limiting factor + + real(r8) :: nmbartop ! Top level density (rho) + real(r8) :: zkt ! Factor for H Jean's escape flux calculation + real(r8) :: nDensHETop ! Helium number density (kg/m3) + real(r8) :: pScaleHeight ! Scale height (m) + real(r8) :: wN2 ! Neutral vertical velocity second level (m/s) + real(r8) :: wN3 ! Neutral vertical velocity at third level (m/s) + real(r8) :: wNTop ! Neutral vertical velocity at top level (m/s) + + real(r8), pointer :: qh_top(:) ! Top level hydrogen mixing ratio (kg/kg) +!----------------------------------------------------------------------- + + ubc_mmr(:,:) = 0._r8 + ubc_flux(:,:) = 0._r8 + msis_temp(:) = 0._r8 + + if (.not. apply_upper_bc) return + + end subroutine ubc_get_vals + +end module upper_bc diff --git a/src/control/camsrfexch.F90 b/src/control/camsrfexch.F90 index d48e42b433..fae49a18ab 100644 --- a/src/control/camsrfexch.F90 +++ b/src/control/camsrfexch.F90 @@ -120,6 +120,9 @@ module camsrfexch real(r8) :: re(pcols) ! atm/ocn saved version of re real(r8) :: ssq(pcols) ! atm/ocn saved version of ssq real(r8), pointer, dimension(:,:) :: depvel ! deposition velocities + real(r8), pointer, dimension(:,:) :: lwtgcell ! landunit areas + real(r8), pointer, dimension(:,:) :: pwtgcell ! patch areas + real(r8), pointer, dimension(:,:) :: lai ! leaf area indices real(r8), pointer, dimension(:,:) :: dstflx ! dust fluxes real(r8), pointer, dimension(:,:) :: meganflx ! MEGAN fluxes real(r8), pointer, dimension(:,:) :: fireflx ! wild fire emissions @@ -146,7 +149,7 @@ module camsrfexch ! !INTERFACE ! subroutine hub2atm_alloc( cam_in ) - use seq_drydep_mod, only: lnd_drydep, n_drydep + use seq_drydep_mod, only: lnd_drydep, n_drydep, NLUse, NPatch use cam_cpl_indices, only: index_x2a_Sl_ram1, index_x2a_Sl_fv, index_x2a_Sl_soilw, index_x2a_Fall_flxdst1 use cam_cpl_indices, only: index_x2a_Fall_flxvoc use shr_megan_mod, only: shr_megan_mechcomps_n @@ -177,6 +180,9 @@ subroutine hub2atm_alloc( cam_in ) nullify(cam_in(c)%fv) nullify(cam_in(c)%soilw) nullify(cam_in(c)%depvel) + nullify(cam_in(c)%lwtgcell) + nullify(cam_in(c)%pwtgcell) + nullify(cam_in(c)%lai) nullify(cam_in(c)%dstflx) nullify(cam_in(c)%meganflx) nullify(cam_in(c)%fireflx) @@ -210,6 +216,12 @@ subroutine hub2atm_alloc( cam_in ) do c = begchunk,endchunk allocate (cam_in(c)%depvel(pcols,n_drydep), stat=ierror) if ( ierror /= 0 ) call endrun('HUB2ATM_ALLOC error: allocation error depvel') + allocate (cam_in(c)%lwtgcell(pcols,NLUse), stat=ierror) + if ( ierror /= 0 ) call endrun('HUB2ATM_ALLOC error: allocation error lwtgcell') + allocate (cam_in(c)%pwtgcell(pcols,NPatch), stat=ierror) + if ( ierror /= 0 ) call endrun('HUB2ATM_ALLOC error: allocation error pwtgcell') + allocate (cam_in(c)%lai(pcols,NPatch), stat=ierror) + if ( ierror /= 0 ) call endrun('HUB2ATM_ALLOC error: allocation error lai') end do endif @@ -266,6 +278,11 @@ subroutine hub2atm_alloc( cam_in ) if (lnd_drydep .and. n_drydep>0) then cam_in(c)%depvel (:,:) = 0._r8 endif + if (lnd_drydep) then + cam_in(c)%lwtgcell (:,:) = 0._r8 + cam_in(c)%pwtgcell (:,:) = 0._r8 + cam_in(c)%lai (:,:) = 0._r8 + endif if ( index_x2a_Fall_flxfire>0 .and. shr_fire_emis_mechcomps_n>0 ) then cam_in(c)%fireflx(:,:) = 0._r8 cam_in(c)%fireztop(:) = 0._r8 @@ -411,6 +428,18 @@ subroutine hub2atm_deallocate(cam_in) deallocate(cam_in(c)%depvel) nullify(cam_in(c)%depvel) end if + if(associated(cam_in(c)%lwtgcell)) then + deallocate(cam_in(c)%lwtgcell) + nullify(cam_in(c)%lwtgcell) + end if + if(associated(cam_in(c)%pwtgcell)) then + deallocate(cam_in(c)%pwtgcell) + nullify(cam_in(c)%pwtgcell) + end if + if(associated(cam_in(c)%lai)) then + deallocate(cam_in(c)%lai) + nullify(cam_in(c)%lai) + end if enddo diff --git a/src/cpl/atm_import_export.F90 b/src/cpl/atm_import_export.F90 index 8ff1839da6..31e8d803e5 100644 --- a/src/cpl/atm_import_export.F90 +++ b/src/cpl/atm_import_export.F90 @@ -13,7 +13,7 @@ subroutine atm_import( x2a, cam_in, restart_init ) use phys_grid , only: get_ncols_p use ppgrid , only: begchunk, endchunk use shr_const_mod, only: shr_const_stebol - use seq_drydep_mod, only: n_drydep + use seq_drydep_mod, only: n_drydep, NLUse, NPatch use shr_fire_emis_mod, only: shr_fire_emis_mechcomps_n use co2_cycle , only: c_i, co2_readFlux_ocn, co2_readFlux_fuel use co2_cycle , only: co2_transport, co2_time_interp_ocn, co2_time_interp_fuel @@ -101,6 +101,24 @@ subroutine atm_import( x2a, cam_in, restart_init ) cam_in(c)%depvel(i,:n_drydep) = & x2a(index_x2a_Sl_ddvel:index_x2a_Sl_ddvel+n_drydep-1, ig) endif + + ! for landunit weights + if (index_x2a_Sl_lwtgcell /= 0 ) then + cam_in(c)%lwtgcell(i,:NLUse) = & + x2a(index_x2a_Sl_lwtgcell:index_x2a_Sl_lwtgcell+NLUse-1, ig) + end if + + ! for patch weights + if (index_x2a_Sl_pwtgcell /= 0 ) then + cam_in(c)%pwtgcell(i,:NPatch) = & + x2a(index_x2a_Sl_pwtgcell:index_x2a_Sl_pwtgcell+NPatch-1, ig) + end if + + ! for leaf area indices + if (index_x2a_Sl_lai /= 0 ) then + cam_in(c)%lai(i,:NPatch) = & + x2a(index_x2a_Sl_lai:index_x2a_Sl_lai+NPatch-1, ig) + end if ! ! fields needed to calculate water isotopes to ocean evaporation processes ! diff --git a/src/cpl/cam_cpl_indices.F90 b/src/cpl/cam_cpl_indices.F90 index ec6d7a1546..acc02abe8f 100644 --- a/src/cpl/cam_cpl_indices.F90 +++ b/src/cpl/cam_cpl_indices.F90 @@ -3,6 +3,8 @@ module cam_cpl_indices use seq_flds_mod use mct_mod use seq_drydep_mod, only: drydep_fields_token, lnd_drydep + use seq_drydep_mod, only: luse_fields_token, patch_fields_token + use seq_drydep_mod, only: lai_fields_token use shr_megan_mod, only: shr_megan_fields_token, shr_megan_mechcomps_n use shr_fire_emis_mod, only: shr_fire_emis_fields_token, shr_fire_emis_ztop_token, shr_fire_emis_mechcomps_n @@ -86,6 +88,9 @@ module cam_cpl_indices integer :: index_x2a_So_re ! square of atm/ocn exch. coeff integer :: index_x2a_So_ssq ! surface saturation specific humidity in ocean integer :: index_x2a_Sl_ddvel ! dry deposition velocities from land + integer :: index_x2a_Sl_lwtgcell ! landunit area weights + integer :: index_x2a_Sl_pwtgcell ! patch area weights + integer :: index_x2a_Sl_lai ! leaf area indices integer :: index_x2a_Sx_u10 ! 10m wind contains @@ -157,9 +162,15 @@ subroutine cam_cpl_indices_set( ) endif if ( lnd_drydep )then - index_x2a_Sl_ddvel = mct_avect_indexra(x2a, trim(drydep_fields_token)) + index_x2a_Sl_ddvel = mct_avect_indexra(x2a, trim(drydep_fields_token)) + index_x2a_Sl_lwtgcell = mct_avect_indexra(x2a, trim(luse_fields_token)) + index_x2a_Sl_pwtgcell = mct_avect_indexra(x2a, trim(patch_fields_token)) + index_x2a_Sl_lai = mct_avect_indexra(x2a, trim(lai_fields_token)) else - index_x2a_Sl_ddvel = 0 + index_x2a_Sl_ddvel = 0 + index_x2a_Sl_lwtgcell = 0 + index_x2a_Sl_pwtgcell = 0 + index_x2a_Sl_lai = 0 end if index_a2x_Sa_z = mct_avect_indexra(a2x,'Sa_z') From 94b742390f57fff227e93faba2085433a0d4937e Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Fri, 15 May 2020 21:20:43 -0400 Subject: [PATCH 003/291] Squashed 5 commits from Haipeng Lin Feat: Implement HEMCO_CESM within CESM-GC (Initial attempt in syncing CAM sources) Feat: HEMCO_CESM code integration (full). Add mo_sim_dat and mo_tracname Fix: Call set_sim_dat from chemistry.F90 to pass solsym to HEMCO_CESM. Fix: Do not assign other variables within mo_sim_dat -- to discuss Fix: Comment out mo_sim_dat except solsym, expand solsym size to nTracersMax *This might not be needed after all as HEMCO_CESM now reads tracer names from chem_mods. But fixing this so it doesn't infinite loop. --- .gitignore | 1 + Externals_CAM.cfg | 8 + bld/config_files/definition.xml | 4 + bld/configure | 45 +- bld/namelist_files/namelist_definition.xml | 17 + src/chemistry/pp_geoschem/.exclude | 15 +- src/chemistry/pp_geoschem/chemistry.F90 | 9 + src/chemistry/pp_geoschem/mo_sim_dat.F90 | 1400 ++++++++++---------- src/chemistry/pp_geoschem/mo_tracname.F90 | 17 + src/control/cam_comp.F90 | 42 + src/control/runtime_opts.F90 | 7 + src/physics/cam/phys_control.F90 | 8 +- 12 files changed, 856 insertions(+), 717 deletions(-) create mode 100644 src/chemistry/pp_geoschem/mo_tracname.F90 diff --git a/.gitignore b/.gitignore index 5cc0bde57c..fcb95837b8 100644 --- a/.gitignore +++ b/.gitignore @@ -8,6 +8,7 @@ src/physics/clubb src/physics/cosp2/src src/physics/silhs src/chemistry/pp_geoschem/geoschem_src +src/hemco # Ignore compiled python buildnmlc diff --git a/Externals_CAM.cfg b/Externals_CAM.cfg index e50b7ea88e..a6b4048f33 100644 --- a/Externals_CAM.cfg +++ b/Externals_CAM.cfg @@ -33,6 +33,14 @@ tag = CESM repo_url = https://github.com/fritzt/CESM2-GC_Src required = True +[hemco] +local_path = src/hemco +protocol = git +branch = development +repo_url = https://github.com/jimmielin/HEMCO_CESM.git +required = True +externals = Externals_HCO.cfg + [externals_description] schema_version = 1.0.0 diff --git a/bld/config_files/definition.xml b/bld/config_files/definition.xml index dd0d01e5ee..e6a6055002 100644 --- a/bld/config_files/definition.xml +++ b/bld/config_files/definition.xml @@ -52,6 +52,10 @@ Option to turn on waccmx thermosphere/ionosphere extension: 0 => no, 1 => yes Ionosphere model used in WACCMX. + +Switch to turn on Harmonized Emissions Component (HEMCO): 0 => no, 1 => yes. +WARNING THIS IS ON BY DEFAULT FOR DEVELOPMENT - DO NOT SUBMIT THIS TO PRODUCTION CODE + Physics package: cam3, cam4, cam5, cam6, held_suarez, adiabatic, kessler, tj2016, spcam_sam1mom, spcam_m2005. diff --git a/bld/configure b/bld/configure index 25bd9e1dbf..4540f09a90 100755 --- a/bld/configure +++ b/bld/configure @@ -139,6 +139,7 @@ OPTIONS Makefile defaults. E.g. -cppdefs '-DVAR1 -DVAR2' -dyn Dynamical core option: [eul | fv | se]. Default: fv. -edit_chem_mech Invokes CAMCHEM_EDITOR to allow the user to edit the chemistry mechanism file + -hemco Switch enables the use of the Harmonized Emissions Component. -hgrid Specify horizontal grid. Use nlatxnlon for spectral grids; dlatxdlon for fv grids (dlat and dlon are the grid cell size in degrees for latitude and longitude respectively); nexnp for @@ -324,6 +325,7 @@ GetOptions( "fopt=s" => \$opts{'fopt'}, "gmake=s" => \$opts{'gmake'}, "h|help" => \$opts{'help'}, + "hemco" => \$opts{'hemco'}, "hgrid=s" => \$opts{'hgrid'}, "ionosphere=s" => \$opts{'ionosphere'}, "lapack_libdir=s" => \$opts{'lapack_libdir'}, @@ -1608,6 +1610,14 @@ else { $nadv = $cfg_ref->get('nadv'); if ($print>=2) { print "Total advected constituents: $nadv$eol"; } +#----------------------------------------------------------------------------------------------- + +# Harmonized Emissions Component (HEMCO) +if (defined $opts{'hemco'}) { + $cfg_ref->set('hemco', $opts{'hemco'}); +} +my $hemco = $cfg_ref->get('hemco'); + #----------------------------------------------------------------------------------------------- # Makefile configuration ####################################################################### #----------------------------------------------------------------------------------------------- @@ -1994,6 +2004,13 @@ $cfg_cppdefs .= ' -DHAVE_VPRINTF -DHAVE_TIMES -DHAVE_GETTIMEOFDAY -DHAVE_COMM_F2 unless ($target_os eq 'aix' or $target_os =~ 'bg' or $target_os eq 'darwin') { $cfg_cppdefs .= ' -DHAVE_NANOTIME -DBIT64 -DHAVE_SLASHPROC'; } + +# Harmonized Emissions Component (HEMCO) +if ($hemco) { + $cfg_cppdefs .= ' -DMODEL_ -DMODEL_CESM -DHEMCO_CESM -DUSE_REAL8 '; + print "Compiling highly-experimental HEMCO with CESM.$eol"; +} + #----------------------------------------------------------------------------------------------- # External libraries ########################################################################### #----------------------------------------------------------------------------------------------- @@ -2753,6 +2770,7 @@ sub write_filepath my $waccm_phys = $cfg_ref->get('waccm_phys'); my $waccmx = $cfg_ref->get('waccmx'); my $ionos = $cfg_ref->get('ionosphere'); + my $hemco = $cfg_ref->get('hemco'); my $carma = $cfg_ref->get('carma'); my $rad = $cfg_ref->get('rad'); my $dyn = $cfg_ref->get('dyn'); @@ -2812,9 +2830,6 @@ sub write_filepath print $fh "$chem_src_dir/geoschem_src/GeosCore\n"; print $fh "$chem_src_dir/geoschem_src/GeosUtil\n"; print $fh "$chem_src_dir/geoschem_src/Headers\n"; - print $fh "$chem_src_dir/geoschem_src/HEMCO/Core\n"; - print $fh "$chem_src_dir/geoschem_src/HEMCO/Extensions\n"; - print $fh "$chem_src_dir/geoschem_src/HEMCO/Interfaces\n"; print $fh "$chem_src_dir/geoschem_src/ISORROPIA\n"; print $fh "$chem_src_dir/geoschem_src/KPP/Standard\n"; } # print $fh "$camsrcdir/cam/src/chemistry/pp_geoschem\n"; } @@ -2831,6 +2846,30 @@ sub write_filepath } print $fh "$camsrcdir/src/ionosphere\n"; + # -- Added by hplin - 5/2020 + if ($hemco) { + print $fh "$camsrcdir/src/hemco\n"; + + # if not compiling with GEOS-Chem; coordinate this with tfritz later + # we may eventually remove all this + print $fh "$camsrcdir/src/hemco/HEMCO/src/Shared\n"; + + # right now shared files have been renamed for no-conflict + # if ($chem_pkg ne 'geoschem') { + print $fh "$camsrcdir/src/hemco/HEMCO/src/Shared/Headers\n"; + print $fh "$camsrcdir/src/hemco/HEMCO/src/Shared/GeosUtil\n"; + # } + + # to remove - need to use pio + print $fh "$camsrcdir/src/hemco/HEMCO/src/Shared/NcdfUtil\n"; + + # hplin 2/16/20: temporarily add hemco src code directories manually + # until we figure out a better compile routine. + print $fh "$camsrcdir/src/hemco/HEMCO/src/Core\n"; + print $fh "$camsrcdir/src/hemco/HEMCO/src/Extensions\n"; + print $fh "$camsrcdir/src/hemco/HEMCO/src/Interfaces\n"; + } + # -- Added by MSL - 1/2018 # -- Updated by TMMF - 11/2019 if ($chem_pkg ne 'geoschem') { diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index 3bd44f4200..3424886ca4 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -3913,6 +3913,15 @@ cache file to be consistent with how CAM was built. Default: set by build-namelist + +Full pathname to CAM physics grid ESMF mesh file. +N.B. this variable may not be set by the user. +It is set by build-namelist via information in the configure +cache file to be consistent with how CAM was built. +Default: set by build-namelist + + Runtime options of upper thermosphere WACCM-X. 'ionosphere' for @@ -4000,6 +4009,14 @@ Full pathname of AMIE inputs for southern hemisphere. Default: NONE. + + +Full pathname of dataset for coefficient data used in Weimer05 +high latitude electric potential model. +Default: set by build-namelist. + + Date: Tue, 19 May 2020 11:26:36 -0400 Subject: [PATCH 004/291] Squashed 2 commits from Thibaud Fritz Feat: Add Olson / CLM land type mapping for CLM4.5/5.0 Feat: Add FAST_JX_DIR in Input_Opt. Remove hard-wired paths in fast_jx --- src/chemistry/pp_geoschem/chemistry.F90 | 4 + src/chemistry/pp_geoschem/getLandTypes.F90 | 416 ++++++++++++++++++--- 2 files changed, 378 insertions(+), 42 deletions(-) diff --git a/src/chemistry/pp_geoschem/chemistry.F90 b/src/chemistry/pp_geoschem/chemistry.F90 index f99181f1cd..caea37321e 100644 --- a/src/chemistry/pp_geoschem/chemistry.F90 +++ b/src/chemistry/pp_geoschem/chemistry.F90 @@ -931,6 +931,10 @@ subroutine chem_init(phys_state, pbuf2d) Input_Opt%TPCore_JOrd = 3 Input_Opt%TPCore_KOrd = 3 + ! Now READ_PHOTOLYSIS_MENU + Input_Opt%FAST_JX_DIR ='/glade/p/univ/umit0034/ExtData/' // & + 'CHEM_INPUTS/FAST_JX/v2019-06/' + ! Now READ_CONVECTION_MENU ! For now, TMMF Input_Opt%LConv = .False. diff --git a/src/chemistry/pp_geoschem/getLandTypes.F90 b/src/chemistry/pp_geoschem/getLandTypes.F90 index 9852d706f5..2a7ef31932 100644 --- a/src/chemistry/pp_geoschem/getLandTypes.F90 +++ b/src/chemistry/pp_geoschem/getLandTypes.F90 @@ -20,6 +20,7 @@ SUBROUTINE getLandTypes( cam_in, nY, State_Met ) USE PRECISION_MOD, ONLY : fp, f4 ! Flexible precision USE CMN_SIZE_Mod, ONLY : NSURFTYPE USE cam_abortutils, ONLY : endrun + IMPLICIT NONE ! ! !INPUT PARAMETERS: @@ -55,17 +56,17 @@ SUBROUTINE getLandTypes( cam_in, nY, State_Met ) ! Coniferous Forest (ID = 4) | ! Deciduous Conifer Forest (ID = 5) | Needleleaf Deciduous Bor. (PAID = 3) ! Deciduous Broadleaf For. (ID = 6) | - ! Evergreen Broadleaf For. (ID = 7) | + ! Evergreen Broadleaf For. (ID = 7) | Broadleaf Evergreen Temp. (PAID = 5) ! Tall Grasses and Shrubs (ID = 8) | ! Bare Desert (ID = 9) | Not veg. \ Ice (PAID = 0\LUID = 2) ! Upland Tundra (ID = 10) | Broadleaf Deciduous Bore. (PAID = 11) - ! Irrigated Grassland (ID = 11) | C3 Irrigated (PAID = 16) + ! Irrigated Grassland (ID = 11) | ! Semi Desert (ID = 12) | ! Glacier ice (ID = 13) | Land ice (LUID = 2) ! Wooded Wet Swamp (ID = 14) | ! - (ID = 15) | ! - (ID = 16) | - ! Shrub Evergreen (ID = 17) | + ! Shrub Evergreen (ID = 17) | Broadleaf Evergreen Shru. (PAID = 9) ! - (ID = 18) | ! Shrub Deciduous (ID = 19) | ! Evergreen Forest and Fi. (ID = 20) | @@ -81,6 +82,7 @@ SUBROUTINE getLandTypes( cam_in, nY, State_Met ) ! Seasonal Tropical Fores. (ID = 30) | ! Cool Crops and Towns (ID = 31) | Winter Temp. Cereal (PAID = 19) ! Crops and Town (ID = 32) | C3 Crop (PAID = 15) + ! | C3 Irrigated (PAID = 16) ! | Spring Temp. Cereal (PAID = 18) ! Dry Tropical Woods (ID = 33) | ! Tropical Rainforest (ID = 34) | Broadleaf Evergreen Trop. (PAID = 4) @@ -98,15 +100,15 @@ SUBROUTINE getLandTypes( cam_in, nY, State_Met ) ! | C4 Grass (PAID = 14) ! Mire, Bog, Fen (ID = 45) | Wetland - Not Applied (LUID = 5) ! Marsh Wetland (ID = 46) | - ! Mediterranean Scrub (ID = 47) | Broadleaf Evergreen Shru. (PAID = 9) - ! Dry Woody Scrub (ID = 48) | + ! Mediterranean Scrub (ID = 47) | + ! Dry Woody Scrub (ID = 48) | Broadleaf Deciduous Temp. (PAID = 10) ! - (ID = 49) | ! - (ID = 50) | ! - (ID = 51) | - ! Semi Desert Shrubs (ID = 52) | Broadleaf Deciduous Temp. (PAID = 10) + ! Semi Desert Shrubs (ID = 52) | ! Semi Desert Sage (ID = 53) | ! Barren Tundra (ID = 54) | - ! Cool Southern Hemisphere (ID = 55) | Broadleaf Evergreen Temp. (PAID = 5) + ! Cool Southern Hemisphere (ID = 55) | ! Cool Fields and Woods (ID = 56) | ! Forest and Field (ID = 57) | ! Cool Forest and Field (ID = 58) | @@ -141,57 +143,387 @@ SUBROUTINE getLandTypes( cam_in, nY, State_Met ) ! Initialize fraction land for this grid cell State_Met%LandTypeFrac(1,J, 1) = waterFrac !State_Met%LandTypeFrac(1,J, 2) = cam_in%lwtgcell(J, 6) + State_Met%LandTypeFrac(1,J, 5) = cam_in%pwtgcell(J, 4) + State_Met%LandTypeFrac(1,J, 7) = cam_in%pwtgcell(J, 6) State_Met%LandTypeFrac(1,J, 9) = cam_in%pwtgcell(J, 1) & - cam_in%lwtgcell(J, 2) State_Met%LandTypeFrac(1,J,10) = cam_in%pwtgcell(J,12) State_Met%LandTypeFrac(1,J,13) = cam_in%lwtgcell(J, 2) + State_Met%LandTypeFrac(1,J,17) = cam_in%pwtgcell(J,10) + State_Met%LandTypeFrac(1,J,22) = cam_in%pwtgcell(J, 3) State_Met%LandTypeFrac(1,J,24) = cam_in%pwtgcell(J, 9) State_Met%LandTypeFrac(1,J,26) = cam_in%pwtgcell(J, 8) - !State_Met%LandTypeFrac(1,J,45) = cam_in%lwtgcell(J, 5) - State_Met%LandTypeFrac(1,J,52) = cam_in%pwtgcell(J,11) - State_Met%LandTypeFrac(1,J,47) = cam_in%pwtgcell(J,10) - State_Met%LandTypeFrac(1,J,55) = cam_in%pwtgcell(J, 6) - State_Met%LandTypeFrac(1,J,34) = cam_in%pwtgcell(J, 5) - State_Met%LandTypeFrac(1,J,43) = cam_in%pwtgcell(J,13) - State_Met%LandTypeFrac(1,J,42) = cam_in%pwtgcell(J,14) - State_Met%LandTypeFrac(1,J,32) = cam_in%pwtgcell(J,16) - State_Met%LandTypeFrac(1,J,44) = cam_in%pwtgcell(J,15) - State_Met%LandTypeFrac(1,J, 5) = cam_in%pwtgcell(J, 4) - State_Met%LandTypeFrac(1,J,22) = cam_in%pwtgcell(J, 3) State_Met%LandTypeFrac(1,J,28) = cam_in%pwtgcell(J, 2) - State_Met%LandTypeFrac(1,J,44) = & - State_Met%LandTypeFrac(1,J,44) + cam_in%pwtgcell(J, 7) - State_Met%LandTypeFrac(1,J,11) = cam_in%pwtgcell(J,17) - State_Met%LandTypeFrac(1,J,36) = cam_in%pwtgcell(J,18) State_Met%LandTypeFrac(1,J,31) = cam_in%pwtgcell(J,20) - State_Met%LandTypeFrac(1,J,32) = & - State_Met%LandTypeFrac(1,J,32) + cam_in%pwtgcell(J,19) - State_Met%LandTypeFrac(1,J,36) = & - State_Met%LandTypeFrac(1,J,36) + cam_in%pwtgcell(J,21) + State_Met%LandTypeFrac(1,J,32) = cam_in%pwtgcell(J,16) & + + cam_in%pwtgcell(J,17) & + + cam_in%pwtgcell(J,19) + State_Met%LandTypeFrac(1,J,34) = cam_in%pwtgcell(J, 5) + State_Met%LandTypeFrac(1,J,36) = cam_in%pwtgcell(J,18) & + + cam_in%pwtgcell(J,21) + State_Met%LandTypeFrac(1,J,42) = cam_in%pwtgcell(J,14) + State_Met%LandTypeFrac(1,J,43) = cam_in%pwtgcell(J,13) + State_Met%LandTypeFrac(1,J,44) = cam_in%pwtgcell(J, 7) & + + cam_in%pwtgcell(J,15) + !State_Met%LandTypeFrac(1,J,45) = cam_in%lwtgcell(J, 5) + State_Met%LandTypeFrac(1,J,48) = cam_in%pwtgcell(J,11) + State_Met%XLAI_NATIVE(1,J, 5) = cam_in%lai(J, 4) + State_Met%XLAI_NATIVE(1,J, 7) = cam_in%lai(J, 6) State_Met%XLAI_NATIVE(1,J,10) = cam_in%lai(J,12) + State_Met%XLAI_NATIVE(1,J,17) = cam_in%lai(J,10) + State_Met%XLAI_NATIVE(1,J,22) = cam_in%lai(J, 3) State_Met%XLAI_NATIVE(1,J,24) = cam_in%lai(J, 9) State_Met%XLAI_NATIVE(1,J,26) = cam_in%lai(J, 8) - State_Met%XLAI_NATIVE(1,J,52) = cam_in%lai(J,11) - State_Met%XLAI_NATIVE(1,J,47) = cam_in%lai(J,10) - State_Met%XLAI_NATIVE(1,J,55) = cam_in%lai(J, 6) + State_Met%XLAI_NATIVE(1,J,28) = cam_in%lai(J, 2) + State_Met%XLAI_NATIVE(1,J,31) = cam_in%lai(J,20) + State_Met%XLAI_NATIVE(1,J,32) = cam_in%lai(J,16) & + + cam_in%lai(J,17) & + + cam_in%lai(J,19) State_Met%XLAI_NATIVE(1,J,34) = cam_in%lai(J, 5) - State_Met%XLAI_NATIVE(1,J,43) = cam_in%lai(J,13) + State_Met%XLAI_NATIVE(1,J,36) = cam_in%lai(J,18) & + + cam_in%lai(J,21) State_Met%XLAI_NATIVE(1,J,42) = cam_in%lai(J,14) - State_Met%XLAI_NATIVE(1,J,32) = cam_in%lai(J,16) - State_Met%XLAI_NATIVE(1,J,44) = cam_in%lai(J,15) + State_Met%XLAI_NATIVE(1,J,43) = cam_in%lai(J,13) + State_Met%XLAI_NATIVE(1,J,44) = cam_in%lai(J, 7) & + + cam_in%lai(J,15) + State_Met%XLAI_NATIVE(1,J,48) = cam_in%lai(J,11) + + DO T = 2, NSURFTYPE + State_Met%LandTypeFrac(1,J,T) = & + State_Met%LandTypeFrac(1,J,T) * landFrac + + State_Met%XLAI_NATIVE(1,J,T) = & + State_Met%XLAI_NATIVE(1,J,T) * landFrac + + ! Make sure that the land type fractions do not exceed 1 + IF ( State_Met%LandTypeFrac(1,J,T) > 1.0e+0_fp ) THEN + State_Met%LandTypeFrac(1,J,T) = 1.0e+0_fp + ELSEIF ( State_Met%LandTypeFrac(1,J,T) < 0.0e+0_fp ) THEN + State_Met%LandTypeFrac(1,J,T) = 0.0e+0_fp + ENDIF + ENDDO + + ENDDO + +#elif defined( CLM45 ) || defined( CLM50 ) + + ! Mapping for CLM4.5/CLM5.0 + ! -----------------------------------|-------------------------------------- + ! Olson land type | CLM land type + ! -----------------------------------|-------------------------------------- + ! Inland/sea water (ID = 1) | Ocean fraction + ! | Deeplake (LUID = 5) + ! Urban (ID = 2) | Urban - Not Applied (LUID =7-9) + ! Low Sparse Grassland (ID = 3) | + ! Coniferous Forest (ID = 4) | + ! Deciduous Conifer Forest (ID = 5) | Needleleaf Deciduous Bor. (PAID = 3) + ! Deciduous Broadleaf For. (ID = 6) | + ! Evergreen Broadleaf For. (ID = 7) | Broadleaf Evergreen Temp. (PAID = 5) + ! Tall Grasses and Shrubs (ID = 8) | + ! Bare Desert (ID = 9) | Not veg. \ Ice (PAID = 0\LUID = 4) + ! Upland Tundra (ID = 10) | Broadleaf Deciduous Bore. (PAID = 11) + ! Irrigated Grassland (ID = 11) | + ! Semi Desert (ID = 12) | + ! Glacier ice (ID = 13) | Land ice (LUID = 4) + ! Wooded Wet Swamp (ID = 14) | + ! - (ID = 15) | + ! - (ID = 16) | + ! Shrub Evergreen (ID = 17) | Broadleaf Evergreen Shru. (PAID = 9) + ! - (ID = 18) | + ! Shrub Deciduous (ID = 19) | + ! Evergreen Forest and Fi. (ID = 20) | + ! Cool Rain Forest (ID = 21) | + ! Conifer Boreal Forest (ID = 22) | Needleleaf Evergreen Bor. (PAID = 2) + ! Cool Conifer Forest (ID = 23) | + ! Cool Mixed Forest (ID = 24) | Broadleaf Deciduous Bore. (PAID = 8) + ! Mixed Forest (ID = 25) | + ! Cool Broadleaf Forest (ID = 26) | Broadleaf Deciduous Temp. (PAID = 7) + ! Deciduous Broadleaf For. (ID = 27) | + ! Conifer Forest (ID = 28) | Needleleaf Evergreen Tem. (PAID = 1) + ! Montane Tropical Forests (ID = 29) | + ! Seasonal Tropical Fores. (ID = 30) | + ! Cool Crops and Towns (ID = 31) | + ! Crops and Town (ID = 32) | C3 Crop (PAID = 15) + ! | C3 Irrigated (PAID = 16) + ! Dry Tropical Woods (ID = 33) | + ! Tropical Rainforest (ID = 34) | Broadleaf Evergreen Trop. (PAID = 4) + ! Tropical Degraded Forest (ID = 35) | + ! Corn and Beans Cropland (ID = 36) | Corn (PAID = 17) + ! | Irrigated Temperate Corn (PAID = 18) + ! | Spring Wheat (PAID = 19) + ! | Irrigated Spring Wheat (PAID = 20) + ! | Winter Wheat (PAID = 21) + ! | Irrigated Winter Wheat (PAID = 22) + ! | Temperated Soybean (PAID = 23) + ! | Irrigated Temperate Soyb. (PAID = 24) + ! | Barley (PAID = 25) + ! | Irrigated Barley (PAID = 26) + ! | Winter Barley (PAID = 27) + ! | Irrigated Winter Barley (PAID = 28) + ! | Rye (PAID = 29) + ! | Irrigated Rye (PAID = 30) + ! | Winter Rye (PAID = 31) + ! | Irrigated Winter Rye (PAID = 32) + ! | Cassava (PAID = 33) + ! | Irrigated Cassava (PAID = 34) + ! | Citrus (PAID = 35) + ! | Irrigated Citrus (PAID = 36) + ! | Cocoa (PAID = 37) + ! | Irrigated Cocoa (PAID = 38) + ! | Coffee (PAID = 39) + ! | Irrigated Coffee (PAID = 40) + ! | Cotton (PAID = 41) + ! | Irrigated Cotton (PAID = 42) + ! | Datepalm (PAID = 43) + ! | Irrigated Datepalm (PAID = 44) + ! | Foddergrass (PAID = 45) + ! | Irrigated Foddergrass (PAID = 46) + ! | Grapes (PAID = 47) + ! | Irrigated Grapes (PAID = 48) + ! | Groundnuts (PAID = 49) + ! | Irrigated Groundnuts (PAID = 50) + ! | Millet (PAID = 51) + ! | Irrigated Millet (PAID = 52) + ! | Oilpalm (PAID = 53) + ! | Irrigated Oilpalm (PAID = 54) + ! | Potatoes (PAID = 55) + ! | Irrigated Potatoes (PAID = 56) + ! | Pulses (PAID = 57) + ! | Irrigated Pulses (PAID = 58) + ! | Rapeseed (PAID = 59) + ! | Irrigated Rapeseed (PAID = 60) + ! | Rice (PAID = 61) + ! | Irrigated Rice (PAID = 62) + ! | Sorghum (PAID = 63) + ! | Irrigated Sorghum (PAID = 64) + ! | Sugarbeet (PAID = 65) + ! | Irrigated Sugarbeet (PAID = 66) + ! | Sugarcane (PAID = 67) + ! | Irrigated Sugarcane (PAID = 68) + ! | Sunflower (PAID = 69) + ! | Irrigated Sunflower (PAID = 70) + ! | Miscanthus (PAID = 71) + ! | Irrigated Miscanthus (PAID = 72) + ! | Switchgrass (PAID = 73) + ! | Irrigated Switchgrass (PAID = 74) + ! | Tropical Corn (PAID = 75) + ! | Irrigated Tropical Corn (PAID = 76) + ! | Tropical Soybean (PAID = 77) + ! | Irrigated Tropical Soybe. (PAID = 78) + ! Rice Paddy and Field (ID = 37) | + ! Hot Irrigated Cropland (ID = 38) | + ! Cool Irrigated Cropland (ID = 39) | + ! - (ID = 40) | + ! Cool Grasses and Shrubs (ID = 41) | + ! Hot and Mild Grasses and (ID = 42) | C3 Non-Arctic Grass (PAID = 13) + ! Cold Grassland (ID = 43) | C3 Arctic Grass (PAID = 12) + ! Savanna (Woods) (ID = 44) | Broadleaf Deciduous Trop. (PAID = 6) + ! | C4 Grass (PAID = 14) + ! Mire, Bog, Fen (ID = 45) | Wetland - Not Applied (LUID = 6) + ! Marsh Wetland (ID = 46) | + ! Mediterranean Scrub (ID = 47) | + ! Dry Woody Scrub (ID = 48) | Broadleaf Deciduous Temp. (PAID = 10) + ! - (ID = 49) | + ! - (ID = 50) | + ! - (ID = 51) | + ! Semi Desert Shrubs (ID = 52) | + ! Semi Desert Sage (ID = 53) | + ! Barren Tundra (ID = 54) | + ! Cool Southern Hemisphere (ID = 55) | + ! Cool Fields and Woods (ID = 56) | + ! Forest and Field (ID = 57) | + ! Cool Forest and Field (ID = 58) | + ! Fields and Woody Savanna (ID = 59) | + ! Succulent and Thorn Scr. (ID = 60) | + ! Small Leaf Mixed Woods (ID = 61) | + ! Deciduous and Mixed Bor. (ID = 62) | + ! Narrow Conifers (ID = 63) | + ! Wooded Tundra (ID = 64) | + ! Heath Scrub (ID = 65) | + ! - (ID = 66) | + ! - (ID = 67) | + ! - (ID = 68) | + ! - (ID = 69) | + ! Polar and Alpine Desert (ID = 70) | + ! - (ID = 71) | + ! - (ID = 72) | + ! Mangrove (ID = 73) | + + State_Met%LandTypeFrac(:,:,:) = 0.0e+0_fp + State_Met%XLAI_NATIVE(:,:,:) = 0.0e+0_fp + + DO J = 1, nY + waterFrac = cam_in%ocnFrac(J) + cam_in%iceFrac(J) & + + cam_in%lwtgcell(J,5) + landFrac = 1.0e+0_fp - waterFrac + + ! Initialize fraction land for this grid cell + State_Met%LandTypeFrac(1,J, 1) = waterFrac + !State_Met%LandTypeFrac(1,J, 2) = cam_in%lwtgcell(J, 7) & + ! + cam_in%lwtgcell(J, 8) & + ! + cam_in%lwtgcell(J, 9) + State_Met%LandTypeFrac(1,J, 5) = cam_in%pwtgcell(J, 4) + State_Met%LandTypeFrac(1,J, 7) = cam_in%pwtgcell(J, 6) + State_Met%LandTypeFrac(1,J, 9) = cam_in%pwtgcell(J, 1) & + * ( 1.0e+0_fp - cam_in%lwtgcell(J, 4) ) + State_Met%LandTypeFrac(1,J,10) = cam_in%pwtgcell(J,12) + State_Met%LandTypeFrac(1,J,13) = cam_in%lwtgcell(J, 4) + State_Met%LandTypeFrac(1,J,17) = cam_in%pwtgcell(J,10) + State_Met%LandTypeFrac(1,J,22) = cam_in%pwtgcell(J, 3) + State_Met%LandTypeFrac(1,J,24) = cam_in%pwtgcell(J, 9) + State_Met%LandTypeFrac(1,J,26) = cam_in%pwtgcell(J, 8) + State_Met%LandTypeFrac(1,J,28) = cam_in%pwtgcell(J, 2) + State_Met%LandTypeFrac(1,J,32) = cam_in%pwtgcell(J,16) & + + cam_in%pwtgcell(J,17) + State_Met%LandTypeFrac(1,J,34) = cam_in%pwtgcell(J, 5) + State_Met%LandTypeFrac(1,J,36) = cam_in%pwtgcell(J,18) & + + cam_in%pwtgcell(J,19) & + + cam_in%pwtgcell(J,20) & + + cam_in%pwtgcell(J,21) & + + cam_in%pwtgcell(J,22) & + + cam_in%pwtgcell(J,23) & + + cam_in%pwtgcell(J,24) & + + cam_in%pwtgcell(J,25) & + + cam_in%pwtgcell(J,26) & + + cam_in%pwtgcell(J,27) & + + cam_in%pwtgcell(J,28) & + + cam_in%pwtgcell(J,29) & + + cam_in%pwtgcell(J,30) & + + cam_in%pwtgcell(J,31) & + + cam_in%pwtgcell(J,32) & + + cam_in%pwtgcell(J,33) & + + cam_in%pwtgcell(J,34) & + + cam_in%pwtgcell(J,35) & + + cam_in%pwtgcell(J,36) & + + cam_in%pwtgcell(J,37) & + + cam_in%pwtgcell(J,38) & + + cam_in%pwtgcell(J,39) & + + cam_in%pwtgcell(J,40) & + + cam_in%pwtgcell(J,41) & + + cam_in%pwtgcell(J,42) & + + cam_in%pwtgcell(J,43) & + + cam_in%pwtgcell(J,44) & + + cam_in%pwtgcell(J,45) & + + cam_in%pwtgcell(J,46) & + + cam_in%pwtgcell(J,47) & + + cam_in%pwtgcell(J,48) & + + cam_in%pwtgcell(J,49) & + + cam_in%pwtgcell(J,50) & + + cam_in%pwtgcell(J,51) & + + cam_in%pwtgcell(J,52) & + + cam_in%pwtgcell(J,53) & + + cam_in%pwtgcell(J,54) & + + cam_in%pwtgcell(J,55) & + + cam_in%pwtgcell(J,56) & + + cam_in%pwtgcell(J,57) & + + cam_in%pwtgcell(J,58) & + + cam_in%pwtgcell(J,59) & + + cam_in%pwtgcell(J,60) & + + cam_in%pwtgcell(J,61) & + + cam_in%pwtgcell(J,62) & + + cam_in%pwtgcell(J,63) & + + cam_in%pwtgcell(J,64) & + + cam_in%pwtgcell(J,65) & + + cam_in%pwtgcell(J,66) & + + cam_in%pwtgcell(J,67) & + + cam_in%pwtgcell(J,68) & + + cam_in%pwtgcell(J,69) & + + cam_in%pwtgcell(J,70) & + + cam_in%pwtgcell(J,71) & + + cam_in%pwtgcell(J,72) & + + cam_in%pwtgcell(J,73) & + + cam_in%pwtgcell(J,74) & + + cam_in%pwtgcell(J,75) & + + cam_in%pwtgcell(J,76) & + + cam_in%pwtgcell(J,77) & + + cam_in%pwtgcell(J,78) & + + cam_in%pwtgcell(J,79) + State_Met%LandTypeFrac(1,J,42) = cam_in%pwtgcell(J,14) + State_Met%LandTypeFrac(1,J,43) = cam_in%pwtgcell(J,13) + State_Met%LandTypeFrac(1,J,44) = cam_in%pwtgcell(J, 7) & + + cam_in%pwtgcell(J,15) + !State_Met%LandTypeFrac(1,J,45) = cam_in%lwtgcell(J, 6) + State_Met%LandTypeFrac(1,J,48) = cam_in%pwtgcell(J,11) + State_Met%XLAI_NATIVE(1,J, 5) = cam_in%lai(J, 4) + State_Met%XLAI_NATIVE(1,J, 7) = cam_in%lai(J, 6) + State_Met%XLAI_NATIVE(1,J,10) = cam_in%lai(J,12) + State_Met%XLAI_NATIVE(1,J,17) = cam_in%lai(J,10) State_Met%XLAI_NATIVE(1,J,22) = cam_in%lai(J, 3) + State_Met%XLAI_NATIVE(1,J,24) = cam_in%lai(J, 9) + State_Met%XLAI_NATIVE(1,J,26) = cam_in%lai(J, 8) State_Met%XLAI_NATIVE(1,J,28) = cam_in%lai(J, 2) - State_Met%XLAI_NATIVE(1,J,44) = & - State_Met%XLAI_NATIVE(1,J,44) + cam_in%lai(J, 7) - State_Met%XLAI_NATIVE(1,J,11) = cam_in%lai(J,17) - State_Met%XLAI_NATIVE(1,J,36) = cam_in%lai(J,18) - State_Met%XLAI_NATIVE(1,J,31) = cam_in%lai(J,20) - State_Met%XLAI_NATIVE(1,J,32) = & - State_Met%XLAI_NATIVE(1,J,32) + cam_in%lai(J,19) - State_Met%XLAI_NATIVE(1,J,36) = & - State_Met%XLAI_NATIVE(1,J,36) + cam_in%lai(J,21) + State_Met%XLAI_NATIVE(1,J,32) = cam_in%lai(J,16) & + + cam_in%lai(J,17) + State_Met%XLAI_NATIVE(1,J,34) = cam_in%lai(J, 5) + State_Met%XLAI_NATIVE(1,J,36) = cam_in%lai(J,18) & + + cam_in%lai(J,19) & + + cam_in%lai(J,20) & + + cam_in%lai(J,21) & + + cam_in%lai(J,22) & + + cam_in%lai(J,23) & + + cam_in%lai(J,24) & + + cam_in%lai(J,25) & + + cam_in%lai(J,26) & + + cam_in%lai(J,27) & + + cam_in%lai(J,28) & + + cam_in%lai(J,29) & + + cam_in%lai(J,30) & + + cam_in%lai(J,31) & + + cam_in%lai(J,32) & + + cam_in%lai(J,33) & + + cam_in%lai(J,34) & + + cam_in%lai(J,35) & + + cam_in%lai(J,36) & + + cam_in%lai(J,37) & + + cam_in%lai(J,38) & + + cam_in%lai(J,39) & + + cam_in%lai(J,40) & + + cam_in%lai(J,41) & + + cam_in%lai(J,42) & + + cam_in%lai(J,43) & + + cam_in%lai(J,44) & + + cam_in%lai(J,45) & + + cam_in%lai(J,46) & + + cam_in%lai(J,47) & + + cam_in%lai(J,48) & + + cam_in%lai(J,49) & + + cam_in%lai(J,50) & + + cam_in%lai(J,51) & + + cam_in%lai(J,52) & + + cam_in%lai(J,53) & + + cam_in%lai(J,54) & + + cam_in%lai(J,55) & + + cam_in%lai(J,56) & + + cam_in%lai(J,57) & + + cam_in%lai(J,58) & + + cam_in%lai(J,59) & + + cam_in%lai(J,60) & + + cam_in%lai(J,61) & + + cam_in%lai(J,62) & + + cam_in%lai(J,63) & + + cam_in%lai(J,64) & + + cam_in%lai(J,65) & + + cam_in%lai(J,66) & + + cam_in%lai(J,67) & + + cam_in%lai(J,68) & + + cam_in%lai(J,69) & + + cam_in%lai(J,70) & + + cam_in%lai(J,71) & + + cam_in%lai(J,72) & + + cam_in%lai(J,73) & + + cam_in%lai(J,74) & + + cam_in%lai(J,75) & + + cam_in%lai(J,76) & + + cam_in%lai(J,77) & + + cam_in%lai(J,78) & + + cam_in%lai(J,79) + State_Met%XLAI_NATIVE(1,J,42) = cam_in%lai(J,14) + State_Met%XLAI_NATIVE(1,J,43) = cam_in%lai(J,13) + State_Met%XLAI_NATIVE(1,J,44) = cam_in%lai(J, 7) & + + cam_in%lai(J,15) + State_Met%XLAI_NATIVE(1,J,48) = cam_in%lai(J,11) DO T = 2, NSURFTYPE State_Met%LandTypeFrac(1,J,T) = & @@ -209,7 +541,7 @@ SUBROUTINE getLandTypes( cam_in, nY, State_Met ) ENDDO ENDDO -#elif defined( CLM45 ) || defined( CLM50 ) + #else CALL endrun('Cannot figure out which version of CLM') #endif From 63df68000515bcd439b621f10d08ab0ab35961fd Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Tue, 21 Jul 2020 10:19:46 -0600 Subject: [PATCH 005/291] Squashed 4 commits from Lizzie Lundgren Change GEOS-Chem source to CESM-GC GitHub organization and branch name Use GEOS-Chem branch feature/13.0.0+CESM Update HEMCO interfaces directory name in configure Partial updates to enable GEOS-Chem dev/13.0.0 to build in CESM Signed-off-by: Lizzie Lundgren --- Externals_CAM.cfg | 4 +- bld/configure | 2 +- src/chemistry/pp_geoschem/.exclude | 46 +- src/chemistry/pp_geoschem/chemistry.F90 | 1024 +++++++++++------------ 4 files changed, 491 insertions(+), 585 deletions(-) diff --git a/Externals_CAM.cfg b/Externals_CAM.cfg index a6b4048f33..906d81c24c 100644 --- a/Externals_CAM.cfg +++ b/Externals_CAM.cfg @@ -29,8 +29,8 @@ required = True [geoschem] local_path = src/chemistry/pp_geoschem/geoschem_src protocol = git -tag = CESM -repo_url = https://github.com/fritzt/CESM2-GC_Src +branch = feature/13.0.0+CESM +repo_url = https://github.com/CESM-GC/geos-chem required = True [hemco] diff --git a/bld/configure b/bld/configure index 4540f09a90..459fda9916 100755 --- a/bld/configure +++ b/bld/configure @@ -2867,7 +2867,7 @@ sub write_filepath # until we figure out a better compile routine. print $fh "$camsrcdir/src/hemco/HEMCO/src/Core\n"; print $fh "$camsrcdir/src/hemco/HEMCO/src/Extensions\n"; - print $fh "$camsrcdir/src/hemco/HEMCO/src/Interfaces\n"; + print $fh "$camsrcdir/src/hemco/HEMCO/src/Interfaces/Shared\n"; } # -- Added by MSL - 1/2018 diff --git a/src/chemistry/pp_geoschem/.exclude b/src/chemistry/pp_geoschem/.exclude index 674cabfdd2..313c41158c 100644 --- a/src/chemistry/pp_geoschem/.exclude +++ b/src/chemistry/pp_geoschem/.exclude @@ -1,39 +1,23 @@ regrid_a2a_mod.F90 -transport_mod.F +transport_mod.F90 tpcore_window_mod.F90 -tpcore_bc_mod.F90 tpcore_fvdas_mod.F90 flexgrid_read_mod.F90 -geosfp_read_mod.F90 get_met_mod.F90 -merra2_read_mod.F90 -regrid_a2a_mod.F90 -restart_mod.F -pops_mod.F -diag49_mod.F -diag51_mod.F -diag03_mod.F -diag04_mod.F -diag1.F -diag20_mod.F -diag_2pm.F -diag3.F -diag41_mod.F -diag42_mod.F -diag48_mod.F -diag50_mod.F -diag51b_mod.F -diag53_mod.F -diag56_mod.F -diag63_mod.F +pops_mod.F90 +planeflight_mod.F90 +diag51_mod.F90 +diag1.F90 +diag03_mod.F90 +diag3.F90 +diag51b_mod.F90 +diag53_mod.F90 emissions_mod.F90 -diag3.F -hcoi_gc_main_mod.F90 -gamap_mod.F -initialize.F -input_mod.F -cleanup.F -main.F +gamap_mod.F90 +initialize.F90 +input_mod.F90 +cleanup.F90 +main.F90 hcoi_gc_diagn_include.H hcoi_gc_diagn_mod.F90 -hcoi_gc_main_mod.F90 \ No newline at end of file +hco_interface_gc_mod.F90 \ No newline at end of file diff --git a/src/chemistry/pp_geoschem/chemistry.F90 b/src/chemistry/pp_geoschem/chemistry.F90 index caea37321e..2914f1ae38 100644 --- a/src/chemistry/pp_geoschem/chemistry.F90 +++ b/src/chemistry/pp_geoschem/chemistry.F90 @@ -212,591 +212,588 @@ subroutine chem_register IO%RootCPU = .False. - CALL Set_Input_Opt( am_I_Root = .False., & - Input_Opt = IO, & + CALL Set_Input_Opt( Am_I_Root = MasterProc, & + INPUT_OPT = IO, & RC = RC ) - if(masterproc) write(iulog,*) 'GCCALL after Set_Input_Opt' + IF(MASTERPROC) WRITE(IULOG,*) 'GCCALL AFTER SET_INPUT_OPT' IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Could not generate reference input options object!' - CALL Error_Stop( ErrMsg, ThisLoc ) + ERRMSG = 'COULD NOT GENERATE REFERENCE INPUT OPTIONS OBJECT!' + CALL ERROR_STOP( ERRMSG, THISLOC ) ENDIF - ! Options needed by Init_State_Chm - IO%ITS_A_FULLCHEM_SIM = .True. - IO%LLinoz = .True. - IO%LUCX = .True. - IO%LPRT = .False. - IO%N_Advect = nTracers - DO I = 1, nTracers - IO%AdvectSpc_Name(I) = TRIM(tracerNames(I)) + ! OPTIONS NEEDED BY INIT_STATE_CHM + IO%ITS_A_FULLCHEM_SIM = .TRUE. + IO%LLINOZ = .TRUE. + IO%LUCX = .TRUE. + IO%LPRT = .FALSE. + IO%N_ADVECT = NTRACERS + DO I = 1, NTRACERS + IO%ADVECTSPC_NAME(I) = TRIM(TRACERNAMES(I)) ENDDO - IO%SalA_rEdge_um(1) = 0.01e+0_fp - IO%SalA_rEdge_um(2) = 0.50e+0_fp - IO%SalC_rEdge_um(1) = 0.50e+0_fp - IO%SalC_rEdge_um(2) = 8.00e+0_fp + IO%SALA_REDGE_UM(1) = 0.01E+0_FP + IO%SALA_REDGE_UM(2) = 0.50E+0_FP + IO%SALC_REDGE_UM(1) = 0.50E+0_FP + IO%SALC_REDGE_UM(2) = 8.00E+0_FP - ! Prevent reporting - IO%rootCPU = .False. - IO%myCPU = myCPU + ! PREVENT REPORTING + IO%ROOTCPU = .FALSE. + IO%MYCPU = MYCPU - CALL Init_State_Grid( am_I_Root = .False., & - State_Grid = SG , & + CALL INIT_STATE_GRID( STATE_GRID = SG , & RC = RC ) IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Error encountered within call to "Init_State_Grid"!' - CALL Error_Stop( ErrMsg, ThisLoc ) + ERRMSG = 'ERROR ENCOUNTERED WITHIN CALL TO "INIT_STATE_GRID"!' + CALL ERROR_STOP( ERRMSG, THISLOC ) ENDIF SG%NX = 1 SG%NY = 1 SG%NZ = 1 - CALL Init_State_Chm( am_I_Root = .False., & - Input_Opt = IO, & - State_Chm = SC, & - State_Grid = SG, & + CALL INIT_STATE_CHM( INPUT_OPT = IO, & + STATE_CHM = SC, & + STATE_GRID = SG, & RC = RC ) IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Error encountered within call to "Init_State_Chm"!' - CALL Error_Stop( ErrMsg, ThisLoc ) + ERRMSG = 'ERROR ENCOUNTERED WITHIN CALL TO "INIT_STATE_CHM"!' + CALL ERROR_STOP( ERRMSG, THISLOC ) ENDIF - ! At the moment, we force nadv_chem=200 in the setup file - ! Default - map2GC = -1 - ref_MMR(:) = 0.0e+0_r8 - MWRatio(:) = 1.0e+0_r8 - tracerLongNames = '' - - DO I = 1, nTracersMax - IF (I.LE.nTracers) THEN - N = Ind_(tracerNames(I)) - ThisSpc => SC%SpcData(N)%Info - lng_Name = TRIM(ThisSpc%FullName) - MWTmp = REAL(ThisSpc%MW_g,r8) - ref_VMR = REAL(ThisSpc%BackgroundVV,r8) - adv_Mass(I) = MWTmp - ref_MMR(I) = ref_VMR / (MWDry / MWTmp) + ! AT THE MOMENT, WE FORCE NADV_CHEM=200 IN THE SETUP FILE + ! DEFAULT + MAP2GC = -1 + REF_MMR(:) = 0.0E+0_R8 + MWRATIO(:) = 1.0E+0_R8 + TRACERLONGNAMES = '' + + DO I = 1, NTRACERSMAX + IF (I.LE.NTRACERS) THEN + N = IND_(TRACERNAMES(I)) + THISSPC => SC%SPCDATA(N)%INFO + LNG_NAME = TRIM(THISSPC%FULLNAME) + MWTMP = REAL(THISSPC%MW_G,R8) + REF_VMR = REAL(THISSPC%BACKGROUNDVV,R8) + ADV_MASS(I) = MWTMP + REF_MMR(I) = REF_VMR / (MWDRY / MWTMP) ELSE - lng_Name = TRIM(tracerNames(I)) - MWTmp = 1000.0e+0_r8 * (0.001e+0_r8) - adv_Mass(I) = MWTmp - ref_MMR(I) = 1.0e-38_r8 + LNG_NAME = TRIM(TRACERNAMES(I)) + MWTMP = 1000.0E+0_R8 * (0.001E+0_R8) + ADV_MASS(I) = MWTMP + REF_MMR(I) = 1.0E-38_R8 ENDIF - MWRatio(I) = MWDry/MWTmp - tracerLongNames(I) = TRIM(lng_Name) - - ! dummy value for specific heat of constant pressure (Cp) - cptmp = 666._r8 - ! minimum mixing ratio - qmin = 1.e-38_r8 - ! mixing ratio type - mixtype = 'dry' - ! Used for ionospheric WACCM (WACCM-X) - molectype = 'minor' - ! Is an output field (?) - camout = .false. - ! Not true for O2(1-delta) or O2(1-sigma) - ic_from_cam2 = .true. - ! Use a fixed value at the upper boundary - has_fixed_ubc = .false. - ! Use a fixed flux condition at the upper boundary - has_fixed_ubflx = .false. - !write(tracernames(i),'(a,I0.4)') 'GCTRC_', i - ! NOTE: In MOZART, this only gets called for tracers - ! This is the call to add a "constituent" - CALL cnst_add( TRIM(tracerNames(I)), adv_Mass(I), cptmp, qmin, N, & - readiv=ic_from_cam2, mixtype=mixtype, cam_outfld=camout, & - molectype=molectype, fixed_ubc=has_fixed_ubc, & - fixed_ubflx=has_fixed_ubflx, longname=TRIM(lng_Name) ) - - ! Add to GC mapping. When starting a timestep, we will want to update the - ! concentration of State_Chm(x)%Species(1,iCol,iLev,m) with data from - ! constituent n - M = Ind_(TRIM(tracerNames(I))) + MWRATIO(I) = MWDRY/MWTMP + TRACERLONGNAMES(I) = TRIM(LNG_NAME) + + ! DUMMY VALUE FOR SPECIFIC HEAT OF CONSTANT PRESSURE (CP) + CPTMP = 666._R8 + ! MINIMUM MIXING RATIO + QMIN = 1.E-38_R8 + ! MIXING RATIO TYPE + MIXTYPE = 'DRY' + ! USED FOR IONOSPHERIC WACCM (WACCM-X) + MOLECTYPE = 'MINOR' + ! IS AN OUTPUT FIELD (?) + CAMOUT = .FALSE. + ! NOT TRUE FOR O2(1-DELTA) OR O2(1-SIGMA) + IC_FROM_CAM2 = .TRUE. + ! USE A FIXED VALUE AT THE UPPER BOUNDARY + HAS_FIXED_UBC = .FALSE. + ! USE A FIXED FLUX CONDITION AT THE UPPER BOUNDARY + HAS_FIXED_UBFLX = .FALSE. + !WRITE(TRACERNAMES(I),'(A,I0.4)') 'GCTRC_', I + ! NOTE: IN MOZART, THIS ONLY GETS CALLED FOR TRACERS + ! THIS IS THE CALL TO ADD A "CONSTITUENT" + CALL CNST_ADD( TRIM(TRACERNAMES(I)), ADV_MASS(I), CPTMP, QMIN, N, & + READIV=IC_FROM_CAM2, MIXTYPE=MIXTYPE, CAM_OUTFLD=CAMOUT, & + MOLECTYPE=MOLECTYPE, FIXED_UBC=HAS_FIXED_UBC, & + FIXED_UBFLX=HAS_FIXED_UBFLX, LONGNAME=TRIM(LNG_NAME) ) + + ! ADD TO GC MAPPING. WHEN STARTING A TIMESTEP, WE WILL WANT TO UPDATE THE + ! CONCENTRATION OF STATE_CHM(X)%SPECIES(1,ICOL,ILEV,M) WITH DATA FROM + ! CONSTITUENT N + M = IND_(TRIM(TRACERNAMES(I))) IF ( M > 0 ) THEN - map2GC(N) = M - map2Idx(N) = I + MAP2GC(N) = M + MAP2IDX(N) = I ENDIF - ! Nullify pointer - ThisSpc => NULL() + ! NULLIFY POINTER + THISSPC => NULL() ENDDO - ! Now unadvected species - map2GC_Sls = 0 - sls_ref_MMR(:) = 0.0e+0_r8 - SlsMWRatio(:) = -1.0e+0_r8 - slsLongNames = '' - DO I = 1, nSls - N = Ind_(slsNames(I)) + ! NOW UNADVECTED SPECIES + MAP2GC_SLS = 0 + SLS_REF_MMR(:) = 0.0E+0_R8 + SLSMWRATIO(:) = -1.0E+0_R8 + SLSLONGNAMES = '' + DO I = 1, NSLS + N = IND_(SLSNAMES(I)) IF ( N .GT. 0 ) THEN - ThisSpc => SC%SpcData(N)%Info - MWTmp = REAL(ThisSpc%MW_g,r8) - ref_VMR = REAL(ThisSpc%BackgroundVV,r8) - lng_Name = TRIM(ThisSpc%FullName) - slsLongNames(I) = lng_Name - sls_ref_MMR(I) = ref_VMR / (MWDry / MWTmp) - SlsMWRatio(I) = MWDry / MWTmp - map2GC_Sls(I) = N - ThisSpc => NULL() + THISSPC => SC%SPCDATA(N)%INFO + MWTMP = REAL(THISSPC%MW_G,R8) + REF_VMR = REAL(THISSPC%BACKGROUNDVV,R8) + LNG_NAME = TRIM(THISSPC%FULLNAME) + SLSLONGNAMES(I) = LNG_NAME + SLS_REF_MMR(I) = REF_VMR / (MWDRY / MWTMP) + SLSMWRATIO(I) = MWDRY / MWTMP + MAP2GC_SLS(I) = N + THISSPC => NULL() ENDIF ENDDO - ! Pass information to "short_lived_species" module - slvd_ref_MMR(1:nSls) = sls_ref_MMR(1:nSls) - CALL Register_Short_Lived_Species() - ! More information: - ! http://www.cesm.ucar.edu/models/atm-cam/docs/phys-interface/node5.html + ! PASS INFORMATION TO "SHORT_LIVED_SPECIES" MODULE + SLVD_REF_MMR(1:NSLS) = SLS_REF_MMR(1:NSLS) + CALL REGISTER_SHORT_LIVED_SPECIES() + ! MORE INFORMATION: + ! HTTP://WWW.CESM.UCAR.EDU/MODELS/ATM-CAM/DOCS/PHYS-INTERFACE/NODE5.HTML - ! Clean up - Call Cleanup_State_Chm ( .False., SC, RC ) - Call Cleanup_State_Grid( .False., SG, RC ) - Call Cleanup_Input_Opt ( .False., IO, RC ) + ! CLEAN UP + CALL CLEANUP_STATE_CHM ( .FALSE., SC, RC ) + CALL CLEANUP_STATE_GRID( .FALSE., SG, RC ) + CALL CLEANUP_INPUT_OPT ( .FALSE., IO, RC ) - end subroutine chem_register + END SUBROUTINE CHEM_REGISTER - subroutine chem_readnl(nlfile) - ! This is the FIRST routine to get called - so it should read in - ! GEOS-Chem options from input.geos without actually doing any - ! initialization + SUBROUTINE CHEM_READNL(NLFILE) + ! THIS IS THE FIRST ROUTINE TO GET CALLED - SO IT SHOULD READ IN + ! GEOS-CHEM OPTIONS FROM INPUT.GEOS WITHOUT ACTUALLY DOING ANY + ! INITIALIZATION - use cam_abortutils, only : endrun - use units, only : getunit, freeunit - use mpishorthand - use gckpp_Model, only : nSpec, Spc_Names - use mo_chem_utls, only : get_spc_ndx - use chem_mods, only : drySpc_ndx + USE CAM_ABORTUTILS, ONLY : ENDRUN + USE UNITS, ONLY : GETUNIT, FREEUNIT + USE MPISHORTHAND + USE GCKPP_MODEL, ONLY : NSPEC, SPC_NAMES + USE MO_CHEM_UTLS, ONLY : GET_SPC_NDX + USE CHEM_MODS, ONLY : DRYSPC_NDX - ! args - CHARACTER(LEN=*), INTENT(IN) :: nlfile ! filepath for file containing namelist input + ! ARGS + CHARACTER(LEN=*), INTENT(IN) :: NLFILE ! FILEPATH FOR FILE CONTAINING NAMELIST INPUT - ! Local variables - INTEGER :: I, N, nIgnored + ! LOCAL VARIABLES + INTEGER :: I, N, NIGNORED INTEGER :: UNITN, IERR - CHARACTER(LEN=500) :: line - LOGICAL :: menuFound - LOGICAL :: validSLS - -#if ( OCNDDVEL_MOZART ) - namelist /chem_inparm/ MOZART_depvel_lnd_file, & - MOZART_clim_soilw_file, & - MOZART_season_wes_file -#endif - - nIgnored = 0 - - ! Set paths - ! MIT path - !inputGeosPath='/home/fritzt/input.geos.template' - !chemInputsDir='/net/d06/data/GCdata/ExtData/CHEM_INPUTS/' - ! Cheyenne path - inputGeosPath='/glade/u/home/fritzt/input.geos.template' - chemInputsDir='/glade/p/univ/umit0034/ExtData/CHEM_INPUTS/' - - -#if ( ALLDDVEL_GEOSCHEM + OCNDDVEL_GEOSCHEM + OCNDDVEL_MOZART != 1 ) - IF (MasterProc) THEN - Write(iulog,'(/,a)') REPEAT( "=", 79 ) - Write(iulog,'(a)') " Preprocessor flags are not set correctly in chemistry.F90" - Write(iulog,'(a)') " The user needs to decide how to compute dry deposition velocities" - Write(iulog,'(a)') " Three options appear: " - Write(iulog,'(a)') " + Let GEOS-Chem calculate all dry deposition velocities." - Write(iulog,'(a)') " Required setup:" - Write(iulog,'(a)') " ALLDDVEL_GEOSCHEM == 1" - Write(iulog,'(a)') " OCNDDVEL_GEOSCHEM == 0" - Write(iulog,'(a)') " OCNDDVEL_MOZART == 0" - Write(iulog,'(a)') " + Let CLM compute dry deposition velocities over land and let" - Write(iulog,'(a)') " GEOS-Chem compute velocities over ocean and ice" - Write(iulog,'(a)') " Required setup:" - Write(iulog,'(a)') " ALLDDVEL_GEOSCHEM == 0" - Write(iulog,'(a)') " OCNDDVEL_GEOSCHEM == 1" - Write(iulog,'(a)') " OCNDDVEL_MOZART == 0" - Write(iulog,'(a)') " + Let CLM compute dry deposition velocities over land and" - Write(iulog,'(a)') " compute velocities over ocean and ice in a similar way as" - Write(iulog,'(a)') " MOZART" - Write(iulog,'(a)') " Required setup:" - Write(iulog,'(a)') " ALLDDVEL_GEOSCHEM == 0" - Write(iulog,'(a)') " OCNDDVEL_GEOSCHEM == 0" - Write(iulog,'(a)') " OCNDDVEL_MOZART == 1" - Write(iulog,'(a)') REPEAT( "=", 79 ) - CALL ENDRUN('Incorrect definitions for dry deposition velocities') + CHARACTER(LEN=500) :: LINE + LOGICAL :: MENUFOUND + LOGICAL :: VALIDSLS + +#IF ( OCNDDVEL_MOZART ) + NAMELIST /CHEM_INPARM/ MOZART_DEPVEL_LND_FILE, & + MOZART_CLIM_SOILW_FILE, & + MOZART_SEASON_WES_FILE +#ENDIF + + NIGNORED = 0 + + ! SET PATHS + ! MIT PATH + !INPUTGEOSPATH='/HOME/FRITZT/INPUT.GEOS.TEMPLATE' + !CHEMINPUTSDIR='/NET/D06/DATA/GCDATA/EXTDATA/CHEM_INPUTS/' + ! CHEYENNE PATH + INPUTGEOSPATH='/GLADE/U/HOME/FRITZT/INPUT.GEOS.TEMPLATE' + CHEMINPUTSDIR='/GLADE/P/UNIV/UMIT0034/EXTDATA/CHEM_INPUTS/' + + +#IF ( ALLDDVEL_GEOSCHEM + OCNDDVEL_GEOSCHEM + OCNDDVEL_MOZART != 1 ) + IF (MASTERPROC) THEN + WRITE(IULOG,'(/,A)') REPEAT( "=", 79 ) + WRITE(IULOG,'(A)') " PREPROCESSOR FLAGS ARE NOT SET CORRECTLY IN CHEMISTRY.F90" + WRITE(IULOG,'(A)') " THE USER NEEDS TO DECIDE HOW TO COMPUTE DRY DEPOSITION VELOCITIES" + WRITE(IULOG,'(A)') " THREE OPTIONS APPEAR: " + WRITE(IULOG,'(A)') " + LET GEOS-CHEM CALCULATE ALL DRY DEPOSITION VELOCITIES." + WRITE(IULOG,'(A)') " REQUIRED SETUP:" + WRITE(IULOG,'(A)') " ALLDDVEL_GEOSCHEM == 1" + WRITE(IULOG,'(A)') " OCNDDVEL_GEOSCHEM == 0" + WRITE(IULOG,'(A)') " OCNDDVEL_MOZART == 0" + WRITE(IULOG,'(A)') " + LET CLM COMPUTE DRY DEPOSITION VELOCITIES OVER LAND AND LET" + WRITE(IULOG,'(A)') " GEOS-CHEM COMPUTE VELOCITIES OVER OCEAN AND ICE" + WRITE(IULOG,'(A)') " REQUIRED SETUP:" + WRITE(IULOG,'(A)') " ALLDDVEL_GEOSCHEM == 0" + WRITE(IULOG,'(A)') " OCNDDVEL_GEOSCHEM == 1" + WRITE(IULOG,'(A)') " OCNDDVEL_MOZART == 0" + WRITE(IULOG,'(A)') " + LET CLM COMPUTE DRY DEPOSITION VELOCITIES OVER LAND AND" + WRITE(IULOG,'(A)') " COMPUTE VELOCITIES OVER OCEAN AND ICE IN A SIMILAR WAY AS" + WRITE(IULOG,'(A)') " MOZART" + WRITE(IULOG,'(A)') " REQUIRED SETUP:" + WRITE(IULOG,'(A)') " ALLDDVEL_GEOSCHEM == 0" + WRITE(IULOG,'(A)') " OCNDDVEL_GEOSCHEM == 0" + WRITE(IULOG,'(A)') " OCNDDVEL_MOZART == 1" + WRITE(IULOG,'(A)') REPEAT( "=", 79 ) + CALL ENDRUN('INCORRECT DEFINITIONS FOR DRY DEPOSITION VELOCITIES') ENDIF -#endif -#if ( ALLDDVEL_GEOSCHEM && ( LANDTYPE_HEMCO + LANDTYPE_CLM != 1 ) ) - IF (MasterProc) THEN - Write(iulog,'(/,a)') REPEAT( "=", 79 ) - Write(iulog,'(a)') REPEAT( "=", 79 ) - Write(iulog,'(a)') " Preprocessor flags are not set correctly in chemistry.F90" - Write(iulog,'(a)') " Dry-deposition velocities are computed by GEOS-Chem" - Write(iulog,'(a)') " The user needs to decide if land types should be from CLM or from HEMCO" - CALL ENDRUN('Incorrect definitions for source of land type data') +#ENDIF +#IF ( ALLDDVEL_GEOSCHEM && ( LANDTYPE_HEMCO + LANDTYPE_CLM != 1 ) ) + IF (MASTERPROC) THEN + WRITE(IULOG,'(/,A)') REPEAT( "=", 79 ) + WRITE(IULOG,'(A)') REPEAT( "=", 79 ) + WRITE(IULOG,'(A)') " PREPROCESSOR FLAGS ARE NOT SET CORRECTLY IN CHEMISTRY.F90" + WRITE(IULOG,'(A)') " DRY-DEPOSITION VELOCITIES ARE COMPUTED BY GEOS-CHEM" + WRITE(IULOG,'(A)') " THE USER NEEDS TO DECIDE IF LAND TYPES SHOULD BE FROM CLM OR FROM HEMCO" + CALL ENDRUN('INCORRECT DEFINITIONS FOR SOURCE OF LAND TYPE DATA') ENDIF -#endif +#ENDIF - ALLOCATE(drySpc_ndx(nddvels), STAT=IERR) - IF ( IERR .NE. 0 ) CALL ENDRUN('Failed to allocate drySpc_ndx') + ALLOCATE(DRYSPC_NDX(NDDVELS), STAT=IERR) + IF ( IERR .NE. 0 ) CALL ENDRUN('FAILED TO ALLOCATE DRYSPC_NDX') - IF (MasterProc) THEN + IF (MASTERPROC) THEN - Write(iulog,'(/,a)') REPEAT( '=', 50 ) - Write(iulog,'(a)') REPEAT( '=', 50 ) - Write(iulog,'(a)') 'This is the GEOS-CHEM / CESM interface' - Write(iulog,'(a)') REPEAT( '=', 50 ) - Write(iulog,'(a)') ' + Routines written by Thibaud M. Fritz' - Write(iulog,'(a)') ' + Laboratory for Aviation and the Environment,' - Write(iulog,'(a)') ' + Department of Aeronautics and Astronautics,' - Write(iulog,'(a)') ' + Massachusetts Institute of Technology' - Write(iulog,'(a)') REPEAT( '=', 50 ) + WRITE(IULOG,'(/,A)') REPEAT( '=', 50 ) + WRITE(IULOG,'(A)') REPEAT( '=', 50 ) + WRITE(IULOG,'(A)') 'THIS IS THE GEOS-CHEM / CESM INTERFACE' + WRITE(IULOG,'(A)') REPEAT( '=', 50 ) + WRITE(IULOG,'(A)') ' + ROUTINES WRITTEN BY THIBAUD M. FRITZ' + WRITE(IULOG,'(A)') ' + LABORATORY FOR AVIATION AND THE ENVIRONMENT,' + WRITE(IULOG,'(A)') ' + DEPARTMENT OF AERONAUTICS AND ASTRONAUTICS,' + WRITE(IULOG,'(A)') ' + MASSACHUSETTS INSTITUTE OF TECHNOLOGY' + WRITE(IULOG,'(A)') REPEAT( '=', 50 ) - Write(iulog,'(/,/, a)') 'Now defining GEOS-Chem tracers and dry deposition mapping...' + WRITE(IULOG,'(/,/, A)') 'NOW DEFINING GEOS-CHEM TRACERS AND DRY DEPOSITION MAPPING...' UNITN = GETUNIT() !============================================================== - ! Opening input.geos and go to ADVECTED SPECIES MENU + ! OPENING INPUT.GEOS AND GO TO ADVECTED SPECIES MENU !============================================================== - OPEN( UNITN, FILE=TRIM(inputGeosPath), STATUS='OLD', IOSTAT=IERR ) + OPEN( UNITN, FILE=TRIM(INPUTGEOSPATH), STATUS='OLD', IOSTAT=IERR ) IF (IERR .NE. 0) THEN - CALL ENDRUN('chem_readnl: ERROR opening input.geos') + CALL ENDRUN('CHEM_READNL: ERROR OPENING INPUT.GEOS') ENDIF - ! Go to ADVECTED SPECIES MENU - menuFound = .False. - DO WHILE ( .NOT. menuFound ) - READ( UNITN, '(a)', IOSTAT=IERR ) line + ! GO TO ADVECTED SPECIES MENU + MENUFOUND = .FALSE. + DO WHILE ( .NOT. MENUFOUND ) + READ( UNITN, '(A)', IOSTAT=IERR ) LINE IF ( IERR .NE. 0 ) THEN - CALL ENDRUN('chem_readnl: ERROR finding advected species menu') - ELSEIF ( INDEX(line, 'ADVECTED SPECIES MENU') > 0 ) THEN - menuFound = .True. + CALL ENDRUN('CHEM_READNL: ERROR FINDING ADVECTED SPECIES MENU') + ELSEIF ( INDEX(LINE, 'ADVECTED SPECIES MENU') > 0 ) THEN + MENUFOUND = .TRUE. ENDIF ENDDO !============================================================== - ! Read list of GEOS-Chem tracers + ! READ LIST OF GEOS-CHEM TRACERS !============================================================== DO - ! Read line - READ(UNITN,'(26x,a)', IOSTAT=IERR) line + ! READ LINE + READ(UNITN,'(26X,A)', IOSTAT=IERR) LINE - IF ( INDEX( TRIM(line), '---' ) > 0 ) EXIT + IF ( INDEX( TRIM(LINE), '---' ) > 0 ) EXIT - nTracers = nTracers + 1 - tracerNames(nTracers) = TRIM(line) + NTRACERS = NTRACERS + 1 + TRACERNAMES(NTRACERS) = TRIM(LINE) ENDDO CLOSE(UNITN) CALL FREEUNIT(UNITN) - ! Assign remaining tracers dummy names - DO I = (nTracers+1), nTracersMax - WRITE(tracerNames(I),'(a,I0.4)') 'GCTRC_', I + ! ASSIGN REMAINING TRACERS DUMMY NAMES + DO I = (NTRACERS+1), NTRACERSMAX + WRITE(TRACERNAMES(I),'(A,I0.4)') 'GCTRC_', I ENDDO !============================================================== - ! Now go through the KPP mechanism and add any species not - ! implemented by the tracer list in input.geos + ! NOW GO THROUGH THE KPP MECHANISM AND ADD ANY SPECIES NOT + ! IMPLEMENTED BY THE TRACER LIST IN INPUT.GEOS !============================================================== - IF ( nSpec > nSlsMax ) THEN - CALL ENDRUN('chem_readnl: too many species - increase nSlsmax') + IF ( NSPEC > NSLSMAX ) THEN + CALL ENDRUN('CHEM_READNL: TOO MANY SPECIES - INCREASE NSLSMAX') ENDIF - nSls = 0 - DO I = 1, nSpec - ! Get the name of the species from KPP - line = ADJUSTL(TRIM(Spc_Names(I))) - ! Only add this - validSLS = ( .NOT. ANY(TRIM(line) .EQ. tracerNames) ) - IF (validSLS) THEN - ! Genuine new short-lived species - nSls = nSls + 1 - slsNames(nSls) = TRIM(line) + NSLS = 0 + DO I = 1, NSPEC + ! GET THE NAME OF THE SPECIES FROM KPP + LINE = ADJUSTL(TRIM(SPC_NAMES(I))) + ! ONLY ADD THIS + VALIDSLS = ( .NOT. ANY(TRIM(LINE) .EQ. TRACERNAMES) ) + IF (VALIDSLS) THEN + ! GENUINE NEW SHORT-LIVED SPECIES + NSLS = NSLS + 1 + SLSNAMES(NSLS) = TRIM(LINE) ENDIF ENDDO !============================================================== - ! Get mapping between dry deposition species and species set + ! GET MAPPING BETWEEN DRY DEPOSITION SPECIES AND SPECIES SET !============================================================== - DO N = 1, nddvels + DO N = 1, NDDVELS - ! The species names need to be convert to upper case as, - ! for instance, BR2 != Br2 - drySpc_ndx(N) = get_spc_ndx( to_upper(drydep_list(N)) ) + ! THE SPECIES NAMES NEED TO BE CONVERT TO UPPER CASE AS, + ! FOR INSTANCE, BR2 != BR2 + DRYSPC_NDX(N) = GET_SPC_NDX( TO_UPPER(DRYDEP_LIST(N)) ) - IF ( drySpc_ndx(N) < 0 ) THEN - Write(iulog,'(a,a)') ' ## Ignoring dry deposition of ', & - TRIM(drydep_list(N)) - nIgnored = nIgnored + 1 + IF ( DRYSPC_NDX(N) < 0 ) THEN + WRITE(IULOG,'(A,A)') ' ## IGNORING DRY DEPOSITION OF ', & + TRIM(DRYDEP_LIST(N)) + NIGNORED = NIGNORED + 1 ENDIF ENDDO - IF ( nIgnored > 0 ) THEN - Write(iulog,'(a,a)') ' The species listed above have dry', & - ' deposition turned off for one of the following reasons:' - Write(iulog,'(a)') ' - They are not present in the GEOS-Chem tracer list.' - Write(iulog,'(a)') ' - They have a synonym (e.g. CH2O and HCHO).' + IF ( NIGNORED > 0 ) THEN + WRITE(IULOG,'(A,A)') ' THE SPECIES LISTED ABOVE HAVE DRY', & + ' DEPOSITION TURNED OFF FOR ONE OF THE FOLLOWING REASONS:' + WRITE(IULOG,'(A)') ' - THEY ARE NOT PRESENT IN THE GEOS-CHEM TRACER LIST.' + WRITE(IULOG,'(A)') ' - THEY HAVE A SYNONYM (E.G. CH2O AND HCHO).' ENDIF !============================================================== - ! Print summary + ! PRINT SUMMARY !============================================================== - Write(iulog,'(/, a)') '### Summary of GEOS-Chem species: ' - Write(iulog,'( a)') REPEAT( '-', 50 ) - Write(iulog,'( a)') '+ List of advected species: ' - Write(iulog,100) 'ID', 'Tracer', 'Dry deposition (T/F)' - DO N = 1, nTracers - WRITE(iulog,110) N, TRIM(tracerNames(N)), any(drySpc_ndx .eq. N) + WRITE(IULOG,'(/, A)') '### SUMMARY OF GEOS-CHEM SPECIES: ' + WRITE(IULOG,'( A)') REPEAT( '-', 50 ) + WRITE(IULOG,'( A)') '+ LIST OF ADVECTED SPECIES: ' + WRITE(IULOG,100) 'ID', 'TRACER', 'DRY DEPOSITION (T/F)' + DO N = 1, NTRACERS + WRITE(IULOG,110) N, TRIM(TRACERNAMES(N)), ANY(DRYSPC_NDX .EQ. N) ENDDO - Write(iulog,'(/, a)') '+ List of short-lived species: ' - DO N = 1, nSls - WRITE(iulog,120) N, TRIM(slsNames(N)) + WRITE(IULOG,'(/, A)') '+ LIST OF SHORT-LIVED SPECIES: ' + DO N = 1, NSLS + WRITE(IULOG,120) N, TRIM(SLSNAMES(N)) ENDDO - 100 FORMAT( 1x, A3, 3x, A10, 1x, A25 ) - 110 FORMAT( 1x, I3, 3x, A10, 1x, L15 ) - 120 FORMAT( 1x, I3, 3x, A10 ) + 100 FORMAT( 1X, A3, 3X, A10, 1X, A25 ) + 110 FORMAT( 1X, I3, 3X, A10, 1X, L15 ) + 120 FORMAT( 1X, I3, 3X, A10 ) !============================================================== ENDIF !================================================================== - ! Broadcast to all processors + ! BROADCAST TO ALL PROCESSORS !================================================================== -#if defined( SPMD ) - CALL MPIBCAST(nTracers, 1, MPIINT, 0, MPICOM ) - CALL MPIBCAST(tracerNames, LEN(tracerNames(1))*nTracersMax, MPICHAR, 0, MPICOM ) - CALL MPIBCAST(nSls, 1, MPIINT, 0, MPICOM ) - CALL MPIBCAST(slsNames, LEN(slsNames(1))*nSlsMax, MPICHAR, 0, MPICOM ) - CALL MPIBCAST(drySpc_ndx, nddvels, MPIINT, 0, MPICOM ) +#IF DEFINED( SPMD ) + CALL MPIBCAST(NTRACERS, 1, MPIINT, 0, MPICOM ) + CALL MPIBCAST(TRACERNAMES, LEN(TRACERNAMES(1))*NTRACERSMAX, MPICHAR, 0, MPICOM ) + CALL MPIBCAST(NSLS, 1, MPIINT, 0, MPICOM ) + CALL MPIBCAST(SLSNAMES, LEN(SLSNAMES(1))*NSLSMAX, MPICHAR, 0, MPICOM ) + CALL MPIBCAST(DRYSPC_NDX, NDDVELS, MPIINT, 0, MPICOM ) -#if ( OCNDDVEL_MOZART ) +#IF ( OCNDDVEL_MOZART ) !============================================================== - ! The following lines should only be called if we compute - ! velocities over the ocean and ice in a MOZART-like way. - ! Thibaud M. Fritz - 26 Feb 2020 + ! THE FOLLOWING LINES SHOULD ONLY BE CALLED IF WE COMPUTE + ! VELOCITIES OVER THE OCEAN AND ICE IN A MOZART-LIKE WAY. + ! THIBAUD M. FRITZ - 26 FEB 2020 !============================================================== - CALL MPIBCAST(MOZART_depvel_lnd_file, LEN(MOZART_depvel_lnd_file), MPICHAR, 0, MPICOM) - CALL MPIBCAST(MOZART_clim_soilw_file, LEN(MOZART_clim_soilw_file), MPICHAR, 0, MPICOM) - CALL MPIBCAST(MOZART_season_wes_file, LEN(MOZART_season_wes_file), MPICHAR, 0, MPICOM) -#endif - -#endif - - ! Update "short_lived_species" arrays - will eventually unify these - nSlvd = nSls - ALLOCATE(slvd_Lst(nSlvd), STAT=IERR) - IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating slvd_Lst') - ALLOCATE(slvd_ref_MMR(nSlvd), STAT=IERR) - IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating slvd_ref_MMR') - DO I = 1, nSls - slvd_Lst(I) = TRIM(slsNames(I)) + CALL MPIBCAST(MOZART_DEPVEL_LND_FILE, LEN(MOZART_DEPVEL_LND_FILE), MPICHAR, 0, MPICOM) + CALL MPIBCAST(MOZART_CLIM_SOILW_FILE, LEN(MOZART_CLIM_SOILW_FILE), MPICHAR, 0, MPICOM) + CALL MPIBCAST(MOZART_SEASON_WES_FILE, LEN(MOZART_SEASON_WES_FILE), MPICHAR, 0, MPICOM) +#ENDIF + +#ENDIF + + ! UPDATE "SHORT_LIVED_SPECIES" ARRAYS - WILL EVENTUALLY UNIFY THESE + NSLVD = NSLS + ALLOCATE(SLVD_LST(NSLVD), STAT=IERR) + IF ( IERR .NE. 0 ) CALL ENDRUN('FAILURE WHILE ALLOCATING SLVD_LST') + ALLOCATE(SLVD_REF_MMR(NSLVD), STAT=IERR) + IF ( IERR .NE. 0 ) CALL ENDRUN('FAILURE WHILE ALLOCATING SLVD_REF_MMR') + DO I = 1, NSLS + SLVD_LST(I) = TRIM(SLSNAMES(I)) ENDDO - end subroutine chem_readnl + END SUBROUTINE CHEM_READNL !================================================================================================ - function chem_is_active() + FUNCTION CHEM_IS_ACTIVE() !----------------------------------------------------------------------- - logical :: chem_is_active + LOGICAL :: CHEM_IS_ACTIVE !----------------------------------------------------------------------- - chem_is_active = .true. + CHEM_IS_ACTIVE = .TRUE. - end function chem_is_active + END FUNCTION CHEM_IS_ACTIVE !================================================================================================ - function chem_implements_cnst(name) + FUNCTION CHEM_IMPLEMENTS_CNST(NAME) !----------------------------------------------------------------------- ! - ! Purpose: return true if specified constituent is implemented by this package + ! PURPOSE: RETURN TRUE IF SPECIFIED CONSTITUENT IS IMPLEMENTED BY THIS PACKAGE ! - ! Author: B. Eaton + ! AUTHOR: B. EATON ! !----------------------------------------------------------------------- IMPLICIT NONE - !-----------------------------Arguments--------------------------------- + !-----------------------------ARGUMENTS--------------------------------- - CHARACTER(LEN=*), INTENT(IN) :: name ! constituent name - LOGICAL :: chem_implements_cnst ! return value + CHARACTER(LEN=*), INTENT(IN) :: NAME ! CONSTITUENT NAME + LOGICAL :: CHEM_IMPLEMENTS_CNST ! RETURN VALUE INTEGER :: I - chem_implements_cnst = .false. + CHEM_IMPLEMENTS_CNST = .FALSE. - DO I = 1, nTracers - IF (TRIM(tracerNames(I)) .eq. TRIM(NAME)) THEN - chem_implements_cnst = .true. + DO I = 1, NTRACERS + IF (TRIM(TRACERNAMES(I)) .EQ. TRIM(NAME)) THEN + CHEM_IMPLEMENTS_CNST = .TRUE. EXIT ENDIF ENDDO - IF (MasterProc) WRITE(iulog,'(a)') 'GCCALL CHEM_IMPLEMENTS_CNST' + IF (MASTERPROC) WRITE(IULOG,'(A)') 'GCCALL CHEM_IMPLEMENTS_CNST' - end function chem_implements_cnst + END FUNCTION CHEM_IMPLEMENTS_CNST !=============================================================================== - subroutine chem_init(phys_state, pbuf2d) + SUBROUTINE CHEM_INIT(PHYS_STATE, PBUF2D) !----------------------------------------------------------------------- ! - ! Purpose: initialize GEOS-Chem parts (state objects, mainly) - ! (and declare history variables) + ! PURPOSE: INITIALIZE GEOS-CHEM PARTS (STATE OBJECTS, MAINLY) + ! (AND DECLARE HISTORY VARIABLES) ! !----------------------------------------------------------------------- - use physics_buffer, only: physics_buffer_desc, pbuf_get_index - use cam_history, only: addfld, add_default, horiz_only - use chem_mods, only: map2GC_dryDep, drySpc_ndx - - use mpishorthand - use cam_abortutils, only : endrun - - use Input_Opt_Mod - use State_Chm_Mod - use State_Grid_Mod - use State_Met_Mod - use DiagList_Mod, only : Init_DiagList, Print_DiagList - use GC_Environment_Mod - use GC_Grid_Mod, only : SetGridFromCtrEdges - - ! Use GEOS-Chem versions of physical constants - use PhysConstants, only : PI, PI_180 - use PhysConstants, only : Re - - use Phys_Grid, only : get_Area_All_p - use hycoef, only : ps0, hyai, hybi - - use Time_Mod, only : Accept_External_Date_Time - !use Time_Mod, only : Set_Begin_Time, Set_End_Time - !use Time_Mod, only : Set_Current_Time, Set_DiagB - !use Transfer_Mod, only : Init_Transfer - use Linoz_Mod, only : Linoz_Read - -#if ( OCNDDVEL_MOZART ) - use seq_drydep_mod, only: drydep_method, DD_XLND - use mo_drydep, only: drydep_inti -#endif - - use CMN_Size_Mod - - use Drydep_Mod, only : Init_Drydep, DepName, nDVZind - use Carbon_Mod, only : Init_Carbon - use Dust_Mod, only : Init_Dust - use Seasalt_Mod, only : Init_Seasalt - use Sulfate_Mod, only : Init_Sulfate - use Aerosol_Mod, only : Init_Aerosol - use WetScav_Mod, only : Init_WetScav - use TOMS_Mod, only : Init_TOMS - use Pressure_Mod, only : Init_Pressure, Accept_External_ApBp - use Chemistry_Mod, only : Init_Chemistry - use UCX_Mod, only : Init_UCX -#if ( ALLDDVEL_GEOSCHEM && LANDTYPE_HEMCO ) - use Olson_Landmap_Mod -#endif - use Mixing_Mod - - use PBL_Mix_Mod, only : Init_PBL_Mix - - use GC_Emissions_Mod, only : GC_Emissions_Init - - TYPE(physics_state), INTENT(IN):: phys_state(BEGCHUNK:ENDCHUNK) - TYPE(physics_buffer_desc), POINTER :: pbuf2d(:,:) - - ! Local variables + USE PHYSICS_BUFFER, ONLY: PHYSICS_BUFFER_DESC, PBUF_GET_INDEX + USE CAM_HISTORY, ONLY: ADDFLD, ADD_DEFAULT, HORIZ_ONLY + USE CHEM_MODS, ONLY: MAP2GC_DRYDEP, DRYSPC_NDX + + USE MPISHORTHAND + USE CAM_ABORTUTILS, ONLY : ENDRUN + + USE INPUT_OPT_MOD + USE STATE_CHM_MOD + USE STATE_GRID_MOD + USE STATE_MET_MOD + USE DIAGLIST_MOD, ONLY : INIT_DIAGLIST, PRINT_DIAGLIST + USE GC_ENVIRONMENT_MOD + USE GC_GRID_MOD, ONLY : SETGRIDFROMCTREDGES + + ! USE GEOS-CHEM VERSIONS OF PHYSICAL CONSTANTS + USE PHYSCONSTANTS, ONLY : PI, PI_180 + USE PHYSCONSTANTS, ONLY : RE + + USE PHYS_GRID, ONLY : GET_AREA_ALL_P + USE HYCOEF, ONLY : PS0, HYAI, HYBI + + USE TIME_MOD, ONLY : ACCEPT_EXTERNAL_DATE_TIME + !USE TIME_MOD, ONLY : SET_BEGIN_TIME, SET_END_TIME + !USE TIME_MOD, ONLY : SET_CURRENT_TIME, SET_DIAGB + !USE TRANSFER_MOD, ONLY : INIT_TRANSFER + USE LINOZ_MOD, ONLY : LINOZ_READ + +#IF ( OCNDDVEL_MOZART ) + USE SEQ_DRYDEP_MOD, ONLY: DRYDEP_METHOD, DD_XLND + USE MO_DRYDEP, ONLY: DRYDEP_INTI +#ENDIF + + USE CMN_SIZE_MOD + + USE DRYDEP_MOD, ONLY : INIT_DRYDEP, DEPNAME, NDVZIND + USE CARBON_MOD, ONLY : INIT_CARBON + USE DUST_MOD, ONLY : INIT_DUST + USE SEASALT_MOD, ONLY : INIT_SEASALT + USE SULFATE_MOD, ONLY : INIT_SULFATE + USE AEROSOL_MOD, ONLY : INIT_AEROSOL + USE WETSCAV_MOD, ONLY : INIT_WETSCAV + USE PRESSURE_MOD, ONLY : INIT_PRESSURE, ACCEPT_EXTERNAL_APBP + USE CHEMISTRY_MOD, ONLY : INIT_CHEMISTRY + USE UCX_MOD, ONLY : INIT_UCX +#IF ( ALLDDVEL_GEOSCHEM && LANDTYPE_HEMCO ) + USE OLSON_LANDMAP_MOD +#ENDIF + USE MIXING_MOD + + USE PBL_MIX_MOD, ONLY : INIT_PBL_MIX + + USE GC_EMISSIONS_MOD, ONLY : GC_EMISSIONS_INIT + + TYPE(PHYSICS_STATE), INTENT(IN):: PHYS_STATE(BEGCHUNK:ENDCHUNK) + TYPE(PHYSICS_BUFFER_DESC), POINTER :: PBUF2D(:,:) + + ! LOCAL VARIABLES !---------------------------- - ! Scalars + ! SCALARS !---------------------------- - ! Integers + ! INTEGERS INTEGER :: LCHNK(BEGCHUNK:ENDCHUNK), NCOL(BEGCHUNK:ENDCHUNK) INTEGER :: IWAIT, IERR - INTEGER :: nX, nY, nZ - INTEGER :: iX, jY + INTEGER :: NX, NY, NZ + INTEGER :: IX, JY INTEGER :: I, J, L, N INTEGER :: RC INTEGER :: NLINOZ - ! Logicals - LOGICAL :: am_I_Root, rootChunk - LOGICAL :: prtDebug + ! LOGICALS + LOGICAL :: ROOTCHUNK + LOGICAL :: PRTDEBUG - ! Strings - CHARACTER(LEN=255) :: historyConfigFile - CHARACTER(LEN=255) :: SpcName + ! STRINGS + CHARACTER(LEN=255) :: HISTORYCONFIGFILE + CHARACTER(LEN=255) :: SPCNAME - ! Grid setup - REAL(fp) :: lonVal, latVal - REAL(fp) :: dLonFix, dLatFix - REAL(f4), ALLOCATABLE :: lonMidArr(:,:), latMidArr(:,:) - REAL(f4), ALLOCATABLE :: lonEdgeArr(:,:), latEdgeArr(:,:) - REAL(r8), ALLOCATABLE :: linozData(:,:,:,:) + ! GRID SETUP + REAL(FP) :: LONVAL, LATVAL + REAL(FP) :: DLONFIX, DLATFIX + REAL(F4), ALLOCATABLE :: LONMIDARR(:,:), LATMIDARR(:,:) + REAL(F4), ALLOCATABLE :: LONEDGEARR(:,:), LATEDGEARR(:,:) + REAL(R8), ALLOCATABLE :: LINOZDATA(:,:,:,:) - REAL(r8), ALLOCATABLE :: Col_Area(:) - REAL(fp), ALLOCATABLE :: Ap_CAM_Flip(:), Bp_CAM_Flip(:) + REAL(R8), ALLOCATABLE :: COL_AREA(:) + REAL(FP), ALLOCATABLE :: AP_CAM_FLIP(:), BP_CAM_FLIP(:) - REAL(r8), POINTER :: SlsPtr(:,:,:) + REAL(R8), POINTER :: SLSPTR(:,:,:) - ! Assume a successful return until otherwise + ! ASSUME A SUCCESSFUL RETURN UNTIL OTHERWISE RC = GC_SUCCESS - ! For error trapping - ErrMsg = '' - ThisLoc = ' -> at GEOS-Chem (in chemistry/pp_geoschem/chemistry.F90)' + ! FOR ERROR TRAPPING + ERRMSG = '' + THISLOC = ' -> AT GEOS-CHEM (IN CHEMISTRY/PP_GEOSCHEM/CHEMISTRY.F90)' - ! LCHNK: which chunks we have on this process + ! LCHNK: WHICH CHUNKS WE HAVE ON THIS PROCESS LCHNK = PHYS_STATE%LCHNK - ! NCOL: number of atmospheric columns for each chunk + ! NCOL: NUMBER OF ATMOSPHERIC COLUMNS FOR EACH CHUNK NCOL = PHYS_STATE%NCOL - write(iulog,'(2(a,x,I6,x))') 'chem_init called on PE ', myCPU, ' of ', nCPUs - - ! The GEOS-Chem grids on every "chunk" will all be the same size, to avoid - ! the possibility of having differently-sized chunks - nX = 1 - !nY = MAXVAL(NCOL) - nY = PCOLS - nZ = PVER - - !! Add short lived speies to buffers - !CALL Pbuf_add_field(Trim(SLSBuffer),'global',dtype_r8,(/PCOLS,PVER,nSls/),Sls_Pbf_Idx) - !! Initialize - !ALLOCATE(SlsPtr(PCOLS,PVER,BEGCHUNK:ENDCHUNK), STAT=IERR) - !IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating SlsPtr') - !SlsPtr(:,:,:) = 0.0e+0_r8 - !DO I=1,nSls - ! SlsPtr(:,:,:) = sls_ref_MMR(I) - ! CALL pbuf_set_field(pbuf2d,Sls_Pbf_Idx,SlsPtr,start=(/1,1,i/),kount=(/PCOLS,PVER,1/)) + WRITE(IULOG,'(2(A,X,I6,X))') 'CHEM_INIT CALLED ON PE ', MYCPU, ' OF ', NCPUS + + ! THE GEOS-CHEM GRIDS ON EVERY "CHUNK" WILL ALL BE THE SAME SIZE, TO AVOID + ! THE POSSIBILITY OF HAVING DIFFERENTLY-SIZED CHUNKS + NX = 1 + !NY = MAXVAL(NCOL) + NY = PCOLS + NZ = PVER + + !! ADD SHORT LIVED SPEIES TO BUFFERS + !CALL PBUF_ADD_FIELD(TRIM(SLSBUFFER),'GLOBAL',DTYPE_R8,(/PCOLS,PVER,NSLS/),SLS_PBF_IDX) + !! INITIALIZE + !ALLOCATE(SLSPTR(PCOLS,PVER,BEGCHUNK:ENDCHUNK), STAT=IERR) + !IF ( IERR .NE. 0 ) CALL ENDRUN('FAILURE WHILE ALLOCATING SLSPTR') + !SLSPTR(:,:,:) = 0.0E+0_R8 + !DO I=1,NSLS + ! SLSPTR(:,:,:) = SLS_REF_MMR(I) + ! CALL PBUF_SET_FIELD(PBUF2D,SLS_PBF_IDX,SLSPTR,START=(/1,1,I/),KOUNT=(/PCOLS,PVER,1/)) !ENDDO - !DEALLOCATE(SlsPtr) - - ! This ensures that each process allocates everything needed for its chunks - ALLOCATE(State_Chm(BEGCHUNK:ENDCHUNK) , STAT=IERR) - IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating State_Chm') - ALLOCATE(State_Diag(BEGCHUNK:ENDCHUNK) , STAT=IERR) - IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating State_Diag') - ALLOCATE(State_Grid(BEGCHUNK:ENDCHUNK), STAT=IERR) - IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating State_Grid') - ALLOCATE(State_Met(BEGCHUNK:ENDCHUNK) , STAT=IERR) - IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating State_Met') - - ! Initialize fields of the Input Options object - CALL Set_Input_Opt( am_I_Root = MasterProc, & - Input_Opt = Input_Opt, & + !DEALLOCATE(SLSPTR) + + ! THIS ENSURES THAT EACH PROCESS ALLOCATES EVERYTHING NEEDED FOR ITS CHUNKS + ALLOCATE(STATE_CHM(BEGCHUNK:ENDCHUNK) , STAT=IERR) + IF ( IERR .NE. 0 ) CALL ENDRUN('FAILURE WHILE ALLOCATING STATE_CHM') + ALLOCATE(STATE_DIAG(BEGCHUNK:ENDCHUNK) , STAT=IERR) + IF ( IERR .NE. 0 ) CALL ENDRUN('FAILURE WHILE ALLOCATING STATE_DIAG') + ALLOCATE(STATE_GRID(BEGCHUNK:ENDCHUNK), STAT=IERR) + IF ( IERR .NE. 0 ) CALL ENDRUN('FAILURE WHILE ALLOCATING STATE_GRID') + ALLOCATE(STATE_MET(BEGCHUNK:ENDCHUNK) , STAT=IERR) + IF ( IERR .NE. 0 ) CALL ENDRUN('FAILURE WHILE ALLOCATING STATE_MET') + + ! INITIALIZE FIELDS OF THE INPUT OPTIONS OBJECT + CALL SET_INPUT_OPT( AM_I_ROOT = MASTERPROC, & + INPUT_OPT = INPUT_OPT, & RC = RC ) ! Set some basic flags @@ -809,12 +806,8 @@ subroutine chem_init(phys_state, pbuf2d) DO I = BEGCHUNK, ENDCHUNK - ! Only treat the first chunk as the "root" - am_I_Root = ((I.EQ.BEGCHUNK) .and. MasterProc) - ! Initialize fields of the Grid State object - CALL Init_State_Grid( am_I_Root = am_I_Root, & - State_Grid = State_Grid(I), & + CALL Init_State_Grid( State_Grid = State_Grid(I), & RC = RC ) IF ( RC /= GC_SUCCESS ) THEN @@ -827,8 +820,7 @@ subroutine chem_init(phys_state, pbuf2d) State_Grid(I)%NZ = nZ ! Initialize GEOS-Chem horizontal grid structure - CALL GC_Init_Grid( am_I_Root = am_I_Root, & - Input_Opt = Input_Opt, & + CALL GC_Init_Grid( Input_Opt = Input_Opt, & State_Grid = State_Grid(I), & RC = RC ) @@ -859,8 +851,7 @@ subroutine chem_init(phys_state, pbuf2d) ! Call the routine GC_Allocate_All (located in module file ! GeosCore/gc_environment_mod.F90) to allocate all lat/lon ! allocatable arrays used by GEOS-Chem. - CALL GC_Allocate_All ( am_I_Root = MasterProc, & - Input_Opt = Input_Opt, & + CALL GC_Allocate_All ( Input_Opt = Input_Opt, & State_Grid = State_Grid(BEGCHUNK), & value_I_Lo = 1, & value_J_Lo = 1, & @@ -884,8 +875,7 @@ subroutine chem_init(phys_state, pbuf2d) ! TODO: Mimic GEOS-Chem's reading of input options !IF (MasterProc) THEN - ! CALL Read_Input_File( am_I_Root = .True., & - ! Input_Opt = Input_Opt(BEGCHUNK), & + ! CALL Read_Input_File( Input_Opt = Input_Opt(BEGCHUNK), & ! srcFile = inputGeosPath, & ! RC = RC ) !ENDIF @@ -1113,8 +1103,7 @@ subroutine chem_init(phys_state, pbuf2d) latEdgeArr(nX+1,J) = REAL((latVal) * PI_180, f4) ENDDO - CALL SetGridFromCtrEdges( am_I_Root = MasterProc, & - State_Grid = State_Grid(L), & + CALL SetGridFromCtrEdges( State_Grid = State_Grid(L), & lonCtr = lonMidArr, & latCtr = latMidArr, & lonEdge = lonEdgeArr, & @@ -1134,8 +1123,7 @@ subroutine chem_init(phys_state, pbuf2d) ! Set the times held by "time_mod" - CALL Accept_External_Date_Time( am_I_Root = MasterProc, & - value_NYMDb = Input_Opt%NYMDb, & + CALL Accept_External_Date_Time( value_NYMDb = Input_Opt%NYMDb, & value_NHMSb = Input_Opt%NHMSb, & value_NYMDe = Input_Opt%NYMDe, & value_NHMSe = Input_Opt%NHMSe, & @@ -1172,13 +1160,11 @@ subroutine chem_init(phys_state, pbuf2d) !ENDIF !!### Print diagnostic list if needed for debugging - !IF ( prtDebug ) CALL Print_DiagList( am_I_Root, Diag_List, RC ) + !IF ( prtDebug ) CALL Print_DiagList( Diag_List, RC ) DO I = BEGCHUNK, ENDCHUNK - am_I_Root = (MasterProc .AND. (I == BEGCHUNK)) - CALL GC_Init_StateObj( am_I_Root = am_I_Root, & ! Root CPU (Y/N)? - & Diag_List = Diag_List, & ! Diagnostic list obj + CALL GC_Init_StateObj( Diag_List = Diag_List, & ! Diagnostic list obj & Input_Opt = Input_Opt, & ! Input Options & State_Chm = State_Chm(I), & ! Chemistry State & State_Diag = State_Diag(I), & ! Diagnostics State @@ -1201,8 +1187,7 @@ subroutine chem_init(phys_state, pbuf2d) IF ( Input_Opt%LDryD ) THEN ! Setup for dry deposition - CALL Init_Drydep( am_I_Root = MasterProc, & - & Input_Opt = Input_Opt, & + CALL Init_Drydep( Input_Opt = Input_Opt, & & State_Chm = State_Chm(BEGCHUNK), & & State_Diag = State_Diag(BEGCHUNK), & & State_Grid = State_Grid(BEGCHUNK), & @@ -1278,8 +1263,7 @@ subroutine chem_init(phys_state, pbuf2d) IF ( Input_Opt%LConv .OR. & Input_Opt%LWetD .OR. & Input_Opt%LChem ) THEN - CALL Init_WetScav( am_I_Root = MasterProc, & - & Input_Opt = Input_Opt, & + CALL Init_WetScav( Input_Opt = Input_Opt, & & State_Chm = State_Chm(BEGCHUNK), & & State_Diag = State_Diag(BEGCHUNK), & & State_Grid = State_Grid(BEGCHUNK), & @@ -1297,8 +1281,7 @@ subroutine chem_init(phys_state, pbuf2d) ! of logical_mod.F and tracer_mod.F.. This has to be called ! after the input.geos file has been read from disk. !----------------------------------------------------------------- - !CALL Set_VDiff_Values( am_I_Root = MasterProc, & - !& Input_Opt = Input_Opt, & + !CALL Set_VDiff_Values( Input_Opt = Input_Opt, & !& State_Chm = State_Chm(BEGCHUNK), & !& RC = RC ) @@ -1310,8 +1293,7 @@ subroutine chem_init(phys_state, pbuf2d) !----------------------------------------------------------------- ! Initialize the GET_NDEP_MOD for soil NOx deposition (bmy, 6/17/16) !----------------------------------------------------------------- - !CALL Init_Get_NDep( am_I_Root = MasterProc, & - !& Input_Opt = Input_Opt, & + !CALL Init_Get_NDep( Input_Opt = Input_Opt, & !& State_Chm = State_Chm(BEGCHUNK), & !& State_Diag = State_Diag(BEGCHUNK), & !& RC = RC ) @@ -1325,8 +1307,7 @@ subroutine chem_init(phys_state, pbuf2d) ! Initialize "carbon_mod.F" !----------------------------------------------------------------- IF ( Input_Opt%LCarb ) THEN - CALL Init_Carbon( am_I_Root = MasterProc, & - & Input_Opt = Input_Opt, & + CALL Init_Carbon( Input_Opt = Input_Opt, & & State_Chm = State_Chm(BEGCHUNK), & & State_Diag = State_Diag(BEGCHUNK), & & State_Grid = State_Grid(BEGCHUNK), & @@ -1339,8 +1320,7 @@ subroutine chem_init(phys_state, pbuf2d) ENDIF IF ( Input_Opt%LDust ) THEN - CALL Init_Dust( am_I_Root = MasterProc, & - & Input_Opt = Input_Opt, & + CALL Init_Dust( Input_Opt = Input_Opt, & & State_Chm = State_Chm(BEGCHUNK), & & State_Diag = State_Diag(BEGCHUNK), & & State_Grid = State_Grid(BEGCHUNK), & @@ -1353,8 +1333,7 @@ subroutine chem_init(phys_state, pbuf2d) ENDIF IF ( Input_Opt%LSSalt ) THEN - CALL Init_Seasalt( am_I_Root = MasterProc, & - & Input_Opt = Input_Opt, & + CALL Init_Seasalt( Input_Opt = Input_Opt, & & State_Chm = State_Chm(BEGCHUNK), & & State_Diag = State_Diag(BEGCHUNK), & & State_Grid = State_Grid(BEGCHUNK), & @@ -1367,8 +1346,7 @@ subroutine chem_init(phys_state, pbuf2d) ENDIF IF ( Input_Opt%LSulf ) THEN - CALL Init_Sulfate( am_I_Root = MasterProc, & - & Input_Opt = Input_Opt, & + CALL Init_Sulfate( Input_Opt = Input_Opt, & & State_Chm = State_Chm(BEGCHUNK), & & State_Diag = State_Diag(BEGCHUNK), & & State_Grid = State_Grid(BEGCHUNK), & @@ -1384,8 +1362,7 @@ subroutine chem_init(phys_state, pbuf2d) Input_Opt%LCarb .OR. & Input_Opt%LDust .OR. & Input_Opt%LSSalt ) THEN - CALL Init_Aerosol( am_I_Root = MasterProc, & - & Input_Opt = Input_Opt, & + CALL Init_Aerosol( Input_Opt = Input_Opt, & & State_Chm = State_Chm(BEGCHUNK), & & State_Diag = State_Diag(BEGCHUNK), & & State_Grid = State_Grid(BEGCHUNK), & @@ -1397,23 +1374,8 @@ subroutine chem_init(phys_state, pbuf2d) ENDIF ENDIF - IF ( Input_Opt%LChem ) THEN - CALL Init_Toms( am_I_Root = MasterProc, & - & Input_Opt = Input_Opt, & - & State_Chm = State_Chm(BEGCHUNK), & - & State_Diag = State_Diag(BEGCHUNK), & - & State_Grid = State_Grid(BEGCHUNK), & - & RC = RC ) - - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Error encountered in "Init_TOMS"!' - CALL Error_Stop( ErrMsg, ThisLoc ) - ENDIF - ENDIF - ! This is a bare subroutine - no module - CALL NDXX_Setup( MasterProc, & - & Input_Opt, & + CALL NDXX_Setup( Input_Opt, & & State_Chm(BEGCHUNK), & & State_Grid(BEGCHUNK), & & RC ) @@ -1423,8 +1385,7 @@ subroutine chem_init(phys_state, pbuf2d) CALL Error_Stop( ErrMsg, ThisLoc ) ENDIF - CALL Init_PBL_Mix( am_I_Root = MasterProc, & - State_Grid = State_Grid(BEGCHUNK), & + CALL Init_PBL_Mix( State_Grid = State_Grid(BEGCHUNK), & RC = RC ) IF ( RC /= GC_SUCCESS ) THEN @@ -1476,8 +1437,7 @@ subroutine chem_init(phys_state, pbuf2d) !----------------------------------------------------------------- ! Initialize the hybrid pressure module. Define Ap and Bp. !----------------------------------------------------------------- - CALL Init_Pressure( am_I_Root = MasterProc, & ! Root CPU (Y/N)? - State_Grid = State_Grid(BEGCHUNK), & ! Grid State + CALL Init_Pressure( State_Grid = State_Grid(BEGCHUNK), & ! Grid State RC = RC ) ! Success or failure ! Trapping errors @@ -1489,8 +1449,7 @@ subroutine chem_init(phys_state, pbuf2d) !----------------------------------------------------------------- ! Pass external Ap and Bp to GEOS-Chem's Pressure_Mod !----------------------------------------------------------------- - CALL Accept_External_ApBp( am_I_Root = MasterProc, & ! Root CPU (Y/N)? - State_Grid = State_Grid(BEGCHUNK), & ! Grid State + CALL Accept_External_ApBp( State_Grid = State_Grid(BEGCHUNK), & ! Grid State ApIn = Ap_CAM_Flip, & ! "A" term for hybrid grid BpIn = Bp_CAM_Flip, & ! "B" term for hybrid grid RC = RC ) ! Success or failure @@ -1514,8 +1473,7 @@ subroutine chem_init(phys_state, pbuf2d) DEALLOCATE(Ap_CAM_Flip,Bp_CAM_Flip) !! Initialize HEMCO? - !CALL Emissions_Init ( am_I_Root = MasterProc, & - ! Input_Opt = Input_Opt, & + !CALL Emissions_Init ( Input_Opt = Input_Opt, & ! State_Met = State_Met, & ! State_Chm = State_Chm, & ! State_Grid = State_Grid, & @@ -1531,8 +1489,7 @@ subroutine chem_init(phys_state, pbuf2d) #if ( ALLDDVEL_GEOSCHEM && LANDTYPE_HEMCO ) ! Populate the State_Met%LandTypeFrac field with data from HEMCO - CALL Init_LandTypeFrac( am_I_Root = MasterProc, & - Input_Opt = Input_Opt, & + CALL Init_LandTypeFrac( Input_Opt = Input_Opt, & State_Met = State_Met(BEGCHUNK), & RC = RC ) @@ -1543,8 +1500,7 @@ subroutine chem_init(phys_state, pbuf2d) ! Compute the Olson landmap fields of State_Met ! (e.g. State_Met%IREG, State_Met%ILAND, etc.) - CALL Compute_Olson_Landmap( am_I_Root = MasterProc, & - Input_Opt = Input_Opt, & + CALL Compute_Olson_Landmap( Input_Opt = Input_Opt, & State_Grid = State_Grid(BEGCHUNK), & State_Met = State_Met(BEGCHUNK), & RC = RC ) @@ -1557,8 +1513,7 @@ subroutine chem_init(phys_state, pbuf2d) ! Initialize PBL quantities but do not do mixing ! Add option for non-local PBL (Lin, 03/31/09) - CALL Init_Mixing ( am_I_Root = MasterProc, & - Input_Opt = Input_Opt, & + CALL Init_Mixing ( Input_Opt = Input_Opt, & State_Chm = State_Chm(BEGCHUNK), & State_Diag = State_Diag(BEGCHUNK), & State_Grid = State_Grid(BEGCHUNK), & @@ -1574,8 +1529,7 @@ subroutine chem_init(phys_state, pbuf2d) IF ( Input_Opt%Its_A_FullChem_Sim .OR. & Input_Opt%Its_An_Aerosol_Sim ) THEN ! This also initializes Fast-JX - CALL Init_Chemistry( am_I_Root = MasterProc, & - & Input_Opt = Input_Opt, & + CALL Init_Chemistry( Input_Opt = Input_Opt, & & State_Chm = State_Chm(BEGCHUNK), & & State_Diag = State_Diag(BEGCHUNK), & & State_Grid = State_Grid(BEGCHUNK), & @@ -1589,8 +1543,7 @@ subroutine chem_init(phys_state, pbuf2d) IF ( Input_Opt%LChem .AND. & Input_Opt%LUCX ) THEN - CALL Init_UCX( am_I_Root = MasterProc, & - & Input_Opt = Input_Opt, & + CALL Init_UCX( Input_Opt = Input_Opt, & & State_Chm = State_Chm(BEGCHUNK), & & State_Diag = State_Diag(BEGCHUNK), & & State_Grid = State_Grid(BEGCHUNK) ) @@ -2085,8 +2038,8 @@ subroutine chem_timestep_tend( State, ptend, cam_in, cam_out, dT, pbuf, fh2o ) use Drydep_Mod, only: Update_DryDepSav use Mixing_Mod - use Dao_Mod, only: Set_Dry_Surface_Pressure - use Dao_Mod, only: AirQnt + use Calc_Met_Mod, only: Set_Dry_Surface_Pressure + use Calc_Met_Mod, only: AirQnt use GC_Grid_Mod, only: SetGridFromCtr use Pressure_Mod, only: Set_Floating_Pressures use Pressure_Mod, only: Accept_External_Pedge @@ -2271,8 +2224,7 @@ subroutine chem_timestep_tend( State, ptend, cam_in, cam_out, dT, pbuf, fh2o ) ENDDO ! Update the grid - Call SetGridFromCtr( am_I_Root = rootChunk, & - State_Grid = State_Grid(LCHNK), & + Call SetGridFromCtr( State_Grid = State_Grid(LCHNK), & lonCtr = lonMidArr, & latCtr = latMidArr, & RC = RC ) @@ -2895,8 +2847,7 @@ subroutine chem_timestep_tend( State, ptend, cam_in, cam_out, dT, pbuf, fh2o ) ENDIF ! Pass time values obtained from the ESMF environment to GEOS-Chem - CALL Accept_External_Date_Time( am_I_Root = rootChunk, & - value_NYMD = currYMD, & + CALL Accept_External_Date_Time( value_NYMD = currYMD, & value_NHMS = currHMS, & value_YEAR = currYr, & value_MONTH = currMo, & @@ -2913,8 +2864,7 @@ subroutine chem_timestep_tend( State, ptend, cam_in, cam_out, dT, pbuf, fh2o ) CALL Error_Stop( ErrMsg, ThisLoc ) ENDIF - CALL Accept_External_PEdge( am_I_Root = rootChunk, & - State_Met = State_Met(LCHNK), & + CALL Accept_External_PEdge( State_Met = State_Met(LCHNK), & RC = RC ) IF ( RC /= GC_SUCCESS ) THEN @@ -2945,8 +2895,7 @@ subroutine chem_timestep_tend( State, ptend, cam_in, cam_out, dT, pbuf, fh2o ) State_Met(LCHNK)%PSC2_WET = State_Met(LCHNK)%PS1_WET State_Met(LCHNK)%PSC2_DRY = State_Met(LCHNK)%PS1_DRY - CALL Set_Floating_Pressures( am_I_Root = rootChunk, & - State_Grid = State_Grid(LCHNK), & + CALL Set_Floating_Pressures( State_Grid = State_Grid(LCHNK), & State_Met = State_Met(LCHNK), & RC = RC ) @@ -2978,8 +2927,7 @@ subroutine chem_timestep_tend( State, ptend, cam_in, cam_out, dT, pbuf, fh2o ) ! (13) AIRVOL : Volume of grid box [m^3] ! (14) MOISTMW : Molecular weight of moist air in box [g/mol] ! ==================================================================== - CALL AirQnt( am_I_Root = rootChunk, & - Input_Opt = Input_Opt, & + CALL AirQnt( Input_Opt = Input_Opt, & State_Chm = State_Chm(LCHNK), & State_Grid = State_Grid(LCHNK), & State_Met = State_Met(LCHNK), & @@ -2996,8 +2944,7 @@ subroutine chem_timestep_tend( State, ptend, cam_in, cam_out, dT, pbuf, fh2o ) ! the first call to AirQnt !IF ( (.not.SCHEM_READY) .and. Input_Opt%LSCHEM ) THEN IF ( (.not.SCHEM_READY) .and. .True. ) THEN !TMMF - CALL Init_Strat_Chem( am_I_Root = rootChunk, & - Input_Opt = Input_Opt, & + CALL Init_Strat_Chem( Input_Opt = Input_Opt, & State_Chm = State_Chm(LCHNK), & State_Met = State_Met(LCHNK), & State_Grid = State_Grid(LCHNK), & @@ -3020,8 +2967,7 @@ subroutine chem_timestep_tend( State, ptend, cam_in, cam_out, dT, pbuf, fh2o ) ! (ckeller, 4/1/15) !============================================================== ! Run HEMCO Phase 1 - !CALL Emissions_Run ( am_I_Root = MasterProc, & - ! Input_Opt = Input_Opt, & + !CALL Emissions_Run ( Input_Opt = Input_Opt, & ! State_Chm = State_Chm(LCHNK), & ! State_Diag = State_Diag(LCHNK), & ! State_Grid = State_Grid(LCHNK), & @@ -3056,8 +3002,7 @@ subroutine chem_timestep_tend( State, ptend, cam_in, cam_out, dT, pbuf, fh2o ) ! ! ! Copy UV Albedo data (for photolysis) into the ! ! State_Met%UVALBEDO field. (bmy, 3/20/15) - ! CALL Get_UvAlbedo( am_I_Root = MasterProc, & - ! Input_Opt = Input_Opt, & + ! CALL Get_UvAlbedo( Input_Opt = Input_Opt, & ! State_Met = State_Met(LCHNK), & ! RC = RC ) ! @@ -3070,8 +3015,7 @@ subroutine chem_timestep_tend( State, ptend, cam_in, cam_out, dT, pbuf, fh2o ) ! IF ( Input_Opt%USE_TOMS_O3 ) THEN ! ! Get TOMS overhead O3 columns for photolysis from ! ! the HEMCO data structure (bmy, 3/20/15) - ! CALL Read_TOMS( am_I_Root = MasterProc, & - ! Input_Opt = Input_Opt, & + ! CALL Read_TOMS( Input_Opt = Input_Opt, & ! RC = RC ) ! ! ! Trap potential errors @@ -3086,8 +3030,7 @@ subroutine chem_timestep_tend( State, ptend, cam_in, cam_out, dT, pbuf, fh2o ) ! ! Read data required for Hg2 gas-particle partitioning ! ! (H Amos, 25 Oct 2011) ! IF ( ITS_A_MERCURY_SIM ) THEN - ! CALL Read_Hg2_Partitioning( am_I_Root = MasterProc, & - ! Input_Opt = Input_Opt, & + ! CALL Read_Hg2_Partitioning( Input_Opt = Input_Opt, & ! State_Grid = State_Grid(LCHNK), & ! State_Met = State_Met(LCHNK), & ! MONTH = 1, & !TMMF @@ -3107,8 +3050,7 @@ subroutine chem_timestep_tend( State, ptend, cam_in, cam_out, dT, pbuf, fh2o ) !IF ( ITS_A_FULLCHEM_SIM .and. id_CH4 > 0 ) THEN ! ! ! Set CH4 concentrations - ! CALL SET_CH4( am_I_Root = MasterProc, & - ! Input_Opt = Input_Opt, & + ! CALL SET_CH4( Input_Opt = Input_Opt, & ! State_Chm = State_Chm(LCHNK), & ! State_Diag = State_Diag(LCHNK), & ! State_Grid = State_Grid(LCHNK), & @@ -3124,8 +3066,7 @@ subroutine chem_timestep_tend( State, ptend, cam_in, cam_out, dT, pbuf, fh2o ) ! Eventually initialize/reset wetdep IF ( Input_Opt%LConv .OR. Input_Opt%LChem .OR. Input_Opt%LWetD ) THEN - CALL Setup_WetScav( am_I_Root = rootChunk, & - Input_Opt = Input_Opt, & + CALL Setup_WetScav( Input_Opt = Input_Opt, & State_Chm = State_Chm(LCHNK), & State_Grid = State_Grid(LCHNK), & State_Met = State_Met(LCHNK), & @@ -3154,8 +3095,7 @@ subroutine chem_timestep_tend( State, ptend, cam_in, cam_out, dT, pbuf, fh2o ) ! (7) F_UNDER_PBLTOP: Fraction of grid box underneath the PBL top [-] ! (8) PBL_MAX_L : Model level where PBL top occurs [-] ! ==================================================================== - CALL Compute_PBL_Height( am_I_Root = rootChunk, & - State_Grid = State_Grid(LCHNK), & + CALL Compute_PBL_Height( State_Grid = State_Grid(LCHNK), & State_Met = State_Met(LCHNK), & RC = RC ) @@ -3214,8 +3154,7 @@ subroutine chem_timestep_tend( State, ptend, cam_in, cam_out, dT, pbuf, fh2o ) #if ( LANDTYPE_CLM ) ! Compute the Olson landmap fields of State_Met ! (e.g. State_Met%IREG, State_Met%ILAND, etc.) - CALL Compute_Olson_Landmap( am_I_Root = rootChunk, & - Input_Opt = Input_Opt, & + CALL Compute_Olson_Landmap( Input_Opt = Input_Opt, & State_Grid = State_Grid(LCHNK), & State_Met = State_Met(LCHNK), & RC = RC ) @@ -3228,8 +3167,7 @@ subroutine chem_timestep_tend( State, ptend, cam_in, cam_out, dT, pbuf, fh2o ) ! Compute State_Met%XLAI (for drydep) and State_Met%MODISLAI, ! which is the average LAI per grid box (for soil NOx emissions) - CALL Compute_Xlai( am_I_Root = rootChunk, & - Input_Opt = Input_Opt, & + CALL Compute_Xlai( Input_Opt = Input_Opt, & State_Grid = State_Grid(LCHNK), & State_Met = State_Met(LCHNK), & RC = RC ) @@ -3244,8 +3182,7 @@ subroutine chem_timestep_tend( State, ptend, cam_in, cam_out, dT, pbuf, fh2o ) #if ( ALLDDVEL_GEOSCHEM || OCNDDVEL_GEOSCHEM ) ! Compute drydep velocities and update State_Chm%DryDepVel - CALL Do_Drydep( am_I_Root = rootChunk, & - Input_Opt = Input_Opt, & + CALL Do_Drydep( Input_Opt = Input_Opt, & State_Chm = State_Chm(LCHNK), & State_Diag = State_Diag(LCHNK), & State_Grid = State_Grid(LCHNK), & @@ -3386,8 +3323,7 @@ subroutine chem_timestep_tend( State, ptend, cam_in, cam_out, dT, pbuf, fh2o ) CALL ENDRUN('Incorrect definitions for dry deposition velocities') #endif - CALL Update_DryDepSav( am_I_Root = rootChunk, & - Input_Opt = Input_Opt, & + CALL Update_DryDepSav( Input_Opt = Input_Opt, & State_Chm = State_Chm(LCHNK), & State_Diag = State_Diag(LCHNK), & State_Grid = State_Grid(LCHNK), & @@ -3410,8 +3346,7 @@ subroutine chem_timestep_tend( State, ptend, cam_in, cam_out, dT, pbuf, fh2o ) !! only calculates emissions. All data has been read to disk !! in phase 1 at the beginning of the time step. !! (ckeller, 4/1/15) - !CALL Emissions_Run( am_I_Root = rootChunk, & - ! Input_Opt = Input_Opt, & + !CALL Emissions_Run( Input_Opt = Input_Opt, & ! State_Chm = State_Chmk(LCHNK), & ! State_Diag = State_Diag(LCHNK), & ! State_Grid = State_Grid(LCHNK), & @@ -3446,8 +3381,7 @@ subroutine chem_timestep_tend( State, ptend, cam_in, cam_out, dT, pbuf, fh2o ) ! ! This requires HEMCO. For now comment out. ! Thibaud M. Fritz - 05/07/20 - !CALL Do_Mixing( am_I_Root = rootChunk, & - ! Input_Opt = Input_Opt, & + !CALL Do_Mixing( Input_Opt = Input_Opt, & ! State_Chm = State_Chm(LCHNK), & ! State_Diag = State_Diag(LCHNK), & ! State_Grid = State_Grid(LCHNK), & @@ -3468,8 +3402,7 @@ subroutine chem_timestep_tend( State, ptend, cam_in, cam_out, dT, pbuf, fh2o ) ! ! Call the appropriate convection routine ! ! NOTE: Tracer concentration units are converted locally ! ! to [kg/kg total air] for convection (ewl, 9/18/15) - ! CALL Do_Convection( am_I_Root = rootChunk, & - ! Input_Opt = Input_Opt, & + ! CALL Do_Convection( Input_Opt = Input_Opt, & ! State_Chm = State_Chm(LCHNK), & ! State_Diag = State_Diag(LCHNK), & ! State_Grid = State_Grid(LCHNK), & @@ -3491,16 +3424,14 @@ subroutine chem_timestep_tend( State, ptend, cam_in, cam_out, dT, pbuf, fh2o ) Input_Opt%Its_An_Aerosol_Sim ) THEN IF ( Input_Opt%LChem ) THEN - CALL Compute_Overhead_O3( am_I_Root = rootChunk, & - State_Grid = State_Grid(LCHNK), & + CALL Compute_Overhead_O3( State_Grid = State_Grid(LCHNK), & DAY = currDy, & USE_O3_FROM_MET = Input_Opt%Use_O3_From_Met, & TO3 = State_Met(LCHNK)%TO3 ) ENDIF ENDIF - CALL Do_Chemistry( am_I_Root = rootChunk, & - Input_Opt = Input_Opt, & + CALL Do_Chemistry( Input_Opt = Input_Opt, & State_Chm = State_Chm(LCHNK), & State_Diag = State_Diag(LCHNK), & State_Grid = State_Grid(LCHNK), & @@ -3521,8 +3452,7 @@ subroutine chem_timestep_tend( State, ptend, cam_in, cam_out, dT, pbuf, fh2o ) ! NOTE: Tracer concentration units are converted locally ! to [kg/m2] in wet deposition to enable calculations ! along the column (ewl, 9/18/15) - CALL Do_WetDep( am_I_Root = rootChunk, & - Input_Opt = Input_Opt, & + CALL Do_WetDep( Input_Opt = Input_Opt, & State_Chm = State_Chm(LCHNK), & State_Diag = State_Diag(LCHNK), & State_Grid = State_Grid(LCHNK), & @@ -4038,7 +3968,6 @@ subroutine chem_final use Dust_Mod, only : Cleanup_Dust use Seasalt_Mod, only : Cleanup_Seasalt use Aerosol_Mod, only : Cleanup_Aerosol - use TOMS_Mod, only : Cleanup_Toms use Sulfate_Mod, only : Cleanup_Sulfate use Pressure_Mod, only : Cleanup_Pressure use Strat_Chem_Mod, only : Cleanup_Strat_Chem @@ -4054,7 +3983,6 @@ subroutine chem_final use GC_Emissions_Mod, only: GC_Emissions_Final INTEGER :: I, RC - LOGICAL :: am_I_Root ! Finalize GEOS-Chem IF (MasterProc) WRITE(iulog,'(a)') 'GCCALL CHEM_FINAL' @@ -4064,7 +3992,7 @@ subroutine chem_final CALL Cleanup_Carbon CALL Cleanup_Drydep CALL Cleanup_Dust - CALL Cleanup_FlexChem( am_I_Root, RC ) + CALL Cleanup_FlexChem( RC ) IF ( RC /= GC_SUCCESS ) THEN ErrMsg = 'Error encountered in "Cleanup_FlexChem"!' CALL Error_Stop( ErrMsg, ThisLoc ) @@ -4075,13 +4003,8 @@ subroutine chem_final CALL Cleanup_Seasalt CALL Cleanup_Sulfate CALL Cleanup_Strat_Chem - CALL Cleanup_Toms( MasterProc, RC ) - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Error encountered in "Cleanup_Toms"!' - CALL Error_Stop( ErrMsg, ThisLoc ) - ENDIF - CALL Cleanup_WetScav( MasterProc, RC) + CALL Cleanup_WetScav( RC) IF ( RC /= GC_SUCCESS ) THEN ErrMsg = 'Error encountered in "Cleanup_WetScav"!' CALL Error_Stop( ErrMsg, ThisLoc ) @@ -4115,12 +4038,11 @@ subroutine chem_final ! Loop over each chunk and cleanup the variables DO I = BEGCHUNK, ENDCHUNK - am_I_Root = ((I.eq.BEGCHUNK) .and. MasterProc) - CALL Cleanup_State_Chm ( am_I_Root, State_Chm(I), RC ) - CALL Cleanup_State_Diag( am_I_Root, State_Diag(I), RC ) - CALL Cleanup_State_Grid( am_I_Root, State_Grid(I), RC ) - CALL Cleanup_State_Met ( am_I_Root, State_Met(I), RC ) + CALL Cleanup_State_Chm ( State_Chm(I), RC ) + CALL Cleanup_State_Diag( State_Diag(I), RC ) + CALL Cleanup_State_Grid( State_Grid(I), RC ) + CALL Cleanup_State_Met ( State_Met(I), RC ) ENDDO CALL Cleanup_Error From 9a9ead503679507c872b20ce2aa5665c8ea6c974 Mon Sep 17 00:00:00 2001 From: Thibaud Fritz Date: Fri, 31 Jul 2020 18:56:26 -0400 Subject: [PATCH 006/291] Squashed 60+ commits from Thibaud Fritz Feat: Increase nchem_adv Feat: Define GEOS-Chem deposition species in geoschem.xml Feat: Update solsym based on gckpp_Monitor (1) solsym needs to be defined explicitely, as it is parsed at compile time. Feat: Update .exclude to now include input_mod and pops_mod.F90 Feat: Changes required to make GEOS-Chem 13.0 work with CESM Feat: Set State_Met%Salinity and Iodide to 0. Will be read from HEMCO Feat: Compute isLand/Water/Ice/Snow after AirQnt + Get fields from HEMCO (1) Get IODIDE surface concentration and SALINITY from HEMCO Feat: Kludge gaseous species names to match CESM restart file: (1) Bromine, chlorine, iodine and lumped species are not in CESM restart file. We can choose to load these from a GEOS-Chem restart file but this is future work. Feat: Rename CAM's drydep_mod to aer_drydep_mod Feat: Print dep. lists when getting from namelist Feat: Allow MAM to compile with CESM-GC Feat: Remove unused use statement Feat: Updates to make MAM4 interchange data with CESM-GC Compile time changes: (1) prescribe_aerosols is set to FALSE when $chem contains geoschem (2) Replace aerosol deposition species with MAM4 aerosols in nml files (3) Remove pp_geoschem/aero_model. Currently, GEOS-Chem only works with MAM(4) turned on. If MAM is to be switched off in the future, then the compiler should choose to compile pp_geoschem/aero_model (which is just a dummy, almost empty file) over modal_aero/aero_model.F90 Code changes: (1) Make xname_massptr a public and protected variable. It is used to establish a mapping between MAM4 and GEOS-Chem aerosols (2) Add map2MAM4(:,:) in chem_mods and set number of fixed species to 6 rather than 4 (3) Add dummy constituents for GEOS-Chem aerosols. Ideally, aerosols that are inherited from MAM should not need to be defined as a constituent. For instance, BCPI is inherited from bc_a* whereas NIT is not included and needs to be defined as a constituent (in order to be advected) (4) Establish mapping between MAM4 and GEOS-Chem aerosols. Currently, POM and SOA are not mapped. More work is needed here to figure out which GEOS-Chem aerosols should be used to map those. (5) Reverse mapping (aka from GEOS-Chem back to MAM) is not established yet. (6) Clip QI and QL to 1.0E-05 as low values (I have found values as low as 1.0E-141) can make GEOS-Chem blow up in sulfate_mod. (7) Add empty m_spc_id.F90, required by MAM4 (8) In mo_chem_utils, replace tracerNames by tracname. This is required as MAM aerosols are not in tracerNames (which only includes GEOS-Chem species). Add get_inv_ndx. I believe that this change temporarily breaks dry deposition as performed by MOZART. More investigation is needed here. (9) Add subroutine in mo_drydep to load in land types which is required for MAM4 to perform its own dry deposition (10) Add MAM4 aerosols to solsym and define inv_lst (list of fixed species) ---- TODOs: (1) Establish reverse mappings (GEOS-Chem -> MAM4) (2) Check MOZART's dry deposition routines. (3) As of right now, MAM4 performs dry deposition. Would it be possible to let GEOS-Chem perform dry deposition of aerosols? (4) What to do regarding pure GEOS-Chem aerosols (e.g. NIT)? Chore: Fix indentation + capitalization Feat: Add option to get land types from HEMCO Fix: Aerosol mapping requires more indices in MMR_Beg. Remove custom emissions Feat: Add emissions to CESM-GC Fix: Prevent emissions from adding up in CESM-GC. Reset cam_in%cflx Feat: Modify aero_model.F90 to let GEOS-Chem handle its own aerosols Fix: Resolve circular dependency Feat: Rename HCO_surf_salinity to HCO_salinity (1) The physics buffer does not allow to store strings as long as `HCO_surf_salinity` and would, for instance, store `HCO_surf_salinit`. To avoid confusion, we rename it to `HCO_salinity`, same for `HCO_iodide`. Feat: Allow CESM-GC to output dry deposition velocity used by GEOS-Chem (1) Add addfld and outfld statements for each dry deposition species, using State_Chm%DryDepVel (2) Fix to let chemistry.F90 when LANDTYPE_HEMCO is 1. Feat: Uncomment call to DO_MIXING to allow for dry deposition Feat: Change IC condition file (1) Renamed some species into their GEOS-Chem equivalent. This new IC file is a mere copy of the default file, with some species renamed Fix: Replace species number with `gas_pcnst` Feat: Reindexed GEOS-Chem species: tracers, MAM aerosols, SL species (1) This reindexing is necessary as MAM requires that there is a linear mapping (constant offset) between solsym and constituents. (2) adv_mass is now properly defined in mo_sim_dat, using GEOS-Chem values for all species, except MAM aerosols. Feat: Add runtime option to using GEOS-Chem wet deposition Feat: Add files to allow for NEU wet deposition scheme (1) Add mo_neu_wetdep (copied from MOZART) (2) Add additional files (mo_mean_mass, mo_setinv, gas_wetdep_opts) (3) Add new field in mo_neu_wetdep (WDRATE), corresponding to the wet removal rate in kg/s Feat: Add NEU WD routines + MAM gas-aerosol exchange ( 1) Added NEU wet deposition routines. Option to choose between NEU and GEOS-Chem wet deposition scheme is available at runtime. See commit #a8d642c ( 2) Added diagnostic fields for wet deposition. These match the names of the same quantities in MOZART ( 3) Added MAM gas-aerosol exchange ( 4) Rename field DDVel and SurfFlux into DepVel and DepFlux. Might need to change those in the future to match those in MOZART ( 5) Established MAM4 aerosol to GEOS-Chem species mapping based on discussion with Louisa Emmons ( 6) Added inverse mapping map2GCinv hat maps tracers onto constituent. This is now used in chem_emissions. ( 7) Added map2chm which maps solsym onto GEOS-Chem species and constituents ( 8) Remove special handlings when defining constituents. Variable names are now changed in the IC file. ( 9) Compute CSZAmid field (10) Fix bug where qH2O was flipped vertically Feat: Get UVALBEDO from HEMCO *CAM only defines albedo during daytime. However, UVALBEDO is only used for photolysis, which should be fine. Feat: Define MaxTrop/StratLev from grid + Add Set_H2O_Trac Feat: Add OH and JRates diagnostics. Feat: Get H2O mmr from specific humidity (1) GEOS-Chem's water mass mixing ratio is derived from CAM's specific humidity (2) Additionally, the JRates diagnostics are only computed if they are an output field Chore: Remove unnecessary comment Fix: Unit check failed because 'kg/ kg dry' /= 'kg/kg dry' Feat: Remove special handlings as we now use GEOS-Chem IC (1) Previously GEOS-Chem species were modified to account for the species in the CAM restart file (e.g. HNO2 vs HONO). Now, we just use GEOS-Chem initial conditions that have been regridded to ~0.9x1.25 Feat: Add option to pass H2O tendency to Q + change some addfld Feat: Set State_Met%OMEGA equal to state%omega Feat: Allow CESM-GC to compute overhead ozone from State_Chm%Species Feat: Allow CESM-GC runs to be restartable Feat: Implement 3-D emissions. (1) Surface emissions (layer PVER) are passed to cam_in%cflx while the non-surface emissions are added directly to the chemical tendencies (2) Dry deposition fluxes are now passed to cam_in%cflx such that: cam_in%cflx = eflx - dflx (3) Remove call to DO_MIXING as this is now handled by CAM. Feat: Replace tracerNames with solsym in chem_implements_cnst Feat: Changes required by GEOS-Chem 13.0.0 Feat: Move compile time flags to run time flags for DD velocities Feat: Read OMOC from HEMCO and store in State_Chm Feat: Move all GEOS-Chem related diagnostics to cesmgc_diag_mod.F90 Feat: Add missing initialization of ThisLoc and ErrMsg Feat: Add option to output State_Met in cesmgc_diag_mod.F90 Feat: Update GEOS-Chem branch in Externals_CAM.cfg to be `CESM` Feat: Replace pp_geoschem with geoschem Feat: Reset MAM-inherited aerosols to 0 before mapping (1) Resetting MAM-inherited aerosols in State_Chm%Species allows these aerosols to not accumulate over time. Otherwise, we would have for instance: BCPI = BCPI + MAM4, which would accumulate overtime if BCPI was not reset (2) Lowered the threshold on QI and QL to 1.0E-10 rather than 1.0E-05 Feat: Add MAM aerosols to cesmgc_diag_mod Feat: Add lightning emissions Feat: Add MEGAN emissions Feat: Symbolic link to mozart/mo_lightning Feat: Add symbolic link to MOZART files, rather than copy Feat: Add lightning, MEGAN, aerosol and fire emissions Feat: Remote WDRATE_* from CAM history fields Fix: Molar weight pFe Fix: Add to_upper to tracerNames, required since 'pFe' /= 'PFE' Chore: Try lower and uppercase tracernames when getting data from pbuf Fix: Handle cases where ncol /= pcols Chore: Add note explaining why DQRLSAN needs to be zero in top layer Feat: Pass GEOS-Chem aerosol emissions to MAM tendencies Fix: Fix typo SO4S vs SOAS Feat: Enforce lq('Q') to be true if passing H2O tendencies: (1) lq(cQ) = .True. if applyQTend is True (2) iFirstCnst is now a variable in chem_mods (3) Reset cam_in%cflx for all species (including MAM aerosols) Feat: Only diagnose wet deposition rates of soluble species Feat: Skip emissions on first time step before HEMCO fills in data Feat: Add chem_is-like function in mo_chm_utls Fix: Fix typo Feat: Add or rename some output fields: (1) Add option to save out chemical tendencies (kg/kg/s or kg/s) (2) Rename output fluxes to match CAM-Chem Feat: Add _CLFX and other CAM-Chem like diagnostics to CESM-GC Feat: Add new GC compsets that mimic CAM-Chem compsets: (1) New compsets (2) Enforce NTHRDS_ATM to be 1 when running with GEOS-Chem Feat: Add new use_cases XML entries for newly added GC compsets Feat: Turn on rad_prog_ozone for GEOS-Chem chemistry Feat: Implement CAM-Chem like diagnostics for CESM-GC: (1) Rename diagnostics to match CAM-Chem's (2) Only perform diagnostics computations if field is an output. Use hist_fld_active whenever a call to outfld is performed. Feat: Make sure that GC's SOAGX species is not picked up by MAM Fix: Remove debug statement in cesmgc_diag_mod Feat: Add mmr tendencies for MAM aerosols from chemistry Feat: Replace DO loops with array element-wise operations Feat: Set NTHRDS_*=1 when using a GEOS-Chem compset Feat: Make SDYN compset with GEOS-Chem have 56 levs Feat: Pass chemical tendencies to MAM aerosols: (1) Changes in aerosol concentrations due to GEOS-Chem processing is now passed to chemical tendencies for MAM aerosols (2) Wet deposition of MAM-inherited aerosols is not performed in GEOS-Chem. To do so, we define a new logical `WD_ExternalDep` in SpcInfo Feat: Remove mass-weighted OH concentration diagnostics Feat: Add CO2 as constituent Feat: Compute CO2 chemical tendencies: (1) GEOS-Chem overwrites CO2 concentrations at every time step. We thus set State_Chm%Species(:,:,:,iCO2) = 0.0e+00 before chemistry and compute chemical tendencies based on how much CO2 has been produced. (2) Cleanup Feat: Apply CAM-Chem surface boundary conditions for long-lived species Feat: Remove hardwired path to GEOS-Chem CHEM_INPUTS directory Feat: Remove hard-wired paths for GEOS-Chem inputs: (1) All input files are now (one-time) copied from geoschem_src/run/CESM to Buildconf/camconf. Then to the run folder every time builnml is called Feat: Read from input.geos Feat: Read input.geos rather than hard-wiring input options Feat: Add check to make sure that solsym is following list of GC tracer Chore: Clean up in short_lived_species Fix: Fix wrong reference MMR Chore: Cleanup, remove unused MWRatio and longNames Feat: Update .exclude to exclude gosat and tccon from GEOS-Chem folder Feat: Get strat_chem data from HEMCO Feat: Add timers around DO_CHEMISTRY + Fix diagnostic in WetDep Feat: Remove PSO4 diagnostic (write statement) Fix: Fix diagnostics of emissions Feat: Remove option to let GEOS-Chem perform wet scavenging. (1) The only option to perform convective scavenging in CESM-GC is currently to rely on the NEU scheme, which handles large-scale precipitation and convective scavening. Since the variables required by the GEOS-Chem convective routines cannot be extracted easily, we rely on the NEU scheme to perform washout due to both LS precipitation and convective scavenging for gases AND aerosols. (2) A next commit will follow to specify Henry coefficients of aerosols. The best option is to probably set something similar as HNO3 Feat: Make non-MAM GC aerosols "gas-like" species for wet&dry dep (1) Move all GC aerosols from aer_drydep_list to drydep_list and from aer_wetdep_list to gas_wetdep_list (see previous commits too) (2) This allows to remove the 'GC_AER_' terminology for GC aerosols (3) Aerosol emission fluxes (e.g. BCPI) are now passed directly to MAM (e.g. flux to bc_a4). This allows for the removal of some interfacing code in cesmgc_emissions_mod.F90 (4) Fix diagnostic naming issues (e.g. replaced WD_HBR with WD_HBr) (5) Remove extra bit of code in cesmgc_diag_mod dealing with wet dep in GEOS-Chem, which had been removed in previous commits (6) In mo_neu_wetdep.F90, make all GC aerosols be removed like HNO3 (7) Revert previous changes in modal_aero that used to deal with GC aerosols in aer_drydep_list Signed-off-by: Thibaud Fritz --- Externals_CAM.cfg | 4 +- bld/build-namelist | 54 +- bld/config_files/definition.xml | 2 +- bld/configure | 35 +- bld/namelist_files/namelist_definition.xml | 12 +- bld/namelist_files/use_cases/geoschem.xml | 37 +- .../use_cases/hist_geoschem.xml | 172 + bld/namelist_files/use_cases/sd_geoschem.xml | 177 + bld/perl5lib/Build/ChemNamelist.pm | 12 +- cime_config/buildnml | 48 +- cime_config/config_component.xml | 29 +- cime_config/config_compsets.xml | 35 +- cime_config/config_pes.xml | 12 + .../{drydep_mod.F90 => aer_drydep_mod.F90} | 4 +- src/chemistry/bulk_aero/aero_model.F90 | 22 +- .../{pp_geoschem => geoschem}/.exclude | 8 +- src/chemistry/geoschem/cesmgc_diag_mod.F90 | 1460 ++++++ .../geoschem/cesmgc_emissions_mod.F90 | 540 +++ .../charge_neutrality.F90 | 0 .../{pp_geoschem => geoschem}/chem_mods.F90 | 50 +- .../chem_prod_loss_diags.F90 | 0 src/chemistry/geoschem/chemistry.F90 | 4215 +++++++++++++++++ .../{pp_geoschem => geoschem}/clybry_fam.F90 | 0 .../epp_ionization.F90 | 0 src/chemistry/geoschem/fire_emissions.F90 | 1 + src/chemistry/geoschem/gas_wetdep_opts.F90 | 79 + .../getLandTypes.F90 | 0 src/chemistry/geoschem/m_spc_id.F90 | 3 + .../{pp_geoschem => geoschem}/mo_apex.F90 | 0 src/chemistry/geoschem/mo_chem_utls.F90 | 180 + .../{pp_geoschem => geoschem}/mo_drydep.F90 | 191 + .../mo_gas_phase_chemdr.F90 | 0 src/chemistry/geoschem/mo_ghg_chem.F90 | 1 + src/chemistry/geoschem/mo_lightning.F90 | 1 + src/chemistry/geoschem/mo_mean_mass.F90 | 1 + src/chemistry/geoschem/mo_neu_wetdep.F90 | 1798 +++++++ src/chemistry/geoschem/mo_setinv.F90 | 1 + .../{pp_geoschem => geoschem}/mo_sim_dat.F90 | 335 +- .../{pp_geoschem => geoschem}/mo_tracname.F90 | 2 +- .../{pp_geoschem => geoschem}/rate_diags.F90 | 0 .../short_lived_species.F90 | 8 - src/chemistry/geoschem/tracer_cnst.F90 | 1 + src/chemistry/geoschem/tracer_srcs.F90 | 1 + .../{pp_geoschem => geoschem}/upper_bc.F90 | 0 src/chemistry/modal_aero/aero_model.F90 | 10 +- src/chemistry/modal_aero/modal_aero_data.F90 | 4 +- src/chemistry/mozart/mo_chem_utls.F90 | 12 + src/chemistry/pp_geoschem/aero_model.F90 | 1150 ----- src/chemistry/pp_geoschem/chemistry.F90 | 4160 ---------------- src/chemistry/pp_geoschem/gc_emissions.F90 | 76 - src/chemistry/pp_geoschem/mo_chem_utls.F90 | 162 - src/chemistry/pp_geoschem/mo_lightning.F90 | 182 - 52 files changed, 9287 insertions(+), 6000 deletions(-) create mode 100644 bld/namelist_files/use_cases/hist_geoschem.xml create mode 100644 bld/namelist_files/use_cases/sd_geoschem.xml rename src/chemistry/aerosol/{drydep_mod.F90 => aer_drydep_mod.F90} (99%) rename src/chemistry/{pp_geoschem => geoschem}/.exclude (84%) create mode 100644 src/chemistry/geoschem/cesmgc_diag_mod.F90 create mode 100644 src/chemistry/geoschem/cesmgc_emissions_mod.F90 rename src/chemistry/{pp_geoschem => geoschem}/charge_neutrality.F90 (100%) rename src/chemistry/{pp_geoschem => geoschem}/chem_mods.F90 (71%) rename src/chemistry/{pp_geoschem => geoschem}/chem_prod_loss_diags.F90 (100%) create mode 100644 src/chemistry/geoschem/chemistry.F90 rename src/chemistry/{pp_geoschem => geoschem}/clybry_fam.F90 (100%) rename src/chemistry/{pp_geoschem => geoschem}/epp_ionization.F90 (100%) create mode 120000 src/chemistry/geoschem/fire_emissions.F90 create mode 100644 src/chemistry/geoschem/gas_wetdep_opts.F90 rename src/chemistry/{pp_geoschem => geoschem}/getLandTypes.F90 (100%) create mode 100644 src/chemistry/geoschem/m_spc_id.F90 rename src/chemistry/{pp_geoschem => geoschem}/mo_apex.F90 (100%) create mode 100644 src/chemistry/geoschem/mo_chem_utls.F90 rename src/chemistry/{pp_geoschem => geoschem}/mo_drydep.F90 (94%) rename src/chemistry/{pp_geoschem => geoschem}/mo_gas_phase_chemdr.F90 (100%) create mode 120000 src/chemistry/geoschem/mo_ghg_chem.F90 create mode 120000 src/chemistry/geoschem/mo_lightning.F90 create mode 120000 src/chemistry/geoschem/mo_mean_mass.F90 create mode 100644 src/chemistry/geoschem/mo_neu_wetdep.F90 create mode 120000 src/chemistry/geoschem/mo_setinv.F90 rename src/chemistry/{pp_geoschem => geoschem}/mo_sim_dat.F90 (81%) rename src/chemistry/{pp_geoschem => geoschem}/mo_tracname.F90 (90%) rename src/chemistry/{pp_geoschem => geoschem}/rate_diags.F90 (100%) rename src/chemistry/{pp_geoschem => geoschem}/short_lived_species.F90 (96%) create mode 120000 src/chemistry/geoschem/tracer_cnst.F90 create mode 120000 src/chemistry/geoschem/tracer_srcs.F90 rename src/chemistry/{pp_geoschem => geoschem}/upper_bc.F90 (100%) delete mode 100644 src/chemistry/pp_geoschem/aero_model.F90 delete mode 100644 src/chemistry/pp_geoschem/chemistry.F90 delete mode 100644 src/chemistry/pp_geoschem/gc_emissions.F90 delete mode 100644 src/chemistry/pp_geoschem/mo_chem_utls.F90 delete mode 100644 src/chemistry/pp_geoschem/mo_lightning.F90 diff --git a/Externals_CAM.cfg b/Externals_CAM.cfg index 906d81c24c..f7ccf98a07 100644 --- a/Externals_CAM.cfg +++ b/Externals_CAM.cfg @@ -27,9 +27,9 @@ tag = v2.0.3cesm/src required = True [geoschem] -local_path = src/chemistry/pp_geoschem/geoschem_src +local_path = src/chemistry/geoschem/geoschem_src protocol = git -branch = feature/13.0.0+CESM +branch = CESM repo_url = https://github.com/CESM-GC/geos-chem required = True diff --git a/bld/build-namelist b/bld/build-namelist index 7d8374fe81..c0e4bc0a25 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -665,7 +665,7 @@ my $rad_prog_bcarb = (($prog_species =~ "BC" or $aero_chem) and !($chem_rad_pa my $rad_prog_sulf = (($prog_species =~ "SO4" or $aero_chem) and !($chem_rad_passive)); my $rad_prog_dust = (($prog_species =~ "DST" or $aero_chem) and !($chem_rad_passive)); my $rad_prog_sslt = (($prog_species =~ "SSLT" or $aero_chem) and !($chem_rad_passive)); -my $rad_prog_ozone = (($chem =~ "mozart" or $chem =~ "waccm_ma" or $chem =~ "tsmlt" or $chem =~ "trop_strat") and !($chem_rad_passive)); +my $rad_prog_ozone = (($chem =~ "mozart" or $chem =~ "waccm_ma" or $chem =~ "tsmlt" or $chem =~ "trop_strat" or $chem =~ /geoschem/) and !($chem_rad_passive)); # Check for eruptive volcano emissions. These will be radiatively active by default, but # only if using BAM and the camrt radiation package @@ -707,6 +707,11 @@ if ( ($chem ne 'none') or ( $prog_species ) ){ add_default($nl, 'gas_wetdep_method' ); add_default($nl, 'gas_wetdep_list', 'val'=>$gas_wetdep_list ); } + + if ($chem =~ /geoschem/) { + $prescribe_aerosols = $FALSE; + } + if (length($aer_wetdep_list)>2){ # determine if prescribed aerosols are not needed ... if ($aer_wetdep_list =~ /so4/i && @@ -740,6 +745,10 @@ if ( ($chem ne 'none') or ( $prog_species ) ){ if (length($aer_drydep_list)>2){ add_default($nl, 'aer_drydep_list', 'val'=>$aer_drydep_list ); } + $nl->set_variable_value('aerosol_nl', 'aer_drydep_list', $aer_drydep_list); + $nl->set_variable_value('aerosol_nl', 'aer_wetdep_list', $aer_wetdep_list); + $nl->set_variable_value('drydep_inparm', 'drydep_list', $gas_drydep_list); + $nl->set_variable_value('wetdep_inparm', 'gas_wetdep_list', $gas_wetdep_list); } if ($chem) { # Dry Deposition -- The responsibility for dry deposition is shared between CAM and CLM. @@ -981,7 +990,7 @@ my $radval = "'A:Q:H2O'"; if (($chem =~ /waccm_ma/ or $chem =~ /waccm_tsmlt/) and !$chem_rad_passive) { $radval .= ",'A:O2:O2','A:CO2:CO2'"; } -elsif ($chem =~ /trop_strat/ and !$chem_rad_passive) { +elsif (($chem =~ /trop_strat/ or $chem =~ /geoschem/) and !$chem_rad_passive) { $radval .= ",'N:O2:O2','A:CO2:CO2'"; } elsif ($co2_cycle and !$co2_cycle_rad_passive) { @@ -2070,7 +2079,38 @@ if (($chem =~ /geoschem/ or $chem =~ /trop_mozart/ or $chem =~ /trop_strat/ or $ } } -if ($chem =~ /geoschem/ or $chem =~ /trop_mozart/ or $chem =~ /trop_strat/ or $chem =~ /waccm_tsmlt/) { +if ($chem =~ /geoschem/) { + + my $val; + + # Species with fixed lower boundary + $val = "'CH4','OCS','N2O','CO2','CFC11','CFC12'"; + + if ($chem_has_ocs) { + $val .= ",'OCS'"; + } + if (chem_has_species($cfg, 'SF6')) { + $val .= ",'SF6'"; + } + add_default($nl, 'flbc_list', 'val'=>$val); + unless (defined $nl->get_value('flbc_type')) { + add_default($nl, 'flbc_type', 'val'=>'CYCLICAL'); + add_default($nl, 'flbc_cycle_yr', 'val'=>'2000'); + } + + my @files; + # Datasets + #@files = ( 'soil_erod_file', 'flbc_file', + # 'xs_coef_file','xs_short_file', + # 'xs_long_file', 'rsf_file', + # 'exo_coldens_file', 'sulf_file' ); + @files = ( 'soil_erod_file', 'flbc_file' ); + foreach my $file (@files) { + add_default($nl, $file); + } +} + +if ($chem =~ /trop_mozart/ or $chem =~ /trop_strat/ or $chem =~ /waccm_tsmlt/) { my $val; @@ -2085,8 +2125,6 @@ if ($chem =~ /geoschem/ or $chem =~ /trop_mozart/ or $chem =~ /trop_strat/ or $c if ($chem =~ /_tsmlt_mam/ or $chem =~ /trop_strat/) { $val = "'CCL4','CF2CLBR','CF3BR','CFC11','CFC113','CFC12','CH3BR','CH3CCL3','CH3CL','CH4','CO2'" .",'H2','HCFC22','N2O','CFC114','CFC115','HCFC141B','HCFC142B','CH2BR2','CHBR3','H2402'"; - } elsif ($chem =~ /geoschem/) { - $val = "'CH4','OCS','N2O','CO2','CFC11','CFC12'"; } else { $val = "'CH4','H2','N2O','CO2','CFC11','CFC12'"; } @@ -2367,7 +2405,7 @@ if ($chem =~ /_mam4/ and $phys =~ /cam6/) { 'num_a2_cv_ext_file' => 'num_a2', ); - # air craft emissions + # aircraft emissions if ($chem !~ /trop_mam/ and $chem !~ /waccm_sc/) { %species = (%species, 'bc_a4_ar_ext_file' => 'bc_a4', @@ -2422,7 +2460,7 @@ if ($chem =~ /_mam4/ and $phys =~ /cam6/) { } # MEGAN emissions - if ($chem =~ /trop_strat/ or $chem =~ /_tsmlt/) { + if ($chem =~ /trop_strat/ or $chem =~ /_tsmlt/ or $chem =~ /geoschem/) { 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 " @@ -2863,7 +2901,7 @@ if (!$simple_phys) { } # tropopause level used in gas-phase / aerosol processes -if (($chem ne 'none') and ($chem ne 'terminator')) { +if (($chem ne 'none') and ($chem ne 'terminator') and !($chem =~ /geoschem/)) { add_default($nl, 'chem_use_chemtrop'); } diff --git a/bld/config_files/definition.xml b/bld/config_files/definition.xml index e6a6055002..e9d8c38697 100644 --- a/bld/config_files/definition.xml +++ b/bld/config_files/definition.xml @@ -97,7 +97,7 @@ test_radiative (Radiatively Active Dust), test_swelling (Sea Salt), test_tracers Chemistry package: trop_mam3 trop_mam4 trop_mam7 trop_mozart trop_strat_mam4_vbs trop_strat_mam4_vbsext waccm_ma waccm_mad waccm_mad_mam4 waccm_ma_mam4 waccm_ma_sulfur waccm_sc waccm_sc_mam4 waccm_tsmlt_mam4 terminator none - + Chemistry package: trop_mam3 trop_mam4 trop_mam7 trop_mozart trop_strat_mam4_vbs trop_strat_mam4_vbsext waccm_ma waccm_mad waccm_mad_mam4 waccm_ma_mam4 waccm_ma_sulfur waccm_sc waccm_sc_mam4 waccm_tsmlt_mam4 terminator GEOS-Chem none diff --git a/bld/configure b/bld/configure index 459fda9916..56673cb754 100755 --- a/bld/configure +++ b/bld/configure @@ -124,7 +124,7 @@ OPTIONS [ trop_mam3 | trop_mam4 | trop_mam7 | trop_mozart | trop_strat_mam4_vbs | trop_strat_mam4_vbsext | waccm_ma | waccm_mad | waccm_mad_mam4 | waccm_ma_mam4 | waccm_ma_sulfur | waccm_sc | waccm_sc_mam4 | waccm_tsmlt_mam4 | - terminator | geoschem | none ]. + terminator | geoschem | geoschem_mam4 | none ]. Default: trop_mam4 for cam6 and trop_mam3 for cam5. -clm_vers Version of land model to use. This option is only used when chem is set to 'geoschem'. @@ -673,7 +673,7 @@ if (defined $opts{'chem'}) { # If the user has specified a simple physics package... if ($simple_phys) { # the only valid chemistry options are 'none', 'terminator' and 'geoschem' - if (($chem_pkg ne 'none') and ($chem_pkg ne 'terminator') and ($chem_pkg ne 'geoschem')) { + if (($chem_pkg ne 'none') and ($chem_pkg ne 'terminator') and !($chem_pkg =~ 'geoschem')) { die "configure ERROR: -phys=$phys_pkg -chem=$chem_pkg\n". " -chem can only be set to 'none', 'terminator' or 'geoschem'.\n"; } @@ -1392,7 +1392,11 @@ my $chem_cppdefs = ''; my $chem_src_dir = ''; if (!$prog_species) { - $chem_src_dir = "$cam_dir/src/chemistry/pp_$chem_pkg"; + if ($chem_pkg =~ 'geoschem') { + $chem_src_dir = "$cam_dir/src/chemistry/geoschem"; + } else { + $chem_src_dir = "$cam_dir/src/chemistry/pp_$chem_pkg"; + } $cfg_ref->set('chem_src_dir', $chem_src_dir); } @@ -1438,7 +1442,7 @@ if ($chem_pkg =~ '_mam3') { if ($chem_pkg =~ 'geoschem') { $chem_cppdefs .= ' -DEXTERNAL_GRID -DEXTERNAL_FORCING -DLINUX_IFORT -DUSE_REAL8 -DMODEL_ -DMODEL_CESM'; # TMMF - Temporary fix - $chem_nadv = 200; + $chem_nadv = 250; if (defined $opts{'clm_vers'}) { if ($opts{'clm_vers'} =~ 'CLM4.0') { $chem_cppdefs .= ' -DCLM40' @@ -2826,13 +2830,17 @@ sub write_filepath } if ($chem_src_dir) { print $fh "$chem_src_dir\n"; - if ($chem_pkg eq 'geoschem') { + if ($chem_pkg =~ 'geoschem') { print $fh "$chem_src_dir/geoschem_src/GeosCore\n"; print $fh "$chem_src_dir/geoschem_src/GeosUtil\n"; print $fh "$chem_src_dir/geoschem_src/Headers\n"; print $fh "$chem_src_dir/geoschem_src/ISORROPIA\n"; - print $fh "$chem_src_dir/geoschem_src/KPP/Standard\n"; } -# print $fh "$camsrcdir/cam/src/chemistry/pp_geoschem\n"; } + print $fh "$chem_src_dir/geoschem_src/KPP/fullchem\n"; + if ($chem =~ /_mam/) { + print $fh "$camsrcdir/src/chemistry/modal_aero\n"; + print $fh "$camsrcdir/src/chemistry/aerosol\n"; + } + } } if ($waccmx) { @@ -2872,17 +2880,14 @@ sub write_filepath # -- Added by MSL - 1/2018 # -- Updated by TMMF - 11/2019 - if ($chem_pkg ne 'geoschem') { - print $fh "$camsrcdir/cam/src/chemistry/mozart\n"; + if (!($chem_pkg =~ 'geoschem')) { + print $fh "$camsrcdir/src/chemistry/mozart\n"; if ($chem =~ /_mam/) { - print $fh "$camsrcdir/cam/src/chemistry/modal_aero\n"; + print $fh "$camsrcdir/src/chemistry/modal_aero\n"; } else { - print $fh "$camsrcdir/cam/src/chemistry/bulk_aero\n"; + print $fh "$camsrcdir/src/chemistry/bulk_aero\n"; } - print $fh "$camsrcdir/cam/src/chemistry/aerosol\n"; -# } -# else { -# print $fh "$camsrcdir/cam/src/chemistry/mozart\n"; + print $fh "$camsrcdir/src/chemistry/aerosol\n"; } # -- print $fh "$camsrcdir/src/chemistry/utils\n"; diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index 3424886ca4..92d0a579b6 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -4009,11 +4009,17 @@ Full pathname of AMIE inputs for southern hemisphere. Default: NONE. + + +Full pathname to GEOS-Chem chemistry inputs directory +Default: set by build-namelist. + + -Full pathname of dataset for coefficient data used in Weimer05 -high latitude electric potential model. +Full pathname to HEMCO_Config.rc, which prescribes emission inventories Default: set by build-namelist. @@ -4736,7 +4742,7 @@ radiatively passive. Default: FALSE - Wet deposition method used MOZ --> mozart scheme is used diff --git a/bld/namelist_files/use_cases/geoschem.xml b/bld/namelist_files/use_cases/geoschem.xml index 14e8f7a9ba..ce495dbfb2 100644 --- a/bld/namelist_files/use_cases/geoschem.xml +++ b/bld/namelist_files/use_cases/geoschem.xml @@ -1,54 +1,56 @@ - - + 00010101 367.0e-6 -atm/cam/inic/fv/cami-chem_1990-01-01_1.9x2.5_L26_c080114.nc +/glade/p/univ/umit0034/ExtData/CHEM_INPUTS/ + +/glade/p/univ/umit0034/Shared/f.e20.FWAMIP.f09_f09.134.1975.009.cam.i.2010-01-01_32L_c170403.nc - +/glade/p/univ/umit0034/Shared/f.e20.FWAMIP.f19_f19.134.1975.009.cam.i.2010-01-01_32L_c170403.nc + +>&gt; Solar constant from Lean (via Caspar Ammann) &lt;/!</! atm/cam/solar/spectral_irradiance_Lean_1610-2009_ann_c100405.nc 20000101 FIXED - +>&gt; Prescribed BAM data is from Jean-Francois Lamarque &lt;/!</! atm/cam/chem/trop_mozart_aero/aero aero_1.9x2.5_L26_1850-2005_c091112.nc CYCLICAL 2000 - +>&gt; aerosol deposition &lt;/!</! atm/cam/chem/trop_mozart_aero/aero aerosoldep_monthly_2000_mean_1.9x2.5_c090421.nc CYCLICAL 2000 - +>&gt; Prescribed ozone data is from Jean-Francois Lamarque &lt;/!</! atm/cam/ozone ozone_1.9x2.5_L26_1850-2005_c090803.nc O3 CYCLICAL 2000 -.true. 'xactive_lnd' - +>&gt; sim_year used for CLM datasets &lt;/!</! 2000 - +>&gt; fixed lower boundary data &lt;/!</! 2000 atm/waccm/lb/LBC_1765-2500_1.9x2.5_CMIP5_RCP45_za_c120204.nc CYCLICAL - +>&gt; emissions timing &lt;/!</! - +>&gt; &amp;lt;ext_frc_type&amp;gt;'SERIAL'&amp;lt;/ext_frc_type&amp;gt; &lt;/!</! 'CYCLICAL' 2000 - +>&gt; History Files &lt;/!</! 1, 24 0, -1 @@ -63,20 +65,19 @@ - 'ACET','ACTA','ALD2','ASOG1','ASOG2','ASOG3','BR2','BRNO3','CH2O','HCHO','CLNO3','DHDN','EOH','ETHLN','GLYC','GLYX','H2O2','HAC','HBR','HC187','HCL','HCOOH','HNO3','HOBR','HOCL','HONIT','HPALD','IEPOXA','IEPOXB','IEPOXD','IMAE','IPMN','ISN1','ISN1OG','ISOPNB','ISOPND','LIMO','LVOC','MACR','MACRN','MAP','MGLY','MONITS','MONITU','MTPA','MTPO','MVK','MVKN','N2O5','NH3','NO2','NPMN','O3','OPOG1','OPOG2','PAN','POG1','POG2','PPN','PROPNN','R4N2','RIPA','RIPB','RIPD','SO2','HOI','I2','IBR','ICL','HI','IONO','IONO2','I2O2','I2O3','I2O4','H2SO4','TSOG0','TSOG1','TSOG2','TSOG3' + 'ACET','ACTA','ALD2','ASOG1','ASOG2','ASOG3','ATOOH','Br2','BrCl','BrNO3','CH2O','Cl2','ClNO2','ClNO3','ClO','ClOO','EOH','ETHLN','ETNO3','ETP','GLYC','GLYX','H2O2','HAC','HBr','HC5A','HCl','HCOOH','Hg0','Hg0_ANT','Hg0_ARC','Hg0_ATL','Hg0_BB','Hg0_CAM','Hg0_CAN','Hg0_EAF','Hg0_EAS','Hg0_EEU','Hg0_EUR','Hg0_GEO','Hg0_JPN','Hg0_MDE','Hg0_NAF','Hg0_NAT','Hg0_NPA','Hg0_OCE','Hg0_OCN','Hg0_SAF','Hg0_SAM','Hg0_SAS','Hg0_SAT','Hg0_SEA','Hg0_SO','Hg0_SOV','Hg0_STR','Hg0_USA','Hg0_WAF','Hg2','Hg2_ANT','Hg2_ARC','Hg2_ATL','Hg2_BB','Hg2_CAM','Hg2_CAN','Hg2_EAF','Hg2_EAS','Hg2_EEU','Hg2_EUR','Hg2_GEO','Hg2_JPN','Hg2_MDE','Hg2_NAF','Hg2_NAT','Hg2_NPA','Hg2_OCE','Hg2_OCN','Hg2_SAF','Hg2_SAM','Hg2_SAS','Hg2_SAT','Hg2_SEA','Hg2_SO','Hg2_SOV','Hg2_STR','Hg2_USA','Hg2_WAF','HI','HMHP','HMML','HNO3','HOBr','HOCl','HOI','HONIT','HPALD1','HPALD2','HPALD3','HPALD4','HPETHNL','I2','I2O2','I2O3','I2O4','IBr','ICHE','ICl','ICN','ICPDH','IDC','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','IPRNO3','ITCN','ITHN','LIMO','LVOC','MACR','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MENO3','MGLY','MOH','MONITS','MONITU','MPAN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','N2O5','NH3','NO2','NPRNO3','O3','O3AFBL','O3ASBL','O3ATBL','O3EUBL','O3INIT','O3MT','O3NABL','O3PCBL','O3ROW','O3Strat','O3USA','O3UT','OPOG1','OPOG2','PAN','POG1','POG2','POPG_BAP','POPG_PHE','POPG_PYR','PP','PPN','PROPNN','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2','TSOG0','TSOG1','TSOG2','TSOG3','AERI','ASOA1','ASOA2','ASOA3','ASOAN','BCPI','BCPO','Be10','Be10Strat','Be7','Be7Strat','BrSALA','BrSALC','DST1','DST2','DST3','DST4','DSTAL1','DSTAL2','DSTAL3','DSTAL4','HgP','HgP_ANT','HgP_ARC','HgP_ATL','HgP_BB','HgP_CAM','HgP_CAN','HgP_EAF','HgP_EAS','HgP_EEU','HgP_EUR','HgP_GEO','HgP_JPN','HgP_MDE','HgP_NAF','HgP_NAT','HgP_NPA','HgP_OCE','HgP_OCN','HgP_SAF','HgP_SAM','HgP_SAS','HgP_SAT','HgP_SEA','HgP_SO','HgP_SOV','HgP_STR','HgP_USA','HgP_WAF','INDIOL','IONITA','ISALA','ISALC','LVOCOA','MONITA','MOPI','MOPO','MSA','NH4','NIT','NITD1','NITD2','NITD3','NITD4','NITs','OCPI','OCPO','OPOA1','OPOA2','Pb210','Pb210Strat','pFe','POA1','POA2','POPPBCPI_BAP','POPPBCPI_PHE','POPPBCPI_PYR','POPPBCPO_BAP','POPPBCPO_PHE','POPPBCPO_PYR','POPPOCPI_BAP','POPPOCPI_PHE','POPPOCPI_PYR','POPPOCPO_BAP','POPPOCPO_PHE','POPPOCPO_PYR','SALA','SALAAL','SALACL','SALC','SALCAL','SALCCL','SO4','SO4D1','SO4D2','SO4D3','SO4D4','SO4S','SOAGX','SOAIE','SOAS','TSOA0','TSOA1','TSOA2','TSOA3', - 'ASOA1','ASOA2','ASOA3','ASOAN','BCPI','BCPO','DST1','DSTAL1','NITD1','SO4D1','DST2','DSTAL2','NITD2','SO4D2','DST3','DSTAL3','NITD3','SO4D3','DST4','DSTAL4','NITD4','SO4D4','INDIOL','IONITA','ISN1OA','LVOCOA','MONITA','MOPI','MOPO','MSA','NH4','NIT','NITS','OCPI','OCPO','OPOA1','OPOA2','PFE','POA1','POA2','SALA','SALC','SO4','SO4S','SOAIE','SOAGX','SOAME','SOAMG','SOAS','TSOA0','TSOA1','TSOA2','TSOA3','BRSALA','BRSALC','ISALA','ISALC','AERI' + 'dst_a1','so4_a1','nh4_a1','pom_a1','pomff1_a1','pombb1_a1','soa_a1','bc_a1','ncl_a1','num_a1','so4_a2','nh4_a2','soa_a2','ncl_a2','dst_a2','num_a2','dst_a3','ncl_a3','so4_a3','pom_a3','bc_a3','num_a3','ncl_a4','so4_a4','pom_a4','pomff1_a4','pombb1_a4','bc_a4','nh4_a4','num_a4','dst_a5','so4_a5','nh4_a5','num_a5','ncl_a6','so4_a6','nh4_a6','num_a6','dst_a7','so4_a7','nh4_a7','num_a7','soa1_a1','soa1_a2','soa2_a1','soa2_a2','soa3_a1','soa3_a2','soa4_a1','soa4_a2','soa5_a1','soa5_a2','soaff1_a1','soaff2_a1','soaff3_a1','soaff4_a1','soaff5_a1','soabb1_a1','soabb2_a1','soabb3_a1','soabb4_a1','soabb5_a1','soabg1_a1','soabg2_a1','soabg3_a1','soabg4_a1','soabg5_a1','soaff1_a2','soaff2_a2','soaff3_a2','soaff4_a2','soaff5_a2','soabb1_a2','soabb2_a2','soabb3_a2','soabb4_a2','soabb5_a2','soabg1_a2','soabg2_a2','soabg3_a2','soabg4_a2','soabg5_a2' - 'ACTA','ALD2','ASOG1','ASOG2','ASOG3','BR2','CH2O','HCHO','DHDN','EOH','ETHLN','GLYC','GLYX','H2O2','HAC','HBR','HCL','HCOOH','HNO3','HOBR','HOCL','HONIT','IEPOXA','IEPOXB','IEPOXD','IMAE','ISN1','ISN1OG','ISOPNB','ISOPND','LIMO','LVOC','MACRN','MAP','MGLY','MOBA','MONITS','MONITU','MP','CH3OOH','MTPA','MTPO','MVKN','NH3','OPOG1','OPOG2','POG1','POG2','PROPNN','RIPA','RIPB','RIPD','SO2','TSOG0','TSOG1','TSOG2','TSOG3','HOI','I2','IBR','ICL','HI','IONO','IONO2','I2O2','I2O3','I2O4','H2SO4' + 'ACTA','ALD2','ASOG1','ASOG2','ASOG3','ATOOH','Br2','BrCl','CH2O','EOH','ETHLN','ETP','GLYC','GLYX','H2O2','HAC','HBr','HC5A','HCl','HCOOH','Hg2','Hg2_ANT','Hg2_ARC','Hg2_ATL','Hg2_BB','Hg2_CAM','Hg2_CAN','Hg2_EAF','Hg2_EAS','Hg2_EEU','Hg2_EUR','Hg2_GEO','Hg2_JPN','Hg2_MDE','Hg2_NAF','Hg2_NAT','Hg2_NPA','Hg2_OCE','Hg2_OCN','Hg2_SAF','Hg2_SAM','Hg2_SAS','Hg2_SAT','Hg2_SEA','Hg2_SO','Hg2_SOV','Hg2_STR','Hg2_USA','Hg2_WAF','HI','HMHP','HMML','HNO3','HOBr','HOCl','HOI','HONIT','HPETHNL','I2','I2O2','I2O3','I2O4','IBr','ICHE','ICl','ICN','ICPDH','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','ITCN','ITHN','LIMO','LVOC','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MEK','MGLY','MOH','MONITS','MONITU','MP','MPAN','MPN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','NH3','OPOG1','OPOG2','PAN','POG1','POG2','POPG_BAP','POPG_PHE','POPG_PYR','PP','PPN','PROPNN','PRPE','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2','TSOG0','TSOG1','TSOG2','TSOG3','AERI','ASOA1','ASOA2','ASOA3','ASOAN','BCPI','BCPO','Be10','Be10Strat','Be7','Be7Strat','BrSALA','BrSALC','DST1','DST2','DST3','DST4','DSTAL1','DSTAL2','DSTAL3','DSTAL4','HgP','HgP_ANT','HgP_ARC','HgP_ATL','HgP_BB','HgP_CAM','HgP_CAN','HgP_EAF','HgP_EAS','HgP_EEU','HgP_EUR','HgP_GEO','HgP_JPN','HgP_MDE','HgP_NAF','HgP_NAT','HgP_NPA','HgP_OCE','HgP_OCN','HgP_SAF','HgP_SAM','HgP_SAS','HgP_SAT','HgP_SEA','HgP_SO','HgP_SOV','HgP_STR','HgP_USA','HgP_WAF','INDIOL','IONITA','ISALA','ISALC','LVOCOA','MONITA','MOPI','MOPO','MSA','NH4','NIT','NITD1','NITD2','NITD3','NITD4','NITs','OCPI','OCPO','OPOA1','OPOA2','Pb210','Pb210Strat','pFe','POA1','POA2','POPPBCPI_BAP','POPPBCPI_PHE','POPPBCPI_PYR','POPPBCPO_BAP','POPPBCPO_PHE','POPPBCPO_PYR','POPPOCPI_BAP','POPPOCPI_PHE','POPPOCPI_PYR','POPPOCPO_BAP','POPPOCPO_PHE','POPPOCPO_PYR','SALA','SALAAL','SALACL','SALC','SALCAL','SALCCL','SO4','SO4D1','SO4D2','SO4D3','SO4D4','SO4S','SOAGX','SOAIE','SOAS','TSOA0','TSOA1','TSOA2','TSOA3', - 'ASOA1','ASOA2','ASOA3','ASOAN','BCPI','BCPO','DST1','DSTAL1','NITD1','SO4D1','DST2','DSTAL2','NITD2','SO4D2','DST3','DSTAL3','NITD3','SO4D3','DST4','DSTAL4','NITD4','SO4D4','INDIOL','IONITA','ISN1OA','LVOCOA','MONITA','MOPI','MOPO','MSA','NH4','NIT','NITS','OCPI','OCPO','OPOA1','OPOA2','PFE','POA1','POA2','SALA','SALC','SO4','SO4S','SOAIE','SOAGX','SOAME','SOAMG','SOAS','TSOA0','TSOA1','TSOA2','TSOA3','BRSALA','BRSALC','ISALA','ISALC','AERI' + 'dst_a1','so4_a1','nh4_a1','pom_a1','pomff1_a1','pombb1_a1','soa_a1','bc_a1','ncl_a1','num_a1','so4_a2','nh4_a2','soa_a2','ncl_a2','dst_a2','num_a2','dst_a3','ncl_a3','so4_a3','pom_a3','bc_a3','num_a3','ncl_a4','so4_a4','pom_a4','pomff1_a4','pombb1_a4','bc_a4','nh4_a4','num_a4','dst_a5','so4_a5','nh4_a5','num_a5','ncl_a6','so4_a6','nh4_a6','num_a6','dst_a7','so4_a7','nh4_a7','num_a7','soa1_a1','soa1_a2','soa2_a1','soa2_a2','soa3_a1','soa3_a2','soa4_a1','soa4_a2','soa5_a1','soa5_a2','soaff1_a1','soaff2_a1','soaff3_a1','soaff4_a1','soaff5_a1','soabb1_a1','soabb2_a1','soabb3_a1','soabb4_a1','soabb5_a1','soabg1_a1','soabg2_a1','soabg3_a1','soabg4_a1','soabg5_a1','soaff1_a2','soaff2_a2','soaff3_a2','soaff4_a2','soaff5_a2','soabb1_a2','soabb2_a2','soabb3_a2','soabb4_a2','soabb5_a2','soabg1_a2','soabg2_a2','soabg3_a2','soabg4_a2','soabg5_a2' - diff --git a/bld/namelist_files/use_cases/hist_geoschem.xml b/bld/namelist_files/use_cases/hist_geoschem.xml new file mode 100644 index 0000000000..606e409b36 --- /dev/null +++ b/bld/namelist_files/use_cases/hist_geoschem.xml @@ -0,0 +1,172 @@ + + + + +00010101 + +/glade/p/univ/umit0034/ExtData/CHEM_INPUTS/ + +/glade/p/univ/umit0034/Shared/f.e20.FWAMIP.f09_f09.134.1975.009.cam.i.2010-01-01_32L_c170403.nc + +/glade/p/univ/umit0034/Shared/f.e20.FWAMIP.f19_f19.134.1975.009.cam.i.2010-01-01_32L_c170403.nc + + +atm/cam/solar/SolarForcingCMIP6_18491230-23000102_c20200615.nc + + +.true. +.true. +.false. +0.25D0 + +SERIAL +atm/waccm/lb/LBC_1750-2014_CMIP6_0p5degLat_c170126.nc + + SERIAL + + + +INTERP_MISSING_MONTHS + +INTERP_MISSING_MONTHS + +'noy', 'nhx' + + + + 1,30,365,240,240,480,365,73,30 + 0,-24,-24,-3,-1,1,-24,-120,-240 +'A','A','A','A','A','A','A','A','I' + +.true. +.false. +.false. +.false. +.false. +.false. +.false. +.false. +.false. + + + + 'AODDUST', 'AODDUST2', 'T', 'U', 'V', 'O3', 'OH', 'NO3', 'HO2', + 'LNO_COL_PROD', 'NO2_CLXF', 'SFNO', 'SFNH3', 'BRO', + 'CH3CL', 'CLO', 'CO2', 'HCL', 'HO2', 'HOCL', 'H2O', 'PHIS', 'Z3', + 'BENZ', 'C2H6', 'C3H8', 'CCL4', 'CFC11', 'CFC113', 'CFC12', + 'CH2O', 'CH3BR', 'CH3CCL3', 'ALD2', 'CH3CL', 'ACET', 'MOH', 'CH4', + 'CO', 'H2O2', 'HCFC22', 'HNO3', 'ISOP', 'MTPA', 'N2O', 'O3', + 'PAN', 'SO2', 'OH', 'ALK4', 'PRPE', 'BR', 'BRCL', 'BRO', 'BRNO3', + 'EOH', 'ETP', 'PRPE', 'RA3P', 'CCL4', 'H1211', 'H1301', + 'CFC11', 'CFC113', 'CFC114', 'CFC115', 'CFC12', 'CH2BR2', 'CH2O', + 'CH3BR', 'CH3CCL3', 'ALD2', 'CH3CL', 'MGLY', 'ACTA', 'MAP', 'MP', + 'CH4', 'CHBR3', 'CL', 'CL2', 'CL2O2', 'CLO', 'CLNO3', 'CO', + 'CO2', 'DMS', 'GLYC', 'GLYX', + 'H', 'H2', 'H2402', 'H2O2', 'HBR', 'HCFC141B', 'HCFC142B', 'HCFC22', + 'HCL', 'HNO3', 'HNO4', 'HOBR', 'HOCL', 'HONIT', 'HPALD1', 'HPALD2', 'HPALD3', + 'HPALD4', 'HAC', 'HC5A', 'IEPOXA', 'IEPOXB', 'IEPOXD', 'ISOP', 'IHN1', 'IHN2', 'IHN3', + 'IHN4', 'INO2B', 'INO2D', 'INPB', 'INPD', 'RIPA', 'RIPB', 'RIPC', 'RIPD', + 'MACR', 'MVKHP', 'MEK', 'MCRDH', 'MPAN', 'MVK', 'N', 'N2O', 'N2O5', 'ICN', + 'NH3', 'NH4', 'NO', 'NO2', 'NO3', 'PROPNN', 'OLND', 'OLNN', 'O', 'OCLO', + 'OCS', 'PAN', 'SO2', 'SO4', 'SOAP', 'TOLU', 'XYLE', + 'R4O2', 'BRO2', 'ETO2', 'A3O2', 'MCO3', 'MO2', 'HO2', 'O1D', 'OH', + 'H2O', 'SAD_PSC', 'SAD_SULFC', 'SAD_TROP', 'SAD_AERO', 'REFF_AERO', + 'PDELDRY', 'RAD_PSC', 'RAD_SULFC', + 'HNO3_GAS', 'HNO3_STS', 'HNO3_NAT', 'NOX', 'NOY', 'CLOX', 'CLOY', + 'BROX', 'BROY', 'TCLY', 'TOTH', 'MASS', 'TBRY', 'HCL_GAS', + 'HCL_GAS', 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'ABSORB', + 'AODVISdn', 'AODdnMODE1', 'AODVISstdn', 'AODNIRstdn', + 'AODUVstdn', 'AODdnMODE2', 'AODdnMODE3', 'AODdnDUST1', 'AODdnDUST2', + 'AODdnDUST3', 'AODVISstdn', 'AODUVstdn', 'AODNIRstdn', + 'AODNIRstdn', 'AODVISdn', 'AODUVdn', 'EXTINCTdn', 'EXTxASYMdn', + 'EXTINCTNIRdn', 'EXTINCTUVdn', + 'WD_EOH', 'WD_ETP', 'WD_RA3P', 'WD_CH2O', 'WD_ALD2', + 'WD_MGLY', 'WD_ACTA', 'WD_MAP', 'WD_MOH', 'WD_MP', + 'WD_GLYC', 'WD_H2O2', 'WD_SO4', 'WD_HBr', 'WD_HCl', + 'WD_HNO3', 'WD_HOBr', 'WD_HOCl', 'WD_HONIT', 'WD_HAC', 'WD_IEPOXA', + 'WD_IEPOXB', 'WD_IEPOXD', 'WD_MVK', 'WD_NH3', 'WD_NH4', 'WD_SO2', + 'DF_EOH', 'DF_ETP', 'DF_RA3P', 'DF_CH2O', 'DF_ALD2', 'DF_ACET', + 'DF_MGLY', 'DF_ACTA', 'DF_MAP', 'DF_MOH', 'DF_MP', 'DF_CO', + 'DF_GLYC', 'DF_H2O2', 'DF_SO4', 'DF_HNO3', 'DF_HNO4', + 'DF_HONIT', 'DF_HPALD1', 'DF_HPALD2', 'DF_HPALD3', 'DF_HPALD4', + 'DF_HAC', 'DF_IEPOXA', 'DF_IEPOXB', 'DF_IEPOXD', + 'DF_MPAN', 'DF_NH3', 'DF_NH4', 'DF_NO', + 'DF_NO2', 'DF_O3', 'DF_PAN', 'DF_SO2', + 'DF_SOAP', 'SO2_CLXF', 'SO2_XFRC', + 'CO_CLXF', 'NO2_CLXF', 'LNO_PROD', 'LNO_COL_PROD', 'SOAP_CLXF', + 'SFEOH', 'SFALD2', 'SFMEK', 'SFCH2O', 'SFC2H6', 'SFC3H8', + 'SFALK4', 'SFPRPE', 'SFBENZ', 'SFTOLU', 'SFXYLE', + 'SFNO', 'SFACTA', 'SFDMS', 'SFMEK', 'SFSO2', 'SFNH3', + 'SFISOP', 'SFMTPA', 'SFMOH', 'SFACET', 'SFCO', 'SFSOAP', + 'MEG_ISOP', 'MEG_MTERP', 'MEG_BCARY', 'MEG_CH3OH', 'MEG_C2H5OH', 'MEG_CH2O', + 'MEG_CH3CHO', 'MEG_CH3COOH', 'MEG_CH3COCH3', 'MEG_HCOOH', 'MEG_HCN', 'MEG_CO', + 'MEG_C2H6', 'MEG_C2H4', 'MEG_C3H8', 'MEG_C3H6', 'MEG_BIGALK', 'MEG_BIGENE', + 'MEG_TOLUENE', 'Dso4_a1CHM', 'Dso4_a2CHM', 'Dso4_a3CHM', 'DO3CHM', 'DCOCHM', + 'DHNO3CHM', 'DH2O2CHM', 'DO3CHM', 'DCOCHM', 'AQ_SO2', 'GS_SO2', 'SO2_CLXF', + 'MASS', 'ABSORB', + 'Jval_O3O1D', 'Jval_NO2', 'Jval_PAN', 'Jval_H2O2', 'Jval_Cl2O2', + 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a1', + 'ncl_a2', 'ncl_a3', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', + 'soa1_a1', 'soa2_a1', 'soa3_a1', 'soa4_a1', 'soa5_a1', 'soa1_a2', 'soa2_a2', 'soa3_a2', + 'soa4_a2', 'soa5_a2', 'bc_c1', 'bc_c4', 'dst_c1', 'dst_c2', 'dst_c3', 'ncl_c1', 'ncl_c1', + 'ncl_c2', 'ncl_c3', 'pom_c1', 'pom_c4', 'so4_c1', 'so4_c2', 'so4_c3', 'soa1_c1', 'soa2_c1', + 'soa3_c1', 'soa4_c1', 'soa5_c1', 'soa1_c2', 'soa2_c2', 'soa3_c2', 'soa4_c2', 'soa5_c2', + 'bc_a1SFWET', 'num_a1','num_a2','num_a3','num_a4','num_c1','num_c2','num_c3','num_c4', + 'bc_a1SFWET', 'bc_a4SFWET', 'dst_a1SFWET', 'dst_a2SFWET', 'dst_a3SFWET', 'ncl_a1SFWET', + 'ncl_a2SFWET', 'ncl_a3SFWET', 'pom_a1SFWET', 'pom_a4SFWET', + 'so4_a1SFWET', 'so4_a2SFWET', 'so4_a3SFWET', 'soa1_a1SFWET', 'soa1_a2SFWET', + 'soa2_a1SFWET', 'soa2_a2SFWET', 'soa3_a1SFWET', 'soa3_a2SFWET', + 'soa4_a1SFWET', 'soa4_a2SFWET', 'soa5_a1SFWET', 'soa5_a2SFWET', 'bc_c1SFWET', + 'bc_c4SFWET', 'dst_c1SFWET', 'dst_c2SFWET', 'dst_c3SFWET', + 'ncl_c1SFWET', 'ncl_c2SFWET', 'ncl_c3SFWET', 'pom_c1SFWET', 'pom_c4SFWET', + 'so4_c1SFWET', 'so4_c2SFWET', 'so4_c3SFWET', 'soa1_c1SFWET', + 'soa1_c2SFWET', 'soa2_c1SFWET', 'soa2_c2SFWET', 'soa3_c1SFWET', 'soa3_c2SFWET', + 'soa4_c1SFWET', 'soa4_c2SFWET', 'soa5_c1SFWET', 'soa5_c2SFWET', + 'bc_a1DDF', 'bc_a4DDF', 'dst_a1DDF', 'dst_a2DDF', 'dst_a3DDF', 'ncl_a1DDF', + 'ncl_a2DDF', 'ncl_a3DDF', 'pom_a1DDF', + 'pom_a4DDF', 'so4_a1DDF', 'so4_a2DDF', 'so4_a3DDF', 'soa1_a1DDF', + 'soa1_a2DDF', 'soa2_a1DDF', 'soa2_a2DDF', 'soa3_a1DDF', + 'soa3_a2DDF', 'soa4_a1DDF', 'soa4_a2DDF', 'soa5_a1DDF', 'soa5_a2DDF', + 'bc_c1DDF', 'bc_c4DDF', 'dst_c1DDF', 'dst_c2DDF', + 'dst_c3DDF', 'ncl_c1DDF', 'ncl_c2DDF', 'ncl_c3DDF', 'pom_c1DDF', + 'pom_c4DDF', 'so4_c1DDF', 'so4_c2DDF', 'so4_c3DDF', + 'soa1_c1DDF', 'soa1_c2DDF', 'soa2_c1DDF', 'soa2_c2DDF', 'soa3_c1DDF', + 'soa3_c2DDF', 'soa4_c1DDF', 'soa4_c2DDF', 'soa5_c1DDF', + 'soa5_c2DDF', 'num_a1DDF', 'num_a2DDF', 'num_a3DDF', 'num_a4DDF', + 'num_c1DDF', 'num_c2DDF', 'num_c3DDF', 'num_c4DDF', + 'bc_a4_CLXF', 'pom_a4_CLXF', 'so4_a1_CLXF', 'so4_a2_CLXF', + 'num_a1_CLXF', 'num_a2_CLXF', 'SFbc_a4', 'SFpom_a4', 'SFso4_a1', + 'SFso4_a2', 'SFnum_a1', 'SFnum_a2', 'SFnum_a3', 'so4_a1_sfgaex1', + 'so4_a2_sfgaex1', 'so4_a3_sfgaex1', 'soa1_a1_sfgaex1', 'soa1_a2_sfgaex1', + 'soa2_a1_sfgaex1', 'soa2_a2_sfgaex1', 'soa3_a1_sfgaex1', 'soa3_a2_sfgaex1', + 'soa4_a1_sfgaex1', 'soa4_a2_sfgaex1', 'soa5_a1_sfgaex1', 'soa5_a2_sfgaex1', + 'so4_a2_sfnnuc1', 'so4_c1AQH2SO4', 'so4_c2AQH2SO4', 'so4_c3AQH2SO4', + 'so4_c1AQSO4', 'so4_c2AQSO4', 'so4_c3AQSO4', 'SFdst_a1', 'SFdst_a2', 'SFdst_a3', + 'SFncl_a1', 'SFncl_a2', 'SFncl_a3', + 'TMOCS', 'TMSO2', 'TMso4_a1', 'TMso4_a2', 'TMso4_a3', + 'BURDENDUSTdn', 'BURDENPOMdn', 'BURDENSO4dn', 'BURDENSOAdn', + 'BURDENSEASALTdn','BURDENBCdn', 'PM25' + + + + + + 'ACET','ACTA','ALD2','ASOG1','ASOG2','ASOG3','ATOOH','Br2','BrCl','BrNO3','CH2O','Cl2','ClNO2','ClNO3','ClO','ClOO','EOH','ETHLN','ETNO3','ETP','GLYC','GLYX','H2O2','HAC','HBr','HC5A','HCl','HCOOH','Hg0','Hg0_ANT','Hg0_ARC','Hg0_ATL','Hg0_BB','Hg0_CAM','Hg0_CAN','Hg0_EAF','Hg0_EAS','Hg0_EEU','Hg0_EUR','Hg0_GEO','Hg0_JPN','Hg0_MDE','Hg0_NAF','Hg0_NAT','Hg0_NPA','Hg0_OCE','Hg0_OCN','Hg0_SAF','Hg0_SAM','Hg0_SAS','Hg0_SAT','Hg0_SEA','Hg0_SO','Hg0_SOV','Hg0_STR','Hg0_USA','Hg0_WAF','Hg2','Hg2_ANT','Hg2_ARC','Hg2_ATL','Hg2_BB','Hg2_CAM','Hg2_CAN','Hg2_EAF','Hg2_EAS','Hg2_EEU','Hg2_EUR','Hg2_GEO','Hg2_JPN','Hg2_MDE','Hg2_NAF','Hg2_NAT','Hg2_NPA','Hg2_OCE','Hg2_OCN','Hg2_SAF','Hg2_SAM','Hg2_SAS','Hg2_SAT','Hg2_SEA','Hg2_SO','Hg2_SOV','Hg2_STR','Hg2_USA','Hg2_WAF','HI','HMHP','HMML','HNO3','HOBr','HOCl','HOI','HONIT','HPALD1','HPALD2','HPALD3','HPALD4','HPETHNL','I2','I2O2','I2O3','I2O4','IBr','ICHE','ICl','ICN','ICPDH','IDC','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','IPRNO3','ITCN','ITHN','LIMO','LVOC','MACR','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MENO3','MGLY','MOH','MONITS','MONITU','MPAN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','N2O5','NH3','NO2','NPRNO3','O3','O3AFBL','O3ASBL','O3ATBL','O3EUBL','O3INIT','O3MT','O3NABL','O3PCBL','O3ROW','O3Strat','O3USA','O3UT','OPOG1','OPOG2','PAN','POG1','POG2','POPG_BAP','POPG_PHE','POPG_PYR','PP','PPN','PROPNN','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2','TSOG0','TSOG1','TSOG2','TSOG3','AERI','ASOA1','ASOA2','ASOA3','ASOAN','BCPI','BCPO','Be10','Be10Strat','Be7','Be7Strat','BrSALA','BrSALC','DST1','DST2','DST3','DST4','DSTAL1','DSTAL2','DSTAL3','DSTAL4','HgP','HgP_ANT','HgP_ARC','HgP_ATL','HgP_BB','HgP_CAM','HgP_CAN','HgP_EAF','HgP_EAS','HgP_EEU','HgP_EUR','HgP_GEO','HgP_JPN','HgP_MDE','HgP_NAF','HgP_NAT','HgP_NPA','HgP_OCE','HgP_OCN','HgP_SAF','HgP_SAM','HgP_SAS','HgP_SAT','HgP_SEA','HgP_SO','HgP_SOV','HgP_STR','HgP_USA','HgP_WAF','INDIOL','IONITA','ISALA','ISALC','LVOCOA','MONITA','MOPI','MOPO','MSA','NH4','NIT','NITD1','NITD2','NITD3','NITD4','NITs','OCPI','OCPO','OPOA1','OPOA2','Pb210','Pb210Strat','pFe','POA1','POA2','POPPBCPI_BAP','POPPBCPI_PHE','POPPBCPI_PYR','POPPBCPO_BAP','POPPBCPO_PHE','POPPBCPO_PYR','POPPOCPI_BAP','POPPOCPI_PHE','POPPOCPI_PYR','POPPOCPO_BAP','POPPOCPO_PHE','POPPOCPO_PYR','SALA','SALAAL','SALACL','SALC','SALCAL','SALCCL','SO4','SO4D1','SO4D2','SO4D3','SO4D4','SO4S','SOAGX','SOAIE','SOAS','TSOA0','TSOA1','TSOA2','TSOA3', + + + + 'dst_a1','so4_a1','nh4_a1','pom_a1','pomff1_a1','pombb1_a1','soa_a1','bc_a1','ncl_a1','num_a1','so4_a2','nh4_a2','soa_a2','ncl_a2','dst_a2','num_a2','dst_a3','ncl_a3','so4_a3','pom_a3','bc_a3','num_a3','ncl_a4','so4_a4','pom_a4','pomff1_a4','pombb1_a4','bc_a4','nh4_a4','num_a4','dst_a5','so4_a5','nh4_a5','num_a5','ncl_a6','so4_a6','nh4_a6','num_a6','dst_a7','so4_a7','nh4_a7','num_a7','soa1_a1','soa1_a2','soa2_a1','soa2_a2','soa3_a1','soa3_a2','soa4_a1','soa4_a2','soa5_a1','soa5_a2','soaff1_a1','soaff2_a1','soaff3_a1','soaff4_a1','soaff5_a1','soabb1_a1','soabb2_a1','soabb3_a1','soabb4_a1','soabb5_a1','soabg1_a1','soabg2_a1','soabg3_a1','soabg4_a1','soabg5_a1','soaff1_a2','soaff2_a2','soaff3_a2','soaff4_a2','soaff5_a2','soabb1_a2','soabb2_a2','soabb3_a2','soabb4_a2','soabb5_a2','soabg1_a2','soabg2_a2','soabg3_a2','soabg4_a2','soabg5_a2' + + + + 'ACTA','ALD2','ASOG1','ASOG2','ASOG3','ATOOH','Br2','BrCl','CH2O','EOH','ETHLN','ETP','GLYC','GLYX','H2O2','HAC','HBr','HC5A','HCl','HCOOH','Hg2','Hg2_ANT','Hg2_ARC','Hg2_ATL','Hg2_BB','Hg2_CAM','Hg2_CAN','Hg2_EAF','Hg2_EAS','Hg2_EEU','Hg2_EUR','Hg2_GEO','Hg2_JPN','Hg2_MDE','Hg2_NAF','Hg2_NAT','Hg2_NPA','Hg2_OCE','Hg2_OCN','Hg2_SAF','Hg2_SAM','Hg2_SAS','Hg2_SAT','Hg2_SEA','Hg2_SO','Hg2_SOV','Hg2_STR','Hg2_USA','Hg2_WAF','HI','HMHP','HMML','HNO3','HOBr','HOCl','HOI','HONIT','HPETHNL','I2','I2O2','I2O3','I2O4','IBr','ICHE','ICl','ICN','ICPDH','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','ITCN','ITHN','LIMO','LVOC','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MEK','MGLY','MOH','MONITS','MONITU','MP','MPAN','MPN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','NH3','OPOG1','OPOG2','PAN','POG1','POG2','POPG_BAP','POPG_PHE','POPG_PYR','PP','PPN','PROPNN','PRPE','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2','TSOG0','TSOG1','TSOG2','TSOG3','AERI','ASOA1','ASOA2','ASOA3','ASOAN','BCPI','BCPO','Be10','Be10Strat','Be7','Be7Strat','BrSALA','BrSALC','DST1','DST2','DST3','DST4','DSTAL1','DSTAL2','DSTAL3','DSTAL4','HgP','HgP_ANT','HgP_ARC','HgP_ATL','HgP_BB','HgP_CAM','HgP_CAN','HgP_EAF','HgP_EAS','HgP_EEU','HgP_EUR','HgP_GEO','HgP_JPN','HgP_MDE','HgP_NAF','HgP_NAT','HgP_NPA','HgP_OCE','HgP_OCN','HgP_SAF','HgP_SAM','HgP_SAS','HgP_SAT','HgP_SEA','HgP_SO','HgP_SOV','HgP_STR','HgP_USA','HgP_WAF','INDIOL','IONITA','ISALA','ISALC','LVOCOA','MONITA','MOPI','MOPO','MSA','NH4','NIT','NITD1','NITD2','NITD3','NITD4','NITs','OCPI','OCPO','OPOA1','OPOA2','Pb210','Pb210Strat','pFe','POA1','POA2','POPPBCPI_BAP','POPPBCPI_PHE','POPPBCPI_PYR','POPPBCPO_BAP','POPPBCPO_PHE','POPPBCPO_PYR','POPPOCPI_BAP','POPPOCPI_PHE','POPPOCPI_PYR','POPPOCPO_BAP','POPPOCPO_PHE','POPPOCPO_PYR','SALA','SALAAL','SALACL','SALC','SALCAL','SALCCL','SO4','SO4D1','SO4D2','SO4D3','SO4D4','SO4S','SOAGX','SOAIE','SOAS','TSOA0','TSOA1','TSOA2','TSOA3', + + + + 'dst_a1','so4_a1','nh4_a1','pom_a1','pomff1_a1','pombb1_a1','soa_a1','bc_a1','ncl_a1','num_a1','so4_a2','nh4_a2','soa_a2','ncl_a2','dst_a2','num_a2','dst_a3','ncl_a3','so4_a3','pom_a3','bc_a3','num_a3','ncl_a4','so4_a4','pom_a4','pomff1_a4','pombb1_a4','bc_a4','nh4_a4','num_a4','dst_a5','so4_a5','nh4_a5','num_a5','ncl_a6','so4_a6','nh4_a6','num_a6','dst_a7','so4_a7','nh4_a7','num_a7','soa1_a1','soa1_a2','soa2_a1','soa2_a2','soa3_a1','soa3_a2','soa4_a1','soa4_a2','soa5_a1','soa5_a2','soaff1_a1','soaff2_a1','soaff3_a1','soaff4_a1','soaff5_a1','soabb1_a1','soabb2_a1','soabb3_a1','soabb4_a1','soabb5_a1','soabg1_a1','soabg2_a1','soabg3_a1','soabg4_a1','soabg5_a1','soaff1_a2','soaff2_a2','soaff3_a2','soaff4_a2','soaff5_a2','soabb1_a2','soabb2_a2','soabb3_a2','soabb4_a2','soabb5_a2','soabg1_a2','soabg2_a2','soabg3_a2','soabg4_a2','soabg5_a2' + + + diff --git a/bld/namelist_files/use_cases/sd_geoschem.xml b/bld/namelist_files/use_cases/sd_geoschem.xml new file mode 100644 index 0000000000..40d1799727 --- /dev/null +++ b/bld/namelist_files/use_cases/sd_geoschem.xml @@ -0,0 +1,177 @@ + + + + +20050101 + +/glade/p/univ/umit0034/ExtData/CHEM_INPUTS/ + +/glade/p/univ/umit0034/Shared/f.e20.FWAMIP.f09_f09.134.1975.009.cam.i.2010-01-01_56L_c170403.nc +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/0.5x0.63/fv_0.47x0.63_nc3000_Co030_Fi001_PF_nullRR_Nsw021_MERRA2_c180612.nc + +50. +.true. + +2005/MERRA2_0.9x1.25_20050101.nc +atm/cam/met/MERRA2/0.9x1.25 +atm/cam/met/MERRA2/0.9x1.25/filenames_1975-2017_c190125.txt + +2010/MERRA2_0.5x0.63_20100101.nc +atm/cam/met/MERRA2/0.5x0.63 +atm/cam/met/MERRA2/0.5x0.63/filenames_list_c180612 + + +atm/cam/solar/SolarForcingNRLSSI2_daily_s18820101_e20171231_c191122.nc +SERIAL + + +.true. +.true. +.false. +0.25D0 + + +SERIAL +atm/waccm/lb/LBC_1750-2014_CMIP6_0p5degLat_c170126.nc + + + +INTERP_MISSING_MONTHS + +INTERP_MISSING_MONTHS + + + + 1,30,365,240,240,480,365,73,30 + 0,-24,-24,-3,-1,1,-24,-120,-240 +'A','A','A','A','A','A','A','A','I' + +.true. +.false. +.false. +.false. +.false. +.false. +.false. +.false. +.false. + + + + 'AODDUST', 'AODDUST2', 'T', 'U', 'V', 'O3', 'OH', 'NO3', 'HO2', + 'LNO_COL_PROD', 'NO2_CLXF', 'SFNO', 'SFNH3', 'BRO', + 'CH3CL', 'CLO', 'CO2', 'HCL', 'HO2', 'HOCL', 'H2O', 'PHIS', 'Z3', + 'BENZ', 'C2H6', 'C3H8', 'CCL4', 'CFC11', 'CFC113', 'CFC12', + 'CH2O', 'CH3BR', 'CH3CCL3', 'ALD2', 'CH3CL', 'ACET', 'MOH', 'CH4', + 'CO', 'H2O2', 'HCFC22', 'HNO3', 'ISOP', 'MTPA', 'N2O', 'O3', + 'PAN', 'SO2', 'OH', 'ALK4', 'PRPE', 'BR', 'BRCL', 'BRO', 'BRNO3', + 'EOH', 'ETP', 'PRPE', 'RA3P', 'CCL4', 'H1211', 'H1301', + 'CFC11', 'CFC113', 'CFC114', 'CFC115', 'CFC12', 'CH2BR2', 'CH2O', + 'CH3BR', 'CH3CCL3', 'ALD2', 'CH3CL', 'MGLY', 'ACTA', 'MAP', 'MP', + 'CH4', 'CHBR3', 'CL', 'CL2', 'CL2O2', 'CLO', 'CLNO3', 'CO', + 'CO2', 'DMS', 'GLYC', 'GLYX', + 'H', 'H2', 'H2402', 'H2O2', 'HBR', 'HCFC141B', 'HCFC142B', 'HCFC22', + 'HCL', 'HNO3', 'HNO4', 'HOBR', 'HOCL', 'HONIT', 'HPALD1', 'HPALD2', 'HPALD3', + 'HPALD4', 'HAC', 'HC5A', 'IEPOXA', 'IEPOXB', 'IEPOXD', 'ISOP', 'IHN1', 'IHN2', 'IHN3', + 'IHN4', 'INO2B', 'INO2D', 'INPB', 'INPD', 'RIPA', 'RIPB', 'RIPC', 'RIPD', + 'MACR', 'MVKHP', 'MEK', 'MCRDH', 'MPAN', 'MVK', 'N', 'N2O', 'N2O5', 'ICN', + 'NH3', 'NH4', 'NO', 'NO2', 'NO3', 'PROPNN', 'OLND', 'OLNN', 'O', 'OCLO', + 'OCS', 'PAN', 'SO2', 'SO4', 'SOAP', 'TOLU', 'XYLE', + 'R4O2', 'BRO2', 'ETO2', 'A3O2', 'MCO3', 'MO2', 'HO2', 'O1D', 'OH', + 'H2O', 'SAD_PSC', 'SAD_SULFC', 'SAD_TROP', 'SAD_AERO', 'REFF_AERO', + 'PDELDRY', 'RAD_PSC', 'RAD_SULFC', + 'HNO3_GAS', 'HNO3_STS', 'HNO3_NAT', 'NOX', 'NOY', 'CLOX', 'CLOY', + 'BROX', 'BROY', 'TCLY', 'TOTH', 'MASS', 'TBRY', 'HCL_GAS', + 'HCL_GAS', 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'ABSORB', + 'AODVISdn', 'AODdnMODE1', 'AODVISstdn', 'AODNIRstdn', + 'AODUVstdn', 'AODdnMODE2', 'AODdnMODE3', 'AODdnDUST1', 'AODdnDUST2', + 'AODdnDUST3', 'AODVISstdn', 'AODUVstdn', 'AODNIRstdn', + 'AODNIRstdn', 'AODVISdn', 'AODUVdn', 'EXTINCTdn', 'EXTxASYMdn', + 'EXTINCTNIRdn', 'EXTINCTUVdn', + 'WD_EOH', 'WD_ETP', 'WD_RA3P', 'WD_CH2O', 'WD_ALD2', + 'WD_MGLY', 'WD_ACTA', 'WD_MAP', 'WD_MOH', 'WD_MP', + 'WD_GLYC', 'WD_H2O2', 'WD_SO4', 'WD_HBr', 'WD_HCl', + 'WD_HNO3', 'WD_HOBr', 'WD_HOCl', 'WD_HONIT', 'WD_HAC', 'WD_IEPOXA', + 'WD_IEPOXB', 'WD_IEPOXD', 'WD_MVK', 'WD_NH3', 'WD_NH4', 'WD_SO2', + 'DF_EOH', 'DF_ETP', 'DF_RA3P', 'DF_CH2O', 'DF_ALD2', 'DF_ACET', + 'DF_MGLY', 'DF_ACTA', 'DF_MAP', 'DF_MOH', 'DF_MP', 'DF_CO', + 'DF_GLYC', 'DF_H2O2', 'DF_SO4', 'DF_HNO3', 'DF_HNO4', + 'DF_HONIT', 'DF_HPALD1', 'DF_HPALD2', 'DF_HPALD3', 'DF_HPALD4', + 'DF_HAC', 'DF_IEPOXA', 'DF_IEPOXB', 'DF_IEPOXD', + 'DF_MPAN', 'DF_NH3', 'DF_NH4', 'DF_NO', + 'DF_NO2', 'DF_O3', 'DF_PAN', 'DF_SO2', + 'DF_SOAP', 'SO2_CLXF', 'SO2_XFRC', + 'CO_CLXF', 'NO2_CLXF', 'LNO_PROD', 'LNO_COL_PROD', 'SOAP_CLXF', + 'SFEOH', 'SFALD2', 'SFMEK', 'SFCH2O', 'SFC2H6', 'SFC3H8', + 'SFALK4', 'SFPRPE', 'SFBENZ', 'SFTOLU', 'SFXYLE', + 'SFNO', 'SFACTA', 'SFDMS', 'SFMEK', 'SFSO2', 'SFNH3', + 'SFISOP', 'SFMTPA', 'SFMOH', 'SFACET', 'SFCO', 'SFSOAP', + 'MEG_ISOP', 'MEG_MTERP', 'MEG_BCARY', 'MEG_CH3OH', 'MEG_C2H5OH', 'MEG_CH2O', + 'MEG_CH3CHO', 'MEG_CH3COOH', 'MEG_CH3COCH3', 'MEG_HCOOH', 'MEG_HCN', 'MEG_CO', + 'MEG_C2H6', 'MEG_C2H4', 'MEG_C3H8', 'MEG_C3H6', 'MEG_BIGALK', 'MEG_BIGENE', + 'MEG_TOLUENE', 'Dso4_a1CHM', 'Dso4_a2CHM', 'Dso4_a3CHM', 'DO3CHM', 'DCOCHM', + 'DHNO3CHM', 'DH2O2CHM', 'DO3CHM', 'DCOCHM', 'AQ_SO2', 'GS_SO2', 'SO2_CLXF', + 'MASS', 'ABSORB', + 'Jval_O3O1D', 'Jval_NO2', 'Jval_PAN', 'Jval_H2O2', 'Jval_Cl2O2', + 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a1', + 'ncl_a2', 'ncl_a3', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', + 'soa1_a1', 'soa2_a1', 'soa3_a1', 'soa4_a1', 'soa5_a1', 'soa1_a2', 'soa2_a2', 'soa3_a2', + 'soa4_a2', 'soa5_a2', 'bc_c1', 'bc_c4', 'dst_c1', 'dst_c2', 'dst_c3', 'ncl_c1', 'ncl_c1', + 'ncl_c2', 'ncl_c3', 'pom_c1', 'pom_c4', 'so4_c1', 'so4_c2', 'so4_c3', 'soa1_c1', 'soa2_c1', + 'soa3_c1', 'soa4_c1', 'soa5_c1', 'soa1_c2', 'soa2_c2', 'soa3_c2', 'soa4_c2', 'soa5_c2', + 'bc_a1SFWET', 'num_a1','num_a2','num_a3','num_a4','num_c1','num_c2','num_c3','num_c4', + 'bc_a1SFWET', 'bc_a4SFWET', 'dst_a1SFWET', 'dst_a2SFWET', 'dst_a3SFWET', 'ncl_a1SFWET', + 'ncl_a2SFWET', 'ncl_a3SFWET', 'pom_a1SFWET', 'pom_a4SFWET', + 'so4_a1SFWET', 'so4_a2SFWET', 'so4_a3SFWET', 'soa1_a1SFWET', 'soa1_a2SFWET', + 'soa2_a1SFWET', 'soa2_a2SFWET', 'soa3_a1SFWET', 'soa3_a2SFWET', + 'soa4_a1SFWET', 'soa4_a2SFWET', 'soa5_a1SFWET', 'soa5_a2SFWET', 'bc_c1SFWET', + 'bc_c4SFWET', 'dst_c1SFWET', 'dst_c2SFWET', 'dst_c3SFWET', + 'ncl_c1SFWET', 'ncl_c2SFWET', 'ncl_c3SFWET', 'pom_c1SFWET', 'pom_c4SFWET', + 'so4_c1SFWET', 'so4_c2SFWET', 'so4_c3SFWET', 'soa1_c1SFWET', + 'soa1_c2SFWET', 'soa2_c1SFWET', 'soa2_c2SFWET', 'soa3_c1SFWET', 'soa3_c2SFWET', + 'soa4_c1SFWET', 'soa4_c2SFWET', 'soa5_c1SFWET', 'soa5_c2SFWET', + 'bc_a1DDF', 'bc_a4DDF', 'dst_a1DDF', 'dst_a2DDF', 'dst_a3DDF', 'ncl_a1DDF', + 'ncl_a2DDF', 'ncl_a3DDF', 'pom_a1DDF', + 'pom_a4DDF', 'so4_a1DDF', 'so4_a2DDF', 'so4_a3DDF', 'soa1_a1DDF', + 'soa1_a2DDF', 'soa2_a1DDF', 'soa2_a2DDF', 'soa3_a1DDF', + 'soa3_a2DDF', 'soa4_a1DDF', 'soa4_a2DDF', 'soa5_a1DDF', 'soa5_a2DDF', + 'bc_c1DDF', 'bc_c4DDF', 'dst_c1DDF', 'dst_c2DDF', + 'dst_c3DDF', 'ncl_c1DDF', 'ncl_c2DDF', 'ncl_c3DDF', 'pom_c1DDF', + 'pom_c4DDF', 'so4_c1DDF', 'so4_c2DDF', 'so4_c3DDF', + 'soa1_c1DDF', 'soa1_c2DDF', 'soa2_c1DDF', 'soa2_c2DDF', 'soa3_c1DDF', + 'soa3_c2DDF', 'soa4_c1DDF', 'soa4_c2DDF', 'soa5_c1DDF', + 'soa5_c2DDF', 'num_a1DDF', 'num_a2DDF', 'num_a3DDF', 'num_a4DDF', + 'num_c1DDF', 'num_c2DDF', 'num_c3DDF', 'num_c4DDF', + 'bc_a4_CLXF', 'pom_a4_CLXF', 'so4_a1_CLXF', 'so4_a2_CLXF', + 'num_a1_CLXF', 'num_a2_CLXF', 'SFbc_a4', 'SFpom_a4', 'SFso4_a1', + 'SFso4_a2', 'SFnum_a1', 'SFnum_a2', 'SFnum_a3', 'so4_a1_sfgaex1', + 'so4_a2_sfgaex1', 'so4_a3_sfgaex1', 'soa1_a1_sfgaex1', 'soa1_a2_sfgaex1', + 'soa2_a1_sfgaex1', 'soa2_a2_sfgaex1', 'soa3_a1_sfgaex1', 'soa3_a2_sfgaex1', + 'soa4_a1_sfgaex1', 'soa4_a2_sfgaex1', 'soa5_a1_sfgaex1', 'soa5_a2_sfgaex1', + 'so4_a2_sfnnuc1', 'so4_c1AQH2SO4', 'so4_c2AQH2SO4', 'so4_c3AQH2SO4', + 'so4_c1AQSO4', 'so4_c2AQSO4', 'so4_c3AQSO4', 'SFdst_a1', 'SFdst_a2', 'SFdst_a3', + 'SFncl_a1', 'SFncl_a2', 'SFncl_a3', + 'TMOCS', 'TMSO2', 'TMso4_a1', 'TMso4_a2', 'TMso4_a3', + 'BURDENDUSTdn', 'BURDENPOMdn', 'BURDENSO4dn', 'BURDENSOAdn', + 'BURDENSEASALTdn','BURDENBCdn', 'PM25' + + + + 'ACET','ACTA','ALD2','ASOG1','ASOG2','ASOG3','ATOOH','Br2','BrCl','BrNO3','CH2O','Cl2','ClNO2','ClNO3','ClO','ClOO','EOH','ETHLN','ETNO3','ETP','GLYC','GLYX','H2O2','HAC','HBr','HC5A','HCl','HCOOH','Hg0','Hg0_ANT','Hg0_ARC','Hg0_ATL','Hg0_BB','Hg0_CAM','Hg0_CAN','Hg0_EAF','Hg0_EAS','Hg0_EEU','Hg0_EUR','Hg0_GEO','Hg0_JPN','Hg0_MDE','Hg0_NAF','Hg0_NAT','Hg0_NPA','Hg0_OCE','Hg0_OCN','Hg0_SAF','Hg0_SAM','Hg0_SAS','Hg0_SAT','Hg0_SEA','Hg0_SO','Hg0_SOV','Hg0_STR','Hg0_USA','Hg0_WAF','Hg2','Hg2_ANT','Hg2_ARC','Hg2_ATL','Hg2_BB','Hg2_CAM','Hg2_CAN','Hg2_EAF','Hg2_EAS','Hg2_EEU','Hg2_EUR','Hg2_GEO','Hg2_JPN','Hg2_MDE','Hg2_NAF','Hg2_NAT','Hg2_NPA','Hg2_OCE','Hg2_OCN','Hg2_SAF','Hg2_SAM','Hg2_SAS','Hg2_SAT','Hg2_SEA','Hg2_SO','Hg2_SOV','Hg2_STR','Hg2_USA','Hg2_WAF','HI','HMHP','HMML','HNO3','HOBr','HOCl','HOI','HONIT','HPALD1','HPALD2','HPALD3','HPALD4','HPETHNL','I2','I2O2','I2O3','I2O4','IBr','ICHE','ICl','ICN','ICPDH','IDC','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','IPRNO3','ITCN','ITHN','LIMO','LVOC','MACR','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MENO3','MGLY','MOH','MONITS','MONITU','MPAN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','N2O5','NH3','NO2','NPRNO3','O3','O3AFBL','O3ASBL','O3ATBL','O3EUBL','O3INIT','O3MT','O3NABL','O3PCBL','O3ROW','O3Strat','O3USA','O3UT','OPOG1','OPOG2','PAN','POG1','POG2','POPG_BAP','POPG_PHE','POPG_PYR','PP','PPN','PROPNN','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2','TSOG0','TSOG1','TSOG2','TSOG3','AERI','ASOA1','ASOA2','ASOA3','ASOAN','BCPI','BCPO','Be10','Be10Strat','Be7','Be7Strat','BrSALA','BrSALC','DST1','DST2','DST3','DST4','DSTAL1','DSTAL2','DSTAL3','DSTAL4','HgP','HgP_ANT','HgP_ARC','HgP_ATL','HgP_BB','HgP_CAM','HgP_CAN','HgP_EAF','HgP_EAS','HgP_EEU','HgP_EUR','HgP_GEO','HgP_JPN','HgP_MDE','HgP_NAF','HgP_NAT','HgP_NPA','HgP_OCE','HgP_OCN','HgP_SAF','HgP_SAM','HgP_SAS','HgP_SAT','HgP_SEA','HgP_SO','HgP_SOV','HgP_STR','HgP_USA','HgP_WAF','INDIOL','IONITA','ISALA','ISALC','LVOCOA','MONITA','MOPI','MOPO','MSA','NH4','NIT','NITD1','NITD2','NITD3','NITD4','NITs','OCPI','OCPO','OPOA1','OPOA2','Pb210','Pb210Strat','pFe','POA1','POA2','POPPBCPI_BAP','POPPBCPI_PHE','POPPBCPI_PYR','POPPBCPO_BAP','POPPBCPO_PHE','POPPBCPO_PYR','POPPOCPI_BAP','POPPOCPI_PHE','POPPOCPI_PYR','POPPOCPO_BAP','POPPOCPO_PHE','POPPOCPO_PYR','SALA','SALAAL','SALACL','SALC','SALCAL','SALCCL','SO4','SO4D1','SO4D2','SO4D3','SO4D4','SO4S','SOAGX','SOAIE','SOAS','TSOA0','TSOA1','TSOA2','TSOA3', + + + + 'dst_a1','so4_a1','nh4_a1','pom_a1','pomff1_a1','pombb1_a1','soa_a1','bc_a1','ncl_a1','num_a1','so4_a2','nh4_a2','soa_a2','ncl_a2','dst_a2','num_a2','dst_a3','ncl_a3','so4_a3','pom_a3','bc_a3','num_a3','ncl_a4','so4_a4','pom_a4','pomff1_a4','pombb1_a4','bc_a4','nh4_a4','num_a4','dst_a5','so4_a5','nh4_a5','num_a5','ncl_a6','so4_a6','nh4_a6','num_a6','dst_a7','so4_a7','nh4_a7','num_a7','soa1_a1','soa1_a2','soa2_a1','soa2_a2','soa3_a1','soa3_a2','soa4_a1','soa4_a2','soa5_a1','soa5_a2','soaff1_a1','soaff2_a1','soaff3_a1','soaff4_a1','soaff5_a1','soabb1_a1','soabb2_a1','soabb3_a1','soabb4_a1','soabb5_a1','soabg1_a1','soabg2_a1','soabg3_a1','soabg4_a1','soabg5_a1','soaff1_a2','soaff2_a2','soaff3_a2','soaff4_a2','soaff5_a2','soabb1_a2','soabb2_a2','soabb3_a2','soabb4_a2','soabb5_a2','soabg1_a2','soabg2_a2','soabg3_a2','soabg4_a2','soabg5_a2' + + + + 'ACTA','ALD2','ASOG1','ASOG2','ASOG3','ATOOH','Br2','BrCl','CH2O','EOH','ETHLN','ETP','GLYC','GLYX','H2O2','HAC','HBr','HC5A','HCl','HCOOH','Hg2','Hg2_ANT','Hg2_ARC','Hg2_ATL','Hg2_BB','Hg2_CAM','Hg2_CAN','Hg2_EAF','Hg2_EAS','Hg2_EEU','Hg2_EUR','Hg2_GEO','Hg2_JPN','Hg2_MDE','Hg2_NAF','Hg2_NAT','Hg2_NPA','Hg2_OCE','Hg2_OCN','Hg2_SAF','Hg2_SAM','Hg2_SAS','Hg2_SAT','Hg2_SEA','Hg2_SO','Hg2_SOV','Hg2_STR','Hg2_USA','Hg2_WAF','HI','HMHP','HMML','HNO3','HOBr','HOCl','HOI','HONIT','HPETHNL','I2','I2O2','I2O3','I2O4','IBr','ICHE','ICl','ICN','ICPDH','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','ITCN','ITHN','LIMO','LVOC','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MEK','MGLY','MOH','MONITS','MONITU','MP','MPAN','MPN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','NH3','OPOG1','OPOG2','PAN','POG1','POG2','POPG_BAP','POPG_PHE','POPG_PYR','PP','PPN','PROPNN','PRPE','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2','TSOG0','TSOG1','TSOG2','TSOG3','AERI','ASOA1','ASOA2','ASOA3','ASOAN','BCPI','BCPO','Be10','Be10Strat','Be7','Be7Strat','BrSALA','BrSALC','DST1','DST2','DST3','DST4','DSTAL1','DSTAL2','DSTAL3','DSTAL4','HgP','HgP_ANT','HgP_ARC','HgP_ATL','HgP_BB','HgP_CAM','HgP_CAN','HgP_EAF','HgP_EAS','HgP_EEU','HgP_EUR','HgP_GEO','HgP_JPN','HgP_MDE','HgP_NAF','HgP_NAT','HgP_NPA','HgP_OCE','HgP_OCN','HgP_SAF','HgP_SAM','HgP_SAS','HgP_SAT','HgP_SEA','HgP_SO','HgP_SOV','HgP_STR','HgP_USA','HgP_WAF','INDIOL','IONITA','ISALA','ISALC','LVOCOA','MONITA','MOPI','MOPO','MSA','NH4','NIT','NITD1','NITD2','NITD3','NITD4','NITs','OCPI','OCPO','OPOA1','OPOA2','Pb210','Pb210Strat','pFe','POA1','POA2','POPPBCPI_BAP','POPPBCPI_PHE','POPPBCPI_PYR','POPPBCPO_BAP','POPPBCPO_PHE','POPPBCPO_PYR','POPPOCPI_BAP','POPPOCPI_PHE','POPPOCPI_PYR','POPPOCPO_BAP','POPPOCPO_PHE','POPPOCPO_PYR','SALA','SALAAL','SALACL','SALC','SALCAL','SALCCL','SO4','SO4D1','SO4D2','SO4D3','SO4D4','SO4S','SOAGX','SOAIE','SOAS','TSOA0','TSOA1','TSOA2','TSOA3', + + + + 'dst_a1','so4_a1','nh4_a1','pom_a1','pomff1_a1','pombb1_a1','soa_a1','bc_a1','ncl_a1','num_a1','so4_a2','nh4_a2','soa_a2','ncl_a2','dst_a2','num_a2','dst_a3','ncl_a3','so4_a3','pom_a3','bc_a3','num_a3','ncl_a4','so4_a4','pom_a4','pomff1_a4','pombb1_a4','bc_a4','nh4_a4','num_a4','dst_a5','so4_a5','nh4_a5','num_a5','ncl_a6','so4_a6','nh4_a6','num_a6','dst_a7','so4_a7','nh4_a7','num_a7','soa1_a1','soa1_a2','soa2_a1','soa2_a2','soa3_a1','soa3_a2','soa4_a1','soa4_a2','soa5_a1','soa5_a2','soaff1_a1','soaff2_a1','soaff3_a1','soaff4_a1','soaff5_a1','soabb1_a1','soabb2_a1','soabb3_a1','soabb4_a1','soabb5_a1','soabg1_a1','soabg2_a1','soabg3_a1','soabg4_a1','soabg5_a1','soaff1_a2','soaff2_a2','soaff3_a2','soaff4_a2','soaff5_a2','soabb1_a2','soabb2_a2','soabb3_a2','soabb4_a2','soabb5_a2','soabg1_a2','soabg2_a2','soabg3_a2','soabg4_a2','soabg5_a2' + + + diff --git a/bld/perl5lib/Build/ChemNamelist.pm b/bld/perl5lib/Build/ChemNamelist.pm index 0cf0114337..5f95ad9f2f 100644 --- a/bld/perl5lib/Build/ChemNamelist.pm +++ b/bld/perl5lib/Build/ChemNamelist.pm @@ -66,31 +66,35 @@ sub set_dep_lists if ($print_lvl>=2) {print "Chemistry species : @species_list \n" ;} if (!defined $nl->get_value('gas_wetdep_list')) { - $gas_wetdep_list = get_gas_wetdep_list( $cfgdir, $print_lvl, @species_list ); + $gas_wetdep_list = get_gas_wetdep_list( $cfgdir, $print_lvl, @species_list ); } else { $gas_wetdep_list = $nl->get_value('gas_wetdep_list'); $gas_wetdep_list = filter_dep_list( $gas_wetdep_list, $print_lvl, @species_list ); + if ($print_lvl>=2) {print " gas wet dep list : $gas_wetdep_list \n" ;} } if (!defined $nl->get_value('aer_wetdep_list')) { - $aer_wetdep_list = get_aer_wetdep_list( $cfgdir, $print_lvl, @species_list ); + $aer_wetdep_list = get_aer_wetdep_list( $cfgdir, $print_lvl, @species_list ); } else { $aer_wetdep_list = $nl->get_value('aer_wetdep_list'); $aer_wetdep_list = filter_dep_list( $aer_wetdep_list, $print_lvl, @species_list ); + if ($print_lvl>=2) {print " aer wet dep list : $aer_wetdep_list \n" ;} } if (!defined $nl->get_value('drydep_list')) { - $gas_drydep_list = get_gas_drydep_list( $cfgdir, $print_lvl, @species_list ); + $gas_drydep_list = get_gas_drydep_list( $cfgdir, $print_lvl, @species_list ); } else { $gas_drydep_list = $nl->get_value('drydep_list'); $gas_drydep_list = filter_dep_list( $gas_drydep_list, $print_lvl, @species_list ); + if ($print_lvl>=2) {print " dry dep list : $gas_drydep_list \n" ;} } if (!defined $nl->get_value('aer_drydep_list')) { - $aer_drydep_list = get_aer_drydep_list( $cfgdir, $print_lvl, @species_list ); + $aer_drydep_list = get_aer_drydep_list( $cfgdir, $print_lvl, @species_list ); } else { $aer_drydep_list = $nl->get_value('aer_drydep_list'); $aer_drydep_list = filter_dep_list( $aer_drydep_list, $print_lvl, @species_list ); + if ($print_lvl>=2) {print " aer dry dep list : $aer_drydep_list \n" ;} } # set solubility factors for aerosols diff --git a/cime_config/buildnml b/cime_config/buildnml index b12f690263..cb3a9412e9 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -36,6 +36,7 @@ def buildnml(case, caseroot, compname): din_loc_root = case.get_value("DIN_LOC_ROOT") atm_ncpl = case.get_value("ATM_NCPL") CAM_NAMELIST_OPTS = case.get_value("CAM_NAMELIST_OPTS") + CAM_CONFIG_OPTS = case.get_value("CAM_CONFIG_OPTS") CAM_NML_USE_CASE = case.get_value("CAM_NML_USE_CASE") DEBUG = case.get_value("DEBUG") NINST_ATM = case.get_value("NINST_ATM") @@ -175,17 +176,52 @@ def buildnml(case, caseroot, compname): rc, out, err = run_cmd(cmd, from_dir=camconf) expect(rc==0,"Command %s failed rc=%d\nout=%s\nerr=%s"%(cmd,rc,out,err)) + # ----------------------------------------------------- + # For GEOS-Chem / HEMCO only: + # Copy input files from storage location into Buildconf/camconf + # This only needs to be done once + # ----------------------------------------------------- + + # We use this to figure out if we are using the GEOS-Chem chemistry + # mechanism. + # Might have to do something else with HEMCO_CESM? + if '-chem geoschem' in CAM_CONFIG_OPTS: + geoschem_src = os.path.join(srcroot, "src/chemistry/geoschem/geoschem_src") + if not os.path.isdir(geoschem_src): + raise SystemExit("ERROR: Did not find path to GEOS-Chem source code at {:s}".format(geoschem_src)) + if os.path.isdir(rundir): + for fileName in ['species_database.yml', 'input.geos', + 'HISTORY.rc', 'HEMCO_Config.rc', 'HEMCO_Diagn.rc']: + file1 = os.path.join(geoschem_src, "run/CESM", fileName) + file2 = os.path.join(camconf, fileName) + if not os.path.exists(file2): + logger.info("CAM namelist one-time copy: file1 %s file2 %s ", file1, file2) + shutil.copy(file1,file2) + # ----------------------------------------------------- # copy resolved namelist, atm_in, to rundir # ----------------------------------------------------- if os.path.isdir(rundir): - file1 = os.path.join(camconf, "atm_in") - file2 = os.path.join(rundir, "atm_in") - if ninst > 1: - file2 += inst_string - logger.info("CAM namelist copy: file1 %s file2 %s ", file1, file2) - shutil.copy(file1,file2) + for fileName in ['atm_in', 'species_database.yml', 'input.geos', + 'HISTORY.rc', 'HEMCO_Config.rc', 'HEMCO_Diagn.rc']: + file1 = os.path.join(camconf, fileName) + file2 = os.path.join(rundir, fileName) + if fileName == 'atm_in' and ninst > 1: + file2 += inst_string + if os.path.exists(file1) or fileName == 'atm_in': + logger.info("CAM namelist copy: file1 %s file2 %s ", file1, file2) + shutil.copy(file1,file2) + + if fileName == 'input.geos': + # We need to replace the simulation name by "Standard" + # in input.geos + # This should already be the case, but just making sure + with open(file2, 'r') as file: + inputGC = file.read() + inputGC = inputGC.replace('{SIM}', 'Standard') + with open(file2, 'w') as file: + file.write(inputGC) # ----------------------------------------------------- # copy drv_flds_in to rundir if it does not exist diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index fdc00f964b..c700a521ea 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -8,10 +8,10 @@ CAM =============== --> - CAM cam6 physics: - CAM cam5 physics: - CAM cam4 physics: - CAM simplified and non-versioned physics : + CAM cam6 physics: + CAM cam5 physics: + CAM cam4 physics: + CAM simplified and non-versioned physics : CAM-Chem troposphere/stratosphere chem with simplified volatility basis set SOA scheme and modal aersols : + GEOS-Chem troposphere/stratosphere chemistry : CAM-Chem troposphere/stratosphere chem with simplified volatility basis set SOA scheme and fire emissons : CAM CLUBB - turned on by default in CAM60: - CAM-Chem troposphere/stratosphere chem with extended volatility basis set SOA scheme and modal aersols : + CAM-Chem troposphere/stratosphere chem with extended volatility basis set SOA scheme and modal aerosols : CAM CO2 ramp: CAM super-parameterized CAM one moment SAM microphysics CAM super-parameterized CAM one moment SAM microphysics using CLUBB CAM super-parameterized CAM double moment m2005 SAM microphysics + CAM super-parameterized CAM double moment m2005 SAM microphysics using GEOS-Chem CAM super-parameterized CAM double moment m2005 SAM microphysics using CLUBB CAM tropospheric chemistry with bulk aerosols: @@ -65,7 +67,6 @@ CAM dry adiabatic baroclinic instability (Polvani et al., 2004): CAM moist Held-Suarez forcing (Thatcher and Jablonowski, 2016): CAM dry Held-Suarez forcing (Held and Suarez (1994)): - CAM with GEOS-Chem: CAM with GEOS-Chem dycore test: CAM moist dynamical core test with Ullrich et al. (2014) baroclinic wave IC, Kessler physics and terminator chemistry: @@ -119,12 +120,14 @@ -chem trop_strat_mam4_vbs + -chem geoschem_mam4 -chem trop_strat_mam4_vbsext -clubb_sgs -dyn eul -scam -rad camrt -chem none -spcam_nx 32 -spcam_ny 1 -spcam_dx 4000 -spcam_dt 20 -phys spcam_sam1mom -rad camrt -chem none -spcam_nx 32 -spcam_ny 1 -spcam_dx 4000 -spcam_dt 20 -phys spcam_sam1mom -spcam_clubb_sgs -rad rrtmg -chem trop_mam3 -spcam_nx 32 -spcam_ny 1 -spcam_dx 4000 -spcam_dt 20 -phys spcam_m2005 + -rad rrtmg -chem geoschem_mam3 -spcam_nx 32 -spcam_ny 1 -spcam_dx 4000 -spcam_dt 20 -phys spcam_m2005 -rad rrtmg -chem trop_mam3 -spcam_nx 32 -spcam_ny 1 -spcam_dx 4000 -spcam_dt 20 -phys spcam_m2005 -spcam_clubb_sgs -chem trop_mozart @@ -147,6 +150,7 @@ -offline_dyn -nlev 56 -nlev 56 + -nlev 56 -nlev 88 -nlev 145 @@ -157,6 +161,7 @@ -phys tj2016 -analytic_ic -phys held_suarez -chem geoschem + -chem geoschem_mam4 -phys held_suarez -chem geoschem -analytic_ic -phys kessler -chem terminator -analytic_ic @@ -195,11 +200,17 @@ 2000_cam4_trop_chem waccmxie_ma_2000_cam4 + geoschem + geoschem + geoschem + geoschem_baro_moist + 2000_cam6 waccm_tsmlt_2000_cam6 waccm_ma_2000_cam6 waccm_sc_2000_cam6 2000_trop_strat_vbs_cam6 + geoschem_2000 aquaplanet_cam4 aquaplanet_cam4 @@ -212,6 +223,7 @@ 2010_trop_strat_vbs_cam6 waccm_tsmlt_2010_cam6 waccm_sc_2010_cam6 + geoschem_2010 1850-2005_cam5 1850-2005_cam4 @@ -229,6 +241,7 @@ hist_trop_strat_vbs_cam6 hist_trop_strat_vbsext_cam6 hist_trop_strat_vbsfire_cam6 + hist_geoschem 1850-PD_cam5 @@ -250,6 +263,7 @@ sd_waccm_ma_cam6 sd_waccm_ma_cam4 sd_trop_strat_vbs_cam6 + sd_geoschem sd_cam6 dabi_p2004 @@ -260,9 +274,6 @@ scam_arm97 - geoschem - geoschem - geoschem_baro_moist run_component_cam env_run.xml diff --git a/cime_config/config_compsets.xml b/cime_config/config_compsets.xml index 1c637f1d73..70b41adfe5 100644 --- a/cime_config/config_compsets.xml +++ b/cime_config/config_compsets.xml @@ -382,30 +382,35 @@ + + + + + - GEOSCHEM - 2000_CAM40%GC_SLND_SICE_SOCN_SROF_SGLC_SWAV + FSPCAMM_GC + 2000_CAM%SPCAMMGC_CLM50%SP_CICE%PRES_DOCN%DOM_RTM_SGLC_SWAV - GEOSCHEMTEST - 2000_CAM%GCHS_SLND_SICE_SOCN_SROF_SGLC_SWAV + FC2000climo_GC + 2000_CAM60%GC_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV - FGC - 2000_CAM40%GC_CLM40%SP_CICE%PRES_DOCN%DOM_RTM_SGLC_SWAV + FC2010climo_GC + 2010_CAM60%GC_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV - FGC_CLM45 - 2000_CAM40%GC_CLM45%SP_CICE%PRES_DOCN%DOM_RTM_SGLC_SWAV + FCHIST_GC + HIST_CAM60%GC_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV - FGC_CLM50 - 2000_CAM40%GC_CLM50%SP_CICE%PRES_DOCN%DOM_RTM_SGLC_SWAV + FCSD_GC + HIST_CAM60%GC%SDYN_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV @@ -595,6 +600,7 @@ 1 1 + 1 @@ -602,6 +608,7 @@ 1 1 + 1 @@ -609,6 +616,7 @@ 1 1 + 1 @@ -616,6 +624,7 @@ 1 1 + 1 @@ -623,6 +632,7 @@ 1 1 + 1 @@ -630,6 +640,7 @@ 1 1 + 1 @@ -637,6 +648,7 @@ 1 1 + 1 @@ -644,6 +656,7 @@ 1 1 + 1 @@ -651,6 +664,7 @@ 1 1 + 1 @@ -658,6 +672,7 @@ 1 1 + 1 diff --git a/cime_config/config_pes.xml b/cime_config/config_pes.xml index d4e7ae45c8..89b4290731 100644 --- a/cime_config/config_pes.xml +++ b/cime_config/config_pes.xml @@ -1698,6 +1698,18 @@ 1 + + + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + diff --git a/src/chemistry/aerosol/drydep_mod.F90 b/src/chemistry/aerosol/aer_drydep_mod.F90 similarity index 99% rename from src/chemistry/aerosol/drydep_mod.F90 rename to src/chemistry/aerosol/aer_drydep_mod.F90 index 1e83641d71..512a8bdc5b 100644 --- a/src/chemistry/aerosol/drydep_mod.F90 +++ b/src/chemistry/aerosol/aer_drydep_mod.F90 @@ -1,4 +1,4 @@ -module drydep_mod +module aer_drydep_mod use shr_kind_mod, only: r8 => shr_kind_r8 use ppgrid @@ -265,4 +265,4 @@ end subroutine calcram !############################################################################## -end module drydep_mod +end module aer_drydep_mod diff --git a/src/chemistry/bulk_aero/aero_model.F90 b/src/chemistry/bulk_aero/aero_model.F90 index 4c3d0ab80e..c5c25abc74 100644 --- a/src/chemistry/bulk_aero/aero_model.F90 +++ b/src/chemistry/bulk_aero/aero_model.F90 @@ -124,16 +124,16 @@ end subroutine aero_model_register !============================================================================= subroutine aero_model_init( pbuf2d ) - use mo_chem_utls, only: get_inv_ndx, get_spc_ndx - use cam_history, only: addfld, add_default, horiz_only - use phys_control, only: phys_getopts - use mo_aerosols, only: aerosols_inti - use mo_setsoa, only: soa_inti - use dust_model, only: dust_init - use seasalt_model, only: seasalt_init - use drydep_mod, only: inidrydep - use wetdep, only: wetdep_init - use mo_setsox, only: has_sox + use mo_chem_utls, only: get_inv_ndx, get_spc_ndx + use cam_history, only: addfld, add_default, horiz_only + use phys_control, only: phys_getopts + use mo_aerosols, only: aerosols_inti + use mo_setsoa, only: soa_inti + use dust_model, only: dust_init + use seasalt_model, only: seasalt_init + use aer_drydep_mod, only: inidrydep + use wetdep, only: wetdep_init + use mo_setsox, only: has_sox ! args type(physics_buffer_desc), pointer :: pbuf2d(:,:) @@ -384,7 +384,7 @@ end subroutine aero_model_init subroutine aero_model_drydep ( state, pbuf, obklen, ustar, cam_in, dt, cam_out, ptend ) use dust_sediment_mod, only: dust_sediment_tend - use drydep_mod, only: d3ddflux, calcram + use aer_drydep_mod, only: d3ddflux, calcram use dust_model, only: dust_depvel, dust_nbin, dust_names use seasalt_model, only: sslt_depvel=>seasalt_depvel, sslt_nbin=>seasalt_nbin, sslt_names=>seasalt_names diff --git a/src/chemistry/pp_geoschem/.exclude b/src/chemistry/geoschem/.exclude similarity index 84% rename from src/chemistry/pp_geoschem/.exclude rename to src/chemistry/geoschem/.exclude index 313c41158c..b0c26be3ef 100644 --- a/src/chemistry/pp_geoschem/.exclude +++ b/src/chemistry/geoschem/.exclude @@ -4,20 +4,20 @@ tpcore_window_mod.F90 tpcore_fvdas_mod.F90 flexgrid_read_mod.F90 get_met_mod.F90 -pops_mod.F90 planeflight_mod.F90 -diag51_mod.F90 diag1.F90 diag03_mod.F90 diag3.F90 +diag51_mod.F90 diag51b_mod.F90 diag53_mod.F90 emissions_mod.F90 gamap_mod.F90 +gosat_ch4_mod.F90 +tccon_ch4_mod.F90 initialize.F90 -input_mod.F90 cleanup.F90 main.F90 hcoi_gc_diagn_include.H hcoi_gc_diagn_mod.F90 -hco_interface_gc_mod.F90 \ No newline at end of file +hco_interface_gc_mod.F90 diff --git a/src/chemistry/geoschem/cesmgc_diag_mod.F90 b/src/chemistry/geoschem/cesmgc_diag_mod.F90 new file mode 100644 index 0000000000..7c3180ddd6 --- /dev/null +++ b/src/chemistry/geoschem/cesmgc_diag_mod.F90 @@ -0,0 +1,1460 @@ +!------------------------------------------------------------------------------ +! "GEOS-Chem" chemistry diagnostics interface ! +!------------------------------------------------------------------------------ +!BOP +! +! !MODULE: cesmgc_diag_mod.F90 +! +! !DESCRIPTION: Module cesmgc\_diag\_mod contains routines which aim to +! diagnose variables from GEOS-Chem +!\\ +!\\ +! !INTERFACE: +! +MODULE CESMGC_Diag_Mod +! +! !USES: +! + USE SHR_KIND_MOD, ONLY : r8 => shr_kind_r8 + USE SHR_CONST_MOD, ONLY : pi => shr_const_pi + USE CAM_HISTORY, ONLY : fieldname_len + USE CONSTITUENTS, ONLY : pcnst + USE CHEM_MODS, ONLY : gas_pcnst, map2chm + USE CHEM_MODS, ONLY : iFirstCnst + USE MO_TRACNAME, ONLY : solsym + USE SPMD_UTILS, ONLY : MasterProc + USE PPGRID, ONLY : begchunk, pver + USE CAM_LOGFILE, ONLY : iulog + USE STRING_UTILS, ONLY : to_upper + USE Error_Mod ! For error checking + USE ErrCode_Mod ! Error codes for success or failure + + IMPLICIT NONE + + PRIVATE + +! +! !PUBLIC MEMBER FUNCTIONS: +! + PUBLIC :: CESMGC_Diag_Init + PUBLIC :: CESMGC_Diag_Calc + PUBLIC :: wetdep_name, wtrate_name + + INTEGER :: nPhotol ! Number of diagnosed photolytic reactions + CHARACTER(LEN=fieldname_len) :: srcnam(gas_pcnst) ! Names of source/sink tendencies + CHARACTER(LEN=fieldname_len) :: wetdep_name(gas_pcnst) ! Wet deposition tendencies + CHARACTER(LEN=fieldname_len) :: wtrate_name(gas_pcnst) ! Column tendencies for wet dep + CHARACTER(LEN=fieldname_len) :: dtchem_name(gas_pcnst) ! Chemical tendencies + CHARACTER(LEN=16) :: sflxnam_loc(pcnst) ! Names of surface fluxes + + ! Chemical families + INTEGER :: NOx_species(3) + INTEGER :: NOy_species(63) + INTEGER :: HOx_species(4) + INTEGER :: ClOx_species(6) + INTEGER :: ClOy_species(11) + INTEGER :: tCly_species(30) + INTEGER :: BrOx_species(4) + INTEGER :: BrOy_species(9) + INTEGER :: tBry_species(18) + INTEGER :: SOx_species(2) + INTEGER :: NHx_species(2) + INTEGER :: TOTH_species(3) + REAL(r8) :: NOx_MWs(3) + REAL(r8) :: NOy_MWs(64) + REAL(r8) :: HOx_MWs(4) + REAL(r8) :: ClOx_MWs(6) + REAL(r8) :: ClOy_MWs(11) + REAL(r8) :: tCly_MWs(30) + REAL(r8) :: BrOx_MWs(4) + REAL(r8) :: BrOy_MWs(9) + REAL(r8) :: tBry_MWs(18) + REAL(r8) :: SOx_MWs(2) + REAL(r8) :: NHx_MWs(2) + REAL(r8) :: TOTH_MWs(3) + + REAL(r8), PARAMETER :: MW_NIT = 62.01 + REAL(r8), PARAMETER :: MW_HNO3 = 63.01 + REAL(r8), PARAMETER :: MW_HCl = 36.45 + REAL(r8), PARAMETER :: MW_H2O = 18.02 + + ! NOx species + INTEGER :: i_NO, i_NO2, i_N + ! NOy \ NOx species + INTEGER :: i_BrNO2, i_BrNO3, i_ClNO2, i_ClNO3, i_ETHLN, i_ETNO3, & + i_HNO2, i_HNO3, i_HNO4, i_ICN, i_ICNOO, i_IDHNBOO, & + i_IDHNDOO1, i_IDN, i_IDNOO, i_IHN1, i_IHN2, & + i_IHN3, i_IHN4, i_IHPNBOO, i_IHPNDOO, i_INA, i_INO, & + i_INO2B, i_INO2D, i_INPB, i_INPD, i_IONO, i_IONO2, & + i_IPRNO3, i_ISOPNOO1, i_ISOPNOO2, i_ITCN, i_ITHN, & + i_MACRNO2, i_MCRHN, i_MCRHNB, i_MENO3, i_MONITS, i_MONITU, & + i_MPAN, i_MPN, i_MVKN, i_N2O5, i_NO3, i_NPRNO3, i_OLND, & + i_OLNN, i_PAN, i_PPN, i_PRN1, i_PROPNN, i_PRPN, i_R4N1, & + i_R4N2, i_HONIT, i_IONITA, i_NIT, i_NITs, i_NH4 + ! HOx + INTEGER :: i_H, i_OH, i_HO2, i_H2O2 + ! ClOx + INTEGER :: i_Cl, i_ClO, i_HOCl, i_Cl2, i_Cl2O2, i_OClO + ! tCly \ ClOx + INTEGER :: i_ClOO, i_HCl, i_BrCl, i_ICl, i_H1211, & + i_CFC115, i_CH3Cl, i_HCFC142b, i_HCFC22, i_CH2ICl, & + i_CFC114, i_CFC12, i_HCFC141b, i_HCFC123, i_CH2Cl2, & + i_CFC11, i_CH3CCl3, i_CHCl3, i_CCl4, i_CFC113, i_SALACL, & + i_SALCCL !ClNO2, ClNO3 already defined in NOy_species + ! BrOx + INTEGER :: i_Br, i_BrO, i_HOBr !BrCl already defined in tCly_species + ! Bry \ BrOx + INTEGER :: i_HBr, i_IBr, i_Br2, i_CH3Br, & + i_H1301, i_H2402, i_CH2Br2, i_CHBr3, i_BrSALA, i_BrSALC, & + i_CH2IBr + !BrNO2, BrNO3 already defined in NOy_speies + !H1211 already defined in tCly_species + ! SOx + INTEGER :: i_SO2, i_SO4 + ! NHx + INTEGER :: i_NH3 !NH4 already defined in NOy_species + ! TOTH + INTEGER :: i_CH4, i_H2O, i_H2 +! +! !REVISION HISTORY: +! 28 Oct 2020 - T. M. Fritz - Initial version +!EOP +!------------------------------------------------------------------------------ +!BOC +! +CONTAINS +! +!EOC +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: cesmgc_diag_init +! +! !DESCRIPTION: Subroutine CESMGC\_Diag\_Init declares the variables to +! diagnosethe +!\\ +!\\ +! !INTERFACE: +! + SUBROUTINE CESMGC_Diag_Init( Input_Opt, State_Chm, State_Met ) +! +! !USES: +! + USE Input_Opt_Mod, ONLY : OptInput + USE State_Chm_Mod, ONLY : ChmState + USE State_Met_Mod, ONLY : MetState + USE State_Diag_Mod, ONLY : get_TagInfo + USE Species_Mod, ONLY : Species + USE Registry_Mod, ONLY : MetaRegItem, RegItem + USE State_Chm_Mod, ONLY : Ind_ + USE CONSTITUENTS, ONLY : cnst_name, sflxnam + USE CONSTITUENTS, ONLY : cnst_get_ind + USE CAM_HISTORY, ONLY : addfld, add_default, horiz_only + USE DRYDEP_MOD, ONLY : depName +! +! !INPUT PARAMETERS: +! + TYPE(OptInput), INTENT(IN) :: Input_Opt ! Input options + TYPE(ChmState), INTENT(IN) :: State_Chm ! Chemistry State object + TYPE(MetState), INTENT(IN) :: State_Met ! Meteorology State object +! +! !REVISION HISTORY: +! 20 Oct 2020 - T. M. Fritz - Initial version +!EOP +!------------------------------------------------------------------------------ +!BOC +! + ! Integer + INTEGER :: M, N, SM + INTEGER :: idx + INTEGER :: RC + + ! Logical + LOGICAL :: Found + + ! Strings + CHARACTER(LEN=255) :: SpcName + CHARACTER(LEN=255) :: tagName + CHARACTER(LEN=255) :: ThisLoc + CHARACTER(LEN=255) :: ErrMsg + CHARACTER(LEN=2) :: unit_basename ! Units 'kg' or '1' + + ! Objects + TYPE(Species), POINTER :: SpcInfo + TYPE(MetaRegItem), POINTER :: Current + TYPE(RegItem ), POINTER :: Item + + !================================================================= + ! CESMGC_Diag_Init begins here! + !================================================================= + + ! Initialize pointers + SpcInfo => NULL() + Current => NULL() + Item => NULL() + + ! Assume a successful return until otherwise + RC = GC_SUCCESS + + CALL Addfld( 'MASS', (/ 'lev' /), 'A', 'kg', 'Mass of grid box' ) + CALL Addfld( 'AREA', horiz_only, 'A', 'm2', 'Area of grid box' ) + CALL Addfld( 'HEIGHT', (/ 'ilev' /),'A','m', 'Geopotential height above surface at interfaces' ) + + ! Note that constituents are already output by default + ! Add all species as output fields if desired + DO N = 1, gas_pcnst + M = map2chm(N) + IF ( M > 0 ) THEN + ! It's a GEOS-Chem species + SpcName = to_upper(TRIM(solsym(N))) + CALL AddFld( TRIM(SpcName), (/ 'lev' /), 'A', 'mol/mol', & + TRIM(SpcName)//' volume mixing ratio') + CALL AddFld( TRIM(SpcName)//'_SRF', horiz_only, 'A', 'mol/mol', & + TRIM(SpcName)//' in bottom layer') + IF (TRIM(SpcName) == 'O3') CALL Add_Default( TRIM(SpcName), 2, ' ' ) + ELSE + ! MAM aerosols + SpcName = TRIM(solsym(N)) + unit_basename = 'kg' + IF ( SpcName(1:3) == 'num' ) unit_basename = ' 1' + CALL AddFld( TRIM(SpcName), (/ 'lev' /), 'A', unit_basename//'/kg', & + TRIM(SpcName)//' concentration' ) + CALL AddFld( TRIM(SpcName)//'_SRF', horiz_only, 'A', unit_basename//'/kg', & + TRIM(SpcName)//' in bottom layer' ) + ENDIF + ENDDO + + IF ( Input_Opt%LDryD ) THEN + DO N = 1, State_Chm%nDryDep + SpcName = 'DV_'//to_upper(TRIM(depName(N))) + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'm/s', & + TRIM(SpcName)//' dry deposition velocity') + ENDDO + + DO N = 1, State_Chm%nAdvect + ! Get the species ID from the advected species ID + M = State_Chm%Map_Advect(N) + + ! Get info about this species from the species database + SpcInfo => State_Chm%SpcData(M)%Info + SpcName = 'DF_'//to_upper(TRIM(SpcInfo%Name)) + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'kg/m2/s', & + TRIM(SpcName)//' dry deposition flux') + + ! Free pointer + SpcInfo => NULL() + ENDDO + ENDIF + + sflxnam_loc(:) = '' + ! Chemical tendencies and surface fluxes + DO N = 1, gas_pcnst + IF ( map2chm(N) > 0 ) THEN + ! If this is a GEOS-Chem species then capitalize. This avoids + ! issues where Br2 /= BR2 + srcnam(N) = 'CT_'//to_upper(TRIM(solsym(N))) ! chem tendency (source/sink) + ELSE + ! For MAM aerosols, keep as it is (i.e. bc_a1) + srcnam(N) = 'CT_'//TRIM(solsym(N)) ! chem tendency (source/sink) + ENDIF + SpcName = srcnam(N) + CALL Addfld( TRIM(SpcName), (/ 'lev' /), 'A', 'kg/kg/s', TRIM(SpcName)//' source/sink' ) + + SpcName = TRIM(solsym(N)) + CALL cnst_get_ind( SpcName, M, abort=.false. ) + IF ( M > 0 ) THEN + IF (sflxnam(M)(3:5) == 'num') then ! name is in the form of "SF****" + unit_basename = ' 1' + ELSE + unit_basename = 'kg' + ENDIF + IF ( map2chm(N) > 0 ) THEN + sflxnam_loc(M) = to_upper(sflxnam(M)) + ELSE + sflxnam_loc(M) = sflxnam(M) + ENDIF + SpcName = sflxnam_loc(M) + CALL Addfld ( TRIM(SpcName), horiz_only, 'A', unit_basename//'/m2/s', & + TRIM(solsym(N))//' surface flux') + ENDIF + ENDDO + + CALL get_TagInfo( Input_Opt = Input_Opt, & + tagID = 'PHO', & + State_Chm = State_Chm, & + Found = Found, & + RC = RC, & + nTags = nPhotol ) + + ! Trap potential errors + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Abnormal exit from routine "Get_TagInfo", could not ' // & + ' get nTags!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + DO M = 1, nPhotol + CALL get_TagInfo( Input_Opt = Input_Opt, & + tagID = 'PHO', & + State_Chm = State_Chm, & + Found = Found, & + RC = RC, & + N = M, & + tagName = tagName ) + + ! Trap potential errors + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Abnormal exit from routine "Get_TagInfo"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + SpcName = 'Jval_' // TRIM( tagName ) + CALL Addfld( TRIM(SpcName), (/ 'lev' /), 'A', '1/s', & + TRIM(tagName) // ' photolysis rate' ) + ENDDO + ! Add Jval_O3O1D and Jval_O3O3P + SpcName = 'Jval_O3O1D' + CALL Addfld( TRIM(SpcName), (/ 'lev' /), 'A', '1/s', & + TRIM(tagName) // ' photolysis rate' ) + SpcName = 'Jval_O3O3P' + CALL Addfld( TRIM(SpcName), (/ 'lev' /), 'A', '1/s', & + TRIM(tagName) // ' photolysis rate' ) + + ! ========================================== + ! Now add fields corresponding to State_Met + ! ========================================== + + ! Copied from Headers/registry_mod.F90 + ! Point to the head node of the Registry + Current => State_Met%Registry + + ! As long as the current node isn't NULL + DO WHILE( ASSOCIATED( Current ) ) + + ! Get the REGISTRY ITEM belonging to this node of the Registry + Item => Current%Item + + ! Only print on the root CPU + IF ( ASSOCIATED( Item ) ) THEN + + !IF (( TRIM(Item%FullName(1:8)) /= 'MET_XLAI' ) .AND. & + ! ( TRIM(Item%FullName(1:8)) /= 'MET_IUSE' ) .AND. & + ! ( TRIM(Item%FullName(1:9)) /= 'MET_ILAND' )) THEN + ! IF ( TRIM(Item%DimNames) == 'xy' ) THEN + ! CALL Addfld( TRIM( Item%FullName ), horiz_only, 'A', & + ! TRIM( Item%Units ), TRIM( Item%Description ) ) + ! ELSE + ! CALL Addfld( TRIM( Item%FullName ), (/ 'lev' /), 'A', & + ! TRIM( Item%Units ), TRIM( Item%Description ) ) + ! ENDIF + !ENDIF + + ENDIF + + ! Point to next node of the Registry + Current => Current%Next + + ENDDO + + ! Chemical tendencies + DO N = 1, gas_pcnst + M = map2chm(N) + IF ( M > 0 ) THEN + dtchem_name(N) = 'D'//to_upper(TRIM(solsym(N)))//'CHM' + ELSE + dtchem_name(N) = 'D'//TRIM(solsym(N))//'CHM' + ENDIF + SpcName = TRIM(dtchem_name(N)) + CALL Addfld( TRIM(SpcName), (/ 'lev' /), 'A', 'kg/s', & + 'net tendency from chemistry' ) + ENDDO + + i_NO = Ind_('NO') + i_NO2 = Ind_('NO2') + i_N = Ind_('N') + i_BrNO2 = Ind_('BrNO2') + i_BrNO3 = Ind_('BrNO3') + i_ClNO2 = Ind_('ClNO2') + i_ClNO3 = Ind_('ClNO3') + i_ETHLN = Ind_('ETHLN') + i_ETNO3 = Ind_('ETNO3') + i_HNO2 = Ind_('HNO2') + i_HNO3 = Ind_('HNO3') + i_HNO4 = Ind_('HNO4') + i_ICN = Ind_('ICN') + i_ICNOO = Ind_('ICNOO') + i_IDHNBOO = Ind_('IDHNBOO') + i_IDHNDOO1 = Ind_('IDHNDOO1') + i_IDN = Ind_('IDN') + i_IDNOO = Ind_('IDNOO') + i_IHN1 = Ind_('IHN1') + i_IHN2 = Ind_('IHN2') + i_IHN3 = Ind_('IHN3') + i_IHN4 = Ind_('IHN4') + i_IHPNBOO = Ind_('IHPNBOO') + i_IHPNDOO = Ind_('IHPNDOO') + i_INA = Ind_('INA') + i_INO = Ind_('INO') + i_INO2B = Ind_('INO2B') + i_INO2D = Ind_('INO2D') + i_INPB = Ind_('INPB') + i_INPD = Ind_('INPD') + i_IONO = Ind_('IONO') + i_IONO2 = Ind_('IONO2') + i_IPRNO3 = Ind_('IPRNO3') + i_ISOPNOO1 = Ind_('ISOPNOO1') + i_ISOPNOO2 = Ind_('ISOPNOO2') + i_ITCN = Ind_('ITCN') + i_ITHN = Ind_('ITHN') + i_MACRNO2 = Ind_('MACRNO2') + i_MCRHN = Ind_('MCRHN') + i_MCRHNB = Ind_('MCRHNB') + i_MENO3 = Ind_('MENO3') + i_MONITS = Ind_('MONITS') + i_MONITU = Ind_('MONITU') + i_MPAN = Ind_('MPAN') + i_MPN = Ind_('MPN') + i_MVKN = Ind_('MVKN') + i_N2O5 = Ind_('N2O5') + i_NO3 = Ind_('NO3') + i_NPRNO3 = Ind_('NPRNO3') + i_OLND = Ind_('OLND') + i_OLNN = Ind_('OLNN') + i_PAN = Ind_('PAN') + i_PPN = Ind_('PPN') + i_PRN1 = Ind_('PRN1') + i_PROPNN = Ind_('PROPNN') + i_PRPN = Ind_('PRPN') + i_R4N1 = Ind_('R4N1') + i_R4N2 = Ind_('R4N2') + i_HONIT = Ind_('HONIT') + i_IONITA = Ind_('IONITA') + i_NIT = Ind_('NIT') + i_NITs = Ind_('NITs') + i_H = Ind_('H') + i_OH = Ind_('OH') + i_HO2 = Ind_('HO2') + i_H2O2 = Ind_('H2O2') + i_Cl = Ind_('Cl') + i_ClO = Ind_('ClO') + i_HOCl = Ind_('HOCl') + i_Cl2 = Ind_('Cl2') + i_Cl2O2 = Ind_('Cl2O2') + i_OClO = Ind_('OClO') + i_ClOO = Ind_('ClOO') + i_HCl = Ind_('HCl') + i_ClNO2 = Ind_('ClNO2') + i_ClNO3 = Ind_('ClNO3') + i_BrCl = Ind_('BrCl') + i_ICl = Ind_('ICl') + i_H1211 = Ind_('H1211') + i_CFC115 = Ind_('CFC115') + i_CH3Cl = Ind_('CH3Cl') + i_HCFC142b = Ind_('HCFC142b') + i_HCFC22 = Ind_('HCFC22') + i_CH2ICl = Ind_('CH2ICl') + i_CFC114 = Ind_('CFC114') + i_CFC12 = Ind_('CFC12') + i_HCFC141b = Ind_('HCFC141b') + i_HCFC123 = Ind_('HCFC123') + i_CH2Cl2 = Ind_('CH2Cl2') + i_CFC11 = Ind_('CFC11') + i_CH3CCl3 = Ind_('CH3CCl3') + i_CHCl3 = Ind_('CHCl3') + i_CCl4 = Ind_('CCl4') + i_CFC113 = Ind_('CFC113') + i_SALACL = Ind_('SALACL') + i_SALCCL = Ind_('SALCCL') + i_Br = Ind_('Br') + i_BrO = Ind_('BrO') + i_BrCl = Ind_('BrCl') + i_HOBr = Ind_('HOBr') + i_HBr = Ind_('HBr') + i_BrNO2 = Ind_('BrNO2') + i_BrNO3 = Ind_('BrNO3') + i_IBr = Ind_('IBr') + i_Br2 = Ind_('Br2') + i_CH3Br = Ind_('CH3Br') + i_H1211 = Ind_('H1211') + i_H1301 = Ind_('H1301') + i_H2402 = Ind_('H2402') + i_CH2Br2 = Ind_('CH2Br2') + i_CHBr3 = Ind_('CHBr3') + i_BrSALA = Ind_('BrSALA') + i_BrSALC = Ind_('BrSALC') + i_CH2IBr = Ind_('CH2IBr') + i_SO2 = Ind_('SO2') + i_SO4 = Ind_('SO4') + i_NH3 = Ind_('NH3') + i_NH4 = Ind_('NH4') + i_CH4 = Ind_('CH4') + i_H2O = Ind_('H2O') + i_H2 = Ind_('H2') + + NOx_species = (/ i_N, i_NO, i_NO2 /) + NOy_species = (/ i_N, i_NO, i_NO2, i_BrNO2, i_BrNO3, i_ClNO2, i_ClNO3,& + i_ETHLN, i_ETNO3, i_HNO2, i_HNO3, i_HNO4, i_ICN, & + i_ICNOO, i_IDHNBOO, i_IDHNDOO1, i_IDN, & + i_IDNOO, i_IHN1, i_IHN2, i_IHN3, i_IHN4, i_IHPNBOO, & + i_IHPNDOO, i_INA, i_INO, i_INO2B, i_INO2D, i_INPB, & + i_INPD, i_IONO, i_IONO2, i_IPRNO3, i_ISOPNOO1, & + i_ISOPNOO2, i_ITCN, i_ITHN, i_MACRNO2, i_MCRHN, & + i_MCRHNB, i_MENO3, i_MONITS, i_MONITU, i_MPAN, i_MPN,& + i_MVKN, i_N2O5, i_NO3, i_NPRNO3, i_OLND, i_OLNN, & + i_PAN, i_PPN, i_PRN1, i_PROPNN, i_PRPN, i_R4N1, & + i_R4N2, i_HONIT, i_IONITA, i_NIT, i_NITs, i_NH4 /) + HOx_species = (/ i_H, i_OH, i_HO2, i_H2O2 /) + ClOx_species = (/ i_Cl, i_ClO, i_HOCl, i_Cl2, i_Cl2O2, i_OClO /) + ClOy_species = (/ i_Cl, i_ClO, i_HOCl, i_Cl2, i_Cl2O2, i_OClO, & + i_HCl, i_ClNO3, i_BrCl, i_ICl, i_ClNO2 /) + tCly_species = (/ i_Cl, i_ClO, i_HOCl, i_Cl2, i_Cl2O2, i_OClO, i_ClOO, & + i_HCl, i_ClNO2, i_ClNO3, i_BrCl, i_ICl, i_H1211, & + i_CFC115, i_CH3Cl, i_HCFC142b, i_HCFC22, i_CH2ICl, & + i_CFC114, i_CFC12, i_HCFC141b, i_HCFC123, i_CH2Cl2, & + i_CFC11, i_CH3CCl3, i_CHCl3, i_CCl4, i_CFC113, & + i_SALACL, i_SALCCL /) + BrOx_species = (/ i_Br, i_BrO, i_BrCl, i_HOBr /) + BrOy_species = (/ i_Br, i_BrO, i_BrCl, i_HOBr, i_HBr, i_BrNO2, & + i_BrNO3, i_IBr, i_Br2 /) + tBry_species = (/ i_Br, i_BrO, i_BrCl, i_HOBr, i_HBr, i_BrNO2, & + i_BrNO3, i_IBr, i_Br2, i_CH3Br, i_H1211, i_H1301, & + i_H2402, i_CH2Br2, i_CHBr3, i_BrSALA, i_BrSALC, & + i_CH2IBr /) + SOx_species = (/ i_SO2, i_SO4 /) + NHx_species = (/ i_NH3, i_NH4 /) + TOTH_species = (/ i_CH4, i_H2O, i_H2 /) + + DO N = 1, SIZE(NOx_species) + idx = NOx_species(N) + IF ( idx > 0 ) THEN + SpcInfo => State_Chm%SpcData(idx)%Info + NOx_MWs(N) = REAL(SpcInfo%MW_g,r8) + SpcInfo => NULL() + ELSE + NOx_MWs(N) = -1.0e+00_r8 + ENDIF + ENDDO + + DO N = 1, SIZE(NOy_species) + idx = NOy_species(N) + IF ( idx > 0 ) THEN + SpcInfo => State_Chm%SpcData(idx)%Info + NOy_MWs(N) = REAL(SpcInfo%MW_g,r8) + SpcInfo => NULL() + ELSE + NOy_MWs(N) = -1.0e+00_r8 + ENDIF + ENDDO + + DO N = 1, SIZE(HOx_species) + idx = HOx_species(N) + IF ( idx > 0 ) THEN + SpcInfo => State_Chm%SpcData(idx)%Info + HOx_MWs(N) = REAL(SpcInfo%MW_g,r8) + SpcInfo => NULL() + ELSE + HOx_MWs(N) = -1.0e+00_r8 + ENDIF + ENDDO + + DO N = 1, SIZE(ClOx_species) + idx = ClOx_species(N) + IF ( idx > 0 ) THEN + SpcInfo => State_Chm%SpcData(idx)%Info + ClOx_MWs(N) = REAL(SpcInfo%MW_g,r8) + SpcInfo => NULL() + ELSE + ClOx_MWs(N) = -1.0e+00_r8 + ENDIF + ENDDO + + DO N = 1, SIZE(ClOy_species) + idx = ClOy_species(N) + IF ( idx > 0 ) THEN + SpcInfo => State_Chm%SpcData(idx)%Info + ClOy_MWs(N) = REAL(SpcInfo%MW_g,r8) + SpcInfo => NULL() + ELSE + ClOy_MWs(N) = -1.0e+00_r8 + ENDIF + ENDDO + + DO N = 1, SIZE(tCly_species) + idx = tCly_species(N) + IF ( idx > 0 ) THEN + SpcInfo => State_Chm%SpcData(idx)%Info + tCly_MWs(N) = REAL(SpcInfo%MW_g,r8) + SpcInfo => NULL() + ELSE + tCly_MWs(N) = -1.0e+00_r8 + ENDIF + ENDDO + + DO N = 1, SIZE(BrOx_species) + idx = BrOx_species(N) + IF ( idx > 0 ) THEN + SpcInfo => State_Chm%SpcData(idx)%Info + BrOx_MWs(N) = REAL(SpcInfo%MW_g,r8) + SpcInfo => NULL() + ELSE + BrOx_MWs(N) = -1.0e+00_r8 + ENDIF + ENDDO + + DO N = 1, SIZE(BrOy_species) + idx = BrOy_species(N) + IF ( idx > 0 ) THEN + SpcInfo => State_Chm%SpcData(idx)%Info + BrOy_MWs(N) = REAL(SpcInfo%MW_g,r8) + SpcInfo => NULL() + ELSE + BrOy_MWs(N) = -1.0e+00_r8 + ENDIF + ENDDO + + DO N = 1, SIZE(tBry_species) + idx = tBry_species(N) + IF ( idx > 0 ) THEN + SpcInfo => State_Chm%SpcData(idx)%Info + tBry_MWs(N) = REAL(SpcInfo%MW_g,r8) + SpcInfo => NULL() + ELSE + tBry_MWs(N) = -1.0e+00_r8 + ENDIF + ENDDO + + DO N = 1, SIZE(SOx_species) + idx = SOx_species(N) + IF ( idx > 0 ) THEN + SpcInfo => State_Chm%SpcData(idx)%Info + SOx_MWs(N) = REAL(SpcInfo%MW_g,r8) + SpcInfo => NULL() + ELSE + SOx_MWs(N) = -1.0e+00_r8 + ENDIF + ENDDO + + DO N = 1, SIZE(NHx_species) + idx = NHx_species(N) + IF ( idx > 0 ) THEN + SpcInfo => State_Chm%SpcData(idx)%Info + NHx_MWs(N) = REAL(SpcInfo%MW_g,r8) + SpcInfo => NULL() + ELSE + NHx_MWs(N) = -1.0e+00_r8 + ENDIF + ENDDO + + DO N = 1, SIZE(TOTH_species) + idx = TOTH_species(N) + IF ( idx > 0 ) THEN + SpcInfo => State_Chm%SpcData(idx)%Info + TOTH_MWs(N) = REAL(SpcInfo%MW_g,r8) + SpcInfo => NULL() + ELSE + TOTH_MWs(N) = -1.0e+00_r8 + ENDIF + ENDDO + + IF ( ANY(NOx_species <= 0 ) ) THEN + IF ( MasterProc ) Write(iulog,*) "NOx indices: ", NOx_species + ENDIF + IF ( ANY(NOy_species <= 0 ) ) THEN + IF ( MasterProc ) Write(iulog,*) "NOy indices: ", NOy_species + ENDIF + IF ( ANY(HOx_species <= 0 ) ) THEN + IF ( MasterProc ) Write(iulog,*) "HOx indices: ", HOx_species + ENDIF + IF ( ANY(ClOx_species <= 0 ) ) THEN + IF ( MasterProc ) Write(iulog,*) "ClOx indices: ", ClOx_species + ENDIF + IF ( ANY(ClOy_species <= 0 ) ) THEN + IF ( MasterProc ) Write(iulog,*) "ClOy indices: ", ClOy_species + ENDIF + IF ( ANY(tCly_species <= 0 ) ) THEN + IF ( MasterProc ) Write(iulog,*) "tCly indices: ", tCly_species + ENDIF + IF ( ANY(BrOx_species <= 0 ) ) THEN + IF ( MasterProc ) Write(iulog,*) "BrOx indices: ", BrOx_species + ENDIF + IF ( ANY(BrOy_species <= 0 ) ) THEN + IF ( MasterProc ) Write(iulog,*) "BrOy indices: ", BrOy_species + ENDIF + IF ( ANY(tBry_species <= 0 ) ) THEN + IF ( MasterProc ) Write(iulog,*) "tBry indices: ", tBry_species + ENDIF + IF ( ANY(SOx_species <= 0 ) ) THEN + IF ( MasterProc ) Write(iulog,*) "SOx indices: ", SOx_species + ENDIF + IF ( ANY(NHx_species <= 0 ) ) THEN + IF ( MasterProc ) Write(iulog,*) "NHx indices: ", NHx_species + ENDIF + IF ( ANY(TOTH_species <= 0 ) ) THEN + IF ( MasterProc ) Write(iulog,*) "TOTH indices: ", TOTH_species + ENDIF + + CALL Addfld( 'NOX', (/ 'lev' /), 'A', 'mol/mol', & + 'NOx molar mixing ratio' ) + CALL Addfld( 'NOY', (/ 'lev' /), 'A', 'mol/mol', & + 'NOy molar mixing ratio' ) + CALL Addfld( 'NOY_mmr', (/ 'lev' /), 'A', 'kg/kg', & + 'NOy mass mixing ratio' ) + CALL Addfld( 'NOY_SRF', horiz_only, 'A', 'mol/mol', & + 'Surface NOy molar mixing ratio' ) + CALL Addfld( 'HOX', (/ 'lev' /), 'A', 'mol/mol', & + 'HOx molar mixing ratio' ) + CALL Addfld( 'CLOX', (/ 'lev' /), 'A', 'mol/mol', & + 'ClOx molar mixing ratio' ) + CALL Addfld( 'CLOY', (/ 'lev' /), 'A', 'mol/mol', & + 'Total inorganic chlorine (ClOy) molar mixing ratio' ) + CALL Addfld( 'TCLY', (/ 'lev' /), 'A', 'mol/mol', & + 'Total Cl molar mixing ratio' ) + CALL Addfld( 'BROX', (/ 'lev' /), 'A', 'mol/mol', & + 'BrOx molar mixing ratio' ) + CALL Addfld( 'BROY', (/ 'lev' /), 'A', 'mol/mol', & + 'Total inorganic bromine (BrOy) molar mixing ratio' ) + CALL Addfld( 'TBRY', (/ 'lev' /), 'A', 'mol/mol', & + 'Total Br molar mixing ratio' ) + CALL Addfld( 'SOX', (/ 'lev' /), 'A', 'mol/mol', & + 'SOx molar mixing ratio' ) + CALL Addfld( 'SOX_mmr', (/ 'lev' /), 'A', 'kg/kg', & + 'SOx mass mixing ratio' ) + CALL Addfld( 'NHX', (/ 'lev' /), 'A', 'mol/mol', & + 'NHx molar mixing ratio' ) + CALL Addfld( 'NHX_mmr', (/ 'lev' /), 'A', 'kg/kg', & + 'NHx mass mixing ratio' ) + CALL Addfld( 'TOTH', (/ 'lev' /), 'A', 'mol/mol', & + 'Total H2 molar mixing ratio' ) + + CALL Addfld( 'SAD_STRAT', (/ 'lev' /), 'I', 'cm2/cm3', 'Stratospheric aerosol SAD' ) + CALL Addfld( 'SAD_SULFC', (/ 'lev' /), 'I', 'cm2/cm3', 'Chemical sulfate aerosol SAD' ) + CALL Addfld( 'SAD_PSC', (/ 'lev' /), 'I', 'cm2/cm3', 'PSC aerosol SAD' ) + CALL Addfld( 'RAD_SULFC', (/ 'lev' /), 'I', 'cm', 'Chemical sulfate radius' ) + CALL Addfld( 'RAD_PSC', (/ 'lev' /), 'I', 'cm', 'PSC aerosol radius' ) + CALL Addfld( 'SAD_TROP', (/ 'lev' /), 'I', 'cm2/cm3', 'Tropospheric aerosol SAD' ) + CALL Addfld( 'SAD_AERO', (/ 'lev' /), 'I', 'cm2/cm3', 'Aerosol surface area density' ) + CALL Addfld( 'REFF_AERO', (/ 'lev' /), 'I', 'cm', 'Aerosol effective radius') + CALL Addfld( 'SULF_TROP', (/ 'lev' /), 'I', 'cm2/cm3', 'Tropospheric sulfate area density') + + CALL Addfld( 'HNO3_TOTAL', (/ 'lev' /), 'I', 'mol/mol', 'Total HNO3' ) + CALL Addfld( 'HNO3_STS', (/ 'lev' /), 'I', 'mol/mol', 'STS condensed HNO3' ) + CALL Addfld( 'HNO3_NAT', (/ 'lev' /), 'I', 'mol/mol', 'NAT condensed HNO3' ) + CALL Addfld( 'HNO3_GAS', (/ 'lev' /), 'I', 'mol/mol', 'Gas phase HNO3' ) + CALL Addfld( 'H2O_GAS', (/ 'lev' /), 'I', 'mol/mol', 'Gas phase H2O' ) + CALL Addfld( 'HCL_TOTAL', (/ 'lev' /), 'I', 'mol/mol', 'Total HCl' ) + CALL Addfld( 'HCL_GAS', (/ 'lev' /), 'I', 'mol/mol', 'Gas phase HCl' ) + CALL Addfld( 'HCL_STS', (/ 'lev' /), 'I', 'mol/mol', 'STS condensend HCl' ) + + CALL Addfld( 'SZA', horiz_only, 'I', 'degrees', 'Solar Zenith Angle' ) + CALL Addfld( 'U_SRF', horiz_only, 'I', 'm/s', 'Horizontal wind velocity' ) + CALL Addfld( 'V_SRF', horiz_only, 'I', 'm/s', 'Vertical wind velocity' ) + CALL Addfld( 'Q_SRF', horiz_only, 'I', 'kg/kg', 'Specific humidity' ) + + CALL Addfld( 'CT_H2O_GHG', (/ 'lev' /), 'A','kg/kg/s', 'ghg-chem h2o source/sink' ) + + !======================================================================= + ! Cleanup and quit + !======================================================================= + Current => NULL() + Item => NULL() + + END SUBROUTINE CESMGC_Diag_Init +!EOC +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: cesmgc_diag_calc +! +! !DESCRIPTION: Subroutine CESMGC\_Diag\_Calc passes the diagnostics variable +! to the CAM History routines +!\\ +!\\ +! !INTERFACE: +! + SUBROUTINE CESMGC_Diag_Calc( Input_Opt, State_Chm, State_Diag, & + State_Grid, State_Met, cam_in, state, & + mmr_tend, LCHNK ) +! +! !USES: +! + USE Input_Opt_Mod, ONLY : OptInput + USE State_Chm_Mod, ONLY : ChmState + USE State_Met_Mod, ONLY : MetState + USE State_Diag_Mod, ONLY : DgnState + USE State_Diag_Mod, ONLY : get_TagInfo + USE State_Grid_Mod, ONLY : GrdState + USE Species_Mod, ONLY : Species + USE Registry_Mod, ONLY : MetaRegItem, RegItem + USE Registry_Mod, ONLY : Registry_Lookup + USE Registry_Params_Mod + USE PRECISION_MOD + USE CHEM_MODS, ONLY : adv_mass + USE CAM_HISTORY, ONLY : outfld, hist_fld_active + USE CONSTITUENTS, ONLY : cnst_name, sflxnam + USE DRYDEP_MOD, ONLY : depName, Ndvzind + USE CAMSRFEXCH, ONLY : cam_in_t + USE PHYSICS_TYPES, ONLY : physics_state + USE SPMD_UTILS, ONLY : MasterProc + USE PHYSCONST, ONLY : MWDry + USE UCX_MOD, ONLY : GET_STRAT_OPT!, AERFRAC + USE CMN_SIZE_MOD, ONLY : NDUST +! +! !INPUT PARAMETERS: +! + TYPE(OptInput), INTENT(IN) :: Input_Opt ! Input options + TYPE(ChmState), INTENT(IN) :: State_Chm ! Chemistry State object + TYPE(DgnState), INTENT(IN) :: State_Diag ! Diag State object + TYPE(GrdState), INTENT(IN) :: State_Grid ! Grid State object + TYPE(MetState), INTENT(IN) :: State_Met ! Meteorology State object + TYPE(cam_in_t), INTENT(IN) :: cam_in ! import state + TYPE(physics_state), INTENT(IN) :: state ! Physics state variables + REAL(r8), INTENT(IN) :: mmr_tend(state%ncol,pver,gas_pcnst) + ! Net tendency from chemistry in kg/s + INTEGER, INTENT(IN) :: LCHNK ! Chunk number +! +! !REVISION HISTORY: +! 20 Oct 2020 - T. M. Fritz - Initial version +!EOP +!------------------------------------------------------------------------------ +!BOC +! + ! Integers + INTEGER :: I, J, L, M, N, ND, SM + INTEGER :: idx + INTEGER :: RC + INTEGER :: Source_KindVal ! KIND value of data + INTEGER :: Output_KindVal ! KIND value for output + INTEGER :: Rank ! Size of data + + INTEGER :: nY, nZ + + ! Logicals + LOGICAL :: Found + LOGICAL :: rootChunk + LOGICAL :: OnLevelEdges ! Is the data defined + ! on level edges (T/F) + + ! Strings + CHARACTER(LEN=255) :: ThisLoc + CHARACTER(LEN=255) :: ErrMsg + CHARACTER(LEN=255) :: SpcName + CHARACTER(LEN=255) :: tagName + + ! Real + REAL(r8) :: wgt + REAL(r8) :: MW + REAL(r8) :: RAER, REFF, SADSTRAT, XSASTRAT + + ! Arrays + REAL(r8) :: outTmp(State_Grid%nY,State_Grid%nZ) + REAL(r8) :: radTmp(State_Grid%nY,State_Grid%nZ) + + ! Floating-point data pointers (8-byte precision) + REAL(f8), POINTER :: Ptr0d_8 ! 0D 8-byte data + REAL(f8), POINTER :: Ptr1d_8(: ) ! 1D 8-byte data + REAL(f8), POINTER :: Ptr2d_8(:,: ) ! 2D 8-byte data + REAL(f8), POINTER :: Ptr3d_8(:,:,:) ! 3D 8-byte data + + ! Objects + TYPE(Species), POINTER :: SpcInfo + TYPE(MetaRegItem), POINTER :: Current + TYPE(RegItem ), POINTER :: Item + + !================================================================= + ! CESMGC_Diag_Calc begins here! + !================================================================= + + nY = State_Grid%nY + nZ = State_Grid%nZ + + ! Initialize pointers + SpcInfo => NULL() + Current => NULL() + Item => NULL() + + ! For error trapping + ErrMsg = '' + ThisLoc = ' -> at CESMGC_Diag_Calc (in chemistry/geoschem/cesmgc_diag_mod.F90)' + + ! Define rootChunk + rootChunk = ( MasterProc.and.(LCHNK==BEGCHUNK) ) + + CALL OutFld( 'AREA', State_Grid%Area_M2(1,:nY), nY, LCHNK) + CALL OutFld( 'MASS', State_Met%AD(1,:nY,nZ:1:-1), nY, LCHNK) + CALL Outfld( 'HEIGHT', state%zi(:nY,:), nY, LCHNK ) + + ! =============================================== + ! Diagnose chemical species (constituents and short-lived) + ! =============================================== + + DO N = 1, gas_pcnst + M = map2chm(N) + IF ( M > 0 ) THEN + ! It's a GEOS-Chem species + SpcName = to_upper(TRIM(solsym(N))) + ELSE + ! MAM aerosols + SpcName = TRIM(solsym(N)) + ENDIF + outTmp = 0.0e+00_r8 + IF ( adv_mass(N) > 0.0e+00_r8 .AND. M /= 0 .AND. hist_fld_active(TRIM(SpcName)) ) THEN + IF ( M > 0 ) THEN + outTmp(:nY,:) = REAL(State_Chm%Species(1,:nY,nZ:1:-1,M),r8) * MWDry / adv_mass(N) + ELSE + outTmp(:nY,:) = state%q(:nY,:nZ,-M) + ENDIF + CALL OutFld( TRIM(SpcName), outTmp(:nY,:), nY, LCHNK ) + CALL OutFld( TRIM(SpcName)//'_SRF', outTmp(:nY,nZ), nY, LCHNK ) + ENDIF + ENDDO + + ! =============================================== + ! Diagnose chemical families (NOx, NOy, ...) + ! =============================================== + + SpcName = 'NOX' + IF ( hist_fld_active(TRIM(SpcName)) ) THEN + outTmp = 0.0e+00_r8 + DO N = 1, SIZE(NOx_species) + idx = NOx_species(N) + MW = NOx_MWs(N) + IF ( idx <= 0 .OR. MW <= 0.0e+00_r8 ) CYCLE + wgt = 1.0E+00_r8 + outTmp(:nY,:) = outTmp(:nY,:) & + + wgt * REAL(State_Chm%Species(1,:nY,nZ:1:-1,idx),r8) * MWDry / MW + ENDDO + CALL Outfld( TRIM(SpcName), outTmp(:nY,:), nY, LCHNK ) + ENDIF + + SpcName = 'NOY' + IF ( hist_fld_active(TRIM(SpcName)) .OR. hist_fld_active(TRIM(SpcName)//'_SRF') ) THEN + outTmp = 0.0e+00_r8 + DO N = 1, SIZE(NOy_species) + idx = NOy_species(N) + MW = NOy_MWs(N) + IF ( idx <= 0 .OR. MW <= 0.0e+00_r8 ) CYCLE + wgt = 1.0E+00_r8 + IF ( idx == i_N2O5 .OR. idx == i_IDN .OR. idx == i_IDNOO ) THEN + wgt = 2.0E+00_r8 + ENDIF + outTmp(:nY,:) = outTmp(:nY,:) & + + wgt * REAL(State_Chm%Species(1,:nY,nZ:1:-1,idx),r8) * MWDry / MW + ENDDO + CALL Outfld( TRIM(SpcName), outTmp(:nY,:), nY, LCHNK ) + ENDIF + SpcName = 'NOY_SRF' + IF ( hist_fld_active(TRIM(SpcName)) ) CALL Outfld( TRIM(SpcName), outTmp(:nY,nZ), nY, LCHNK ) + + SpcName = 'NOY_mmr' + IF ( hist_fld_active(TRIM(SpcName)) ) THEN + outTmp = 0.0e+00_r8 + DO N = 1, SIZE(NOy_species) + idx = NOy_species(N) + MW = NOy_MWs(N) + IF ( idx <= 0 .OR. MW <= 0.0e+00_r8 ) CYCLE + wgt = 1.0E+00_r8 + IF ( idx == i_N2O5 .OR. idx == i_IDN .OR. idx == i_IDNOO ) THEN + wgt = 2.0E+00_r8 + ENDIF + outTmp(:nY,:) = outTmp(:nY,:) + wgt * REAL(State_Chm%Species(1,:nY,nZ:1:-1,idx),r8) + ENDDO + CALL Outfld( TRIM(SpcName), outTmp(:nY,:), nY, LCHNK ) + ENDIF + + SpcName = 'HOX' + IF ( hist_fld_active(TRIM(SpcName)) ) THEN + outTmp = 0.0e+00_r8 + DO N = 1, SIZE(HOx_species) + idx = HOx_species(N) + MW = HOx_MWs(N) + IF ( idx <= 0 .OR. MW <= 0.0e+00_r8 ) CYCLE + wgt = 1.0E+00_r8 + IF ( idx == i_H2O2 ) THEN + wgt = 2.0E+00_r8 + ENDIF + outTmp(:nY,:) = outTmp(:nY,:) & + + wgt * REAL(State_Chm%Species(1,:nY,nZ:1:-1,idx),r8) * MWDry / MW + ENDDO + CALL Outfld( TRIM(SpcName), outTmp(:nY,:), nY, LCHNK ) + ENDIF + + SpcName = 'CLOX' + IF ( hist_fld_active(TRIM(SpcName)) ) THEN + outTmp = 0.0e+00_r8 + DO N = 1, SIZE(ClOx_species) + idx = ClOx_species(N) + MW = ClOx_MWs(N) + IF ( idx <= 0 .OR. MW <= 0.0e+00_r8 ) CYCLE + wgt = 1.0E+00_r8 + IF ( idx == i_Cl2 .OR. idx == i_Cl2O2 ) THEN + wgt = 2.0E+00_r8 + ENDIF + outTmp(:nY,:) = outTmp(:nY,:) & + + wgt * REAL(State_Chm%Species(1,:nY,nZ:1:-1,idx),r8) * MWDry / MW + ENDDO + CALL Outfld( TRIM(SpcName), outTmp(:nY,:), nY, LCHNK ) + ENDIF + + SpcName = 'CLOY' + IF ( hist_fld_active(TRIM(SpcName)) ) THEN + outTmp = 0.0e+00_r8 + DO N = 1, SIZE(ClOy_species) + idx = ClOy_species(N) + MW = ClOy_MWs(N) + IF ( idx <= 0 .OR. MW <= 0.0e+00_r8 ) CYCLE + wgt = 1.0E+00_r8 + IF ( idx == i_Cl2 .OR. idx == i_Cl2O2 ) THEN + wgt = 2.0E+00_r8 + ENDIF + outTmp(:nY,:) = outTmp(:nY,:) & + + wgt * REAL(State_Chm%Species(1,:nY,nZ:1:-1,idx),r8) * MWDry / MW + ENDDO + CALL Outfld( TRIM(SpcName), outTmp(:nY,:), nY, LCHNK ) + ENDIF + + SpcName = 'TCLY' + IF ( hist_fld_active(TRIM(SpcName)) ) THEN + outTmp = 0.0e+00_r8 + DO N = 1, SIZE(tCly_species) + idx = tCly_species(N) + MW = tCly_MWs(N) + IF ( idx <= 0 .OR. MW <= 0.0e+00_r8 ) CYCLE + wgt = 1.0E+00_r8 + IF ( idx == i_Cl2 .OR. idx == i_Cl2O2 .OR. idx == i_CFC114 .OR. & + idx == i_CFC12 .OR. idx == i_CH2Cl2 .OR. idx == i_HCFC123 .OR. & + idx == i_HCFC141b ) THEN + wgt = 2.0E+00_r8 + ELSEIF ( idx == i_CFC11 .OR. idx == i_CFC113 .OR. idx == i_CH3CCl3 .OR. & + idx == i_CHCl3 ) THEN + wgt = 3.0E+00_r8 + ELSEIF ( idx == i_CCl4 ) THEN + wgt = 4.0E+00_r8 + ENDIF + outTmp(:nY,:) = outTmp(:nY,:) & + + wgt * REAL(State_Chm%Species(1,:nY,nZ:1:-1,idx),r8) * MWDry / MW + ENDDO + CALL Outfld( TRIM(SpcName), outTmp(:nY,:), nY, LCHNK ) + ENDIF + + SpcName = 'BROX' + IF ( hist_fld_active(TRIM(SpcName)) ) THEN + outTmp = 0.0e+00_r8 + DO N = 1, SIZE(BrOx_species) + idx = BrOx_species(N) + MW = BrOx_MWs(N) + IF ( idx <= 0 .OR. MW <= 0.0e+00_r8 ) CYCLE + wgt = 1.0E+00_r8 + outTmp(:nY,:) = outTmp(:nY,:) & + + wgt * REAL(State_Chm%Species(1,:nY,nZ:1:-1,idx),r8) * MWDry / MW + ENDDO + CALL Outfld( TRIM(SpcName), outTmp(:nY,:), nY, LCHNK ) + ENDIF + + SpcName = 'BROY' + IF ( hist_fld_active(TRIM(SpcName)) ) THEN + outTmp = 0.0e+00_r8 + DO N = 1, SIZE(BrOy_species) + idx = BrOy_species(N) + MW = BrOy_MWs(N) + IF ( idx <= 0 .OR. MW <= 0.0e+00_r8 ) CYCLE + wgt = 1.0E+00_r8 + IF ( idx == i_Br2 ) THEN + wgt = 2.0E+00_r8 + ENDIF + outTmp(:nY,:) = outTmp(:nY,:) & + + wgt * REAL(State_Chm%Species(1,:nY,nZ:1:-1,idx),r8) * MWDry / MW + ENDDO + CALL Outfld( TRIM(SpcName), outTmp(:nY,:), nY, LCHNK ) + ENDIF + + SpcName = 'TBRY' + IF ( hist_fld_active(TRIM(SpcName)) ) THEN + outTmp = 0.0e+00_r8 + DO N = 1, SIZE(tBry_species) + idx = tBry_species(N) + MW = tBry_MWs(N) + IF ( idx <= 0 .OR. MW <= 0.0e+00_r8 ) CYCLE + wgt = 1.0E+00_r8 + IF ( idx == i_Br2 .OR. idx == i_H2402 .OR. idx == i_CH2Br2 ) THEN + wgt = 2.0E+00_r8 + ENDIF + outTmp(:nY,:) = outTmp(:nY,:) & + + wgt * REAL(State_Chm%Species(1,:nY,nZ:1:-1,idx),r8) * MWDry / MW + ENDDO + CALL Outfld( TRIM(SpcName), outTmp(:nY,:), nY, LCHNK ) + ENDIF + + SpcName = 'SOX' + IF ( hist_fld_active(TRIM(SpcName)) ) THEN + outTmp = 0.0e+00_r8 + DO N = 1, SIZE(SOx_species) + idx = SOx_species(N) + MW = SOx_MWs(N) + IF ( idx <= 0 .OR. MW <= 0.0e+00_r8 ) CYCLE + wgt = 1.0E+00_r8 + outTmp(:nY,:) = outTmp(:nY,:) & + + wgt * REAL(State_Chm%Species(1,:nY,nZ:1:-1,idx),r8) * MWDry / MW + ENDDO + CALL Outfld( TRIM(SpcName), outTmp(:nY,:), nY, LCHNK ) + ENDIF + + SpcName = 'SOX_mmr' + IF ( hist_fld_active(TRIM(SpcName)) ) THEN + outTmp = 0.0e+00_r8 + DO N = 1, SIZE(SOx_species) + idx = SOx_species(N) + MW = SOx_MWs(N) + IF ( idx <= 0 .OR. MW <= 0.0e+00_r8 ) CYCLE + wgt = 1.0E+00_r8 + outTmp(:nY,:) = outTmp(:nY,:) + wgt * REAL(State_Chm%Species(1,:nY,nZ:1:-1,idx),r8) + ENDDO + CALL Outfld( TRIM(SpcName), outTmp(:nY,:), nY, LCHNK ) + ENDIF + + SpcName = 'NHX' + IF ( hist_fld_active(TRIM(SpcName)) ) THEN + outTmp = 0.0e+00_r8 + DO N = 1, SIZE(NHx_species) + idx = NHx_species(N) + MW = NHx_MWs(N) + IF ( idx <= 0 .OR. MW <= 0.0e+00_r8 ) CYCLE + wgt = 1.0E+00_r8 + outTmp(:nY,:) = outTmp(:nY,:) & + + wgt * REAL(State_Chm%Species(1,:nY,nZ:1:-1,idx),r8) * MWDry / MW + ENDDO + CALL Outfld( TRIM(SpcName), outTmp(:nY,:), nY, LCHNK ) + ENDIF + + SpcName = 'NHX_mmr' + IF ( hist_fld_active(TRIM(SpcName)) ) THEN + outTmp = 0.0e+00_r8 + DO N = 1, SIZE(NHx_species) + idx = NHx_species(N) + MW = NHx_MWs(N) + IF ( idx <= 0 .OR. MW <= 0.0e+00_r8 ) CYCLE + wgt = 1.0E+00_r8 + outTmp(:nY,:) = outTmp(:nY,:) + wgt * REAL(State_Chm%Species(1,:nY,nZ:1:-1,idx),r8) + ENDDO + CALL Outfld( TRIM(SpcName), outTmp(:nY,:), nY, LCHNK ) + ENDIF + + SpcName = 'TOTH' + IF ( hist_fld_active(TRIM(SpcName)) ) THEN + outTmp = 0.0e+00_r8 + DO N = 1, SIZE(TOTH_species) + idx = TOTH_species(N) + MW = TOTH_MWs(N) + IF ( idx <= 0 .OR. MW <= 0.0e+00_r8 ) CYCLE + wgt = 1.0E+00_r8 + IF ( idx == i_CH4 ) THEN + wgt = 2.0E+00_r8 + ENDIF + outTmp(:nY,:) = outTmp(:nY,:) & + + wgt * REAL(State_Chm%Species(1,:nY,nZ:1:-1,idx),r8) * MWDry / MW + ENDDO + CALL Outfld( TRIM(SpcName), outTmp(:nY,:), nY, LCHNK ) + ENDIF + + ! =============================================== + ! Diagnose GEOS-Chem aerosol quantities + ! =============================================== + + IF ( hist_fld_active('SAD_PSC') .OR. hist_fld_active('RAD_PSC') ) THEN + outTmp = 0.0e+00_r8 + radTmp = 0.0e+00_r8 + DO J = 1, nY + DO L = 1, nZ + CALL GET_STRAT_OPT(1,J,L,1,RAER,REFF,SADSTRAT,XSASTRAT) + outTmp(J,nZ+1-L) = SADSTRAT + radTmp(J,nZ+1-L) = RAER + ENDDO + ENDDO + CALL Outfld( 'SAD_PSC', outTmp(:nY,:), nY, LCHNK ) + CALL Outfld( 'RAD_PSC', radTmp(:nY,:), nY, LCHNK ) + ENDIF + + IF ( hist_fld_active('SAD_SULFC') .OR. hist_fld_active('RAD_SULFC') ) THEN + outTmp = 0.0e+00_r8 + DO J = 1, nY + DO L = 1, nZ + CALL GET_STRAT_OPT(1,J,L,2,RAER,REFF,SADSTRAT,XSASTRAT) + outTmp(J,nZ+1-L) = SADSTRAT + radTmp(J,nZ+1-L) = RAER + ENDDO + ENDDO + CALL Outfld( 'SAD_SULFC', outTmp(:nY,:), nY, LCHNK ) + CALL Outfld( 'RAD_SULFC', radTmp(:nY,:), nY, LCHNK ) + ENDIF + + IF ( hist_fld_active('SAD_AERO') .OR. hist_fld_active('SAD_TROP') ) THEN + outTmp(:nY,:) = SUM(State_Chm%AeroArea(1,:nY,nZ:1:-1,:), DIM=3) + CALL Outfld( 'SAD_AERO', outTmp(:nY,:), nY, LCHNK ) + ENDIF + + IF ( hist_fld_active('SAD_TROP') ) THEN + DO J = 1, nY + DO L = 1, nZ + IF ( .NOT. State_Met%InTroposphere(1,J,nZ+1-L) ) THEN + outTmp(J,L) = 0.0e+00_r8 + ENDIF + ENDDO + ENDDO + CALL Outfld( 'SAD_TROP', outTmp(:nY,:), nY, LCHNK ) + ENDIF + + IF ( hist_fld_active('REFF_AERO') ) THEN + !outTmp(:nY,:) = State_Chm%AeroRadi(1,:nY,nZ:1:-1,:) + !CALL Outfld( 'REFF_AERO', outTmp(:nY,:), nY, LCHNK ) + ENDIF + + IF ( hist_fld_active('SULF_TROP') ) THEN + outTmp(:nY,:) = State_Chm%AeroArea(1,:nY,nZ:1:-1,NDUST+1) + CALL Outfld( 'SULF_TROP', outTmp(:nY,:), nY, LCHNK ) + ENDIF + + ! =============================================== + ! Diagnose stratospheric quantities + ! =============================================== + + outTmp(:nY,:) = State_Chm%Species(1,:nY,nZ:1:-1,i_HNO3) * MWDry / MW_HNO3 + CALL Outfld( 'HNO3_GAS', outTmp(:nY,:), nY, LCHNK ) + + ! TMMF, this requires to have access to the AERFRAC variable in ucx_mod. + !outTmp(:nY,:) = AERFRAC(1,:nY,nZ:1:-1,2) + !CALL Outfld( 'HNO3_STS', outTmp(:nY,:), nY, LCHNK ) + + outTmp = 0.0e+00_r8 + DO J = 1, nY + DO L = 1, nZ + IF ( State_Met%InTroposphere(1,J,nZ+1-L) ) CYCLE + outTmp(J,L) = State_Chm%Species(1,J,nZ+1-L,i_NIT) * MWDry / MW_NIT + ENDDO + ENDDO + CALL Outfld( 'HNO3_NAT', outTmp(:nY,:), nY, LCHNK ) + + outTmp(:nY,:) = outTmp(:nY,:) + & + ! AERFRAC(1,:nY,nZ:1:-1,2) + & + State_Chm%Species(1,:nY,nZ:1:-1,i_HNO3) * MWDry / MW_HNO3 + CALL Outfld( 'HNO3_TOTAL', outTmp(:nY,:), nY, LCHNK ) + + outTmp(:nY,:) = State_Chm%Species(1,:nY,nZ:1:-1,i_H2O) * MWDry / MW_H2O + CALL Outfld( 'H2O_GAS', outTmp(:nY,:), nY, LCHNK ) + + outTmp(:nY,:) = State_Chm%Species(1,:nY,nZ:1:-1,i_HCl) * MWDry / MW_HCl + CALL Outfld( 'HCL_GAS', outTmp(:nY,:), nY, LCHNK ) + + !outTmp(:nY,:) = AERFRAC(1,:nY,nZ:1:-1,3) + !CALL Outfld( 'HCL_STS', outTmp(:nY,:), nY, LCHNK ) + + outTmp(:nY,:) = 0.0e+00_r8 + !outTmp(:nY,:) = AERFRAC(1,:nY,nZ:1:-1,3) + outTmp(:nY,:) = outTmp(:nY,:) + & + State_Chm%Species(1,:nY,nZ:1:-1,i_HCl) * MWDry / MW_HCl + CALL Outfld( 'HCL_TOTAL', outTmp(:nY,:), nY, LCHNK ) + + ! =============================================== + ! Diagnose dry deposition velocities and fluxes + ! =============================================== + + IF ( Input_Opt%LDryD ) THEN + DO N = 1, State_Chm%nDryDep + ND = NDVZIND(N) + SpcName = 'DV_'//to_upper(TRIM(depName(N))) + IF ( .NOT. hist_fld_active(TRIM(SpcName)) ) CYCLE + CALL OutFld( TRIM(SpcName), State_Chm%DryDepVel(1,:nY,ND), nY, LCHNK ) + ENDDO + + DO N = 1, State_Chm%nAdvect + ! Get the species ID from the advected species ID + L = State_Chm%Map_Advect(N) + + ! Get info about this species from the species database + SpcInfo => State_Chm%SpcData(L)%Info + SpcName = 'DF_'//to_upper(TRIM(SpcInfo%Name)) + + IF ( .NOT. hist_fld_active(TRIM(SpcName)) ) CYCLE + ! SurfaceFlux is Emissions - Drydep, but Emissions = 0, as it is applied + ! externally + CALL OutFld( TRIM(SpcName), -State_Chm%SurfaceFlux(1,:nY,N), nY, LCHNK ) + + ! Free pointer + SpcInfo => NULL() + ENDDO + ENDIF + + ! =============================================== + ! Diagnose surface fluxes (emissions - drydep) + ! =============================================== + + DO N = iFirstCnst, pcnst + SpcName = TRIM(sflxnam_loc(N)) + IF ( TRIM(SpcName) == '' ) CYCLE + IF ( .NOT. hist_fld_active(TRIM(SpcName)) ) CYCLE + CALL OutFld( TRIM(SpcName), cam_in%cflx(:nY,N), nY, LCHNK ) + ENDDO + + ! =============================================== + ! Diagnose chemical tendencies + ! =============================================== + + ! Chemical tendencies in kg/kg/s + DO N = 1, gas_pcnst + SpcName = TRIM(srcnam(N)) + IF ( TRIM(SpcName) == '' ) CYCLE + IF ( .NOT. hist_fld_active(TRIM(SpcName)) ) CYCLE + CALL OutFld( TRIM(SpcName), mmr_tend(:nY,:nZ,N), nY, LCHNK ) + ENDDO + + ! Chemical tendencies in kg/s + DO N = 1, gas_pcnst + SpcName = TRIM(dtchem_name(N)) + IF ( .NOT. hist_fld_active(TRIM(SpcName)) ) CYCLE + outTmp = 0.0e+0_r8 + outTmp(:nY,:nZ) = mmr_tend(:nY,:nZ,N) * REAL(State_Met%AD(1,:nY,nZ:1:-1),r8) + CALL OutFld( TRIM(SpcName), outTmp(:nY,:), nY, LCHNK ) + ENDDO + + ! =============================================== + ! Diagnose photolysis rates + ! =============================================== + + IF ( ASSOCIATED(State_Diag%Jval) ) THEN + DO M = 1, nPhotol + CALL get_TagInfo( Input_Opt = Input_Opt, & + tagID = 'PHO', & + State_Chm = State_Chm, & + Found = Found, & + RC = RC, & + N = M, & + tagName = tagName ) + + ! Trap potential errors + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Abnormal exit from routine "Get_TagInfo"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + SpcName = 'Jval_' // TRIM( tagName ) + IF ( .NOT. hist_fld_active(TRIM(SpcName)) ) CYCLE + outTmp(:nY,:nZ) = REAL(State_Diag%Jval(1,:nY,nZ:1:-1,M),r8) + CALL OutFld( TRIM(SpcName), outTmp(:nY,:), nY, LCHNK ) + ENDDO + ENDIF + IF ( ASSOCIATED(State_Diag%JvalO3O1D) ) THEN + SpcName = 'Jval_O3O1D' + IF ( hist_fld_active(TRIM(SpcName)) ) THEN + outTmp(:nY,:nZ) = REAL(State_Diag%JvalO3O1D(1,:nY,nZ:1:-1),r8) + CALL OutFld( TRIM(SpcName), outTmp(:nY,:), nY, LCHNK ) + ENDIF + ENDIF + IF ( ASSOCIATED(State_Diag%JvalO3O3P) ) THEN + SpcName = 'Jval_O3O3P' + IF ( hist_fld_active(TRIM(SpcName)) ) THEN + outTmp(:nY,:nZ) = REAL(State_Diag%JvalO3O3P(1,:nY,nZ:1:-1),r8) + CALL OutFld( TRIM(SpcName), outTmp(:nY,:), nY, LCHNK ) + ENDIF + ENDIF + + ! =============================================== + ! Diagnose fields corresponding to State_Met + ! =============================================== + + ! Copied from Headers/registry_mod.F90 + ! Point to the head node of the Registry + Current => State_Met%Registry + + Source_KindVal = KINDVAL_F8 + Output_KindVal = KINDVAL_F8 + + ! As long as the current node isn't NULL + DO WHILE( ASSOCIATED( Current ) ) + + ! Get the REGISTRY ITEM belonging to this node of the Registry + Item => Current%Item + + ! Only print on the root CPU + IF ( ASSOCIATED( Item ) ) THEN + + SpcName = TRIM(Item%FullName) + IF (( TRIM(Item%FullName(1:8)) /= 'MET_XLAI' ) .AND. & + ( TRIM(Item%FullName(1:8)) /= 'MET_IUSE' ) .AND. & + ( TRIM(Item%FullName(1:9)) /= 'MET_ILAND' )) THEN + CALL Registry_Lookup( am_I_Root = Input_Opt%amIRoot, & + Registry = State_Met%Registry, & + RegDict = State_Met%RegDict, & + State = State_Met%State, & + Variable = Item%FullName, & + Source_KindVal = Source_KindVal, & + Output_KindVal = Output_KindVal, & + Rank = Rank, & + OnLevelEdges = OnLevelEdges, & + Ptr0d_8 = Ptr0d_8, & + Ptr1d_8 = Ptr1d_8, & + Ptr2d_8 = Ptr2d_8, & + Ptr3d_8 = Ptr3d_8, & + RC = RC ) + + !IF ( hist_fld_active(TRIM(SpcName)) ) THEN + ! IF ( Source_KindVal /= KINDVAL_I4 ) THEN + ! IF ( Rank == 2 ) THEN + ! outTmp(:nY,nZ) = REAL(Ptr2d_8(1,:nY),r8) + ! CALL Outfld( TRIM( Item%FullName ), outTmp(:nY,nZ), nY, LCHNK ) + ! ELSEIF ( Rank == 3 ) THEN + ! ! For now, treat variables defined on level edges by ignoring top + ! ! most layer + ! outTmp(:nY,:nZ) = REAL(Ptr3d_8(1,:nY,nZ:1:-1),r8) + ! CALL Outfld( TRIM( Item%FullName ), outTmp(:nY,:), nY, LCHNK ) + ! ELSE + ! IF ( rootChunk ) Write(iulog,*) " Item ", TRIM(Item%FullName), & + ! " is of rank ", Rank, " and will not be diagnosed!" + ! ENDIF + ! ENDIF + !ENDIF + ENDIF + + ENDIF + + ! Point to next node of the Registry + Current => Current%Next + + ENDDO + + SpcName = 'SZA' + IF ( hist_fld_active(TRIM(SpcName)) ) THEN + outTmp(:nY,1) = ACOS(MIN(MAX(State_Met%SUNCOS(1,:nY),-1._r8),1._r8))/pi*180.e+0_r8 + CALL Outfld( TRIM(SpcName), outTmp(:nY,1) , nY, LCHNK ) + ENDIF + + SpcName = 'U_SRF' + IF ( hist_fld_active(TRIM(SpcName)) ) THEN + outTmp(:nY,:) = state%u(:nY,:) + CALL Outfld( TRIM(SpcName), outTmp(:nY,:) , nY, LCHNK ) + ENDIF + + SpcName = 'V_SRF' + IF ( hist_fld_active(TRIM(SpcName)) ) THEN + outTmp(:nY,:) = state%v(:nY,:) + CALL Outfld( TRIM(SpcName), outTmp(:nY,:) , nY, LCHNK ) + ENDIF + + SpcName = 'Q_SRF' + IF ( hist_fld_active(TRIM(SpcName)) ) THEN + outTmp(:nY,:) = State_Chm%Species(1,:nY,nZ:1:-1,i_H2O) + CALL Outfld( TRIM(SpcName), outTmp(:nY,:) , nY, LCHNK ) + ENDIF + + !======================================================================= + ! Cleanup and quit + !======================================================================= + Current => NULL() + Item => NULL() + Ptr0d_8 => NULL() + Ptr1d_8 => NULL() + Ptr2d_8 => NULL() + Ptr3d_8 => NULL() + + END SUBROUTINE CESMGC_Diag_Calc +!EOC +!------------------------------------------------------------------------------ + END MODULE CESMGC_Diag_Mod + diff --git a/src/chemistry/geoschem/cesmgc_emissions_mod.F90 b/src/chemistry/geoschem/cesmgc_emissions_mod.F90 new file mode 100644 index 0000000000..2a1ff841b2 --- /dev/null +++ b/src/chemistry/geoschem/cesmgc_emissions_mod.F90 @@ -0,0 +1,540 @@ +!------------------------------------------------------------------------------ +! "GEOS-Chem" chemistry emissions interface ! +!------------------------------------------------------------------------------ +!BOP +! +! !MODULE: cesmgc_emissions_mod.F90 +! +! !DESCRIPTION: Module cesmgc\_emissions\_mod contains routines which retrieve +! emission fluxes from HEMCO and transfers it back to the CESM-GC interface +!\\ +!\\ +! !INTERFACE: +! +MODULE CESMGC_Emissions_Mod +! +! !USES: +! + USE SHR_KIND_MOD, ONLY : r8 => shr_kind_r8 + USE SPMD_UTILS, ONLY : MasterProc + USE CAM_ABORTUTILS, ONLY : endrun + USE CHEM_MODS, ONLY : iFirstCnst + USE CONSTITUENTS, ONLY : pcnst, cnst_name + USE SHR_MEGAN_MOD, ONLY : shr_megan_mechcomps, shr_megan_mechcomps_n + USE CAM_LOGFILE, ONLY : iulog + + IMPLICIT NONE + + PRIVATE + +! +! !PUBLIC MEMBER FUNCTIONS: +! + PUBLIC :: CESMGC_Emissions_Init + PUBLIC :: CESMGC_Emissions_Calc + PUBLIC :: CESMGC_Emissions_Final + + ! Constituent number for NO + INTEGER :: iNO + + ! Aerosol constituent number + INTEGER :: iBC1 + INTEGER :: iBC4 + INTEGER :: iH2SO4 + INTEGER :: iSOA11 + INTEGER :: iSOA12 + INTEGER :: iSOA21 + INTEGER :: iSOA22 + INTEGER :: iSOA31 + INTEGER :: iSOA32 + INTEGER :: iSOA41 + INTEGER :: iSOA42 + INTEGER :: iSOA51 + INTEGER :: iSOA52 + INTEGER :: iPOM1 + INTEGER :: iPOM4 + + INTEGER :: iBCPI + INTEGER :: iBCPO + INTEGER :: iOCPI + INTEGER :: iOCPO + INTEGER :: iSO4 + INTEGER :: iSOAS + + ! MEGAN Emissions + INTEGER, ALLOCATABLE :: megan_indices_map(:) + REAL(r8), ALLOCATABLE :: megan_wght_factors(:) + +! +! !REVISION HISTORY: +! 07 Oct 2020 - T. M. Fritz - Initial version +!EOP +!------------------------------------------------------------------------------ +!BOC +! +CONTAINS +! +!EOC +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: cesmgc_emissions_init +! +! !DESCRIPTION: Subroutine CESMGC\_Emissions\_Init initializes the emissions +! routine +!\\ +!\\ +! !INTERFACE: +! + SUBROUTINE CESMGC_Emissions_Init( lght_no_prd_factor ) +! +! !USES: +! + USE PHYSICS_TYPES, ONLY : physics_state + USE CONSTITUENTS, ONLY : cnst_get_ind + USE MO_CHEM_UTLS, ONLY : get_spc_ndx + USE CAM_HISTORY, ONLY : addfld, add_default, horiz_only + USE MO_LIGHTNING, ONLY : lightning_inti + USE FIRE_EMISSIONS, ONLY : fire_emissions_init + USE CHEM_MODS, ONLY : adv_mass + USE INFNAN, ONLY : NaN, assignment(=) +! +! !INPUT PARAMETERS: +! + REAL(r8), INTENT(IN ) :: lght_no_prd_factor ! Lightning scaling factor +! +! !REVISION HISTORY: +! 07 Oct 2020 - T. M. Fritz - Initial version +!EOP +!------------------------------------------------------------------------------ +!BOC +! + ! Integers + INTEGER :: IERR + INTEGER :: N, II + + ! Strings + CHARACTER(LEN=255) :: SpcName + CHARACTER(LEN=255) :: Description + + ! Real + REAL(r8) :: MW + + !================================================================= + ! CESMGC_Emissions_Init begins here! + !================================================================= + + ! Get constituent index for NO + CALL cnst_get_ind('NO', iNO, abort=.True.) + +#if defined( MODAL_AERO_4MODE ) + ! Get constituent index for aerosols + CALL cnst_get_ind('soa1_a1', iSOA11, abort=.True.) + CALL cnst_get_ind('soa1_a2', iSOA12, abort=.True.) + CALL cnst_get_ind('soa2_a1', iSOA21, abort=.True.) + CALL cnst_get_ind('soa2_a2', iSOA22, abort=.True.) + CALL cnst_get_ind('soa3_a1', iSOA31, abort=.True.) + CALL cnst_get_ind('soa3_a2', iSOA32, abort=.True.) + CALL cnst_get_ind('soa4_a1', iSOA41, abort=.True.) + CALL cnst_get_ind('soa4_a2', iSOA42, abort=.True.) + CALL cnst_get_ind('soa5_a1', iSOA51, abort=.True.) + CALL cnst_get_ind('soa5_a2', iSOA52, abort=.True.) + + CALL cnst_get_ind('SOAS', iSOAS, abort=.True.) +#endif + + !----------------------------------------------------------------------- + ! ... initialize the lightning module + !----------------------------------------------------------------------- + CALL lightning_inti(lght_no_prd_factor) + + !----------------------------------------------------------------------- + ! ... MEGAN emissions + !----------------------------------------------------------------------- + IF ( shr_megan_mechcomps_n > 0 ) THEN + + ALLOCATE( megan_indices_map(shr_megan_mechcomps_n), STAT=IERR ) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating megan_indices_map') + ALLOCATE( megan_wght_factors(shr_megan_mechcomps_n), STAT=IERR ) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating megan_wght_factors') + megan_wght_factors(:) = NaN + + DO N = 1, shr_megan_mechcomps_n + SpcName = TRIM(shr_megan_mechcomps(N)%name) + ! Special handlings for GEOS-Chem species + IF ( TRIM(SpcName) == 'MTERP' ) THEN + SpcName = 'MTPA' + ELSEIF ( TRIM(SpcName) == 'BCARY' ) THEN + SpcName = 'None' + MW = 204.342600_r8 ! Taken from pp_trop_strat_mam4_vbs + ELSEIF ( TRIM(SpcName) == 'CH3OH' ) THEN + SpcName = 'MOH' + ELSEIF ( TRIM(SpcName) == 'C2H5OH' ) THEN + SpcName = 'EOH' + ELSEIF ( TRIM(SpcName) == 'CH3CHO' ) THEN + SpcName = 'ALD2' + ELSEIF ( TRIM(SpcName) == 'CH3COOH' ) THEN + SpcName = 'ACTA' + ELSEIF ( TRIM(SpcName) == 'CH3COCH3' ) THEN + SpcName = 'ACET' + ELSEIF ( TRIM(SpcName) == 'HCN' ) THEN + SpcName = 'None' + MW = 27.025140_r8 ! Taken from pp_trop_strat_mam4_vbs + ELSEIF ( TRIM(SpcName) == 'C2H4' ) THEN + SpcName = 'None' + MW = 28.051600_r8 ! Taken from pp_trop_strat_mam4_vbs + ELSEIF ( TRIM(SpcName) == 'C3H6' ) THEN + SpcName = 'PRPE' + ELSEIF ( TRIM(SpcName) == 'BIGALK' ) THEN + ! BIGALK = Pentane + Hexane + Heptane + Tricyclene + SpcName = 'ALK4' + ELSEIF ( TRIM(SpcName) == 'BIGENE' ) THEN + ! BIGENE = butene (C4H8) + SpcName = 'PRPE' ! Lumped >= C3 alkenes + ELSEIF ( TRIM(SpcName) == 'TOLUENE' ) THEN + SpcName = 'TOLU' + ENDIF + + CALL cnst_get_ind (SpcName, megan_indices_map(N), abort=.False.) + II = get_spc_ndx(SpcName) + IF ( II > 0 ) THEN + SpcName = TRIM(shr_megan_mechcomps(N)%name) + megan_wght_factors(N) = adv_mass(II)*1.e-3_r8 ! kg/moles (to convert moles/m2/sec to kg/m2/sec) + Description = TRIM(SpcName)//' MEGAN emissions flux (released as '//TRIM(SpcName)//' in GEOS-Chem)' + ELSEIF ( TRIM(SpcName) == 'None' ) THEN + SpcName = TRIM(shr_megan_mechcomps(N)%name) + megan_wght_factors(N) = MW*1.e-3_r8 ! kg/moles + IF ( MasterProc ) Write(iulog,*) " MEGAN ", TRIM(SpcName), & + " emissions will be ignored as no species match in GEOS-Chem." + Description = TRIM(SpcName)//' MEGAN emissions flux (not released in GEOS-Chem)' + ELSE + SpcName = TRIM(shr_megan_mechcomps(N)%name) + CALL ENDRUN( 'chem_init: MEGAN compound not in chemistry mechanism : '//TRIM(SpcName)) + ENDIF + + ! MEGAN history fields + CALL Addfld( 'MEG_'//TRIM(SpcName), horiz_only, 'A', 'kg/m2/s', & + Description ) + + !if (history_chemistry) then + CALL Add_default('MEG_'//TRIM(SpcName), 1, ' ') + !endif + ENDDO + ENDIF + + DO N = iFirstCnst, pcnst + SpcName = TRIM(cnst_name(N))//'_XFRC' + CALL Addfld( TRIM(SpcName), (/ 'lev' /), 'A', 'molec/cm3/s', & + 'External forcing for '//TRIM(cnst_name(N))) + SpcName = TRIM(cnst_name(N))//'_CLXF' + CALL Addfld( TRIM(SpcName), horiz_only, 'A', 'molec/cm2/s', & + 'Vertically-integrated external forcing for '//TRIM(cnst_name(N))) + SpcName = TRIM(cnst_name(N))//'_CMXF' + CALL Addfld( TRIM(SpcName), horiz_only, 'A', 'kg/m2/s', & + 'Vertically-integrated external forcing for '//TRIM(cnst_name(N))) + ENDDO + + CALL Addfld( 'NO_Lightning', (/ 'lev' /), 'A','molec/cm3/s', & + 'lightning NO source' ) + + !----------------------------------------------------------------------- + ! ... Fire emissions + !----------------------------------------------------------------------- + CALL fire_emissions_init() + + END SUBROUTINE CESMGC_Emissions_Init +!EOC +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: cesmgc_emissions_calc +! +! !DESCRIPTION: Subroutine CESMGC\_Emissions\_Calc retrieves emission fluxes +! from HEMCO and returns a 3-D array of emission flux to the CESM-GC +! interface. On top of passing data, this routine handles a number of checks. +!\\ +!\\ +! !INTERFACE: +! + SUBROUTINE CESMGC_Emissions_Calc( state, hco_pbuf2d, State_Met, cam_in, eflx, iStep ) +! +! !USES: +! + USE State_Met_Mod, ONLY : MetState + USE CAMSRFEXCH, ONLY : cam_in_t + USE CONSTITUENTS, ONLY : cnst_get_ind, cnst_mw + USE PHYSICS_TYPES, ONLY : physics_state + USE PHYSICS_BUFFER, ONLY : pbuf_get_index, pbuf_get_chunk + USE PHYSICS_BUFFER, ONLY : physics_buffer_desc, pbuf_get_field + USE PPGRID, ONLY : pcols, pver, begchunk + USE CAM_HISTORY, ONLY : outfld + USE STRING_UTILS, ONLY : to_upper + + ! Data from CLM + USE CAM_CPL_INDICES, ONLY : index_x2a_Fall_flxvoc + + ! Lightning emissions + USE MO_LIGHTNING, ONLY : prod_NO + + ! Fire emissions + USE FIRE_EMISSIONS, ONLY : fire_emissions_srf + USE FIRE_EMISSIONS, ONLY : fire_emissions_vrt + + ! Aerosol emissions + USE AERO_MODEL, ONLY : aero_model_emissions + + ! GEOS-Chem version of physical constants + USE PHYSCONSTANTS, ONLY : AVO + ! CAM version of physical constants + USE PHYSCONST, ONLY : rga, avogad +! +! !INPUT PARAMETERS: +! + TYPE(physics_state), INTENT(IN ) :: state ! Physics state variables + TYPE(physics_buffer_desc), POINTER, INTENT(IN ) :: hco_pbuf2d(:,:) ! Pointer to 2-D pbuf + TYPE(MetState), INTENT(IN ) :: State_Met ! Meteorology State object + INTEGER, INTENT(IN ) :: iStep +! +! !OUTPUT PARAMETERS: +! + TYPE(cam_in_t), INTENT(INOUT) :: cam_in ! import state + REAL(r8), INTENT( OUT) :: eflx(pcols,pver,pcnst) ! 3-D emissions in kg/m2/s +! +! !REVISION HISTORY: +! 07 Oct 2020 - T. M. Fritz - Initial version +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: +! + ! Integers + INTEGER :: LCHNK + INTEGER :: nY, nZ + INTEGER :: J, L, N + INTEGER :: RC ! return code + INTEGER :: tmpIdx ! pbuf field id + + ! Logical + LOGICAL :: rootChunk + + ! Objects + TYPE(physics_buffer_desc), POINTER :: pbuf_chnk(:) ! slice of pbuf in current chunk + + ! Real + REAL(r8), POINTER :: pbuf_ik(:,:) ! pointer to pbuf data (/pcols,pver/) + REAL(r8), DIMENSION(state%NCOL,PVER+1) :: zint ! Interface geopotential in km + REAL(r8), DIMENSION(state%NCOL) :: zsurf ! Surface height + REAL(r8) :: SCALFAC ! Multiplying factor + REAL(r8) :: megflx(pcols) ! For MEGAN emissions + REAL(r8), PARAMETER :: m2km = 1.e-3_r8 + + ! Strings + CHARACTER(LEN=255) :: SpcName + CHARACTER(LEN=255) :: fldname_ns ! field name HCO_* + + !================================================================= + ! CESMGC_Emissions_Calc begins here! + !================================================================= + + ! Initialize pointers + pbuf_chnk => NULL() + pbuf_ik => NULL() + + ! LCHNK: which chunk we have on this process + LCHNK = state%LCHNK + ! nY: number of atmospheric columns on this chunk + nY = state%NCOL + nZ = PVER + rootChunk = ( MasterProc .AND. ( LCHNK.EQ.BEGCHUNK ) ) + + ! Initialize emission flux + eflx(:,:,:) = 0.0e+0_r8 + + DO N = iFirstCnst, pcnst + fldname_ns = 'HCO_'//TRIM(cnst_name(N)) + tmpIdx = pbuf_get_index(fldname_ns, RC) + + IF ( tmpIdx < 0 .OR. ( iStep == 1 ) ) THEN + IF ( rootChunk ) Write(iulog,'(a,a)') " CESMGC_Emissions_Calc: Field not found ", & + TRIM(fldname_ns) + ELSE + ! This is already in chunk, retrieve it + pbuf_chnk => pbuf_get_chunk(hco_pbuf2d, LCHNK) + CALL pbuf_get_field(pbuf_chnk, tmpIdx, pbuf_ik) + + IF ( .NOT. ASSOCIATED(pbuf_ik) ) THEN ! Sanity check + CALL ENDRUN("CESMGC_Emissions_Calc: FATAL - tmpIdx > 0 but pbuf_ik not associated") + ENDIF + + eflx(1:nY,:nZ,N) = pbuf_ik(1:nY,:nZ) + + ! Reset pointers + pbuf_ik => NULL() + pbuf_chnk => NULL() + + IF ( MINVAL(eflx(:nY,:nZ,N)) < 0.0e+00_r8 ) THEN + Write(iulog,*) " CESMGC_Emissions_Calc: HEMCO emission flux is negative for ", & + TRIM(cnst_name(N)), " with value ", MINVAL(eflx(:nY,:nZ,N)), " at ", & + MINLOC(eflx(:nY,:nZ,N)) + ENDIF + + IF ( rootChunk .and. ( MAXVAL(eflx(:nY,:nZ,N)) > 0.0e+0_r8 ) ) THEN + Write(iulog,'(a,a,a,a)') " CESMGC_Emissions_Calc: HEMCO flux ", & + TRIM(fldname_ns), " added to ", TRIM(cnst_name(N)) + Write(iulog,'(a,a,E16.4)') " CESMGC_Emissions_Calc: Maximum flux ", & + TRIM(fldname_ns), MAXVAL(eflx(:nY,:nZ,N)) + ENDIF + ENDIF + ENDDO + +#if defined( MODAL_AERO_4MODE ) + !----------------------------------------------------------------------- + ! Aerosol emissions (dust + seasalt) ... + !----------------------------------------------------------------------- + call aero_model_emissions( state, cam_in ) + + ! Since GEOS-Chem DST* aerosols are inherited from MAM's DST, we do not + ! need to feed MAM dust emissions into the GEOS-Chem DST* constituents + ! Same thing applies for sea salt. + + ! HEMCO aerosol emissions are fed to MAM through the HEMCO_Config.rc + ! where all GEOS-Chem aerosols (BCPI, BCPO, OCPI, OCPO, SO4) have been + ! replaced with the corresponding MAM aerosols + + ! For SOA emission, split evently GEOS-Chem SOAS emission into each + ! VBS bin. + eflx(:nY,:nZ,iSOA11) = eflx(:nY,:nZ,iSOAS) / 10.0e+00_r8 + eflx(:nY,:nZ,iSOA12) = eflx(:nY,:nZ,iSOAS) / 10.0e+00_r8 + eflx(:nY,:nZ,iSOA21) = eflx(:nY,:nZ,iSOAS) / 10.0e+00_r8 + eflx(:nY,:nZ,iSOA22) = eflx(:nY,:nZ,iSOAS) / 10.0e+00_r8 + eflx(:nY,:nZ,iSOA31) = eflx(:nY,:nZ,iSOAS) / 10.0e+00_r8 + eflx(:nY,:nZ,iSOA32) = eflx(:nY,:nZ,iSOAS) / 10.0e+00_r8 + eflx(:nY,:nZ,iSOA41) = eflx(:nY,:nZ,iSOAS) / 10.0e+00_r8 + eflx(:nY,:nZ,iSOA42) = eflx(:nY,:nZ,iSOAS) / 10.0e+00_r8 + eflx(:nY,:nZ,iSOA51) = eflx(:nY,:nZ,iSOAS) / 10.0e+00_r8 + eflx(:nY,:nZ,iSOA52) = eflx(:nY,:nZ,iSOAS) / 10.0e+00_r8 + eflx(:nY,:nZ,iSOAS) = 0.0e+00_r8 + +#endif + + ! Output fields before lightning NO emissions are applied to eflx + DO N = iFirstCnst, pcnst + SpcName = TRIM(cnst_name(N))//'_XFRC' + CALL Outfld( TRIM(SpcName), eflx(:nY,:nZ,N) / State_Met%BXHEIGHT(1,:nY,nZ:1:-1) * 1.0E-06 / cnst_mw(N) * avogad, nY, LCHNK ) + + SpcName = TRIM(cnst_name(N))//'_CLXF' + ! Convert from kg/m2/s to molec/cm2/s + ! Note 1: cnst_mw is in kg/kmole + ! Note 2: avogad is in molecules/kmole + CALL Outfld( TRIM(SpcName), SUM(eflx(:nY,:nZ,N), DIM=2) * 1.0E-04 / cnst_mw(N) * avogad, nY, LCHNK ) + + SpcName = TRIM(cnst_name(N))//'_CMXF' + CALL Outfld( TRIM(SpcName), SUM(eflx(:nY,:nZ,N), DIM=2), nY, LCHNK ) + ENDDO + + !----------------------------------------------------------------------- + ! Lightning NO emissions + !----------------------------------------------------------------------- + N = iNO + + ! prod_NO is in atom N cm^-3 s^-1 <=> molec cm^-3 s^-1 + ! We need to convert this to kg NO/m2/s + ! Multiply by MWNO * BXHEIGHT * 1.0E+06 / AVO + ! = mole/molec * kg NO/mole * m * cm^3/m^3 + ! cnst_mw(N) is in g/mole + SCALFAC = cnst_mw(N) * 1.0E-03 * 1.0E+06 / AVO + DO J = 1, nY + DO L = 1, nZ + eflx(J,L,N) = eflx(J,L,N) & + + prod_NO(J,L,LCHNK) & + * State_Met%BXHEIGHT(1,J,nZ+1-L) & + * SCALFAC + ENDDO + ENDDO + + CALL Outfld( 'NO_Lightning', prod_NO(:nY,:nZ,LCHNK), nY, LCHNK ) + + !----------------------------------------------------------------------- + ! MEGAN emissions ... + !----------------------------------------------------------------------- + + IF ( index_x2a_Fall_flxvoc > 0 .AND. shr_megan_mechcomps_n > 0 ) THEN + ! set MEGAN fluxes + DO N = 1, shr_megan_mechcomps_n + DO J = 1, nY + megflx(J) = -cam_in%meganflx(J,N) * megan_wght_factors(N) + ENDDO + IF ( ( megan_indices_map(N) > 0 ) .AND. ( megan_wght_factors(N) > 0.0e+00_r8 ) ) THEN + DO J = 1, nY + cam_in%cflx(J,megan_indices_map(N)) = cam_in%cflx(J,megan_indices_map(N)) & + + megflx(J) + ENDDO + ENDIF + ! output MEGAN emis fluxes to history + CALL Outfld('MEG_'//TRIM(shr_megan_mechcomps(N)%name), megflx(:nY), nY, LCHNK) + ENDDO + ENDIF + + !----------------------------------------------------------------------- + ! Fire surface emissions if not elevated forcing + !----------------------------------------------------------------------- + + CALL fire_emissions_srf( LCHNK, nY, cam_in%fireflx, cam_in%cflx ) + + !----------------------------------------------------------------------- + ! Apply CLM emissions (for elevated forcing) + !----------------------------------------------------------------------- + + ! Compute geopotential height in km (needed for vertical distribution of + ! fire emissions + zsurf(:nY) = rga * state%phis(:nY) + DO L = 1, nZ + zint(:nY,L) = m2km * ( state%zi(:nY,L) + zsurf(:nY) ) + ENDDO + L = nZ+1 + zint(:nY,L) = m2km * ( state%zi(:nY,L) + zsurf(:nY) ) + + ! Distributed fire emissions if elevated forcing + ! extfrc is in molec/cm3/s + ! TMMF - vertical distribution of fire emissions is not implemented yet + !CALL fire_emissions_vrt( nY, LCHNK, zint, cam_in%fireflx, cam_in%fireztop, extfrc ) + + !----------------------------------------------------------------------- + ! Add near-surface emissions to surface flux boundary condition + !----------------------------------------------------------------------- + cam_in%cflx(1:nY,:) = cam_in%cflx(1:nY,:) + eflx(1:nY,nZ,:) + eflx(1:nY,nZ,:) = 0.0e+00_r8 + + END SUBROUTINE CESMGC_Emissions_Calc +!EOC +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: cesmgc_emissions_final +! +! !DESCRIPTION: Subroutine CESMGC\_Emissions\_Final cleans up the module +!\\ +!\\ +! !INTERFACE: +! + SUBROUTINE CESMGC_Emissions_Final +! +! !REVISION HISTORY: +! 07 Oct 2020 - T. M. Fritz - Initial version +!EOP +!------------------------------------------------------------------------------ +!BOC +! + !================================================================= + ! CESMGC_Emissions_Final begins here! + !================================================================= + + IF ( ALLOCATED( megan_indices_map ) ) DEALLOCATE( megan_indices_map ) + IF ( ALLOCATED( megan_wght_factors ) ) DEALLOCATE( megan_wght_factors ) + + END SUBROUTINE CESMGC_Emissions_Final +!EOC +!------------------------------------------------------------------------------ +!EOC + END MODULE CESMGC_Emissions_Mod diff --git a/src/chemistry/pp_geoschem/charge_neutrality.F90 b/src/chemistry/geoschem/charge_neutrality.F90 similarity index 100% rename from src/chemistry/pp_geoschem/charge_neutrality.F90 rename to src/chemistry/geoschem/charge_neutrality.F90 diff --git a/src/chemistry/pp_geoschem/chem_mods.F90 b/src/chemistry/geoschem/chem_mods.F90 similarity index 71% rename from src/chemistry/pp_geoschem/chem_mods.F90 rename to src/chemistry/geoschem/chem_mods.F90 index af430ac0ca..c2b9919a94 100644 --- a/src/chemistry/pp_geoschem/chem_mods.F90 +++ b/src/chemistry/geoschem/chem_mods.F90 @@ -7,7 +7,7 @@ module chem_mods implicit none save - INTEGER, PARAMETER :: nTracersMax = 200 ! Must be equal to nadv_chem + INTEGER, PARAMETER :: nTracersMax = 250 ! Must be equal to nadv_chem INTEGER :: nTracers CHARACTER(LEN=255) :: tracerNames(nTracersMax) CHARACTER(LEN=255) :: tracerLongNames(nTracersMax) @@ -15,18 +15,38 @@ module chem_mods REAL(r8) :: MWRatio(nTracersMax) REAL(r8) :: ref_MMR(nTracersMax) + ! Index of first constituent + INTEGER :: iFirstCnst + ! Short-lived species (i.e. not advected) - INTEGER, PARAMETER :: nSlsMax = 500 ! UNadvected species only - INTEGER :: nSls - CHARACTER(LEN=255) :: slsNames(nSlsMax) - CHARACTER(LEN=255) :: slsLongnames(nSlsMax) - REAL(r8) :: sls_Ref_MMR(nSlsMax) - REAL(r8) :: slsMWRatio(nSlsMax) + INTEGER, PARAMETER :: nSlsMax = 500 ! UNadvected species only + INTEGER :: nSls + CHARACTER(LEN=255) :: slsNames(nSlsMax) + CHARACTER(LEN=255) :: slsLongnames(nSlsMax) + REAL(r8) :: sls_Ref_MMR(nSlsMax) ! Mapping between constituents and GEOS-Chem tracers INTEGER :: map2GC(pcnst) + INTEGER :: map2GCinv(nTracersMax) INTEGER :: map2GC_Sls(nSlsMax) + ! Mapping constituent onto chemical species (as listed in solsym) + INTEGER :: mapCnst(pcnst) + + ! Aerosols + INTEGER, PARAMETER :: nAerMax = 35 + INTEGER :: nAer + CHARACTER(LEN=16) :: aerNames(nAerMax) + REAL(r8) :: aerAdvMass(nAerMax) + + !----------------------------- + ! Aerosol index mapping + !----------------------------- + ! map2MAM4 maps aerNames onto the GEOS-Chem Species array such + ! that + ! State_Chm%Species(1,:,:,map2MAM4(:,:)) = state%q(:,:,MAM4_Indices) + INTEGER, ALLOCATABLE :: map2MAM4(:,:) + !----------------------------- ! Dry deposition index mapping !----------------------------- @@ -39,20 +59,16 @@ module chem_mods ! State_Chm%DryDepVel(1,:,map2GC_dryDep(:)) = cam_in%depVel(:,:) INTEGER, ALLOCATABLE :: map2GC_dryDep(:) - - ! Mapping from constituents to raw index - INTEGER :: map2Idx(pcnst) - INTEGER, PARAMETER :: phtcnt = 40, & ! number of photolysis reactions rxntot = 212, & ! number of total reactions gascnt = 172, & ! number of gas phase reactions nabscol = 2, & ! number of absorbing column densities - gas_pcnst = 103, & ! number of "gas phase" species - nfs = 4, & ! number of "fixed" species + gas_pcnst = 318, & ! number of "gas phase" species + nfs = 6, & ! number of "fixed" species relcnt = 0, & ! number of relationship species grpcnt = 0, & ! number of group members nzcnt = 824, & ! number of non-zero matrix entries - extcnt = 4, & ! number of species with external forcing + extcnt = 0, & ! number of species with external forcing clscnt1 = 8, & ! number of species in explicit class clscnt2 = 0, & ! number of species in hov class clscnt3 = 0, & ! number of species in ebi class @@ -69,7 +85,7 @@ module chem_mods 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) :: 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(:) @@ -88,4 +104,8 @@ module chem_mods integer :: nslvd character(len=255), allocatable :: slvd_lst(:) real(r8), allocatable :: slvd_ref_mmr(:) + + ! Mapping between chemical species and GEOS-Chem species/other tracers + INTEGER :: map2chm(gas_pcnst) + end module chem_mods diff --git a/src/chemistry/pp_geoschem/chem_prod_loss_diags.F90 b/src/chemistry/geoschem/chem_prod_loss_diags.F90 similarity index 100% rename from src/chemistry/pp_geoschem/chem_prod_loss_diags.F90 rename to src/chemistry/geoschem/chem_prod_loss_diags.F90 diff --git a/src/chemistry/geoschem/chemistry.F90 b/src/chemistry/geoschem/chemistry.F90 new file mode 100644 index 0000000000..ec97c95ec1 --- /dev/null +++ b/src/chemistry/geoschem/chemistry.F90 @@ -0,0 +1,4215 @@ +!================================================================================================ +! This is the "GEOS-Chem" chemistry module. +!================================================================================================ + +module chemistry + use shr_kind_mod, only : r8 => shr_kind_r8, shr_kind_cl + use physics_types, only : physics_state, physics_ptend, physics_ptend_init + use physics_buffer, only : physics_buffer_desc + use ppgrid, only : begchunk, endchunk, pcols + use ppgrid, only : pver, pverp + use constituents, only : pcnst, cnst_add, cnst_get_ind + use constituents, only : cnst_name + use shr_const_mod, only : molw_dryair=>SHR_CONST_MWDAIR + use seq_drydep_mod, only : nddvels => n_drydep, drydep_list + use spmd_utils, only : MasterProc, myCPU=>Iam, nCPUs=>npes + use cam_logfile, only : iulog + use string_utils, only : to_upper + + !-------------------------------------------------------------------- + ! Basic GEOS-Chem modules + !-------------------------------------------------------------------- + USE DiagList_Mod, ONLY : DgnList ! Derived type for diagnostics list + USE TaggedDiagList_Mod, ONLY : TaggedDgnList ! Derived type for tagged diagnostics list + USE Input_Opt_Mod, ONLY : OptInput ! Derived type for Input Options + USE State_Chm_Mod, ONLY : ChmState ! Derived type for Chemistry State object + USE State_Diag_Mod, ONLY : DgnState ! Derived type for Diagnostics State object + USE State_Grid_Mod, ONLY : GrdState ! Derived type for Grid State object + USE State_Met_Mod, ONLY : MetState ! Derived type for Meteorology State object + USE Species_Mod, ONLY : Species ! Derived type for Species object + USE GC_Environment_Mod ! Runtime GEOS-Chem environment + USE ErrCode_Mod ! Error codes for success or failure + USE Error_Mod ! For error checking + + !----------------------------------------------------------------- + ! Parameters to define floating-point variables + !----------------------------------------------------------------- + USE PRECISION_MOD, ONLY : fp, f4 ! Flexible precision + + use chem_mods, only : nSlvd, slvd_Lst, slvd_ref_MMR + + ! Exit routine in CAM + use cam_abortutils, only : endrun + + use chem_mods, only : nTracersMax + use chem_mods, only : nTracers + use chem_mods, only : gas_pcnst + use chem_mods, only : tracerNames + use chem_mods, only : adv_mass + use chem_mods, only : ref_MMR + use chem_mods, only : iFirstCnst + use chem_mods, only : nSlsMax + use chem_mods, only : nSls + use chem_mods, only : slsNames + use chem_mods, only : sls_ref_MMR + use chem_mods, only : nAerMax + use chem_mods, only : nAer + use chem_mods, only : aerNames + use chem_mods, only : aerAdvMass + use chem_mods, only : map2GC, map2GCinv + use chem_mods, only : map2GC_Sls + use chem_mods, only : mapCnst + use chem_mods, only : map2chm + use chem_mods, only : map2MAM4 + + use mo_tracname, only : solsym + + IMPLICIT NONE + PRIVATE + SAVE + ! + ! Public interfaces + ! + public :: chem_is ! identify which chemistry is being used + public :: chem_register ! register consituents + public :: chem_is_active ! returns true if this package is active (ghg_chem=.true.) + public :: chem_implements_cnst ! returns true if consituent is implemented by this package + public :: chem_init_cnst ! initialize mixing ratios if not read from initial file + public :: chem_init ! initialize (history) variables + public :: chem_timestep_tend ! interface to tendency computation + public :: chem_final + public :: chem_write_restart + public :: chem_read_restart + public :: chem_init_restart + public :: chem_readnl ! read chem namelist + + public :: chem_emissions + public :: chem_timestep_init + + ! Location of valid input.geos and species_database.yml + ! Use local files in run folder + CHARACTER(LEN=500) :: inputGeos = 'input.geos' + CHARACTER(LEN=500) :: speciesDB = 'species_database.yml' + + ! Location of chemistry input + CHARACTER(LEN=256) :: gc_cheminputs + + !----------------------------- + ! Derived type objects + !----------------------------- + TYPE(OptInput) :: Input_Opt ! Input Options object + TYPE(ChmState),ALLOCATABLE :: State_Chm(:) ! Chemistry State object + TYPE(DgnState),ALLOCATABLE :: State_Diag(:) ! Diagnostics State object + TYPE(GrdState),ALLOCATABLE :: State_Grid(:) ! Grid State object + TYPE(MetState),ALLOCATABLE :: State_Met(:) ! Meteorology State object + TYPE(DgnList ) :: Diag_List ! Diagnostics list object + TYPE(TaggedDgnList ) :: TaggedDiag_List ! Tagged diagnostics list object + + type(physics_buffer_desc), pointer :: hco_pbuf2d(:,:) ! Pointer to 2D pbuf + + ! Indices of critical species in GEOS-Chem + INTEGER :: iH2O, iO3, iCO2 + INTEGER :: iO, iH, iO2, iPSO4 + REAL(r8) :: MWPSO4, MWO3 + ! Indices of critical species in the constituent list + INTEGER :: cQ, cH2O + + ! Indices in the physics buffer + INTEGER :: NDX_PBLH ! PBL height [m] + INTEGER :: NDX_FSDS ! Downward shortwave flux at surface [W/m2] + INTEGER :: NDX_CLDTOP ! Cloud top height [index] + INTEGER :: NDX_CLDFRC ! Cloud fraction [-] + INTEGER :: NDX_PRAIN ! Rain production rate [kg/kg/s] + INTEGER :: NDX_NEVAPR ! Total rate of precipitation evaporation [kg/kg/s] + INTEGER :: NDX_LSFLXPRC ! Large-scale precip. at interface (liq + snw) [kg/m2/s] + INTEGER :: NDX_LSFLXSNW ! Large-scale precip. at interface (snow only) [kg/m2/s] + INTEGER :: NDX_CMFDQR ! Convective total precip. production rate [kg/kg/s] + + ! Get constituent indices + INTEGER :: ixCldLiq ! Cloud liquid water + INTEGER :: ixCldIce ! Cloud ice + INTEGER :: ixNDrop ! Cloud droplet number index + + ! ghg + + LOGICAL :: ghg_chem = .false. ! .true. => use ghg chem package + CHARACTER(len=shr_kind_cl) :: bndtvg = ' ' ! pathname for greenhouse gas loss rate + CHARACTER(len=shr_kind_cl) :: h2orates = ' ' ! pathname for greenhouse gas (lyman-alpha H2O loss) + + ! lightning + REAL(r8) :: lght_no_prd_factor = 1._r8 + + ! Strings + CHARACTER(LEN=255) :: ThisLoc + CHARACTER(LEN=255) :: ErrMsg + + ! Filenames to compute dry deposition velocities similarly to MOZART + character(len=shr_kind_cl) :: clim_soilw_file = 'clim_soilw_file' + character(len=shr_kind_cl) :: depvel_file = '' + character(len=shr_kind_cl) :: depvel_lnd_file = 'depvel_lnd_file' + character(len=shr_kind_cl) :: season_wes_file = 'season_wes_file' + + character(len=shr_kind_cl) :: srf_emis_specifier(pcnst) = '' + character(len=shr_kind_cl) :: ext_frc_specifier(pcnst) = '' + + character(len=24) :: srf_emis_type = 'CYCLICAL' ! 'CYCLICAL' | 'SERIAL' | 'INTERP_MISSING_MONTHS' + integer :: srf_emis_cycle_yr = 0 + integer :: srf_emis_fixed_ymd = 0 + integer :: srf_emis_fixed_tod = 0 + + character(len=24) :: ext_frc_type = 'CYCLICAL' ! 'CYCLICAL' | 'SERIAL' | 'INTERP_MISSING_MONTHS' + integer :: ext_frc_cycle_yr = 0 + integer :: ext_frc_fixed_ymd = 0 + integer :: ext_frc_fixed_tod = 0 + + +!================================================================================================ +contains +!================================================================================================ + + logical function chem_is (name) + + use mo_chem_utls, only : utls_chem_is + + chem_is = .false. + IF ( to_upper(name) == 'GEOSCHEM' ) THEN + chem_is = .true. + ENDIF + + end function chem_is + +!================================================================================================ + + subroutine chem_register + + use physics_buffer, only : pbuf_add_field, dtype_r8 + use PhysConst, only : MWDry + + use Short_Lived_Species, only : Register_Short_Lived_Species + + use State_Grid_Mod, only : Init_State_Grid, Cleanup_State_Grid + use State_Chm_Mod, only : Init_State_Chm, Cleanup_State_Chm + use State_Chm_Mod, only : Ind_ + use Input_Opt_Mod, only : Set_Input_Opt, Cleanup_Input_Opt + use CMN_SIZE_Mod, only : Init_CMN_SIZE + + use mo_sim_dat, only : set_sim_dat + use mo_chem_utls, only : get_spc_ndx + use chem_mods, only : drySpc_ndx +#if defined( MODAL_AERO_4MODE ) + use aero_model, only : aero_model_register + use modal_aero_data, only : nspec_max + use modal_aero_data, only : ntot_amode, nspec_amode + use modal_aero_data, only : xname_massptr +#endif + + !----------------------------------------------------------------------- + ! + ! Purpose: register advected constituents for chemistry + ! + !----------------------------------------------------------------------- + ! Need to generate a temporary species database + TYPE(ChmState) :: SC + TYPE(GrdState) :: SG + TYPE(OptInput) :: IO + TYPE(Species), POINTER :: ThisSpc + + INTEGER :: I, N, M, L + INTEGER :: nIgnored + REAL(r8) :: cptmp + REAL(r8) :: MWTmp + REAL(r8) :: qmin + REAL(r8) :: refmmr, refvmr + CHARACTER(LEN=128) :: mixtype + CHARACTER(LEN=128) :: molectype + CHARACTER(LEN=128) :: lngName + CHARACTER(LEN=64) :: cnstName + CHARACTER(LEN=64) :: trueName + LOGICAL :: camout + LOGICAL :: ic_from_cam2 + LOGICAL :: has_fixed_ubc + LOGICAL :: has_fixed_ubflx + + INTEGER :: RC, IERR + + ! Assume a successful return until otherwise + RC = GC_SUCCESS + + ! For error trapping + ErrMsg = '' + ThisLoc = ' -> at GEOS-Chem (in chemistry/geoschem/chemistry.F90)' + + ! Initialize pointer + ThisSpc => NULL() + + ! SDE 2018-05-02: This seems to get called before anything else + ! that includes CHEM_INIT + ! At this point, mozart calls SET_SIM_DAT, which is specified by each + ! mechanism separately (ie mozart/chemistry.F90 calls the subroutine + ! set_sim_dat which is in pp_[mechanism]/mo_sim_dat.F90. That sets a lot of + ! data in other places, notably in "chem_mods" + + ! hplin 2020-05-16: Call set_sim_dat to populate chemistry constituent information + ! from mo_sim_dat.F90 in other places. This is needed for HEMCO_CESM. + CALL Set_sim_dat() + IF ( MasterProc ) Write(iulog,*) 'GCCALL after set_sim_dat' + + ! Prevent Reporting + IO%amIRoot = .False. + IO%thisCpu = MyCPU + + CALL Set_Input_Opt( am_I_Root = MasterProc, & + Input_Opt = IO, & + RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Could not generate reference input options object!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + ! Options needed by Init_State_Chm + IO%ITS_A_FULLCHEM_SIM = .True. + IO%LLinoz = .True. + IO%LUCX = .True. + IO%LPRT = .False. + IO%N_Advect = nTracers + DO I = 1, nTracers + IO%AdvectSpc_Name(I) = TRIM(tracerNames(I)) + ENDDO + IO%SALA_rEdge_um(1) = 0.01e+0_fp + IO%SALA_rEdge_um(2) = 0.50e+0_fp + IO%SALC_rEdge_um(1) = 0.50e+0_fp + IO%SALC_rEdge_um(2) = 8.00e+0_fp + + IO%SpcDatabaseFile = TRIM(speciesDB) + + CALL Init_State_Grid( Input_Opt = IO, & + State_Grid = SG, & + RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered within call to "Init_State_Grid"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + SG%NX = 1 + SG%NY = 1 + SG%NZ = 1 + + CALL GC_Init_Grid( Input_Opt = IO, & + State_Grid = SG, & + RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error in GC_Init_Grid"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + CALL Init_CMN_SIZE( Input_Opt = IO, & + RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered within call to "Init_CMN_SIZE"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + CALL Init_State_Chm( Input_Opt = IO, & + State_Chm = SC, & + State_Grid = SG, & + RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered within call to "Init_State_Chm"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + iFirstCnst = -1 + mapCnst = -1 + map2GC = -1 + map2GCinv = -1 + map2chm = -1 + ref_MMR(:) = 0.0e+0_r8 + + DO I = 1, nTracersMax + IF ( I .LE. nTracers ) THEN + cnstName = TRIM(tracerNames(I)) + trueName = cnstName + N = Ind_(cnstName) + ThisSpc => SC%SpcData(N)%Info + lngName = TRIM(ThisSpc%FullName) + MWTmp = REAL(ThisSpc%MW_g,r8) + refvmr = REAL(ThisSpc%BackgroundVV,r8) + refmmr = refvmr / (MWDry / MWTmp) + ! Make sure that solsym is following the list of tracers as listed in input.geos + IF ( to_upper(TRIM(tracerNames(I))) /= to_upper(TRIM(solsym(I))) ) THEN + Write(iulog,*) "tracerNames (", TRIM(tracerNames(I)), ") /= solsym (", & + TRIM(solsym(I)), ")" + CALL ENDRUN('Solsym must be following GEOS-Chem tracer. Check geoschem/mo_sim.dat') + ENDIF + ! Nullify pointer + ThisSpc => NULL() + ELSEIF ( I .LE. (nTracers + nAer) ) THEN + ! Add MAM4 aerosols + cnstName = TRIM(aerNames(I - nTracers)) + trueName = cnstName + lngName = cnstName + MWTmp = aerAdvMass(I - nTracers) + refmmr = 1.0e-38_r8 + ELSEIF ( I .EQ. (nTracers + nAer + 1) ) THEN + ! Add CO2 (which is not a GEOS-Chem tracer) + cnstName = 'CO2' + trueName = cnstName + lngName = cnstName + MWTmp = 44.009800_r8 + refmmr = 1.0e-38_r8 + ELSE + cnstName = TRIM(tracerNames(I)) + trueName = cnstName + lngName = cnstName + MWTmp = 1000.0e+0_r8 * (0.001e+0_r8) + refmmr = 1.0e-38_r8 + ENDIF + + ! dummy value for specific heat of constant pressure (Cp) + cptmp = 666._r8 + ! minimum mixing ratio + qmin = 1.e-38_r8 + ! mixing ratio type + mixtype = 'dry' + ! Used for ionospheric WACCM (WACCM-X) + molectype = 'minor' + ! Is an output field (?) + camout = .false. + ! Not true for O2(1-delta) or O2(1-sigma) + ic_from_cam2 = .true. + ! Use a fixed value at the upper boundary + has_fixed_ubc = .false. + ! Use a fixed flux condition at the upper boundary + has_fixed_ubflx = .false. + + ! TMMF - 8/20/2020 + ! Note: I had to modify the IC file to rename variables such as + ! CH3COCH3 into ACET. Using that new IC file, we can thus remove + ! the unnecessary special handlings. + ! Another option would have been to modify cnst_add and read_inidat + ! to use a load_name the first time IC are read. Constituent names + ! would be stored in cnst_name, while read_inidat would load from + ! load_name. load_name would be an optional argument to cnst_add, such + ! that, by default, load_name = cnst_name. + ! However, this would be tricky to handle with restart files that + ! would save cnst_name rather than load_name. + + ! Special handlings + IF ( cnstName == 'HCHO' ) THEN + cnstName = 'CH2O' + !ELSEIF ( cnstName == 'HNO4' ) THEN + ! cnstName = 'HO2NO2' + !ELSEIF ( cnstName == 'HNO2' ) THEN + ! cnstName = 'HONO' + !ELSEIF ( cnstName == 'ACET' ) THEN + ! cnstName = 'CH3COCH3' + !ELSEIF ( cnstName == 'ALD2' ) THEN + ! cnstName = 'CH3CHO' + !ELSEIF ( cnstName == 'PRPE' ) THEN + ! cnstName = 'C3H6' + !ELSEIF ( cnstName == 'MP' ) THEN + ! cnstName = 'CH3OOH' + !ELSEIF ( cnstName == 'HAC' ) THEN + ! cnstName = 'HYAC' + !ELSEIF ( cnstName == 'GLYC' ) THEN + ! cnstName = 'GLYALD' + !ELSEIF ( cnstName == 'MAP' ) THEN + ! cnstName = 'CH3COOOH' + !ELSEIF ( cnstName == 'EOH' ) THEN + ! cnstName = 'C2H5OH' + !ELSEIF ( cnstName == 'MGLY' ) THEN + ! cnstName = 'CH3COCHO' + !ELSEIF ( cnstName == 'GLYX' ) THEN + ! cnstName = 'GLYOXAL' + !ELSEIF ( cnstName == 'ACTA' ) THEN + ! cnstName = 'CH3COOH' + !ELSEIF ( cnstName == 'TOLU' ) THEN + ! cnstName = 'TOLUENE' + ENDIF + + ! For debug, only + !If ( MasterProc ) Write(iulog,*) " Species = ", TRIM(cnstName) + + CALL cnst_add( cnstName, MWtmp, cptmp, qmin, N, & + readiv=ic_from_cam2, mixtype=mixtype, & + cam_outfld=camout, molectype=molectype, & + fixed_ubc=has_fixed_ubc, & + fixed_ubflx=has_fixed_ubflx, & + longname=TRIM(lngName) ) + + IF ( iFirstCnst < 0 ) iFirstCnst = N + + ref_MMR(N) = refmmr + + ! Add to GC mapping. When starting a timestep, we will want to update the + ! concentration of State_Chm(x)%Species(1,iCol,iLev,m) with data from + ! constituent n + M = Ind_(TRIM(trueName)) + IF ( M > 0 ) THEN + ! Map constituent onto GEOS-Chem tracer as indexed in State_Chm(LCHNK)%Species + map2GC(N) = M + ! Map GEOS-Chem tracer onto constituent + map2GCinv(M) = N + ENDIF + ! Map constituent onto chemically-active species (aka as indexed in solsym) + M = get_spc_ndx(TRIM(trueName)) + IF ( M > 0 ) THEN + mapCnst(N) = M + ENDIF + ENDDO + + ! Now unadvected species + map2GC_Sls = 0 + sls_ref_MMR(:) = 0.0e+0_r8 + DO I = 1, nSls + N = Ind_(slsNames(I)) + IF ( N .GT. 0 ) THEN + ThisSpc => SC%SpcData(N)%Info + MWTmp = REAL(ThisSpc%MW_g,r8) + refvmr = REAL(ThisSpc%BackgroundVV,r8) + lngName = TRIM(ThisSpc%FullName) + sls_ref_MMR(I) = refvmr / (MWDry / MWTmp) + map2GC_Sls(I) = N + ThisSpc => NULL() + ENDIF + ENDDO + + ! Pass information to "short_lived_species" module + slvd_ref_MMR(1:nSls) = sls_ref_MMR(1:nSls) + CALL Register_Short_Lived_Species() + ! More information: + ! http://www.cesm.ucar.edu/models/atm-cam/docs/phys-interface/node5.html + + DO N = 1, gas_pcnst + ! Map solsym onto GEOS-Chem species + map2chm(N) = Ind_(TRIM(solsym(N))) + IF ( map2chm(N) < 0 ) THEN + ! This is not a GEOS-Chem species and we thus map on constituents + ! Most likely, these will be MAM aerosols + ! We store the index as the opposite to not confuse with GEOS-Chem + ! indices. + CALL cnst_get_ind(TRIM(solsym(N)), I, abort=.True.) + map2chm(N) = -I + ENDIF + ENDDO + ! Get constituent index of specific humidity + CALL cnst_get_ind('Q', cQ, abort=.True.) + CALL cnst_get_ind('H2O', cH2O, abort=.True.) + + !============================================================== + ! Get mapping between dry deposition species and species set + !============================================================== + + nIgnored = 0 + + DO N = 1, nddvels + + ! The species names need to be convert to upper case as, + ! for instance, BR2 != Br2 + drySpc_ndx(N) = get_spc_ndx( to_upper(drydep_list(N)) ) + + IF ( MasterProc .AND. ( drySpc_ndx(N) < 0 ) ) THEN + Write(iulog,'(a,a)') ' ## Ignoring dry deposition of ', & + TRIM(drydep_list(N)) + nIgnored = nIgnored + 1 + ENDIF + ENDDO + + IF ( MasterProc .AND. ( nIgnored > 0 ) ) THEN + Write(iulog,'(a,a)') ' The species listed above have dry', & + ' deposition turned off for one of the following reasons:' + Write(iulog,'(a)') ' - They are not present in the GEOS-Chem tracer list.' + Write(iulog,'(a)') ' - They have a synonym (e.g. CH2O and HCHO).' + ENDIF + +#if defined( MODAL_AERO_4MODE ) + ! add fields to pbuf needed by aerosol models + CALL aero_model_register() + + ! Mode | \sigma_g | Dry diameter (micrometers) + ! -----------------------|----------|-------------------------- + ! a2 - Aitken mode | 1.6 | 0.015 - 0.053 + ! a1 - Accumulation mode | 1.8 | 0.058 - 0.27 + ! a3 - Coarse mode | 1.8 | 0.80 - 3.65 + ! a4 - Primary carbon | 1.6 | 0.039 - 0.13 + ! -----------------------|----------|-------------------------- + ! Ref: Liu, Xiaohong, et al. "Toward a minimal representation of aerosols in + ! climate models: Description and evaluation in the Community Atmosphere + ! Model CAM5." Geoscientific Model Development 5.3 (2012): 709. + + ALLOCATE(map2MAM4(nspec_max,ntot_amode), STAT=IERR) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failed to allocate map2MAM4') + + ! Initialize indices + map2MAM4(:,:) = -1 + + DO M = 1, ntot_amode + DO L = 1, nspec_amode(M) + SELECT CASE ( to_upper(xname_massptr(L,M)(:3)) ) + CASE ( 'BC_' ) + SELECT CASE ( to_upper(xname_massptr(L,M)(4:5)) ) + CASE ( 'A1' ) + map2MAM4(L,M) = Ind_('BCPI') + CASE ( 'A4' ) + map2MAM4(L,M) = Ind_('BCPO') + END SELECT + CASE ( 'DST' ) + SELECT CASE ( to_upper(xname_massptr(L,M)(5:6)) ) + ! DST1 - Dust aerosol, Reff = 0.7 micrometers + ! DST2 - Dust aerosol, Reff = 1.4 micrometers + ! DST3 - Dust aerosol, Reff = 2.4 micrometers + ! DST4 - Dust aerosol, Reff = 4.5 micrometers + CASE ( 'A1' ) + map2MAM4(L,M) = Ind_('DST1') + CASE ( 'A2' ) + map2MAM4(L,M) = Ind_('DST1') + CASE ( 'A3' ) + map2MAM4(L,M) = Ind_('DST4') + END SELECT + CASE ( 'SOA' ) + map2MAM4(L,M) = Ind_('SOAS') + CASE ( 'SO4' ) + map2MAM4(L,M) = Ind_('SO4') + CASE ( 'NCL' ) + SELECT CASE ( to_upper(xname_massptr(L,M)(5:6)) ) + ! SALA - Fine (0.01-0.05 micros) sea salt aerosol + ! SALC - Coarse (0.5-8 micros) sea salt aerosol + CASE ( 'A1' ) + map2MAM4(L,M) = Ind_('SALA') + CASE ( 'A2' ) + map2MAM4(L,M) = Ind_('SALA') + CASE ( 'A3' ) + map2MAM4(L,M) = Ind_('SALC') + END SELECT + CASE ( 'POM' ) + SELECT CASE ( to_upper(xname_massptr(L,M)(5:6)) ) + CASE ( 'A1' ) + map2MAM4(L,M) = Ind_('OCPI') + CASE ( 'A4' ) + map2MAM4(L,M) = Ind_('OCPO') + END SELECT + END SELECT + ENDDO + ENDDO + +#endif + + !============================================================== + ! Print summary + !============================================================== + + IF ( MasterProc ) THEN + Write(iulog,'(/, a)') '### Summary of GEOS-Chem species: ' + Write(iulog,'( a)') REPEAT( '-', 50 ) + Write(iulog,'( a)') '+ List of advected species: ' + Write(iulog,100) 'ID', 'Tracer', ''!'Dry deposition (T/F)' + DO N = 1, nTracers + Write(iulog,120) N, TRIM(tracerNames(N))!, ANY(drySpc_ndx .eq. N) + ENDDO + IF ( nAer > 0 ) THEN + Write(iulog,'(/, a)') '+ List of aerosols: ' + Write(iulog,110) 'ID', 'MAM4 Aerosol' + DO N = 1, nAer + Write(iulog,130) N, TRIM(aerNames(N)) + ENDDO + ENDIF + Write(iulog,'(/, a)') '+ List of short-lived species: ' + DO N = 1, nSls + Write(iulog,130) N, TRIM(slsNames(N)) + ENDDO + ENDIF + +100 FORMAT( 1x, A3, 3x, A10, 1x, A25 ) +110 FORMAT( 1x, A3, 3x, A15 ) +!120 FORMAT( 1x, I3, 3x, A10, 1x, L15 ) +120 FORMAT( 1x, I3, 3x, A10 ) +130 FORMAT( 1x, I3, 3x, A10 ) + + ! Clean up + Call Cleanup_State_Chm ( SC, RC ) + Call Cleanup_State_Grid( SG, RC ) + Call Cleanup_Input_Opt ( IO, RC ) + + end subroutine chem_register + +!=============================================================================== + + subroutine chem_readnl(nlfile) + + use cam_abortutils, only : endrun + use units, only : getunit, freeunit + use namelist_utils, only : find_group_name +#if defined( MODAL_AERO_4MODE ) + use aero_model, only : aero_model_readnl + use dust_model, only : dust_readnl +#endif + use gas_wetdep_opts, only : gas_wetdep_readnl +#ifdef SPMD + use mpishorthand +#endif + use gckpp_Model, only : nSpec, Spc_Names + use chem_mods, only : drySpc_ndx + + ! args + CHARACTER(LEN=*), INTENT(IN) :: nlfile ! filepath for file containing namelist input + + ! Local variables + INTEGER :: I, N + INTEGER :: UNITN, IERR + CHARACTER(LEN=500) :: line + LOGICAL :: menuFound + LOGICAL :: validSLS + + ! The following files are required to compute land maps, required to perform + ! aerosol dry deposition + namelist /chem_inparm/ clim_soilw_file, & + depvel_file, & + lght_no_prd_factor, & + depvel_lnd_file, & + ext_frc_specifier, & + ext_frc_type, & + ext_frc_cycle_yr, & + ext_frc_fixed_ymd, & + ext_frc_fixed_tod, & + season_wes_file, & + srf_emis_specifier, & + srf_emis_cycle_yr, & + srf_emis_fixed_ymd, & + srf_emis_fixed_tod, & + srf_emis_type + + nIgnored = 0 + + ALLOCATE(drySpc_ndx(nddvels), STAT=IERR) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failed to allocate drySpc_ndx') + +#if defined( MODAL_AERO_4MODE ) + !============================================================== + ! Get names and molar weights of aerosols in MAM4 + !============================================================== + + nAer = 33 + + aerNames(:nAer) = (/ 'bc_a1 ','bc_a4 ','dst_a1 ', & + 'dst_a2 ','dst_a3 ','ncl_a1 ', & + 'ncl_a2 ','ncl_a3 ','num_a1 ', & + 'num_a2 ','num_a3 ','num_a4 ', & + 'pom_a1 ','pom_a4 ','so4_a1 ', & + 'so4_a2 ','so4_a3 ','soa1_a1 ', & + 'soa1_a2 ','soa2_a1 ','soa2_a2 ', & + 'soa3_a1 ','soa3_a2 ','soa4_a1 ', & + 'soa4_a2 ','soa5_a1 ','soa5_a2 ', & + 'H2SO4 ','SOAG0 ','SOAG1 ', & + 'SOAG2 ','SOAG3 ','SOAG4 ' /) + + aerAdvMass(:nAer) = (/ 12.011000_r8, 12.011000_r8, 135.064039_r8, & + 135.064039_r8, 135.064039_r8, 58.442468_r8, & + 58.442468_r8, 58.442468_r8, 1.007400_r8, & + 1.007400_r8, 1.007400_r8, 1.007400_r8, & + 12.011000_r8, 12.011000_r8, 115.107340_r8, & + 115.107340_r8, 115.107340_r8, 250.445000_r8, & + 250.445000_r8, 250.445000_r8, 250.445000_r8, & + 250.445000_r8, 250.445000_r8, 250.445000_r8, & + 250.445000_r8, 250.445000_r8, 250.445000_r8, & + 98.078400_r8, 250.445000_r8, 250.445000_r8, & + 250.445000_r8, 250.445000_r8, 250.445000_r8 /) + + CALL aero_model_readnl(nlfile) + CALL dust_readnl(nlfile) +#endif + + DO I = (nAer+1), nAerMax + aerNames(I) = 'EMPTY_AER ' + aerAdvMass(I) = -1.00_r8 + ENDDO + + CALL gas_wetdep_readnl(nlfile) + + CALL gc_readnl(nlfile) + + IF ( MasterProc ) THEN + + Write(iulog,'(/,a)') REPEAT( '=', 50 ) + Write(iulog,'(a)') REPEAT( '=', 50 ) + Write(iulog,'(a)') 'This is the GEOS-CHEM / CESM interface' + Write(iulog,'(a)') REPEAT( '=', 50 ) + Write(iulog,'(a)') ' + Routines written by Thibaud M. Fritz' + Write(iulog,'(a)') ' + Laboratory for Aviation and the Environment,' + Write(iulog,'(a)') ' + Department of Aeronautics and Astronautics,' + Write(iulog,'(a)') ' + Massachusetts Institute of Technology' + Write(iulog,'(a)') REPEAT( '=', 50 ) + + Write(iulog,'(/,a,/)') 'Now defining GEOS-Chem tracers and dry deposition mapping...' + + unitn = getunit() + + !============================================================== + ! Opening input.geos and go to ADVECTED SPECIES MENU + !============================================================== + + OPEN( unitn, FILE=TRIM(inputGeos), STATUS='OLD', IOSTAT=IERR ) + IF (IERR .NE. 0) THEN + CALL ENDRUN('chem_readnl: ERROR opening input.geos') + ENDIF + + ! Go to ADVECTED SPECIES MENU + menuFound = .False. + DO WHILE ( .NOT. menuFound ) + READ( unitn, '(a)', IOSTAT=IERR ) line + IF ( IERR .NE. 0 ) THEN + CALL ENDRUN('chem_readnl: ERROR finding advected species menu') + ELSEIF ( INDEX(line, 'ADVECTED SPECIES MENU') > 0 ) THEN + menuFound = .True. + ENDIF + ENDDO + + !============================================================== + ! Read list of GEOS-Chem tracers + !============================================================== + + ! Mimic GEOS-Chem's READ_ADVECTED_SPECIES_MENU + DO + ! Read line + READ(unitn,'(26x,a)', IOSTAT=IERR) line + + IF ( INDEX( TRIM(line), '---' ) > 0 ) EXIT + + nTracers = nTracers + 1 + tracerNames(nTracers) = TRIM(line) + ENDDO + + CLOSE(unitn) + CALL freeunit(unitn) + + ! Assign remaining tracers dummy names + DO I = (nTracers+1), nTracersMax + WRITE(tracerNames(I),'(a,I0.4)') 'GCTRC_', I + ENDDO + + !============================================================== + ! Now go through the KPP mechanism and add any species not + ! implemented by the tracer list in input.geos + !============================================================== + + IF ( nSpec > nSlsMax ) THEN + CALL ENDRUN('chem_readnl: too many species - increase nSlsmax') + ENDIF + + nSls = 0 + DO I = 1, nSpec + ! Get the name of the species from KPP + line = ADJUSTL(TRIM(Spc_Names(I))) + ! Only add short-lived KPP species, except from CO2 + validSLS = (( .NOT. ANY(TRIM(line) .EQ. tracerNames) ) & + .AND. TRIM(line) /= 'CO2' ) + IF ( validSLS ) THEN + ! Genuine new short-lived species + nSls = nSls + 1 + slsNames(nSls) = TRIM(line) + ENDIF + ENDDO + + !============================================================== + + unitn = getunit() + OPEN( unitn, FILE=TRIM(nlfile), STATUS='old' ) + CALL find_group_name(unitn, 'chem_inparm', STATUS=IERR) + IF (IERR == 0) THEN + READ(unitn, chem_inparm, IOSTAT=IERR) + IF (IERR /= 0) THEN + CALL endrun('chem_readnl: ERROR reading namelist') + ENDIF + ENDIF + CLOSE(unitn) + CALL freeunit(unitn) + + ENDIF + + !================================================================== + ! Broadcast to all processors + !================================================================== + +#if defined( SPMD ) + CALL MPIBCAST ( nTracers, 1, MPIINT, 0, MPICOM ) + CALL MPIBCAST ( tracerNames, LEN(tracerNames(1))*nTracersMax, MPICHAR, 0, MPICOM ) + CALL MPIBCAST ( nSls, 1, MPIINT, 0, MPICOM ) + CALL MPIBCAST ( slsNames, LEN(slsNames(1))*nSlsMax, MPICHAR, 0, MPICOM ) + + ! Broadcast namelist variables + + ! The following files are required to compute land maps, required to perform + ! aerosol dry deposition + CALL MPIBCAST (depvel_lnd_file, LEN(depvel_lnd_file), MPICHAR, 0, MPICOM) + CALL MPIBCAST (clim_soilw_file, LEN(clim_soilw_file), MPICHAR, 0, MPICOM) + CALL MPIBCAST (season_wes_file, LEN(season_wes_file), MPICHAR, 0, MPICOM) + + CALL MPIBCAST (lght_no_prd_factor, 1, MPIR8, 0, MPICOM) + CALL MPIBCAST (depvel_file, LEN(depvel_file), MPICHAR, 0, MPICOM) + CALL MPIBCAST (srf_emis_specifier, LEN(srf_emis_specifier(1))*pcnst, MPICHAR, 0, MPICOM) + CALL MPIBCAST (srf_emis_type, LEN(srf_emis_type), MPICHAR, 0, MPICOM) + CALL MPIBCAST (srf_emis_cycle_yr, 1, MPIINT, 0, MPICOM) + CALL MPIBCAST (srf_emis_fixed_ymd, 1, MPIINT, 0, MPICOM) + CALL MPIBCAST (srf_emis_fixed_tod, 1, MPIINT, 0, MPICOM) + CALL MPIBCAST (ext_frc_specifier, LEN(ext_frc_specifier(1))*pcnst, MPICHAR, 0, MPICOM) + CALL MPIBCAST (ext_frc_type, LEN(ext_frc_type), MPICHAR, 0, MPICOM) + CALL MPIBCAST (ext_frc_cycle_yr, 1, MPIINT, 0, MPICOM) + CALL MPIBCAST (ext_frc_fixed_ymd, 1, MPIINT, 0, MPICOM) + CALL MPIBCAST (ext_frc_fixed_tod, 1, MPIINT, 0, MPICOM) + + CALL MPIBCAST (ghg_chem, 1, MPILOG, 0, MPICOM) + CALL MPIBCAST (bndtvg, LEN(bndtvg), MPICHAR, 0, MPICOM) + CALL MPIBCAST (h2orates, LEN(h2orates), MPICHAR, 0, MPICOM) +#endif + + ! Update "short_lived_species" arrays + nSlvd = nSls + ALLOCATE(slvd_Lst(nSlvd), STAT=IERR) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating slvd_Lst') + ALLOCATE(slvd_ref_MMR(nSlvd), STAT=IERR) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating slvd_ref_MMR') + DO I = 1, nSls + slvd_Lst(I) = TRIM(slsNames(I)) + ENDDO + + end subroutine chem_readnl + +!================================================================================================ + + function chem_is_active() + !----------------------------------------------------------------------- + logical :: chem_is_active + !----------------------------------------------------------------------- + chem_is_active = .true. + + end function chem_is_active + +!================================================================================================ + + function chem_implements_cnst(name) + !----------------------------------------------------------------------- + ! + ! Purpose: return true if specified constituent is implemented by this package + ! + ! Author: B. Eaton + ! + !----------------------------------------------------------------------- + IMPLICIT NONE + !-----------------------------Arguments--------------------------------- + + CHARACTER(LEN=*), INTENT(IN) :: name ! constituent name + LOGICAL :: chem_implements_cnst ! return value + + INTEGER :: M + + chem_implements_cnst = .false. + + DO M = 1, gas_pcnst + IF (TRIM(solsym(M)) .eq. TRIM(name)) THEN + chem_implements_cnst = .true. + EXIT + ENDIF + ENDDO + + end function chem_implements_cnst + +!=============================================================================== + + subroutine chem_init(phys_state, pbuf2d) + !----------------------------------------------------------------------- + ! + ! Purpose: initialize GEOS-Chem parts (state objects, mainly) + ! (and declare history variables) + ! + !----------------------------------------------------------------------- + use physics_buffer, only : physics_buffer_desc, pbuf_get_index + use chem_mods, only : map2GC_dryDep, drySpc_ndx + +#ifdef SPMD + use mpishorthand +#endif + use cam_abortutils, only : endrun + use mo_chem_utls, only : get_spc_ndx + + use Phys_Grid, only : get_Area_All_p + use hycoef, only : ps0, hyai, hybi, hyam + + use seq_drydep_mod, only : drydep_method, DD_XLND + use gas_wetdep_opts, only : gas_wetdep_method + use mo_neu_wetdep, only : neu_wetdep_init + +#if defined( MODAL_AERO_4MODE ) + use aero_model, only : aero_model_init + use mo_setsox, only : sox_inti + use mo_drydep, only : drydep_inti_landuse + use modal_aero_data, only : ntot_amode, nspec_amode + use modal_aero_data, only : xname_massptr +#endif + + use Input_Opt_Mod + use State_Chm_Mod + use State_Grid_Mod + use State_Met_Mod + use DiagList_Mod, only : Init_DiagList, Print_DiagList + use TaggedDiagList_Mod, only : Init_TaggedDiagList, Print_TaggedDiagList + use GC_Grid_Mod, only : SetGridFromCtrEdges + + ! Use GEOS-Chem versions of physical constants + use PhysConstants, only : PI, PI_180, Re + + use Time_Mod, only : Accept_External_Date_Time + use Linoz_Mod, only : Linoz_Read + + use CMN_Size_Mod + + use Drydep_Mod, only : depName, Ndvzind + use Pressure_Mod, only : Accept_External_ApBp + use Chemistry_Mod, only : Init_Chemistry + use Ucx_Mod, only : Init_Ucx + use Strat_chem_Mod, only : Init_Strat_Chem + use isorropiaII_Mod, only : Init_IsorropiaII + use Input_Mod, only : Read_Input_File + use Input_Mod, only : Validate_Directories + use Olson_Landmap_Mod + use Vdiff_Mod + + use mo_setinv, only : setinv_inti + use mo_mean_mass, only : init_mean_mass + use mo_ghg_chem, only : ghg_chem_init + use tracer_cnst, only : tracer_cnst_init + use tracer_srcs, only : tracer_srcs_init + + use CESMGC_Emissions_Mod, only : CESMGC_Emissions_Init + use CESMGC_Diag_Mod, only : CESMGC_Diag_Init + + TYPE(physics_state), INTENT(IN ) :: phys_state(BEGCHUNK:ENDCHUNK) + TYPE(physics_buffer_desc), POINTER, INTENT(INOUT) :: pbuf2d(:,:) + + ! Local variables + + !---------------------------- + ! Scalars + !---------------------------- + + ! Integers + INTEGER :: LCHNK(BEGCHUNK:ENDCHUNK), NCOL(BEGCHUNK:ENDCHUNK) + INTEGER :: IWAIT, IERR + INTEGER :: nX, nY, nZ + INTEGER :: nStrat, nTrop + INTEGER :: I, J, L, N, M + INTEGER :: RC + INTEGER :: nLinoz + + ! Logicals + LOGICAL :: prtDebug + LOGICAL :: Found + + ! Strings + CHARACTER(LEN=255) :: historyConfigFile + CHARACTER(LEN=255) :: SpcName + + ! Objects + TYPE(Species), POINTER :: SpcInfo + + ! Grid setup + REAL(fp) :: lonVal, latVal + REAL(fp) :: dLonFix, dLatFix + REAL(f4), ALLOCATABLE :: lonMidArr(:,:), latMidArr(:,:) + REAL(f4), ALLOCATABLE :: lonEdgeArr(:,:), latEdgeArr(:,:) + REAL(r8), ALLOCATABLE :: linozData(:,:,:,:) + + ! Grid with largest number of columns + TYPE(GrdState) :: maxGrid ! Grid State object + + REAL(r8), ALLOCATABLE :: Col_Area(:) + REAL(fp), ALLOCATABLE :: Ap_CAM_Flip(:), Bp_CAM_Flip(:) + + !REAL(r8), POINTER :: SlsPtr(:,:,:) + + ! Assume a successful return until otherwise + RC = GC_SUCCESS + + ! For error trapping + ErrMsg = '' + ThisLoc = ' -> at GEOS-Chem (in chemistry/geoschem/chemistry.F90)' + + ! Initialize pointers + SpcInfo => NULL() + + ! LCHNK: which chunks we have on this process + LCHNK = phys_state%LCHNK + ! NCOL: number of atmospheric columns for each chunk + NCOL = phys_state%NCOL + + ! The GEOS-Chem grids on every "chunk" will all be the same size, to avoid + ! the possibility of having differently-sized chunks + nX = 1 + !nY = MAXVAL(NCOL) + nY = PCOLS + nZ = PVER + + !! Add short lived speies to buffers + !CALL Pbuf_add_field(Trim(SLSBuffer),'global',dtype_r8,(/PCOLS,PVER,nSls/),Sls_Pbf_Idx) + !! Initialize + !ALLOCATE(SlsPtr(PCOLS,PVER,BEGCHUNK:ENDCHUNK), STAT=IERR) + !IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating SlsPtr') + !SlsPtr(:,:,:) = 0.0e+0_r8 + !DO I=1,nSls + ! SlsPtr(:,:,:) = sls_ref_MMR(I) + ! CALL pbuf_set_field(pbuf2d,Sls_Pbf_Idx,SlsPtr,start=(/1,1,i/),kount=(/PCOLS,PVER,1/)) + !ENDDO + !DEALLOCATE(SlsPtr) + + ! This ensures that each process allocates everything needed for its chunks + ALLOCATE(State_Chm(BEGCHUNK:ENDCHUNK) , STAT=IERR) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating State_Chm') + ALLOCATE(State_Diag(BEGCHUNK:ENDCHUNK) , STAT=IERR) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating State_Diag') + ALLOCATE(State_Grid(BEGCHUNK:ENDCHUNK), STAT=IERR) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating State_Grid') + ALLOCATE(State_Met(BEGCHUNK:ENDCHUNK) , STAT=IERR) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating State_Met') + + ! Initialize fields of the Input Options object + CALL Set_Input_Opt( am_I_Root = MasterProc, & + Input_Opt = Input_Opt, & + RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered within call to "Set_Input_Opt"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + ! Find maximum tropopause level, set at 40 hPa (based on GEOS-Chem 72 and 47 + ! layer grids) + nTrop = nZ + DO WHILE ( hyam(nZ+1-nTrop) * ps0 < 4000.0 ) + nTrop = nTrop-1 + ENDDO + ! Find stratopause level, defined at 1 hPa + nStrat = nZ + DO WHILE ( hyam(nZ+1-nStrat) * ps0 < 100.0 ) + nStrat = nStrat-1 + ENDDO + + ! Initialize grid with largest number of columns + ! This is required as State_Grid(LCHNK) can have different + ! number of columns, but GEOS-Chem arrays are defined based + ! on State_Grid(BEGCHUNK). + ! To go around this, we define all of GEOS-Chem arrays with + ! size PCOLS x PVER, which is the largest possible number of + ! grid cells. + CALL Init_State_Grid( Input_Opt = Input_Opt, & + State_Grid = maxGrid, & + RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered within call to "Init_State_Grid"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + maxGrid%NX = nX + maxGrid%NY = nY + maxGrid%NZ = nZ + + Input_Opt%thisCPU = myCPU + Input_Opt%amIRoot = MasterProc + + !IF ( MasterProc ) THEN + IF ( .True. ) THEN + CALL Read_Input_File( Input_Opt = Input_Opt, & + State_Grid = maxGrid, & + RC = RC ) + + ! First setup directories + Input_Opt%Chem_Inputs_Dir = TRIM(gc_cheminputs) + Input_Opt%SpcDatabaseFile = TRIM(speciesDB) + Input_Opt%FAST_JX_DIR = TRIM(gc_cheminputs)//'FAST_JX/v2020-02/' + + !================================================================== + ! CESM-specific input flags + !================================================================== + + ! onlineAlbedo -> True (use CLM albedo) + ! -> False (read monthly-mean albedo from HEMCO) + Input_Opt%onlineAlbedo = .True. + + ! onlineLandTypes -> True (use CLM landtypes) + ! -> False (read landtypes from HEMCO) + Input_Opt%onlineLandTypes = .True. + + ! ddVel_CLM -> True (use CLM dry deposition velocities) + ! -> False (let GEOS-Chem compute dry deposition velocities) + Input_Opt%ddVel_CLM = .False. + + ! applyQtend: apply tendencies of water vapor to specific humidity + Input_Opt%applyQtend = .False. + ENDIF + + CALL Validate_Directories( Input_Opt, RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Validation_Directories"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + ! Initialize GEOS-Chem horizontal grid structure + CALL GC_Init_Grid( Input_Opt = Input_Opt, & + State_Grid = maxGrid, & + RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered within call to "GC_Init_Grid"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + ! Define more variables for maxGrid + maxGrid%MaxTropLev = nTrop + maxGrid%MaxStratLev = nStrat + IF ( Input_Opt%LUCX ) THEN + maxGrid%MaxChemLev = maxGrid%MaxStratLev + ELSE + maxGrid%MaxChemLev = maxGrid%MaxTropLev + ENDIF + + DO I = BEGCHUNK, ENDCHUNK + + ! Initialize fields of the Grid State object + CALL Init_State_Grid( Input_Opt = Input_Opt, & + State_Grid = State_Grid(I), & + RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered within call to "Init_State_Grid"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + State_Grid(I)%NX = nX + State_Grid(I)%NY = NCOL(I) + State_Grid(I)%NZ = nZ + + ! Initialize GEOS-Chem horizontal grid structure + CALL GC_Init_Grid( am_I_Root = am_I_Root, & + Input_Opt = Input_Opt, & + State_Grid = State_Grid(I), & + RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered within call to "GC_Init_Grid"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + ! Define more variables for State_Grid + State_Grid(I)%MaxTropLev = nTrop + State_Grid(I)%MaxStratLev = nStrat + + ! Set maximum number of levels in the chemistry grid + IF ( Input_Opt%LUCX ) THEN + State_Grid(I)%MaxChemLev = State_Grid(I)%MaxStratLev + ELSE + State_Grid(I)%MaxChemLev = State_Grid(I)%MaxTropLev + ENDIF + + ENDDO + + ! Note - this is called AFTER chem_readnl, after X, and after + ! every constituent has had its initial conditions read. Any + ! constituent which is not found in the CAM restart file will + ! then have already had a call to chem_implements_cnst, and will + ! have then had a call to chem_init_cnst to set a default VMR + ! Call the routine GC_Allocate_All (located in module file + ! GeosCore/gc_environment_mod.F90) to allocate all lat/lon + ! allocatable arrays used by GEOS-Chem. + CALL GC_Allocate_All ( Input_Opt = Input_Opt, & + State_Grid = maxGrid, & + RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "GC_Allocate_All"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + ! Read in data for Linoz. All CPUs allocate one array to hold the data. Only + ! the root CPU reads in the data; then we copy it out to a temporary array, + ! broadcast to all other CPUs, and finally duplicate the data into every + ! copy of Input_Opt + IF ( Input_Opt%LLinoz ) THEN + ! Allocate array for broadcast + nLinoz = Input_Opt%Linoz_NLevels * & + Input_Opt%Linoz_NLat * & + Input_Opt%Linoz_NMonths * & + Input_Opt%Linoz_NFields + ALLOCATE( linozData( Input_Opt%Linoz_NLevels, & + Input_Opt%Linoz_NLat, & + Input_Opt%Linoz_NMonths, & + Input_Opt%Linoz_NFields ), STAT=IERR) + IF (IERR .NE. 0) CALL ENDRUN('Failure while allocating linozData') + linozData = 0.0e+0_r8 + + IF ( MasterProc ) THEN + ! Read data in to Input_Opt%Linoz_TParm + CALL Linoz_Read( MasterProc, Input_Opt, RC ) + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Linoz_Read"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + ! Copy the data to a temporary array + linozData = REAL(Input_Opt%LINOZ_TPARM, r8) + ENDIF +#if defined( SPMD ) + CALL MPIBCAST( linozData, nLinoz, MPIR8, 0, MPICOM ) +#endif + IF ( .NOT. MasterProc ) THEN + Input_Opt%LINOZ_TPARM = REAL(linozData,fp) + ENDIF + IF ( ALLOCATED( linozData ) ) DEALLOCATE(linozData) + ENDIF + + + ! Note: The following calculations do not setup the gridcell areas. + ! In any case, we will need to be constantly updating this grid + ! to compensate for the "multiple chunks per processor" element + ALLOCATE(lonMidArr(maxGrid%nX,maxGrid%nY), STAT=IERR) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating lonMidArr') + ALLOCATE(lonEdgeArr(maxGrid%nX+1,maxGrid%nY+1), STAT=IERR) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating lonEdgeArr') + ALLOCATE(latMidArr(maxGrid%nX,maxGrid%nY), STAT=IERR) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating latMidArr') + ALLOCATE(latEdgeArr(maxGrid%nX+1,maxGrid%nY+1), STAT=IERR) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating latEdgeArr') + + ! We could try and get the data from CAM.. but the goal is to make this GC + ! component completely grid independent. So for now, we set to arbitrary + ! values + ! TODO: This needs more refinement. For now, this generates identical + ! State_Grid for all chunks + DO L = BEGCHUNK, ENDCHUNK + lonMidArr = 0.0e+0_f4 + latMidArr = 0.0e+0_f4 + dLonFix = 360.0e+0_fp / REAL(nX,fp) + dLatFix = 180.0e+0_fp / REAL(NCOL(L),fp) + DO I = 1, nX + ! Center of box, assuming dateline edge + lonVal = -180.0e+0_fp + (REAL(I-1,fp)*dLonFix) + DO J = 1, NCOL(L) + ! Center of box, assuming regular cells + latVal = -90.0e+0_fp + (REAL(J-1,fp)*dLatFix) + lonMidArr(I,J) = REAL((lonVal + (0.5e+0_fp * dLonFix)) * PI_180, f4) + latMidArr(I,J) = REAL((latVal + (0.5e+0_fp * dLatFix)) * PI_180, f4) + + ! Edges of box, assuming regular cells + lonEdgeArr(I,J) = REAL(lonVal * PI_180, f4) + latEdgeArr(I,J) = REAL(latVal * PI_180, f4) + ENDDO + ! Edges of box, assuming regular cells + lonEdgeArr(I,NCOL(L)+1) = REAL((lonVal + dLonFix) * PI_180, f4) + latEdgeArr(I,NCOL(L)+1) = REAL((latVal + dLatFix) * PI_180, f4) + ENDDO + DO J = 1, NCOL(L)+1 + ! Edges of box, assuming regular cells + latVal = -90.0e+0_fp + (REAL(J-1,fp)*dLatFix) + lonEdgeArr(nX+1,J) = REAL((lonVal + dLonFix) * PI_180, f4) + latEdgeArr(nX+1,J) = REAL((latVal) * PI_180, f4) + ENDDO + + CALL SetGridFromCtrEdges( am_I_Root = MasterProc, & + State_Grid = State_Grid(L), & + lonCtr = lonMidArr, & + latCtr = latMidArr, & + lonEdge = lonEdgeArr, & + latEdge = latEdgeArr, & + RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "SetGridFromCtrEdges"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + ENDDO + IF ( ALLOCATED( lonMidArr ) ) DEALLOCATE( lonMidArr ) + IF ( ALLOCATED( latMidArr ) ) DEALLOCATE( latMidArr ) + IF ( ALLOCATED( lonEdgeArr ) ) DEALLOCATE( lonEdgeArr ) + IF ( ALLOCATED( latEdgeArr ) ) DEALLOCATE( latEdgeArr ) + + + ! Set the times held by "time_mod" + CALL Accept_External_Date_Time( value_NYMDb = Input_Opt%NYMDb, & + value_NHMSb = Input_Opt%NHMSb, & + value_NYMDe = Input_Opt%NYMDe, & + value_NHMSe = Input_Opt%NHMSe, & + value_NYMD = Input_Opt%NYMDb, & + value_NHMS = Input_Opt%NHMSb, & + RC = RC ) + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Accept_External_Date_Time"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + ! Start by setting some dummy timesteps + CALL GC_Update_Timesteps(300.0E+0_r8) + + ! Initialize error module + CALL Init_Error( Input_Opt, RC ) + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Init_Error"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + ! Set a flag to denote if we should print ND70 debug output + prtDebug = ( Input_Opt%LPRT .and. MasterProc ) + + historyConfigFile = 'HISTORY.rc' + ! This requires input.geos and HISTORY.rc to be in the run directory + ! This is the current way chosen to diagnose photolysis rates! + CALL Init_DiagList( MasterProc, historyConfigFile, Diag_List, RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Init_DiagList"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + ! Initialize the TaggedDiag_List (list of wildcards/tags per diagnostic) + CALL Init_TaggedDiagList( Input_Opt%amIroot, Diag_List, & + TaggedDiag_List, RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Init_TaggedDiagList"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + IF ( prtDebug ) THEN + CALL Print_DiagList( Input_Opt%amIRoot, Diag_List, RC ) + CALL Print_TaggedDiagList( Input_Opt%amIRoot, TaggedDiag_List, RC ) + ENDIF + + DO I = BEGCHUNK, ENDCHUNK + am_I_Root = (MasterProc .AND. (I == BEGCHUNK)) + + CALL GC_Init_StateObj( Diag_List = Diag_List, & ! Diagnostic list obj + TaggedDiag_List = TaggedDiag_List, & ! TaggedDiag list obj + Input_Opt = Input_Opt, & ! Input Options + State_Chm = State_Chm(I), & ! Chemistry State + State_Diag = State_Diag(I), & ! Diagnostics State + State_Grid = maxGrid, & ! Grid State + State_Met = State_Met(I), & ! Meteorology State + RC = RC ) ! Success or failure + + ! Trap potential errors + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "GC_Init_StateObj"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + ! Start with v/v dry (CAM standard) + State_Chm(I)%Spc_Units = 'v/v dry' + + ENDDO + Input_Opt%amIRoot = MasterProc + + CALL GC_Init_Extra( Diag_List = Diag_List, & ! Diagnostic list obj + & Input_Opt = Input_Opt, & ! Input Options + & State_Chm = State_Chm(BEGCHUNK), & ! Chemistry State + & State_Diag = State_Diag(BEGCHUNK), & ! Diagnostics State + & State_Grid = maxGrid, & ! Grid State + & RC = RC ) ! Success or failure + + ! Trap potential errors + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "GC_Init_Extra"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + IF ( Input_Opt%LDryD ) THEN + !============================================================== + ! Get mapping between CESM dry deposited species and the + ! indices of State_Chm%DryDepVel. This needs to be done after + ! Init_Drydep + ! Thibaud M. Fritz - 04 Mar 2020 + !============================================================== + + ALLOCATE(map2GC_dryDep(nddvels), STAT=IERR) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failed to allocate map2GC_dryDep') + + DO N = 1, nddvels + ! Initialize index to -1 + map2GC_dryDep(N) = -1 + + IF ( drySpc_ndx(N) > 0 ) THEN + + ! Convert to upper case + SpcName = to_upper(drydep_list(N)) + + DO I = 1, State_Chm(BEGCHUNK)%nDryDep + IF ( TRIM( SpcName ) == TRIM( to_upper(depName(I)) ) ) THEN + map2GC_dryDep(N) = nDVZind(I) + EXIT + ENDIF + ENDDO + + ! Print out debug information + IF ( masterProc ) THEN + IF ( N == 1 ) Write(iulog,*) " ++ GEOS-Chem Dry deposition ++ " + IF ( map2GC_dryDep(N) > 0 ) THEN + Write(iulog,*) " CESM species: ", TRIM(drydep_list(N)), & + ' is matched with ', depName(map2GC_dryDep(N)) + ELSE + Write(iulog,*) " CESM species: ", TRIM(drydep_list(N)), & + ' has no match' + ENDIF + ENDIF + + ENDIF + ENDDO + ENDIF + +#if defined( MODAL_AERO_4MODE ) + ! Initialize aqueous chem + CALL SOx_inti() + + ! Initialize aerosols + CALL aero_model_init( pbuf2d ) + + ! Initialize land maps for aerosol dry deposition + IF ( drydep_method == DD_XLND ) THEN + CALL drydep_inti_landuse( depvel_lnd_file, & + clim_soilw_file ) + ELSE + Write(iulog,'(a,a)') ' drydep_method is set to: ', TRIM(drydep_method) + CALL ENDRUN('drydep_method must be DD_XLND to compute land maps for aerosol' // & + ' dry deposition!') + ENDIF +#endif + + IF ( gas_wetdep_method == 'NEU' ) THEN + ! Initialize MOZART's wet deposition + CALL Neu_wetdep_init() + ENDIF + + ! Set grid-cell area + DO N = BEGCHUNK, ENDCHUNK + ALLOCATE(Col_Area(State_Grid(N)%nY), STAT=IERR) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating Col_Area') + + CALL Get_Area_All_p(N, State_Grid(N)%nY, Col_Area) + + ! Set default value (in case of chunks with fewer columns) + State_Grid(N)%Area_M2 = 1.0e+10_fp + DO I = 1, State_Grid(N)%nX + DO J = 1, State_Grid(N)%nY + State_Grid(N)%Area_M2(I,J) = REAL(Col_Area(J) * Re**2,fp) + State_Met(N)%Area_M2(I,J) = State_Grid(N)%Area_M2(I,J) + ENDDO + ENDDO + + IF ( ALLOCATED( Col_Area ) ) DEALLOCATE(Col_Area) + ENDDO + + ! Initialize (mostly unused) diagnostic arrays + ! WARNING: This routine likely calls on modules which are currently + ! excluded from the GC-CESM build (eg diag03) + ! CALL Initialize( MasterProc, Input_Opt, 2, RC ) + ! CALL Initialize( Masterproc, Input_Opt, 3, RC ) + + ! Get Ap and Bp from CAM at pressure edges + ALLOCATE(Ap_CAM_Flip(nZ+1), STAT=IERR) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating Ap_CAM_Flip') + ALLOCATE(Bp_CAM_Flip(nZ+1), STAT=IERR) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating Bp_CAM_Flip') + + Ap_CAM_Flip = 0.0e+0_fp + Bp_CAM_Flip = 0.0e+0_fp + DO I = 1, nZ+1 + Ap_CAM_Flip(I) = hyai(nZ+2-I) * ps0 * 0.01e+0_r8 + Bp_CAM_Flip(I) = hybi(nZ+2-I) + ENDDO + + !----------------------------------------------------------------- + ! Pass external Ap and Bp to GEOS-Chem's Pressure_Mod + !----------------------------------------------------------------- + CALL Accept_External_ApBp( State_Grid = maxGrid, & ! Grid State + ApIn = Ap_CAM_Flip, & ! "A" term for hybrid grid + BpIn = Bp_CAM_Flip, & ! "B" term for hybrid grid + RC = RC ) ! Success or failure + + ! Print vertical coordinates + IF ( MasterProc ) THEN + WRITE( 6, '(a)' ) REPEAT( '=', 79 ) + WRITE( 6, '(a,/)' ) 'V E R T I C A L G R I D S E T U P' + WRITE( 6, '( ''Ap '', /, 6(f11.6,1x) )' ) Ap_CAM_Flip(1:maxGrid%nZ+1) + WRITE( 6, '(a)' ) + WRITE( 6, '( ''Bp '', /, 6(f11.6,1x) )' ) Bp_CAM_Flip(1:maxGrid%nZ+1) + WRITE( 6, '(a)' ) REPEAT( '=', 79 ) + ENDIF + + ! Trapping errors + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Accept_External_ApBp"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + IF ( ALLOCATED( Ap_CAM_Flip ) ) DEALLOCATE( Ap_CAM_Flip ) + IF ( ALLOCATED( Bp_CAM_Flip ) ) DEALLOCATE( Bp_CAM_Flip ) + + !! Initialize HEMCO? + !CALL Emissions_Init ( am_I_Root = MasterProc, & + ! Input_Opt = Input_Opt, & + ! State_Met = State_Met, & + ! State_Chm = State_Chm, & + ! State_Grid = State_Grid, & + ! State_Met = State_Met, & + ! RC = RC, & + ! HcoConfig = HcoConfig ) + ! + !IF ( RC /= GC_SUCCESS ) THEN + ! ErrMsg = 'Error encountered in "Emissions_Init"!' + ! CALL Error_Stop( ErrMsg, ThisLoc ) + !ENDIF + ! + +!#if ( ALLDDVEL_GEOSCHEM && LANDTYPE_HEMCO ) +! ! Populate the State_Met%LandTypeFrac field with data from HEMCO +! CALL Init_LandTypeFrac( am_I_Root = MasterProc, & +! Input_Opt = Input_Opt, & +! State_Met = State_Met(BEGCHUNK), & +! RC = RC ) +! +! IF ( RC /= GC_SUCCESS ) THEN +! ErrMsg = 'Error encountered in "Init_LandTypeFrac"!' +! CALL Error_Stop( ErrMsg, ThisLoc ) +! ENDIF +! +! ! Compute the Olson landmap fields of State_Met +! ! (e.g. State_Met%IREG, State_Met%ILAND, etc.) +! CALL Compute_Olson_Landmap( am_I_Root = MasterProc, & +! Input_Opt = Input_Opt, & +! State_Grid = State_Grid(BEGCHUNK), & +! State_Met = State_Met(BEGCHUNK), & +! RC = RC ) +! +! IF ( RC /= GC_SUCCESS ) THEN +! ErrMsg = 'Error encountered in "Compute_Olson_Landmap"!' +! CALL Error_Stop( ErrMsg, ThisLoc ) +! ENDIF +!#endif + + IF ( Input_Opt%Its_A_FullChem_Sim .OR. & + Input_Opt%Its_An_Aerosol_Sim ) THEN + ! This also initializes Fast-JX + CALL Init_Chemistry( Input_Opt = Input_Opt, & + & State_Chm = State_Chm(BEGCHUNK), & + & State_Diag = State_Diag(BEGCHUNK), & + & State_Grid = State_Grid(BEGCHUNK), & + & RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Init_Chemistry"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + ENDIF + + IF ( Input_Opt%LChem .AND. & + Input_Opt%LUCX ) THEN + CALL Init_UCX( Input_Opt = Input_Opt, & + State_Chm = State_Chm(BEGCHUNK), & + State_Diag = State_Diag(BEGCHUNK), & + State_Grid = maxGrid ) + ENDIF + + IF ( Input_Opt%LSCHEM ) THEN + CALL Init_Strat_Chem( Input_Opt = Input_Opt, & + State_Chm = State_Chm(BEGCHUNK), & + State_Met = State_Met(BEGCHUNK), & + State_Grid = maxGrid, & + RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Init_Strat_Chem"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + ENDIF + + IF ( Input_Opt%LSSalt ) THEN + CALL INIT_ISORROPIAII( State_Grid = maxGrid ) + ENDIF + + ! Get some indices + iH2O = Ind_('H2O') + iO3 = Ind_('O3') + iCO2 = Ind_('CO2') + ! The following indices are needed to compute invariants + iO = Ind_('O') + iH = Ind_('H') + iO2 = Ind_('O2') + + ! This is used to compute gas-phase H2SO4 production + iPSO4 = Ind_('PSO4') + SpcInfo => State_Chm(BEGCHUNK)%SpcData(iPSO4)%Info + MWPSO4 = REAL(SpcInfo%MW_g,r8) + ! Free pointer + SpcInfo => NULL() + + ! This is used to compute overhead ozone column + SpcInfo => State_Chm(BEGCHUNK)%SpcData(iO3)%Info + MWO3 = REAL(SpcInfo%MW_g,r8) + ! Free pointer + SpcInfo => NULL() + + ! Get indices for physical fields in physics buffer + NDX_PBLH = pbuf_get_index('pblh' ) + NDX_FSDS = pbuf_get_index('FSDS' ) + NDX_CLDTOP = pbuf_get_index('CLDTOP' ) + NDX_CLDFRC = pbuf_get_index('CLD' ) + NDX_PRAIN = pbuf_get_index('PRAIN' ) + NDX_NEVAPR = pbuf_get_index('NEVAPR' ) + NDX_LSFLXPRC = pbuf_get_index('LS_FLXPRC') + NDX_LSFLXSNW = pbuf_get_index('LS_FLXSNW') + NDX_CMFDQR = pbuf_get_index('RPRDTOT' ) + + ! Get cloud water indices + CALL cnst_get_ind( 'CLDLIQ', ixCldLiq) + CALL cnst_get_ind( 'CLDICE', ixCldIce) + CALL cnst_get_ind( 'NUMLIQ', ixNDrop, abort=.False. ) + + CALL init_mean_mass() + CALL setinv_inti() + + !----------------------------------------------------------------------- + ! ... initialize tracer modules + !----------------------------------------------------------------------- + CALL tracer_cnst_init() + CALL tracer_srcs_init() + + IF ( ghg_chem ) THEN + CALL ghg_chem_init(phys_state, bndtvg, h2orates) + ENDIF + + ! Initialize diagnostics interface + CALL CESMGC_Diag_Init( Input_Opt = Input_Opt, & + State_Chm = State_Chm(BEGCHUNK), & + State_Met = State_Met(BEGCHUNK) ) + + ! Initialize emissions interface + CALL CESMGC_Emissions_Init( lght_no_prd_factor = lght_no_prd_factor ) + + hco_pbuf2d => pbuf2d + + If ( MasterProc ) Write(iulog,*) "hco_pbuf2d now points to pbuf2d" + + ! Cleanup + Call Cleanup_State_Grid( maxGrid, RC ) + + end subroutine chem_init + +!=============================================================================== + + subroutine chem_timestep_init(phys_state, pbuf2d) + + use physics_buffer, only : physics_buffer_desc + use mo_flbc, only : flbc_chk + use mo_ghg_chem, only : ghg_chem_timestep_init + + TYPE(physics_state), INTENT(IN):: phys_state(begchunk:endchunk) + TYPE(physics_buffer_desc), POINTER :: pbuf2d(:,:) + + ! Not sure what we would realistically do here rather than in tend + + !----------------------------------------------------------------------- + ! Set fixed lower boundary timing factors + !----------------------------------------------------------------------- + CALL flbc_chk + + IF ( ghg_chem ) THEN + CALL ghg_chem_timestep_init(phys_state) + ENDIF + + end subroutine chem_timestep_init + +!=============================================================================== + + subroutine GC_Update_Timesteps(DT) + + use Time_Mod, only : Set_Timesteps + + REAL(r8), INTENT(IN) :: DT + INTEGER :: DT_MIN + INTEGER, SAVE :: DT_MIN_LAST = -1 + + DT_MIN = NINT(DT) + + Input_Opt%TS_CHEM = DT_MIN + Input_Opt%TS_EMIS = DT_MIN + Input_Opt%TS_CONV = DT_MIN + Input_Opt%TS_DYN = DT_MIN + Input_Opt%TS_RAD = DT_MIN + + ! Only bother updating the module information if there's been a change + IF (DT_MIN .NE. DT_MIN_LAST) THEN + CALL Set_Timesteps( Input_Opt = Input_Opt, & + CHEMISTRY = DT_MIN, & + EMISSION = DT_MIN, & + DYNAMICS = DT_MIN, & + UNIT_CONV = DT_MIN, & + CONVECTION = DT_MIN, & + DIAGNOS = DT_MIN, & + RADIATION = DT_MIN ) + DT_MIN_LAST = DT_MIN + ENDIF + + end subroutine + +!=============================================================================== + +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: gc_readnl +! +! !DESCRIPTION: Reads the namelist from cam/src/control/runtime_opts. +!\\ +!\\ +! !INTERFACE: +! + subroutine gc_readnl(nlfile) +! +! !USES: +! + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use mpishorthand +! +! !INPUT PARAMETERS: +! + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input +! +! !REVISION HISTORY: +! 21 Jan 2021 - T.M. Fritz - Initial version +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: +! + integer :: unitn, ierr + character(len=*), parameter :: subname = 'gc_readnl' + + namelist /gc_nl/ gc_cheminputs + + !----------------------------------------------------------------------------- + + ! Read namelist + IF ( MasterProc ) THEN + unitn = getunit() + OPEN( unitn, FILE=TRIM(nlfile), STATUS='old' ) + CALL find_group_name(unitn, 'gc_nl', STATUS=ierr) + IF ( ierr == 0 ) THEN + READ(unitn, gc_nl, IOSTAT=ierr) + IF ( ierr /= 0 ) THEN + CALL ENDRUN(subname // ':: ERROR reading namelist') + ENDIF + ENDIF + CLOSE(unitn) + CALL freeunit(unitn) + ENDIF + +#ifdef SPMD + ! Broadcast namelist variables + CALL MPIBCAST(gc_cheminputs, LEN(gc_cheminputs), MPICHAR, 0, MPICOM) +#endif + + end subroutine +!EOC + +!=============================================================================== + + subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) + + use physics_buffer, only : physics_buffer_desc, pbuf_get_field, pbuf_old_tim_idx + use physics_buffer, only : pbuf_get_chunk, pbuf_get_index + use perf_mod, only : t_startf, t_stopf + use cam_history, only : outfld, hist_fld_active + use camsrfexch, only : cam_in_t, cam_out_t + +#ifdef SPMD + use mpishorthand +#endif + + use phys_grid, only : get_ncols_p, get_rlat_all_p, get_rlon_all_p + + use chem_mods, only : drySpc_ndx, map2GC_dryDep + use chem_mods, only : nfs, indexm, gas_pcnst + use mo_mean_mass, only : set_mean_mass + use mo_setinv, only : setinv + use mo_flbc, only : flbc_set + use mo_ghg_chem, only : ghg_chem_set_flbc + use mo_neu_wetdep, only : neu_wetdep_tend + use gas_wetdep_opts, only : gas_wetdep_method +#if defined( MODAL_AERO_4MODE ) + use modal_aero_data, only : ntot_amode, nspec_amode + use modal_aero_data, only : lmassptr_amode + use modal_aero_data, only : xname_massptr +#endif + + use Olson_Landmap_Mod, only : Compute_Olson_Landmap + use Modis_LAI_Mod, only : Compute_XLAI + use CMN_Size_Mod, only : NSURFTYPE + use Drydep_Mod, only : Do_Drydep + use Drydep_Mod, only : DEPNAME, NDVZIND + use Drydep_Mod, only : Update_DryDepFreq + + use Calc_Met_Mod, only : Set_Dry_Surface_Pressure + use Calc_Met_Mod, only : AirQnt + use GC_Grid_Mod, only : SetGridFromCtr + use Pressure_Mod, only : Set_Floating_Pressures + use Pressure_Mod, only : Accept_External_Pedge + use Time_Mod, only : Accept_External_Date_Time + use Toms_Mod, only : Compute_Overhead_O3 + use Chemistry_Mod, only : Do_Chemistry + use Wetscav_Mod, only : Setup_Wetscav + use CMN_Size_Mod, only : PTop + use PBL_Mix_Mod, only : Compute_PBL_Height + use UCX_Mod, only : Set_H2O_Trac + use CMN_FJX_MOD, only : ZPJ + use State_Diag_Mod, only : get_TagInfo + use Unitconv_Mod, only : Convert_Spc_Units + + use Strat_Chem_Mod, only : Strat_TrID_GC, GC_Bry_TrID, NSCHEM + use Strat_Chem_Mod, only : BrPtrDay, BrPtrNight, PLVEC, STRAT_OH + + use CESMGC_Emissions_Mod,only : CESMGC_Emissions_Calc + use CESMGC_Diag_Mod, only : CESMGC_Diag_Calc + use CESMGC_Diag_Mod, only : wetdep_name, wtrate_name + + use Tropopause, only : Tropopause_findChemTrop, Tropopause_Find + use HCO_Utilities_GC_Mod ! Utility routines for GC-HEMCO interface + + ! For calculating SZA + use Orbit, only : zenith + use Time_Manager, only : Get_Curr_Calday, Get_Curr_Date + + ! Calculating relative humidity + use WV_Saturation, only : QSat + + ! Grid area + use Phys_Grid, only : get_area_all_p, get_lat_all_p, get_lon_all_p + + use short_lived_species, only : get_short_lived_species + use short_lived_species, only : set_short_lived_species + +#if defined( MODAL_AERO ) + ! Aqueous chemistry and aerosol growth + use aero_model, only : aero_model_gasaerexch +#endif + + use rad_constituents, only : rad_cnst_get_info + + ! GEOS-Chem version of physical constants + use PhysConstants, only : PI, PI_180, g0, AVO, Re, g0_100 + ! CAM version of physical constants + use PhysConst, only : MWDry, Gravit + + REAL(r8), INTENT(IN) :: dT ! Time step + TYPE(physics_state), INTENT(IN) :: state ! Physics State variables + TYPE(physics_ptend), INTENT(OUT) :: ptend ! indivdual parameterization tendencies + TYPE(cam_in_t), INTENT(INOUT) :: cam_in + TYPE(cam_out_t), INTENT(IN) :: cam_out + TYPE(physics_buffer_desc), POINTER :: pbuf(:) + REAL(r8), OPTIONAL, INTENT(OUT) :: fh2o(PCOLS) ! h2o flux to balance source from chemistry + + ! Initial MMR for all species + REAL(r8) :: MMR_Beg(PCOLS,PVER,MAXVAL(map2GC(:))) + REAL(r8) :: MMR_End(PCOLS,PVER,MAXVAL(map2GC(:))) + + ! Logical to apply tendencies to mixing ratios + LOGICAL :: lq(pcnst) + + ! Indexing + INTEGER :: N, M, P, SM, ND + INTEGER :: I, J, L, nX, nY, nZ + + INTEGER :: LCHNK, NCOL + + REAL(r8), DIMENSION(state%NCOL) :: & + CSZA, & ! Cosine of solar zenith angle + CSZAmid, & ! Cosine of solar zenith angle at the mid timestep + Rlats, Rlons ! Chunk latitudes and longitudes (radians) + + REAL(fp) :: O3col(state%NCOL) ! Overhead O3 column (DU) + + REAL(r8), POINTER :: PblH(:) ! PBL height on each chunk [m] + REAL(r8), POINTER :: cldTop(:) ! Cloud top height [?] + REAL(r8), POINTER :: cldFrc(:,:) ! Cloud fraction [-] + REAL(r8), POINTER :: Fsds(:) ! Downward shortwave flux at surface [W/m2] + REAL(r8), POINTER :: PRain(:,:) ! Total stratiform precip. prod. (rain + snow) [kg/kg/s] + REAL(r8), POINTER :: NEvapr(:,:) ! Evaporation of total precipitation (rain + snow) [kg/kg/s] + REAL(r8), POINTER :: LsFlxPrc(:,:) ! Large-scale downward precip. flux at interface (rain + snow) [kg/m2/s] + REAL(r8), POINTER :: LsFlxSnw(:,:) ! Large-scale downward precip. flux at interface (snow only) [kg/m2/s] + REAL(r8), POINTER :: cmfdqr(:,:) ! Total convective precip. prod. (rain + snow) [kg/kg/s] + + REAL(r8) :: tmpMass + REAL(r8) :: cldW (state%NCOL,PVER) ! Cloud water (kg/kg) + REAL(r8) :: nCldWtr(state%NCOL,PVER) ! Droplet number concentration (#/kg) + + REAL(r8) :: relHum (state%NCOL,PVER) ! Relative humidity [0-1] + REAL(r8) :: satV (state%NCOL,PVER) ! Work arrays + REAL(r8) :: satQ (state%NCOL,PVER) ! Work arrays + REAL(r8) :: qH2O (state%NCOL,PVER) ! Specific humidity [kg/kg] + REAL(r8) :: h2ovmr (state%NCOL,PVER) ! H2O volume mixing ratio + REAL(r8) :: mBar (state%NCOL,PVER) ! Mean wet atmospheric mass [amu] + REAL(r8) :: invariants(state%NCOL,PVER,nfs) + REAL(r8) :: reaction_rates(1,1,1) ! Reaction rates (unused) + + ! For aerosol formation + REAL(r8) :: del_h2so4_gasprod(state%NCOL,PVER) + REAL(r8) :: vmr0(state%NCOL,PVER,gas_pcnst) + REAL(r8) :: vmr1(state%NCOL,PVER,gas_pcnst) + REAL(r8) :: wetdepflx(pcols,pcnst) ! Wet deposition fluxes (kg/m2/s) + +#if defined( MODAL_AERO ) + REAL(r8) :: binRatio(MAXVAL(nspec_amode(:)),ntot_amode,state%NCOL,PVER) +#endif + + ! For emissions + REAL(r8) :: eflx(pcols,pver,pcnst) ! 3-D emissions in kg/m2/s + + ! For GEOS-Chem diagnostics + REAL(r8) :: mmr_tend(state%NCOL,PVER,gas_pcnst) + REAL(r8) :: wk_out(state%NCOL) + LOGICAL :: Found + CHARACTER(LEN=255) :: tagName + + REAL(r8), PARAMETER :: zlnd = 0.01_r8 ! Roughness length for soil [m] + REAL(r8), PARAMETER :: zslnd = 0.0024_r8 ! Roughness length for snow [m] + REAL(r8), PARAMETER :: zsice = 0.0400_r8 ! Roughness length for sea ice [m] + REAL(r8), PARAMETER :: zocn = 0.0001_r8 ! Roughness length for oean [m] + + REAL(f4) :: lonMidArr(1,PCOLS), latMidArr(1,PCOLS) + INTEGER :: iMaxLoc(1) + + REAL(r8) :: Col_Area(state%NCOL) + + ! Intermediate arrays + INTEGER :: Trop_Lev (PCOLS) + REAL(r8) :: Trop_P (PCOLS) + REAL(r8) :: Trop_T (PCOLS) + REAL(r8) :: Trop_Ht (PCOLS) + REAL(r8) :: SnowDepth(PCOLS) + REAL(r8) :: cld2D (PCOLS) + REAL(r8) :: Z0 (PCOLS) + REAL(r8) :: Sd_Ice, Sd_Lnd, Sd_Avg, Frc_Ice + + ! Estimating cloud optical depth + REAL(r8) :: cld(PCOLS,PVER) + REAL(r8) :: TauCli(PCOLS,PVER) + REAL(r8) :: TauClw(PCOLS,PVER) + REAL(r8), PARAMETER :: re_m = 1.0e-05_r8 ! Cloud drop radius in m + REAL(r8), PARAMETER :: cldMin = 1.0e-02_r8 ! Minimum cloud cover + REAL(r8), PARAMETER :: cnst = 1.5e+00_r8 / (re_m * 1.0e+03_r8 * g0) + + ! Calculating SZA + REAL(r8) :: Calday + + CHARACTER(LEN=255) :: SpcName + CHARACTER(LEN=255) :: Prefix, FieldName + LOGICAL :: FND + INTEGER :: SpcId + TYPE(Species), POINTER :: SpcInfo + + CHARACTER(LEN=63) :: OrigUnit + + REAL(r8) :: SlsData(PCOLS, PVER, nSls) + + INTEGER :: currYr, currMo, currDy, currTOD + INTEGER :: currYMD, currHMS, currHr, currMn, currSc + REAL(f4) :: currUTC + + TYPE(physics_buffer_desc), POINTER :: pbuf_chnk(:) ! slice of pbuf in chnk + REAL(r8), POINTER :: pbuf_ik(:,:) ! ptr to pbuf data (/pcols,pver/) + INTEGER :: tmpIdx ! pbuf field id + CHARACTER(LEN=255) :: fldname_ns ! field name + + INTEGER :: TIM_NDX + INTEGER :: IERR + + INTEGER, SAVE :: iStep = 0 + LOGICAL :: rootChunk + LOGICAL :: lastChunk + INTEGER :: RC + + + ! Initialize pointers + SpcInfo => NULL() + PblH => NULL() + cldTop => NULL() + cldFrc => NULL() + Fsds => NULL() + PRain => NULL() + NEvapr => NULL() + LsFlxPrc => NULL() + LsFlxSnw => NULL() + cmfdqr => NULL() + pbuf_chnk=> NULL() + pbuf_ik => NULL() + + ! LCHNK: which chunk we have on this process + LCHNK = state%LCHNK + ! NCOL: number of atmospheric columns on this chunk + NCOL = state%NCOL + + ! Root Chunk + rootChunk = ( MasterProc .and. (LCHNK==BEGCHUNK) ) + ! Last Chunk + lastChunk = ( MasterProc .and. (LCHNK==ENDCHUNK) ) + + ! Count the number of steps which have passed + IF ( LCHNK .EQ. BEGCHUNK ) iStep = iStep + 1 + + ! Need to update the timesteps throughout the code + CALL GC_Update_Timesteps(dT) + + ! For safety's sake + PTop = state%pint(1,1)*0.01e+0_fp + + ! Need to be super careful that the module arrays are updated and correctly + ! set. NOTE: First thing - you'll need to flip all the data vertically + + nX = 1 + nY = NCOL + nZ = PVER + + ! Update the grid lat/lons since they are module variables + ! Assume (!) that area hasn't changed for now, as GEOS-Chem will + ! retrieve this from State_Met which is chunked + !CALL get_rlat_all_p( LCHNK, NCOL, Rlats ) + !CALL get_rlon_all_p( LCHNK, NCOL, Rlons ) + Rlats(1:nY) = state%Lat(1:nY) + Rlons(1:nY) = state%Lon(1:nY) + + lonMidArr = 0.0e+0_f4 + latMidArr = 0.0e+0_f4 + DO I = 1, nX + DO J = 1, nY + lonMidArr(I,J) = REAL(Rlons(J), f4) + latMidArr(I,J) = REAL(Rlats(J), f4) + ENDDO + ENDDO + + ! Update the grid + CALL SetGridFromCtr( Input_Opt = Input_Opt, & + State_Grid = State_Grid(LCHNK), & + lonCtr = lonMidArr, & + latCtr = latMidArr, & + RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered within call to "SetGridFromCtr"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + ! Set area + CALL Get_Area_All_p( LCHNK, nY, Col_Area ) + + ! Field : AREA_M2 + ! Description: Grid box surface area + ! Unit : - + ! Dimensions : nX, nY + ! Note : Set default value (in case of chunks with fewer columns) + State_Grid(LCHNK)%Area_M2 = -1.0e+10_fp + State_Met(LCHNK)%Area_M2 = -1.0e+10_fp + State_Grid(LCHNK)%Area_M2(1,:nY) = REAL(Col_Area(:nY) * Re**2,fp) + State_Met(LCHNK)%Area_M2(1,:nY) = State_Grid(LCHNK)%Area_M2(1,:nY) + + ! 2. Copy tracers into State_Chm + ! Data was received in kg/kg dry + State_Chm(LCHNK)%Spc_Units = 'kg/kg dry' + ! Initialize ALL State_Chm species data to zero, not just tracers + State_Chm(LCHNK)%Species = 0.0e+0_fp + + lq(:) = .False. + + ! Map and flip gaseous species + MMR_Beg = 0.0e+0_r8 + MMR_End = 0.0e+0_r8 + DO N = 1, pcnst + M = map2GC(N) + IF ( M <= 0 ) CYCLE + MMR_Beg(:nY,:nZ,M) = state%q(:nY,nZ:1:-1,N) + State_Chm(LCHNK)%Species(1,:nY,:nZ,M) = REAL(MMR_Beg(:nY,:nZ,M),fp) + lq(N) = .True. + ENDDO + + ! We need to let CAM know that 'H2O' and 'Q' are identical + MMR_Beg(:nY,:nZ,iH2O) = state%q(:nY,nZ:1:-1,cQ) + State_Chm(LCHNK)%Species(1,:nY,:nZ,iH2O) = REAL(MMR_Beg(:nY,:nZ,iH2O),fp) + + ! Retrieve previous value of species data + SlsData(:,:,:) = 0.0e+0_r8 + CALL get_short_lived_species( SlsData, LCHNK, nY, pbuf ) + + !----------------------------------------------------------------------- + ! ... Set atmosphere mean mass + !----------------------------------------------------------------------- + ! This is not meant for simulations of the ionosphere. mBar will then just + ! be set to mwdry and does not require to pass anything besides NCOL. We + ! can then just past a dummy array as the second argument + !CALL Set_mean_mass( NCOL, mmr, mBar ) + CALL Set_mean_mass( NCOL, vmr0, mBar ) + + ! Map and flip gaseous short-lived species + DO N = 1, nSls + M = map2GC_Sls(N) + IF ( M <= 0 ) CYCLE + State_Chm(LCHNK)%Species(1,:nY,:nZ,M) = REAL(SlsData(:nY,nZ:1:-1,N),fp) + ENDDO + + DO N = 1, gas_pcnst + ! See definition of map2chm + M = map2chm(N) + IF ( M > 0 ) THEN + vmr0(:nY,:nZ,N) = State_Chm(LCHNK)%Species(1,:nY,nZ:1:-1,M) * & + MWDry / adv_mass(N) + ! We'll substract concentrations after chemistry later + mmr_tend(:nY,:nZ,N) = REAL(State_Chm(LCHNK)%Species(1,:nY,nZ:1:-1,M),r8) + ELSEIF ( M < 0 ) THEN + vmr0(:nY,:nZ,N) = state%q(:nY,:nZ,-M) * & + MWDry / adv_mass(N) + mmr_tend(:nY,:nZ,N) = state%q(:nY,:nZ,-M) + ENDIF + ENDDO + +#if defined( MODAL_AERO_4MODE ) + ! First reset State_Chm%Species to zero for aerosols + DO M = 1, ntot_amode + DO SM = 1, nspec_amode(M) + P = map2MAM4(SM,M) + IF ( P > 0 ) State_Chm(LCHNK)%Species(1,:nY,:nZ,P) = 0.0e+00_fp + ENDDO + ENDDO + + ! Map and flip aerosols + DO M = 1, ntot_amode + DO SM = 1, nspec_amode(M) + ! TMMF - Should there be a ratio of molar weights involved? + P = map2MAM4(SM,M) + IF ( P <= 0 ) CYCLE + N = lmassptr_amode(SM,M) + ! Multiple MAM4 bins are mapped to same GEOS-Chem species + State_Chm(LCHNK)%Species(1,:nY,:nZ,P) = State_Chm(LCHNK)%Species(1,:nY,:nZ,P) & + + REAL(state%q(:nY,nZ:1:-1,N),fp) + ENDDO + ENDDO + DO M = 1, ntot_amode + DO SM = 1, nspec_amode(M) + P = map2MAM4(SM,M) + IF ( P <= 0 ) CYCLE + N = lmassptr_amode(SM,M) + DO J = 1, nY + DO L = 1, nZ + IF ( State_Chm(LCHNK)%Species(1,J,nZ+1-L,P) > 0.0e+00_r8 ) THEN + binRatio(SM,M,J,L) = REAL(state%q(J,L,N),r8) & + / State_Chm(LCHNK)%Species(1,J,nZ+1-L,P) + ELSE + binRatio(SM,M,J,L) = 0.0e+00_r8 + ENDIF + ENDDO + ENDDO + ENDDO + ENDDO +#endif + + ! If H2O tendencies are propagated to specific humidity, then make sure + ! that Q actually applies tendencies + IF ( Input_Opt%applyQtend ) lq(cQ) = .True. + + IF ( ghg_chem ) lq(1) = .True. + + ! Initialize tendency array + CALL Physics_ptend_init(ptend, state%psetcols, 'chemistry', lq=lq) + + ! Reset chemical tendencies + ptend%q(:,:,:) = 0.0e+0_r8 + + ! Determine current date and time + CALL Get_Curr_Date( yr = currYr, & + mon = currMo, & + day = currDy, & + tod = currTOD ) + + currYMD = (currYr*1000) + (currMo*100) + (currDy) + ! Deal with subdaily + currUTC = REAL(currTOD,f4)/3600.0e+0_f4 + currSc = 0 + currMn = 0 + currHr = 0 + DO WHILE (currTOD >= 3600) + currTOD = currTOD - 3600 + currHr = currHr + 1 + ENDDO + DO WHILE (currTOD >= 60) + currTOD = currTOD - 60 + currMn = currMn + 1 + ENDDO + currSc = currTOD + currHMS = (currHr*1000) + (currMn*100) + (currSc) + + ! Calculate COS(SZA) + Calday = Get_Curr_Calday( INT(dT/2) ) + CALL Zenith( Calday, Rlats, Rlons, CSZAmid, nY ) + + Calday = Get_Curr_Calday( ) + CALL Zenith( Calday, Rlats, Rlons, CSZA, nY ) + + ! Get all required data from physics buffer + TIM_NDX = pbuf_old_tim_idx() + CALL pbuf_get_field( pbuf, NDX_PBLH, PblH ) + CALL pbuf_get_field( pbuf, NDX_FSDS, Fsds ) + CALL pbuf_get_field( pbuf, NDX_CLDTOP, cldTop ) + CALL pbuf_get_field( pbuf, NDX_CLDFRC, cldFrc, START=(/1,1,TIM_NDX/), KOUNT=(/NCOL,PVER,1/) ) + CALL pbuf_get_field( pbuf, NDX_NEVAPR, NEvapr, START=(/1,1/), KOUNT=(/NCOL,PVER/)) + CALL pbuf_get_field( pbuf, NDX_PRAIN, PRain, START=(/1,1/), KOUNT=(/NCOL,PVER/)) + CALL pbuf_get_field( pbuf, NDX_LSFLXPRC, LsFlxPrc, START=(/1,1/), KOUNT=(/NCOL,PVERP/)) + CALL pbuf_get_field( pbuf, NDX_LSFLXSNW, LsFlxSnw, START=(/1,1/), KOUNT=(/NCOL,PVERP/)) + CALL pbuf_get_field( pbuf, NDX_CMFDQR, cmfdqr, START=(/1,1/), KOUNT=(/NCOL,PVER/)) + + ! Get VMR and MMR of H2O + h2ovmr = 0.0e0_fp + qH2O = 0.0e0_fp + ! Note MWDry = 28.966 g/mol + DO J = 1, nY + DO L = 1, nZ + qH2O(J,L) = REAL(state%q(J,L,cQ),r8) + ! Set GEOS-Chem's H2O mixing ratio to CAM's specific humidity 'q' + State_Chm(LCHNK)%Species(1,J,nZ+1-L,iH2O) = qH2O(J,L) + h2ovmr(J,L) = qH2O(J,L) * MWDry / 18.016e+0_fp + ENDDO + ENDDO + + !----------------------------------------------------------------------- + ! ... Set the "invariants" + !----------------------------------------------------------------------- + CALL Setinv( invariants, state%t(:,:), h2ovmr, vmr0, & + state%pmid(:,:), nY, LCHNK, pbuf ) + + ! Calculate RH (range 0-1, note still level 1 = TOA) + relHum(:,:) = 0.0e+0_r8 + CALL QSat(state%t(:nY,:), state%pmid(:nY,:), satV, satQ) + DO J = 1, nY + DO L = 1, nZ + relHum(J,L) = 0.622e+0_r8 * h2ovmr(J,L) / satQ(J,L) + relHum(J,L) = MAX( 0.0e+0_r8, MIN( 1.0e+0_r8, relHum(J,L) ) ) + ENDDO + ENDDO + + Z0 = 0.0e+0_r8 + DO J = 1, nY + Z0(J) = cam_in%landFrac(J) * zlnd & + + cam_in%iceFrac(J) * zsice & + + cam_in%ocnFrac(J) * zocn + IF (( cam_in%snowhLand(J) > 0.01_r8 ) .OR. & + ( cam_in%snowhIce(J) > 0.01_r8 )) THEN + ! Land is covered in snow + Z0(J) = zslnd + ENDIF + ENDDO + + ! Estimate cloud liquid water content and OD + TauCli = 0.0e+0_r8 + TauClw = 0.0e+0_r8 + + ! Note: all using CAM vertical convention (1 = TOA) + ! Calculation is based on that done for MOZART + DO J = 1, nY + DO L = nZ, 1, -1 + cldW(J,L) = state%q(J,L,ixCldLiq) + state%q(J,L,ixCldIce) + ! Convert water mixing ratio [kg/kg] to water content [g/m^3] + IF ( cldW(J,L) * state%pmid(J,L) / & + (state%T(J,L) * 287.0e+00_r8) * 1.0e+03_r8 <= 0.01_r8 .AND. & + cldFrc(J,L) /= 0.0e+00_r8 ) THEN + cld(J,L) = 0.0e+00_r8 + ELSE + cld(J,L) = cldFrc(J,L) + ENDIF + IF ( ixNDrop > 0 ) nCldWtr(J,L) = state%q(J,L,ixNDrop) + ENDDO + ENDDO + + DO J = 1, nY + IF ( COUNT( cld(J,:nZ) > cldMin ) > 0 ) THEN + DO L = nZ, 1, -1 + ! ================================================================= + ! =========== Compute cloud optical depth based on ============ + ! =========== Liao et al. JGR, 104, 23697, 1999 ============ + ! ================================================================= + ! + ! Tau = 3/2 * LWC * dZ / ( \rho_w * r_e ) + ! dZ = - dP / ( \rho_air * g ) + ! since Pint is ascending, we can neglect the minus sign + ! + ! Tau = 3/2 * LWC * dP / ( \rho_air * r_e * \rho_w * g ) + ! LWC / \rho_air = Q + ! + ! Tau = 3/2 * Q * dP / ( r_e * rho_w * g ) + ! Tau(L) = 3/2 * Q(L) * (Pint(L+1) - Pint(L)) / (re * rho_w * g ) + ! Tau(L) = Q(L) * (Pint(L+1) - Pint(L)) * Cnst + ! + ! Unit check: | + ! Q : [kg H2O/kg air] | + ! Pint : [Pa]=[kg air/m/s^2] | + ! re : [m] | = 1.0e-5 + ! rho_w: [kg H2O/m^3] | = 1.0e+3 + ! g : [m/s^2] | = 9.81 + TauClw(J,L) = state%q(J,L,ixCldLiq) & + * (state%pint(J,L+1)-state%pint(J,L)) & + * cnst + TauClw(J,L) = MAX(TauClw(J,L), 0.0e+00_r8) + TauCli(J,L) = state%q(J,L,ixCldIce) & + * (state%pint(J,L+1)-state%pint(J,L)) & + * cnst + TauCli(J,L) = MAX(TauCli(J,L), 0.0e+00_r8) + ENDDO + ENDIF + ENDDO + + ! Retrieve tropopause level + Trop_Lev = 0.0e+0_r8 + CALL Tropopause_FindChemTrop(state, Trop_Lev) + ! Back out the pressure + Trop_P = 1000.0e+0_r8 + DO J = 1, nY + Trop_P(J) = state%pmid(J,Trop_Lev(J)) * 0.01e+0_r8 + ENDDO + + ! Calculate snow depth + snowDepth = 0.0e+0_r8 + DO J = 1, nY + Sd_Ice = MAX(0.0e+0_r8,cam_in%snowhIce(J)) + Sd_Lnd = MAX(0.0e+0_r8,cam_in%snowhLand(J)) + Frc_Ice = MAX(0.0e+0_r8,cam_in%iceFrac(J)) + IF (Frc_Ice > 0.0e+0_r8) THEN + Sd_Avg = (Sd_Lnd*(1.0e+0_r8 - Frc_Ice)) + (Sd_Ice * Frc_Ice) + ELSE + Sd_Avg = Sd_Lnd + ENDIF + snowDepth(J) = Sd_Avg + ENDDO + + ! Field : ALBD + ! Description: Visible surface albedo + ! Unit : - + ! Dimensions : nX, nY + State_Met(LCHNK)%ALBD (1,:nY) = cam_in%asdir(:nY) + + ! Field : CLDFRC + ! Description: Column cloud fraction + ! Unit : - + ! Dimensions : nX, nY + ! Note : Estimate column cloud fraction as the maximum cloud + ! fraction in the column (pessimistic assumption) + DO J = 1, nY + State_Met(LCHNK)%CLDFRC(1,J) = MAXVAL(cldFrc(J,:)) + ENDDO + + ! Field : EFLUX, HFLUX + ! Description: Latent heat flux, sensible heat flux + ! Unit : W/m^2 + ! Dimensions : nX, nY + State_Met(LCHNK)%EFLUX (1,:nY) = cam_in%Lhf(:nY) + State_Met(LCHNK)%HFLUX (1,:nY) = cam_in%Shf(:nY) + + ! Field : LandTypeFrac + ! Description: Olson fraction per type + ! Unit : - (between 0 and 1) + ! Dimensions : nX, nY, NSURFTYPE + ! Note : Index 1 is water + IF ( Input_Opt%onlineLandTypes ) THEN + ! Fill in water + State_Met(LCHNK)%LandTypeFrac(1,:nY,1) = cam_in%ocnFrac(:nY) & + + cam_in%iceFrac(:nY) + IF ( .NOT. Input_Opt%ddVel_CLM ) THEN + CALL getLandTypes( cam_in, & + nY, & + State_Met(LCHNK) ) + ENDIF + ELSE + DO N = 1, NSURFTYPE + Write(fldname_ns, '(a,i2.2)') 'HCO_LANDTYPE', N-1 + tmpIdx = pbuf_get_index(fldname_ns, rc) + IF ( tmpIdx < 0 ) THEN + ! there is an error here and the field was not found + IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(fldname_ns) + ELSE + CALL pbuf_get_field(pbuf, tmpIdx, pbuf_ik) + DO J = 1, nY + State_Met(LCHNK)%LandTypeFrac(1,J,N) = pbuf_ik(J,nZ) + ! 2-D data is stored in the 1st level of a + ! 3-D array due to laziness + ENDDO + pbuf_ik => NULL() + ENDIF + + Write(fldname_ns, '(a,i2.2)') 'HCO_XLAI', N-1 + tmpIdx = pbuf_get_index(fldname_ns, rc) + IF ( tmpIdx < 0 ) THEN + ! there is an error here and the field was not found + IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(fldname_ns) + + ELSE + CALL pbuf_get_field(pbuf, tmpIdx, pbuf_ik) + DO J = 1, nY + State_Met(LCHNK)%XLAI_NATIVE(1,J,N) = pbuf_ik(J,nZ) + ! 2-D data is stored in the 1st level of a + ! 3-D array due to laziness + ENDDO + pbuf_ik => NULL() + ENDIF + ENDDO +#endif + + ! Field : FRCLND, FRLAND, FROCEAN, FRSEAICE, FRLAKE, FRLANDIC + ! Description: Olson land fraction + ! Fraction of land + ! Fraction of ocean + ! Fraction of sea ice + ! Fraction of lake + ! Fraction of land ice + ! Fraction of snow + ! Unit : - + ! Dimensions : nX, nY + State_Met(LCHNK)%FRCLND (1,:ny) = 1.e+0_fp - & + State_Met(LCHNK)%LandTypeFrac(1,:nY,1) ! Olson Land Fraction + State_Met(LCHNK)%FRLAND (1,:nY) = cam_in%landFrac(:nY) + State_Met(LCHNK)%FROCEAN (1,:nY) = cam_in%ocnFrac(:nY) + cam_in%iceFrac(:nY) + State_Met(LCHNK)%FRSEAICE (1,:nY) = cam_in%iceFrac(:nY) + IF ( Input_Opt%onlineLandTypes ) THEN + State_Met(LCHNK)%FRLAKE (1,:nY) = cam_in%lwtgcell(:,3) + & + cam_in%lwtgcell(:,4) + State_Met(LCHNK)%FRLANDIC (1,:nY) = cam_in%lwtgcell(:,2) + State_Met(LCHNK)%FRSNO (1,:nY) = 0.0e+0_fp + ELSE + State_Met(LCHNK)%FRLAKE (1,:nY) = 0.0e+0_fp + State_Met(LCHNK)%FRLANDIC (1,:nY) = 0.0e+0_fp + State_Met(LCHNK)%FRSNO (1,:nY) = 0.0e+0_fp + ENDIF + + ! Field : GWETROOT, GWETTOP + ! Description: Root and top soil moisture + ! Unit : - + ! Dimensions : nX, nY + State_Met(LCHNK)%GWETROOT (1,:nY) = 0.0e+0_fp + State_Met(LCHNK)%GWETTOP (1,:nY) = 0.0e+0_fp + + ! Field : LAI + ! Description: Leaf area index + ! Unit : m^2/m^2 + ! Dimensions : nX, nY + State_Met(LCHNK)%LAI (1,:nY) = 0.0e+0_fp + + ! Field : PARDR, PARDF + ! Description: Direct and diffuse photosynthetically active radiation + ! Unit : W/m^2 + ! Dimensions : nX, nY + State_Met(LCHNK)%PARDR (1,:nY) = 0.0e+0_fp + State_Met(LCHNK)%PARDF (1,:nY) = 0.0e+0_fp + + ! Field : PBLH + ! Description: PBL height + ! Unit : m + ! Dimensions : nX, nY + State_Met(LCHNK)%PBLH (1,:nY) = PblH(:nY) + + ! Field : PHIS + ! Description: Surface geopotential height + ! Unit : m + ! Dimensions : nX, nY + State_Met(LCHNK)%PHIS (1,:nY) = state%Phis(:nY) + + ! Field : PRECANV, PRECCON, PRECLSC, PRECTOT + ! Description: Anvil precipitation @ ground + ! Convective precipitation @ ground + ! Large-scale precipitation @ ground + ! Total precipitation @ ground + ! Unit : kg/m^2/s + ! Dimensions : nX, nY + State_Met(LCHNK)%PRECANV (1,:nY) = 0.0e+0_fp + State_Met(LCHNK)%PRECCON (1,:nY) = cam_out%Precc(:nY) + State_Met(LCHNK)%PRECLSC (1,:nY) = cam_out%Precl(:nY) + State_Met(LCHNK)%PRECTOT (1,:nY) = cam_out%Precc(:nY) + cam_out%Precl(:nY) + + ! Field : TROPP + ! Description: Tropopause pressure + ! Unit : hPa + ! Dimensions : nX, nY + State_Met(LCHNK)%TROPP (1,:nY) = Trop_P(:nY) + + ! Field : PS1_WET, PS2_WET + ! Description: Wet surface pressure at start and end of timestep + ! Unit : hPa + ! Dimensions : nX, nY + State_Met(LCHNK)%PS1_WET (1,:nY) = state%ps(:nY)*0.01e+0_fp + State_Met(LCHNK)%PS2_WET (1,:nY) = state%ps(:nY)*0.01e+0_fp + + ! Field : SLP + ! Description: Sea level pressure + ! Unit : hPa + ! Dimensions : nX, nY + State_Met(LCHNK)%SLP (1,:nY) = state%ps(:nY)*0.01e+0_fp + + ! Field : TS, TSKIN + ! Description: Surface temperature, surface skin temperature + ! Unit : K + ! Dimensions : nX, nY + State_Met(LCHNK)%TS (1,:nY) = cam_in%TS(:nY) + State_Met(LCHNK)%TSKIN (1,:nY) = cam_in%TS(:nY) + + ! Field : SWGDN + ! Description: Incident radiation @ ground + ! Unit : W/m^2 + ! Dimensions : nX, nY + State_Met(LCHNK)%SWGDN (1,:nY) = fsds(:nY) + + ! Field : SNODP, SNOMAS + ! Description: Snow depth, snow mass + ! Unit : m, kg/m^2 + ! Dimensions : nX, nY + ! Note : Conversion from m to kg/m^2 + ! \rho_{ice} = 916.7 kg/m^3 + State_Met(LCHNK)%SNODP (1,:nY) = snowDepth(:nY) + State_Met(LCHNK)%SNOMAS (1,:nY) = snowDepth(:nY) * 916.7e+0_r8 + + ! Field : SUNCOS, SUNCOSmid + ! Description: COS(solar zenith angle) at current time and midpoint + ! of chemistry timestep + ! Unit : - + ! Dimensions : nX, nY + State_Met(LCHNK)%SUNCOS (1,:nY) = CSZA(:nY) + State_Met(LCHNK)%SUNCOSmid (1,:nY) = CSZAmid(:nY) + + ! Field : UVALBEDO + ! Description: UV surface albedo + ! Unit : - + ! Dimensions : nX, nY + IF ( Input_Opt%onlineAlbedo ) THEN + State_Met(LCHNK)%UVALBEDO(1,:nY) = cam_in%asdir(:nY) + ELSE + fldname_ns = 'HCO_UV_ALBEDO' + tmpIdx = pbuf_get_index(fldname_ns, RC) + IF ( tmpIdx < 0 .or. ( iStep == 1 ) ) THEN + IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(fldname_ns) + State_Met(LCHNK)%UVALBEDO(1,:nY) = 0.0e+0_fp + ELSE + pbuf_chnk => pbuf_get_chunk(hco_pbuf2d, LCHNK) + CALL pbuf_get_field(pbuf_chnk, tmpIdx, pbuf_ik) + State_Met(LCHNK)%UVALBEDO(1,:nY) = pbuf_ik(:nY,nZ) + pbuf_chnk => NULL() + pbuf_ik => NULL() + ENDIF + ENDIF + + ! Field : U10M, V10M + ! Description: E/W and N/S wind speed @ 10m height + ! Unit : m/s + ! Dimensions : nX, nY + State_Met(LCHNK)%U10M (1,:nY) = state%U(:nY,nZ) + State_Met(LCHNK)%V10M (1,:nY) = state%V(:nY,nZ) + + ! Field : USTAR + ! Description: Friction velocity + ! Unit : m/s + ! Dimensions : nX, nY + ! Note : We here combine the land friction velocity (fv) with + ! the ocean friction velocity (ustar) + DO J = 1, nY + State_Met(LCHNK)%USTAR (1,J) = & + cam_in%fv(J) * ( cam_in%landFrac(J)) & + + cam_in%uStar(J) * ( 1.0e+0_fp - cam_in%landFrac(J)) + ENDDO + + ! Field : Z0 + ! Description: Surface roughness length + ! Unit : m + ! Dimensions : nX, nY + State_Met(LCHNK)%Z0 (1,:nY) = Z0(:nY) + + ! Field : IODIDE + ! Description: Surface iodide concentration + ! Unit : nM + ! Dimensions : nX, nY + fldname_ns = 'HCO_iodide' + tmpIdx = pbuf_get_index(fldname_ns, RC) + IF ( tmpIdx < 0 .or. ( iStep == 1 ) ) THEN + IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(fldname_ns) + State_Chm(LCHNK)%IODIDE(1,:nY) = 0.0e+0_fp + ELSE + pbuf_chnk => pbuf_get_chunk(hco_pbuf2d, LCHNK) + CALL pbuf_get_field(pbuf_chnk, tmpIdx, pbuf_ik) + State_Chm(LCHNK)%IODIDE(1,:nY) = pbuf_ik(:nY,nZ) + pbuf_chnk => NULL() + pbuf_ik => NULL() + ENDIF + + ! Field : SALINITY + ! Description: Ocean salinity + ! Unit : PSU + ! Dimensions : nX, nY + ! Note : Possibly get ocean salinity from POP? + fldname_ns = 'HCO_salinity' + tmpIdx = pbuf_get_index(fldname_ns, RC) + IF ( tmpIdx < 0 .or. ( iStep == 1 ) ) THEN + IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(fldname_ns) + State_Chm(LCHNK)%SALINITY(1,:nY) = 0.0e+0_fp + ELSE + pbuf_chnk => pbuf_get_chunk(hco_pbuf2d, LCHNK) + CALL pbuf_get_field(pbuf_chnk, tmpIdx, pbuf_ik) + State_Chm(LCHNK)%SALINITY(1,:nY) = pbuf_ik(:nY,nZ) + pbuf_chnk => NULL() + pbuf_ik => NULL() + ENDIF + + ! Field : OMOC + ! Description: OM/OC ratio + ! Unit : - + ! Dimensions : nX, nY + IF ( currMo == 12 .or. currMo == 1 .or. currMo == 2 ) THEN + fldname_ns = 'HCO_OMOC_DJF' + ELSE IF ( currMo == 3 .or. currMo == 4 .or. currMo == 5 ) THEN + fldname_ns = 'HCO_OMOC_MAM' + ELSE IF ( currMo == 6 .or. currMo == 7 .or. currMo == 8 ) THEN + fldname_ns = 'HCO_OMOC_JJA' + ELSE IF ( currMo == 9 .or. currMo == 10 .or. currMo == 11 ) THEN + fldname_ns = 'HCO_OMOC_SON' + ENDIF + tmpIdx = pbuf_get_index(fldname_ns, rc) + IF ( tmpIdx < 0 ) THEN + ! there is an error here and the field was not found + IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(fldname_ns) + ELSE + CALL pbuf_get_field(pbuf, tmpIdx, pbuf_ik) + DO J = 1, nY + State_Chm(LCHNK)%OMOC(1,J) = pbuf_ik(J,nZ) + ! 2-D data is stored in the 1st level of a + ! 3-D array due to laziness + ENDDO + pbuf_ik => NULL() + ENDIF + + ! Three-dimensional fields on level edges + DO J = 1, nY + DO L = 1, nZ+1 + ! Field : PEDGE + ! Description: Wet air pressure at (vertical) level edges + ! Unit : hPa + ! Dimensions : nX, nY, nZ+1 + State_Met(LCHNK)%PEDGE (1,J,L) = state%pint(J,nZ+2-L)*0.01e+0_fp + + ! Field : CMFMC + ! Description: Upward moist convective mass flux + ! Unit : kg/m^2/s + ! Dimensions : nX, nY, nZ+1 + State_Met(LCHNK)%CMFMC (1,J,L) = 0.0e+0_fp + + ! Field : PFICU, PFLCU + ! Description: Downward flux of ice/liquid precipitation (convective) + ! Unit : kg/m^2/s + ! Dimensions : nX, nY, nZ+1 + State_Met(LCHNK)%PFICU (1,J,L) = 0.0e+0_fp + State_Met(LCHNK)%PFLCU (1,J,L) = 0.0e+0_fp + + ! Field : PFILSAN, PFLLSAN + ! Description: Downward flux of ice/liquid precipitation (Large-scale & anvil) + ! Unit : kg/m^2/s + ! Dimensions : nX, nY, nZ+1 + State_Met(LCHNK)%PFILSAN (1,J,L) = LsFlxSnw(J,nZ+2-L) ! kg/m2/s + State_Met(LCHNK)%PFLLSAN (1,J,L) = MAX(0.0e+0_fp,LsFlxPrc(J,nZ+2-L) - LsFlxSnw(J,nZ+2-L)) ! kg/m2/s + ENDDO + ENDDO + + DO J = 1, nY + ! Field : CLDTOPS + ! Description: Max cloud top height + ! Unit : level + ! Dimensions : nX, nY + State_Met(LCHNK)%CLDTOPS(1,J) = nZ + 1 - NINT(cldTop(J)) + ENDDO + + ! Three-dimensional fields on level centers + DO J = 1, nY + DO L = 1, nZ + ! Field : U, V + ! Description: E/W and N/S component of wind + ! Unit : m/s + ! Dimensions : nX, nY, nZ + State_Met(LCHNK)%U (1,J,L) = state%U(J,nZ+1-L) + State_Met(LCHNK)%V (1,J,L) = state%V(J,nZ+1-L) + + ! Field : OMEGA + ! Description: Updraft velocity + ! Unit : Pa/s + ! Dimensions : nX, nY, nZ + State_Met(LCHNK)%OMEGA (1,J,L) = state%Omega(J,nZ+1-L) + + ! Field : CLDF + ! Description: 3-D cloud fraction + ! Unit : - + ! Dimensions : nX, nY, nZ + State_Met(LCHNK)%CLDF (1,J,L) = cldFrc(J,nZ+1-L) + + ! Field : DTRAIN + ! Description: Detrainment flux + ! Unit : kg/m^2/s + ! Dimensions : nX, nY, nZ + State_Met(LCHNK)%DTRAIN (1,J,L) = 0.0e+0_fp ! Used in convection + + ! Field : DQRCU + ! Description: Convective precipitation production rate + ! Unit : kg/kg dry air/s + ! Dimensions : nX, nY, nZ + State_Met(LCHNK)%DQRCU (1,J,L) = 0.0e+0_fp ! Used in convection + + ! Field : DQRLSAN + ! Description: Large-scale precipitation production rate + ! Unit : kg/kg dry air/s + ! Dimensions : nX, nY, nZ + State_Met(LCHNK)%DQRLSAN (1,J,L) = PRain(J,nZ+1-L) ! kg/kg/s + + ! Field : QI, QL + ! Description: Cloud ice/water mixing ratio + ! Unit : kg/kg dry air + ! Dimensions : nX, nY, nZ + State_Met(LCHNK)%QI (1,J,L) = MAX(1.0e-10_fp, state%q(J,nZ+1-L,ixCldIce)) ! kg ice / kg dry air + State_Met(LCHNK)%QL (1,J,L) = MAX(1.0e-10_fp, state%q(J,nZ+1-L,ixCldLiq)) ! kg water / kg dry air + + ! Field : RH + ! Description: Relative humidity + ! Unit : % + ! Dimensions : nX, nY, nZ + State_Met(LCHNK)%RH (1,J,L) = relHum(J,nZ+1-L) * 100.0e+0_fp + + ! Field : TAUCLI, TAUCLW + ! Description: Optical depth of ice/H2O clouds + ! Unit : - + ! Dimensions : nX, nY, nZ + State_Met(LCHNK)%TAUCLI (1,J,L) = TauCli(J,nZ+1-L) + State_Met(LCHNK)%TAUCLW (1,J,L) = TauClw(J,nZ+1-L) + + ! Field : REEVAPCN + ! Description: Evaporation of convective precipitation + ! (w/r/t dry air) + ! Unit : kg + ! Dimensions : nX, nY, nZ + State_Met(LCHNK)%REEVAPCN (1,J,L) = 0.0e+0_fp + + ! Field : REEVAPLS + ! Description: Evaporation of large-scale + anvil precipitation + ! (w/r/t dry air) + ! Unit : kg/kg/s + ! Dimensions : nX, nY, nZ + State_Met(LCHNK)%REEVAPLS (1,J,L) = NEvapr(J,nZ+1-L) ! kg/kg/s + + ! Field : SPHU1, SPHU2 + ! Description: Specific humidity at current and next timestep + ! Unit : g H2O/ kg air + ! Dimensions : nX, nY, nZ + ! Note : Since we are using online meteorology, we do not have + ! access to the data at the next time step + ! Compute tendency in g H2O/kg air/s (tmmf, 1/13/20) ? + State_Met(LCHNK)%SPHU1 (1,J,L) = qH2O(J,nZ+1-L) * 1.0e+3_fp ! g/kg + State_Met(LCHNK)%SPHU2 (1,J,L) = qH2O(J,nZ+1-L) * 1.0e+3_fp ! g/kg + + ! Field : TMPU1, TMPU2 + ! Description: Temperature at current and next timestep + ! Unit : K + ! Dimensions : nX, nY, nZ + ! Note : Since we are using online meteorology, we do not have + ! access to the data at the next time step + ! Compute tendency in K/s (tmmf, 1/13/20) ? + State_Met(LCHNK)%TMPU1 (1,J,L) = state%t(J,nZ+1-L) + State_Met(LCHNK)%TMPU2 (1,J,L) = state%t(J,nZ+1-L) + ENDDO + ENDDO + ! Note: Setting DQRLSAN to zero in the top layer prevents upcoming NaNs + ! in the GEOS-Chem wet deposition routines. Given the altitude, it should + ! be zero anyway, this is just to prevent any numerical artifacts from + ! creeping in. + State_Met(LCHNK)%DQRLSAN (1,:nY,nZ) = 0.0e+00_fp + + ! Field : T + ! Description: Temperature at current time + ! Unit : K + ! Dimensions : nX, nY, nZ + ! Note : Since we are using online meteorology, we do not have + ! access to the data at the next time step + ! Compute tendency in K/s (tmmf, 1/13/20) ? + State_Met(LCHNK)%T = (State_Met(LCHNK)%TMPU1 + State_Met(LCHNK)%TMPU2)*0.5e+0_fp + + ! Field : SPHU + ! Description: Specific humidity at current time + ! Unit : g H2O/ kg air + ! Dimensions : nX, nY, nZ + ! Note : Since we are using online meteorology, we do not have + ! access to the data at the next time step + ! Compute tendency in g H2O/kg air/s (tmmf, 1/13/20) ? + State_Met(LCHNK)%SPHU = (State_Met(LCHNK)%SPHU1 + State_Met(LCHNK)%SPHU2)*0.5e+0_fp + + ! Field : OPTD + ! Description: Total in-cloud optical depth (visible band) + ! Unit : - + ! Dimensions : nX, nY, nZ + State_Met(LCHNK)%OPTD = State_Met(LCHNK)%TAUCLI + State_Met(LCHNK)%TAUCLW + + ! Determine current date and time + CALL Get_Curr_Date( yr = currYr, & + mon = currMo, & + day = currDy, & + tod = currTOD ) + + ! For now, force year to be 2000 + currYr = 2000 + currYMD = (currYr*1000) + (currMo*100) + (currDy) + ! Deal with subdaily + currUTC = REAL(currTOD,f4)/3600.0e+0_f4 + currSc = 0 + currMn = 0 + currHr = 0 + DO WHILE (currTOD > 3600) + currTOD = currTOD - 3600 + currHr = currHr + 1 + ENDDO + DO WHILE (currTOD > 60) + currTOD = currTOD - 60 + currMn = currMn + 1 + ENDDO + currSc = currTOD + currHMS = (currHr*1000) + (currMn*100) + (currSc) + + IF ( firstDay ) THEN + newDay = .True. + newMonth = .True. + firstDay = .False. + ELSE IF ( currHMS < dT ) THEN + newDay = .True. + IF ( currDy == 1 ) THEN + newMonth = .True. + ELSE + newMonth = .False. + ENDIF + ELSE + newDay = .False. + newMonth = .False. + ENDIF + + ! Pass time values obtained from the ESMF environment to GEOS-Chem + CALL Accept_External_Date_Time( value_NYMD = currYMD, & + value_NHMS = currHMS, & + value_YEAR = currYr, & + value_MONTH = currMo, & + value_DAY = currDy, & + value_DAYOFYR = INT(FLOOR(Calday)), & + value_HOUR = currHr, & + value_MINUTE = currMn, & + value_HELAPSED = 0.0e+0_f4, & + value_UTC = currUTC, & + RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Failed to update time in GEOS-Chem!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + CALL Accept_External_PEdge( State_Met = State_Met(LCHNK), & + State_Grid = State_Grid(LCHNK), & + RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Failed to update pressure edges!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + ! Field : PS1_DRY, PS2_DRY + ! Description: Dry surface pressure at current and next timestep + ! Unit : hPa + ! Dimensions : nX, nY, nZ+1 + ! Note : 1. Use the CAM PSDry fields instead of using the + ! GEOS-Chem calculation + ! 2. As we are using online meteorology, we do not + ! have access to the fields at the next time step + ! Compute Pa/s tendency? (tmmf, 1/13/20) + State_Met(LCHNK)%PS1_DRY (1,:nY) = state%PSDry(:nY) * 0.01e+0_fp + State_Met(LCHNK)%PS2_DRY (1,:nY) = state%PSDry(:nY) * 0.01e+0_fp + + ! Field : PSC2_WET, PSC2_DRY + ! Description: Interpolated wet and dry surface pressure at the + ! current time + ! Unit : hPa + ! Dimensions : nX, nY, nZ+1 + ! Note : As we are using online meteorology, we do not + ! have access to the fields at the next time step + ! Compute Pa/s tendency? (tmmf, 1/13/20) + State_Met(LCHNK)%PSC2_WET = State_Met(LCHNK)%PS1_WET + State_Met(LCHNK)%PSC2_DRY = State_Met(LCHNK)%PS1_DRY + + CALL Set_Floating_Pressures( State_Grid = State_Grid(LCHNK), & + State_Met = State_Met(LCHNK), & + RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Failed to set floating pressures!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + ! Set quantities of interest but do not change VMRs + ! This function updates: + ! ==================================================================== + ! (1) PEDGE : Moist air pressure at grid box bottom [hPa] + ! (2) PEDGE_DRY : Dry air partial pressure at box bottom [hPa] + ! (3) PMID : Moist air pressure at grid box centroid [hPa] + ! (4) PMID_DRY : Dry air partial pressure at box centroid [hPa] + ! (5) PMEAN : Altitude-weighted mean moist air pressure [hPa] + ! (6) PMEAN_DRY : Alt-weighted mean dry air partial pressure [hPa] + ! (7) DELP : Delta-P extent of grid box [hPa] + ! (Same for both moist and dry air since we + ! assume constant water vapor pressure + ! across box) + ! (8) AIRDEN : Mean grid box dry air density [kg/m^3] + ! (defined as total dry air mass/box vol) + ! (9) AIRNUMDEN : Mean grid box dry air number density [molec/m^3] + ! (10) MAIRDEN : Mean grid box moist air density [kg/m^3] + ! (defined as total moist air mass/box vol) + ! (11) AD : Total dry air mass in grid box [kg] + ! (12) ADMOIST : Total moist air mass in grid box [kg] + ! (13) BXHEIGHT : Vertical height of grid box [m] + ! (14) AIRVOL : Volume of grid box [m^3] + ! (15) MOISTMW : Molecular weight of moist air in box [g/mol] + ! (16) IsLand : Logical for grid cells over land [-] + ! (17) IsWater : Logical for grid cells over water [-] + ! (18) IsIce : Logical for grid cells over ice [-] + ! (19) IsSnow : Logical for grid cells over snow [-] + ! (20) InTroposph: Logical for tropospheric grid cells [-] + ! (21) InStratMes: Logical for non-tropospheric grid cells [-] + ! (22) InStratosp: Logical for stratospheric grid cells [-] + ! (23) InChemGrid: Logical for chemistry grid cells [-] + ! (24) LocalSolar: Local solar time [-] + ! (25) IsLocalNoo: Logical for local noon [-] + ! (26) TropLev : Maximum tropopause level [-] + ! (27) TropHt : Maximum tropopause height [km] + ! ==================================================================== + CALL AirQnt( Input_Opt = Input_Opt, & + State_Chm = State_Chm(LCHNK), & + State_Grid = State_Grid(LCHNK), & + State_Met = State_Met(LCHNK), & + RC = RC, & + Update_Mixing_Ratio = .False. ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Failed to calculate air properties!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + ! SDE 05/28/13: Set H2O to State_Chm tracer if relevant and, + ! if LUCX=T and LSETH2O=F and LACTIVEH2O=T, update specific humidity + ! in the stratosphere + ! + ! NOTE: Specific humidity may change in SET_H2O_TRAC and + ! therefore this routine may call AIRQNT again to update + ! air quantities and tracer concentrations (ewl, 10/28/15) + IF ( Input_Opt%Its_A_Fullchem_Sim .and. iH2O > 0 ) THEN + CALL Set_H2O_Trac( SETSTRAT = ( ( .not. Input_Opt%LUCX ) & + .or. Input_Opt%LSETH2O ), & + Input_Opt = Input_Opt, & + State_Chm = State_Chm(LCHNK), & + State_Grid = State_Grid(LCHNK), & + State_Met = State_Met(LCHNK), & + RC = RC ) + + ! Trap potential errors + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Set_H2O_Trac" #1!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + ! Only force strat once if using UCX + IF (Input_Opt%LSETH2O) Input_Opt%LSETH2O = .FALSE. + ENDIF + + ! Do this after AirQnt, such that we overwrite GEOS-Chem isLand, isWater and + ! isIce, which are based on albedo. Rather, we use CLM landFranc, ocnFrac + ! and iceFrac. We also compute isSnow + DO J = 1, nY + iMaxLoc = MAXLOC( (/ State_Met(LCHNK)%FRLAND(1,J) + & + State_Met(LCHNK)%FRLANDIC(1,J) + & + State_Met(LCHNK)%FRLAKE(1,J), & + State_Met(LCHNK)%FRSEAICE(1,J), & + State_Met(LCHNK)%FROCEAN(1,J) - & + State_Met(LCHNK)%FRSEAICE(1,J) /) ) + IF ( iMaxLoc(1) == 3 ) iMaxLoc(1) = 0 + ! reset ocean to 0 + + ! Field : LWI + ! Description: Land/water indices + ! Unit : - + ! Dimensions : nX, nY + State_Met(LCHNK)%LWI(1,J) = FLOAT( iMaxLoc(1) ) + + IF ( iMaxLoc(1) == 0 ) THEN + State_Met(LCHNK)%isLand(1,J) = .False. + State_Met(LCHNK)%isWater(1,J) = .True. + State_Met(LCHNK)%isIce(1,J) = .False. + ELSEIF ( iMaxLoc(1) == 1 ) THEN + State_Met(LCHNK)%isLand(1,J) = .True. + State_Met(LCHNK)%isWater(1,J) = .False. + State_Met(LCHNK)%isIce(1,J) = .False. + ELSEIF ( iMaxLoc(1) == 2 ) THEN + State_Met(LCHNK)%isLand(1,J) = .False. + State_Met(LCHNK)%isWater(1,J) = .False. + State_Met(LCHNK)%isIce(1,J) = .True. + ELSE + Write(iulog,*) " iMaxLoc gets value: ", iMaxLoc + ErrMsg = 'Failed to figure out land/water' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + State_Met(LCHNK)%isSnow(1,J) = ( State_Met(LCHNK)%FRSEAICE(1,J) > 0.0e+0_fp & + .or. State_Met(LCHNK)%SNODP(1,J) > 0.01 ) + + ENDDO + + ! Do this after AirQnt in order to use AIRDEN and BXHEIGHT + DO J = 1, nY + O3col(J) = 0.0e+0_fp + DO L = 1, nZ + O3col(J) = O3col(J) & + + State_Chm(LCHNK)%Species(1,J,L,iO3) & + * State_Met(LCHNK)%AIRDEN(1,J,L) & + * State_Met(LCHNK)%BXHEIGHT(1,J,L) + ENDDO + O3col(J) = O3col(J) * ( AVO / MWO3 ) / 1e+1_fp / 2.69e+16_fp + ENDDO + + ! Field : TO3 + ! Description: Total overhead ozone column + ! Unit : DU + ! Dimensions : nX, nY + State_Met(LCHNK)%TO3 (1,:nY) = O3col(:nY) + + IF ( Input_Opt%LSCHEM .AND. & + State_Grid(LCHNK)%MaxChemLev /= State_Grid(LCHNK)%nZ ) THEN + IF ( iStep == 1 ) THEN + ALLOCATE( BrPtrDay ( 6 ), STAT=IERR ) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating BrPtrDay') + ALLOCATE( BrPtrNight( 6 ), STAT=IERR ) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating BrPtrNight') + DO N = 1, 6 + ! Skip if species is not defined + IF ( GC_Bry_TrID(N) <= 0 ) CYCLE + + ! Get Bry name + SpcName = State_Chm(LCHNK)%SpcData(GC_Bry_TrID(N))%Info%Name + + ! Construct field name using Bry name + PREFIX = 'GEOSCCM_'//TRIM(SpcName) + + ALLOCATE( BrPtrDay(N)%MR(1,PCOLS,nZ), STAT=IERR ) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating BrPtrDay%MR') + ALLOCATE( BrPtrNight(N)%MR(1,PCOLS,nZ), STAT=IERR ) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating BrPtrNight%MR') + + ! Get pointer to this field. These are the mixing ratios (pptv). + + ! Day + FIELDNAME = TRIM(PREFIX) // '_DAY' + fldname_ns = FIELDNAME + tmpIdx = pbuf_get_index(fldname_ns, RC) + IF ( tmpIdx < 0 .or. ( iStep == 1 ) ) THEN + IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(fldname_ns) + BrPtrDay(N)%MR(1,:nY,nZ:1:-1) = 0.0e+0_f4 + ELSE + pbuf_chnk => pbuf_get_chunk(hco_pbuf2d, LCHNK) + CALL pbuf_get_field(pbuf_chnk, tmpIdx, pbuf_ik) + BrPtrDay(N)%MR(1,:nY,nZ:1:-1) = REAL(pbuf_ik(:nY,:nZ), f4) + pbuf_chnk => NULL() + pbuf_ik => NULL() + ENDIF + !CALL HCO_GetPtr( HcoState, FIELDNAME, BrPtrDay(N)%MR, RC ) + + ! Night + FIELDNAME = TRIM(PREFIX) // '_NIGHT' + tmpIdx = pbuf_get_index(fldname_ns, RC) + IF ( tmpIdx < 0 .or. ( iStep == 1 ) ) THEN + IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(fldname_ns) + BrPtrDay(N)%MR(1,:nY,nZ:1:-1) = 0.0e+0_f4 + ELSE + pbuf_chnk => pbuf_get_chunk(hco_pbuf2d, LCHNK) + CALL pbuf_get_field(pbuf_chnk, tmpIdx, pbuf_ik) + BrPtrNight(N)%MR(1,:nY,nZ:1:-1) = REAL(pbuf_ik(:nY,:nZ), f4) + pbuf_chnk => NULL() + pbuf_ik => NULL() + ENDIF + !CALL HCO_GetPtr( HcoState, FIELDNAME, BrPtrNight(N)%MR, RC ) + + ENDDO + + DO N = 1,NSCHEM + + ! Get GEOS-Chem species index + M = Strat_TrID_GC(N) + + ! Skip if species is not defined + IF ( M <= 0 ) CYCLE + + ! Get species name + SpcName = State_Chm(LCHNK)%SpcData(M)%Info%Name + + ! --------------------------------------------------------------- + ! Get pointers to fields + ! --------------------------------------------------------------- + + ! Production rates [v/v/s] + IF ( Input_Opt%LUCX ) THEN + FIELDNAME = 'GMI_PROD_'//TRIM(SpcName) + ELSE + FIELDNAME = 'UCX_PROD_'//TRIM(SpcName) + ENDIF + + ALLOCATE( PLVEC(N)%PROD(1,PCOLS,nZ), STAT=IERR ) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating PLVEC%PROD') + ALLOCATE( PLVEC(N)%LOSS(1,PCOLS,nZ), STAT=IERR ) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating PLVEC%PROD') + + ! Get pointer from HEMCO + tmpIdx = pbuf_get_index(fldname_ns, RC) + IF ( tmpIdx < 0 .or. ( iStep == 1 ) ) THEN + IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(fldname_ns) + PLVEC(N)%PROD(1,:nY,nZ:1:-1) = 0.0e+0_f4 + FND = .False. + ELSE + pbuf_chnk => pbuf_get_chunk(hco_pbuf2d, LCHNK) + CALL pbuf_get_field(pbuf_chnk, tmpIdx, pbuf_ik) + PLVEC(N)%PROD(1,:nY,nZ:1:-1) = REAL(pbuf_ik(:nY,:nZ),f4) + FND = .True. + pbuf_chnk => NULL() + pbuf_ik => NULL() + ENDIF + !CALL HCO_GetPtr( HcoState, FIELDNAME, PLVEC(N)%PROD, RC, FOUND=FND ) + + ! Warning message + IF ( .NOT. FND .AND. Input_Opt%amIRoot ) THEN + ErrMsg = 'Cannot find archived production rates for ' // & + TRIM(SpcName) // ' - will use value of 0.0. ' // & + 'To use archived rates, add the following field ' // & + 'to the HEMCO configuration file: '// TRIM( FIELDNAME ) + CALL GC_Warning( ErrMsg, RC, ThisLoc ) + ENDIF + + ! Loss frequency [s-1] + IF ( Input_Opt%LUCX ) THEN + FIELDNAME = 'GMI_LOSS_'//TRIM(SpcName) + ELSE + FIELDNAME = 'UCX_LOSS_'//TRIM(SpcName) + ENDIF + + ! Get pointer from HEMCO + tmpIdx = pbuf_get_index(fldname_ns, RC) + IF ( tmpIdx < 0 .or. ( iStep == 1 ) ) THEN + IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(fldname_ns) + PLVEC(N)%LOSS(1,:nY,nZ:1:-1) = 0.0e+0_f4 + FND = .False. + ELSE + pbuf_chnk => pbuf_get_chunk(hco_pbuf2d, LCHNK) + CALL pbuf_get_field(pbuf_chnk, tmpIdx, pbuf_ik) + PLVEC(N)%LOSS(1,:nY,nZ:1:-1) = REAL(pbuf_ik(:nY,:nZ), f4) + FND = .True. + pbuf_chnk => NULL() + pbuf_ik => NULL() + ENDIF + !CALL HCO_GetPtr( HcoState, FIELDNAME, PLVEC(N)%LOSS, RC, FOUND=FND ) + + ! Warning message + IF ( .NOT. FND .AND. Input_Opt%amIRoot ) THEN + ErrMsg= 'Cannot find archived loss frequencies for ' // & + TRIM(SpcName) // ' - will use value of 0.0. ' // & + 'To use archived rates, add the following field ' // & + 'to the HEMCO configuration file: '//TRIM(FIELDNAME) + CALL GC_Warning( ErrMsg, RC, ThisLoc ) + ENDIF + + ENDDO !N + + ! Get pointer to STRAT_OH + + ALLOCATE( STRAT_OH(1,PCOLS,nZ), STAT=IERR ) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating STRAT_OH') + + tmpIdx = pbuf_get_index(fldname_ns, RC) + IF ( tmpIdx < 0 .or. ( iStep == 1 ) ) THEN + IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(fldname_ns) + STRAT_OH(1,:nY,nZ:1:-1) = 0.0e+0_f4 + ELSE + pbuf_chnk => pbuf_get_chunk(hco_pbuf2d, LCHNK) + CALL pbuf_get_field(pbuf_chnk, tmpIdx, pbuf_ik) + STRAT_OH(1,:nY,nZ:1:-1) = REAL(pbuf_ik(:nY,:nZ), f4) + pbuf_chnk => NULL() + pbuf_ik => NULL() + ENDIF + !CALL HCO_GetPtr( HcoState, 'STRAT_OH', STRAT_OH, RC, FOUND=FND ) + ENDIF + + ENDIF + + ! This is not necessary as we prescribe CH4 surface mixing ratios + ! through CAM. + !! Prescribe methane surface concentrations throughout PBL + !IF ( ITS_A_FULLCHEM_SIM .and. id_CH4 > 0 ) THEN + ! + ! ! Set CH4 concentrations + ! CALL SET_CH4( Input_Opt = Input_Opt, & + ! State_Chm = State_Chm(LCHNK), & + ! State_Diag = State_Diag(LCHNK), & + ! State_Grid = State_Grid(LCHNK), & + ! State_Met = State_Met(LCHNK), & + ! RC = RC ) + ! + ! ! Trap potential errors + ! IF ( RC /= GC_SUCCESS ) THEN + ! ErrMsg = 'Error encountered in call to "SET_CH4"!' + ! CALL Error_Stop( ErrMsg, ThisLoc ) + ! ENDIF + !ENDIF + + ! Eventually initialize/reset wetdep + IF ( Input_Opt%LConv .OR. Input_Opt%LChem .OR. Input_Opt%LWetD ) THEN + CALL Setup_WetScav( Input_Opt = Input_Opt, & + State_Chm = State_Chm(LCHNK), & + State_Grid = State_Grid(LCHNK), & + State_Met = State_Met(LCHNK), & + RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Setup_WetScav"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + ENDIF + + !============================================================== + ! ***** C O M P U T E P B L H E I G H T etc. ***** + !============================================================== + ! Move this call from the PBL mixing routines because the PBL + ! height is used by drydep and some of the emissions routines. + ! (ckeller, 3/5/15) + ! This function updates: + ! ==================================================================== + ! (1) InPbl : Logical indicating if we are in the PBL [-] + ! (2) PBL_TOP_L : Number of layers in the PBL [-] + ! (3) PBL_TOP_hPa: Pressure at the top of the PBL [hPa] + ! (4) PBL_TOP_m : PBL height [m] + ! (5) PBL_THICK : PBL thickness [hPa] + ! (6) F_OF_PBL : Fraction of grid box within the PBL [-] + ! (7) F_UNDER_PBLTOP: Fraction of grid box underneath the PBL top [-] + ! (8) PBL_MAX_L : Model level where PBL top occurs [-] + ! ==================================================================== + CALL Compute_PBL_Height( Input_Opt = Input_Opt, & + State_Grid = State_Grid(LCHNK), & + State_Met = State_Met(LCHNK), & + RC = RC ) + + ! Trap potential errors + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Compute_PBL_Height"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + !-------------------------------------------------------------- + ! Test for emission timestep + ! Now always do emissions here, even for full-mixing + ! (ckeller, 3/5/15) + !-------------------------------------------------------------- + !================================================================== + ! ***** D R Y D E P O S I T I O N ***** + !================================================================== + !================================================================== + ! Compute dry deposition velocities + ! + ! CLM computes dry deposition velocities over land. + ! We need to merge the land component passed through cam_in and + ! the ocn/ice dry deposition velocities. + ! + ! If using the CLM velocities, then use GEOS-Chem's dry deposition + ! module to compute velocities and then scale them with the ocean + ! fraction (Input_Opt%ddVel_CLM) + ! + ! A second option would be to let GEOS-Chem compute dry deposition + ! velocity, thus overwriting the input from CLM + ! + ! drydep_method must be set to DD_XLND. + ! + ! The GEOS-Chem option (.not. Input_Opt%ddVel_CLM) option coupled + ! with Input_Opt%onlineLandTypes requires that CLM passes land + ! type information (land type and leaf area index). + !================================================================== + ! + ! State_Chm expects dry deposition velocities in m/s, whereas + ! CLM returns land deposition velocities in cm/s! + ! + ! For now, dry deposition velocities are only computed for gases + ! (which is what CLM deals with). Dry deposition for aerosols is + ! work in progress. + ! + ! Thibaud M. Fritz - 27 Feb 2020 + !================================================================== + + IF ( Input_Opt%LDryD ) THEN + ! Compute the Olson landmap fields of State_Met + ! (e.g. State_Met%IREG, State_Met%ILAND, etc.) + CALL Compute_Olson_Landmap( Input_Opt = Input_Opt, & + State_Grid = State_Grid(LCHNK), & + State_Met = State_Met(LCHNK), & + RC = RC ) + + ! Trap potential errors + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Compute_Olson_Landmap"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + ! Compute State_Met%XLAI (for drydep) and State_Met%MODISLAI, + ! which is the average LAI per grid box (for soil NOx emissions) + CALL Compute_Xlai( Input_Opt = Input_Opt, & + State_Grid = State_Grid(LCHNK), & + State_Met = State_Met(LCHNK), & + RC = RC ) + + ! Trap potential errors + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Compute_Xlai"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + ! Compute drydep velocities and update State_Chm%DryDepVel + CALL Do_Drydep( Input_Opt = Input_Opt, & + State_Chm = State_Chm(LCHNK), & + State_Diag = State_Diag(LCHNK), & + State_Grid = State_Grid(LCHNK), & + State_Met = State_Met(LCHNK), & + RC = RC ) + + ! Trap potential errors + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Do_Drydep"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + +#if ( OCNDDVEL_GEOSCHEM ) + + DO N = 1, nddvels + + !! Print debug + !IF ( rootChunk ) THEN + ! IF ( N == 1 ) THEN + ! Write(iulog,*) "Number of GC dry deposition species = ", & + ! SIZE(State_Chm(LCHNK)%DryDepVel(:,:,:),3) + ! Write(iulog,*) "Number of CESM dry deposition species = ", & + ! nddvels + ! ENDIF + ! Write(iulog,*) "N = ", N + ! Write(iulog,*) "drySpc_ndx = ", drySpc_ndx(N) + ! Write(iulog,*) "GC index = ", map2GC_dryDep(N) + ! IF ( map2GC_dryDep(N) > 0 ) THEN + ! Write(iulog,*) "GC name = ", TRIM(DEPNAME(map2GC_dryDep(N))) + ! ENDIF + ! Write(iulog,*) "dry Species= ", TRIM(drydep_list(N)) + ! IF ( drySpc_ndx(N) > 0 ) THEN + ! Write(iulog,*) "tracerName = ", TRIM(tracerNames(drySpc_ndx(N))) + ! ENDIF + ! Write(iulog,*) "CLM-depVel = ", & + ! MAXVAL(cam_in%depvel(:nY,N)) * 1.0e-02_fp, " [m/s]" + ! IF ( map2GC_dryDep(N) > 0 ) THEN + ! Write(iulog,*) "GC-depVel = ", & + ! MAXVAL(State_Chm(LCHNK)%DryDepVel(1,:nY,map2GC_dryDep(N))), " [m/s]" + ! ENDIF + !ENDIF + + IF ( map2GC_dryDep(N) > 0 ) THEN + ! State_Chm%DryDepVel is in m/s + State_Chm(LCHNK)%DryDepVel(1,:nY,map2GC_dryDep(N)) = & + ! This first bit corresponds to the dry deposition + ! velocities over land as computed from CLM and + ! converted to m/s. This is scaled by the fraction + ! of land. + cam_in%depVel(:nY,N) * 1.0e-02_fp & + * MAX(0._fp, 1.0_fp - State_Met(LCHNK)%FROCEAN(1,:nY)) & + ! This second bit corresponds to the dry deposition + ! velocities over ocean and sea ice as computed from + ! GEOS-Chem. This is scaled by the fraction of ocean + ! and sea ice. + + State_Chm(LCHNK)%DryDepVel(1,:nY,map2GC_dryDep(N)) & + * State_Met(LCHNK)%FROCEAN(1,:nY) + ENDIF + ENDDO + +#endif + +#elif ( OCNDDVEL_MOZART ) + ! This routine updates the deposition velocities from CLM in the + ! pointer lnd(LCHNK)%dvel as long as drydep_method == DD_XLND is + ! True. + CALL drydep_update( State, cam_in ) + + windSpeed(:nY) = SQRT( state%U(:nY,nZ)*state%U(:nY,nZ) + & + state%V(:nY,nZ)*state%V(:nY,nZ) ) + potT(:nY) = state%t(:nY,nZ) * (1._fp + qH2O(:nY,nZ)) + + CALL get_lat_all_p( LCHNK, nY, latndx ) + CALL get_lon_all_p( LCHNK, nY, lonndx ) + + CALL drydep_fromlnd( ocnfrac = cam_in%ocnfrac(:), & + icefrac = cam_in%icefrac(:), & + ncdate = currYMD, & + sfc_temp = cam_in%TS(:), & + pressure_sfc = state%PS(:), & + wind_speed = windSpeed(:), & + spec_hum = qH2O(:,nZ), & + air_temp = state%t(:,nZ), & + pressure_10m = state%pmid(:,nZ), & + rain = State_Met(LCHNK)%PRECTOT(1,:), & + snow = cam_in%Snowhland(:), & + solar_flux = State_Met(LCHNK)%SWGDN(1,:), & + dvelocity = MOZART_depVel(:,:), & + dflx = MOZART_depFlx(:,:), & + State_Chm = State_Chm(LCHNK), & + tv = potT(:), & + soilw = -99._fp, & + rh = relHum(:,nZ), & + ncol = nY, & + lonndx = lonndx(:), & + latndx = latndx(:), & + lchnk = LCHNK ) + + DO N = 1, nddvels + + !! Print debug + !IF ( rootChunk ) THEN + ! IF ( N == 1 ) THEN + ! Write(iulog,*) "Number of GC dry deposition species = ", & + ! SIZE(State_Chm(LCHNK)%DryDepVel(:,:,:),3) + ! Write(iulog,*) "Number of CESM dry deposition species = ", & + ! nddvels + ! ENDIF + ! Write(iulog,*) "N = ", N + ! Write(iulog,*) "drySpc_ndx = ", drySpc_ndx(N) + ! Write(iulog,*) "GC index = ", map2GC_dryDep(N) + ! IF ( map2GC_dryDep(N) > 0 ) THEN + ! Write(iulog,*) "GC name = ", TRIM(DEPNAME(map2GC_dryDep(N))) + ! ENDIF + ! Write(iulog,*) "dry Species= ", TRIM(drydep_list(N)) + ! IF ( drySpc_ndx(N) > 0 ) THEN + ! Write(iulog,*) "tracerName = ", TRIM(tracerNames(drySpc_ndx(N))) + ! ENDIF + ! Write(iulog,*) "CLM-depVel = ", & + ! MAXVAL(cam_in%depvel(:nY,N)) * 1.0e-02_fp, " [m/s]", LCHNK + ! IF ( drySpc_ndx(N) > 0 ) THEN + ! Write(iulog,*) "Merged depVel = ", & + ! MAXVAL(MOZART_depVel(:nY,drySpc_ndx(N))) * 1.0e-02_fp, " [m/s]", LCHNK + ! ENDIF + !ENDIF + + IF ( ( map2GC_dryDep(N) > 0 ) .AND. ( drySpc_ndx(N) > 0 ) ) THEN + ! State_Chm%DryDepVel is in m/s + State_Chm(LCHNK)%DryDepVel(1,:nY,map2GC_dryDep(N)) = & + MOZART_depVel(:nY,drySpc_ndx(N)) * 1.0e-02_fp + ENDIF + + ENDDO + + !TMMF, Here set dry deposition velocities to zero if MAM performs its + !own deposition... + + CALL Update_DryDepFreq( Input_Opt = Input_Opt, & + State_Chm = State_Chm(LCHNK), & + State_Diag = State_Diag(LCHNK), & + State_Grid = State_Grid(LCHNK), & + State_Met = State_Met(LCHNK), & + RC = RC ) + + ENDIF + + !!=========================================================== + !! ***** E M I S S I O N S ***** + !! + !! NOTE: For a complete description of how emissions from + !! HEMCO are added into GEOS-Chem (and how they are mixed + !! into the boundary layer), please see the wiki page: + !! + !! http://wiki-geos-chem.org/Distributing_emissions_in_the_PBL + !!=========================================================== + ! + !! EMISSIONS_RUN will call HEMCO run phase 2. HEMCO run phase + !! only calculates emissions. All data has been read to disk + !! in phase 1 at the beginning of the time step. + !! (ckeller, 4/1/15) + !CALL Emissions_Run( Input_Opt = Input_Opt, & + ! State_Chm = State_Chmk(LCHNK), & + ! State_Diag = State_Diag(LCHNK), & + ! State_Grid = State_Grid(LCHNK), & + ! State_Met = State_Met(LCHNK), & + ! TimeForEmis = TimeForEmis, & + ! Phase = 2, & + ! RC = RC ) + ! + !! Trap potential errors + !IF ( RC /= GC_SUCCESS ) THEN + ! ErrMsg = + ! 'Error encountered in "Emissions_Run"! after drydep!' + ! CALL Error_Stop( ErrMsg, ThisLoc ) + !ENDIF + + !=========================================================== + ! ***** M I X E D L A Y E R M I X I N G ***** + !=========================================================== + + ! Updates from Bob Yantosca, 06/2020 + ! Compute the surface flux for the non-local mixing, + ! (which means getting emissions & drydep from HEMCO) + ! and store it in State_Chm%Surface_Flux + ! + ! For CESM-GC, Surface_Flux will be equal to the opposite of the + ! dry deposition flux since emissions are loaded externally + ! ( SurfaceFlux = eflx - dflx = - dflx ) + IF ( Input_Opt%LTURB .and. Input_Opt%LNLPBL ) THEN + CALL Compute_Sflx_For_Vdiff( Input_Opt = Input_Opt, & + State_Chm = State_Chm(LCHNK), & + State_Diag = State_Diag(LCHNK), & + State_Grid = State_Grid(LCHNK), & + State_Met = State_Met(LCHNK), & + RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Compute_Sflx_for_Vdiff"!' + CALL Error_Stop( errMsg, thisLoc ) + ENDIF + ENDIF + + !----------------------------------------------------------------------- + ! Get emissions from HEMCO + Lightning + Fire + ! Add surface emissions to cam_in + !----------------------------------------------------------------------- + + CALL CESMGC_Emissions_Calc( state = state, & + hco_pbuf2d = hco_pbuf2d, & + State_Met = State_Met(LCHNK), & + cam_in = cam_in, & + eflx = eflx, & + iStep = iStep ) + + !----------------------------------------------------------------------- + ! Add dry deposition flux + ! (stored as SurfaceFlux = -dflx) + !----------------------------------------------------------------------- + + DO ND = 1, State_Chm(BEGCHUNK)%nDryDep + ! Get the species ID from the drydep ID + N = State_Chm(BEGCHUNK)%Map_DryDep(ND) + IF ( N <= 0 ) CYCLE + + M = map2GCinv(N) + IF ( M <= 0 ) CYCLE + + cam_in%cflx(1:nY,M) = cam_in%cflx(1:nY,M) & + + State_Chm(LCHNK)%SurfaceFlux(1,1:nY,N) + ENDDO + + !----------------------------------------------------------------------- + ! Add non-surface emissions + !----------------------------------------------------------------------- + + ! Use units of kg/m2 as State_Chm%Species to add emissions fluxes + CALL Convert_Spc_Units( Input_Opt = Input_Opt, & + State_Chm = State_Chm(LCHNK), & + State_Grid = State_Grid(LCHNK), & + State_Met = State_Met(LCHNK), & + OutUnit = 'kg/m2', & + RC = RC, & + OrigUnit = OrigUnit ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Convert_Spc_Units"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + DO N = 1, pcnst + M = map2GC(N) + IF ( M > 0 ) THEN + ! Add to GEOS-Chem species + State_Chm(LCHNK)%Species(1,:nY,:nZ,M) = State_Chm(LCHNK)%Species(1,:nY,:nZ,M) & + + eflx(:nY,nZ:1:-1,N) * dT + ELSEIF ( M < 0 ) THEN + ! Add to constituent (mostly for MAM4 aerosols) + ! Convert from kg/m2/s to kg/kg/s + ptend%q(:nY,nZ:1:-1,N) = ptend%q(:nY,nZ:1:-1,N) & + + eflx(:nY,nZ:1:-1,N) & + / ( g0_100 * State_Met(LCHNK)%DELP_DRY(1,:nY,:nZ) ) + ENDIF + ENDDO + + ! Convert back to original unit + CALL Convert_Spc_Units( Input_Opt = Input_Opt, & + State_Chm = State_Chm(LCHNK), & + State_Grid = State_Grid(LCHNK), & + State_Met = State_Met(LCHNK), & + OutUnit = OrigUnit, & + RC = RC ) + + ! Convert State_Chm%Species back to original units + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Convert_Spc_Units"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + !============================================================== + ! ***** C H E M I S T R Y ***** + !============================================================== + + call t_startf( 'chemdr' ) + + ! Get the overhead column O3 for use with FAST-J + IF ( Input_Opt%Its_A_FullChem_Sim .OR. & + Input_Opt%Its_An_Aerosol_Sim ) THEN + + IF ( Input_Opt%LChem ) THEN + CALL Compute_Overhead_O3( Input_Opt = Input_Opt, & + State_Grid = State_Grid(LCHNK), & + State_Chm = State_Chm(LCHNK), & + DAY = currDy, & + USE_O3_FROM_MET = Input_Opt%Use_O3_From_Met, & + TO3 = State_Met(LCHNK)%TO3, & + RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Compute_Overhead_O3"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + ENDIF + ENDIF + + IF ( Input_Opt%Its_A_Fullchem_Sim .and. iH2O > 0 ) THEN + CALL Set_H2O_Trac( SETSTRAT = (.not. Input_Opt%LUCX), & + Input_Opt = Input_Opt, & + State_Chm = State_Chm(LCHNK), & + State_Grid = State_Grid(LCHNK), & + State_Met = State_Met(LCHNK), & + RC = RC ) + + ! Trap potential errors + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Set_H2O_Trac" #2!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + ENDIF + + ! Reset photolysis rates + ZPJ = 0.0e+0_r8 + + ! Perform chemistry + CALL Do_Chemistry( Input_Opt = Input_Opt, & + State_Chm = State_Chm(LCHNK), & + State_Diag = State_Diag(LCHNK), & + State_Grid = State_Grid(LCHNK), & + State_Met = State_Met(LCHNK), & + RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Do_Chemistry"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + + ! Make sure State_Chm(LCHNK) is back in kg/kg dry! + IF ( TRIM(State_Chm(LCHNK)%Spc_Units) /= 'kg/kg dry' ) THEN + Write(iulog,*) 'Current unit = ', TRIM(State_Chm(LCHNK)%Spc_Units) + Write(iulog,*) 'Expected unit = kg/ kg dry' + CALL ENDRUN('Incorrect unit in GEOS-Chem State_Chm%Species') + ENDIF + + ! GEOS-Chem considers CO2 as a dead species and resets its concentration + ! internally. Right after the call to `Do_Chemistry`, State_Chm%Species(iCO2) + ! corresponds to the chemically-produced CO2. The real CO2 concentration + ! is thus the concentration before chemistry + the chemically-produced CO2. + State_Chm(LCHNK)%Species(1,:nY,:nZ,iCO2) = State_Chm(LCHNK)%Species(1,:nY,:nZ,iCO2) & + + MMR_Beg(:nY,:nZ,iCO2) + + call t_stopf( 'chemdr' ) + + !============================================================== + ! ***** W E T D E P O S I T I O N (rainout + washout) ***** + !============================================================== + IF ( Input_Opt%LWetD ) THEN + + IF ( gas_wetdep_method == 'NEU' ) THEN + CALL Neu_wetdep_tend( LCHNK = LCHNK, & + NCOL = NCOL, & + mmr = state%q, & + pmid = state%pmid, & + pdel = state%pdel, & + zint = state%zi, & + tfld = state%t, & + delt = dT, & + prain = PRain, & + nevapr = NEvapr, & + cld = cldFrc, & + cmfdqr = cmfdqr, & + wd_tend = ptend%q, & + wd_tend_int = wetdepflx ) + ELSE + ErrMsg = 'Unknown gas_wetdep_method '//TRIM(gas_wetdep_method) + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + ENDIF + + DO N = 1, gas_pcnst + ! See definition of map2chm + M = map2chm(N) + IF ( M > 0 ) THEN + vmr1(:nY,:nZ,N) = State_Chm(LCHNK)%Species(1,:nY,nZ:1:-1,M) * & + MWDry / adv_mass(N) + ELSEIF ( M < 0 ) THEN + vmr1(:nY,:nZ,N) = state%q(:nY,:nZ,-M) * & + MWDry / adv_mass(N) + ENDIF + ENDDO + + !============================================================== + ! ***** M A M G A S - A E R O S O L E X C H A N G E ***** + !============================================================== + +#if defined( MODAL_AERO ) + + del_h2so4_gasprod = 0.0e+00_fp + ! This needs to be in mol/mol over this timestep + IF ( ( iPSO4 > 0 ) .and. ( MWPSO4 > 0.0e+00_fp ) ) THEN + DO L = 1, nZ + ! Convert from kg SO4/kg to mol/mol + del_h2so4_gasprod(:nY,L) = & + State_Chm(LCHNK)%Species(1,:nY,nZ+1-L,iPSO4) * MWDry / MWPSO4 + ENDDO + ENDIF + + call aero_model_gasaerexch( loffset = iFirstCnst - 1, & + ncol = NCOL, & + lchnk = LCHNK, & + troplev = Trop_Lev(:), & + delt = dT, & + reaction_rates = reaction_rates, & + tfld = state%t(:,:), & + pmid = state%pmid(:,:), & + pdel = state%pdel(:,:), & + mbar = mBar, & + relhum = relHum(:,:), & + zm = state%zm(:,:), & + qh2o = qH2O(:,:), & + cwat = cldW, & + cldfr = cldFrc, & + cldnum = nCldWtr, & + airdens = invariants(:,:,indexm), & + invariants = invariants, & + del_h2so4_gasprod = del_h2so4_gasprod, & + vmr0 = vmr0, & + vmr = vmr1, & + pbuf = pbuf ) +#endif + + ! Set boundary conditions of long-lived species (most likely + ! CH4, OCS, N2O, CFC11, CFC12). + ! Note: This will overwrite the UCX boundary conditions + + CALL flbc_set( vmr1(:nY,:nZ,:), nY, LCHNK, mapCnst ) + + IF ( ghg_chem ) THEN + CALL ghg_chem_set_flbc( vmr1, nY ) + ENDIF + + DO N = 1, gas_pcnst + ! See definition of map2chm + M = map2chm(N) + IF ( M <= 0 ) CYCLE + State_Chm(LCHNK)%Species(1,:nY,nZ:1:-1,M) = vmr1(:nY,:nZ,N) * & + adv_mass(N) / MWDry + ENDDO + + ! Make sure State_Chm(LCHNK) is back in kg/kg dry! + IF ( TRIM(State_Chm(LCHNK)%Spc_Units) /= 'kg/kg dry' ) THEN + Write(iulog,*) 'Current unit = ', TRIM(State_Chm(LCHNK)%Spc_Units) + Write(iulog,*) 'Expected unit = kg/ kg dry' + CALL ENDRUN('Incorrect unit in GEOS-Chem State_Chm%Species') + ENDIF + + ! Reset H2O MMR to the initial value (no chemistry tendency in H2O just yet) + State_Chm(LCHNK)%Species(1,:,:,iH2O) = MMR_Beg(:,:,iH2O) + + ! Store unadvected species data + SlsData = 0.0e+0_r8 + DO N = 1, nSls + M = map2GC_Sls(N) + IF ( M <= 0 ) CYCLE + SlsData(:nY,nZ:1:-1,N) = REAL(State_Chm(LCHNK)%Species(1,:nY,:nZ,M),r8) + ENDDO + CALL set_short_lived_species( SlsData, LCHNK, nY, pbuf ) + + DO N = 1, pcnst + M = map2GC(N) + IF ( M <= 0 ) CYCLE + ! Add change in mass mixing ratio to tendencies. + ! For NEU wet deposition, the wet removal rates are added to + ! ptend. + MMR_End(:nY,:nZ,M) = REAL(State_Chm(LCHNK)%Species(1,:nY,:nZ,M),r8) + ptend%q(:nY,nZ:1:-1,N) = ptend%q(:nY,nZ:1:-1,N) & + + (MMR_End(:nY,:nZ,M)-MMR_Beg(:nY,:nZ,M))/dT + ENDDO + +#if defined( MODAL_AERO_4MODE ) + ! Here apply tendencies to MAM aerosols + ! Initial mass in bin SM is stored as state%q(N) + ! Final mass in bin SM is stored as binRatio(SM,M) * State_Chm(P) + ! + ! We decide to apply chemical tendencies to all MAM aerosols, + ! except so4, for which the chemically-produced sulfate gets + ! partitioned in aero_model_gasaerexch + DO M = 1, ntot_amode + DO SM = 1, nspec_amode(M) + P = map2MAM4(SM,M) + IF ( P <= 0 .OR. to_upper(xname_massptr(SM,M)(:3)) == 'SO4' ) CYCLE + N = lmassptr_amode(SM,M) + ! Apply MAM4 chemical tendencies owing to GEOS-Chem aerosol processing + ptend%q(:nY,:nZ,N) = ptend%q(:nY,:nZ,N) & + + (binRatio(SM,M,:nY,:nZ) * & + REAL(State_Chm(LCHNK)%Species(1,:nY,nZ:1:-1,P),r8) & + - state%q(:nY,:nZ,N))/dT + ENDDO + ENDDO +#endif + + DO N = 1, gas_pcnst + ! See definition of map2chm + M = map2chm(N) + IF ( M > 0 ) THEN + mmr_tend(:nY,:nZ,N) = ( REAL(State_Chm(LCHNK)%Species(1,:nY,nZ:1:-1,M),r8) - mmr_tend(:nY,:nZ,N) ) / dT + ELSEIF ( M < 0 ) THEN + mmr_tend(:nY,:nZ,N) = ptend%q(:nY,:nZ,-M) + ENDIF + ENDDO + + IF ( Input_Opt%applyQtend ) THEN + ! Apply GEOS-Chem's H2O mixing ratio tendency to CAM's specific humidity + ! This requires to set lq(cQ) = lq(cH2O) ( = .True. ) + ptend%q(:,:,cQ) = ptend%q(:,:,cH2O) + ENDIF + + CALL CESMGC_Diag_Calc( Input_Opt = Input_Opt, & + State_Chm = State_Chm(LCHNK), & + State_Diag = State_Diag(LCHNK), & + State_Grid = State_Grid(LCHNK), & + State_Met = State_Met(LCHNK), & + cam_in = cam_in, & + state = state, & + mmr_tend = mmr_tend, & + LCHNK = LCHNK ) + + IF ( ghg_chem ) THEN + ptend%lq(1) = .True. + CALL outfld( 'CT_H2O_GHG', ptend%q(:,:,1), PCOLS, LCHNK ) + ENDIF + + ! Debug statements + ! Ozone tendencies + IF ( rootChunk ) THEN + Write(iulog,*) " MMR_Beg = ", MMR_Beg(1,:,iO3) + Write(iulog,*) " MMR_End = ", MMR_End(1,:,iO3) + ENDIF + + IF (PRESENT(fh2o)) THEN + fh2o(:nY) = 0.0e+0_r8 + !DO L = 1, nZ + ! fh2o(:nY) = fh2o(:nY) + ptend%q(:nY,L,iH2O)*state%pdel(:nY,L)/Gravit + !ENDDO + ENDIF + + ! Nullify all pointers + Nullify(PblH ) + Nullify(Fsds ) + Nullify(PRain ) + Nullify(LsFlxSnw) + Nullify(LsFlxPrc) + Nullify(cldTop ) + Nullify(cldFrc ) + Nullify(NEvapr ) + Nullify(cmfdqr ) + + IF ( rootChunk ) WRITE(iulog,*) ' GEOS-Chem Chemistry step ', iStep, ' completed' + IF ( lastChunk ) WRITE(iulog,*) ' Chemistry completed on all chunks completed of MasterProc' + + end subroutine chem_timestep_tend + +!=============================================================================== + + subroutine chem_init_cnst(name, latvals, lonvals, mask, q) + + CHARACTER(LEN=*), INTENT(IN) :: name ! constituent name + 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(OUT) :: q(:,:) ! kg tracer/kg dry air (NCOL, PVER) + ! Used to initialize tracer fields if desired. + ! Will need a simple mapping structure as well as the CAM tracer registration + ! routines. + + INTEGER :: ILEV, NLEV, I + REAL(r8) :: QTemp, Min_MMR + + nlev = SIZE(q, 2) + + ! Retrieve a "background value" for this from the database + Min_MMR = 1.0e-38_r8 + CALL cnst_get_ind(TRIM(name), M, abort=.False.) + IF ( M > 0 ) Min_MMR = ref_MMR(M) + + DO ilev = 1, nlev + WHERE(mask) + ! Set to the minimum mixing ratio + q(:,ilev) = Min_MMR + END WHERE + ENDDO + + end subroutine chem_init_cnst + +!=============================================================================== + + subroutine chem_final + + use Input_Opt_Mod, only : Cleanup_Input_Opt + use State_Chm_Mod, only : Cleanup_State_Chm + use State_Diag_Mod, only : Cleanup_State_Diag + use State_Grid_Mod, only : Cleanup_State_Grid + use State_Met_Mod, only : Cleanup_State_Met + use Error_Mod, only : Cleanup_Error + + use FlexChem_Mod, only : Cleanup_FlexChem + use UCX_Mod, only : Cleanup_UCX + use Drydep_Mod, only : Cleanup_Drydep + use Carbon_Mod, only : Cleanup_Carbon + use Dust_Mod, only : Cleanup_Dust + use Seasalt_Mod, only : Cleanup_Seasalt + use Aerosol_Mod, only : Cleanup_Aerosol + use Sulfate_Mod, only : Cleanup_Sulfate + use Pressure_Mod, only : Cleanup_Pressure + use Strat_Chem_Mod, only : Cleanup_Strat_Chem + + use CMN_Size_Mod, only : Cleanup_CMN_Size + use CMN_FJX_Mod, only : Cleanup_CMN_FJX + +#ifdef BPCH_DIAG + use CMN_O3_Mod, only : Cleanup_CMN_O3 + ! Special: cleans up after NDXX_Setup + use Diag_Mod, only : Cleanup_Diag +#endif + + use CESMGC_Emissions_Mod, only: CESMGC_Emissions_Final + + ! Local variables + INTEGER :: I, RC + + ! Finalize GEOS-Chem + + CALL Cleanup_UCX + CALL Cleanup_Aerosol + CALL Cleanup_Carbon + CALL Cleanup_Drydep + CALL Cleanup_Dust + CALL Cleanup_FlexChem( RC ) + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Cleanup_FlexChem"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + CALL Cleanup_Pressure + CALL Cleanup_Seasalt + CALL Cleanup_Sulfate + CALL Cleanup_Strat_Chem + + CALL CESMGC_Emissions_Final + + CALL Cleanup_CMN_SIZE( RC ) + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Cleanup_CMN_SIZE"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + CALL Cleanup_CMN_FJX( RC ) + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Cleanup_CMN_FJX"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + +#ifdef BPCH_DIAG + CALL Cleanup_Diag + + ! Call extra cleanup routines, from modules in Headers/ + CALL Cleanup_CMN_O3( RC ) + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Cleanup_CMN_O3"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF +#endif + + ! Cleanup Input_Opt + CALL Cleanup_Input_Opt( Input_Opt, RC ) + + ! Loop over each chunk and cleanup the variables + DO I = BEGCHUNK, ENDCHUNK + CALL Cleanup_State_Chm ( State_Chm(I), RC ) + CALL Cleanup_State_Diag( State_Diag(I), RC ) + CALL Cleanup_State_Grid( State_Grid(I), RC ) + CALL Cleanup_State_Met ( State_Met(I), RC ) + ENDDO + CALL Cleanup_Error + + ! Finally deallocate state variables + IF ( ALLOCATED( State_Chm ) ) DEALLOCATE( State_Chm ) + IF ( ALLOCATED( State_Diag ) ) DEALLOCATE( State_Diag ) + IF ( ALLOCATED( State_Grid ) ) DEALLOCATE( State_Grid ) + IF ( ALLOCATED( State_Met ) ) DEALLOCATE( State_Met ) + + IF ( ALLOCATED( slvd_Lst ) ) DEALLOCATE( slvd_Lst ) + IF ( ALLOCATED( slvd_ref_MMR ) ) DEALLOCATE( slvd_ref_MMR ) + + + RETURN + + end subroutine chem_final + +!=============================================================================== + + subroutine chem_init_restart(File) + use tracer_cnst, only: init_tracer_cnst_restart + use tracer_srcs, only: init_tracer_srcs_restart + use pio, only : file_desc_t + + IMPLICIT NONE + + TYPE(file_desc_t) :: File + + IF (MasterProc) WRITE(iulog,'(a)') 'GCCALL CHEM_INIT_RESTART' + + ! + ! data for offline tracers + ! + call init_tracer_cnst_restart(File) + call init_tracer_srcs_restart(File) + !call init_linoz_data_restart(File) + + end subroutine chem_init_restart + +!=============================================================================== + + subroutine chem_write_restart( File ) + use tracer_cnst, only: write_tracer_cnst_restart + use tracer_srcs, only: write_tracer_srcs_restart + !use linoz_data, only: write_linoz_data_restart + use pio, only : file_desc_t + + IMPLICIT NONE + + TYPE(file_desc_t) :: File + + IF ( MasterProc ) WRITE(iulog,'(a)') 'GCCALL CHEM_WRITE_RESTART' + ! + ! data for offline tracers + ! + call write_tracer_cnst_restart(File) + call write_tracer_srcs_restart(File) + !call write_linoz_data_restart(File) + end subroutine chem_write_restart + +!=============================================================================== + + subroutine chem_read_restart( File ) + use tracer_cnst, only: read_tracer_cnst_restart + use tracer_srcs, only: read_tracer_srcs_restart + !use linoz_data, only: read_linoz_data_restart + use pio, only : file_desc_t + + IMPLICIT NONE + + TYPE(file_desc_t) :: File + + IF ( MasterProc ) WRITE(iulog,'(a)') 'GCCALL CHEM_READ_RESTART' + ! + ! data for offline tracers + ! + call read_tracer_cnst_restart(File) + call read_tracer_srcs_restart(File) + !call read_linoz_data_restart(File) + end subroutine chem_read_restart + +!================================================================================ + + subroutine chem_emissions( state, cam_in ) + + use camsrfexch, only : cam_in_t + + ! Arguments: + + TYPE(physics_state), INTENT(IN) :: state ! Physics state variables + TYPE(cam_in_t), INTENT(INOUT) :: cam_in ! import state + + INTEGER :: M, N + INTEGER :: LCHNK, nY + LOGICAL :: rootChunk + + + ! LCHNK: which chunk we have on this process + LCHNK = state%LCHNK + ! NCOL: number of atmospheric columns on this chunk + nY = state%NCOL + rootChunk = ( MasterProc.and.(LCHNK.EQ.BEGCHUNK) ) + + sflx(:,:) = 0.0e+0_r8 + + DO N = 1, nTracers + + fldname_ns = 'HCO_' // TRIM(tracerNames(N)) + tmpIdx = pbuf_get_index(fldname_ns, RC) + IF ( tmpIdx < 0 ) THEN + IF ( rootChunk ) Write(iulog,*) "chem_emissions hemco: Field not found ", TRIM(fldname_ns) + ELSE + ! This is already in chunk, retrieve it + pbuf_chnk => pbuf_get_chunk(hco_pbuf2d, LCHNK) + CALL pbuf_get_field(pbuf_chnk, tmpIdx, pbuf_ik) + + IF ( .NOT. ASSOCIATED(pbuf_ik) ) THEN ! Sanity check + CALL ENDRUN("chem_emissions: FATAL - tmpIdx > 0 but pbuf_ik not associated") + ENDIF + + ! For each column retrieve data from pbuf_ik(I,K) + sflx(1:ncol,N) = pbuf_ik(1:ncol,pver) ! Only surface emissions for now, + + ! Reset pointers + pbuf_ik => NULL() + pbuf_chnk => NULL() + + M = map2GCinv(N) + + IF ( M <= 0 ) CYCLE + + cam_in%cflx(1:ncol,M) = sflx(1:ncol,N) + If ( MAXVAL(sflx(1:ncol,N)) > 0.0e+0_fp ) & + Write(iulog,*) "chem_emissions: debug added emiss for ", & + TRIM(cnst_name(M)), MAXVAL(sflx(1:ncol,N)), " from ", TRIM(fldname_ns), & + ". Total emission flux is: ", MAXVAL(cam_in%cflx(1:ncol,M)) + ENDIF + ENDDO + + end subroutine chem_emissions + +!=============================================================================== + +end module chemistry diff --git a/src/chemistry/pp_geoschem/clybry_fam.F90 b/src/chemistry/geoschem/clybry_fam.F90 similarity index 100% rename from src/chemistry/pp_geoschem/clybry_fam.F90 rename to src/chemistry/geoschem/clybry_fam.F90 diff --git a/src/chemistry/pp_geoschem/epp_ionization.F90 b/src/chemistry/geoschem/epp_ionization.F90 similarity index 100% rename from src/chemistry/pp_geoschem/epp_ionization.F90 rename to src/chemistry/geoschem/epp_ionization.F90 diff --git a/src/chemistry/geoschem/fire_emissions.F90 b/src/chemistry/geoschem/fire_emissions.F90 new file mode 120000 index 0000000000..7b9f50ff22 --- /dev/null +++ b/src/chemistry/geoschem/fire_emissions.F90 @@ -0,0 +1 @@ +../mozart/fire_emissions.F90 \ No newline at end of file diff --git a/src/chemistry/geoschem/gas_wetdep_opts.F90 b/src/chemistry/geoschem/gas_wetdep_opts.F90 new file mode 100644 index 0000000000..908e352239 --- /dev/null +++ b/src/chemistry/geoschem/gas_wetdep_opts.F90 @@ -0,0 +1,79 @@ +!----------------------------------------------------------------------- +! Reads namelist options for gas-phase wet deposition +! +! Created by Francis Vitt -- 22 Apr 2011 +!----------------------------------------------------------------------- +module gas_wetdep_opts + + use constituents, only : pcnst + use cam_logfile, only : iulog + use constituents, only : pcnst + use spmd_utils, only : masterproc + use cam_abortutils, only : endrun + + implicit none + + character(len=16), protected :: gas_wetdep_list(pcnst) = ' ' + character(len=9), protected :: gas_wetdep_method = 'MOZ' + integer, protected :: gas_wetdep_cnt = 0 + +contains + + !----------------------------------------------------------------------- + !----------------------------------------------------------------------- + + subroutine gas_wetdep_readnl(nlfile) + + use cam_abortutils, only: endrun + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit +#ifdef SPMD + use mpishorthand, only: mpichar, mpicom +#endif + + implicit none + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + integer :: unitn, i, ierr + + namelist /wetdep_inparm/ gas_wetdep_list + namelist /wetdep_inparm/ gas_wetdep_method + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'wetdep_inparm', status=ierr) + if (ierr == 0) then + read(unitn, wetdep_inparm, iostat=ierr) + if (ierr /= 0) then + call endrun('mo_neu_wetdep->wetdep_readnl: ERROR reading wetdep_inparm namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + +#ifdef SPMD + call mpibcast (gas_wetdep_list, len(gas_wetdep_list(1))*pcnst, mpichar, 0, mpicom) + call mpibcast (gas_wetdep_method, len(gas_wetdep_method), mpichar, 0, mpicom) +#endif + + gas_wetdep_cnt = 0 + do i = 1,pcnst + if ( len_trim(gas_wetdep_list(i)) > 0 ) then + gas_wetdep_cnt = gas_wetdep_cnt + 1 + endif + enddo + + if (( gas_wetdep_cnt>0 ).and. & + ( .not.(gas_wetdep_method=='MOZ' .or. & + gas_wetdep_method=='NEU' .or. & + gas_wetdep_method=='GEOS-CHEM' .or. & + gas_wetdep_method=='OFF') )) then + call endrun('gas_wetdep_readnl; gas_wetdep_method must be set to either MOZ, NEU or GEOS-CHEM') + endif + + end subroutine gas_wetdep_readnl + +end module gas_wetdep_opts diff --git a/src/chemistry/pp_geoschem/getLandTypes.F90 b/src/chemistry/geoschem/getLandTypes.F90 similarity index 100% rename from src/chemistry/pp_geoschem/getLandTypes.F90 rename to src/chemistry/geoschem/getLandTypes.F90 diff --git a/src/chemistry/geoschem/m_spc_id.F90 b/src/chemistry/geoschem/m_spc_id.F90 new file mode 100644 index 0000000000..14a949048d --- /dev/null +++ b/src/chemistry/geoschem/m_spc_id.F90 @@ -0,0 +1,3 @@ + module m_spc_id + implicit none + end module m_spc_id diff --git a/src/chemistry/pp_geoschem/mo_apex.F90 b/src/chemistry/geoschem/mo_apex.F90 similarity index 100% rename from src/chemistry/pp_geoschem/mo_apex.F90 rename to src/chemistry/geoschem/mo_apex.F90 diff --git a/src/chemistry/geoschem/mo_chem_utls.F90 b/src/chemistry/geoschem/mo_chem_utls.F90 new file mode 100644 index 0000000000..43e2d7317e --- /dev/null +++ b/src/chemistry/geoschem/mo_chem_utls.F90 @@ -0,0 +1,180 @@ + +module mo_chem_utls + + private + public :: get_spc_ndx + public :: get_inv_ndx + public :: get_extfrc_ndx + public :: get_rxt_ndx + public :: utls_chem_is + !, get_het_ndx + + save + +contains + + integer function get_spc_ndx( spc_name ) + !----------------------------------------------------------------------- + ! ... return overall species index associated with spc_name + !----------------------------------------------------------------------- + + use chem_mods, only : gas_pcnst + use mo_tracname, only : tracnam => solsym + use string_utils, only : to_upper + + implicit none + + !----------------------------------------------------------------------- + ! ... dummy arguments + !----------------------------------------------------------------------- + character(len=*), intent(in) :: spc_name + + !----------------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------------- + integer :: m + + get_spc_ndx = -1 + do m = 1, gas_pcnst + if( trim( to_upper( spc_name ) ) == trim( to_upper( tracnam(m) ) ) ) then + get_spc_ndx = m + exit + end if + end do + + end function get_spc_ndx + + integer function get_inv_ndx( invariant ) + !----------------------------------------------------------------------- + ! ... return overall external frcing index associated with spc_name + !----------------------------------------------------------------------- + + use chem_mods, only : nfs, inv_lst + + implicit none + + !----------------------------------------------------------------------- + ! ... dummy arguments + !----------------------------------------------------------------------- + character(len=*), intent(in) :: invariant + + !----------------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------------- + integer :: m + + get_inv_ndx = -1 + do m = 1,nfs + if( trim( invariant ) == trim( inv_lst(m) ) ) then + get_inv_ndx = m + exit + end if + end do + + end function get_inv_ndx + + logical function utls_chem_is (name) result(chem_is) + use string_utils, only : to_lower + + character(len=*), intent(in) :: name + chem_is = .false. + if (( to_lower(name) == 'geoschem' ) .or. & + ( to_lower(name) == 'geos-chem' )) then + chem_is = .true. + endif + + end function utls_chem_is +! +! integer function get_het_ndx( het_name ) +! !----------------------------------------------------------------------- +! ! ... return overall het process index associated with spc_name +! !----------------------------------------------------------------------- +! +! use gas_wetdep_opts,only : gas_wetdep_method, gas_wetdep_list, gas_wetdep_cnt +! +! implicit none +! +! !----------------------------------------------------------------------- +! ! ... dummy arguments +! !----------------------------------------------------------------------- +! character(len=*), intent(in) :: het_name +! +! !----------------------------------------------------------------------- +! ! ... local variables +! !----------------------------------------------------------------------- +! integer :: m +! +! get_het_ndx=-1 +! +! do m=1,gas_wetdep_cnt +! +! if( trim( het_name ) == trim( gas_wetdep_list(m) ) ) then +! get_het_ndx = get_spc_ndx( gas_wetdep_list(m) ) +! return +! endif +! +! enddo +! +! end function get_het_ndx +! + integer function get_extfrc_ndx( frc_name ) + !----------------------------------------------------------------------- + ! ... return overall external frcing index associated with spc_name + !----------------------------------------------------------------------- + + use chem_mods, only : extcnt, extfrc_lst + + implicit none + + !----------------------------------------------------------------------- + ! ... dummy arguments + !----------------------------------------------------------------------- + character(len=*), intent(in) :: frc_name + + !----------------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------------- + integer :: m + + get_extfrc_ndx = -1 + if( extcnt > 0 ) then + do m = 1,max(1,extcnt) + if( trim( frc_name ) == trim( extfrc_lst(m) ) ) then + get_extfrc_ndx = m + exit + end if + end do + end if + + end function get_extfrc_ndx + + integer function get_rxt_ndx( rxt_tag ) + !----------------------------------------------------------------------- + ! ... return overall external frcing index associated with spc_name + !----------------------------------------------------------------------- + + use chem_mods, only : rxt_tag_cnt, rxt_tag_lst, rxt_tag_map + + implicit none + + !----------------------------------------------------------------------- + ! ... dummy arguments + !----------------------------------------------------------------------- + character(len=*), intent(in) :: rxt_tag + + !----------------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------------- + integer :: m + + get_rxt_ndx = -1 + do m = 1,rxt_tag_cnt + if( trim( rxt_tag ) == trim( rxt_tag_lst(m) ) ) then + get_rxt_ndx = rxt_tag_map(m) + exit + end if + end do + + end function get_rxt_ndx + +end module mo_chem_utls diff --git a/src/chemistry/pp_geoschem/mo_drydep.F90 b/src/chemistry/geoschem/mo_drydep.F90 similarity index 94% rename from src/chemistry/pp_geoschem/mo_drydep.F90 rename to src/chemistry/geoschem/mo_drydep.F90 index 50656ef30b..66f4b122f0 100644 --- a/src/chemistry/pp_geoschem/mo_drydep.F90 +++ b/src/chemistry/geoschem/mo_drydep.F90 @@ -37,6 +37,10 @@ module mo_drydep module procedure dvel_inti_fromlnd end interface + interface drydep_inti_landuse + module procedure dvel_inti_xactive_landuse + end interface + interface drydep !module procedure drydep_table module procedure drydep_xactive @@ -45,6 +49,7 @@ module mo_drydep private public :: drydep_inti, drydep, set_soilw, chk_soilw, has_drydep + public :: drydep_inti_landuse public :: drydep_update public :: drydep_fromlnd public :: n_land_type, fraction_landuse, drydep_srf_file @@ -2043,6 +2048,192 @@ subroutine dvel_inti_xactive( depvel_lnd_file, clim_soilw_file, season_wes_file end subroutine dvel_inti_xactive + subroutine dvel_inti_xactive_landuse( depvel_lnd_file, clim_soilw_file ) + !------------------------------------------------------------------------------------- + ! ... intialize interactive drydep + !------------------------------------------------------------------------------------- + use dycore, only : dycore_is + use mo_constants, only : r2d + use chem_mods, only : adv_mass + use mo_chem_utls, only : get_spc_ndx ! Replaced, TMMF + use seq_drydep_mod,only : drydep_method, DD_XATM, DD_XLND + use phys_control, only : phys_getopts + + implicit none + + !------------------------------------------------------------------------------------- + ! ... dummy arguments + !------------------------------------------------------------------------------------- + character(len=*), intent(in) :: depvel_lnd_file, clim_soilw_file + + !------------------------------------------------------------------------------------- + ! ... local variables + !------------------------------------------------------------------------------------- + integer :: i, j, ii, jj, jl, ju + integer :: nlon_veg, nlat_veg, npft_veg + integer :: nlat_lai, npft_lai, pos_min, imin + integer :: dimid + integer :: m, n, l, id + integer :: length1, astat + integer :: k, num_max, k_max + integer :: num_seas(5) + integer :: plon, plat + integer :: ierr, ndx + + real(r8) :: spc_mass + real(r8) :: diff_min, target_lat + real(r8), allocatable :: vegetation_map(:,:,:) + real(r8), pointer :: soilw_map(:,:,:) + real(r8), allocatable :: work(:,:) + real(r8), allocatable :: landmask(:,:) + real(r8), allocatable :: urban(:,:) + real(r8), allocatable :: lake(:,:) + real(r8), allocatable :: wetland(:,:) + real(r8), allocatable :: lon_veg(:) + real(r8), allocatable :: lon_veg_edge(:) + real(r8), allocatable :: lat_veg(:) + real(r8), allocatable :: lat_veg_edge(:) + character(len=32) :: test_name + character(len=4) :: tag_name + type(file_desc_t) :: piofile + type(var_desc_t) :: vid + logical :: do_soilw + + character(len=shr_kind_cl) :: locfn + logical :: prog_modal_aero + + ! determine if modal aerosols are active so that fraction_landuse array is initialized for modal aerosal dry dep + call phys_getopts(prog_modal_aero_out=prog_modal_aero) + + call dvel_inti_fromlnd() + + !--------------------------------------------------------------------------- + ! ... allocate module variables + !--------------------------------------------------------------------------- + if (drydep_method == DD_XLND .and. (.not.prog_modal_aero)) then + return + endif + + do_soilw = .not. dyn_soilw + allocate( fraction_landuse(pcols,n_land_type, begchunk:endchunk),stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'dvel_inti: failed to allocate fraction_landuse; error = ',astat + call endrun + end if + if(do_soilw) then + allocate(soilw_3d(pcols,12,begchunk:endchunk),stat=astat) + if( astat /= 0 ) then + write(iulog,*) 'dvel_inti: failed to allocate soilw_3d error = ',astat + call endrun + end if + end if + + plon = get_dyn_grid_parm('plon') + plat = get_dyn_grid_parm('plat') + if(dycore_is('UNSTRUCTURED') ) then + call get_landuse_and_soilw_from_file(do_soilw) + else + !--------------------------------------------------------------------------- + ! ... read landuse map + !--------------------------------------------------------------------------- + call getfil (depvel_lnd_file, locfn, 0) + call cam_pio_openfile (piofile, trim(locfn), PIO_NOWRITE) + !--------------------------------------------------------------------------- + ! ... get the dimensions + !--------------------------------------------------------------------------- + ierr = pio_inq_dimid( piofile, 'lon', dimid ) + ierr = pio_inq_dimlen( piofile, dimid, nlon_veg ) + ierr = pio_inq_dimid( piofile, 'lat', dimid ) + ierr = pio_inq_dimlen( piofile, dimid, nlat_veg ) + ierr = pio_inq_dimid( piofile, 'pft', dimid ) + ierr = pio_inq_dimlen( piofile, dimid, npft_veg ) + !--------------------------------------------------------------------------- + ! ... allocate arrays + !--------------------------------------------------------------------------- + allocate( vegetation_map(nlon_veg,nlat_veg,npft_veg), work(nlon_veg,nlat_veg), stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'dvel_inti: failed to allocate vegation_map; error = ',astat + call endrun + end if + allocate( urban(nlon_veg,nlat_veg), lake(nlon_veg,nlat_veg), & + landmask(nlon_veg,nlat_veg), wetland(nlon_veg,nlat_veg), stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'dvel_inti: failed to allocate vegation_map; error = ',astat + call endrun + end if + allocate( lon_veg(nlon_veg), lat_veg(nlat_veg), & + lon_veg_edge(nlon_veg+1), lat_veg_edge(nlat_veg+1), stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'dvel_inti: failed to allocate vegation lon, lat arrays; error = ',astat + call endrun + end if + !--------------------------------------------------------------------------- + ! ... read the vegetation map and landmask + !--------------------------------------------------------------------------- + ierr = pio_inq_varid( piofile, 'PCT_PFT', vid ) + ierr = pio_get_var( piofile, vid, vegetation_map ) + + ierr = pio_inq_varid( piofile, 'LANDMASK', vid ) + ierr = pio_get_var( piofile, vid, landmask ) + + ierr = pio_inq_varid( piofile, 'PCT_URBAN', vid ) + ierr = pio_get_var( piofile, vid, urban ) + + ierr = pio_inq_varid( piofile, 'PCT_LAKE', vid ) + ierr = pio_get_var( piofile, vid, lake ) + + ierr = pio_inq_varid( piofile, 'PCT_WETLAND', vid ) + ierr = pio_get_var( piofile, vid, wetland ) + + call cam_pio_closefile( piofile ) + + !--------------------------------------------------------------------------- + ! scale vegetation, urban, lake, and wetland to fraction + !--------------------------------------------------------------------------- + vegetation_map(:,:,:) = .01_r8 * vegetation_map(:,:,:) + wetland(:,:) = .01_r8 * wetland(:,:) + lake(:,:) = .01_r8 * lake(:,:) + urban(:,:) = .01_r8 * urban(:,:) +#ifdef DEBUG + if(masterproc) then + write(iulog,*) 'minmax vegetation_map ',minval(vegetation_map),maxval(vegetation_map) + write(iulog,*) 'minmax wetland ',minval(wetland),maxval(wetland) + write(iulog,*) 'minmax landmask ',minval(landmask),maxval(landmask) + end if +#endif + !--------------------------------------------------------------------------- + ! ... define lat-lon of vegetation map (1x1) + !--------------------------------------------------------------------------- + lat_veg(:) = (/ (-89.5_r8 + (i-1),i=1,nlat_veg ) /) + lon_veg(:) = (/ ( 0.5_r8 + (i-1),i=1,nlon_veg ) /) + lat_veg_edge(:) = (/ (-90.0_r8 + (i-1),i=1,nlat_veg+1) /) + lon_veg_edge(:) = (/ ( 0.0_r8 + (i-1),i=1,nlon_veg+1) /) + !--------------------------------------------------------------------------- + ! ... read soilw table if necessary + !--------------------------------------------------------------------------- + + if( do_soilw ) then + call soilw_inti( clim_soilw_file, nlon_veg, nlat_veg, soilw_map ) + end if + + !--------------------------------------------------------------------------- + ! ... regrid to model grid + !--------------------------------------------------------------------------- + + call interp_map( plon, plat, nlon_veg, nlat_veg, npft_veg, lat_veg, lat_veg_edge, & + lon_veg, lon_veg_edge, landmask, urban, lake, & + wetland, vegetation_map, soilw_map, do_soilw ) + + deallocate( vegetation_map, work, stat=astat ) + deallocate( lon_veg, lat_veg, lon_veg_edge, lat_veg_edge, stat=astat ) + deallocate( landmask, urban, lake, wetland, stat=astat ) + if( do_soilw ) then + deallocate( soilw_map, stat=astat ) + end if + endif ! Unstructured grid + + end subroutine dvel_inti_xactive_landuse + !------------------------------------------------------------------------------------- subroutine get_landuse_and_soilw_from_file(do_soilw) use ncdio_atm, only : infld diff --git a/src/chemistry/pp_geoschem/mo_gas_phase_chemdr.F90 b/src/chemistry/geoschem/mo_gas_phase_chemdr.F90 similarity index 100% rename from src/chemistry/pp_geoschem/mo_gas_phase_chemdr.F90 rename to src/chemistry/geoschem/mo_gas_phase_chemdr.F90 diff --git a/src/chemistry/geoschem/mo_ghg_chem.F90 b/src/chemistry/geoschem/mo_ghg_chem.F90 new file mode 120000 index 0000000000..f8a8b4ba4c --- /dev/null +++ b/src/chemistry/geoschem/mo_ghg_chem.F90 @@ -0,0 +1 @@ +../mozart/mo_ghg_chem.F90 \ No newline at end of file diff --git a/src/chemistry/geoschem/mo_lightning.F90 b/src/chemistry/geoschem/mo_lightning.F90 new file mode 120000 index 0000000000..8b731ae98f --- /dev/null +++ b/src/chemistry/geoschem/mo_lightning.F90 @@ -0,0 +1 @@ +../mozart/mo_lightning.F90 \ No newline at end of file diff --git a/src/chemistry/geoschem/mo_mean_mass.F90 b/src/chemistry/geoschem/mo_mean_mass.F90 new file mode 120000 index 0000000000..e4231e65f7 --- /dev/null +++ b/src/chemistry/geoschem/mo_mean_mass.F90 @@ -0,0 +1 @@ +../mozart/mo_mean_mass.F90 \ No newline at end of file diff --git a/src/chemistry/geoschem/mo_neu_wetdep.F90 b/src/chemistry/geoschem/mo_neu_wetdep.F90 new file mode 100644 index 0000000000..c48af5cc0c --- /dev/null +++ b/src/chemistry/geoschem/mo_neu_wetdep.F90 @@ -0,0 +1,1798 @@ +! +! code written by J.-F. Lamarque, S. Walters and F. Vitt +! based on the original code from J. Neu developed for UC Irvine +! model +! +! LKE 2/23/2018 - correct setting flag for mass-limited (HNO3,etc.) vs Henry's Law washout +! +module mo_neu_wetdep +! + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_logfile, only : iulog + use constituents, only : pcnst + use spmd_utils, only : masterproc + use cam_abortutils, only : endrun + use seq_drydep_mod, only : n_species_table, species_name_table, dheff + use gas_wetdep_opts, only : gas_wetdep_method, gas_wetdep_list, gas_wetdep_cnt +! + implicit none +! + private + public :: neu_wetdep_init + public :: neu_wetdep_tend +! + save +! + integer, allocatable, dimension(:) :: mapping_to_heff,mapping_to_mmr + real(r8),allocatable, dimension(:) :: mol_weight + logical ,allocatable, dimension(:) :: ice_uptake + integer :: index_cldice,index_cldliq,nh3_ndx,co2_ndx + logical :: debug = .false. + integer :: hno3_ndx = 0 + integer :: h2o2_ndx = 0 +! +! diagnostics +! + logical :: do_diag = .false. + integer, parameter :: kdiag = 18 +! + real(r8), parameter :: zero = 0._r8 + real(r8), parameter :: one = 1._r8 +! + logical :: do_neu_wetdep +! + real(r8), parameter :: TICE=263._r8 + +contains + +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! +subroutine neu_wetdep_init +! + use constituents, only : cnst_get_ind,cnst_mw + use cam_history, only : addfld, add_default, horiz_only + use phys_control, only : phys_getopts +! + integer :: m,l + character*20 :: test_name + + logical :: history_chemistry + + call phys_getopts(history_chemistry_out=history_chemistry) + + do_neu_wetdep = gas_wetdep_method == 'NEU' .and. gas_wetdep_cnt>0 + + if (.not.do_neu_wetdep) return + + allocate( mapping_to_heff(gas_wetdep_cnt) ) + allocate( mapping_to_mmr(gas_wetdep_cnt) ) + allocate( ice_uptake(gas_wetdep_cnt) ) + allocate( mol_weight(gas_wetdep_cnt) ) + +! +! find mapping to heff table +! + if ( debug ) then + print '(a,i4)','gas_wetdep_cnt=',gas_wetdep_cnt + print '(a,i4)','n_species_table=',n_species_table + end if + mapping_to_heff = -99 + do m=1,gas_wetdep_cnt +! + test_name = gas_wetdep_list(m) + if ( debug ) print '(i4,a)',m,trim(test_name) +! +! mapping based on the MOZART4 wet removal subroutine; +! this might need to be redone (JFL: Sep 2010) +! + select case( trim(test_name) ) +! +! CCMI: added SO2t and NH_50W +! + case( 'HYAC', 'CH3COOH' , 'HCOOH', 'EOOH', 'IEPOX' ) + test_name = 'CH2O' + case ( 'SOGB','SOGI','SOGM','SOGT','SOGX' ) + test_name = 'H2O2' + case ( 'SO2t' ) + test_name = 'SO2' + case ( 'CLONO2','BRONO2','HCL','HOCL','HOBR','HBR', 'Pb', 'MACROOH', 'ISOPOOH', 'XOOH', 'H2SO4', 'HF', 'COF2', 'COFCL') + test_name = 'HNO3' + case ( 'NH_50W', 'NDEP', 'NHDEP', 'NH4NO3' ) + test_name = 'HNO3' + case ( 'ALKOOH', 'MEKOOH', 'TOLOOH' ) + test_name = 'CH3OOH' + case( 'PHENOOH', 'BENZOOH', 'C6H5OOH', 'BZOOH', 'XYLOLOOH', 'XYLENOOH', 'HPALD' ) + test_name = 'CH3OOH' + case( 'TERPOOH', 'TERP2OOH', 'MBOOOH' ) + test_name = 'HNO3' + case( 'TERPROD1', 'TERPROD2' ) + test_name = 'CH2O' + case( 'HMPROP' ) + test_name = 'GLYALD' + case( 'NOA', 'ALKNIT', 'ISOPNITA', 'ISOPNITB', 'HONITR', 'ISOPNOOH' ) + test_name = 'H2O2' + case( 'NC4CHO', 'NC4CH2OH', 'TERPNIT', 'NTERPOOH' ) + test_name = 'H2O2' + case( 'SOAGbb0' ) ! Henry's Law coeff. added for VBS SOA's, biomass burning is the same as fossil fuels + test_name = 'SOAGff0' + case( 'SOAGbb1' ) + test_name = 'SOAGff1' + case( 'SOAGbb2' ) + test_name = 'SOAGff2' + case( 'SOAGbb3' ) + test_name = 'SOAGff3' + case( 'SOAGbb4' ) + test_name = 'SOAGff4' + case( 'H2O2' ) + test_name = 'GC_H2O2' + case( 'HCHO' ) + test_name = 'GC_CH2O' + case( 'CH2O' ) + test_name = 'GC_CH2O' + case( 'NO2' ) + test_name = 'GC_NO2' + case( 'HNO3' ) + test_name = 'GC_HNO3' + case( 'NH3' ) + test_name = 'GC_NH3' + case( 'N2O5' ) + test_name = 'GC_N2O5' + case( 'PAN' ) + test_name = 'GC_PAN' + case( 'SO2' ) + test_name = 'GC_SO2' + ! Now list all non-MAM GEOS-Chem aerosols. These will be scavenged similarly + ! to HNO3 + case( 'AERI', 'BrSALA', 'BrSALC', 'DMS', 'INDIOL', & + 'IONITA', 'ISALA', 'ISALC', 'LVOCOA', 'MONITA', & + 'MSA', 'NH4', 'NIT', 'NITs', 'pFe', & + 'SALAAL', 'SALACL', 'SALCAL', 'SALCCL', 'SO4s', & + 'SOAGX', 'SOAIE' ) + test_name = 'HNO3' + end select +! + do l = 1,n_species_table +! +! if ( debug ) print '(i4,a)',l,trim(species_name_table(l)) +! + if( trim(test_name) == trim( species_name_table(l) ) ) then + mapping_to_heff(m) = l + if ( debug ) print '(a,a,i4)','mapping to heff of ',trim(species_name_table(l)),l + exit + end if + end do + if ( mapping_to_heff(m) == -99 ) then + if (masterproc) print *,'problem with mapping_to_heff of ',trim(test_name) +! call endrun() + end if +! +! special cases for NH3 and CO2 +! + if ( trim(test_name) == 'NH3' ) then + nh3_ndx = m + end if + if ( trim(test_name) == 'CO2' ) then + co2_ndx = m + end if + if ( trim(gas_wetdep_list(m)) == 'HNO3' ) then + hno3_ndx = m + end if +! + end do + + if (any ( mapping_to_heff(:) == -99 )) call endrun('mo_neu_wet->depwetdep_init: unmapped species error' ) +! + if ( debug ) then + print '(a,i4)','co2_ndx',co2_ndx + print '(a,i4)','nh3_ndx',nh3_ndx + end if +! +! find mapping to species +! + mapping_to_mmr = -99 + do m=1,gas_wetdep_cnt + if ( debug ) print '(i4,a)',m,trim(gas_wetdep_list(m)) + call cnst_get_ind(gas_wetdep_list(m), mapping_to_mmr(m), abort=.false. ) + if ( debug ) print '(a,i4)','mapping_to_mmr ',mapping_to_mmr(m) + if ( mapping_to_mmr(m) <= 0 ) then + print *,'problem with mapping_to_mmr of ',gas_wetdep_list(m) + call endrun('problem with mapping_to_mmr of '//trim(gas_wetdep_list(m))) + end if + end do +! +! define species-dependent arrays +! + do m=1,gas_wetdep_cnt +! + mol_weight(m) = cnst_mw(mapping_to_mmr(m)) + if ( debug ) print '(i4,a,f8.4)',m,' mol_weight ',mol_weight(m) + ice_uptake(m) = .false. + if ( trim(gas_wetdep_list(m)) == 'HNO3' ) then + ice_uptake(m) = .true. + end if +! +! + end do +! +! indices for cloud quantities +! + call cnst_get_ind( 'CLDICE', index_cldice ) + call cnst_get_ind( 'CLDLIQ', index_cldliq ) +! +! define output +! + do m=1,gas_wetdep_cnt + call addfld ('DTWR_'//trim(gas_wetdep_list(m)),(/ 'lev' /), 'A','kg/kg/s','wet removal Neu scheme tendency') + call addfld ('WD_'//trim(gas_wetdep_list(m)),horiz_only, 'A','kg/m2/s','vertical integrated wet deposition flux') + call addfld ('HEFF_'//trim(gas_wetdep_list(m)),(/ 'lev' /), 'A','M/atm','Effective Henrys Law coeff.') + call add_default('DTWR_'//trim(gas_wetdep_list(m)), 4, ' ') + call add_default('WD_'//trim(gas_wetdep_list(m)), 4, ' ') + !if (history_chemistry) then + ! call add_default('DTWR_'//trim(gas_wetdep_list(m)), 1, ' ') + ! call add_default('WD_'//trim(gas_wetdep_list(m)), 1, ' ') + !end if + end do +! + if ( do_diag ) then + call addfld ('QT_RAIN_HNO3',(/ 'lev' /), 'A','mol/mol/s','wet removal Neu scheme rain tendency') + call addfld ('QT_RIME_HNO3',(/ 'lev' /), 'A','mol/mol/s','wet removal Neu scheme rain tendency') + call addfld ('QT_WASH_HNO3',(/ 'lev' /), 'A','mol/mol/s','wet removal Neu scheme rain tendency') + call addfld ('QT_EVAP_HNO3',(/ 'lev' /), 'A','mol/mol/s','wet removal Neu scheme rain tendency') + if (history_chemistry) then + call add_default('QT_RAIN_HNO3',1,' ') + call add_default('QT_RIME_HNO3',1,' ') + call add_default('QT_WASH_HNO3',1,' ') + call add_default('QT_EVAP_HNO3',1,' ') + end if + end if +! + return +! +end subroutine neu_wetdep_init +! +subroutine neu_wetdep_tend(lchnk,ncol,mmr,pmid,pdel,zint,tfld,delt, & + prain, nevapr, cld, cmfdqr, wd_tend, wd_tend_int) +! + use ppgrid, only : pcols, pver +!!DEK + use phys_grid, only : get_area_all_p, get_rlat_all_p + use shr_const_mod, only : SHR_CONST_REARTH,SHR_CONST_G + use cam_history, only : outfld +! + implicit none +! + integer, intent(in) :: lchnk,ncol + real(r8), intent(in) :: mmr(pcols,pver,pcnst) ! mass mixing ratio (kg/kg) + real(r8), intent(in) :: pmid(pcols,pver) ! midpoint pressures (Pa) + real(r8), intent(in) :: pdel(pcols,pver) ! pressure delta about midpoints (Pa) + real(r8), intent(in) :: zint(pcols,pver+1) ! interface geopotential height above the surface (m) + real(r8), intent(in) :: tfld(pcols,pver) ! midpoint temperature (K) + real(r8), intent(in) :: delt ! timestep (s) +! + real(r8), intent(in) :: prain(ncol, pver) + real(r8), intent(in) :: nevapr(ncol, pver) + real(r8), intent(in) :: cld(ncol, pver) + real(r8), intent(in) :: cmfdqr(ncol, pver) + real(r8), intent(inout) :: wd_tend(pcols,pver,pcnst) + real(r8), intent(inout) :: wd_tend_int(pcols,pcnst) +! +! local arrays and variables +! + integer :: i,k,l,kk,m,id + real(r8), parameter :: rearth = SHR_CONST_REARTH ! radius earth (m) + real(r8), parameter :: gravit = SHR_CONST_G ! m/s^2 + real(r8), dimension(ncol) :: area, wk_out + real(r8), dimension(ncol,pver) :: cldice,cldliq,cldfrc,totprec,totevap,delz,delp,p + real(r8), dimension(ncol,pver) :: rls,evaprate,mass_in_layer,temp + real(r8), dimension(ncol,pver,gas_wetdep_cnt) :: trc_mass,heff,dtwr + real(r8), dimension(ncol,pver,gas_wetdep_cnt) :: wd_mmr + logical , dimension(gas_wetdep_cnt) :: tckaqb + integer , dimension(ncol) :: test_flag +! +! arrays for HNO3 diagnostics +! + real(r8), dimension(ncol,pver) :: qt_rain,qt_rime,qt_wash,qt_evap +! +! for Henry's law calculations +! + real(r8), parameter :: t0 = 298._r8 + real(r8), parameter :: ph = 1.e-5_r8 + real(r8), parameter :: ph_inv = 1._r8/ph + real(r8) :: e298, dhr + real(r8), dimension(ncol) :: dk1s,dk2s,wrk +!!DEK + real(r8) :: pi + real(r8) :: lats(pcols) +! +! from cam/src/physics/cam/stratiform.F90 +! +!!DEK + pi = 4._r8*atan(1.0_r8) + + if (.not.do_neu_wetdep) return +! +! don't do anything if there are no species to be removed +! + if ( gas_wetdep_cnt == 0 ) return +! +! reset output variables +! + wd_tend_int = 0._r8 +! +! get area (in radians square) +! + call get_area_all_p(lchnk, ncol, area) + area = area * rearth**2 ! in m^2 +! +! reverse order along the vertical before calling +! J. Neu's wet removal subroutine +! + do k=1,pver + kk = pver - k + 1 + do i=1,ncol +! + mass_in_layer(i,k) = area(i) * pdel(i,kk)/gravit ! kg +! + cldice (i,k) = mmr(i,kk,index_cldice) ! kg/kg + cldliq (i,k) = mmr(i,kk,index_cldliq) ! kg/kg + cldfrc (i,k) = cld(i,kk) ! unitless +! + totprec(i,k) = (prain(i,kk)+cmfdqr(i,kk)) & + * mass_in_layer(i,k) ! kg/s + totevap(i,k) = nevapr(i,kk) * mass_in_layer(i,k) ! kg/s +! + delz(i,k) = zint(i,kk) - zint(i,kk+1) ! in m +! + temp(i,k) = tfld(i,kk) +! +! convert tracer mass to kg to kg/kg +! + trc_mass(i,k,:) = mmr(i,kk,mapping_to_mmr(:)) * mass_in_layer(i,k) +! + delp(i,k) = pdel(i,kk) * 0.01_r8 ! in hPa + p (i,k) = pmid(i,kk) * 0.01_r8 ! in hPa +! + end do + end do +! +! define array for tendency calculation (on model grid) +! + dtwr(1:ncol,:,:) = mmr(1:ncol,:,mapping_to_mmr(:)) +! +! compute 1) integrated precipitation flux across the interfaces (rls) +! 2) evaporation rate +! + rls (:,pver) = 0._r8 + evaprate (:,pver) = 0._r8 + do k=pver-1,1,-1 + rls (:,k) = max(0._r8,totprec(:,k)-totevap(:,k)+rls(:,k+1)) + !evaprate(:,k) = min(1._r8,totevap(:,k)/(rls(:,k+1)+totprec(:,k)+1.e-36_r8)) + evaprate(:,k) = min(1._r8,totevap(:,k)/(rls(:,k+1)+1.e-36_r8)) + end do +! +! compute effective Henry's law coefficients +! code taken from models/drv/shr/seq_drydep_mod.F90 +! + heff = 0._r8 + do k=1,pver +! + kk = pver - k + 1 +! + wrk(:) = (t0-tfld(1:ncol,kk))/(t0*tfld(1:ncol,kk)) +! + do m=1,gas_wetdep_cnt +! + l = mapping_to_heff(m) + id = 6*(l - 1) + e298 = dheff(id+1) + dhr = dheff(id+2) + heff(:,k,m) = e298*exp( dhr*wrk(:) ) + test_flag = -99 + if( dheff(id+3) /= 0._r8 .and. dheff(id+5) == 0._r8 ) then + e298 = dheff(id+3) + dhr = dheff(id+4) + dk1s(:) = e298*exp( dhr*wrk(:) ) + where( heff(:,k,m) /= 0._r8 ) + heff(:,k,m) = heff(:,k,m)*(1._r8 + dk1s(:)*ph_inv) + elsewhere + test_flag = 1 + heff(:,k,m) = dk1s(:)*ph_inv + endwhere + end if +! + if (k.eq.1 .and. maxval(test_flag) > 0 .and. debug ) print '(a,i4)','heff for m=',m +! + if( dheff(id+5) /= 0._r8 ) then + if( nh3_ndx > 0 .or. co2_ndx > 0 ) then + e298 = dheff(id+3) + dhr = dheff(id+4) + dk1s(:) = e298*exp( dhr*wrk(:) ) + e298 = dheff(id+5) + dhr = dheff(id+6) + dk2s(:) = e298*exp( dhr*wrk(:) ) + if( m == co2_ndx ) then + heff(:,k,m) = heff(:,k,m)*(1._r8 + dk1s(:)*ph_inv)*(1._r8 + dk2s(:)*ph_inv) + else if( m == nh3_ndx ) then + heff(:,k,m) = heff(:,k,m)*(1._r8 + dk1s(:)*ph/dk2s(:)) + else + write(iulog,*) 'error in assigning henrys law coefficients' + write(iulog,*) 'species ',m + end if + end if + end if +! + end do + end do +! + if ( debug ) then + print '(a,50f8.2)','tckaqb ',tckaqb + print '(a,50e12.4)','heff ',heff(1,1,:) + print '(a,50i4)' ,'ice_uptake ',ice_uptake + print '(a,50f8.2)','mol_weight ',mol_weight(:) + print '(a,50f8.2)','temp ',temp(1,:) + print '(a,50f8.2)','p ',p (1,:) + end if +! +! call J. Neu's subroutine +! + do i=1,ncol +! + call washo(pver,gas_wetdep_cnt,delt,trc_mass(i,:,:),mass_in_layer(i,:),p(i,:),delz(i,:) & + ,rls(i,:),cldliq(i,:),cldice(i,:),cldfrc(i,:),temp(i,:),evaprate(i,:) & + ,area(i),heff(i,:,:),mol_weight(:),tckaqb(:),ice_uptake(:) & + ,qt_rain(i,:),qt_rime(i,:),qt_wash(i,:),qt_evap(i,:) ) +! + end do +! +! compute tendencies and convert back to mmr +! on original vertical grid +! + do k=1,pver + kk = pver - k + 1 + do i=1,ncol +! +! convert tracer mass from kg +! + wd_mmr(i,kk,:) = trc_mass(i,k,:) / mass_in_layer(i,k) +! + end do + end do +! +! tendency calculation (on model grid) +! + dtwr(1:ncol,:,:) = wd_mmr(1:ncol,:,:) - dtwr(1:ncol,:,:) + dtwr(1:ncol,:,:) = dtwr(1:ncol,:,:) / delt + +!!DEK polarward of 60S, 60N and <200hPa set to zero! + call get_rlat_all_p(lchnk, pcols, lats ) + do k = 1, pver + do i= 1, ncol + if ( abs( lats(i)*180._r8/pi ) > 60._r8 ) then + if ( pmid(i,k) < 20000._r8) then + dtwr(i,k,:) = 0._r8 + endif + endif + end do + end do +! +! output tendencies +! + do m=1,gas_wetdep_cnt + wd_tend(1:ncol,:,mapping_to_mmr(m)) = wd_tend(1:ncol,:,mapping_to_mmr(m)) + dtwr(1:ncol,:,m) + call outfld( 'DTWR_'//trim(gas_wetdep_list(m)),dtwr(:,:,m),ncol,lchnk ) + + call outfld( 'HEFF_'//trim(gas_wetdep_list(m)),heff(:,pver:1:-1,m),ncol,lchnk ) +! +! vertical integrated wet deposition rate [kg/m2/s] +! + wk_out = 0._r8 + do k=1,pver + kk = pver - k + 1 + wk_out(1:ncol) = wk_out(1:ncol) + (dtwr(1:ncol,k,m) * mass_in_layer(1:ncol,kk)/area(1:ncol)) + end do + call outfld( 'WD_'//trim(gas_wetdep_list(m)),wk_out,ncol,lchnk ) +! +! to be used in mo_chm_diags to compute wet_deposition_NOy_as_N and wet_deposition_NHx_as_N (units: kg/m2/s) +! + if ( debug) print *,'mo_neu ',mapping_to_mmr(m),(wk_out(1:ncol)) + wd_tend_int(1:ncol,mapping_to_mmr(m)) = wk_out(1:ncol) +! + end do +! + if ( do_diag ) then + call outfld('QT_RAIN_HNO3', qt_rain, ncol, lchnk ) + call outfld('QT_RIME_HNO3', qt_rime, ncol, lchnk ) + call outfld('QT_WASH_HNO3', qt_wash, ncol, lchnk ) + call outfld('QT_EVAP_HNO3', qt_evap, ncol, lchnk ) + end if +! + return +end subroutine neu_wetdep_tend + +!----------------------------------------------------------------------- +! +! Original code from Jessica Neu +! Updated by S. Walters and J.-F. Lamarque (March-April 2011) +! +!----------------------------------------------------------------------- + + subroutine WASHO(LPAR,NTRACE,DTSCAV,QTTJFL,QM,POFL,DELZ, & + RLS,CLWC,CIWC,CFR,TEM,EVAPRATE,GAREA,HSTAR,TCMASS,TCKAQB, & + TCNION, qt_rain, qt_rime, qt_wash, qt_evap) +! + implicit none + +!----------------------------------------------------------------------- +!---p-conde 5.4 (2007) -----called from main----- +!---called from pmain to calculate rainout and washout of tracers +!---revised by JNEU 8/2007 +!--- +!-LAER has been removed - no scavenging for aerosols +!-LAER could be used as LWASHTYP +!---WILL THIS WORK FOR T42->T21??????????? +!----------------------------------------------------------------------- + + integer LPAR, NTRACE + real(r8), intent(inout) :: QTTJFL(LPAR,NTRACE) + real(r8), intent(in) :: DTSCAV, QM(LPAR),POFL(LPAR),DELZ(LPAR),GAREA + real(r8), intent(in) :: RLS(LPAR),CLWC(LPAR),CIWC(LPAR),CFR(LPAR),TEM(LPAR), & + EVAPRATE(LPAR) + real(r8), intent(in) :: HSTAR(LPAR,NTRACE),TCMASS(NTRACE) + logical , intent(in) :: TCKAQB(NTRACE),TCNION(NTRACE) +! + real(r8), intent(inout) :: qt_rain(lpar) + real(r8), intent(inout) :: qt_rime(lpar) + real(r8), intent(inout) :: qt_wash(lpar) + real(r8), intent(inout) :: qt_evap(lpar) +! + integer I,J,L,N,LE, LM1 + real(r8), dimension(LPAR) :: CFXX + real(r8), dimension(LPAR) :: QTT, QTTNEW + + real(r8) WRK, RNEW_TST + real(r8) CLWX + real(r8) RNEW,RPRECIP,DELTARIMEMASS,DELTARIME,RAMPCT + real(r8) MASSLOSS + real(r8) DOR,DNEW,DEMP,COLEFFSNOW,RHOSNOW + real(r8) WEMP,REMP,RRAIN,RWASH + real(r8) QTPRECIP,QTRAIN,QTCXA,QTAX,QTOC + + real(r8) FAMA,RAMA,DAMA,FCA,RCA,DCA + real(r8) FAX,RAX,DAX,FCXA,RCXA,DCXA,FCXB,RCXB,DCXB + real(r8) RAXADJ,FAXADJ,RAXADJF + real(r8) QTDISCF,QTDISRIME,QTDISCXA + real(r8) QTEVAPAXP,QTEVAPAXW,QTEVAPAX + real(r8) QTWASHAX + real(r8) QTEVAPCXAP,QTEVAPCXAW,QTEVAPCXA + real(r8) QTWASHCXA,QTRIMECXA + real(r8) QTRAINCXA,QTRAINCXB + real(r8) QTTOPCA,QTTOPAA,QTTOPCAX,QTTOPAAX + + real(r8) AMPCT,AMCLPCT,CLNEWPCT,CLNEWAMPCT,CLOLDPCT,CLOLDAMPCT + real(r8) RAXLOC,RCXALOC,RCXBLOC,RCALOC,RAMALOC,RCXPCT + + real(r8) QTNETLCXA,QTNETLCXB,QTNETLAX,QTNETL + real(r8) QTDISSTAR + + + real(r8), parameter :: CFMIN=0.1_r8 + real(r8), parameter :: CWMIN=1.0e-5_r8 + real(r8), parameter :: DMIN=1.0e-1_r8 !mm + real(r8), parameter :: VOLPOW=1._r8/3._r8 + real(r8), parameter :: RHORAIN=1.0e3_r8 !kg/m3 + real(r8), parameter :: RHOSNOWFIX=1.0e2_r8 !kg/m3 + real(r8), parameter :: COLEFFRAIN=0.7_r8 + real(r8), parameter :: TMIX=258._r8 + real(r8), parameter :: TFROZ=240._r8 + real(r8), parameter :: COLEFFAER=0.05_r8 +! +! additional work arrays and diagnostics +! + real(r8) :: rls_wrk(lpar) + real(r8) :: rnew_wrk(lpar) + real(r8) :: rca_wrk(lpar) + real(r8) :: fca_wrk(lpar) + real(r8) :: rcxa_wrk(lpar) + real(r8) :: fcxa_wrk(lpar) + real(r8) :: rcxb_wrk(lpar) + real(r8) :: fcxb_wrk(lpar) + real(r8) :: rax_wrk(lpar,2) + real(r8) :: fax_wrk(lpar,2) + real(r8) :: rama_wrk(lpar) + real(r8) :: fama_wrk(lpar) + real(r8) :: deltarime_wrk(lpar) + real(r8) :: clwx_wrk(lpar) + real(r8) :: frc(lpar,3) + real(r8) :: rlsog(lpar) +! + logical :: is_hno3 + logical :: rls_flag(lpar) + logical :: rnew_flag(lpar) + logical :: cf_trigger(lpar) + logical :: freezing(lpar) +! + real(r8), parameter :: four = 4._r8 + real(r8), parameter :: adj_factor = one + 10._r8*epsilon( one ) +! + integer :: LWASHTYP,LICETYP +! + if ( debug ) then + print '(a,50f8.2)','tckaqb ',tckaqb + print '(a,50e12.4)','hstar ',hstar(1,:) + print '(a,50i4)' ,'ice_uptake ',TCNION + print '(a,50f8.2)','mol_weight ',TCMASS(:) + print '(a,50f8.2)','temp ',tem(:) + print '(a,50f8.2)','p ',pofl(:) + end if + +!----------------------------------------------------------------------- + LE = LPAR-1 +! + rls_flag(1:le) = rls(1:le) > zero + freezing(1:le) = tem(1:le) < tice + rlsog(1:le) = rls(1:le)/garea +! +species_loop : & + do N = 1,NTRACE + QTT(:lpar) = QTTJFL(:lpar,N) + QTTNEW(:lpar) = QTTJFL(:lpar,N) + is_hno3 = n == hno3_ndx + if( is_hno3 ) then + qt_rain(:lpar) = zero + qt_rime(:lpar) = zero + qt_wash(:lpar) = zero + qt_evap(:lpar) = zero + rca_wrk(:lpar) = zero + fca_wrk(:lpar) = zero + rcxa_wrk(:lpar) = zero + fcxa_wrk(:lpar) = zero + rcxb_wrk(:lpar) = zero + fcxb_wrk(:lpar) = zero + rls_wrk(:lpar) = zero + rnew_wrk(:lpar) = zero + cf_trigger(:lpar) = .false. + clwx_wrk(:lpar) = -9999._r8 + deltarime_wrk(:lpar) = -9999._r8 + rax_wrk(:lpar,:) = zero + fax_wrk(:lpar,:) = zero + endif + +!----------------------------------------------------------------------- +! check whether soluble in ice +!----------------------------------------------------------------------- + if( TCNION(N) ) then + LICETYP = 1 + else + LICETYP = 2 + end if + +!----------------------------------------------------------------------- +! initialization +!----------------------------------------------------------------------- + QTTOPAA = zero + QTTOPCA = zero + + RCA = zero + FCA = zero + DCA = zero + RAMA = zero + FAMA = zero + DAMA = zero + + AMPCT = zero + AMCLPCT = zero + CLNEWPCT = zero + CLNEWAMPCT = zero + CLOLDPCT = zero + CLOLDAMPCT = zero + + +!----------------------------------------------------------------------- +! Check whether precip in top layer - if so, require CF ge 0.2 +!----------------------------------------------------------------------- + if( RLS(LE) > zero ) then + CFXX(LE) = max( CFMIN,CFR(LE) ) + else + CFXX(LE) = CFR(LE) + endif + + rnew_flag(1:le) = .false. + +level_loop : & + do L = LE,1,-1 + LM1 = L - 1 + FAX = zero + RAX = zero + DAX = zero + FCXA = zero + FCXB = zero + DCXA = zero + DCXB = zero + RCXA = zero + RCXB = zero + + QTDISCF = zero + QTDISRIME = zero + QTDISCXA = zero + + QTEVAPAXP = zero + QTEVAPAXW = zero + QTEVAPAX = zero + QTWASHAX = zero + + QTEVAPCXAP = zero + QTEVAPCXAW = zero + QTEVAPCXA = zero + QTRIMECXA = zero + QTWASHCXA = zero + QTRAINCXA = zero + QTRAINCXB = zero + + RAMPCT = zero + RCXPCT = zero + + RCXALOC = zero + RCXBLOC = zero + RAXLOC = zero + RAMALOC = zero + RCALOC = zero + + RPRECIP = zero + DELTARIMEMASS = zero + DELTARIME = zero + DOR = zero + DNEW = zero + + QTTOPAAX = zero + QTTOPCAX = zero + +has_rls : & + if( rls_flag(l) ) then +!----------------------------------------------------------------------- +!-----Evaporate ambient precip and decrease area------------------------- +!-----If ice, diam=diam falling from above If rain, diam=4mm (not used) +!-----Evaporate tracer contained in evaporated precip +!-----Can't evaporate more than we start with----------------------------- +!-----Don't do washout until we adjust ambient precip to match Rbot if needed +!------(after RNEW if statements) +!----------------------------------------------------------------------- + FAX = max( zero,FAMA*(one - evaprate(l)) ) + RAX = RAMA !kg/m2/s + if ( debug ) then + if( (l == 3 .or. l == 2) ) then + write(*,*) 'washout: l,rls,fax = ',l,rls(l),fax + endif + endif + if( FAMA > zero ) then + if( freezing(l) ) then + DAX = DAMA !mm + else + DAX = four !mm - not necessary + endif + else + DAX = zero + endif + + if( RAMA > zero ) then + QTEVAPAXP = min( QTTOPAA,EVAPRATE(L)*QTTOPAA ) + else + QTEVAPAXP = zero + endif + if( is_hno3 ) then + rax_wrk(l,1) = rax + fax_wrk(l,1) = fax + endif + + +!----------------------------------------------------------------------- +! Determine how much the in-cloud precip rate has increased------ +!----------------------------------------------------------------------- + WRK = RAX*FAX + RCA*FCA + if( WRK > 0._r8 ) then + RNEW_TST = RLS(L)/(GAREA * WRK) + else + RNEW_TST = 10._r8 + endif + RNEW = RLSOG(L) - (RAX*FAX + RCA*FCA) !GBA*CF + rnew_wrk(l) = rnew_tst + if ( debug ) then + if( is_hno3 .and. l == kdiag-1 ) then + write(*,*) ' ' + write(*,*) 'washout: rls,rax,fax,rca,fca' + write(*,'(1p,5g15.7)') rls(l),rax,fax,rca,fca + write(*,*) ' ' + endif + endif +!----------------------------------------------------------------------- +! if RNEW>0, there is growth and/or new precip formation +!----------------------------------------------------------------------- +has_rnew: if( rlsog(l) > adj_factor*(rax*fax + rca*fca) ) then +!----------------------------------------------------------------------- +! Min cloudwater requirement for cloud with new precip +! Min CF is set at top for LE, at end for other levels +! CWMIN is only needed for new precip formation - do not need for RNEW<0 +!----------------------------------------------------------------------- + if( cfxx(l) == zero ) then + if ( do_diag ) then + write(*,*) 'cfxx(l) == zero',l + write(*,*) qttjfl(:,n) + write(*,*) qm(:) + write(*,*) pofl(:) + write(*,*) delz(:) + write(*,*) rls(:) + write(*,*) clwc(:) + write(*,*) ciwc(:) + write(*,*) cfr(:) + write(*,*) tem(:) + write(*,*) evaprate(:) + write(*,*) hstar(:,n) + end if +! +! if we are here,, that means that there is +! a inconsistency and this will lead to a division +! by 0 later on! This column should then be skipped +! + QTTJFL(:lpar,n) = QTT(:lpar) + cycle species_loop +! +! call endrun() +! + endif + rnew_flag(l) = .true. + CLWX = max( CLWC(L)+CIWC(L),CWMIN*CFXX(L) ) + if( is_hno3 ) then + clwx_wrk(l) = clwx + endif +!----------------------------------------------------------------------- +! Area of old cloud and new cloud +!----------------------------------------------------------------------- + FCXA = FCA + FCXB = max( zero,CFXX(L)-FCXA ) +!----------------------------------------------------------------------- +! ICE +! For ice and mixed phase, grow precip in old cloud by riming +! Use only portion of cloudwater in old cloud fraction +! and rain above old cloud fraction +! COLEFF from Lohmann and Roeckner (1996), Loss rate from Rotstayn (1997) +!----------------------------------------------------------------------- +is_freezing : & + if( freezing(l) ) then + COLEFFSNOW = exp( 2.5e-2_r8*(TEM(L) - TICE) ) + if( TEM(L) <= TFROZ ) then + RHOSNOW = RHOSNOWFIX + else + RHOSNOW = 0.303_r8*(TEM(L) - TFROZ)*RHOSNOWFIX + endif + if( FCXA > zero ) then + if( DCA > zero ) then + DELTARIMEMASS = CLWX*QM(L)*(FCXA/CFXX(L))* & + (one - exp( (-COLEFFSNOW/(DCA*1.e-3_r8))*((RCA)/(2._r8*RHOSNOW))*DTSCAV )) !uses GBA R + else + DELTARIMEMASS = zero + endif + else + DELTARIMEMASS = zero + endif +!----------------------------------------------------------------------- +! Increase in precip rate due to riming (kg/m2/s): +! Limit to total increase in R in cloud +!----------------------------------------------------------------------- + if( FCXA > zero ) then + DELTARIME = min( RNEW/FCXA,DELTARIMEMASS/(FCXA*GAREA*DTSCAV) ) !GBA + else + DELTARIME = zero + endif + if( is_hno3 ) then + deltarime_wrk(l) = deltarime + endif +!----------------------------------------------------------------------- +! Find diameter of rimed precip, must be at least .1mm +!----------------------------------------------------------------------- + if( RCA > zero ) then + DOR = max( DMIN,(((RCA+DELTARIME)/RCA)**VOLPOW)*DCA ) + else + DOR = zero + endif +!----------------------------------------------------------------------- +! If there is some in-cloud precip left, we have new precip formation +! Will be spread over whole cloud fraction +!----------------------------------------------------------------------- +! Calculate precip rate in old and new cloud fractions +!----------------------------------------------------------------------- + RPRECIP = (RNEW-(DELTARIME*FCXA))/CFXX(L) !kg/m2/s !GBA +!----------------------------------------------------------------------- +! Calculate precip rate in old and new cloud fractions +!----------------------------------------------------------------------- + RCXA = RCA + DELTARIME + RPRECIP !kg/m2/s GBA + RCXB = RPRECIP !kg/m2/s GBA + +!----------------------------------------------------------------------- +! Find diameter of new precip from empirical relation using Rprecip +! in given area of box- use density of water, not snow, to convert kg/s +! to mm/s -> as given in Field and Heymsfield +! Also calculate diameter of mixed precip,DCXA, from empirical relation +! using total R in FCXA - this will give larger particles than averaging DOR and +! DNEW in the next level +! DNEW and DCXA must be at least .1mm +!----------------------------------------------------------------------- + if( RPRECIP > zero ) then + WEMP = (CLWX*QM(L))/(GAREA*CFXX(L)*DELZ(L)) !kg/m3 + REMP = RPRECIP/((RHORAIN/1.e3_r8)) !mm/s local + DNEW = DEMPIRICAL( WEMP, REMP ) + if ( debug ) then + if( is_hno3 .and. l >= 15 ) then + write(*,*) ' ' + write(*,*) 'washout: wemp,remp.dnew @ l = ',l + write(*,'(1p,3g15.7)') wemp,remp,dnew + write(*,*) ' ' + endif + endif + DNEW = max( DMIN,DNEW ) + if( FCXB > zero ) then + DCXB = DNEW + else + DCXB = zero + endif + else + DCXB = zero + endif + + if( FCXA > zero ) then + WEMP = (CLWX*QM(L)*(FCXA/CFXX(L)))/(GAREA*FCXA*DELZ(L)) !kg/m3 + REMP = RCXA/((RHORAIN/1.e3_r8)) !mm/s local + DEMP = DEMPIRICAL( WEMP, REMP ) + DCXA = ((RCA+DELTARIME)/RCXA)*DOR + (RPRECIP/RCXA)*DNEW + DCXA = max( DEMP,DCXA ) + DCXA = max( DMIN,DCXA ) + else + WEMP = zero + REMP = zero + DEMP = zero + DCXA = zero + endif + if ( debug ) then + if( is_hno3 .and. l >= 15 ) then + write(*,*) ' ' + write(*,*) 'washout: rca,rcxa,deltarime,dor,rprecip,dnew @ l = ',l + write(*,'(1p,6g15.7)') rca,rcxa,deltarime,dor,rprecip,dnew + write(*,*) 'washout: dcxa,dcxb,wemp,remp,demp' + write(*,'(1p,5g15.7)') dcxa,dcxb,wemp,remp,demp + write(*,*) ' ' + end if + endif + + if( QTT(L) > zero ) then +!----------------------------------------------------------------------- +! ICE SCAVENGING +!----------------------------------------------------------------------- +! For ice, rainout only hno3/aerosols using new precip +! Tracer dissolved given by Kaercher and Voigt (2006) for T<258K +! For T>258K, use Henry's Law with Retention coefficient +! Rain out in whole CF +!----------------------------------------------------------------------- + if( RPRECIP > zero ) then + if( LICETYP == 1 ) then + RRAIN = RPRECIP*GAREA !kg/s local + call DISGAS( CLWX, CFXX(L), TCMASS(N), HSTAR(L,N), & + TEM(L),POFL(L),QM(L), & + QTT(L)*CFXX(L),QTDISCF ) + call RAINGAS( RRAIN, DTSCAV, CLWX, CFXX(L), & + QM(L), QTT(L), QTDISCF, QTRAIN ) + WRK = QTRAIN/CFXX(L) + QTRAINCXA = FCXA*WRK + QTRAINCXB = FCXB*WRK + elseif( LICETYP == 2 ) then + QTRAINCXA = zero + QTRAINCXB = zero + endif + if( debug .and. is_hno3 .and. l == kdiag ) then + write(*,*) ' ' + write(*,*) 'washout: Ice Scavenging' + write(*,*) 'washout: qtraincxa, qtraincxb, fcxa, fcxb, qt_rain, cfxx(l), wrk @ level = ',l + write(*,'(1p,7g15.7)') qtraincxa, qtraincxb, fcxa, fcxb, qt_rain(l), cfxx(l), wrk + write(*,*) ' ' + endif + endif +!----------------------------------------------------------------------- +! For ice, accretion removal for hno3 and aerosols is propotional to riming, +! no accretion removal for gases +! remove only in mixed portion of cloud +! Limit DELTARIMEMASS to RNEW*DTSCAV for ice - evaporation of rimed ice to match +! RNEW precip rate would result in HNO3 escaping from ice (no trapping) +!----------------------------------------------------------------------- + if( DELTARIME > zero ) then + if( LICETYP == 1 ) then + if( TEM(L) <= TFROZ ) then + RHOSNOW = RHOSNOWFIX + else + RHOSNOW = 0.303_r8*(TEM(L) - TFROZ)*RHOSNOWFIX + endif + QTCXA = QTT(L)*FCXA + call DISGAS( CLWX*(FCXA/CFXX(L)), FCXA, TCMASS(N), & + HSTAR(L,N), TEM(L), POFL(L), & + QM(L), QTCXA, QTDISRIME ) + QTDISSTAR = (QTDISRIME*QTCXA)/(QTDISRIME + QTCXA) + if ( debug ) then + if( is_hno3 .and. l >= 15 ) then + write(*,*) ' ' + write(*,*) 'washout: fcxa,dca,rca,qtdisstar @ l = ',l + write(*,'(1p,4g15.7)') fcxa,dca,rca,qtdisstar + write(*,*) ' ' + endif + endif + QTRIMECXA = QTCXA* & + (one - exp((-COLEFFSNOW/(DCA*1.e-3_r8))* & + (RCA/(2._r8*RHOSNOW))* & !uses GBA R + (QTDISSTAR/QTCXA)*DTSCAV)) + QTRIMECXA = min( QTRIMECXA, & + ((RNEW*GAREA*DTSCAV)/(CLWX*QM(L)*(FCXA/CFXX(L))))*QTDISSTAR) + elseif( LICETYP == 2 ) then + QTRIMECXA = zero + endif + endif + else + QTRAINCXA = zero + QTRAINCXB = zero + QTRIMECXA = zero + endif +!----------------------------------------------------------------------- +! For ice, no washout in interstitial cloud air +!----------------------------------------------------------------------- + QTWASHCXA = zero + QTEVAPCXA = zero + +!----------------------------------------------------------------------- +! RAIN +! For rain, accretion increases rain rate but diameter remains constant +! Diameter is 4mm (not used) +!----------------------------------------------------------------------- + else is_freezing + if( FCXA > zero ) then + DELTARIMEMASS = (CLWX*QM(L))*(FCXA/CFXX(L))* & + (one - exp( -0.24_r8*COLEFFRAIN*((RCA)**0.75_r8)*DTSCAV )) !local + else + DELTARIMEMASS = zero + endif +!----------------------------------------------------------------------- +! Increase in precip rate due to riming (kg/m2/s): +! Limit to total increase in R in cloud +!----------------------------------------------------------------------- + if( FCXA > zero ) then + DELTARIME = min( RNEW/FCXA,DELTARIMEMASS/(FCXA*GAREA*DTSCAV) ) !GBA + else + DELTARIME = zero + endif +!----------------------------------------------------------------------- +! If there is some in-cloud precip left, we have new precip formation +!----------------------------------------------------------------------- + RPRECIP = (RNEW-(DELTARIME*FCXA))/CFXX(L) !GBA + + RCXA = RCA + DELTARIME + RPRECIP !kg/m2/s GBA + RCXB = RPRECIP !kg/m2/s GBA + DCXA = FOUR + if( FCXB > zero ) then + DCXB = FOUR + else + DCXB = zero + endif +!----------------------------------------------------------------------- +! RAIN SCAVENGING +! For rain, rainout both hno3/aerosols and gases using new precip +!----------------------------------------------------------------------- + if( QTT(L) > zero ) then + if( RPRECIP > zero ) then + RRAIN = (RPRECIP*GAREA) !kg/s local + call DISGAS( CLWX, CFXX(L), TCMASS(N), HSTAR(L,N), & + TEM(L), POFL(L), QM(L), & + QTT(L)*CFXX(L), QTDISCF ) + call RAINGAS( RRAIN, DTSCAV, CLWX, CFXX(L), & + QM(L), QTT(L), QTDISCF, QTRAIN ) + WRK = QTRAIN/CFXX(L) + QTRAINCXA = FCXA*WRK + QTRAINCXB = FCXB*WRK + if( debug .and. is_hno3 .and. l == kdiag ) then + write(*,*) ' ' + write(*,*) 'washout: Rain Scavenging' + write(*,*) 'washout: qtraincxa, qtraincxb, fcxa, fcxb, qt_rain, cfxx(l), wrk @ level = ',l + write(*,'(1p,7g15.7)') qtraincxa, qtraincxb, fcxa, fcxb, qt_rain(l), cfxx(l), wrk + write(*,*) ' ' + endif + endif +!----------------------------------------------------------------------- +! For rain, accretion removal is propotional to riming +! caclulate for hno3/aerosols and gases +! Remove only in mixed portion of cloud +! Limit DELTARIMEMASS to RNEW*DTSCAV +!----------------------------------------------------------------------- + if( DELTARIME > zero ) then + QTCXA = QTT(L)*FCXA + call DISGAS( CLWX*(FCXA/CFXX(L)), FCXA, TCMASS(N), & + HSTAR(L,N), TEM(L), POFL(L), & + QM(L), QTCXA, QTDISRIME ) + QTDISSTAR = (QTDISRIME*QTCXA)/(QTDISRIME + QTCXA) + QTRIMECXA = QTCXA* & + (one - exp(-0.24_r8*COLEFFRAIN* & + ((RCA)**0.75_r8)* & !local + (QTDISSTAR/QTCXA)*DTSCAV)) + QTRIMECXA = min( QTRIMECXA, & + ((RNEW*GAREA*DTSCAV)/(CLWX*QM(L)*(FCXA/CFXX(L))))*QTDISSTAR) + else + QTRIMECXA = zero + endif + else + QTRAINCXA = zero + QTRAINCXB = zero + QTRIMECXA = zero + endif +!----------------------------------------------------------------------- +! For rain, washout gases and HNO3/aerosols using rain from above old cloud +! Washout for HNO3/aerosols is only on non-dissolved portion, impaction-style +! Washout for gases is on non-dissolved portion, limited by QTTOP+QTRIME +!----------------------------------------------------------------------- + if( RCA > zero ) then + QTPRECIP = FCXA*QTT(L) - QTDISRIME + if( HSTAR(L,N) > 1.e4_r8 ) then + if( QTPRECIP > zero ) then + QTWASHCXA = QTPRECIP*(one - exp( -0.24_r8*COLEFFAER*((RCA)**0.75_r8)*DTSCAV )) !local + else + QTWASHCXA = zero + endif + QTEVAPCXA = zero + else + RWASH = RCA*GAREA !kg/s local + if( QTPRECIP > zero ) then + call WASHGAS( RWASH, FCA, DTSCAV, QTTOPCA+QTRIMECXA, & + HSTAR(L,N), TEM(L), POFL(L), & + QM(L), QTPRECIP, QTWASHCXA, QTEVAPCXA ) + else + QTWASHCXA = zero + QTEVAPCXA = zero + endif + endif + endif + endif is_freezing +!----------------------------------------------------------------------- +! If RNEW zero ) then + RCXA = min( RCA,RLS(L)/(GAREA*FCXA) ) !kg/m2/s GBA + if( FAX > zero .and. ((RCXA+1.e-12_r8) < RLS(L)/(GAREA*FCXA)) ) then + RAXADJF = RLS(L)/GAREA - RCXA*FCXA + RAMPCT = RAXADJF/(RAX*FAX) + FAXADJ = RAMPCT*FAX + if( FAXADJ > zero ) then + RAXADJ = RAXADJF/FAXADJ + else + RAXADJ = zero + endif + else + RAXADJ = zero + RAMPCT = zero + FAXADJ = zero + endif + else + RCXA = zero + if( FAX > zero ) then + RAXADJF = RLS(L)/GAREA + RAMPCT = RAXADJF/(RAX*FAX) + FAXADJ = RAMPCT*FAX + if( FAXADJ > zero ) then + RAXADJ = RAXADJF/FAXADJ + else + RAXADJ = zero + endif + else + RAXADJ = zero + RAMPCT = zero + FAXADJ = zero + endif + endif + + QTEVAPAXP = min( QTTOPAA,QTTOPAA - (RAMPCT*(QTTOPAA-QTEVAPAXP)) ) + FAX = FAXADJ + RAX = RAXADJ + if ( debug ) then + if( (l == 3 .or. l == 2) ) then + write(*,*) 'washout: l,fcxa,fax = ',l,fcxa,fax + endif + endif + +!----------------------------------------------------------------------- +! IN-CLOUD EVAPORATION/WASHOUT +! If precip out the bottom of the cloud is 0, evaporate everything +! If there is no cloud, QTTOPCA=0, so nothing happens +!----------------------------------------------------------------------- + if( RCXA <= zero ) then + QTEVAPCXA = QTTOPCA + RCXA = zero + DCXA = zero + else +!----------------------------------------------------------------------- +! If rain out the bottom of the cloud is >0 (but .le. RCA): +! For ice, decrease particle size, +! no washout +! no evap for non-ice gases (b/c there is nothing in ice) +! TTmix, hno3&aerosols are incorporated into ice structure: +! do not release +! For rain, assume full evaporation of some raindrops +! proportional evaporation for all species +! washout for gases using Rbot +! impact washout for hno3/aerosol portion in gas phase +!----------------------------------------------------------------------- +! if (TEM(L) < TICE ) then +is_freezing_a : & + if( freezing(l) ) then + QTWASHCXA = zero + DCXA = ((RCXA/RCA)**VOLPOW)*DCA + if( LICETYP == 1 ) then + if( TEM(L) <= TMIX ) then + MASSLOSS = (RCA-RCXA)*FCXA*GAREA*DTSCAV +!----------------------------------------------------------------------- +! note-QTT doesn't matter b/c T<258K +!----------------------------------------------------------------------- + call DISGAS( (MASSLOSS/QM(L)), FCXA, TCMASS(N), & + HSTAR(L,N), TEM(L), POFL(L), & + QM(L), QTT(L), QTEVAPCXA ) + QTEVAPCXA = min( QTTOPCA,QTEVAPCXA ) + else + QTEVAPCXA = zero + endif + elseif( LICETYP == 2 ) then + QTEVAPCXA = zero + endif + else is_freezing_a + QTEVAPCXAP = (RCA - RCXA)/RCA*QTTOPCA + DCXA = FOUR + QTCXA = FCXA*QTT(L) + if( HSTAR(L,N) > 1.e4_r8 ) then + if( QTT(L) > zero ) then + call DISGAS( CLWX*(FCXA/CFXX(L)), FCXA, TCMASS(N), & + HSTAR(L,N), TEM(L), POFL(L), & + QM(L), QTCXA, QTDISCXA ) + if( QTCXA > QTDISCXA ) then + QTWASHCXA = (QTCXA - QTDISCXA)*(one - exp( -0.24_r8*COLEFFAER*((RCXA)**0.75_r8)*DTSCAV )) !local + else + QTWASHCXA = zero + endif + QTEVAPCXAW = zero + else + QTWASHCXA = zero + QTEVAPCXAW = zero + endif + else + RWASH = RCXA*GAREA !kg/s local + call WASHGAS( RWASH, FCXA, DTSCAV, QTTOPCA, HSTAR(L,N), & + TEM(L), POFL(L), QM(L), & + QTCXA-QTDISCXA, QTWASHCXA, QTEVAPCXAW ) + endif + QTEVAPCXA = QTEVAPCXAP + QTEVAPCXAW + endif is_freezing_a + endif + endif has_rnew + +!----------------------------------------------------------------------- +! AMBIENT WASHOUT +! Ambient precip is finalized - if it is rain, washout +! no ambient washout for ice, since gases are in vapor phase +!----------------------------------------------------------------------- + if( RAX > zero ) then + if( .not. freezing(l) ) then + QTAX = FAX*QTT(L) + if( HSTAR(L,N) > 1.e4_r8 ) then + QTWASHAX = QTAX* & + (one - exp(-0.24_r8*COLEFFAER* & + ((RAX)**0.75_r8)*DTSCAV)) !local + QTEVAPAXW = zero + else + RWASH = RAX*GAREA !kg/s local + call WASHGAS( RWASH, FAX, DTSCAV, QTTOPAA, HSTAR(L,N), & + TEM(L), POFL(L), QM(L), QTAX, & + QTWASHAX, QTEVAPAXW ) + endif + else + QTEVAPAXW = zero + QTWASHAX = zero + endif + else + QTEVAPAXW = zero + QTWASHAX = zero + endif + QTEVAPAX = QTEVAPAXP + QTEVAPAXW + +!----------------------------------------------------------------------- +! END SCAVENGING +! Require CF if our ambient evaporation rate would give less +! precip than R from model. +!----------------------------------------------------------------------- + if( do_diag .and. is_hno3 ) then + rls_wrk(l) = rls(l)/garea + rca_wrk(l) = rca + fca_wrk(l) = fca + rcxa_wrk(l) = rcxa + fcxa_wrk(l) = fcxa + rcxb_wrk(l) = rcxb + fcxb_wrk(l) = fcxb + rax_wrk(l,2) = rax + fax_wrk(l,2) = fax + endif +upper_level : & + if( L > 1 ) then + FAMA = max( FCXA + FCXB + FAX - CFR(LM1),zero ) + if( FAX > zero ) then + RAXLOC = RAX/FAX + else + RAXLOC = zero + endif + if( FCXA > zero ) then + RCXALOC = RCXA/FCXA + else + RCXALOC = zero + endif + if( FCXB > zero ) then + RCXBLOC = RCXB/FCXB + else + RCXBLOC = zero + endif + + if( CFR(LM1) >= CFMIN ) then + CFXX(LM1) = CFR(LM1) + else + if( adj_factor*RLSOG(LM1) >= (RCXA*FCXA + RCXB*FCXB + RAX*FAX)*(one - EVAPRATE(LM1)) ) then + CFXX(LM1) = CFMIN + cf_trigger(lm1) = .true. + else + CFXX(LM1) = CFR(LM1) + endif + if( is_hno3 .and. lm1 == kdiag .and. debug ) then + write(*,*) ' ' + write(*,*) 'washout: rls,garea,rcxa,fcxa,rcxb,fcxb,rax,fax' + write(*,'(1p,8g15.7)') rls(lm1),garea,rcxa,fcxa,rcxb,fcxb,rax,fax + write(*,*) ' ' + endif + endif +!----------------------------------------------------------------------- +! Figure out what will go into ambient and cloud below +! Don't do for lowest level +!----------------------------------------------------------------------- + if( FAX > zero ) then + RAXLOC = RAX/FAX + AMPCT = max( zero,min( one,(CFXX(L) + FAX - CFXX(LM1))/FAX ) ) + AMCLPCT = one - AMPCT + else + RAXLOC = zero + AMPCT = zero + AMCLPCT = zero + endif + if( FCXB > zero ) then + RCXBLOC = RCXB/FCXB + CLNEWPCT = max( zero,min( (CFXX(LM1) - FCXA)/FCXB,one ) ) + CLNEWAMPCT = one - CLNEWPCT + else + RCXBLOC = zero + CLNEWPCT = zero + CLNEWAMPCT = zero + endif + if( FCXA > zero ) then + RCXALOC = RCXA/FCXA + CLOLDPCT = max( zero,min( CFXX(LM1)/FCXA,one ) ) + CLOLDAMPCT = one - CLOLDPCT + else + RCXALOC = zero + CLOLDPCT = zero + CLOLDAMPCT = zero + endif +!----------------------------------------------------------------------- +! Remix everything for the next level +!----------------------------------------------------------------------- + FCA = min( CFXX(LM1),FCXA*CLOLDPCT + CLNEWPCT*FCXB + AMCLPCT*FAX ) + if( FCA > zero ) then +!----------------------------------------------------------------------- +! Maintain cloud core by reducing NC and AM area going into cloud below +!----------------------------------------------------------------------- + RCA = (RCXA*FCXA*CLOLDPCT + RCXB*FCXB*CLNEWPCT + RAX*FAX*AMCLPCT)/FCA + if ( debug ) then + if( is_hno3 ) then + write(*,*) ' ' + write(*,*) 'washout: rcxa,fcxa,cloldpctrca,rca,fca,dcxa @ l = ',l + write(*,'(1p,6g15.7)') rcxa,fcxa,cloldpct,rca,fca,dcxa + write(*,*) 'washout: rcxb,fcxb,clnewpct,dcxb' + write(*,'(1p,4g15.7)') rcxb,fcxb,clnewpct,dcxb + write(*,*) 'washout: rax,fax,amclpct,dax' + write(*,'(1p,4g15.7)') rax,fax,amclpct,dax + write(*,*) ' ' + endif + endif + + if (RCA > zero) then + DCA = (RCXA*FCXA*CLOLDPCT)/(RCA*FCA)*DCXA + & + (RCXB*FCXB*CLNEWPCT)/(RCA*FCA)*DCXB + & + (RAX*FAX*AMCLPCT)/(RCA*FCA)*DAX + else + DCA = zero + FCA = zero + endif + + else + FCA = zero + DCA = zero + RCA = zero + endif + + FAMA = FCXA + FCXB + FAX - CFXX(LM1) + if( FAMA > zero ) then + RAMA = (RCXA*FCXA*CLOLDAMPCT + RCXB*FCXB*CLNEWAMPCT + RAX*FAX*AMPCT)/FAMA + if( RAMA > zero ) then + DAMA = (RCXA*FCXA*CLOLDAMPCT)/(RAMA*FAMA)*DCXA + & + (RCXB*FCXB*CLNEWAMPCT)/(RAMA*FAMA)*DCXB + & + (RAX*FAX*AMPCT)/(RAMA*FAMA)*DAX + else + FAMA = zero + DAMA = zero + endif + else + FAMA = zero + DAMA = zero + RAMA = zero + endif + else upper_level + AMPCT = zero + AMCLPCT = zero + CLNEWPCT = zero + CLNEWAMPCT = zero + CLOLDPCT = zero + CLOLDAMPCT = zero + endif upper_level + else has_rls + RNEW = zero + QTEVAPCXA = QTTOPCA + QTEVAPAX = QTTOPAA + if( L > 1 ) then + if( RLS(LM1) > zero ) then + CFXX(LM1) = max( CFMIN,CFR(LM1) ) +! if( CFR(LM1) >= CFMIN ) then +! CFXX(LM1) = CFR(LM1) +! else +! CFXX(LM1) = CFMIN +! endif + else + CFXX(LM1) = CFR(LM1) + endif + endif + AMPCT = zero + AMCLPCT = zero + CLNEWPCT = zero + CLNEWAMPCT = zero + CLOLDPCT = zero + CLOLDAMPCT = zero + RCA = zero + RAMA = zero + FCA = zero + FAMA = zero + DCA = zero + DAMA = zero + endif has_rls + + if( do_diag .and. is_hno3 ) then + fama_wrk(l) = fama + rama_wrk(l) = rama + endif +!----------------------------------------------------------------------- +! Net loss can not exceed QTT in each region +!----------------------------------------------------------------------- + QTNETLCXA = QTRAINCXA + QTRIMECXA + QTWASHCXA - QTEVAPCXA + QTNETLCXA = min( QTT(L)*FCXA,QTNETLCXA ) + + QTNETLCXB =QTRAINCXB + QTNETLCXB = min( QTT(L)*FCXB,QTNETLCXB ) + + QTNETLAX = QTWASHAX - QTEVAPAX + QTNETLAX = min( QTT(L)*FAX,QTNETLAX ) + + QTTNEW(L) = QTT(L) - (QTNETLCXA + QTNETLCXB + QTNETLAX) + + if( do_diag .and. is_hno3 ) then + qt_rain(l) = qtraincxa + qtraincxb + qt_rime(l) = qtrimecxa + qt_wash(l) = qtwashcxa + qtwashax + qt_evap(l) = qtevapcxa + qtevapax + frc(l,1) = qtnetlcxa + frc(l,2) = qtnetlcxb + frc(l,3) = qtnetlax + endif + if( debug .and. is_hno3 .and. l == kdiag ) then + write(*,*) ' ' + write(*,*) 'washout: qtraincxa, qtraincxb, qtrimecxa @ level = ',l + write(*,'(1p,3g15.7)') qtraincxa, qtraincxb, qtrimecxa + write(*,*) ' ' + endif + if ( debug ) then + if( (l == 3 .or. l == 2) ) then + write(*,*) 'washout: hno3, hno3, qtnetlca,b, qtnetlax @ level = ',l + write(*,'(1p,5g15.7)') qttnew(l), qtt(l), qtnetlcxa, qtnetlcxb, qtnetlax + write(*,*) 'washout: qtwashax, qtevapax,fax,fama' + write(*,'(1p,5g15.7)') qtwashax, qtevapax, fax, fama + endif + endif + + QTTOPCAX = (QTTOPCA + QTNETLCXA)*CLOLDPCT + QTNETLCXB*CLNEWPCT + (QTTOPAA + QTNETLAX)*AMCLPCT + QTTOPAAX = (QTTOPCA + QTNETLCXA)*CLOLDAMPCT + QTNETLCXB*CLNEWAMPCT + (QTTOPAA + QTNETLAX)*AMPCT + QTTOPCA = QTTOPCAX + QTTOPAA = QTTOPAAX + end do level_loop + + if ( debug ) then + if( is_hno3 ) then + write(*,*) ' ' + write(*,*) 'washout: clwx_wrk' + write(*,'(1p,5g15.7)') clwx_wrk(1:le) + write(*,*) 'washout: cfr' + write(*,'(1p,5g15.7)') cfr(1:le) + write(*,*) 'washout: cfxx' + write(*,'(1p,5g15.7)') cfxx(1:le) + write(*,*) 'washout: cf trigger' + write(*,'(10l4)') cf_trigger(1:le) + write(*,*) 'washout: evaprate' + write(*,'(1p,5g15.7)') evaprate(1:le) + write(*,*) 'washout: rls' + write(*,'(1p,5g15.7)') rls(1:le) + write(*,*) 'washout: rls/garea' + write(*,'(1p,5g15.7)') rls_wrk(1:le) + write(*,*) 'washout: rnew_wrk' + write(*,'(1p,5g15.7)') rnew_wrk(1:le) + write(*,*) 'washout: rnew_flag' + write(*,'(10l4)') rnew_flag(1:le) + write(*,*) 'washout: deltarime_wrk' + write(*,'(1p,5g15.7)') deltarime_wrk(1:le) + write(*,*) 'washout: rama_wrk' + write(*,'(1p,5g15.7)') rama_wrk(1:le) + write(*,*) 'washout: fama_wrk' + write(*,'(1p,5g15.7)') fama_wrk(1:le) + write(*,*) 'washout: rca_wrk' + write(*,'(1p,5g15.7)') rca_wrk(1:le) + write(*,*) 'washout: fca_wrk' + write(*,'(1p,5g15.7)') fca_wrk(1:le) + write(*,*) 'washout: rcxa_wrk' + write(*,'(1p,5g15.7)') rcxa_wrk(1:le) + write(*,*) 'washout: fcxa_wrk' + write(*,'(1p,5g15.7)') fcxa_wrk(1:le) + write(*,*) 'washout: rcxb_wrk' + write(*,'(1p,5g15.7)') rcxb_wrk(1:le) + write(*,*) 'washout: fcxb_wrk' + write(*,'(1p,5g15.7)') fcxb_wrk(1:le) + write(*,*) 'washout: rax1_wrk' + write(*,'(1p,5g15.7)') rax_wrk(1:le,1) + write(*,*) 'washout: fax1_wrk' + write(*,'(1p,5g15.7)') fax_wrk(1:le,1) + write(*,*) 'washout: rax2_wrk' + write(*,'(1p,5g15.7)') rax_wrk(1:le,2) + write(*,*) 'washout: fax2_wrk' + write(*,'(1p,5g15.7)') fax_wrk(1:le,2) + write(*,*) 'washout: rls_flag' + write(*,'(1p,10l4)') rls_flag(1:le) + write(*,*) 'washout: freezing' + write(*,'(1p,10l4)') freezing(1:le) + write(*,*) 'washout: qtnetlcxa' + write(*,'(1p,5g15.7)') frc(1:le,1) + write(*,*) 'washout: qtnetlcxb' + write(*,'(1p,5g15.7)') frc(1:le,2) + write(*,*) 'washout: qtnetlax' + write(*,'(1p,5g15.7)') frc(1:le,3) + write(*,*) ' ' + endif + endif +!----------------------------------------------------------------------- +! reload new tracer mass and rescale moments: check upper limits (LE) +!----------------------------------------------------------------------- + QTTJFL(:le,N) = QTTNEW(:le) + + end do species_loop +! + return + end subroutine washo +!--------------------------------------------------------------------- + subroutine DISGAS (CLWX,CFX,MOLMASS,HSTAR,TM,PR,QM,QT,QTDIS) +!--------------------------------------------------------------------- + implicit none + real(r8), intent(in) :: CLWX,CFX !cloud water,cloud fraction + real(r8), intent(in) :: MOLMASS !molecular mass of tracer + real(r8), intent(in) :: HSTAR !Henry's Law coeffs A*exp(-B/T) + real(r8), intent(in) :: TM !temperature of box (K) + real(r8), intent(in) :: PR !pressure of box (hPa) + real(r8), intent(in) :: QM !air mass in box (kg) + real(r8), intent(in) :: QT !tracer in box (kg) + real(r8), intent(out) :: QTDIS !tracer dissolved in aqueous phase + + real(r8) MUEMP + real(r8), parameter :: INV298 = 1._r8/298._r8 + real(r8), parameter :: TMIX=258._r8 + real(r8), parameter :: RETEFF=0.5_r8 +!---Next calculate rate of uptake of tracer + +!---effective Henry's Law constant: H* = moles-T / liter-precip / press(atm-T) +!---p(atm of tracer-T) = (QT/QM) * (.029/MolWt-T) * pressr(hPa)/1000 +!---limit temperature effects to T above freezing +!----MU from fit to Kaercher and Voigt (2006) + + if(TM .ge. TICE) then + QTDIS=(HSTAR*(QT/(QM*CFX))*0.029_r8*(PR/1.0e3_r8))*(CLWX*QM) + elseif (TM .le. TMIX) then + MUEMP=exp(-14.2252_r8+(1.55704e-1_r8*TM)-(7.1929e-4_r8*(TM**2.0_r8))) + QTDIS=MUEMP*(MOLMASS/18._r8)*(CLWX*QM) + else + QTDIS=RETEFF*((HSTAR*(QT/(QM*CFX))*0.029_r8*(PR/1.0e3_r8))*(CLWX*QM)) + endif + + return + end subroutine DISGAS + +!----------------------------------------------------------------------- + subroutine RAINGAS (RRAIN,DTSCAV,CLWX,CFX,QM,QT,QTDIS,QTRAIN) +!----------------------------------------------------------------------- +!---New trace-gas rainout from large-scale precip with two time scales, +!---one based on precip formation from cloud water and one based on +!---Henry's Law solubility: correct limit for delta-t +!--- +!---NB this code does not consider the aqueous dissociation (eg, C-q) +!--- that makes uptake of HNO3 and H2SO4 so complete. To do so would +!--- require that we keep track of the pH of the falling rain. +!---THUS the Henry's Law coefficient KHA needs to be enhanced to incldue this! +!---ALSO the possible formation of other soluble species from, eg, CH2O, H2O2 +!--- can be considered with enhanced values of KHA. +!--- +!---Does NOT now use RMC (moist conv rain) but could, assuming 30% coverage +!----------------------------------------------------------------------- + implicit none + real(r8), intent(in) :: RRAIN !new rain formation in box (kg/s) + real(r8), intent(in) :: DTSCAV !time step (s) + real(r8), intent(in) :: CLWX,CFX !cloud water and cloud fraction + real(r8), intent(in) :: QM !air mass in box (kg) + real(r8), intent(in) :: QT !tracer in box (kg) + real(r8), intent(in) :: QTDIS !tracer in aqueous phase (kg) + real(r8), intent(out) :: QTRAIN !tracer picked up by new rain + + real(r8) QTLF,QTDISSTAR + + + + + + QTDISSTAR=(QTDIS*(QT*CFX))/(QTDIS+(QT*CFX)) + +!---Tracer Loss frequency (1/s) within cloud fraction: + QTLF = (RRAIN*QTDISSTAR)/(CLWX*QM*QT*CFX) + +!---in time = DTSCAV, the amount of QTT scavenged is calculated +!---from CF*AMOUNT OF UPTAKE + QTRAIN = QT*CFX*(1._r8 - exp(-DTSCAV*QTLF)) + + return + end subroutine RAINGAS + + +!----------------------------------------------------------------------- + subroutine WASHGAS (RWASH,BOXF,DTSCAV,QTRTOP,HSTAR,TM,PR,QM, & + QT,QTWASH,QTEVAP) +!----------------------------------------------------------------------- +!---for most gases below-cloud washout assume Henry-Law equilib with precip +!---assumes that precip is liquid, if frozen, do not call this sub +!---since solubility is moderate, fraction of box with rain does not matter +!---NB this code does not consider the aqueous dissociation (eg, C-q) +!--- that makes uptake of HNO3 and H2SO4 so complete. To do so would +!--- require that we keep track of the pH of the falling rain. +!---THUS the Henry's Law coefficient KHA needs to be enhanced to incldue this! +!---ALSO the possible formation of other soluble species from, eg, CH2O, H2O2 +!--- can be considered with enhanced values of KHA. +!----------------------------------------------------------------------- + implicit none + real(r8), intent(in) :: RWASH ! precip leaving bottom of box (kg/s) + real(r8), intent(in) :: BOXF ! fraction of box with washout + real(r8), intent(in) :: DTSCAV ! time step (s) + real(r8), intent(in) :: QTRTOP ! tracer-T in rain entering top of box +! over time step (kg) + real(r8), intent(in) :: HSTAR ! Henry's Law coeffs A*exp(-B/T) + real(r8), intent(in) :: TM ! temperature of box (K) + real(r8), intent(in) :: PR ! pressure of box (hPa) + real(r8), intent(in) :: QT ! tracer in box (kg) + real(r8), intent(in) :: QM ! air mass in box (kg) + real(r8), intent(out) :: QTWASH ! tracer picked up by precip (kg) + real(r8), intent(out) :: QTEVAP ! tracer evaporated from precip (kg) + + real(r8), parameter :: INV298 = 1._r8/298._r8 + real(r8) :: FWASH, QTMAX, QTDIF + +!---effective Henry's Law constant: H* = moles-T / liter-precip / press(atm-T) +!---p(atm of tracer-T) = (QT/QM) * (.029/MolWt-T) * pressr(hPa)/1000 +!---limit temperature effects to T above freezing + +! +! jfl +! +! added test for BOXF = 0. +! + if ( BOXF == 0._r8 ) then + QTWASH = 0._r8 + QTEVAP = 0._r8 + return + end if + +!---effective washout frequency (1/s): + FWASH = (RWASH*HSTAR*29.e-6_r8*PR)/(QM*BOXF) +!---equilib amount of T (kg) in rain thru bottom of box over time step + QTMAX = QT*FWASH*DTSCAV + if (QTMAX .gt. QTRTOP) then +!---more of tracer T can go into rain + QTDIF = min (QT, QTMAX-QTRTOP) + QTWASH = QTDIF * (1._r8 - exp(-DTSCAV*FWASH)) + QTEVAP=0._r8 + else +!--too much of T in rain, must degas/evap T + QTWASH = 0._r8 + QTEVAP = QTRTOP - QTMAX + endif + + return + end subroutine WASHGAS + +!----------------------------------------------------------------------- + function DEMPIRICAL (CWATER,RRATE) +!----------------------------------------------------------------------- + use shr_spfn_mod, only: shr_spfn_gamma + + implicit none + real(r8), intent(in) :: CWATER + real(r8), intent(in) :: RRATE + + real(r8) :: DEMPIRICAL + + real(r8) RRATEX,WX,THETA,PHI,ETA,BETA,ALPHA,BEE + real(r8) GAMTHETA,GAMBETA + + + + RRATEX=RRATE*3600._r8 !mm/hr + WX=CWATER*1.0e3_r8 !g/m3 + + if(RRATEX .gt. 0.04_r8) then + THETA=exp(-1.43_r8*dlog10(7._r8*RRATEX))+2.8_r8 + else + THETA=5._r8 + endif + PHI=RRATEX/(3600._r8*10._r8) !cgs units + ETA=exp((3.01_r8*THETA)-10.5_r8) + BETA=THETA/(1._r8+0.638_r8) + ALPHA=exp(4._r8*(BETA-3.5_r8)) + BEE=(.638_r8*THETA/(1._r8+.638_r8))-1.0_r8 + GAMTHETA = shr_spfn_gamma(THETA) + GAMBETA = shr_spfn_gamma(BETA+1._r8) + DEMPIRICAL=(((WX*ETA*GAMTHETA)/(1.0e6_r8*ALPHA*PHI*GAMBETA))** & + (-1._r8/BEE))*10._r8 ! in mm (wx/1e6 for cgs) + + + return + end function DEMPIRICAL +! +end module mo_neu_wetdep diff --git a/src/chemistry/geoschem/mo_setinv.F90 b/src/chemistry/geoschem/mo_setinv.F90 new file mode 120000 index 0000000000..eeca85151d --- /dev/null +++ b/src/chemistry/geoschem/mo_setinv.F90 @@ -0,0 +1 @@ +../mozart/mo_setinv.F90 \ No newline at end of file diff --git a/src/chemistry/pp_geoschem/mo_sim_dat.F90 b/src/chemistry/geoschem/mo_sim_dat.F90 similarity index 81% rename from src/chemistry/pp_geoschem/mo_sim_dat.F90 rename to src/chemistry/geoschem/mo_sim_dat.F90 index 1e9005c437..44997c160e 100644 --- a/src/chemistry/pp_geoschem/mo_sim_dat.F90 +++ b/src/chemistry/geoschem/mo_sim_dat.F90 @@ -36,143 +36,198 @@ subroutine set_sim_dat ! cls_rxt_cnt(:,1) = (/ 37, 61, 0, 30 /) ! cls_rxt_cnt(:,4) = (/ 23, 174, 326, 191 /) - solsym(:273) = (/ 'CH2I2 ','CH2ICL ','CH2IBR ', & - 'NITs ','NIT ','AERI ', & - 'CO2 ','INDIOL ','ISALA ', & - 'ISALC ','ISN1OA ','ISN1OG ', & + ! GEOS-Chem tracers (advected species) are placed first along MAM + ! aerosols, as those will be constituents. MAM requires that there + ! is a linear mapping between solsym and constituents + + solsym(:318) = (/ 'ACET ','ACTA ','AERI ', & + 'ALD2 ','ALK4 ','ATOOH ', & + 'BCPI ','BCPO ','BENZ ', & + 'Br ','Br2 ','BrCl ', & + 'BrNO2 ','BrNO3 ','BrO ', & + 'BrSALA ','BrSALC ','C2H6 ', & + 'C3H8 ','CCl4 ','CFC11 ', & + 'CFC113 ','CFC114 ','CFC115 ', & + 'CFC12 ','CH2Br2 ','CH2Cl2 ', & + 'CH2I2 ','CH2IBr ','CH2ICl ', & + 'CH2O ','CH3Br ','CH3CCl3 ', & + 'CH3Cl ','CH3I ','CH4 ', & + 'CHBr3 ','CHCl3 ','Cl ', & + 'Cl2 ','Cl2O2 ','ClNO2 ', & + 'ClNO3 ','ClO ','ClOO ', & + 'CLOCK ', & + 'CO ','DMS ','DST1 ', & + 'DST2 ','DST3 ','DST4 ', & + 'EOH ','ETHLN ','ETNO3 ', & + 'ETP ','GLYC ','GLYX ', & + 'H1211 ','H1301 ','H2402 ', & + 'H2O ','H2O2 ','HAC ', & + 'HBr ','HC5A ','HCFC123 ', & + 'HCFC141b ','HCFC142b ','HCFC22 ', & + 'HCl ','HCOOH ','HI ', & + 'HMHP ','HMML ','HNO2 ', & + 'HNO3 ','HNO4 ','HOBr ', & + 'HOCl ','HOI ','HONIT ', & + 'HPALD1 ','HPALD2 ','HPALD3 ', & + 'HPALD4 ','HPETHNL ','I ', & + 'I2 ','I2O2 ','I2O3 ', & + 'I2O4 ','IBr ','ICHE ', & + 'ICl ','ICN ','ICPDH ', & + 'IDC ','IDCHP ','IDHDP ', & + 'IDHPE ','IDN ','IEPOXA ', & + 'IEPOXB ','IEPOXD ','IHN1 ', & + 'IHN2 ','IHN3 ','IHN4 ', & + 'INDIOL ','INO ','INPB ', & + 'INPD ','IO ','IONITA ', & + 'IONO ','IONO2 ','IPRNO3 ', & + 'ISALA ','ISALC ','ISOP ', & + 'ITCN ','ITHN ','LIMO ', & + 'LVOC ','LVOCOA ','MACR ', & + 'MACR1OOH ','MAP ','MCRDH ', & + 'MCRENOL ','MCRHN ','MCRHNB ', & + 'MCRHP ','MEK ','MENO3 ', & + 'MGLY ','MOH ','MONITA ', & + 'MONITS ','MONITU ','MP ', & + 'MPAN ','MPN ','MSA ', & + 'MTPA ','MTPO ','MVK ', & + 'MVKDH ','MVKHC ','MVKHCB ', & + 'MVKHP ','MVKN ','MVKPC ', & + 'N2O ','N2O5 ','NH3 ', & + 'NH4 ','NIT ','NITs ', & + 'NO ','NO2 ','NO3 ', & + 'NPRNO3 ','O3 ','OClO ', & + 'OCPI ','OCPO ','OCS ', & + 'OIO ','PAN ','pFe ', & + 'PIP ','PP ','PPN ', & + 'PROPNN ','PRPE ','PRPN ', & + 'PYAC ','R4N2 ','R4P ', & + 'RA3P ','RB3P ','RCHO ', & + 'RIPA ','RIPB ','RIPC ', & + 'RIPD ','RP ','SALA ', & + 'SALAAL ','SALACL ','SALC ', & + 'SALCAL ','SALCCL ','SO2 ', & + 'SO4 ','SO4s ','SOAGX ', & + 'SOAIE ','SOAP ','SOAS ', & + 'TOLU ','XYLE ','bc_a1 ', & + 'bc_a4 ','dst_a1 ','dst_a2 ', & + 'dst_a3 ','ncl_a1 ','ncl_a2 ', & + 'ncl_a3 ','num_a1 ','num_a2 ', & + 'num_a3 ','num_a4 ','pom_a1 ', & + 'pom_a4 ','so4_a1 ','so4_a2 ', & + 'so4_a3 ','soa1_a1 ','soa1_a2 ', & + 'soa2_a1 ','soa2_a2 ','soa3_a1 ', & + 'soa3_a2 ','soa4_a1 ','soa4_a2 ', & + 'soa5_a1 ','soa5_a2 ','H2SO4 ', & + 'SOAG0 ','SOAG1 ','SOAG2 ', & + 'SOAG3 ','SOAG4 ','CO2 ', & 'LBRO2H ','LBRO2N ','LISOPOH ', & 'LISOPNO3 ','LTRO2H ','LTRO2N ', & - 'LVOCOA ','LVOC ','LXRO2H ', & - 'LXRO2N ','MSA ','PYAC ', & - 'SO4H1 ','SO4H2 ','SOAGX ', & - 'SOAIE ','SOAME ','IMAE ', & - 'SOAMG ','POx ','LOx ', & - 'PCO ','LCO ','PSO4 ', & - 'LCH4 ','PH2O2 ','I2O4 ', & - 'DHDN ','DHDC ','I2O2 ', & - 'MONITA ','BENZ ','CH3CCL3 ', & - 'H1301 ','H2402 ','I2O3 ', & - 'PMNN ','PPN ','TOLU ', & - 'BRNO2 ','CCL4 ','CFC11 ', & - 'CFC12 ','CFC113 ','CFC114 ', & - 'CFC115 ','CH3I ','H1211 ', & - 'IBR ','IEPOXD ','INO ', & - 'N2O ','TRO2 ','BRO2 ', & - 'IEPOXA ','IEPOXB ','IONITA ', & - 'N ','OCS ','XRO2 ', & - 'HI ','MAP ','ICL ', & - 'IMAO3 ','MPN ','CHBR3 ', & - 'CHCL3 ','CL2O2 ','CH2BR2 ', & - 'CH2CL2 ','HCFC141b ','HCFC142b ', & - 'IONO ','HCFC123 ','HCFC22 ', & - 'OIO ','RA3P ','RB3P ', & - 'XYLE ','DMS ','CLNO2 ', & - 'ETP ','CH3BR ','CH3CL ', & - 'HNO4 ','CLOO ','OCLO ', & - 'PAN ','RP ','HNO2 ', & - 'ALK4 ','PP ','PRPN ', & - 'SO4 ','BRCL ','PIP ', & - 'R4P ','HPALD ','C3H8 ', & - 'DHPCARP ','HOI ','HC187 ', & - 'HPC52O2 ','VRP ','ATOOH ', & - 'BR2 ','IAP ','MOBA ', & - 'HONIT ','DHMOB ','RIPB ', & - 'MP ','ISNP ','BRSALA ', & - 'BRSALC ','MAOP ','MRP ', & - 'RIPA ','RIPD ','EOH ', & - 'ETHLN ','N2O5 ','INPN ', & - 'MTPA ','MTPO ','NPMN ', & - 'C2H6 ','IONO2 ','MOBAOO ', & - 'DIBOO ','LIMO ','IPMN ', & - 'H ','MACRNO2 ','BRNO3 ', & - 'ROH ','MONITS ','CL2 ', & - 'I2 ','ISOPNB ','ISNOHOO ', & - 'CH4 ','MVKOO ','ISNOOB ', & - 'GAOO ','CH3CHOO ','MGLYOO ', & - 'IEPOXOO ','GLYX ','MVKN ', & - 'MGLOO ','PRN1 ','MONITU ', & - 'A3O2 ','PROPNN ','ISNOOA ', & - 'MAN2 ','PO2 ','ISOPNDO2 ', & - 'HCOOH ','B3O2 ','MACROO ', & - 'R4N1 ','MAOPO2 ','ISOP ', & - 'H2O2 ','ATO2 ','I ', & - 'RCO3 ','OLNN ','OLND ', & - 'LIMO2 ','MACRN ','IO ', & - 'KO2 ','HOBR ','ISOPNBO2 ', & - 'HC5OO ','PIO2 ','HNO3 ', & - 'ISOPND ','NMAO3 ','ACTA ', & - 'HOCL ','VRO2 ','ISN1 ', & - 'CH2OO ','GLYC ','CLNO3 ', & - 'MGLY ','ACET ','HC5 ', & - 'RIO2 ','INO2 ','R4O2 ', & - 'ETO2 ','R4N2 ','HAC ', & - 'MRO2 ','BRO ','PRPE ', & - 'RCHO ','MEK ','MACR ', & - 'CH2O ','ALD2 ','MVK ', & - 'MCO3 ','SO2 ','HCL ', & - 'HBR ','H2O ','CLO ', & - 'HO2 ','OH ','BR ', & - 'O ','NO2 ','MO2 ', & - 'NO3 ','NO ','O3 ', & - 'CL ','CO ','O1D ', & - 'H2 ','MOH ','N2 ', & - 'O2 ','RCOOH ','SO4s ', & - 'NH3 ','NH4 ','BCPI ', & - 'OCPI ','BCPO ','OCPO ', & - 'DST1 ','DST2 ','DST3 ', & - 'DST4 ','SALA ','SALC ', & - 'TSOG1 ','TSOG2 ','TSOG3 ', & - 'TSOG0 ','TSOA1 ','TSOA2 ', & - 'TSOA3 ','TSOA0 ','ASOG1 ', & - 'ASOG2 ','ASOG3 ','ASOAN ', & - 'ASOA1 ','ASOA2 ','ASOA3 ', & - 'SOAP ','SOAS ','PFE ' /) + 'LXRO2H ','LXRO2N ','SO4H1 ', & + 'SO4H2 ','SO4H3 ','SO4H4 ', & + 'POx ','LOx ','PCO ', & + 'LCO ','PSO4 ','LCH4 ', & + 'PH2O2 ','BRO2 ','TRO2 ', & + 'N ','XRO2 ','HPALD2OO ', & + 'HPALD1OO ','INA ','C4HVP1 ', & + 'C4HVP2 ','IDNOO ','ICNOO ', & + 'ISOPNOO2 ','ROH ','ISOPNOO1 ', & + 'IDHNDOO1 ','IDHNDOO2 ','H ', & + 'IHPOO2 ','IHPOO1 ','IHPOO3 ', & + 'IHPNDOO ','ICHOO ','R4N1 ', & + 'PRN1 ','MVKOHOO ','MCROHOO ', & + 'MACR1OO ','PO2 ','OLNN ', & + 'OLND ','ETO2 ','IHPNBOO ', & + 'RCO3 ','LIMO2 ','KO2 ', & + 'IEPOXAOO ','IEPOXBOO ','CH3CHOO ', & + 'PIO2 ','IDHNBOO ','A3O2 ', & + 'IHOO4 ','IHOO1 ','INO2D ', & + 'INO2B ','MACRNO2 ','ATO2 ', & + 'OTHRO2 ','R4O2 ','B3O2 ', & + 'CH2OO ','MCO3 ','MO2 ', & + 'O1D ','OH ','HO2 ', & + 'O ','H2 ','N2 ', & + 'O2 ','RCOOH ' /) + + inv_lst(: 6) = (/ 'M ', 'N2 ', 'O2 ', & + 'H2 ', 'MOH ', 'RCOOH ' /) + + fix_mass(: 6) = (/ 0.00000000_r8, 28.0134800_r8, 31.9988000_r8, 2.020000_r8, 32.050000_r8, & + 74.090000_r8 /) + + adv_mass(:318) = (/ 58.090000_r8, 60.060000_r8, 126.900000_r8, 44.060000_r8, 58.120000_r8, & + 90.090000_r8, 12.010000_r8, 12.010000_r8, 78.120000_r8, 79.900000_r8, & + 159.800000_r8, 115.450000_r8, 125.910000_r8, 141.910000_r8, 95.900000_r8, & + 79.900000_r8, 79.900000_r8, 30.080000_r8, 44.110000_r8, 153.820000_r8, & + 137.370000_r8, 187.380000_r8, 170.920000_r8, 154.470000_r8, 120.910000_r8, & + 173.830000_r8, 84.930000_r8, 267.840000_r8, 220.840000_r8, 176.380000_r8, & + 30.030000_r8, 94.940000_r8, 133.350000_r8, 50.450000_r8, 141.940000_r8, & + 16.050000_r8, 252.730000_r8, 119.350000_r8, 35.450000_r8, 70.900000_r8, & + 102.910000_r8, 81.450000_r8, 97.450000_r8, 51.450000_r8, 67.450000_r8, & + 1.000000_r8, & + 28.010000_r8, 62.130000_r8, 29.000000_r8, 29.000000_r8, 29.000000_r8, & + 29.000000_r8, 46.080000_r8, 105.060000_r8, 91.080000_r8, 62.080000_r8, & + 60.060000_r8, 58.040000_r8, 165.360000_r8, 148.910000_r8, 259.820000_r8, & + 18.020000_r8, 34.020000_r8, 74.080000_r8, 80.910000_r8, 100.130000_r8, & + 152.930000_r8, 116.940000_r8, 100.500000_r8, 86.470000_r8, 36.450000_r8, & + 46.030000_r8, 127.910000_r8, 64.050000_r8, 102.100000_r8, 47.010000_r8, & + 63.010000_r8, 79.010000_r8, 96.910000_r8, 52.450000_r8, 143.890000_r8, & + 215.000000_r8, 116.130000_r8, 116.130000_r8, 116.130000_r8, 116.130000_r8, & + 76.060000_r8, 126.900000_r8, 253.800000_r8, 285.800000_r8, 301.800000_r8, & + 317.800000_r8, 206.900000_r8, 116.130000_r8, 162.450000_r8, 145.130000_r8, & + 150.150000_r8, 98.110000_r8, 148.130000_r8, 168.170000_r8, 150.150000_r8, & + 192.150000_r8, 106.140000_r8, 106.140000_r8, 106.140000_r8, 147.150000_r8, & + 147.150000_r8, 147.150000_r8, 147.150000_r8, 102.000000_r8, 156.910000_r8, & + 163.150000_r8, 163.150000_r8, 142.900000_r8, 14.010000_r8, 172.910000_r8, & + 188.910000_r8, 105.110000_r8, 126.900000_r8, 126.900000_r8, 68.130000_r8, & + 195.150000_r8, 197.170000_r8, 136.260000_r8, 154.190000_r8, 154.190000_r8, & + 70.100000_r8, 102.100000_r8, 76.060000_r8, 104.120000_r8, 86.100000_r8, & + 149.110000_r8, 149.110000_r8, 120.120000_r8, 72.110000_r8, 77.050000_r8, & + 72.070000_r8, 32.050000_r8, 14.010000_r8, 215.280000_r8, 215.280000_r8, & + 48.050000_r8, 147.100000_r8, 93.050000_r8, 96.100000_r8, 136.260000_r8, & + 136.260000_r8, 70.090000_r8, 105.130000_r8, 102.100000_r8, 102.100000_r8, & + 120.120000_r8, 149.120000_r8, 118.100000_r8, 44.020000_r8, 108.020000_r8, & + 17.040000_r8, 18.050000_r8, 62.010000_r8, 31.400000_r8, 30.010000_r8, & + 46.010000_r8, 62.010000_r8, 105.110000_r8, 48.000000_r8, 67.450000_r8, & + 12.010000_r8, 12.010000_r8, 60.070000_r8, 158.900000_r8, 121.060000_r8, & + 55.850000_r8, 186.280000_r8, 92.110000_r8, 135.080000_r8, 119.080000_r8, & + 42.090000_r8, 137.110000_r8, 88.070000_r8, 119.100000_r8, 90.140000_r8, & + 76.110000_r8, 76.110000_r8, 58.090000_r8, 118.150000_r8, 118.150000_r8, & + 118.150000_r8, 118.150000_r8, 90.090000_r8, 31.400000_r8, 31.400000_r8, & + 35.450000_r8, 31.400000_r8, 31.400000_r8, 35.450000_r8, 64.040000_r8, & + 96.060000_r8, 31.400000_r8, 58.040000_r8, 118.150000_r8, 150.000000_r8, & + 150.000000_r8, 92.150000_r8, 106.180000_r8, 12.011000_r8, 12.011000_r8, & + 135.064039_r8, 135.064039_r8, 135.064039_r8, 58.442468_r8, 58.442468_r8, & + 58.442468_r8, 1.007400_r8, 1.007400_r8, 1.007400_r8, 1.007400_r8, & + 12.011000_r8, 12.011000_r8, 115.107340_r8, 115.107340_r8, 115.107340_r8, & + 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, & + 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, & + 98.078400_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, & + 250.445000_r8, 44.010000_r8, -1.000000_r8, -1.000000_r8, -1.000000_r8, & + -1.000000_r8, -1.000000_r8, -1.000000_r8, -1.000000_r8, -1.000000_r8, & + 96.060000_r8, 96.060000_r8, 96.060000_r8, 96.060000_r8, -1.000000_r8, & + -1.000000_r8, -1.000000_r8, -1.000000_r8, -1.000000_r8, -1.000000_r8, & + -1.000000_r8, 159.130000_r8, 173.160000_r8, 14.010000_r8, 187.190000_r8, & + 147.120000_r8, 147.120000_r8, 146.140000_r8, 103.110000_r8, 103.110000_r8, & + 241.140000_r8, 194.140000_r8, 196.160000_r8, 60.110000_r8, 196.160000_r8, & + 196.160000_r8, 196.160000_r8, 1.010000_r8, 167.160000_r8, 167.160000_r8, & + 167.160000_r8, 212.160000_r8, 149.140000_r8, 150.130000_r8, 136.090000_r8, & + 119.110000_r8, 119.110000_r8, 101.090000_r8, 91.100000_r8, 230.270000_r8, & + 230.270000_r8, 61.070000_r8, 212.160000_r8, 89.080000_r8, 185.270000_r8, & + 101.090000_r8, 149.140000_r8, 149.140000_r8, 60.060000_r8, 185.270000_r8, & + 196.160000_r8, 75.100000_r8, 117.140000_r8, 117.140000_r8, 162.140000_r8, & + 162.140000_r8, 180.100000_r8, 89.080000_r8, 61.070000_r8, 89.130000_r8, & + 75.100000_r8, 46.030000_r8, 75.050000_r8, 47.040000_r8, 16.000000_r8, & + 17.010000_r8, 33.010000_r8, 16.000000_r8, 2.020000_r8, 28.020000_r8, & + 32.000000_r8, 74.090000_r8 /) + + extfrc_lst(: 1) = (/ ' ' /) - ! adv_mass(:221) = (/ 133.141340_r8, 104.142600_r8, 28.010400_r8, 12.011000_r8, 12.011000_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, 135.064039_r8, 135.064039_r8, 135.064039_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, 58.442468_r8, 58.442468_r8, 58.442468_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, 1.007400_r8, 1.007400_r8, & - ! 1.007400_r8, 1.007400_r8, 15.999400_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, 12.011000_r8, 12.011000_r8, 92.090400_r8, & - ! 90.075600_r8, 32.066000_r8, 146.056419_r8, 48.065400_r8, 64.064800_r8, & - ! 80.064200_r8, 115.107340_r8, 115.107340_r8, 115.107340_r8, 250.445000_r8, & - ! 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, & - ! 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_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, 186.241400_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, 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, 119.093400_r8, 115.063800_r8, & - ! 101.079200_r8, 117.078600_r8, 103.094000_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, 149.118600_r8, 187.166400_r8, 203.165800_r8, & - ! 18.014200_r8 /) + frc_from_dataset(: 1) = (/ .false. /) + + !extfrc_lst(: 17) = (/ 'so4_a2 ','NO ','NO2 ','SO2 ','SVOC ', & + ! 'pom_a1 ','pom_a4 ','so4_a1 ','CO ','bc_a1 ', & + ! 'bc_a4 ','num_a1 ','num_a2 ','num_a4 ','OH ', & + ! 'N ','AOA_NH ' /) ! crb_mass(:221) = (/ 60.055000_r8, 60.055000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & ! 180.165000_r8, 72.066000_r8, 72.066000_r8, 72.066000_r8, 60.055000_r8, & @@ -288,18 +343,6 @@ subroutine set_sim_dat ! 1621,1672,1699,1734,1776,1837,1862,1893,1917,1996, & ! 2022 /) - ! extfrc_lst(: 17) = (/ 'so4_a2 ','NO ','NO2 ','SO2 ','SVOC ', & - ! 'pom_a1 ','pom_a4 ','so4_a1 ','CO ','bc_a1 ', & - ! 'bc_a4 ','num_a1 ','num_a2 ','num_a4 ','OH ', & - ! 'N ','AOA_NH ' /) - - ! frc_from_dataset(: 17) = (/ .true., .true., .true., .true., .true., & - ! .true., .true., .true., .true., .true., & - ! .true., .true., .true., .true., .false., & - ! .false., .false. /) - - ! inv_lst(: 3) = (/ 'M ', 'N2 ', 'O2 ' /) - ! slvd_lst(: 34) = (/ 'ACBZO2 ', 'ALKO2 ', 'BENZO2 ', 'BZOO ', 'C2H5O2 ', & ! 'C3H7O2 ', 'C6H5O2 ', 'CH3CO3 ', 'CH3O2 ', 'DICARBO2 ', & ! 'ENEO2 ', 'EO ', 'EO2 ', 'HO2 ', 'HOCH2OO ', & diff --git a/src/chemistry/pp_geoschem/mo_tracname.F90 b/src/chemistry/geoschem/mo_tracname.F90 similarity index 90% rename from src/chemistry/pp_geoschem/mo_tracname.F90 rename to src/chemistry/geoschem/mo_tracname.F90 index 5d470483d1..be9c474506 100644 --- a/src/chemistry/pp_geoschem/mo_tracname.F90 +++ b/src/chemistry/geoschem/mo_tracname.F90 @@ -12,6 +12,6 @@ module mo_tracname ! modified to an arbitrary high #, was gas_pcnst. this would cause a memory ! overflow overwrite in mo_sim_dat, which allocates :273 larger than ! the default specified gas_pcnst (hplin, 5/16/20) - character(len=16) :: solsym(273) ! species names + character(len=16) :: solsym(318) ! species names end module mo_tracname diff --git a/src/chemistry/pp_geoschem/rate_diags.F90 b/src/chemistry/geoschem/rate_diags.F90 similarity index 100% rename from src/chemistry/pp_geoschem/rate_diags.F90 rename to src/chemistry/geoschem/rate_diags.F90 diff --git a/src/chemistry/pp_geoschem/short_lived_species.F90 b/src/chemistry/geoschem/short_lived_species.F90 similarity index 96% rename from src/chemistry/pp_geoschem/short_lived_species.F90 rename to src/chemistry/geoschem/short_lived_species.F90 index b4dc6d55ff..293aaa65cd 100644 --- a/src/chemistry/pp_geoschem/short_lived_species.F90 +++ b/src/chemistry/geoschem/short_lived_species.F90 @@ -17,7 +17,6 @@ module short_lived_species save private - !public :: map public :: register_short_lived_species public :: short_lived_species_initic public :: short_lived_species_writeic @@ -28,7 +27,6 @@ module short_lived_species public :: pbf_idx integer :: pbf_idx - !integer :: map(nslvd) character(len=16), parameter :: pbufname = 'ShortLivedSpecies' @@ -129,8 +127,6 @@ subroutine initialize_short_lived_species(ncid_ini, pbuf2d) allocate(tmpptr(pcols,pver,begchunk:endchunk)) do m=1,nslvd - !n = map(m) - !fieldname = solsym(n) write(fieldname,'(a,a)') trim(slvd_lst(m)) call infld( fieldname,ncid_ini,dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, & tmpptr, found, gridname='physgrid') @@ -170,8 +166,6 @@ subroutine set_short_lived_species( q, lchnk, ncol, pbuf ) if ( nslvd < 1 ) return do m=1,nslvd - !n = map(m) - !call pbuf_set_field(pbuf, pbf_idx, q(:,:,m), start=(/1,1,n/),kount=(/pcols,pver,1/)) call pbuf_set_field(pbuf, pbf_idx, q(:,:,m), start=(/1,1,m/),kount=(/pcols,pver,1/)) enddo @@ -195,9 +189,7 @@ subroutine get_short_lived_species( q, lchnk, ncol, pbuf ) if ( nslvd < 1 ) return do m=1,nslvd - !n = map(m) call pbuf_get_field(pbuf, pbf_idx, tmpptr, start=(/1,1,m/), kount=(/ pcols,pver,1 /)) - !q(:ncol,:,n) = tmpptr(:ncol,:) q(:ncol,:,m) = tmpptr(:ncol,:) enddo diff --git a/src/chemistry/geoschem/tracer_cnst.F90 b/src/chemistry/geoschem/tracer_cnst.F90 new file mode 120000 index 0000000000..be79edec09 --- /dev/null +++ b/src/chemistry/geoschem/tracer_cnst.F90 @@ -0,0 +1 @@ +../mozart/tracer_cnst.F90 \ No newline at end of file diff --git a/src/chemistry/geoschem/tracer_srcs.F90 b/src/chemistry/geoschem/tracer_srcs.F90 new file mode 120000 index 0000000000..136404bf05 --- /dev/null +++ b/src/chemistry/geoschem/tracer_srcs.F90 @@ -0,0 +1 @@ +../mozart/tracer_srcs.F90 \ No newline at end of file diff --git a/src/chemistry/pp_geoschem/upper_bc.F90 b/src/chemistry/geoschem/upper_bc.F90 similarity index 100% rename from src/chemistry/pp_geoschem/upper_bc.F90 rename to src/chemistry/geoschem/upper_bc.F90 diff --git a/src/chemistry/modal_aero/aero_model.F90 b/src/chemistry/modal_aero/aero_model.F90 index 23fa250357..8603420b87 100644 --- a/src/chemistry/modal_aero/aero_model.F90 +++ b/src/chemistry/modal_aero/aero_model.F90 @@ -179,13 +179,13 @@ 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 mo_chem_utls, only: get_spc_ndx use modal_aero_data, only: cnst_name_cw use modal_aero_data, only: modal_aero_data_init use rad_constituents,only: rad_cnst_get_info use dust_model, only: dust_init, dust_names, dust_active, dust_nbin, dust_nnum use seasalt_model, only: seasalt_init, seasalt_names, seasalt_active,seasalt_nbin - use drydep_mod, only: inidrydep + use aer_drydep_mod, only: inidrydep use wetdep, only: wetdep_init use modal_aero_calcsize, only: modal_aero_calcsize_init @@ -388,7 +388,7 @@ subroutine aero_model_init( pbuf2d ) call pbuf_set_field(pbuf2d, rate1_cw2pr_st_idx, 0.0_r8) do m = 1,ndrydep - + ! units if (drydep_list(m)(1:3) == 'num') then unit_basename = ' 1' @@ -418,7 +418,7 @@ subroutine aero_model_init( pbuf2d ) enddo do m = 1,nwetdep - + ! units if (wetdep_list(m)(1:3) == 'num') then unit_basename = ' 1' @@ -666,7 +666,7 @@ end subroutine aero_model_init subroutine aero_model_drydep ( state, pbuf, obklen, ustar, cam_in, dt, cam_out, ptend ) use dust_sediment_mod, only: dust_sediment_tend - use drydep_mod, only: d3ddflux, calcram + use aer_drydep_mod, only: d3ddflux, calcram use modal_aero_data, only: qqcw_get_field use modal_aero_data, only: cnst_name_cw use modal_aero_data, only: alnsg_amode diff --git a/src/chemistry/modal_aero/modal_aero_data.F90 b/src/chemistry/modal_aero/modal_aero_data.F90 index e45d254dcc..1f23b28f18 100644 --- a/src/chemistry/modal_aero/modal_aero_data.F90 +++ b/src/chemistry/modal_aero/modal_aero_data.F90 @@ -110,7 +110,7 @@ module modal_aero_data logical, public, protected :: soa_multi_species = .false. - character(len=16), allocatable :: xname_massptr(:,:) ! names of species in each mode + character(len=16), public, protected, allocatable :: xname_massptr(:,:) ! names of species in each mode character(len=16), allocatable :: xname_massptrcw(:,:) ! names of cloud-borne species in each mode complex(r8), allocatable :: & @@ -451,7 +451,7 @@ subroutine modal_aero_data_init(pbuf2d) lptr2_soa_g_amode(:) = -1 soa_ndx = 0 do i = 1, pcnst - if (cnst_name(i)(:4) == 'SOAG') then + if (cnst_name(i)(:4) == 'SOAG' .and. cnst_name(i)(:5) /= 'SOAGX') then soa_ndx = soa_ndx+1 lptr2_soa_g_amode(soa_ndx) = i endif diff --git a/src/chemistry/mozart/mo_chem_utls.F90 b/src/chemistry/mozart/mo_chem_utls.F90 index 1620422e12..6d47ed3a0a 100644 --- a/src/chemistry/mozart/mo_chem_utls.F90 +++ b/src/chemistry/mozart/mo_chem_utls.F90 @@ -3,6 +3,7 @@ module mo_chem_utls private public :: get_spc_ndx, get_het_ndx, get_extfrc_ndx, get_rxt_ndx, get_inv_ndx + public :: utls_chem_is save @@ -159,4 +160,15 @@ integer function get_rxt_ndx( rxt_tag ) end function get_rxt_ndx + logical function utls_chem_is (name) result(chem_is) + use string_utils, only : to_lower + + character(len=*), intent(in) :: name + chem_is = .false. + if ( to_lower(name) == 'mozart' ) then + chem_is = .true. + endif + + end function utls_chem_is + end module mo_chem_utls diff --git a/src/chemistry/pp_geoschem/aero_model.F90 b/src/chemistry/pp_geoschem/aero_model.F90 deleted file mode 100644 index 3c9133adf6..0000000000 --- a/src/chemistry/pp_geoschem/aero_model.F90 +++ /dev/null @@ -1,1150 +0,0 @@ -!=============================================================================== -! Bulk Aerosol Model -!=============================================================================== -module aero_model - use shr_kind_mod, only: r8 => shr_kind_r8 - use constituents, only: pcnst, cnst_name, cnst_get_ind - use ppgrid, only: pcols, pver, pverp - use cam_abortutils, only: endrun - use cam_logfile, only: iulog - use perf_mod, only: t_startf, t_stopf - use camsrfexch, only: cam_in_t, cam_out_t - use physics_types, only: physics_state, physics_ptend, physics_ptend_init - use physics_buffer, only: physics_buffer_desc - use physconst, only: gravit, rair - use spmd_utils, only: masterproc - use physics_buffer, only: pbuf_get_field, pbuf_get_index - use cam_history, only: outfld - use infnan, only: nan, assignment(=) - - 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 - - integer :: so4_ndx, cb2_ndx, oc2_ndx, nit_ndx - integer :: soa_ndx, soai_ndx, soam_ndx, soab_ndx, soat_ndx, soax_ndx - - ! Namelist variables - character(len=16) :: wetdep_list(pcnst) = ' ' - character(len=16) :: drydep_list(pcnst) = ' ' - - integer :: ndrydep = 0 - integer,allocatable :: drydep_indices(:) - integer :: nwetdep = 0 - integer,allocatable :: wetdep_indices(:) - logical :: drydep_lq(pcnst) - logical :: wetdep_lq(pcnst) - - integer :: fracis_idx = 0 - - real(r8) :: aer_sol_facti(pcnst) ! in-cloud solubility factor - real(r8) :: aer_sol_factb(pcnst) ! below-cloud solubility factor - real(r8) :: aer_scav_coef(pcnst) - -contains - - !============================================================================= - ! reads aerosol namelist options - !============================================================================= - subroutine aero_model_readnl(nlfile) - - use namelist_utils, only: find_group_name - use units, only: getunit, freeunit - 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 - character(len=16) :: aer_wetdep_list(pcnst) = ' ' - character(len=16) :: aer_drydep_list(pcnst) = ' ' - - namelist /aerosol_nl/ aer_wetdep_list, aer_drydep_list - namelist /aerosol_nl/ aer_sol_facti, aer_sol_factb, aer_scav_coef - !----------------------------------------------------------------------------- - !aer_sol_facti = nan - !aer_sol_factb = nan - !aer_scav_coef = nan - - !! 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(aer_wetdep_list, len(aer_wetdep_list(1))*pcnst, mpichar, 0, mpicom) - !call mpibcast(aer_drydep_list, len(aer_drydep_list(1))*pcnst, mpichar, 0, mpicom) - !call mpibcast(aer_sol_facti, pcnst, mpir8, 0, mpicom) - !call mpibcast(aer_sol_factb, pcnst, mpir8, 0, mpicom) - !call mpibcast(aer_scav_coef, pcnst, mpir8, 0, mpicom) -#endif - - !wetdep_list = aer_wetdep_list - !drydep_list = aer_drydep_list - - end subroutine aero_model_readnl - - !============================================================================= - !============================================================================= - subroutine aero_model_register() - !use mo_setsoa, only : soa_register - - !call soa_register() - end subroutine aero_model_register - - !============================================================================= - !============================================================================= - subroutine aero_model_init( pbuf2d ) - - !use mo_chem_utls, only: get_inv_ndx, get_spc_ndx - use cam_history, only: addfld, add_default, horiz_only - use phys_control, only: phys_getopts - !use mo_aerosols, only: aerosols_inti - !use mo_setsoa, only: soa_inti - !use dust_model, only: dust_init - !use seasalt_model, only: seasalt_init - !use drydep_mod, only: inidrydep - !use wetdep, only: wetdep_init - !use mo_setsox, only: has_sox - - ! args - type(physics_buffer_desc), pointer :: pbuf2d(:,:) - - ! local vars - character(len=12), parameter :: subrname = 'aero_model_init' - integer :: m, id - character(len=20) :: dummy - logical :: history_aerosol ! Output MAM or SECT aerosol tendencies - - !call phys_getopts( history_aerosol_out=history_aerosol ) - !call aerosols_inti() - !call soa_inti(pbuf2d) - !call dust_init() - !call seasalt_init() - !call wetdep_init() - - !fracis_idx = pbuf_get_index('FRACIS') - - !nwetdep = 0 - !ndrydep = 0 - - !count_species: do m = 1,pcnst - ! if ( len_trim(wetdep_list(m)) /= 0 ) then - ! nwetdep = nwetdep+1 - ! endif - ! if ( len_trim(drydep_list(m)) /= 0 ) then - ! ndrydep = ndrydep+1 - ! endif - !enddo count_species - ! - !if (nwetdep>0) & - ! allocate(wetdep_indices(nwetdep)) - !if (ndrydep>0) & - ! allocate(drydep_indices(ndrydep)) - - !do m = 1,ndrydep - ! call cnst_get_ind ( drydep_list(m), id, abort=.false. ) - ! if (id>0) then - ! drydep_indices(m) = id - ! else - ! call endrun(subrname//': invalid drydep species: '//trim(drydep_list(m)) ) - ! endif - - ! if (masterproc) then - ! write(iulog,*) subrname//': '//drydep_list(m)//' will have drydep applied' - ! endif - !enddo - !do m = 1,nwetdep - ! call cnst_get_ind ( wetdep_list(m), id, abort=.false. ) - ! if (id>0) then - ! wetdep_indices(m) = id - ! else - ! call endrun(subrname//': invalid wetdep species: '//trim(wetdep_list(m)) ) - ! endif - ! - ! if (masterproc) then - ! write(iulog,*) subrname//': '//wetdep_list(m)//' will have wet removal' - ! endif - !enddo - ! - !! set flags for drydep tendencies - !drydep_lq(:) = .false. - !do m=1,ndrydep - ! id = drydep_indices(m) - ! drydep_lq(id) = .true. - !enddo - - !! set flags for wetdep tendencies - !wetdep_lq(:) = .false. - !do m=1,nwetdep - ! id = wetdep_indices(m) - ! wetdep_lq(id) = .true. - !enddo - - !do m = 1,ndrydep - ! - ! dummy = trim(drydep_list(m)) // 'TB' - ! call addfld (dummy,horiz_only, 'A','kg/m2/s',trim(drydep_list(m))//' turbulent dry deposition flux') - ! if ( history_aerosol ) then - ! call add_default (dummy, 1, ' ') - ! endif - ! dummy = trim(drydep_list(m)) // 'GV' - ! call addfld (dummy,horiz_only, 'A','kg/m2/s',trim(drydep_list(m)) //' gravitational dry deposition flux') - ! if ( history_aerosol ) then - ! call add_default (dummy, 1, ' ') - ! endif - ! dummy = trim(drydep_list(m)) // 'DD' - ! call addfld (dummy,horiz_only, 'A','kg/m2/s',trim(drydep_list(m)) //' dry deposition flux at bottom (grav + turb)') - ! if ( history_aerosol ) then - ! call add_default (dummy, 1, ' ') - ! endif - ! dummy = trim(drydep_list(m)) // 'DT' - ! call addfld (dummy,(/ 'lev' /), 'A','kg/kg/s',trim(drydep_list(m))//' dry deposition') - ! if ( history_aerosol ) then - ! call add_default (dummy, 1, ' ') - ! endif - ! dummy = trim(drydep_list(m)) // 'DV' - ! call addfld (dummy,(/ 'lev' /), 'A','m/s',trim(drydep_list(m))//' deposition velocity') - ! if ( history_aerosol ) then - ! call add_default (dummy, 1, ' ') - ! endif - - !enddo - ! - !if (ndrydep>0) then - - ! call inidrydep(rair, gravit) - - ! dummy = 'RAM1' - ! call addfld (dummy,horiz_only, 'A','frac','RAM1') - ! if ( history_aerosol ) then - ! call add_default (dummy, 1, ' ') - ! endif - ! dummy = 'airFV' - ! call addfld (dummy,horiz_only, 'A','frac','FV') - ! if ( history_aerosol ) then - ! call add_default (dummy, 1, ' ') - ! endif - - ! if (sslt_active) then - ! dummy = 'SSTSFDRY' - ! call addfld (dummy,horiz_only, 'A','kg/m2/s','Sea salt deposition flux at surface') - ! if ( history_aerosol ) then - ! call add_default (dummy, 1, ' ') - ! endif - ! endif - ! if (dust_active) then - ! dummy = 'DSTSFDRY' - ! call addfld (dummy,horiz_only, 'A','kg/m2/s','Dust deposition flux at surface') - ! if ( history_aerosol ) then - ! call add_default (dummy, 1, ' ') - ! endif - ! endif - - !endif - - !do m = 1,nwetdep - - ! call addfld (trim(wetdep_list(m))//'SFWET', horiz_only, 'A','kg/m2/s', & - ! 'Wet deposition flux at surface') - ! call addfld (trim(wetdep_list(m))//'SFSIC', horiz_only, 'A','kg/m2/s', & - ! 'Wet deposition flux (incloud, convective) at surface') - ! call addfld (trim(wetdep_list(m))//'SFSIS', horiz_only, 'A','kg/m2/s', & - ! 'Wet deposition flux (incloud, stratiform) at surface') - ! call addfld (trim(wetdep_list(m))//'SFSBC', horiz_only, 'A','kg/m2/s', & - ! 'Wet deposition flux (belowcloud, convective) at surface') - ! call addfld (trim(wetdep_list(m))//'SFSBS', horiz_only, 'A','kg/m2/s', & - ! 'Wet deposition flux (belowcloud, stratiform) at surface') - ! call addfld (trim(wetdep_list(m))//'WET', (/ 'lev' /), 'A','kg/kg/s', & - ! 'wet deposition tendency') - ! call addfld (trim(wetdep_list(m))//'SIC', (/ 'lev' /), 'A','kg/kg/s', & - ! trim(wetdep_list(m))//' ic wet deposition') - ! call addfld (trim(wetdep_list(m))//'SIS', (/ 'lev' /), 'A','kg/kg/s', & - ! trim(wetdep_list(m))//' is wet deposition') - ! call addfld (trim(wetdep_list(m))//'SBC', (/ 'lev' /), 'A','kg/kg/s', & - ! trim(wetdep_list(m))//' bc wet deposition') - ! call addfld (trim(wetdep_list(m))//'SBS', (/ 'lev' /), 'A','kg/kg/s', & - ! trim(wetdep_list(m))//' bs wet deposition') - !enddo - ! - !if (nwetdep>0) then - ! if (sslt_active) then - ! dummy = 'SSTSFWET' - ! call addfld (dummy,horiz_only, 'A','kg/m2/s','Sea salt wet deposition flux at surface') - ! if ( history_aerosol ) then - ! call add_default (dummy, 1, ' ') - ! endif - ! endif - ! if (dust_active) then - ! dummy = 'DSTSFWET' - ! call addfld (dummy,horiz_only, 'A','kg/m2/s','Dust wet deposition flux at surface') - ! if ( history_aerosol ) then - ! call add_default (dummy, 1, ' ') - ! endif - ! endif - !endif - ! - !if (dust_active) then - ! ! emissions diagnostics .... - - ! do m = 1, dust_nbin - ! dummy = trim(dust_names(m)) // 'SF' - ! call addfld (dummy,horiz_only, 'A','kg/m2/s',trim(dust_names(m))//' dust surface emission') - ! if (history_aerosol) then - ! call add_default (dummy, 1, ' ') - ! endif - ! enddo - - ! dummy = 'DSTSFMBL' - ! call addfld (dummy,horiz_only, 'A','kg/m2/s','Mobilization flux at surface') - ! if (history_aerosol) then - ! call add_default (dummy, 1, ' ') - ! endif - - ! dummy = 'LND_MBL' - ! call addfld (dummy,horiz_only, 'A','frac','Soil erodibility factor') - ! if (history_aerosol) then - ! call add_default (dummy, 1, ' ') - ! endif - - !endif - ! - !if (sslt_active) then - - ! dummy = 'SSTSFMBL' - ! call addfld (dummy,horiz_only, 'A','kg/m2/s','Mobilization flux at surface') - ! if (history_aerosol) then - ! call add_default (dummy, 1, ' ') - ! endif - - ! do m = 1, seasalt_nbin - ! dummy = trim(seasalt_names(m)) // 'SF' - ! call addfld (dummy,horiz_only, 'A','kg/m2/s',trim(seasalt_names(m))//' seasalt surface emission') - ! if (history_aerosol) then - ! call add_default (dummy, 1, ' ') - ! endif - ! enddo - - !endif - - !if( has_sox ) then - ! call addfld( 'XPH_LWC',(/ 'lev' /), 'A','kg/kg', 'pH value multiplied by lwc') - - ! if ( history_aerosol ) then - ! call add_default ('XPH_LWC', 1, ' ') - ! endif - !endif - - !so4_ndx = get_spc_ndx( 'SO4' ) - !soa_ndx = get_spc_ndx( 'SOA' ) - !soai_ndx = get_spc_ndx( 'SOAI' ) - !soam_ndx = get_spc_ndx( 'SOAM' ) - !soab_ndx = get_spc_ndx( 'SOAB' ) - !soat_ndx = get_spc_ndx( 'SOAT' ) - !soax_ndx = get_spc_ndx( 'SOAX' ) - !cb2_ndx = get_spc_ndx( 'CB2' ) - !oc2_ndx = get_spc_ndx( 'OC2' ) - !nit_ndx = get_spc_ndx( 'NH4NO3' ) - - end subroutine aero_model_init - - !============================================================================= - !============================================================================= - subroutine aero_model_drydep ( state, pbuf, obklen, ustar, cam_in, dt, cam_out, ptend ) - - !use dust_sediment_mod, only: dust_sediment_tend - !use drydep_mod, only: d3ddflux, calcram - !use dust_model, only: dust_depvel, dust_nbin, dust_names - !use seasalt_model, only: sslt_depvel=>seasalt_depvel, sslt_nbin=>seasalt_nbin, sslt_names=>seasalt_names - - ! 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(:) - - ! local vars - real(r8), pointer :: landfrac(:) ! land fraction - real(r8), pointer :: icefrac(:) ! ice fraction - real(r8), pointer :: ocnfrac(:) ! ocean fraction - real(r8), pointer :: fvin(:) ! - real(r8), pointer :: ram1in(:) ! for dry dep velocities from land model for progseasalts - - real(r8) :: fv(pcols) ! for dry dep velocities, from land modified over ocean & ice - real(r8) :: ram1(pcols) ! for dry dep velocities, from land modified over ocean & ice - - ! local decarations - - !integer, parameter :: naero = sslt_nbin+dust_nbin - !integer, parameter :: begslt = 1 - !integer, parameter :: endslt = sslt_nbin - !integer, parameter :: begdst = sslt_nbin+1 - !integer, parameter :: enddst = sslt_nbin+dust_nbin - - !integer :: ncol, lchnk - - !character(len=6) :: aeronames(naero) ! = (/ sslt_names, dust_names /) - - !real(r8) :: vlc_trb(pcols,naero) !Turbulent deposn velocity (m/s) - !real(r8) :: vlc_grv(pcols,pver,naero) !grav deposn velocity (m/s) - !real(r8) :: vlc_dry(pcols,pver,naero) !dry deposn velocity (m/s) - - !real(r8) :: dep_trb(pcols) !kg/m2/s - !real(r8) :: dep_grv(pcols) !kg/m2/s (total of grav and trb) - - !real(r8) :: tsflx_dst(pcols) - !real(r8) :: tsflx_slt(pcols) - !real(r8) :: pvaeros(pcols,pverp) ! sedimentation velocity in Pa - !real(r8) :: sflx(pcols) - - !real(r8) :: tvs(pcols,pver) - !real(r8) :: rho(pcols,pver) ! air density in kg/m3 - - !integer :: m,mm, i, im - ! - !if (ndrydep<1) return - - !landfrac => cam_in%landfrac(:) - !icefrac => cam_in%icefrac(:) - !ocnfrac => cam_in%ocnfrac(:) - !fvin => cam_in%fv(:) - !ram1in => cam_in%ram1(:) - - !lchnk = state%lchnk - !ncol = state%ncol - - !! calc ram and fv over ocean and sea ice ... - !call calcram( ncol,landfrac,icefrac,ocnfrac,obklen,& - ! ustar,ram1in,ram1,state%t(:,pver),state%pmid(:,pver),& - ! state%pdel(:,pver),fvin,fv) - - !call outfld( 'airFV', fv(:), pcols, lchnk ) - !call outfld( 'RAM1', ram1(:), pcols, lchnk ) - - !! note that tendencies are not only in sfc layer (because of sedimentation) - !! and that ptend is updated within each subroutine for different species - ! - !call physics_ptend_init(ptend, state%psetcols, 'aero_model_drydep', lq=drydep_lq) - - !aeronames(:sslt_nbin) = sslt_names(:) - !aeronames(sslt_nbin+1:) = dust_names(:) - - !lchnk = state%lchnk - !ncol = state%ncol - - !tvs(:ncol,:) = state%t(:ncol,:) - !rho(:ncol,:) = state%pmid(:ncol,:)/(rair*state%t(:ncol,:)) - - !! compute dep velocities for sea salt and dust... - !if (sslt_active) then - ! call sslt_depvel( state%t(:,:), state%pmid(:,:), state%q(:,:,1), ram1, fv, ncol, lchnk, & - ! vlc_dry(:,:,begslt:endslt), vlc_trb(:,begslt:endslt), vlc_grv(:,:,begslt:endslt)) - !endif - !if (dust_active) then - ! call dust_depvel( state%t(:,:), state%pmid(:,:), ram1, fv, ncol, & - ! vlc_dry(:,:,begdst:enddst), vlc_trb(:,begdst:enddst), vlc_grv(:,:,begdst:enddst) ) - !endif - - !tsflx_dst(:)=0._r8 - !tsflx_slt(:)=0._r8 - - !! do drydep for each of the bins of dust and seasalt - !do m=1,ndrydep - - ! mm = drydep_indices(m) - ! findindex: do im = 1,naero - ! if (trim(cnst_name(mm))==trim(aeronames(im))) exit findindex - ! enddo findindex - - ! pvaeros(:ncol,1)=0._r8 - ! pvaeros(:ncol,2:pverp) = vlc_dry(:ncol,:,im) - - ! call outfld( trim(cnst_name(mm))//'DV', pvaeros(:,2:pverp), pcols, lchnk ) - - ! if(.true.) then ! use phil's method - ! ! convert from meters/sec to pascals/sec - ! ! pvaeros(:,1) is assumed zero, use density from layer above in conversion - ! pvaeros(:ncol,2:pverp) = pvaeros(:ncol,2:pverp) * rho(:ncol,:)*gravit - - ! ! calculate the tendencies and sfc fluxes from the above velocities - ! call dust_sediment_tend( & - ! ncol, dt, state%pint(:,:), state%pmid, state%pdel, state%t , & - ! state%q(:,:,mm) , pvaeros , ptend%q(:,:,mm), sflx ) - ! else !use charlie's method - ! call d3ddflux(ncol, vlc_dry(:,:,im), state%q(:,:,mm),state%pmid,state%pdel, tvs,sflx,ptend%q(:,:,mm),dt) - ! endif - ! ! apportion dry deposition into turb and gravitational settling for tapes - ! do i=1,ncol - ! dep_trb(i)=sflx(i)*vlc_trb(i,im)/vlc_dry(i,pver,im) - ! dep_grv(i)=sflx(i)*vlc_grv(i,pver,im)/vlc_dry(i,pver,im) - ! enddo - - ! if ( any( sslt_names(:)==trim(cnst_name(mm)) ) ) & - ! tsflx_slt(:ncol)=tsflx_slt(:ncol)+sflx(:ncol) - ! if ( any( dust_names(:)==trim(cnst_name(mm)) ) ) & - ! tsflx_dst(:ncol)=tsflx_dst(:ncol)+sflx(:ncol) - - ! ! if the user has specified prescribed aerosol dep fluxes then - ! ! do not set cam_out dep fluxes according to the prognostic aerosols - ! if (.not. aerodep_flx_prescribed()) then - ! ! set deposition in export state - ! if (im==begdst) then - ! cam_out%dstdry1(:ncol) = max(sflx(:ncol), 0._r8) - ! elseif(im==begdst+1) then - ! cam_out%dstdry2(:ncol) = max(sflx(:ncol), 0._r8) - ! elseif(im==begdst+2) then - ! cam_out%dstdry3(:ncol) = max(sflx(:ncol), 0._r8) - ! elseif(im==begdst+3) then - ! cam_out%dstdry4(:ncol) = max(sflx(:ncol), 0._r8) - ! endif - ! endif - - ! call outfld( trim(cnst_name(mm))//'DD', sflx, pcols, lchnk) - ! call outfld( trim(cnst_name(mm))//'TB', dep_trb, pcols, lchnk ) - ! call outfld( trim(cnst_name(mm))//'GV', dep_grv, pcols, lchnk ) - ! call outfld( trim(cnst_name(mm))//'DT', ptend%q(:,:,mm), pcols, lchnk) - - !end do - ! - !! output the total dry deposition - !if (sslt_active) then - ! call outfld( 'SSTSFDRY', tsflx_slt, pcols, lchnk) - !endif - !if (dust_active) then - ! call outfld( 'DSTSFDRY', tsflx_dst, pcols, lchnk) - !endif - - endsubroutine aero_model_drydep - - !============================================================================= - !============================================================================= - subroutine aero_model_wetdep( state, dt, dlf, cam_out, ptend, pbuf) - - !use wetdep, only : wetdepa_v1, wetdep_inputs_set, wetdep_inputs_t - !use dust_model, only : dust_names - !use seasalt_model, only : sslt_names=>seasalt_names - - ! 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(:) - - !! local vars - - !integer :: ncol ! number of atmospheric columns - !integer :: lchnk ! chunk identifier - !integer :: m,mm, i,k - - !real(r8) :: sflx_tot_dst(pcols) - !real(r8) :: sflx_tot_slt(pcols) - - !real(r8) :: iscavt(pcols, pver) - !real(r8) :: scavt(pcols, pver) - !real(r8) :: scavcoef(pcols,pver) ! Dana and Hales coefficient (/mm) (0.1) - !real(r8) :: sflx(pcols) ! deposition flux - - !real(r8) :: icscavt(pcols, pver) - !real(r8) :: isscavt(pcols, pver) - !real(r8) :: bcscavt(pcols, pver) - !real(r8) :: bsscavt(pcols, pver) - - !real(r8) :: sol_factb, sol_facti - - !real(r8) :: rainmr(pcols,pver) ! mixing ratio of rain within cloud volume - !real(r8) :: cldv(pcols,pver) ! cloudy volume undergoing scavenging - !real(r8) :: cldvcu(pcols,pver) ! Convective precipitation area at the top interface of current layer - !real(r8) :: cldvst(pcols,pver) ! Stratiform precipitation area at the top interface of current layer - - !real(r8), pointer :: fracis(:,:,:) ! fraction of transported species that are insoluble - - !type(wetdep_inputs_t) :: dep_inputs ! obj that contains inputs to wetdepa routine - - !if (nwetdep<1) return - - !call pbuf_get_field(pbuf, fracis_idx, fracis, start=(/1,1,1/), kount=(/pcols, pver, pcnst/) ) - - !call physics_ptend_init(ptend, state%psetcols, 'aero_model_wetdep', lq=wetdep_lq) - - !call wetdep_inputs_set( state, pbuf, dep_inputs ) - - !lchnk = state%lchnk - !ncol = state%ncol - - !sflx_tot_dst(:) = 0._r8 - !sflx_tot_slt(:) = 0._r8 - - !do m = 1, nwetdep - - ! mm = wetdep_indices(m) - - ! sol_factb = aer_sol_factb(m) - ! sol_facti = aer_sol_facti(m) - - ! scavcoef(:ncol,:) = aer_scav_coef(m) - - ! call wetdepa_v1( state%t, state%pmid, state%q(:,:,1), state%pdel, & - ! dep_inputs%cldt, dep_inputs%cldcu, dep_inputs%cmfdqr, & - ! dep_inputs%conicw, dep_inputs%prain, dep_inputs%qme, & - ! dep_inputs%evapr, dep_inputs%totcond, state%q(:,:,mm), dt, & - ! scavt, iscavt, dep_inputs%cldv, & - ! fracis(:,:,mm), sol_factb, ncol, & - ! scavcoef, & - ! sol_facti_in=sol_facti, & - ! icscavt=icscavt, isscavt=isscavt, bcscavt=bcscavt, bsscavt=bsscavt ) - - ! ptend%q(:ncol,:,mm)=scavt(:ncol,:) - - ! call outfld( trim(cnst_name(mm))//'WET', ptend%q(:,:,mm), pcols, lchnk) - ! call outfld( trim(cnst_name(mm))//'SIC', icscavt , pcols, lchnk) - ! call outfld( trim(cnst_name(mm))//'SIS', isscavt, pcols, lchnk) - ! call outfld( trim(cnst_name(mm))//'SBC', bcscavt, pcols, lchnk) - ! call outfld( trim(cnst_name(mm))//'SBS', bsscavt, pcols, lchnk) - - ! sflx(:)=0._r8 - - ! do k=1,pver - ! do i=1,ncol - ! sflx(i)=sflx(i)+ptend%q(i,k,mm)*state%pdel(i,k)/gravit - ! enddo - ! enddo - ! call outfld( trim(cnst_name(mm))//'SFWET', sflx, pcols, lchnk) - ! - ! if ( any( sslt_names(:)==trim(cnst_name(mm)) ) ) & - ! sflx_tot_slt(:ncol) = sflx_tot_slt(:ncol) + sflx(:ncol) - ! if ( any( dust_names(:)==trim(cnst_name(mm)) ) ) & - ! sflx_tot_dst(:ncol) = sflx_tot_dst(:ncol) + sflx(:ncol) - - ! ! if the user has specified prescribed aerosol dep fluxes then - ! ! do not set cam_out dep fluxes according to the prognostic aerosols - ! if (.not.aerodep_flx_prescribed()) then - ! ! export deposition fluxes to coupler ??? why "-" sign ??? - ! if (trim(cnst_name(mm))=='CB2') then - ! cam_out%bcphiwet(:) = max(-sflx(:), 0._r8) - ! elseif (trim(cnst_name(mm))=='OC2') then - ! cam_out%ocphiwet(:) = max(-sflx(:), 0._r8) - ! elseif (trim(cnst_name(mm))==trim(dust_names(1))) then - ! cam_out%dstwet1(:) = max(-sflx(:), 0._r8) - ! elseif (trim(cnst_name(mm))==trim(dust_names(2))) then - ! cam_out%dstwet2(:) = max(-sflx(:), 0._r8) - ! elseif (trim(cnst_name(mm))==trim(dust_names(3))) then - ! cam_out%dstwet3(:) = max(-sflx(:), 0._r8) - ! elseif (trim(cnst_name(mm))==trim(dust_names(4))) then - ! cam_out%dstwet4(:) = max(-sflx(:), 0._r8) - ! endif - ! endif - - !enddo - ! - !if (sslt_active) then - ! call outfld( 'SSTSFWET', sflx_tot_slt, pcols, lchnk) - !endif - !if (dust_active) then - ! call outfld( 'DSTSFWET', sflx_tot_dst, pcols, lchnk) - !endif - - endsubroutine aero_model_wetdep - - !------------------------------------------------------------------------- - ! provides aerosol surface area info for sectional aerosols - ! called from mo_usrrxt - !------------------------------------------------------------------------- - subroutine aero_model_surfarea( & - 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 - 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_total(:,:) - real(r8), intent(out) :: reff_trop(:,:) - - !! local vars - - !integer :: i,k - !real(r8) :: rho_air - !real(r8) :: v, n, n_exp, r_rd, r_sd - !real(r8) :: dm_sulf, dm_sulf_wet, log_sd_sulf, sfc_sulf, sfc_nit - !real(r8) :: dm_orgc, dm_orgc_wet, log_sd_orgc, sfc_oc, sfc_soa - !real(r8) :: sfc_soai, sfc_soam, sfc_soab, sfc_soat, sfc_soax - !real(r8) :: dm_bc, dm_bc_wet, log_sd_bc, sfc_bc - !real(r8) :: rxt_sulf, rxt_nit, rxt_oc, rxt_soa - !real(r8) :: c_n2o5, c_ho2, c_no2, c_no3 - !real(r8) :: s_exp - - !!----------------------------------------------------------------- - !! ... parameters for log-normal distribution by number - !! references: - !! Chin et al., JAS, 59, 461, 2003 - !! Liao et al., JGR, 108(D1), 4001, 2003 - !! Martin et al., JGR, 108(D3), 4097, 2003 - !!----------------------------------------------------------------- - !real(r8), parameter :: rm_sulf = 6.95e-6_r8 ! mean radius of sulfate particles (cm) (Chin) - !real(r8), parameter :: sd_sulf = 2.03_r8 ! standard deviation of radius for sulfate (Chin) - !real(r8), parameter :: rho_sulf = 1.7e3_r8 ! density of sulfate aerosols (kg/m3) (Chin) - - !real(r8), parameter :: rm_orgc = 2.12e-6_r8 ! mean radius of organic carbon particles (cm) (Chin) - !real(r8), parameter :: sd_orgc = 2.20_r8 ! standard deviation of radius for OC (Chin) - !real(r8), parameter :: rho_orgc = 1.8e3_r8 ! density of OC aerosols (kg/m3) (Chin) - - !real(r8), parameter :: rm_bc = 1.18e-6_r8 ! mean radius of soot/BC particles (cm) (Chin) - !real(r8), parameter :: sd_bc = 2.00_r8 ! standard deviation of radius for BC (Chin) - !real(r8), parameter :: rho_bc = 1.0e3_r8 ! density of BC aerosols (kg/m3) (Chin) - - !real(r8), parameter :: mw_so4 = 98.e-3_r8 ! so4 molecular wt (kg/mole) - - !integer :: irh, rh_l, rh_u - !real(r8) :: factor, rfac_sulf, rfac_oc, rfac_bc, rfac_ss - !logical :: zero_aerosols - - !!----------------------------------------------------------------- - !! ... table for hygroscopic growth effect on radius (Chin et al) - !! (no growth effect for mineral dust) - !!----------------------------------------------------------------- - !real(r8), dimension(7) :: table_rh, table_rfac_sulf, table_rfac_bc, table_rfac_oc, table_rfac_ss - - !data table_rh(1:7) / 0.0_r8, 0.5_r8, 0.7_r8, 0.8_r8, 0.9_r8, 0.95_r8, 0.99_r8/ - !data table_rfac_sulf(1:7) / 1.0_r8, 1.4_r8, 1.5_r8, 1.6_r8, 1.8_r8, 1.9_r8, 2.2_r8/ - !data table_rfac_oc(1:7) / 1.0_r8, 1.2_r8, 1.4_r8, 1.5_r8, 1.6_r8, 1.8_r8, 2.2_r8/ - !data table_rfac_bc(1:7) / 1.0_r8, 1.0_r8, 1.0_r8, 1.2_r8, 1.4_r8, 1.5_r8, 1.9_r8/ - !data table_rfac_ss(1:7) / 1.0_r8, 1.6_r8, 1.8_r8, 2.0_r8, 2.4_r8, 2.9_r8, 4.8_r8/ - - !!----------------------------------------------------------------- - !! ... exponent for calculating number density - !!----------------------------------------------------------------- - !n_exp = exp( -4.5_r8*log(sd_sulf)*log(sd_sulf) ) - - !dm_sulf = 2._r8 * rm_sulf - !dm_orgc = 2._r8 * rm_orgc - !dm_bc = 2._r8 * rm_bc - - !log_sd_sulf = log(sd_sulf) - !log_sd_orgc = log(sd_orgc) - !log_sd_bc = log(sd_bc) - - !reff_trop(:,:) = 0._r8 - - !ver_loop: do k = 1,pver - ! col_loop: do i = 1,ncol - ! !------------------------------------------------------------------------- - ! ! ... air density (kg/m3) - ! !------------------------------------------------------------------------- - ! rho_air = pmid(i,k)/(temp(i,k)*287.04_r8) - ! !------------------------------------------------------------------------- - ! ! ... aerosol growth interpolated from M.Chin's table - ! !------------------------------------------------------------------------- - ! if (relhum(i,k) >= table_rh(7)) then - ! rfac_sulf = table_rfac_sulf(7) - ! rfac_oc = table_rfac_oc(7) - ! rfac_bc = table_rfac_bc(7) - ! else - ! do irh = 2,7 - ! if (relhum(i,k) <= table_rh(irh)) then - ! exit - ! end if - ! end do - ! rh_l = irh-1 - ! rh_u = irh - - ! factor = (relhum(i,k) - table_rh(rh_l))/(table_rh(rh_u) - table_rh(rh_l)) - - ! rfac_sulf = table_rfac_sulf(rh_l) + factor*(table_rfac_sulf(rh_u) - table_rfac_sulf(rh_l)) - ! rfac_oc = table_rfac_oc(rh_u) + factor*(table_rfac_oc(rh_u) - table_rfac_oc(rh_l)) - ! rfac_bc = table_rfac_bc(rh_u) + factor*(table_rfac_bc(rh_u) - table_rfac_bc(rh_l)) - ! end if - - ! dm_sulf_wet = dm_sulf * rfac_sulf - ! dm_orgc_wet = dm_orgc * rfac_oc - ! dm_bc_wet = dm_bc * rfac_bc - - ! dm_bc_wet = min(dm_bc_wet ,50.e-6_r8) ! maximum size is 0.5 micron (Chin) - ! dm_orgc_wet = min(dm_orgc_wet,50.e-6_r8) ! maximum size is 0.5 micron (Chin) - - - ! !------------------------------------------------------------------------- - ! ! ... sulfate aerosols - ! !------------------------------------------------------------------------- - ! zero_aerosols = k < ltrop(i) - ! if ( abs( dlat(i) ) > 50._r8 ) then - ! zero_aerosols = pmid(i,k) < 30000._r8 - ! endif - ! !------------------------------------------------------------------------- - ! ! ... use ubvals climatology for stratospheric sulfate surface area density - ! !------------------------------------------------------------------------- - ! if( zero_aerosols ) then - ! sfc_sulf = strato_sad(i,k) - ! if ( het1_ndx > 0 ) then - ! sfc_sulf = 0._r8 ! reaction already taken into account in mo_strato_rates.F90 - ! end if - ! sfc_nit = 0._r8 - ! sfc_soa = 0._r8 - ! sfc_oc = 0._r8 - ! sfc_bc = 0._r8 - ! else - - ! if( so4_ndx > 0 ) then - ! !------------------------------------------------------------------------- - ! ! convert mass mixing ratio of aerosol to cm3/cm3 (cm^3_aerosol/cm^3_air) - ! ! v=volume density (m^3/m^3) - ! ! rho_aer=density of aerosol (kg/m^3) - ! ! v=m*rho_air/rho_aer [kg/kg * (kg/m3)_air/(kg/m3)_aer] - ! !------------------------------------------------------------------------- - ! v = mmr(i,k,so4_ndx) * rho_air/rho_sulf - ! !------------------------------------------------------------------------- - ! ! calculate the number density of aerosol (aerosols/cm3) - ! ! assuming a lognormal distribution - ! ! n = (aerosols/cm3) - ! ! dm = geometric mean diameter - ! ! - ! ! because only the dry mass of the aerosols is known, we - ! ! use the mean dry radius - ! !------------------------------------------------------------------------- - ! n = v * (6._r8/pi)*(1._r8/(dm_sulf**3._r8))*n_exp - ! !------------------------------------------------------------------------- - ! ! find surface area of aerosols using dm_wet, log_sd - ! ! (increase of sd due to RH is negligible) - ! ! and number density calculated above as distribution - ! ! parameters - ! ! sfc = surface area of wet aerosols (cm^2/cm^3) - ! !------------------------------------------------------------------------- - ! s_exp = exp(2._r8*log_sd_sulf*log_sd_sulf) - ! sfc_sulf = n * pi * (dm_sulf_wet**2._r8) * s_exp - - ! else - ! !------------------------------------------------------------------------- - ! ! if so4 not simulated, use off-line sulfate and calculate as above - ! ! convert sulfate vmr to volume density of aerosol (cm^3_aerosol/cm^3_air) - ! !------------------------------------------------------------------------- - ! v = sulfate(i,k) * m(i,k) * mw_so4 / (avo * rho_sulf) *1.e6_r8 - ! n = v * (6._r8/pi)*(1._r8/(dm_sulf**3._r8))*n_exp - ! s_exp = exp(2._r8*log_sd_sulf*log_sd_sulf) - ! sfc_sulf = n * pi * (dm_sulf_wet**2._r8) * s_exp - - ! end if - ! - ! !------------------------------------------------------------------------- - ! ! ammonium nitrate (follow same procedure as sulfate, using size and density of sulfate) - ! !------------------------------------------------------------------------- - ! if( nit_ndx > 0 ) then - ! v = mmr(i,k,nit_ndx) * rho_air/rho_sulf - ! n = v * (6._r8/pi)*(1._r8/(dm_sulf**3._r8))*n_exp - ! s_exp = exp(2._r8*log_sd_sulf*log_sd_sulf) - ! sfc_nit = n * pi * (dm_sulf_wet**2._r8) * s_exp - ! else - ! sfc_nit = 0._r8 - ! end if - - ! !------------------------------------------------------------------------- - ! ! hydrophylic organic carbon (follow same procedure as sulfate) - ! !------------------------------------------------------------------------- - ! if( oc2_ndx > 0 ) then - ! v = mmr(i,k,oc2_ndx) * rho_air/rho_orgc - ! n = v * (6._r8/pi)*(1._r8/(dm_orgc**3))*n_exp - ! s_exp = exp(2._r8*log_sd_orgc*log_sd_orgc) - ! sfc_oc = n * pi * (dm_orgc_wet**2._r8) * s_exp - ! else - ! sfc_oc = 0._r8 - ! end if - - ! !------------------------------------------------------------------------- - ! ! secondary organic carbon (follow same procedure as sulfate) - ! !------------------------------------------------------------------------- - ! if( soa_ndx > 0 ) then - ! v = mmr(i,k,soa_ndx) * rho_air/rho_orgc - ! n = v * (6._r8/pi)*(1._r8/(dm_orgc**3._r8))*n_exp - ! s_exp = exp(2._r8*log_sd_orgc*log_sd_orgc) - ! sfc_soa = n * pi * (dm_orgc_wet**2._r8) * s_exp - ! else - ! sfc_soa = 0._r8 - ! end if - - ! !------------------------------------------------------------------------- - ! ! black carbon (follow same procedure as sulfate) - ! !------------------------------------------------------------------------- - ! if( cb2_ndx > 0 ) then - ! v = mmr(i,k,cb2_ndx) * rho_air/rho_bc - ! n = v * (6._r8/pi)*(1._r8/(dm_bc**3._r8))*n_exp - ! s_exp = exp(2._r8*log_sd_bc*log_sd_bc) - ! sfc_bc = n * pi * (dm_bc_wet**2._r8) * s_exp - ! else - ! sfc_bc = 0._r8 - ! end if - ! if( soai_ndx > 0 ) then - ! v = mmr(i,k,soai_ndx) * rho_air/rho_orgc - ! n = v * (6._r8/pi)*(1._r8/(dm_orgc**3._r8))*n_exp - ! s_exp = exp(2._r8*log_sd_orgc*log_sd_orgc) - ! sfc_soai = n * pi * (dm_orgc_wet**2._r8) * s_exp - ! else - ! sfc_soai = 0._r8 - ! end if - ! if( soam_ndx > 0 ) then - ! v = mmr(i,k,soam_ndx) * rho_air/rho_orgc - ! n = v * (6._r8/pi)*(1._r8/(dm_orgc**3._r8))*n_exp - ! s_exp = exp(2._r8*log_sd_orgc*log_sd_orgc) - ! sfc_soam = n * pi * (dm_orgc_wet**2._r8) * s_exp - ! else - ! sfc_soam = 0._r8 - ! end if - ! if( soab_ndx > 0 ) then - ! v = mmr(i,k,soab_ndx) * rho_air/rho_orgc - ! n = v * (6._r8/pi)*(1._r8/(dm_orgc**3._r8))*n_exp - ! s_exp = exp(2._r8*log_sd_orgc*log_sd_orgc) - ! sfc_soab = n * pi * (dm_orgc_wet**2._r8) * s_exp - ! else - ! sfc_soab = 0._r8 - ! end if - ! if( soat_ndx > 0 ) then - ! v = mmr(i,k,soat_ndx) * rho_air/rho_orgc - ! n = v * (6._r8/pi)*(1._r8/(dm_orgc**3._r8))*n_exp - ! s_exp = exp(2._r8*log_sd_orgc*log_sd_orgc) - ! sfc_soat = n * pi * (dm_orgc_wet**2._r8) * s_exp - ! else - ! sfc_soat = 0._r8 - ! end if - ! if( soax_ndx > 0 ) then - ! v = mmr(i,k,soax_ndx) * rho_air/rho_orgc - ! n = v * (6._r8/pi)*(1._r8/(dm_orgc**3._r8))*n_exp - ! s_exp = exp(2._r8*log_sd_orgc*log_sd_orgc) - ! sfc_soax = n * pi * (dm_orgc_wet**2._r8) * s_exp - ! else - ! sfc_soax = 0._r8 - ! end if - ! sfc_soa = sfc_soa + sfc_soai + sfc_soam + sfc_soab + sfc_soat + sfc_soax - - ! end if - - ! sfc(i,k,:) = (/ sfc_sulf, sfc_nit, sfc_oc, sfc_soa, sfc_bc /) - ! dm_aer(i,k,:) = (/ dm_sulf_wet,dm_sulf_wet,dm_orgc_wet,dm_orgc_wet,dm_bc_wet /) - - ! !------------------------------------------------------------------------- - ! ! ... add up total surface area density for output - ! !------------------------------------------------------------------------- - ! sad_total(i,k) = sfc_sulf + sfc_nit + sfc_oc + sfc_soa + sfc_bc - - ! enddo col_loop - !enddo ver_loop - - end subroutine aero_model_surfarea - - !------------------------------------------------------------------------- - ! stub - !------------------------------------------------------------------------- - subroutine aero_model_strat_surfarea( ncol, mmr, pmid, temp, ltrop, pbuf, strato_sad, reff_strat ) - - ! dummy args - 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(:,:) - real(r8), intent(out) :: reff_strat(:,:) - - strato_sad(:,:) = 0._r8 - reff_strat(:,:) = 0._r8 - - end subroutine aero_model_strat_surfarea - - !============================================================================= - !============================================================================= - subroutine aero_model_gasaerexch( 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 chem_mods, only : gas_pcnst - !use mo_aerosols, only : aerosols_formation, has_aerosols - !use mo_setsox, only : setsox, has_sox - !use mo_setsoa, only : setsoa, has_soa - - !----------------------------------------------------------------------- - ! ... dummy arguments - !----------------------------------------------------------------------- - 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 - - !real(r8) :: vmrcw(ncol,pver,gas_pcnst) ! cloud-borne aerosol (vmr) - - !real(r8) :: aqso4(ncol,1) ! aqueous phase chemistry - !real(r8) :: aqh2so4(ncol,1) ! 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 - - - ! !aqueous chemistry ... - - !if( has_sox ) then - ! call setsox( & - ! ncol, & - ! lchnk, & - ! loffset, & - ! delt, & - ! pmid, & - ! pdel, & - ! tfld, & - ! mbar, & - ! cwat, & - ! cldfr, & - ! cldnum, & - ! airdens, & - ! invariants, & - ! vmrcw, & - ! vmr, & - ! xphlwc, & - ! aqso4, & - ! aqh2so4, & - ! aqso4_h2o2,& - ! aqso4_o3 & - ! ) - ! call outfld( 'XPH_LWC',xphlwc(:ncol,:), ncol , lchnk ) - !endif - - !if( has_soa ) then - ! call setsoa( ncol, lchnk, delt, reaction_rates, tfld, airdens, vmr, pbuf) - !endif - - !if( has_aerosols ) then - ! call aerosols_formation( ncol, lchnk, tfld, relhum, vmr ) - !endif - - - end subroutine aero_model_gasaerexch - - !============================================================================= - !============================================================================= - subroutine aero_model_emissions( state, cam_in ) - !use seasalt_model, only: seasalt_emis, seasalt_indices - !use dust_model, only: dust_emis, dust_indices - use physics_types, only: physics_state - - ! Arguments: - - type(physics_state), intent(in) :: state ! Physics state variables - type(cam_in_t), intent(inout) :: cam_in ! import state - - !! local vars - - !integer :: lchnk, ncol - !integer :: m, mm - !real(r8) :: soil_erod_tmp(pcols) - !real(r8) :: sflx(pcols) ! accumulate over all bins for output - !real(r8) :: u10cubed(pcols) - !real (r8), parameter :: z0=0.0001_r8 ! m roughness length over oceans--from ocean model - - !lchnk = state%lchnk - !ncol = state%ncol - - !if (dust_active) then - - ! call dust_emis( ncol, lchnk, cam_in%dstflx, cam_in%cflx, soil_erod_tmp ) - - ! ! some dust emis diagnostics ... - ! sflx(:)=0._r8 - ! do m=1,dust_nbin - ! mm = dust_indices(m) - ! sflx(:ncol)=sflx(:ncol)+cam_in%cflx(:ncol,mm) - ! call outfld(trim(dust_names(m))//'SF',cam_in%cflx(:,mm),pcols, lchnk) - ! enddo - ! call outfld('DSTSFMBL',sflx(:),pcols,lchnk) - ! call outfld('LND_MBL',soil_erod_tmp(:),pcols, lchnk ) - !endif - - !if (sslt_active) then - ! u10cubed(:ncol)=sqrt(state%u(:ncol,pver)**2+state%v(:ncol,pver)**2) - ! ! move the winds to 10m high from the midpoint of the gridbox: - ! ! follows Tie and Seinfeld and Pandis, p.859 with math. - - ! u10cubed(:ncol)=u10cubed(:ncol)*log(10._r8/z0)/log(state%zm(:ncol,pver)/z0) - - ! ! we need them to the 3.41 power, according to Gong et al., 1997: - ! u10cubed(:ncol)=u10cubed(:ncol)**3.41_r8 - - ! sflx(:)=0._r8 - - ! call seasalt_emis( u10cubed, cam_in%sst, cam_in%ocnfrac, ncol, cam_in%cflx ) - - ! do m=1,seasalt_nbin - ! mm = seasalt_indices(m) - ! sflx(:ncol)=sflx(:ncol)+cam_in%cflx(:ncol,mm) - ! call outfld(trim(seasalt_names(m))//'SF',cam_in%cflx(:,mm),pcols,lchnk) - ! enddo - ! call outfld('SSTSFMBL',sflx(:),pcols,lchnk) - !endif - - end subroutine aero_model_emissions - -end module aero_model diff --git a/src/chemistry/pp_geoschem/chemistry.F90 b/src/chemistry/pp_geoschem/chemistry.F90 deleted file mode 100644 index 2914f1ae38..0000000000 --- a/src/chemistry/pp_geoschem/chemistry.F90 +++ /dev/null @@ -1,4160 +0,0 @@ -!================================================================================================ -! This is the "GEOS-Chem" chemistry module. -!================================================================================================ - -module chemistry - use shr_kind_mod, only: r8 => shr_kind_r8 - use physics_types, only: physics_state, physics_ptend, physics_ptend_init - use ppgrid, only: begchunk, endchunk, pcols - use ppgrid, only: pver, pverp - use constituents, only: pcnst, cnst_add, cnst_get_ind - !use mo_gas_phase_chemdr, only: map2chm - !use mo_constants, only: pi - use shr_const_mod, only: molw_dryair=>SHR_CONST_MWDAIR - !use chem_mods, only : gas_pcnst, adv_mass - !use mo_sim_dat, only: set_sim_dat - use seq_drydep_mod, only : nddvels => n_drydep, drydep_list - use spmd_utils, only : MasterProc, myCPU=>Iam, nCPUs=>npes - use cam_logfile, only : iulog - use string_utils, only : to_upper - - !-------------------------------------------------------------------- - ! Basic GEOS-Chem modules - !-------------------------------------------------------------------- - USE DiagList_Mod, ONLY : DgnList ! Derived type for diagnostics list - USE Input_Opt_Mod, ONLY : OptInput ! Derived type for Input Options - USE State_Chm_Mod, ONLY : ChmState ! Derived type for Chemistry State object - USE State_Diag_Mod, ONLY : DgnState ! Derived type for Diagnostics State object - USE State_Grid_Mod, ONLY : GrdState ! Derived type for Grid State object - USE State_Met_Mod, ONLY : MetState ! Derived type for Meteorology State object - USE ErrCode_Mod ! Error codes for success or failure - USE Error_Mod ! For error checking - - !----------------------------------------------------------------- - ! Parameters to define floating-point variables - !----------------------------------------------------------------- - USE PRECISION_MOD, ONLY : fp, f4 ! Flexible precision - - use Chem_Mods, only : nSlvd, slvd_Lst, slvd_ref_MMR - - ! Exit routine in CAM - use cam_abortutils, only : endrun - - use chem_mods, only : nTracersMax - use chem_mods, only : nTracers - use chem_mods, only : tracerNames - use chem_mods, only : tracerLongNames - use chem_mods, only : adv_Mass - use chem_mods, only : mwRatio - use chem_mods, only : ref_mmr - use chem_mods, only : nSlsMax - use chem_mods, only : nSls - use chem_mods, only : slsNames - use chem_mods, only : slsLongNames - use chem_mods, only : sls_ref_MMR - use chem_mods, only : slsmwRatio - use chem_mods, only : map2GC - use chem_mods, only : map2GC_Sls - use chem_mods, only : map2Idx - - IMPLICIT NONE - PRIVATE - SAVE - ! - ! Public interfaces - ! - public :: chem_is ! identify which chemistry is being used - public :: chem_register ! register consituents - public :: chem_is_active ! returns true if this package is active (ghg_chem=.true.) - public :: chem_implements_cnst ! returns true if consituent is implemented by this package - public :: chem_init_cnst ! initialize mixing ratios if not read from initial file - public :: chem_init ! initialize (history) variables - public :: chem_timestep_tend ! interface to tendency computation - public :: chem_final - public :: chem_write_restart - public :: chem_read_restart - public :: chem_init_restart - public :: chem_readnl ! read chem namelist - - public :: chem_emissions - public :: chem_timestep_init - - ! Location of valid input.geos - CHARACTER(LEN=500) :: inputGeosPath - - ! Location of chemistry input (for now) - CHARACTER(LEN=500) :: chemInputsDir - - !----------------------------- - ! Derived type objects - !----------------------------- - TYPE(OptInput) :: Input_Opt ! Input Options object - TYPE(ChmState),ALLOCATABLE :: State_Chm(:) ! Chemistry State object - TYPE(DgnState),ALLOCATABLE :: State_Diag(:) ! Diagnostics State object - TYPE(GrdState),ALLOCATABLE :: State_Grid(:) ! Grid State object - TYPE(MetState),ALLOCATABLE :: State_Met(:) ! Meteorology State object - TYPE(DgnList ) :: Diag_List ! Diagnostics list object - - ! Indices of critical species - INTEGER :: iH2O, iO3, iCH4, iCO, iNO - - ! Indices in the physics buffer - INTEGER :: NDX_PBLH ! PBL height [m] - INTEGER :: NDX_FSDS ! Downward shortwave flux at surface [W/m2] - INTEGER :: NDX_CLDTOP ! Cloud top height [index] - INTEGER :: NDX_CLDFRC ! Cloud fraction [-] - INTEGER :: NDX_PRAIN ! Rain production rate [kg/kg/s] - INTEGER :: NDX_NEVAPR ! Total rate of precipitation evaporation [kg/kg/s] - INTEGER :: NDX_RPRDTOT ! Convective total precip. production rate [kg/kg/s] - INTEGER :: NDX_LSFLXPRC ! Large-scale precip. at interface (liq + snw) [kg/m2/s] - INTEGER :: NDX_LSFLXSNW ! Large-scale precip. at interface (snow only) [kg/m2/s] - - ! Get constituent indices - INTEGER :: ixCldLiq - INTEGER :: ixCldIce - - ! Strings - CHARACTER(LEN=255) :: ThisLoc - CHARACTER(LEN=255) :: ErrMsg - -#define ALLDDVEL_GEOSCHEM 1 -#define OCNDDVEL_GEOSCHEM 0 -#define OCNDDVEL_MOZART 0 - -! The following flags are only used if ALLDDVEL_GEOSCHEM is on -#define LANDTYPE_HEMCO 0 -#define LANDTYPE_CLM 1 - -#if ( OCNDDVEL_MOZART ) - ! Filenames to compute dry deposition velocities similarly to MOZART - CHARACTER(LEN=255) :: MOZART_depvel_lnd_file = 'depvel_lnd_file' - CHARACTER(LEN=255) :: MOZART_clim_soilw_file = 'clim_soilw_file' - CHARACTER(LEN=255) :: MOZART_season_wes_file = 'season_wes_file' -#endif - -!================================================================================================ -contains -!================================================================================================ - - LOGICAL function chem_is (NAME) - - CHARACTER(LEN=*), INTENT(IN) :: NAME - - chem_is = .false. - IF (NAME == 'geoschem' ) THEN - chem_is = .true. - ENDIF - IF (MasterProc) WRITE(iulog,'(a)') 'GCCALL CHEM_IS' - - end function chem_is - -!================================================================================================ - - subroutine chem_register - - use physics_buffer, only : pbuf_add_field, dtype_r8 - use PhysConst, only : MWDry - - use Short_Lived_Species, only : Register_Short_Lived_Species - - use State_Grid_Mod, only : Init_State_Grid, Cleanup_State_Grid - use State_Chm_Mod, only : Init_State_Chm, Cleanup_State_Chm - use State_Chm_Mod, only : Ind_ - use Input_Opt_Mod, only : Set_Input_Opt, Cleanup_Input_Opt - use Species_Mod, only : Species - - use mo_sim_dat, only : set_sim_dat - - !----------------------------------------------------------------------- - ! - ! Purpose: register advected constituents for chemistry - ! - !----------------------------------------------------------------------- - ! Need to generate a temporary species database - Type(ChmState) :: SC - Type(GrdState) :: SG - Type(OptInput) :: IO - TYPE(Species), POINTER :: ThisSpc - - INTEGER :: I, N, M - REAL(r8) :: cptmp - REAL(r8) :: mwtmp - REAL(r8) :: qmin - REAL(r8) :: ref_VMR - CHARACTER(LEN=128) :: mixtype - CHARACTER(LEN=128) :: molectype - CHARACTER(LEN=128) :: lng_Name - LOGICAL :: camout - LOGICAL :: ic_from_cam2 - LOGICAL :: has_fixed_ubc - LOGICAL :: has_fixed_ubflx - - INTEGER :: RC - - ! SDE 2018-05-02: This seems to get called before anything else - ! that includes CHEM_INIT - ! At this point, mozart calls SET_SIM_DAT, which is specified by each - ! mechanism separately (ie mozart/chemistry.F90 calls the subroutine - ! set_sim_dat which is in pp_[mechanism]/mo_sim_dat.F90. That sets a lot of - ! data in other places, notably in "chem_mods" - - IF (MasterProc) WRITE(iulog,'(a)') 'GCCALL CHEM_REGISTER' - - ! hplin 2020-05-16: Call set_sim_dat to populate chemistry constituent information - ! from mo_sim_dat.F90 in other places. This is needed for HEMCO_CESM. - call set_sim_dat() - if(masterproc) write(iulog,*) 'GCCALL after set_sim_dat' - - ! Generate fake state_chm - IO%Max_BPCH_Diag = 1000 - IO%Max_AdvectSpc = 500 - IO%Max_Families = 250 - - IO%RootCPU = .False. - - CALL Set_Input_Opt( Am_I_Root = MasterProc, & - INPUT_OPT = IO, & - RC = RC ) - - IF(MASTERPROC) WRITE(IULOG,*) 'GCCALL AFTER SET_INPUT_OPT' - - IF ( RC /= GC_SUCCESS ) THEN - ERRMSG = 'COULD NOT GENERATE REFERENCE INPUT OPTIONS OBJECT!' - CALL ERROR_STOP( ERRMSG, THISLOC ) - ENDIF - - ! OPTIONS NEEDED BY INIT_STATE_CHM - IO%ITS_A_FULLCHEM_SIM = .TRUE. - IO%LLINOZ = .TRUE. - IO%LUCX = .TRUE. - IO%LPRT = .FALSE. - IO%N_ADVECT = NTRACERS - DO I = 1, NTRACERS - IO%ADVECTSPC_NAME(I) = TRIM(TRACERNAMES(I)) - ENDDO - IO%SALA_REDGE_UM(1) = 0.01E+0_FP - IO%SALA_REDGE_UM(2) = 0.50E+0_FP - IO%SALC_REDGE_UM(1) = 0.50E+0_FP - IO%SALC_REDGE_UM(2) = 8.00E+0_FP - - ! PREVENT REPORTING - IO%ROOTCPU = .FALSE. - IO%MYCPU = MYCPU - - CALL INIT_STATE_GRID( STATE_GRID = SG , & - RC = RC ) - - IF ( RC /= GC_SUCCESS ) THEN - ERRMSG = 'ERROR ENCOUNTERED WITHIN CALL TO "INIT_STATE_GRID"!' - CALL ERROR_STOP( ERRMSG, THISLOC ) - ENDIF - - SG%NX = 1 - SG%NY = 1 - SG%NZ = 1 - - CALL INIT_STATE_CHM( INPUT_OPT = IO, & - STATE_CHM = SC, & - STATE_GRID = SG, & - RC = RC ) - - IF ( RC /= GC_SUCCESS ) THEN - ERRMSG = 'ERROR ENCOUNTERED WITHIN CALL TO "INIT_STATE_CHM"!' - CALL ERROR_STOP( ERRMSG, THISLOC ) - ENDIF - - ! AT THE MOMENT, WE FORCE NADV_CHEM=200 IN THE SETUP FILE - ! DEFAULT - MAP2GC = -1 - REF_MMR(:) = 0.0E+0_R8 - MWRATIO(:) = 1.0E+0_R8 - TRACERLONGNAMES = '' - - DO I = 1, NTRACERSMAX - IF (I.LE.NTRACERS) THEN - N = IND_(TRACERNAMES(I)) - THISSPC => SC%SPCDATA(N)%INFO - LNG_NAME = TRIM(THISSPC%FULLNAME) - MWTMP = REAL(THISSPC%MW_G,R8) - REF_VMR = REAL(THISSPC%BACKGROUNDVV,R8) - ADV_MASS(I) = MWTMP - REF_MMR(I) = REF_VMR / (MWDRY / MWTMP) - ELSE - LNG_NAME = TRIM(TRACERNAMES(I)) - MWTMP = 1000.0E+0_R8 * (0.001E+0_R8) - ADV_MASS(I) = MWTMP - REF_MMR(I) = 1.0E-38_R8 - ENDIF - MWRATIO(I) = MWDRY/MWTMP - TRACERLONGNAMES(I) = TRIM(LNG_NAME) - - ! DUMMY VALUE FOR SPECIFIC HEAT OF CONSTANT PRESSURE (CP) - CPTMP = 666._R8 - ! MINIMUM MIXING RATIO - QMIN = 1.E-38_R8 - ! MIXING RATIO TYPE - MIXTYPE = 'DRY' - ! USED FOR IONOSPHERIC WACCM (WACCM-X) - MOLECTYPE = 'MINOR' - ! IS AN OUTPUT FIELD (?) - CAMOUT = .FALSE. - ! NOT TRUE FOR O2(1-DELTA) OR O2(1-SIGMA) - IC_FROM_CAM2 = .TRUE. - ! USE A FIXED VALUE AT THE UPPER BOUNDARY - HAS_FIXED_UBC = .FALSE. - ! USE A FIXED FLUX CONDITION AT THE UPPER BOUNDARY - HAS_FIXED_UBFLX = .FALSE. - !WRITE(TRACERNAMES(I),'(A,I0.4)') 'GCTRC_', I - ! NOTE: IN MOZART, THIS ONLY GETS CALLED FOR TRACERS - ! THIS IS THE CALL TO ADD A "CONSTITUENT" - CALL CNST_ADD( TRIM(TRACERNAMES(I)), ADV_MASS(I), CPTMP, QMIN, N, & - READIV=IC_FROM_CAM2, MIXTYPE=MIXTYPE, CAM_OUTFLD=CAMOUT, & - MOLECTYPE=MOLECTYPE, FIXED_UBC=HAS_FIXED_UBC, & - FIXED_UBFLX=HAS_FIXED_UBFLX, LONGNAME=TRIM(LNG_NAME) ) - - ! ADD TO GC MAPPING. WHEN STARTING A TIMESTEP, WE WILL WANT TO UPDATE THE - ! CONCENTRATION OF STATE_CHM(X)%SPECIES(1,ICOL,ILEV,M) WITH DATA FROM - ! CONSTITUENT N - M = IND_(TRIM(TRACERNAMES(I))) - IF ( M > 0 ) THEN - MAP2GC(N) = M - MAP2IDX(N) = I - ENDIF - ! NULLIFY POINTER - THISSPC => NULL() - ENDDO - - ! NOW UNADVECTED SPECIES - MAP2GC_SLS = 0 - SLS_REF_MMR(:) = 0.0E+0_R8 - SLSMWRATIO(:) = -1.0E+0_R8 - SLSLONGNAMES = '' - DO I = 1, NSLS - N = IND_(SLSNAMES(I)) - IF ( N .GT. 0 ) THEN - THISSPC => SC%SPCDATA(N)%INFO - MWTMP = REAL(THISSPC%MW_G,R8) - REF_VMR = REAL(THISSPC%BACKGROUNDVV,R8) - LNG_NAME = TRIM(THISSPC%FULLNAME) - SLSLONGNAMES(I) = LNG_NAME - SLS_REF_MMR(I) = REF_VMR / (MWDRY / MWTMP) - SLSMWRATIO(I) = MWDRY / MWTMP - MAP2GC_SLS(I) = N - THISSPC => NULL() - ENDIF - ENDDO - - ! PASS INFORMATION TO "SHORT_LIVED_SPECIES" MODULE - SLVD_REF_MMR(1:NSLS) = SLS_REF_MMR(1:NSLS) - CALL REGISTER_SHORT_LIVED_SPECIES() - ! MORE INFORMATION: - ! HTTP://WWW.CESM.UCAR.EDU/MODELS/ATM-CAM/DOCS/PHYS-INTERFACE/NODE5.HTML - - ! CLEAN UP - CALL CLEANUP_STATE_CHM ( .FALSE., SC, RC ) - CALL CLEANUP_STATE_GRID( .FALSE., SG, RC ) - CALL CLEANUP_INPUT_OPT ( .FALSE., IO, RC ) - - END SUBROUTINE CHEM_REGISTER - - SUBROUTINE CHEM_READNL(NLFILE) - ! THIS IS THE FIRST ROUTINE TO GET CALLED - SO IT SHOULD READ IN - ! GEOS-CHEM OPTIONS FROM INPUT.GEOS WITHOUT ACTUALLY DOING ANY - ! INITIALIZATION - - USE CAM_ABORTUTILS, ONLY : ENDRUN - USE UNITS, ONLY : GETUNIT, FREEUNIT - USE MPISHORTHAND - USE GCKPP_MODEL, ONLY : NSPEC, SPC_NAMES - USE MO_CHEM_UTLS, ONLY : GET_SPC_NDX - USE CHEM_MODS, ONLY : DRYSPC_NDX - - ! ARGS - CHARACTER(LEN=*), INTENT(IN) :: NLFILE ! FILEPATH FOR FILE CONTAINING NAMELIST INPUT - - ! LOCAL VARIABLES - INTEGER :: I, N, NIGNORED - INTEGER :: UNITN, IERR - CHARACTER(LEN=500) :: LINE - LOGICAL :: MENUFOUND - LOGICAL :: VALIDSLS - -#IF ( OCNDDVEL_MOZART ) - NAMELIST /CHEM_INPARM/ MOZART_DEPVEL_LND_FILE, & - MOZART_CLIM_SOILW_FILE, & - MOZART_SEASON_WES_FILE -#ENDIF - - NIGNORED = 0 - - ! SET PATHS - ! MIT PATH - !INPUTGEOSPATH='/HOME/FRITZT/INPUT.GEOS.TEMPLATE' - !CHEMINPUTSDIR='/NET/D06/DATA/GCDATA/EXTDATA/CHEM_INPUTS/' - ! CHEYENNE PATH - INPUTGEOSPATH='/GLADE/U/HOME/FRITZT/INPUT.GEOS.TEMPLATE' - CHEMINPUTSDIR='/GLADE/P/UNIV/UMIT0034/EXTDATA/CHEM_INPUTS/' - - -#IF ( ALLDDVEL_GEOSCHEM + OCNDDVEL_GEOSCHEM + OCNDDVEL_MOZART != 1 ) - IF (MASTERPROC) THEN - WRITE(IULOG,'(/,A)') REPEAT( "=", 79 ) - WRITE(IULOG,'(A)') " PREPROCESSOR FLAGS ARE NOT SET CORRECTLY IN CHEMISTRY.F90" - WRITE(IULOG,'(A)') " THE USER NEEDS TO DECIDE HOW TO COMPUTE DRY DEPOSITION VELOCITIES" - WRITE(IULOG,'(A)') " THREE OPTIONS APPEAR: " - WRITE(IULOG,'(A)') " + LET GEOS-CHEM CALCULATE ALL DRY DEPOSITION VELOCITIES." - WRITE(IULOG,'(A)') " REQUIRED SETUP:" - WRITE(IULOG,'(A)') " ALLDDVEL_GEOSCHEM == 1" - WRITE(IULOG,'(A)') " OCNDDVEL_GEOSCHEM == 0" - WRITE(IULOG,'(A)') " OCNDDVEL_MOZART == 0" - WRITE(IULOG,'(A)') " + LET CLM COMPUTE DRY DEPOSITION VELOCITIES OVER LAND AND LET" - WRITE(IULOG,'(A)') " GEOS-CHEM COMPUTE VELOCITIES OVER OCEAN AND ICE" - WRITE(IULOG,'(A)') " REQUIRED SETUP:" - WRITE(IULOG,'(A)') " ALLDDVEL_GEOSCHEM == 0" - WRITE(IULOG,'(A)') " OCNDDVEL_GEOSCHEM == 1" - WRITE(IULOG,'(A)') " OCNDDVEL_MOZART == 0" - WRITE(IULOG,'(A)') " + LET CLM COMPUTE DRY DEPOSITION VELOCITIES OVER LAND AND" - WRITE(IULOG,'(A)') " COMPUTE VELOCITIES OVER OCEAN AND ICE IN A SIMILAR WAY AS" - WRITE(IULOG,'(A)') " MOZART" - WRITE(IULOG,'(A)') " REQUIRED SETUP:" - WRITE(IULOG,'(A)') " ALLDDVEL_GEOSCHEM == 0" - WRITE(IULOG,'(A)') " OCNDDVEL_GEOSCHEM == 0" - WRITE(IULOG,'(A)') " OCNDDVEL_MOZART == 1" - WRITE(IULOG,'(A)') REPEAT( "=", 79 ) - CALL ENDRUN('INCORRECT DEFINITIONS FOR DRY DEPOSITION VELOCITIES') - ENDIF -#ENDIF -#IF ( ALLDDVEL_GEOSCHEM && ( LANDTYPE_HEMCO + LANDTYPE_CLM != 1 ) ) - IF (MASTERPROC) THEN - WRITE(IULOG,'(/,A)') REPEAT( "=", 79 ) - WRITE(IULOG,'(A)') REPEAT( "=", 79 ) - WRITE(IULOG,'(A)') " PREPROCESSOR FLAGS ARE NOT SET CORRECTLY IN CHEMISTRY.F90" - WRITE(IULOG,'(A)') " DRY-DEPOSITION VELOCITIES ARE COMPUTED BY GEOS-CHEM" - WRITE(IULOG,'(A)') " THE USER NEEDS TO DECIDE IF LAND TYPES SHOULD BE FROM CLM OR FROM HEMCO" - CALL ENDRUN('INCORRECT DEFINITIONS FOR SOURCE OF LAND TYPE DATA') - ENDIF -#ENDIF - - ALLOCATE(DRYSPC_NDX(NDDVELS), STAT=IERR) - IF ( IERR .NE. 0 ) CALL ENDRUN('FAILED TO ALLOCATE DRYSPC_NDX') - - IF (MASTERPROC) THEN - - WRITE(IULOG,'(/,A)') REPEAT( '=', 50 ) - WRITE(IULOG,'(A)') REPEAT( '=', 50 ) - WRITE(IULOG,'(A)') 'THIS IS THE GEOS-CHEM / CESM INTERFACE' - WRITE(IULOG,'(A)') REPEAT( '=', 50 ) - WRITE(IULOG,'(A)') ' + ROUTINES WRITTEN BY THIBAUD M. FRITZ' - WRITE(IULOG,'(A)') ' + LABORATORY FOR AVIATION AND THE ENVIRONMENT,' - WRITE(IULOG,'(A)') ' + DEPARTMENT OF AERONAUTICS AND ASTRONAUTICS,' - WRITE(IULOG,'(A)') ' + MASSACHUSETTS INSTITUTE OF TECHNOLOGY' - WRITE(IULOG,'(A)') REPEAT( '=', 50 ) - - WRITE(IULOG,'(/,/, A)') 'NOW DEFINING GEOS-CHEM TRACERS AND DRY DEPOSITION MAPPING...' - - UNITN = GETUNIT() - - !============================================================== - ! OPENING INPUT.GEOS AND GO TO ADVECTED SPECIES MENU - !============================================================== - - OPEN( UNITN, FILE=TRIM(INPUTGEOSPATH), STATUS='OLD', IOSTAT=IERR ) - IF (IERR .NE. 0) THEN - CALL ENDRUN('CHEM_READNL: ERROR OPENING INPUT.GEOS') - ENDIF - - ! GO TO ADVECTED SPECIES MENU - MENUFOUND = .FALSE. - DO WHILE ( .NOT. MENUFOUND ) - READ( UNITN, '(A)', IOSTAT=IERR ) LINE - IF ( IERR .NE. 0 ) THEN - CALL ENDRUN('CHEM_READNL: ERROR FINDING ADVECTED SPECIES MENU') - ELSEIF ( INDEX(LINE, 'ADVECTED SPECIES MENU') > 0 ) THEN - MENUFOUND = .TRUE. - ENDIF - ENDDO - - !============================================================== - ! READ LIST OF GEOS-CHEM TRACERS - !============================================================== - - DO - ! READ LINE - READ(UNITN,'(26X,A)', IOSTAT=IERR) LINE - - IF ( INDEX( TRIM(LINE), '---' ) > 0 ) EXIT - - NTRACERS = NTRACERS + 1 - TRACERNAMES(NTRACERS) = TRIM(LINE) - - ENDDO - - CLOSE(UNITN) - CALL FREEUNIT(UNITN) - - ! ASSIGN REMAINING TRACERS DUMMY NAMES - DO I = (NTRACERS+1), NTRACERSMAX - WRITE(TRACERNAMES(I),'(A,I0.4)') 'GCTRC_', I - ENDDO - - !============================================================== - ! NOW GO THROUGH THE KPP MECHANISM AND ADD ANY SPECIES NOT - ! IMPLEMENTED BY THE TRACER LIST IN INPUT.GEOS - !============================================================== - - IF ( NSPEC > NSLSMAX ) THEN - CALL ENDRUN('CHEM_READNL: TOO MANY SPECIES - INCREASE NSLSMAX') - ENDIF - - NSLS = 0 - DO I = 1, NSPEC - ! GET THE NAME OF THE SPECIES FROM KPP - LINE = ADJUSTL(TRIM(SPC_NAMES(I))) - ! ONLY ADD THIS - VALIDSLS = ( .NOT. ANY(TRIM(LINE) .EQ. TRACERNAMES) ) - IF (VALIDSLS) THEN - ! GENUINE NEW SHORT-LIVED SPECIES - NSLS = NSLS + 1 - SLSNAMES(NSLS) = TRIM(LINE) - ENDIF - ENDDO - - !============================================================== - ! GET MAPPING BETWEEN DRY DEPOSITION SPECIES AND SPECIES SET - !============================================================== - - DO N = 1, NDDVELS - - ! THE SPECIES NAMES NEED TO BE CONVERT TO UPPER CASE AS, - ! FOR INSTANCE, BR2 != BR2 - DRYSPC_NDX(N) = GET_SPC_NDX( TO_UPPER(DRYDEP_LIST(N)) ) - - IF ( DRYSPC_NDX(N) < 0 ) THEN - WRITE(IULOG,'(A,A)') ' ## IGNORING DRY DEPOSITION OF ', & - TRIM(DRYDEP_LIST(N)) - NIGNORED = NIGNORED + 1 - ENDIF - ENDDO - - IF ( NIGNORED > 0 ) THEN - WRITE(IULOG,'(A,A)') ' THE SPECIES LISTED ABOVE HAVE DRY', & - ' DEPOSITION TURNED OFF FOR ONE OF THE FOLLOWING REASONS:' - WRITE(IULOG,'(A)') ' - THEY ARE NOT PRESENT IN THE GEOS-CHEM TRACER LIST.' - WRITE(IULOG,'(A)') ' - THEY HAVE A SYNONYM (E.G. CH2O AND HCHO).' - ENDIF - - !============================================================== - ! PRINT SUMMARY - !============================================================== - - WRITE(IULOG,'(/, A)') '### SUMMARY OF GEOS-CHEM SPECIES: ' - WRITE(IULOG,'( A)') REPEAT( '-', 50 ) - WRITE(IULOG,'( A)') '+ LIST OF ADVECTED SPECIES: ' - WRITE(IULOG,100) 'ID', 'TRACER', 'DRY DEPOSITION (T/F)' - DO N = 1, NTRACERS - WRITE(IULOG,110) N, TRIM(TRACERNAMES(N)), ANY(DRYSPC_NDX .EQ. N) - ENDDO - - WRITE(IULOG,'(/, A)') '+ LIST OF SHORT-LIVED SPECIES: ' - DO N = 1, NSLS - WRITE(IULOG,120) N, TRIM(SLSNAMES(N)) - ENDDO - - 100 FORMAT( 1X, A3, 3X, A10, 1X, A25 ) - 110 FORMAT( 1X, I3, 3X, A10, 1X, L15 ) - 120 FORMAT( 1X, I3, 3X, A10 ) - - !============================================================== - - ENDIF - - !================================================================== - ! BROADCAST TO ALL PROCESSORS - !================================================================== - -#IF DEFINED( SPMD ) - CALL MPIBCAST(NTRACERS, 1, MPIINT, 0, MPICOM ) - CALL MPIBCAST(TRACERNAMES, LEN(TRACERNAMES(1))*NTRACERSMAX, MPICHAR, 0, MPICOM ) - CALL MPIBCAST(NSLS, 1, MPIINT, 0, MPICOM ) - CALL MPIBCAST(SLSNAMES, LEN(SLSNAMES(1))*NSLSMAX, MPICHAR, 0, MPICOM ) - CALL MPIBCAST(DRYSPC_NDX, NDDVELS, MPIINT, 0, MPICOM ) - -#IF ( OCNDDVEL_MOZART ) - !============================================================== - ! THE FOLLOWING LINES SHOULD ONLY BE CALLED IF WE COMPUTE - ! VELOCITIES OVER THE OCEAN AND ICE IN A MOZART-LIKE WAY. - ! THIBAUD M. FRITZ - 26 FEB 2020 - !============================================================== - - CALL MPIBCAST(MOZART_DEPVEL_LND_FILE, LEN(MOZART_DEPVEL_LND_FILE), MPICHAR, 0, MPICOM) - CALL MPIBCAST(MOZART_CLIM_SOILW_FILE, LEN(MOZART_CLIM_SOILW_FILE), MPICHAR, 0, MPICOM) - CALL MPIBCAST(MOZART_SEASON_WES_FILE, LEN(MOZART_SEASON_WES_FILE), MPICHAR, 0, MPICOM) -#ENDIF - -#ENDIF - - ! UPDATE "SHORT_LIVED_SPECIES" ARRAYS - WILL EVENTUALLY UNIFY THESE - NSLVD = NSLS - ALLOCATE(SLVD_LST(NSLVD), STAT=IERR) - IF ( IERR .NE. 0 ) CALL ENDRUN('FAILURE WHILE ALLOCATING SLVD_LST') - ALLOCATE(SLVD_REF_MMR(NSLVD), STAT=IERR) - IF ( IERR .NE. 0 ) CALL ENDRUN('FAILURE WHILE ALLOCATING SLVD_REF_MMR') - DO I = 1, NSLS - SLVD_LST(I) = TRIM(SLSNAMES(I)) - ENDDO - - END SUBROUTINE CHEM_READNL - -!================================================================================================ - - FUNCTION CHEM_IS_ACTIVE() - !----------------------------------------------------------------------- - LOGICAL :: CHEM_IS_ACTIVE - !----------------------------------------------------------------------- - CHEM_IS_ACTIVE = .TRUE. - - END FUNCTION CHEM_IS_ACTIVE - -!================================================================================================ - - FUNCTION CHEM_IMPLEMENTS_CNST(NAME) - !----------------------------------------------------------------------- - ! - ! PURPOSE: RETURN TRUE IF SPECIFIED CONSTITUENT IS IMPLEMENTED BY THIS PACKAGE - ! - ! AUTHOR: B. EATON - ! - !----------------------------------------------------------------------- - IMPLICIT NONE - !-----------------------------ARGUMENTS--------------------------------- - - CHARACTER(LEN=*), INTENT(IN) :: NAME ! CONSTITUENT NAME - LOGICAL :: CHEM_IMPLEMENTS_CNST ! RETURN VALUE - - INTEGER :: I - - CHEM_IMPLEMENTS_CNST = .FALSE. - - DO I = 1, NTRACERS - IF (TRIM(TRACERNAMES(I)) .EQ. TRIM(NAME)) THEN - CHEM_IMPLEMENTS_CNST = .TRUE. - EXIT - ENDIF - ENDDO - - IF (MASTERPROC) WRITE(IULOG,'(A)') 'GCCALL CHEM_IMPLEMENTS_CNST' - - END FUNCTION CHEM_IMPLEMENTS_CNST - -!=============================================================================== - - SUBROUTINE CHEM_INIT(PHYS_STATE, PBUF2D) - !----------------------------------------------------------------------- - ! - ! PURPOSE: INITIALIZE GEOS-CHEM PARTS (STATE OBJECTS, MAINLY) - ! (AND DECLARE HISTORY VARIABLES) - ! - !----------------------------------------------------------------------- - USE PHYSICS_BUFFER, ONLY: PHYSICS_BUFFER_DESC, PBUF_GET_INDEX - USE CAM_HISTORY, ONLY: ADDFLD, ADD_DEFAULT, HORIZ_ONLY - USE CHEM_MODS, ONLY: MAP2GC_DRYDEP, DRYSPC_NDX - - USE MPISHORTHAND - USE CAM_ABORTUTILS, ONLY : ENDRUN - - USE INPUT_OPT_MOD - USE STATE_CHM_MOD - USE STATE_GRID_MOD - USE STATE_MET_MOD - USE DIAGLIST_MOD, ONLY : INIT_DIAGLIST, PRINT_DIAGLIST - USE GC_ENVIRONMENT_MOD - USE GC_GRID_MOD, ONLY : SETGRIDFROMCTREDGES - - ! USE GEOS-CHEM VERSIONS OF PHYSICAL CONSTANTS - USE PHYSCONSTANTS, ONLY : PI, PI_180 - USE PHYSCONSTANTS, ONLY : RE - - USE PHYS_GRID, ONLY : GET_AREA_ALL_P - USE HYCOEF, ONLY : PS0, HYAI, HYBI - - USE TIME_MOD, ONLY : ACCEPT_EXTERNAL_DATE_TIME - !USE TIME_MOD, ONLY : SET_BEGIN_TIME, SET_END_TIME - !USE TIME_MOD, ONLY : SET_CURRENT_TIME, SET_DIAGB - !USE TRANSFER_MOD, ONLY : INIT_TRANSFER - USE LINOZ_MOD, ONLY : LINOZ_READ - -#IF ( OCNDDVEL_MOZART ) - USE SEQ_DRYDEP_MOD, ONLY: DRYDEP_METHOD, DD_XLND - USE MO_DRYDEP, ONLY: DRYDEP_INTI -#ENDIF - - USE CMN_SIZE_MOD - - USE DRYDEP_MOD, ONLY : INIT_DRYDEP, DEPNAME, NDVZIND - USE CARBON_MOD, ONLY : INIT_CARBON - USE DUST_MOD, ONLY : INIT_DUST - USE SEASALT_MOD, ONLY : INIT_SEASALT - USE SULFATE_MOD, ONLY : INIT_SULFATE - USE AEROSOL_MOD, ONLY : INIT_AEROSOL - USE WETSCAV_MOD, ONLY : INIT_WETSCAV - USE PRESSURE_MOD, ONLY : INIT_PRESSURE, ACCEPT_EXTERNAL_APBP - USE CHEMISTRY_MOD, ONLY : INIT_CHEMISTRY - USE UCX_MOD, ONLY : INIT_UCX -#IF ( ALLDDVEL_GEOSCHEM && LANDTYPE_HEMCO ) - USE OLSON_LANDMAP_MOD -#ENDIF - USE MIXING_MOD - - USE PBL_MIX_MOD, ONLY : INIT_PBL_MIX - - USE GC_EMISSIONS_MOD, ONLY : GC_EMISSIONS_INIT - - TYPE(PHYSICS_STATE), INTENT(IN):: PHYS_STATE(BEGCHUNK:ENDCHUNK) - TYPE(PHYSICS_BUFFER_DESC), POINTER :: PBUF2D(:,:) - - ! LOCAL VARIABLES - - !---------------------------- - ! SCALARS - !---------------------------- - - ! INTEGERS - INTEGER :: LCHNK(BEGCHUNK:ENDCHUNK), NCOL(BEGCHUNK:ENDCHUNK) - INTEGER :: IWAIT, IERR - INTEGER :: NX, NY, NZ - INTEGER :: IX, JY - INTEGER :: I, J, L, N - INTEGER :: RC - INTEGER :: NLINOZ - - ! LOGICALS - LOGICAL :: ROOTCHUNK - LOGICAL :: PRTDEBUG - - ! STRINGS - CHARACTER(LEN=255) :: HISTORYCONFIGFILE - CHARACTER(LEN=255) :: SPCNAME - - ! GRID SETUP - REAL(FP) :: LONVAL, LATVAL - REAL(FP) :: DLONFIX, DLATFIX - REAL(F4), ALLOCATABLE :: LONMIDARR(:,:), LATMIDARR(:,:) - REAL(F4), ALLOCATABLE :: LONEDGEARR(:,:), LATEDGEARR(:,:) - REAL(R8), ALLOCATABLE :: LINOZDATA(:,:,:,:) - - REAL(R8), ALLOCATABLE :: COL_AREA(:) - REAL(FP), ALLOCATABLE :: AP_CAM_FLIP(:), BP_CAM_FLIP(:) - - REAL(R8), POINTER :: SLSPTR(:,:,:) - - - ! ASSUME A SUCCESSFUL RETURN UNTIL OTHERWISE - RC = GC_SUCCESS - - ! FOR ERROR TRAPPING - ERRMSG = '' - THISLOC = ' -> AT GEOS-CHEM (IN CHEMISTRY/PP_GEOSCHEM/CHEMISTRY.F90)' - - ! LCHNK: WHICH CHUNKS WE HAVE ON THIS PROCESS - LCHNK = PHYS_STATE%LCHNK - ! NCOL: NUMBER OF ATMOSPHERIC COLUMNS FOR EACH CHUNK - NCOL = PHYS_STATE%NCOL - - WRITE(IULOG,'(2(A,X,I6,X))') 'CHEM_INIT CALLED ON PE ', MYCPU, ' OF ', NCPUS - - ! THE GEOS-CHEM GRIDS ON EVERY "CHUNK" WILL ALL BE THE SAME SIZE, TO AVOID - ! THE POSSIBILITY OF HAVING DIFFERENTLY-SIZED CHUNKS - NX = 1 - !NY = MAXVAL(NCOL) - NY = PCOLS - NZ = PVER - - !! ADD SHORT LIVED SPEIES TO BUFFERS - !CALL PBUF_ADD_FIELD(TRIM(SLSBUFFER),'GLOBAL',DTYPE_R8,(/PCOLS,PVER,NSLS/),SLS_PBF_IDX) - !! INITIALIZE - !ALLOCATE(SLSPTR(PCOLS,PVER,BEGCHUNK:ENDCHUNK), STAT=IERR) - !IF ( IERR .NE. 0 ) CALL ENDRUN('FAILURE WHILE ALLOCATING SLSPTR') - !SLSPTR(:,:,:) = 0.0E+0_R8 - !DO I=1,NSLS - ! SLSPTR(:,:,:) = SLS_REF_MMR(I) - ! CALL PBUF_SET_FIELD(PBUF2D,SLS_PBF_IDX,SLSPTR,START=(/1,1,I/),KOUNT=(/PCOLS,PVER,1/)) - !ENDDO - !DEALLOCATE(SLSPTR) - - ! THIS ENSURES THAT EACH PROCESS ALLOCATES EVERYTHING NEEDED FOR ITS CHUNKS - ALLOCATE(STATE_CHM(BEGCHUNK:ENDCHUNK) , STAT=IERR) - IF ( IERR .NE. 0 ) CALL ENDRUN('FAILURE WHILE ALLOCATING STATE_CHM') - ALLOCATE(STATE_DIAG(BEGCHUNK:ENDCHUNK) , STAT=IERR) - IF ( IERR .NE. 0 ) CALL ENDRUN('FAILURE WHILE ALLOCATING STATE_DIAG') - ALLOCATE(STATE_GRID(BEGCHUNK:ENDCHUNK), STAT=IERR) - IF ( IERR .NE. 0 ) CALL ENDRUN('FAILURE WHILE ALLOCATING STATE_GRID') - ALLOCATE(STATE_MET(BEGCHUNK:ENDCHUNK) , STAT=IERR) - IF ( IERR .NE. 0 ) CALL ENDRUN('FAILURE WHILE ALLOCATING STATE_MET') - - ! INITIALIZE FIELDS OF THE INPUT OPTIONS OBJECT - CALL SET_INPUT_OPT( AM_I_ROOT = MASTERPROC, & - INPUT_OPT = INPUT_OPT, & - RC = RC ) - - ! Set some basic flags - Input_Opt%LUCX = .True. - - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Error encountered within call to "Set_Input_Opt"!' - CALL Error_Stop( ErrMsg, ThisLoc ) - ENDIF - - DO I = BEGCHUNK, ENDCHUNK - - ! Initialize fields of the Grid State object - CALL Init_State_Grid( State_Grid = State_Grid(I), & - RC = RC ) - - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Error encountered within call to "Init_State_Grid"!' - CALL Error_Stop( ErrMsg, ThisLoc ) - ENDIF - - State_Grid(I)%NX = nX - State_Grid(I)%NY = nY - State_Grid(I)%NZ = nZ - - ! Initialize GEOS-Chem horizontal grid structure - CALL GC_Init_Grid( Input_Opt = Input_Opt, & - State_Grid = State_Grid(I), & - RC = RC ) - - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Error encountered within call to "GC_Init_Grid"!' - CALL Error_Stop( ErrMsg, ThisLoc ) - ENDIF - - ! Define more variables for State_Grid - ! TMMF, might need tweaking - State_Grid(I)%MaxTropLev = MIN(40, nZ) - State_Grid(I)%MaxStratLev = MIN(59, nZ) - - ! Set maximum number of levels in the chemistry grid - IF ( Input_Opt%LUCX ) THEN - State_Grid(I)%MaxChemLev = State_Grid(I)%MaxStratLev - ELSE - State_Grid(I)%MaxChemLev = State_Grid(I)%MaxTropLev - ENDIF - - ENDDO - - ! Note - this is called AFTER chem_readnl, after X, and after - ! every constituent has had its initial conditions read. Any - ! constituent which is not found in the CAM restart file will - ! then have already had a call to chem_implements_cnst, and will - ! have then had a call to chem_init_cnst to set a default VMR - ! Call the routine GC_Allocate_All (located in module file - ! GeosCore/gc_environment_mod.F90) to allocate all lat/lon - ! allocatable arrays used by GEOS-Chem. - CALL GC_Allocate_All ( Input_Opt = Input_Opt, & - State_Grid = State_Grid(BEGCHUNK), & - value_I_Lo = 1, & - value_J_Lo = 1, & - value_I_Hi = nX, & - value_J_Hi = nY, & - value_IM = nX, & - value_JM = nY, & - value_LM = nZ, & - value_IM_WORLD = nX, & - value_JM_WORLD = nY, & - value_LM_WORLD = nZ, & - value_LLSTRAT = 59, & !TMMF - RC = RC ) - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Error encountered in "GC_Allocate_All"!' - CALL Error_Stop( ErrMsg, ThisLoc ) - ENDIF - - Input_Opt%myCPU = myCPU - Input_Opt%rootCPU = MasterProc - - ! TODO: Mimic GEOS-Chem's reading of input options - !IF (MasterProc) THEN - ! CALL Read_Input_File( Input_Opt = Input_Opt(BEGCHUNK), & - ! srcFile = inputGeosPath, & - ! RC = RC ) - !ENDIF - !CALL - - ! For now just hard-code it - ! First setup directories - Input_Opt%Chem_Inputs_Dir = TRIM(chemInputsDir) - - ! Simulation menu - Input_Opt%NYMDb = 20000101 - Input_Opt%NHMSb = 000000 - Input_Opt%NYMDe = 20010101 - Input_Opt%NHMSe = 000000 - - ! Now READ_SIMULATION_MENU - Input_Opt%ITS_A_CH4_SIM = .False. - Input_Opt%ITS_A_CO2_SIM = .False. - Input_Opt%ITS_A_FULLCHEM_SIM = .True. - Input_Opt%ITS_A_MERCURY_SIM = .False. - Input_Opt%ITS_A_POPS_SIM = .False. - Input_Opt%ITS_A_RnPbBe_SIM = .False. - Input_Opt%ITS_A_TAGO3_SIM = .False. - Input_Opt%ITS_A_TAGCO_SIM = .False. - Input_Opt%ITS_AN_AEROSOL_SIM = .False. - - ! Now READ_ADVECTED_SPECIES_MENU - Input_Opt%N_Advect = nTracers - IF (Input_Opt%N_Advect.GT.Input_Opt%Max_AdvectSpc) THEN - CALL ENDRUN('Number of tracers exceeds max count') - ENDIF - ! Assign tracer names - DO J = 1, Input_Opt%N_Advect - Input_Opt%AdvectSpc_Name(J) = TRIM(tracerNames(J)) - ENDDO - ! No tagged species - Input_Opt%LSplit = .False. - - ! Now READ_TRANSPORT_MENU - Input_Opt%LTran = .True. - Input_Opt%LFill = .True. - Input_Opt%TPCore_IOrd = 3 - Input_Opt%TPCore_JOrd = 3 - Input_Opt%TPCore_KOrd = 3 - - ! Now READ_PHOTOLYSIS_MENU - Input_Opt%FAST_JX_DIR ='/glade/p/univ/umit0034/ExtData/' // & - 'CHEM_INPUTS/FAST_JX/v2019-06/' - - ! Now READ_CONVECTION_MENU - ! For now, TMMF - Input_Opt%LConv = .False. - Input_Opt%LTurb = .True. - Input_Opt%LNLPBL = .True. - - ! Now READ_EMISSIONS_MENU - Input_Opt%LEmis = .False. - Input_Opt%HCOConfigFile = 'HEMCO_Config.rc' - Input_Opt%LFix_PBL_Bro = .False. - - ! Set surface VMRs - turn this off so that CAM can handle it - Input_Opt%LCH4Emis = .False. - Input_Opt%LCH4SBC = .False. - Input_Opt%LOCSEmis = .False. - Input_Opt%LCFCEmis = .False. - Input_Opt%LClEmis = .False. - Input_Opt%LBrEmis = .False. - Input_Opt%LN2OEmis = .False. - Input_Opt%LBasicEmis = .False. - - ! Set initial conditions - Input_Opt%LSetH2O = .True. - - ! CFC control - Input_Opt%CFCYear = 0 - - ! Now READ_AEROSOL_MENU - Input_Opt%LSulf = .True. - Input_Opt%LMetalcatSO2 = .True. - Input_Opt%LCarb = .True. - Input_Opt%LBrC = .False. - Input_Opt%LSOA = .True. - Input_Opt%LSVPOA = .False. - Input_Opt%LOMOC = .False. - Input_Opt%LDust = .True. - Input_Opt%LDstUp = .False. - Input_Opt%LSSalt = .True. - Input_Opt%SalA_rEdge_um(1) = 0.01e+0_fp - Input_Opt%SalA_rEdge_um(2) = 0.50e+0_fp - Input_Opt%SalC_rEdge_um(1) = 0.50e+0_fp - Input_Opt%SalC_rEdge_um(2) = 8.00e+0_fp - Input_Opt%LMPOA = .False. - ! For now, disable solid PSCs and strat aerosol settling - ! Our treatment of the stratosphere isn't really sophisticated - ! enough to warrant it yet - Input_Opt%LGravStrat = .False. - Input_Opt%LSolidPSC = .False. - Input_Opt%LHomNucNAT = .False. - Input_Opt%T_NAT_Supercool = 3.0e+0_fp - Input_Opt%P_Ice_Supersat = 1.2e+0_fp - Input_Opt%LPSCChem = .True. - Input_Opt%LStratOD = .True. - Input_Opt%hvAerNIT = .False. - Input_Opt%hvAerNIT_JNIT = .False. - Input_Opt%hvAerNIT_JNITs = .False. - Input_Opt%JNITChanA = 0e+0_fp - Input_Opt%JNITChanB = 0e+0_fp - - ! Now READ_DEPOSITION_MENU - Input_Opt%LDryD = .True. - !================================================================== - ! Add the following options: - ! + GEOS-Chem computes ALL dry-deposition velocities - ! + CLM computes land velocities. Velocities over ocean and ice are - ! computed in a MOZART-like way - ! + CLM computes land velocities. Velocities over ocean and ice are - ! computed from GEOS-Chem - ! - ! Note: What to do about aerosols? Who should compute the dry - ! deposition velocities - ! - ! Thibaud M. Fritz - 26 Feb 2020 - !================================================================== - Input_Opt%LWetD = .True. - Input_Opt%CO2_Effect = .False. - Input_Opt%CO2_Level = 390.0_fp - Input_Opt%CO2_Ref = 390.0_fp - - ! Now READ_CHEMISTRY_MENU - Input_Opt%LChem = .True. - Input_Opt%LSChem = .False. ! .True. !TMMF - Input_Opt%LLinoz = .True. - Input_Opt%LSynoz = .True. - Input_Opt%LUCX = .True. - Input_Opt%LActiveH2O = .True. - Input_Opt%Use_Online_O3 = .True. - ! Expect to get total overhead ozone, although it shouldn not - ! make too much of a difference since we want to use "full-UCX" - Input_Opt%Use_O3_from_Met = .True. - Input_Opt%Use_TOMS_O3 = .False. - Input_Opt%Gamma_HO2 = 0.2e+0_fp - - Input_Opt%LPRT = .False. - - ! Read in data for Linoz. All CPUs allocate one array to hold the data. Only - ! the root CPU reads in the data; then we copy it out to a temporary array, - ! broadcast to all other CPUs, and finally duplicate the data into every - ! copy of Input_Opt - IF ( Input_Opt%LLinoz ) THEN - ! Allocate array for broadcast - nLinoz = Input_Opt%Linoz_NLevels * & - Input_Opt%Linoz_NLat * & - Input_Opt%Linoz_NMonths * & - Input_Opt%Linoz_NFields - ALLOCATE( linozData( Input_Opt%Linoz_NLevels, & - Input_Opt%Linoz_NLat, & - Input_Opt%Linoz_NMonths, & - Input_Opt%Linoz_NFields ), STAT=IERR) - IF (IERR.NE.0) CALL ENDRUN('Failure while allocating linozData') - linozData = 0.0e+0_r8 - - IF ( MasterProc ) THEN - ! Read data in to Input_Opt%Linoz_TParm - CALL Linoz_Read( MasterProc, Input_Opt, RC ) - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Error encountered in "Linoz_Read"!' - CALL Error_Stop( ErrMsg, ThisLoc ) - ENDIF - ! Copy the data to a temporary array - linozData = REAL(Input_Opt%LINOZ_TPARM,r8) - ENDIF -#if defined( SPMD ) - CALL MPIBCAST( linozData, nLinoz, MPIR8, 0, MPICOM ) -#endif - IF ( .NOT. MasterProc ) THEN - Input_Opt%LINOZ_TPARM = REAL(linozData,fp) - ENDIF - DEALLOCATE(linozData) - ENDIF - - - ! Note: The following calculations do not setup the gridcell areas. - ! In any case, we will need to be constantly updating this grid - ! to compensate for the "multiple chunks per processor" element - ALLOCATE(lonMidArr(nX,nY), STAT=IERR) - IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating lonMidArr') - ALLOCATE(lonEdgeArr(nX+1,nY+1), STAT=IERR) - IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating lonEdgeArr') - ALLOCATE(latMidArr(nX,nY), STAT=IERR) - IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating latMidArr') - ALLOCATE(latEdgeArr(nX+1,nY+1), STAT=IERR) - IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating latEdgeArr') - - ! We could try and get the data from CAM.. but the goal is to make this GC - ! component completely grid independent. So for now, we set to arbitrary - ! values - ! TODO: This needs more refinement. For now, this generates identical - ! State_Grid for all chunks - DO L = BEGCHUNK, ENDCHUNK - lonMidArr = 0.0e+0_f4 - latMidArr = 0.0e+0_f4 - dLonFix = 360.0e+0_fp / REAL(nX,fp) - dLatFix = 180.0e+0_fp / REAL(nY,fp) - DO I = 1, nX - ! Center of box, assuming dateline edge - lonVal = -180.0e+0_fp + (REAL(I-1,fp)*dLonFix) - DO J = 1, nY - ! Center of box, assuming regular cells - latVal = -90.0e+0_fp + (REAL(J-1,fp)*dLatFix) - lonMidArr(I,J) = REAL((lonVal + (0.5e+0_fp * dLonFix)) * PI_180, f4) - latMidArr(I,J) = REAL((latVal + (0.5e+0_fp * dLatFix)) * PI_180, f4) - - ! Edges of box, assuming regular cells - lonEdgeArr(I,J) = REAL(lonVal * PI_180, f4) - latEdgeArr(I,J) = REAL(latVal * PI_180, f4) - ENDDO - ! Edges of box, assuming regular cells - lonEdgeArr(I,nY+1) = REAL((lonVal + dLonFix) * PI_180, f4) - latEdgeArr(I,nY+1) = REAL((latVal + dLatFix) * PI_180, f4) - ENDDO - DO J = 1, nY+1 - ! Edges of box, assuming regular cells - latVal = -90.0e+0_fp + (REAL(J-1,fp)*dLatFix) - lonEdgeArr(nX+1,J) = REAL((lonVal + dLonFix) * PI_180, f4) - latEdgeArr(nX+1,J) = REAL((latVal) * PI_180, f4) - ENDDO - - CALL SetGridFromCtrEdges( State_Grid = State_Grid(L), & - lonCtr = lonMidArr, & - latCtr = latMidArr, & - lonEdge = lonEdgeArr, & - latEdge = latEdgeArr, & - RC = RC ) - - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Error encountered in "SetGridFromCtrEdges"!' - CALL Error_Stop( ErrMsg, ThisLoc ) - ENDIF - - ENDDO - DEALLOCATE(lonMidArr) - DEALLOCATE(latMidArr) - DEALLOCATE(lonEdgeArr) - DEALLOCATE(latEdgeArr) - - - ! Set the times held by "time_mod" - CALL Accept_External_Date_Time( value_NYMDb = Input_Opt%NYMDb, & - value_NHMSb = Input_Opt%NHMSb, & - value_NYMDe = Input_Opt%NYMDe, & - value_NHMSe = Input_Opt%NHMSe, & - value_NYMD = Input_Opt%NYMDb, & - value_NHMS = Input_Opt%NHMSb, & - RC = RC ) - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Error encountered in "Accept_External_Date_Time"!' - CALL Error_Stop( ErrMsg, ThisLoc ) - ENDIF - - ! Start by setting some dummy timesteps - CALL GC_Update_Timesteps(300.0E+0_r8) - - ! Initialize error module - CALL Init_Error( MasterProc, Input_Opt, RC ) - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Error encountered in "Init_Error"!' - CALL Error_Stop( ErrMsg, ThisLoc ) - ENDIF - - ! Set a flag to denote if we should print ND70 debug output - prtDebug = ( Input_Opt%LPRT .and. MasterProc ) - - ! Debug output - IF ( prtDebug ) CALL Debug_Msg( '### MAIN: a READ_INPUT_FILE' ) - - historyConfigFile = 'HISTORY.rc' ! InputOpt not yet initialized - !TMMF need to pass input.geos path - !CALL Init_DiagList( MasterProc, historyConfigFile, Diag_List, RC ) - !IF ( RC /= GC_SUCCESS ) THEN - ! ErrMsg = 'Error encountered in "Init_DiagList"!' - ! CALL Error_Stop( ErrMsg, ThisLoc ) - !ENDIF - - !!### Print diagnostic list if needed for debugging - !IF ( prtDebug ) CALL Print_DiagList( Diag_List, RC ) - - DO I = BEGCHUNK, ENDCHUNK - - CALL GC_Init_StateObj( Diag_List = Diag_List, & ! Diagnostic list obj - & Input_Opt = Input_Opt, & ! Input Options - & State_Chm = State_Chm(I), & ! Chemistry State - & State_Diag = State_Diag(I), & ! Diagnostics State - & State_Grid = State_Grid(I), & ! Grid State - & State_Met = State_Met(I), & ! Meteorology State - & RC = RC ) ! Success or failure - - ! Trap potential errors - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Error encountered in "GC_Init_StateObj"!' - CALL Error_Stop( ErrMsg, ThisLoc ) - ENDIF - - ! Start with v/v dry (CAM standard) - State_Chm(I)%Spc_Units = 'v/v dry' - - ENDDO - - ! Now replicate GC_Init_Extra - IF ( Input_Opt%LDryD ) THEN - - ! Setup for dry deposition - CALL Init_Drydep( Input_Opt = Input_Opt, & - & State_Chm = State_Chm(BEGCHUNK), & - & State_Diag = State_Diag(BEGCHUNK), & - & State_Grid = State_Grid(BEGCHUNK), & - & RC = RC ) - - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Error encountered in "Init_Drydep"!' - CALL Error_Stop( ErrMsg, ThisLoc ) - ENDIF - - !============================================================== - ! Get mapping between CESM dry deposited species and the - ! indices of State_Chm%DryDepVel. This needs to be done after - ! Init_Drydep - ! Thibaud M. Fritz - 04 Mar 2020 - !============================================================== - - ALLOCATE(map2GC_dryDep(nddvels), STAT=IERR) - IF ( IERR .NE. 0 ) CALL ENDRUN('Failed to allocate map2GC_dryDep') - - DO N = 1, nddvels - - ! Initialize index to -1 - map2GC_dryDep(N) = -1 - - IF ( drySpc_ndx(N) > 0 ) THEN - - ! Convert to upper case - SpcName = to_upper(drydep_list(N)) - - DO I = 1, State_Chm(BEGCHUNK)%nDryDep - IF ( TRIM( SpcName ) == TRIM( to_upper(depName(I)) ) ) THEN - map2GC_dryDep(N) = nDVZind(I) - EXIT - ENDIF - ENDDO - - ENDIF - - ENDDO - -#if ( OCNDDVEL_MOZART ) - !============================================================== - ! The following line should only be called if we compute - ! velocities over the ocean and ice in a MOZART-like way. - ! Thibaud M. Fritz - 26 Feb 2020 - !============================================================== - - IF ( drydep_method == DD_XLND ) THEN - CALL drydep_inti( MOZART_depvel_lnd_file, & - MOZART_clim_soilw_file, & - MOZART_season_wes_file ) - ELSE - Write(iulog,'(a,a)') ' drydep_method is set to: ', TRIM(drydep_method) - CALL ENDRUN('drydep_method must be DD_XLND to compute dry deposition' // & - ' velocities similarly to MOZART over ocean and ice!') - ENDIF -#endif - - ENDIF - - !================================================================= - ! Call setup routines for wet deposition - ! - ! We need to initialize the wetdep module if either wet - ! deposition or convection is turned on, so that we can do the - ! large-scale and convective scavenging. Also initialize the - ! wetdep module if both wetdep and convection are turned off, - ! but chemistry is turned on. The INIT_WETSCAV routine will also - ! allocate the H2O2s and SO2s arrays that are referenced in the - ! convection code. (bmy, 9/23/15) - !================================================================= - IF ( Input_Opt%LConv .OR. & - Input_Opt%LWetD .OR. & - Input_Opt%LChem ) THEN - CALL Init_WetScav( Input_Opt = Input_Opt, & - & State_Chm = State_Chm(BEGCHUNK), & - & State_Diag = State_Diag(BEGCHUNK), & - & State_Grid = State_Grid(BEGCHUNK), & - & RC = RC ) - - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Error encountered in "Init_WetScav"!' - CALL Error_Stop( ErrMsg, ThisLoc ) - ENDIF - ENDIF - - !----------------------------------------------------------------- - ! Call SET_VDIFF_VALUES so that we can pass several values from - ! Input_Opt to the vdiff_mod.F90. This replaces the functionality - ! of logical_mod.F and tracer_mod.F.. This has to be called - ! after the input.geos file has been read from disk. - !----------------------------------------------------------------- - !CALL Set_VDiff_Values( Input_Opt = Input_Opt, & - !& State_Chm = State_Chm(BEGCHUNK), & - !& RC = RC ) - - !&IF (RC /= GC_SUCCESS) THEN - ! ErrMsg = 'Error encountered in "Set_VDiff_Values"!' - ! CALL Error_Stop( ErrMsg, ThisLoc ) - !ENDIF - - !----------------------------------------------------------------- - ! Initialize the GET_NDEP_MOD for soil NOx deposition (bmy, 6/17/16) - !----------------------------------------------------------------- - !CALL Init_Get_NDep( Input_Opt = Input_Opt, & - !& State_Chm = State_Chm(BEGCHUNK), & - !& State_Diag = State_Diag(BEGCHUNK), & - !& RC = RC ) - ! - !IF (RC /= GC_SUCCESS) THEN - ! ErrMsg = 'Error encountered in "Init_Get_NDep"!' - ! CALL Error_Stop( ErrMsg, ThisLoc ) - !ENDIF - - !----------------------------------------------------------------- - ! Initialize "carbon_mod.F" - !----------------------------------------------------------------- - IF ( Input_Opt%LCarb ) THEN - CALL Init_Carbon( Input_Opt = Input_Opt, & - & State_Chm = State_Chm(BEGCHUNK), & - & State_Diag = State_Diag(BEGCHUNK), & - & State_Grid = State_Grid(BEGCHUNK), & - & RC = RC ) - - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Error encountered in "Init_Carbon"!' - CALL Error_Stop( ErrMsg, ThisLoc ) - ENDIF - ENDIF - - IF ( Input_Opt%LDust ) THEN - CALL Init_Dust( Input_Opt = Input_Opt, & - & State_Chm = State_Chm(BEGCHUNK), & - & State_Diag = State_Diag(BEGCHUNK), & - & State_Grid = State_Grid(BEGCHUNK), & - & RC = RC ) - - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Error encountered in "Init_Dust"!' - CALL Error_Stop( ErrMsg, ThisLoc ) - ENDIF - ENDIF - - IF ( Input_Opt%LSSalt ) THEN - CALL Init_Seasalt( Input_Opt = Input_Opt, & - & State_Chm = State_Chm(BEGCHUNK), & - & State_Diag = State_Diag(BEGCHUNK), & - & State_Grid = State_Grid(BEGCHUNK), & - & RC = RC ) - - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Error encountered in "Init_Seasalt"!' - CALL Error_Stop( ErrMsg, ThisLoc ) - ENDIF - ENDIF - - IF ( Input_Opt%LSulf ) THEN - CALL Init_Sulfate( Input_Opt = Input_Opt, & - & State_Chm = State_Chm(BEGCHUNK), & - & State_Diag = State_Diag(BEGCHUNK), & - & State_Grid = State_Grid(BEGCHUNK), & - & RC = RC ) - - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Error encountered in "Init_Sulfate"!' - CALL Error_Stop( ErrMsg, ThisLoc ) - ENDIF - ENDIF - - IF ( Input_Opt%LSulf .OR. & - Input_Opt%LCarb .OR. & - Input_Opt%LDust .OR. & - Input_Opt%LSSalt ) THEN - CALL Init_Aerosol( Input_Opt = Input_Opt, & - & State_Chm = State_Chm(BEGCHUNK), & - & State_Diag = State_Diag(BEGCHUNK), & - & State_Grid = State_Grid(BEGCHUNK), & - & RC = RC ) - - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Error encountered in "Init_Aerosol"!' - CALL Error_Stop( ErrMsg, ThisLoc ) - ENDIF - ENDIF - - ! This is a bare subroutine - no module - CALL NDXX_Setup( Input_Opt, & - & State_Chm(BEGCHUNK), & - & State_Grid(BEGCHUNK), & - & RC ) - - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Error encountered in "Init_NDXX_Setup"!' - CALL Error_Stop( ErrMsg, ThisLoc ) - ENDIF - - CALL Init_PBL_Mix( State_Grid = State_Grid(BEGCHUNK), & - RC = RC ) - - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Error encountered in "Init_PBL_Mix"!' - CALL Error_Stop( ErrMsg, ThisLoc ) - ENDIF - - ! Set grid-cell area - DO I = BEGCHUNK, ENDCHUNK - ALLOCATE(Col_Area(NCOL(I)), STAT=IERR) - IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating Col_Area') - - CALL Get_Area_All_p(I, NCOL(I), Col_Area) - - ! Set default value (in case of chunks with fewer columns) - State_Grid(I)%Area_M2 = 1.0e+10_fp - DO iX = 1, nX - DO jY = 1, NCOL(I) - State_Grid(I)%Area_M2(iX,jY) = REAL(Col_Area(jY) * Re**2,fp) - ENDDO - ENDDO - - DEALLOCATE(Col_Area) - - ! Copy to State_Met(I)%Area_M2 - State_Met(I)%Area_M2 = State_Grid(I)%Area_M2 - ENDDO - - - ! Initialize (mostly unused) diagnostic arrays - ! WARNING: This routine likely calls on modules which are currently - ! excluded from the GC-CESM build (eg diag03) - ! CALL Initialize( MasterProc, Input_Opt, 2, RC ) - ! CALL Initialize( Masterproc, Input_Opt, 3, RC ) - - ! Get Ap and Bp from CAM at pressure edges - ALLOCATE(Ap_CAM_Flip(nZ+1), STAT=IERR) - IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating Ap_CAM_Flip') - ALLOCATE(Bp_CAM_Flip(nZ+1), STAT=IERR) - IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating Bp_CAM_Flip') - - Ap_CAM_Flip = 0.0e+0_fp - Bp_CAM_Flip = 0.0e+0_fp - DO I = 1, (nZ+1) - Ap_CAM_Flip(I) = hyai(nZ+2-I) * ps0 * 0.01e+0_r8 - Bp_CAM_Flip(I) = hybi(nZ+2-I) - ENDDO - - !----------------------------------------------------------------- - ! Initialize the hybrid pressure module. Define Ap and Bp. - !----------------------------------------------------------------- - CALL Init_Pressure( State_Grid = State_Grid(BEGCHUNK), & ! Grid State - RC = RC ) ! Success or failure - - ! Trapping errors - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Error encountered in "Init_Pressure"!' - CALL Error_Stop( ErrMsg, ThisLoc ) - ENDIF - - !----------------------------------------------------------------- - ! Pass external Ap and Bp to GEOS-Chem's Pressure_Mod - !----------------------------------------------------------------- - CALL Accept_External_ApBp( State_Grid = State_Grid(BEGCHUNK), & ! Grid State - ApIn = Ap_CAM_Flip, & ! "A" term for hybrid grid - BpIn = Bp_CAM_Flip, & ! "B" term for hybrid grid - RC = RC ) ! Success or failure - - ! Print vertical coordinates - IF ( MasterProc ) THEN - WRITE( 6, '(a)' ) REPEAT( '=', 79 ) - WRITE( 6, '(a,/)' ) 'V E R T I C A L G R I D S E T U P' - WRITE( 6, '( ''Ap '', /, 6(f11.6,1x) )' ) Ap_CAM_Flip(1:State_Grid(BEGCHUNK)%NZ+1) - WRITE( 6, '(a)' ) - WRITE( 6, '( ''Bp '', /, 6(f11.6,1x) )' ) Bp_CAM_Flip(1:State_Grid(BEGCHUNK)%NZ+1) - WRITE( 6, '(a)' ) REPEAT( '=', 79 ) - ENDIF - - ! Trapping errors - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Error encountered in "Accept_External_ApBp"!' - CALL Error_Stop( ErrMsg, ThisLoc ) - ENDIF - - DEALLOCATE(Ap_CAM_Flip,Bp_CAM_Flip) - - !! Initialize HEMCO? - !CALL Emissions_Init ( Input_Opt = Input_Opt, & - ! State_Met = State_Met, & - ! State_Chm = State_Chm, & - ! State_Grid = State_Grid, & - ! State_Met = State_Met, & - ! RC = RC, & - ! HcoConfig = HcoConfig ) - ! - !IF ( RC /= GC_SUCCESS ) THEN - ! ErrMsg = 'Error encountered in "Emissions_Init"!' - ! CALL Error_Stop( ErrMsg, ThisLoc ) - !ENDIF - ! - -#if ( ALLDDVEL_GEOSCHEM && LANDTYPE_HEMCO ) - ! Populate the State_Met%LandTypeFrac field with data from HEMCO - CALL Init_LandTypeFrac( Input_Opt = Input_Opt, & - State_Met = State_Met(BEGCHUNK), & - RC = RC ) - - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Error encountered in "Init_LandTypeFrac"!' - CALL Error_Stop( ErrMsg, ThisLoc ) - ENDIF - - ! Compute the Olson landmap fields of State_Met - ! (e.g. State_Met%IREG, State_Met%ILAND, etc.) - CALL Compute_Olson_Landmap( Input_Opt = Input_Opt, & - State_Grid = State_Grid(BEGCHUNK), & - State_Met = State_Met(BEGCHUNK), & - RC = RC ) - - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Error encountered in "Compute_Olson_Landmap"!' - CALL Error_Stop( ErrMsg, ThisLoc ) - ENDIF -#endif - - ! Initialize PBL quantities but do not do mixing - ! Add option for non-local PBL (Lin, 03/31/09) - CALL Init_Mixing ( Input_Opt = Input_Opt, & - State_Chm = State_Chm(BEGCHUNK), & - State_Diag = State_Diag(BEGCHUNK), & - State_Grid = State_Grid(BEGCHUNK), & - State_Met = State_Met(BEGCHUNK), & - RC = RC ) - - ! Trap potential errors - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Error encountered in Init_Mixing!' - CALL Error_Stop( ErrMsg, ThisLoc ) - ENDIF - - IF ( Input_Opt%Its_A_FullChem_Sim .OR. & - Input_Opt%Its_An_Aerosol_Sim ) THEN - ! This also initializes Fast-JX - CALL Init_Chemistry( Input_Opt = Input_Opt, & - & State_Chm = State_Chm(BEGCHUNK), & - & State_Diag = State_Diag(BEGCHUNK), & - & State_Grid = State_Grid(BEGCHUNK), & - & RC = RC ) - - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Error encountered in "Init_Chemistry"!' - CALL Error_Stop( ErrMsg, ThisLoc ) - ENDIF - ENDIF - - IF ( Input_Opt%LChem .AND. & - Input_Opt%LUCX ) THEN - CALL Init_UCX( Input_Opt = Input_Opt, & - & State_Chm = State_Chm(BEGCHUNK), & - & State_Diag = State_Diag(BEGCHUNK), & - & State_Grid = State_Grid(BEGCHUNK) ) - ENDIF - - ! Get the index of H2O - iH2O = Ind_('H2O') - iO3 = Ind_('O3') - iCH4 = Ind_('CH4') - iCO = Ind_('CO') - iNO = Ind_('NO') - - ! Get indices for physical fields in physics buffer - NDX_PBLH = Pbuf_Get_Index('pblh' ) - NDX_FSDS = Pbuf_Get_Index('FSDS' ) - NDX_CLDTOP = Pbuf_Get_Index('CLDTOP' ) - NDX_CLDFRC = Pbuf_Get_Index('CLD' ) - NDX_PRAIN = Pbuf_Get_Index('PRAIN' ) - NDX_NEVAPR = Pbuf_Get_Index('NEVAPR' ) - NDX_RPRDTOT = Pbuf_Get_Index('RPRDTOT' ) - NDX_LSFLXPRC = Pbuf_Get_Index('LS_FLXPRC') - NDX_LSFLXSNW = Pbuf_Get_Index('LS_FLXSNW') - - ! Get cloud water indices - CALL Cnst_Get_Ind('CLDLIQ', ixCldLiq) - CALL Cnst_Get_Ind('CLDICE', ixCldIce) - - ! Can add history output here too with the "addfld" & "add_default" routines - ! Note that constituents are already output by default - ! Add all species as output fields if desired - DO I = 1, nTracers - SpcName = TRIM(tracerNames(I)) - CALL AddFld( TRIM(SpcName), (/ 'lev' /), 'A', 'mol/mol', TRIM(tracerLongNames(I))//' concentration') - IF (TRIM(SpcName) == 'O3') THEN - CALL Add_Default ( TRIM(SpcName), 1, ' ') - ENDIF - ENDDO - DO I =1, nSls - SpcName = TRIM(slsNames(I)) - CALL AddFld( TRIM(SpcName), (/ 'lev' /), 'A', 'mol/mol', TRIM(slsLongNames(I))//' concentration') - !CALL Add_Default(TRIM(SpcName), 1, '') - ENDDO - - ! Initialize emissions interface (this will eventually handle HEMCO) - CALL GC_Emissions_Init - - !CALL AddFld ( 'BCPI', (/'lev'/), 'A', 'mole/mole', trim('BCPI')//' mixing ratio' ) - !CALL Add_Default ( 'BCPI', 1, ' ') - -#if defined( CLM40 ) - SpcName = 'lu_soil' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'lu_landice' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'lu_deeplake' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'lu_shallowlake' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'lu_wetland' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'lu_urban' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'lu_icemec' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'lu_crop' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') -#elif defined( CLM45 ) || defined( CLM50 ) - SpcName = 'lu_soil' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'lu_crop' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'lu_landice' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'lu_deeplake' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'lu_wetland' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'lu_urban' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') -#endif - SpcName = 'p_notveg' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_needle_eg_temp' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_needle_eg_bor' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_needle_dd_bor' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_broad_eg_trop' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_broad_eg_temp' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_broad_dd_trop' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_broad_dd_temp' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_broad_dd_bor' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_broad_eg_sh' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_broad_dd_temp_sh' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_broad_dd_bor_sh' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_c3_arctic_grass' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_c3_narctic_grass' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_c4_grass' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_c3_crop' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_c3_irrigated' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') -#if defined( CLM40 ) - SpcName = 'p_c3_corn' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_spring_cereal' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_winter_cereal' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_soybean' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') -#elif defined( CLM45 ) || defined( CLM50 ) - SpcName = 'p_temp_corn' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_irr_temp_corn' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_spring_wheat' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_irr_spring_wheat' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_winter_wheat' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_irr_winter_wheat' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_temp_soybean' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_irr_temp_soybean' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_barley' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_irr_barley' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_winter_barley' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_irr_winter_barley' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_rye' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_irr_rye' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_winter_rye' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_irr_winter_rye' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_cassava' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_irr_cassava' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_citrus' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_irr_citrus' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_cocoa' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_irr_cocoa' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_coffee' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_irr_coffee' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_cotton' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_irr_cotton' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_datepalm' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_irr_datepalm' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_foddergrass' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_irr_foddergrass' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_grapes' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_irr_grapes' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_groundnuts' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_irr_groundnuts' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_millet' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_irr_millet' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_oilpalm' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_irr_oilpalm' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_potatoes' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_irr_potatoes' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_pulses' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_irr_pulses' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_rapeseed' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_irr_rapessed' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_rice' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_irr_rice' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_sorghum' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_irr_sorghum' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_sugarbeet' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_irr_sugarbeet' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_sugarcane' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_irr_sugarcane' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_sunflower' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_irr_sunflower' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_miscanthus' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_irr_miscanthus' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_switchgrass' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_irr_switchgrass' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_trop_corn' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_irr_trop_corn' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_trop_soybean' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'p_irr_trop_soybean' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') -#endif - SpcName = 'pla_notveg' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_needle_eg_temp' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_needle_eg_bor' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_needle_dd_bor' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_broad_eg_trop' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_broad_eg_temp' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_broad_dd_trop' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_broad_dd_temp' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_broad_dd_bor' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_broad_eg_sh' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_broad_dd_temp_sh' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_broad_dd_bor_sh' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_c3_arctic_grass' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_c3_narctic_grass' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_c4_grass' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_c3_crop' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_c3_irrigated' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') -#if defined( CLM40 ) - SpcName = 'pla_c3_corn' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_spring_cereal' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_winter_cereal' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_soybean' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') -#elif defined( CLM45 ) || defined( CLM50 ) - SpcName = 'pla_temp_corn' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_irr_temp_corn' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_spring_wheat' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_irr_spring_wheat' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_winter_wheat' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_irr_winter_wheat' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_temp_soybean' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_irr_temp_soybean' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_barley' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_irr_barley' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_winter_barley' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_irr_winter_barley' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_rye' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_irr_rye' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_winter_rye' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_irr_winter_rye' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_cassava' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_irr_cassava' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_citrus' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_irr_citrus' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_cocoa' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_irr_cocoa' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_coffee' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_irr_coffee' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_cotton' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_irr_cotton' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_datepalm' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_irr_datepalm' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_foddergrass' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_irr_foddergrass' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_grapes' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_irr_grapes' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_groundnuts' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_irr_groundnuts' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_millet' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_irr_millet' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_oilpalm' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_irr_oilpalm' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_potatoes' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_irr_potatoes' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_pulses' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_irr_pulses' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_rapeseed' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_irr_rapessed' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_rice' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_irr_rice' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_sorghum' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_irr_sorghum' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_sugarbeet' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_irr_sugarbeet' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_sugarcane' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_irr_sugarcane' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_sunflower' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_irr_sunflower' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_miscanthus' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_irr_miscanthus' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_switchgrass' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_irr_switchgrass' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_trop_corn' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_irr_trop_corn' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_trop_soybean' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') - SpcName = 'pla_irr_trop_soybean' - CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'fraction', TRIM(SpcName)//' surface area') -#endif - - IF (MasterProc) WRITE(iulog,'(a)') 'GCCALL CHEM_INIT' - - end subroutine chem_init - -!=============================================================================== - - subroutine chem_timestep_init(phys_state, pbuf2d) - use physics_buffer, only: physics_buffer_desc - - TYPE(physics_state), INTENT(IN):: phys_state(begchunk:endchunk) - TYPE(physics_buffer_desc), POINTER :: pbuf2d(:,:) - - ! Not sure what we would realistically do here rather than in tend - - end subroutine chem_timestep_init - -!=============================================================================== - - subroutine GC_Update_Timesteps(DT) - - use Time_Mod, only : Set_Timesteps - - REAL(r8), INTENT(IN) :: DT - INTEGER :: DT_MIN - INTEGER, SAVE :: DT_MIN_LAST = -1 - - DT_MIN = NINT(DT) - - Input_Opt%TS_CHEM = DT_MIN - Input_Opt%TS_EMIS = DT_MIN - Input_Opt%TS_CONV = DT_MIN - Input_Opt%TS_DYN = DT_MIN - Input_Opt%TS_RAD = DT_MIN - - ! Only bother updating the module information if there's been a change - IF (DT_MIN .NE. DT_MIN_LAST) THEN - IF (MasterProc) WRITE(iulog,'(a,F7.1,a)') ' --> GC: updating dt to ', DT, ' seconds' - - CALL Set_Timesteps( MasterProc, & - CHEMISTRY = DT_MIN, & - EMISSION = DT_MIN, & - DYNAMICS = DT_MIN, & - UNIT_CONV = DT_MIN, & - CONVECTION = DT_MIN, & - DIAGNOS = DT_MIN, & - RADIATION = DT_MIN ) - DT_MIN_LAST = DT_MIN - ENDIF - - end subroutine - -!=============================================================================== - - subroutine chem_timestep_tend( State, ptend, cam_in, cam_out, dT, pbuf, fh2o ) - - use physics_buffer, only: physics_buffer_desc, pbuf_get_field, pbuf_old_tim_idx - use cam_history, only: outfld - use camsrfexch, only: cam_in_t, cam_out_t - - use phys_grid, only: get_ncols_p, get_rlat_all_p, get_rlon_all_p - - use chem_mods, only: drySpc_ndx, map2GC_dryDep -#if ( LANDTYPE_CLM ) - use Olson_Landmap_Mod, only: Compute_Olson_Landmap - use Modis_LAI_Mod, only: Compute_XLAI -#endif -#if ( ALLDDVEL_GEOSCHEM || OCNDDVEL_GEOSCHEM ) - use Drydep_Mod, only: Do_Drydep -#elif ( OCNDDVEL_MOZART ) - use mo_drydep, only: drydep_update, drydep_fromlnd -#endif - use Drydep_Mod, only: DEPNAME !TMMF, this is just needed for debug - use Drydep_Mod, only: Update_DryDepSav - use Mixing_Mod - - use Calc_Met_Mod, only: Set_Dry_Surface_Pressure - use Calc_Met_Mod, only: AirQnt - use GC_Grid_Mod, only: SetGridFromCtr - use Pressure_Mod, only: Set_Floating_Pressures - use Pressure_Mod, only: Accept_External_Pedge - use Time_Mod, only: Accept_External_Date_Time - use Strat_chem_Mod, only: Init_Strat_Chem - use Toms_Mod, only: Compute_Overhead_O3 - use Chemistry_Mod, only: Do_Chemistry - use Wetscav_Mod, only: Setup_Wetscav, Do_WetDep - use CMN_Size_Mod, only: PTop - use PBL_Mix_Mod, only: Compute_PBL_Height - - use Tropopause, only: Tropopause_findChemTrop, Tropopause_Find - - ! For calculating SZA - use Orbit, only: zenith - use Time_Manager, only: Get_Curr_Calday, Get_Curr_Date - - ! Calculating relative humidity - use WV_Saturation, only: QSat - use PhysConst, only: MWDry - - ! Grid area - use PhysConst, only: Gravit - use PhysConstants, only: Re - use Phys_Grid, only: get_area_all_p, get_lat_all_p, get_lon_all_p - - use Short_Lived_Species, only : Get_Short_Lived_Species - use Short_Lived_Species, only : Set_Short_Lived_Species - - ! Use GEOS-Chem versions of physical constants - use PhysConstants, only: PI, PI_180, g0 - - REAL(r8), INTENT(IN) :: dT ! Time step - TYPE(physics_state), INTENT(IN) :: State ! Physics State variables - TYPE(physics_ptend), INTENT(OUT) :: ptend ! indivdual parameterization tendencies - TYPE(cam_in_t), INTENT(INOUT) :: cam_in - TYPE(cam_out_t), INTENT(IN) :: cam_out - TYPE(physics_buffer_desc), POINTER :: pbuf(:) - REAL(r8), OPTIONAL, INTENT(OUT) :: fh2o(PCOLS) ! h2o flux to balance source from chemistry - - ! Initial MMR for all species - REAL(r8) :: MMR_Beg(PCOLS,PVER,nSls+nTracers) - REAL(r8) :: MMR_End(PCOLS,PVER,nSls+nTracers) - REAL(r8) :: MMR_TEnd(PCOLS,PVER,nSls+nTracers) - - - ! Mapping (?) - LOGICAL :: lq(pcnst) - - ! Indexing - INTEGER :: I, J, K, L, N, M - INTEGER :: nX, nY, nZ - - INTEGER :: LCHNK, NCOL - - REAL(r8), DIMENSION(State%NCOL) :: & - CSZA, & ! Cosine of solar zenith angle - Zsurf, & ! Surface height - Rlats, Rlons ! Chunk latitudes and longitudes (radians) - - REAL(r8), POINTER :: PblH(:) ! PBL height on each chunk [m] - REAL(r8), POINTER :: cldTop(:) ! Cloud top height [?] - REAL(r8), POINTER :: cldFrc(:,:) ! Cloud fraction [-] - REAL(r8), POINTER :: Fsds(:) ! Downward shortwave flux at surface [W/m2] - REAL(r8), POINTER :: PRain(:,:) ! Total stratiform precip. prod. (rain + snow) [kg/kg/s] - REAL(r8), POINTER :: RprdTot(:,:) ! Total convective precip. prod. (rain + snow) [kg/kg/s] - REAL(r8), POINTER :: NEvapr(:,:) ! Evaporation of total precipitation (rain + snow) [kg/kg/s] - REAL(r8), POINTER :: LsFlxPrc(:,:) ! Large-scale downward precip. flux at interface (rain + snow) [kg/m2/s] - REAL(r8), POINTER :: LsFlxSnw(:,:) ! Large-scale downward precip. flux at interface (snow only) [kg/m2/s] - - REAL(r8) :: RelHum(State%NCOL, PVER) ! Relative humidity [0-1] - REAL(r8) :: SatV (State%NCOL, PVER) ! Work arrays - REAL(r8) :: SatQ (State%NCOL, PVER) ! Work arrays - REAL(r8) :: qH2O (State%NCOL, PVER) ! Specific humidity [kg/kg] - REAL(r8) :: H2OVMR(State%NCOL, PVER) ! H2O volume mixing ratio -#if ( OCNDDVEL_MOZART ) - REAL(r8) :: windSpeed(State%NCOL) ! Wind speed at ground level [m/s] - REAL(r8) :: potT(State%NCOL) ! Potential temperature [K] - - INTEGER :: latndx(PCOLS) - INTEGER :: lonndx(PCOLS) - - ! For MOZART's dry deposition over ocean and ice - ! Deposition velocity (cm/s) - REAL(r8) :: MOZART_depVel(State%NCOL, nTracersMax) - ! Deposition flux (/cm^2/s) - REAL(r8) :: MOZART_depFlx(State%NCOL, nTracersMax) -#endif - REAL(r8), PARAMETER :: zlnd = 0.01_r8 ! Roughness length for soil [m] - REAL(r8), PARAMETER :: zslnd = 0.0024_r8 ! Roughness length for snow [m] - REAL(r8), PARAMETER :: zsice = 0.0400_r8 ! Roughness length for sea ice [m] - REAL(r8), PARAMETER :: zocn = 0.0001_r8 ! Roughness length for oean [m] - - ! Because of strat chem - LOGICAL, SAVE :: SCHEM_READY = .FALSE. - - REAL(f4) :: lonMidArr(1,PCOLS), latMidArr(1,PCOLS) - INTEGER :: iMaxLoc(1) - - REAL(r8) :: Col_Area(State%NCOL) - - ! Intermediate arrays - INTEGER :: Trop_Lev (PCOLS) - REAL(r8) :: Trop_P (PCOLS) - REAL(r8) :: Trop_T (PCOLS) - REAL(r8) :: Trop_Ht (PCOLS) - REAL(r8) :: SnowDepth(PCOLS) - REAL(r8) :: cld2D (PCOLS) - REAL(r8) :: Z0 (PCOLS) - REAL(r8) :: Sd_Ice, Sd_Lnd, Sd_Avg, Frc_Ice - - ! Estimating cloud optical depth - REAL(r8) :: cld(PCOLS,PVER) - REAL(r8) :: TauCli(PCOLS,PVER) - REAL(r8) :: TauClw(PCOLS,PVER) - REAL(r8), PARAMETER :: re_m = 1.0e-05_r8 ! Cloud drop radius in m - REAL(r8), PARAMETER :: cldMin = 1.0e-02_r8 ! Minimum cloud cover - REAL(r8), PARAMETER :: cnst = 1.5e+00_r8 / (re_m * 1.0e+03_r8 * g0) - - ! Calculating SZA - REAL(r8) :: Calday - - ! For archiving - CHARACTER(LEN=255) :: SpcName - REAL(r8) :: VMR(State%NCOL,PVER) - - REAL(r8) :: SlsData(State%NCOL, PVER, nSls) - - INTEGER :: currYr, currMo, currDy, currTOD - INTEGER :: currYMD, currHMS, currHr, currMn, currSc - REAL(f4) :: currUTC - LOGICAL :: firstDay = .True. - LOGICAL :: newDay = .False. - LOGICAL :: newMonth = .False. - - INTEGER :: TIM_NDX - - INTEGER, SAVE :: iStep = 0 - LOGICAL :: rootChunk - INTEGER :: RC - - ! LCHNK: which chunk we have on this process - LCHNK = State%LCHNK - ! NCOL: number of atmospheric columns on this chunk - NCOL = State%NCOL - - ! Am I the first chunk on the first CPU? - rootChunk = ( MasterProc.and.(LCHNK==BEGCHUNK) ) - - ! Count the number of steps which have passed - IF (LCHNK.EQ.BEGCHUNK) iStep = iStep + 1 - - ! Need to update the timesteps throughout the code - CALL GC_Update_Timesteps(dT) - - - ! For safety's sake - PTop = State%Pint(1,1)*0.01e+0_fp - - ! Need to be super careful that the module arrays are updated and correctly - ! set. NOTE: First thing - you'll need to flip all the data vertically - - nX = 1 - nY = NCOL - nZ = PVER - - ! Update the grid lat/lons since they are module variables - ! Assume (!) that area hasn't changed for now, as GEOS-Chem will - ! retrieve this from State_Met which is chunked - !CALL get_rlat_all_p( LCHNK, NCOL, Rlats ) - !CALL get_rlon_all_p( LCHNK, NCOL, Rlons ) - Rlats(1:nY) = State%Lat(1:nY) - Rlons(1:nY) = State%Lon(1:nY) - - lonMidArr = 0.0e+0_f4 - latMidArr = 0.0e+0_f4 - DO I = 1, nX - DO J = 1, nY - lonMidArr(I,J) = REAL(Rlons(J), f4) - latMidArr(I,J) = REAL(Rlats(J), f4) - ENDDO - ENDDO - - ! Update the grid - Call SetGridFromCtr( State_Grid = State_Grid(LCHNK), & - lonCtr = lonMidArr, & - latCtr = latMidArr, & - RC = RC ) - - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Error encountered within call to "SetGridFromCtr"!' - CALL Error_Stop( ErrMsg, ThisLoc ) - ENDIF - - ! Set area - CALL Get_Area_All_p( LCHNK, nY, Col_Area ) - - ! Field : AREA_M2 - ! Description: Grid box surface area - ! Unit : - - ! Dimensions : nX, nY - ! Note : Set default value (in case of chunks with fewer columns) - State_Grid(LCHNK)%Area_M2 = 1.0e+10_fp - DO J = 1, nY - State_Grid(LCHNK)%Area_M2(1,J) = REAL(Col_Area(J) * Re**2,fp) - ENDDO - State_Met(LCHNK)%Area_M2 = State_Grid(LCHNK)%Area_M2 - - ! 2. Copy tracers into State_Chm - ! Data was received in kg/kg dry - State_Chm(LCHNK)%Spc_Units = 'kg/kg dry' - ! Initialize ALL State_Chm species data to zero, not just tracers - State_Chm(LCHNK)%Species = 0.0e+0_fp - - lq(:) = .FALSE. - - MMR_Beg = 0.0e+0_r8 - DO N = 1, pcnst - M = map2GC(N) - IF (M > 0) THEN - I = 1 - DO J = 1, nY - DO K = 1, nZ - ! CURRENTLY KG/KG DRY - MMR_Beg(J,K,M) = State%q(J,nZ+1-K,N) - State_Chm(LCHNK)%Species(1,J,K,M) = REAL(MMR_Beg(J,K,M),fp) - ENDDO - ENDDO - lq(N) = .TRUE. - ENDIF - ENDDO - - ! Retrieve previous value of species data - SlsData(:,:,:) = 0.0e+0_r8 - CALL Get_Short_Lived_Species( SlsData, LCHNK, nY, Pbuf ) - - ! Remap and flip them - DO N = 1, nSls - M = map2GC_Sls(N) - IF (M > 0) THEN - DO J = 1, nY - DO K = 1, nZ - State_Chm(LCHNK)%Species(1,J,K,M) = REAL(SlsData(J,nZ+1-K,N),fp) - ENDDO - ENDDO - ENDIF - ENDDO - - ! Initialize tendency array - CALL Physics_ptend_init(ptend, State%psetcols, 'chemistry', lq=lq) - - ! Calculate COS(SZA) - Calday = Get_Curr_Calday( ) - CALL Zenith( Calday, Rlats, Rlons, CSZA, nY ) - - ! Get all required data from physics buffer - TIM_NDX = Pbuf_Old_Tim_Idx() - CALL Pbuf_Get_Field( Pbuf, NDX_PBLH, PblH ) - CALL Pbuf_Get_Field( Pbuf, NDX_FSDS, Fsds ) - CALL Pbuf_Get_Field( Pbuf, NDX_CLDTOP, cldTop ) - CALL Pbuf_Get_Field( Pbuf, NDX_CLDFRC, cldFrc, START=(/1,1,TIM_NDX/), KOUNT=(/NCOL,PVER,1/) ) - CALL Pbuf_Get_Field( Pbuf, NDX_NEVAPR, NEvapr, START=(/1,1/), KOUNT=(/NCOL,PVER/)) - CALL Pbuf_Get_Field( Pbuf, NDX_PRAIN, PRain, START=(/1,1/), KOUNT=(/NCOL,PVER/)) - CALL Pbuf_Get_Field( Pbuf, NDX_RPRDTOT, RprdTot, START=(/1,1/), KOUNT=(/NCOL,PVER/)) - CALL Pbuf_Get_Field( Pbuf, NDX_LSFLXPRC, LsFlxPrc, START=(/1,1/), KOUNT=(/NCOL,PVERP/)) - CALL Pbuf_Get_Field( Pbuf, NDX_LSFLXSNW, LsFlxSnw, START=(/1,1/), KOUNT=(/NCOL,PVERP/)) - - ! Get VMR and MMR of H2O - H2OVMR = 0.0e0_fp - qH2O = 0.0e0_fp - ! Note MWDRY = 28.966 g/mol - DO J = 1, nY - DO L = 1, nZ - qH2O(J,L) = REAL(State_Chm(LCHNK)%Species(1,J,L,iH2O),r8) - H2OVMR(J,L) = qH2O(J,L) * MWDry / 18.016e+0_fp - ENDDO - ENDDO - - ! Calculate RH (range 0-1, note still level 1 = TOA) - relHum(:,:) = 0.0e+0_r8 - CALL QSat(State%T(:nY,:), State%Pmid(:nY,:), SatV, SatQ) - DO J = 1, nY - DO L = 1, nZ - relHum(J,L) = 0.622e+0_r8 * H2OVMR(J,L) / SatQ(J,L) - relHum(J,L) = MAX( 0.0e+0_r8, MIN( 1.0e+0_r8, relHum(J,L) ) ) - ENDDO - ENDDO - - Z0 = 0.0e+0_r8 - DO J = 1, nY - Z0(J) = cam_in%landFrac(J) * zlnd & - + cam_in%iceFrac(J) * zsice & - + cam_in%ocnFrac(J) * zocn - IF (( cam_in%snowhLand(J) > 0.01_r8 ) .OR. & - ( cam_in%snowhIce(J) > 0.01_r8 )) THEN - ! Land is covered in snow - Z0(J) = zslnd - ENDIF - ENDDO - - ! Estimate cloud liquid water content and OD - TauCli = 0.0e+0_r8 - TauClw = 0.0e+0_r8 - - ! Note: all using CAM vertical convention (1 = TOA) - ! Calculation is based on that done for MOZART - DO J = 1, nY - DO L = nZ, 1, -1 - ! Convert water mixing ratio [kg/kg] to water content [g/m^3] - IF ( ( State%Q(J,L,ixCldLiq) + State%Q(J,L,ixCldIce) ) * & - State%PMid(J,L) / (State%T(J,L) * 287.0e+00_r8) * 1.0e+03_r8 <= 0.01_r8 .AND. & - cldFrc(J,L) /= 0.0e+00_r8 ) THEN - cld(J,L) = 0.0e+00_r8 - ELSE - cld(J,L) = cldFrc(J,L) - ENDIF - ENDDO - ENDDO - - DO J = 1, nY - IF ( COUNT( cld(J,:nZ) > cldMin ) > 0 ) THEN - DO L = nZ, 1, -1 - ! ================================================================= - ! =========== Compute cloud optical depth based on ============ - ! =========== Liao et al. JGR, 104, 23697, 1999 ============ - ! ================================================================= - ! - ! Tau = 3/2 * LWC * dZ / ( \rho_w * r_e ) - ! dZ = - dP / ( \rho_air * g ) - ! since Pint is ascending, we can neglect the minus sign - ! - ! Tau = 3/2 * LWC * dP / ( \rho_air * r_e * \rho_w * g ) - ! LWC / \rho_air = Q - ! - ! Tau = 3/2 * Q * dP / ( r_e * rho_w * g ) - ! Tau(K) = 3/2 * Q(K) * (Pint(K+1) - Pint(K)) / (re * rho_w * g ) - ! Tau(K) = Q(K) * (Pint(K+1) - Pint(K)) * Cnst - ! - ! Unit check: | - ! Q : [kg H2O/kg air] | - ! Pint : [Pa]=[kg air/m/s^2] | - ! re : [m] | = 1.0e-5 - ! rho_w: [kg H2O/m^3] | = 1.0e+3 - ! g : [m/s^2] | = 9.81 - ! - TauClw(J,L) = State%Q(J,L,ixCldLiq) & - * (State%Pint(J,L+1)-State%Pint(J,L)) & - * cnst - TauClw(J,L) = MAX(TauClw(J,L), 0.0e+00_r8) - TauCli(J,L) = State%Q(J,L,ixCldIce) & - * (State%Pint(J,L+1)-State%Pint(J,L)) & - * cnst - TauCli(J,L) = MAX(TauCli(J,L), 0.0e+00_r8) - - ENDDO - ENDIF - ENDDO - - ! Retrieve tropopause level - Trop_Lev = 0.0e+0_r8 - CALL Tropopause_FindChemTrop(State, Trop_Lev) - ! Back out the pressure - Trop_P = 1000.0e+0_r8 - DO J = 1, nY - Trop_P(J) = State%PMid(J,Trop_Lev(J)) * 0.01e+0_r8 - ENDDO - - ! Calculate snow depth - snowDepth = 0.0e+0_r8 - DO J = 1, nY - Sd_Ice = MAX(0.0e+0_r8,cam_in%snowhIce(J)) - Sd_Lnd = MAX(0.0e+0_r8,cam_in%snowhLand(J)) - Frc_Ice = MAX(0.0e+0_r8,cam_in%iceFrac(J)) - IF (Frc_Ice > 0.0e+0_r8) THEN - Sd_Avg = (Sd_Lnd*(1.0e+0_r8 - Frc_Ice)) + (Sd_Ice * Frc_Ice) - ELSE - Sd_Avg = Sd_Lnd - ENDIF - snowDepth(J) = Sd_Avg - ENDDO - - ! Field : ALBD - ! Description: Visible surface albedo - ! Unit : - - ! Dimensions : nX, nY - State_Met(LCHNK)%ALBD (1,:) = cam_in%Asdir(:) - - ! Field : CLDFRC - ! Description: Column cloud fraction - ! Unit : - - ! Dimensions : nX, nY - ! Note : Estimate column cloud fraction as the maximum cloud - ! fraction in the column (pessimistic assumption) - DO J = 1, nY - State_Met(LCHNK)%CLDFRC(1,J) = MAXVAL(cldFrc(J,:)) - ENDDO - - ! Field : EFLUX, HFLUX - ! Description: Latent heat flux, sensible heat flux - ! Unit : W/m^2 - ! Dimensions : nX, nY - State_Met(LCHNK)%EFLUX (1,:) = cam_in%Lhf(:) - State_Met(LCHNK)%HFLUX (1,:) = cam_in%Shf(:) - - ! Field : LandTypeFrac - ! Description: Olson fraction per type - ! Unit : - (between 0 and 1) - ! Dimensions : nX, nY, NSURFTYPE - ! Note : Index 1 is water -#if ( LANDTYPE_CLM ) - ! Fill in water - State_Met(LCHNK)%LandTypeFrac(1,:, 1) = cam_in%ocnFrac(:) & - + cam_in%iceFrac(:) -#if ( ALLDDVEL_GEOSCHEM ) - CALL getLandTypes( cam_in, & - nY, & - State_Met(LCHNK) ) -#endif -#endif - - ! Field : FRCLND, FRLAND, FROCEAN, FRSEAICE, FRLAKE, FRLANDIC - ! Description: Olson land fraction - ! Fraction of land - ! Fraction of ocean - ! Fraction of sea ice - ! Fraction of lake - ! Fraction of land ice - ! Fraction of snow - ! Unit : - - ! Dimensions : nX, nY - State_Met(LCHNK)%FRCLND (1,:) = 1.e+0_fp - & - State_Met(LCHNK)%LandTypeFrac(1,:,1) ! Olson Land Fraction - State_Met(LCHNK)%FRLAND (1,:) = cam_in%landFrac(:) - State_Met(LCHNK)%FROCEAN (1,:) = cam_in%ocnFrac(:) + cam_in%iceFrac(:) - State_Met(LCHNK)%FRSEAICE (1,:) = cam_in%iceFrac(:) -#if ( LANDTYPE_CLM ) - State_Met(LCHNK)%FRLAKE (1,:) = cam_in%lwtgcell(:,3) + & - cam_in%lwtgcell(:,4) - State_Met(LCHNK)%FRLANDIC (1,:) = cam_in%lwtgcell(:,2) - State_Met(LCHNK)%FRSNO (1,:) = 0.0e+0_fp -#else - State_Met(LCHNK)%FRLAKE (1,:) = 0.0e+0_fp - State_Met(LCHNK)%FRLANDIC (1,:) = 0.0e+0_fp - State_Met(LCHNK)%FRSNO (1,:) = 0.0e+0_fp -#endif - - ! Field : GWETROOT, GWETTOP - ! Description: Root and top soil moisture - ! Unit : - - ! Dimensions : nX, nY - State_Met(LCHNK)%GWETROOT (1,:) = 0.0e+0_fp - State_Met(LCHNK)%GWETTOP (1,:) = 0.0e+0_fp - - ! Field : LAI - ! Description: Leaf area index - ! Unit : m^2/m^2 - ! Dimensions : nX, nY - State_Met(LCHNK)%LAI (1,:) = 0.0e+0_fp - - ! Field : PARDR, PARDF - ! Description: Direct and diffuse photosynthetically active radiation - ! Unit : W/m^2 - ! Dimensions : nX, nY - State_Met(LCHNK)%PARDR (1,:) = 0.0e+0_fp - State_Met(LCHNK)%PARDF (1,:) = 0.0e+0_fp - - ! Field : PBLH - ! Description: PBL height - ! Unit : m - ! Dimensions : nX, nY - State_Met(LCHNK)%PBLH (1,:) = PblH(:nY) - - ! Field : PHIS - ! Description: Surface geopotential height - ! Unit : m - ! Dimensions : nX, nY - State_Met(LCHNK)%PHIS (1,:) = State%Phis(:) - - ! Field : PRECANV, PRECCON, PRECLSC, PRECTOT - ! Description: Anvil precipitation @ ground - ! Convective precipitation @ ground - ! Large-scale precipitation @ ground - ! Total precipitation @ ground - ! Unit : kg/m^2/s - ! Dimensions : nX, nY - State_Met(LCHNK)%PRECANV (1,:) = 0.0e+0_fp - State_Met(LCHNK)%PRECCON (1,:) = cam_out%Precc(:) - State_Met(LCHNK)%PRECLSC (1,:) = cam_out%Precl(:) - State_Met(LCHNK)%PRECTOT (1,:) = cam_out%Precc(:) + cam_out%Precl(:) - - ! Field : TROPP - ! Description: Tropopause pressure - ! Unit : hPa - ! Dimensions : nX, nY - State_Met(LCHNK)%TROPP (1,:) = Trop_P(:) - - ! Field : PS1_WET, PS2_WET - ! Description: Wet surface pressure at start and end of timestep - ! Unit : hPa - ! Dimensions : nX, nY - State_Met(LCHNK)%PS1_WET (1,:) = State%ps(:)*0.01e+0_fp - State_Met(LCHNK)%PS2_WET (1,:) = State%ps(:)*0.01e+0_fp - - ! Field : SLP - ! Description: Sea level pressure - ! Unit : hPa - ! Dimensions : nX, nY - State_Met(LCHNK)%SLP (1,:) = State%ps(:)*0.01e+0_fp - - ! Field : TS, TSKIN - ! Description: Surface temperature, surface skin temperature - ! Unit : K - ! Dimensions : nX, nY - State_Met(LCHNK)%TS (1,:) = cam_in%TS(:) - State_Met(LCHNK)%TSKIN (1,:) = cam_in%TS(:) - - ! Field : SWGDN - ! Description: Incident radiation @ ground - ! Unit : W/m^2 - ! Dimensions : nX, nY - State_Met(LCHNK)%SWGDN (1,:) = fsds(:) - - ! Field : TO3 - ! Description: Total overhead ozone column - ! Unit : DU - ! Dimensions : nX, nY - State_Met(LCHNK)%TO3 (1,:) = 300.0e+0_fp ! TMMF - - ! Field : SNODP, SNOMAS - ! Description: Snow depth, snow mass - ! Unit : m, kg/m^2 - ! Dimensions : nX, nY - ! Note : Conversion from m to kg/m^2 - ! \rho_{ice} = 916.7 kg/m^3 - State_Met(LCHNK)%SNODP (1,:) = snowDepth(:) - State_Met(LCHNK)%SNOMAS (1,:) = snowDepth(:) * 916.7e+0_r8 - - ! Field : SUNCOS, SUNCOSmid - ! Description: COS(solar zenith angle) at current time and midpoint - ! of chemistry timestep - ! Unit : - - ! Dimensions : nX, nY - ! Note : Compute tendency in -/s (tmmf, 1/13/20) ? - State_Met(LCHNK)%SUNCOS (1,:) = CSZA(:) - State_Met(LCHNK)%SUNCOSmid (1,:) = CSZA(:) - - ! Field : U10M, V10M - ! Description: E/W and N/S wind speed @ 10m height - ! Unit : m/s - ! Dimensions : nX, nY - State_Met(LCHNK)%U10M (1,:) = State%U(:,nZ) - State_Met(LCHNK)%V10M (1,:) = State%V(:,nZ) - - ! Field : USTAR - ! Description: Friction velocity - ! Unit : m/s - ! Dimensions : nX, nY - ! Note : We here combine the land friction velocity (fv) with - ! the ocean friction velocity (ustar) - DO J = 1, nY - State_Met(LCHNK)%USTAR (1,J) = & - cam_in%fv(J) * ( cam_in%landFrac(J)) & - + cam_in%uStar(J) * ( 1.0e+0_fp - cam_in%landFrac(J)) - ENDDO - - ! Field : Z0 - ! Description: Surface roughness length - ! Unit : m - ! Dimensions : nX, nY - State_Met(LCHNK)%Z0 (1,:) = Z0(:) - - DO J = 1, nY - iMaxLoc = MAXLOC( (/ State_Met(LCHNK)%FRLAND(1,J) + & - State_Met(LCHNK)%FRLANDIC(1,J) + & - State_Met(LCHNK)%FRLAKE(1,J), & - State_Met(LCHNK)%FRSEAICE(1,J), & - State_Met(LCHNK)%FROCEAN(1,J) - & - State_Met(LCHNK)%FRSEAICE(1,J) /) ) - IF ( iMaxLoc(1) == 3 ) iMaxLoc(1) = 0 - ! reset ocean to 0 - - ! Field : LWI - ! Description: Land/water indices - ! Unit : - - ! Dimensions : nX, nY - State_Met(LCHNK)%LWI(1,J) = FLOAT( iMaxLoc(1) ) - ENDDO - - ! Three-dimensional fields on level edges - DO J = 1, nY - DO L = 1, nZ+1 - ! Field : PEDGE - ! Description: Wet air pressure at (vertical) level edges - ! Unit : hPa - ! Dimensions : nX, nY, nZ+1 - State_Met(LCHNK)%PEDGE (1,J,L) = State%Pint(J,nZ+2-L)*0.01e+0_fp - - ! Field : CMFMC - ! Description: Upward moist convective mass flux - ! Unit : kg/m^2/s - ! Dimensions : nX, nY, nZ+1 - State_Met(LCHNK)%CMFMC (1,J,L) = 0.0e+0_fp - - ! Field : PFICU, PFLCU - ! Description: Downward flux of ice/liquid precipitation (convective) - ! Unit : kg/m^2/s - ! Dimensions : nX, nY, nZ+1 - State_Met(LCHNK)%PFICU (1,J,L) = 0.0e+0_fp - State_Met(LCHNK)%PFLCU (1,J,L) = 0.0e+0_fp - - ! Field : PFILSAN, PFLLSAN - ! Description: Downward flux of ice/liquid precipitation (Large-scale & anvil) - ! Unit : kg/m^2/s - ! Dimensions : nX, nY, nZ+1 - State_Met(LCHNK)%PFILSAN (1,J,L) = LsFlxSnw(j,nZ+2-L) ! kg/m2/s - State_Met(LCHNK)%PFLLSAN (1,J,L) = MAX(0.0e+0_fp,LsFlxPrc(J,nZ+2-L) - LsFlxSnw(J,nZ+2-L)) ! kg/m2/s - ENDDO - ENDDO - - DO J = 1, nY - ! Field : U, V - ! Description: Max cloud top height - ! Unit : level - ! Dimensions : nX, nY - State_Met(LCHNK)%cldTops(1,J) = nZ + 1 - NINT(cldTop(J)) - ENDDO - - ! Three-dimensional fields on level centers - DO J = 1, nY - DO L = 1, nZ - - ! Field : U, V - ! Description: E/W and N/S component of wind - ! Unit : m/s - ! Dimensions : nX, nY, nZ - State_Met(LCHNK)%U (1,J,L) = State%U(J,nZ+1-L) - State_Met(LCHNK)%V (1,J,L) = State%V(J,nZ+1-L) - - ! Field : OMEGA - ! Description: Updraft velocity - ! Unit : Pa/s - ! Dimensions : nX, nY, nZ - !State_Met(LCHNK)%OMEGA (1,J,L) = State%Omega(J,nZ+1-L) - - ! Field : CLDF - ! Description: 3-D cloud fraction - ! Unit : - - ! Dimensions : nX, nY, nZ - State_Met(LCHNK)%CLDF (1,J,L) = cldFrc(j,nZ+1-l) - - ! Field : DTRAIN - ! Description: Detrainment flux - ! Unit : kg/m^2/s - ! Dimensions : nX, nY, nZ - State_Met(LCHNK)%DTRAIN (1,J,L) = 0.0e+0_fp ! Used in convection - - ! Field : DQRCU - ! Description: Convective precipitation production rate - ! Unit : kg/kg dry air/s - ! Dimensions : nX, nY, nZ - State_Met(LCHNK)%DQRCU (1,J,L) = 0.0e+0_fp ! Used in convection - - ! Field : DQRLSAN - ! Description: Large-scale precipitation production rate - ! Unit : kg/kg dry air/s - ! Dimensions : nX, nY, nZ - State_Met(LCHNK)%DQRLSAN (1,J,L) = PRain(J,nZ+1-L) ! kg/kg/s - - ! Field : QI, QL - ! Description: Cloud ice/water mixing ratio - ! Unit : kg/kg dry air - ! Dimensions : nX, nY, nZ - State_Met(LCHNK)%QI (1,J,L) = State%Q(J,nZ+1-L,ixCldIce) ! kg ice / kg dry air - State_Met(LCHNK)%QL (1,J,L) = State%Q(J,nZ+1-L,ixCldLiq) ! kg water / kg dry air - - ! Field : RH - ! Description: Relative humidity - ! Unit : % - ! Dimensions : nX, nY, nZ - State_Met(LCHNK)%RH (1,J,L) = RelHum(J,nZ+1-L) * 100.0e+0_fp - - ! Field : TAUCLI, TAUCLW - ! Description: Optical depth of ice/H2O clouds - ! Unit : - - ! Dimensions : nX, nY, nZ - State_Met(LCHNK)%TAUCLI (1,J,L) = TauCli(J,nZ+1-L) - State_Met(LCHNK)%TAUCLW (1,J,L) = TauClw(J,nZ+1-L) - - ! Field : REEVAPCN - ! Description: Evaporation of convective precipitation - ! (w/r/t dry air) - ! Unit : kg - ! Dimensions : nX, nY, nZ - State_Met(LCHNK)%REEVAPCN (1,J,L) = 0.0e+0_fp - - ! Field : REEVAPLS - ! Description: Evaporation of large-scale + anvil precipitation - ! (w/r/t dry air) - ! Unit : kg - ! Dimensions : nX, nY, nZ - State_Met(LCHNK)%REEVAPLS (1,J,L) = NEvapr(J,nZ+1-L) ! kg/kg/s - - ! Field : SPHU1, SPHU2 - ! Description: Specific humidity at current and next timestep - ! Unit : g H2O/ kg air - ! Dimensions : nX, nY, nZ - ! Note : Since we are using online meteorology, we do not have - ! access to the data at the next time step - ! Compute tendency in g H2O/kg air/s (tmmf, 1/13/20) ? - State_Met(LCHNK)%SPHU1 (1,J,L) = qH2O(J,nZ+1-L) * 1.0e+3_fp ! g/kg - State_Met(LCHNK)%SPHU2 (1,J,L) = qH2O(J,nZ+1-L) * 1.0e+3_fp ! g/kg - - ! Field : TMPU1, TMPU2 - ! Description: Temperature at current and next timestep - ! Unit : K - ! Dimensions : nX, nY, nZ - ! Note : Since we are using online meteorology, we do not have - ! access to the data at the next time step - ! Compute tendency in K/s (tmmf, 1/13/20) ? - State_Met(LCHNK)%TMPU1 (1,J,L) = State%T(J,nZ+1-L) - State_Met(LCHNK)%TMPU2 (1,J,L) = State%T(J,nZ+1-L) - ENDDO - ENDDO - - ! Field : T - ! Description: Temperature at current time - ! Unit : K - ! Dimensions : nX, nY, nZ - ! Note : Since we are using online meteorology, we do not have - ! access to the data at the next time step - ! Compute tendency in K/s (tmmf, 1/13/20) ? - State_Met(LCHNK)%T = (State_Met(LCHNK)%TMPU1 + State_Met(LCHNK)%TMPU2)*0.5e+0_fp - - ! Field : SPHU - ! Description: Specific humidity at current time - ! Unit : g H2O/ kg air - ! Dimensions : nX, nY, nZ - ! Note : Since we are using online meteorology, we do not have - ! access to the data at the next time step - ! Compute tendency in g H2O/kg air/s (tmmf, 1/13/20) ? - State_Met(LCHNK)%SPHU = (State_Met(LCHNK)%SPHU1 + State_Met(LCHNK)%SPHU2)*0.5e+0_fp - - ! Field : OPTD - ! Description: Total in-cloud optical depth (visible band) - ! Unit : - - ! Dimensions : nX, nY, nZ - State_Met(LCHNK)%OPTD = State_Met(LCHNK)%TAUCLI + State_Met(LCHNK)%TAUCLW - - ! Nullify all pointers - Nullify(PblH ) - Nullify(Fsds ) - Nullify(PRain ) - Nullify(LsFlxSnw) - Nullify(LsFlxPrc) - Nullify(cldTop ) - Nullify(cldFrc ) - Nullify(NEvapr ) - Nullify(RprdTot ) - - ! Field : InChemGrid - ! Description: Are we in the chemistry grid? - ! Unit : - - ! Dimensions : nX, nY, nZ - State_Met(LCHNK)%InChemGrid(:,:,:) = .True. - - ! Determine current date and time - CALL Get_Curr_Date( yr = currYr, & - mon = currMo, & - day = currDy, & - tod = currTOD ) - - ! For now, force year to be 2000 - currYr = 2000 - currYMD = (currYr*1000) + (currMo*100) + (currDy) - ! Deal with subdaily - currUTC = REAL(currTOD,f4)/3600.0e+0_f4 - currSc = 0 - currMn = 0 - currHr = 0 - DO WHILE (currTOD > 3600) - currTOD = currTOD - 3600 - currHr = currHr + 1 - ENDDO - DO WHILE (currTOD > 60) - currTOD = currTOD - 60 - currMn = currMn + 1 - ENDDO - currSc = currTOD - currHMS = (currHr*1000) + (currMn*100) + (currSc) - - IF ( firstDay ) THEN - newDay = .True. - newMonth = .True. - firstDay = .False. - ELSE IF ( currHMS < dT ) THEN - newDay = .True. - IF ( currDy == 1 ) THEN - newMonth = .True. - ELSE - newMonth = .False. - ENDIF - ELSE - newDay = .False. - newMonth = .False. - ENDIF - - ! Pass time values obtained from the ESMF environment to GEOS-Chem - CALL Accept_External_Date_Time( value_NYMD = currYMD, & - value_NHMS = currHMS, & - value_YEAR = currYr, & - value_MONTH = currMo, & - value_DAY = currDy, & - value_DAYOFYR = INT(FLOOR(Calday)), & - value_HOUR = currHr, & - value_MINUTE = currMn, & - value_HELAPSED = 0.0e+0_f4, & - value_UTC = currUTC, & - RC = RC ) - - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Failed to update time in GEOS-Chem!' - CALL Error_Stop( ErrMsg, ThisLoc ) - ENDIF - - CALL Accept_External_PEdge( State_Met = State_Met(LCHNK), & - RC = RC ) - - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Failed to update pressure edges!' - CALL Error_Stop( ErrMsg, ThisLoc ) - ENDIF - - ! Field : PS1_DRY, PS2_DRY - ! Description: Dry surface pressure at current and next timestep - ! Unit : hPa - ! Dimensions : nX, nY, nZ+1 - ! Note : 1. Use the CAM PSDry fields instead of using the - ! GEOS-Chem calculation - ! 2. As we are using online meteorology, we do not - ! have access to the fields at the next time step - ! Compute Pa/s tendency? (tmmf, 1/13/20) - State_Met(LCHNK)%PS1_DRY (1,:) = State%PSDry(:) * 0.01e+0_fp - State_Met(LCHNK)%PS2_DRY (1,:) = State%PSDry(:) * 0.01e+0_fp - - ! Field : PSC2_WET, PSC2_DRY - ! Description: Interpolated wet and dry surface pressure at the - ! current time - ! Unit : hPa - ! Dimensions : nX, nY, nZ+1 - ! Note : As we are using online meteorology, we do not - ! have access to the fields at the next time step - ! Compute Pa/s tendency? (tmmf, 1/13/20) - State_Met(LCHNK)%PSC2_WET = State_Met(LCHNK)%PS1_WET - State_Met(LCHNK)%PSC2_DRY = State_Met(LCHNK)%PS1_DRY - - CALL Set_Floating_Pressures( State_Grid = State_Grid(LCHNK), & - State_Met = State_Met(LCHNK), & - RC = RC ) - - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Failed to set floating pressures!' - CALL Error_Stop( ErrMsg, ThisLoc ) - ENDIF - - ! Set quantities of interest but do not change VMRs - ! This function updates: - ! ==================================================================== - ! (1) PEDGE : Moist air pressure at grid box bottom [hPa] - ! (2) PEDGE_DRY : Dry air partial pressure at box bottom [hPa] - ! (3) PMID : Moist air pressure at grid box centroid [hPa] - ! (4) PMID_DRY : Dry air partial pressure at box centroid [hPa] - ! (5) PMEAN : Altitude-weighted mean moist air pressure [hPa] - ! (6) PMEAN_DRY : Alt-weighted mean dry air partial pressure [hPa] - ! (7) DELP : Delta-P extent of grid box [hPa] - ! (Same for both moist and dry air since we - ! assume constant water vapor pressure - ! across box) - ! (8) AIRDEN : Mean grid box dry air density [kg/m^3] - ! (defined as total dry air mass/box vol) - ! (9) MAIRDEN : Mean grid box moist air density [kg/m^3] - ! (defined as total moist air mass/box vol) - ! (10) AD : Total dry air mass in grid box [kg] - ! (11) ADMOIST : Total moist air mass in grid box [kg] - ! (12) BXHEIGHT : Vertical height of grid box [m] - ! (13) AIRVOL : Volume of grid box [m^3] - ! (14) MOISTMW : Molecular weight of moist air in box [g/mol] - ! ==================================================================== - CALL AirQnt( Input_Opt = Input_Opt, & - State_Chm = State_Chm(LCHNK), & - State_Grid = State_Grid(LCHNK), & - State_Met = State_Met(LCHNK), & - RC = RC, & - Update_Mixing_Ratio = .False. ) - - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Failed to calculate air properties!' - CALL Error_Stop( ErrMsg, ThisLoc ) - ENDIF - - ! Initialize strat chem if not already done. This has to be done here because - ! it needs to have non-zero values in State_Chm%AD, which only happens after - ! the first call to AirQnt - !IF ( (.not.SCHEM_READY) .and. Input_Opt%LSCHEM ) THEN - IF ( (.not.SCHEM_READY) .and. .True. ) THEN !TMMF - CALL Init_Strat_Chem( Input_Opt = Input_Opt, & - State_Chm = State_Chm(LCHNK), & - State_Met = State_Met(LCHNK), & - State_Grid = State_Grid(LCHNK), & - RC = RC ) - - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Error encountered in "Init_Strat_Chem"!' - CALL Error_Stop( ErrMsg, ThisLoc ) - ENDIF - SCHEM_READY = .True. - ENDIF - - !============================================================== - ! ***** R U N H E M C O P H A S E 1 ***** - ! - ! Phase 1 updates the HEMCO clock and the content of the - ! HEMCO data list. This should be done before writing the - ! diagnostics organized in the HEMCO diagnostics structure, - ! and before using any of the HEMCO data list fields. - ! (ckeller, 4/1/15) - !============================================================== - ! Run HEMCO Phase 1 - !CALL Emissions_Run ( Input_Opt = Input_Opt, & - ! State_Chm = State_Chm(LCHNK), & - ! State_Diag = State_Diag(LCHNK), & - ! State_Grid = State_Grid(LCHNK), & - ! State_Met = State_Met(LCHNK), & - ! EmisTime = EmisTime, & - ! Phase = 1, & - ! RC = RC ) - ! - !! Trap potential errors - !IF ( RC /= GC_SUCCESS ) THEN - ! ErrMsg = 'Error encountered in "Emissions_Run"!' - ! CALL Error_Stop( ErrMsg, ThisLoc ) - !ENDIF - - !---------------------------------------------------------- - ! %%% GET SOME NON-EMISSIONS DATA FIELDS VIA HEMCO %%% - ! - ! HEMCO can track non-emission data fields for chemistry - ! simulations. Put these subroutine calls after the - ! call to EMISSIONS_RUN, so that the HEMCO data structure - ! will be initialized. (bmy, 3/20/15) - ! - ! HEMCO data list is now updated further above, so can - ! take these calls out of the emissions sequence. - ! (ckeller, 4/01/15) - !---------------------------------------------------------- - !IF ( LCHEM .and. newMonth ) THEN - ! - ! ! The following only apply when photolysis is used, - ! ! that is for fullchem or aerosol simulations. - ! IF ( ITS_A_FULLCHEM_SIM .or. ITS_AN_AEROSOL_SIM ) THEN - ! - ! ! Copy UV Albedo data (for photolysis) into the - ! ! State_Met%UVALBEDO field. (bmy, 3/20/15) - ! CALL Get_UvAlbedo( Input_Opt = Input_Opt, & - ! State_Met = State_Met(LCHNK), & - ! RC = RC ) - ! - ! ! Trap potential errors - ! IF ( RC /= GC_SUCCESS ) THEN - ! ErrMsg = 'Error encountered in "Get_UvAlbedo"!' - ! CALL Error_Stop( ErrMsg, ThisLoc ) - ! ENDIF - ! - ! IF ( Input_Opt%USE_TOMS_O3 ) THEN - ! ! Get TOMS overhead O3 columns for photolysis from - ! ! the HEMCO data structure (bmy, 3/20/15) - ! CALL Read_TOMS( Input_Opt = Input_Opt, & - ! RC = RC ) - ! - ! ! Trap potential errors - ! IF ( RC /= GC_SUCCESS ) THEN - ! ErrMsg = 'Error encountered in "Read_TOMS"!' - ! CALL Error_Stop( ErrMsg, ThisLoc ) - ! ENDIF - ! ENDIF - ! - ! ENDIF - ! - ! ! Read data required for Hg2 gas-particle partitioning - ! ! (H Amos, 25 Oct 2011) - ! IF ( ITS_A_MERCURY_SIM ) THEN - ! CALL Read_Hg2_Partitioning( Input_Opt = Input_Opt, & - ! State_Grid = State_Grid(LCHNK), & - ! State_Met = State_Met(LCHNK), & - ! MONTH = 1, & !TMMF - ! RC = RC ) - ! - ! ! Trap potential errors - ! IF ( RC /= GC_SUCCESS ) THEN - ! ErrMsg = - ! 'Error encountered in "Read_Hg2_Partitioning"!' - ! CALL Error_Stop( ErrMsg, ThisLoc ) - ! ENDIF - ! - ! ENDIF - !ENDIF - - !! Prescribe methane surface concentrations throughout PBL - !IF ( ITS_A_FULLCHEM_SIM .and. id_CH4 > 0 ) THEN - ! - ! ! Set CH4 concentrations - ! CALL SET_CH4( Input_Opt = Input_Opt, & - ! State_Chm = State_Chm(LCHNK), & - ! State_Diag = State_Diag(LCHNK), & - ! State_Grid = State_Grid(LCHNK), & - ! State_Met = State_Met(LCHNK), & - ! RC = RC ) - ! - ! ! Trap potential errors - ! IF ( RC /= GC_SUCCESS ) THEN - ! ErrMsg = 'Error encountered in call to "SET_CH4"!' - ! CALL Error_Stop( ErrMsg, ThisLoc ) - ! ENDIF - !ENDIF - - ! Eventually initialize/reset wetdep - IF ( Input_Opt%LConv .OR. Input_Opt%LChem .OR. Input_Opt%LWetD ) THEN - CALL Setup_WetScav( Input_Opt = Input_Opt, & - State_Chm = State_Chm(LCHNK), & - State_Grid = State_Grid(LCHNK), & - State_Met = State_Met(LCHNK), & - RC = RC ) - - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Error encountered in "Setup_WetScav"!' - CALL Error_Stop( ErrMsg, ThisLoc ) - ENDIF - ENDIF - - !============================================================== - ! ***** C O M P U T E P B L H E I G H T etc. ***** - !============================================================== - ! Move this call from the PBL mixing routines because the PBL - ! height is used by drydep and some of the emissions routines. - ! (ckeller, 3/5/15) - ! This function updates: - ! ==================================================================== - ! (1) InPbl : Logical indicating if we are in the PBL [-] - ! (2) PBL_TOP_L : Number of layers in the PBL [-] - ! (3) PBL_TOP_hPa: Pressure at the top of the PBL [hPa] - ! (4) PBL_TOP_m : PBL height [m] - ! (5) PBL_THICK : PBL thickness [hPa] - ! (6) F_OF_PBL : Fraction of grid box within the PBL [-] - ! (7) F_UNDER_PBLTOP: Fraction of grid box underneath the PBL top [-] - ! (8) PBL_MAX_L : Model level where PBL top occurs [-] - ! ==================================================================== - CALL Compute_PBL_Height( State_Grid = State_Grid(LCHNK), & - State_Met = State_Met(LCHNK), & - RC = RC ) - - ! Trap potential errors - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Error encountered in "Compute_PBL_Height"!' - CALL Error_Stop( ErrMsg, ThisLoc ) - ENDIF - - !-------------------------------------------------------------- - ! Test for emission timestep - ! Now always do emissions here, even for full-mixing - ! (ckeller, 3/5/15) - !-------------------------------------------------------------- - !================================================================== - ! ***** D R Y D E P O S I T I O N ***** - !================================================================== - !================================================================== - ! Compute dry deposition velocities - ! - ! CLM computes dry deposition velocities over land. - ! We need to merge the land component passed through cam_in and - ! the ocn/ice dry deposition velocities. - ! - ! If using the CLM velocities, two options show up: - ! 1. Compute dry deposition velocities over ocean and ice similarly - ! to the way MOZART does it (OCNDDVEL_MOZART) - ! 2. Use GEOS-Chem's dry deposition module to compute velocities - ! and then scale them with the ocean fraction (OCNDDVEL_GEOSCHEM) - ! - ! A third option would be to let GEOS-Chem compute dry deposition - ! velocity (ALLDDVEL_GEOSCHEM), thus overwriting the input from CLM - ! - ! drydep_method must be set to DD_XLND. - ! - ! The following options are currently supported: - ! - ALLDDVEL_GEOSCHEM - ! - OCNDDVEL_GEOSCHEM - ! - OCNDDVEL_MOZART - ! - ! The ALLDDVEL_GEOSCHEM coupled with LANDTYPE_CLM requires that CLM - ! passes land type information (land type and leaf area index). - !================================================================== - ! - ! State_Chm expects dry deposition velocities in m/s, whereas - ! CLM returns land deposition velocities in cm/s! - ! - ! For now, dry deposition velocities are only computed for gases - ! (which is what CLM deals with). Dry deposition for aerosols is - ! work in progress. - ! - ! Thibaud M. Fritz - 27 Feb 2020 - !================================================================== - - IF ( Input_Opt%LDryD ) THEN -#if ( LANDTYPE_CLM ) - ! Compute the Olson landmap fields of State_Met - ! (e.g. State_Met%IREG, State_Met%ILAND, etc.) - CALL Compute_Olson_Landmap( Input_Opt = Input_Opt, & - State_Grid = State_Grid(LCHNK), & - State_Met = State_Met(LCHNK), & - RC = RC ) - - ! Trap potential errors - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Error encountered in "Compute_Olson_Landmap"!' - CALL Error_Stop( ErrMsg, ThisLoc ) - ENDIF - - ! Compute State_Met%XLAI (for drydep) and State_Met%MODISLAI, - ! which is the average LAI per grid box (for soil NOx emissions) - CALL Compute_Xlai( Input_Opt = Input_Opt, & - State_Grid = State_Grid(LCHNK), & - State_Met = State_Met(LCHNK), & - RC = RC ) - - ! Trap potential errors - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Error encountered in "Compute_Xlai"!' - CALL Error_Stop( ErrMsg, ThisLoc ) - ENDIF -#endif - -#if ( ALLDDVEL_GEOSCHEM || OCNDDVEL_GEOSCHEM ) - - ! Compute drydep velocities and update State_Chm%DryDepVel - CALL Do_Drydep( Input_Opt = Input_Opt, & - State_Chm = State_Chm(LCHNK), & - State_Diag = State_Diag(LCHNK), & - State_Grid = State_Grid(LCHNK), & - State_Met = State_Met(LCHNK), & - RC = RC ) - - ! Trap potential errors - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Error encountered in "Do_Drydep"!' - CALL Error_Stop( ErrMsg, ThisLoc ) - ENDIF - -#if ( OCNDDVEL_GEOSCHEM ) - - DO N = 1, nddvels - - !! Print debug - !IF ( rootChunk ) THEN - ! IF ( N == 1 ) THEN - ! Write(iulog,*) "Number of GC dry deposition species = ", & - ! SIZE(State_Chm(LCHNK)%DryDepVel(:,:,:),3) - ! Write(iulog,*) "Number of CESM dry deposition species = ", & - ! nddvels - ! ENDIF - ! Write(iulog,*) "N = ", N - ! Write(iulog,*) "drySpc_ndx = ", drySpc_ndx(N) - ! Write(iulog,*) "GC index = ", map2GC_dryDep(N) - ! IF ( map2GC_dryDep(N) > 0 ) THEN - ! Write(iulog,*) "GC name = ", TRIM(DEPNAME(map2GC_dryDep(N))) - ! ENDIF - ! Write(iulog,*) "dry Species= ", TRIM(drydep_list(N)) - ! IF ( drySpc_ndx(N) > 0 ) THEN - ! Write(iulog,*) "tracerName = ", TRIM(tracerNames(drySpc_ndx(N))) - ! ENDIF - ! Write(iulog,*) "CLM-depVel = ", & - ! MAXVAL(cam_in%depvel(:nY,N)) * 1.0e-02_fp, " [m/s]" - ! IF ( map2GC_dryDep(N) > 0 ) THEN - ! Write(iulog,*) "GC-depVel = ", & - ! MAXVAL(State_Chm(LCHNK)%DryDepVel(1,:nY,map2GC_dryDep(N))), " [m/s]" - ! ENDIF - !ENDIF - - IF ( map2GC_dryDep(N) > 0 ) THEN - ! State_Chm%DryDepVel is in m/s - State_Chm(LCHNK)%DryDepVel(1,:nY,map2GC_dryDep(N)) = & - ! This first bit corresponds to the dry deposition - ! velocities over land as computed from CLM and - ! converted to m/s. This is scaled by the fraction - ! of land. - cam_in%depVel(:nY,N) * 1.0e-02_fp & - * MAX(0._fp, 1.0_fp - State_Met(LCHNK)%FROCEAN(1,:nY)) & - ! This second bit corresponds to the dry deposition - ! velocities over ocean and sea ice as computed from - ! GEOS-Chem. This is scaled by the fraction of ocean - ! and sea ice. - + State_Chm(LCHNK)%DryDepVel(1,:nY,map2GC_dryDep(N)) & - * State_Met(LCHNK)%FROCEAN(1,:nY) - ENDIF - ENDDO - -#endif - -#elif ( OCNDDVEL_MOZART ) - ! This routine updates the deposition velocities from CLM in the - ! pointer lnd(LCHNK)%dvel as long as drydep_method == DD_XLND is - ! True. - CALL drydep_update( State, cam_in ) - - windSpeed(:nY) = SQRT( State%U(:nY,nZ)*State%U(:nY,nZ) + & - State%V(:nY,nZ)*State%V(:nY,nZ) ) - potT(:nY) = State%T(:nY,nZ) * (1._fp + qH2O(:nY,nZ)) - - CALL get_lat_all_p( LCHNK, nY, latndx ) - CALL get_lon_all_p( LCHNK, nY, lonndx ) - - CALL drydep_fromlnd( ocnfrac = cam_in%ocnfrac(:), & - icefrac = cam_in%icefrac(:), & - ncdate = currYMD, & - sfc_temp = cam_in%TS(:), & - pressure_sfc = State%PS(:), & - wind_speed = windSpeed(:), & - spec_hum = qH2O(:,nZ), & - air_temp = State%T(:,nZ), & - pressure_10m = State%PMid(:,nZ), & - rain = State_Met(LCHNK)%PRECTOT(1,:), & - snow = cam_in%Snowhland(:), & - solar_flux = State_Met(LCHNK)%SWGDN(1,:), & - dvelocity = MOZART_depVel(:,:), & - dflx = MOZART_depFlx(:,:), & - State_Chm = State_Chm(LCHNK), & - tv = potT(:), & - soilw = -99._fp, & - rh = relHum(:,nZ), & - ncol = nY, & - lonndx = lonndx(:), & - latndx = latndx(:), & - lchnk = LCHNK ) - - DO N = 1, nddvels - - !! Print debug - !IF ( rootChunk ) THEN - ! IF ( N == 1 ) THEN - ! Write(iulog,*) "Number of GC dry deposition species = ", & - ! SIZE(State_Chm(LCHNK)%DryDepVel(:,:,:),3) - ! Write(iulog,*) "Number of CESM dry deposition species = ", & - ! nddvels - ! ENDIF - ! Write(iulog,*) "N = ", N - ! Write(iulog,*) "drySpc_ndx = ", drySpc_ndx(N) - ! Write(iulog,*) "GC index = ", map2GC_dryDep(N) - ! IF ( map2GC_dryDep(N) > 0 ) THEN - ! Write(iulog,*) "GC name = ", TRIM(DEPNAME(map2GC_dryDep(N))) - ! ENDIF - ! Write(iulog,*) "dry Species= ", TRIM(drydep_list(N)) - ! IF ( drySpc_ndx(N) > 0 ) THEN - ! Write(iulog,*) "tracerName = ", TRIM(tracerNames(drySpc_ndx(N))) - ! ENDIF - ! Write(iulog,*) "CLM-depVel = ", & - ! MAXVAL(cam_in%depvel(:nY,N)) * 1.0e-02_fp, " [m/s]", LCHNK - ! IF ( drySpc_ndx(N) > 0 ) THEN - ! Write(iulog,*) "Merged depVel = ", & - ! MAXVAL(MOZART_depVel(:nY,drySpc_ndx(N))) * 1.0e-02_fp, " [m/s]", LCHNK - ! ENDIF - !ENDIF - - IF ( ( map2GC_dryDep(N) > 0 ) .AND. ( drySpc_ndx(N) > 0 ) ) THEN - ! State_Chm%DryDepVel is in m/s - State_Chm(LCHNK)%DryDepVel(1,:nY,map2GC_dryDep(N)) = & - MOZART_depVel(:nY,drySpc_ndx(N)) * 1.0e-02_fp - ENDIF - - ENDDO - -#else - ! We should be in one of the cases above as any exceptions should be - ! caught when running chem_readnl, but just for safety's safe: - CALL ENDRUN('Incorrect definitions for dry deposition velocities') -#endif - - CALL Update_DryDepSav( Input_Opt = Input_Opt, & - State_Chm = State_Chm(LCHNK), & - State_Diag = State_Diag(LCHNK), & - State_Grid = State_Grid(LCHNK), & - State_Met = State_Met(LCHNK), & - RC = RC ) - - ENDIF - - !!=========================================================== - !! ***** E M I S S I O N S ***** - !! - !! NOTE: For a complete description of how emissions from - !! HEMCO are added into GEOS-Chem (and how they are mixed - !! into the boundary layer), please see the wiki page: - !! - !! http://wiki-geos-chem.org/Distributing_emissions_in_the_PBL - !!=========================================================== - ! - !! EMISSIONS_RUN will call HEMCO run phase 2. HEMCO run phase - !! only calculates emissions. All data has been read to disk - !! in phase 1 at the beginning of the time step. - !! (ckeller, 4/1/15) - !CALL Emissions_Run( Input_Opt = Input_Opt, & - ! State_Chm = State_Chmk(LCHNK), & - ! State_Diag = State_Diag(LCHNK), & - ! State_Grid = State_Grid(LCHNK), & - ! State_Met = State_Met(LCHNK), & - ! TimeForEmis = TimeForEmis, & - ! Phase = 2, & - ! RC = RC ) - ! - !! Trap potential errors - !IF ( RC /= GC_SUCCESS ) THEN - ! ErrMsg = - ! 'Error encountered in "Emissions_Run"! after drydep!' - ! CALL Error_Stop( ErrMsg, ThisLoc ) - !ENDIF - - !=========================================================== - ! ***** M I X E D L A Y E R M I X I N G ***** - !=========================================================== - - ! Note: mixing routine expects tracers in v/v - ! DO_MIXING applies the tracer tendencies (dry deposition, - ! emission rates) to the tracer arrays and performs PBL - ! mixing. - ! In the non-local PBL scheme, dry deposition and emission - ! fluxes below the PBL are handled within the PBL mixing - ! routine. Otherwise, tracer concentrations are first updated - ! and the full-mixing is then applied. - ! (ckeller, 3/5/15) - ! NOTE: Tracer concentration units are converted locally - ! to [v/v dry air] for mixing. Eventually mixing should - ! be updated to use [kg/kg total air] (ewl, 9/18/15) - ! - ! This requires HEMCO. For now comment out. - ! Thibaud M. Fritz - 05/07/20 - !CALL Do_Mixing( Input_Opt = Input_Opt, & - ! State_Chm = State_Chm(LCHNK), & - ! State_Diag = State_Diag(LCHNK), & - ! State_Grid = State_Grid(LCHNK), & - ! State_Met = State_Met(LCHNK), & - ! RC = RC ) - ! - !! Trap potential errors - !IF ( RC /= GC_SUCCESS ) THEN - ! ErrMsg = 'Error encountered in "Do_Mixing"!' - ! CALL Error_Stop( ErrMsg, ThisLoc ) - !ENDIF - - !!=========================================================== - !! ***** C L O U D C O N V E C T I O N ***** - !!=========================================================== - !IF ( LCONV ) THEN - ! - ! ! Call the appropriate convection routine - ! ! NOTE: Tracer concentration units are converted locally - ! ! to [kg/kg total air] for convection (ewl, 9/18/15) - ! CALL Do_Convection( Input_Opt = Input_Opt, & - ! State_Chm = State_Chm(LCHNK), & - ! State_Diag = State_Diag(LCHNK), & - ! State_Grid = State_Grid(LCHNK), & - ! State_Met = State_Met(LCHNK), & - ! RC = RC ) - ! - ! ! Trap potential errors - ! IF ( RC /= GC_SUCCESS ) THEN - ! ErrMsg = 'Error encountered in "Do_Convection"!' - ! CALL Error_Stop( ErrMsg, ThisLoc ) - ! ENDIF - !ENDIF - - !============================================================== - ! ***** C H E M I S T R Y ***** - !============================================================== - ! Get the overhead column O3 for use with FAST-J - IF ( Input_Opt%Its_A_FullChem_Sim .OR. & - Input_Opt%Its_An_Aerosol_Sim ) THEN - - IF ( Input_Opt%LChem ) THEN - CALL Compute_Overhead_O3( State_Grid = State_Grid(LCHNK), & - DAY = currDy, & - USE_O3_FROM_MET = Input_Opt%Use_O3_From_Met, & - TO3 = State_Met(LCHNK)%TO3 ) - ENDIF - ENDIF - - CALL Do_Chemistry( Input_Opt = Input_Opt, & - State_Chm = State_Chm(LCHNK), & - State_Diag = State_Diag(LCHNK), & - State_Grid = State_Grid(LCHNK), & - State_Met = State_Met(LCHNK), & - RC = RC ) - - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Error encountered in "Do_Chemistry"!' - CALL Error_Stop( ErrMsg, ThisLoc ) - ENDIF - - !============================================================== - ! ***** W E T D E P O S I T I O N (rainout + washout) ***** - !============================================================== - IF ( Input_Opt%LWetD ) THEN - - ! Do wet deposition - ! NOTE: Tracer concentration units are converted locally - ! to [kg/m2] in wet deposition to enable calculations - ! along the column (ewl, 9/18/15) - CALL Do_WetDep( Input_Opt = Input_Opt, & - State_Chm = State_Chm(LCHNK), & - State_Diag = State_Diag(LCHNK), & - State_Grid = State_Grid(LCHNK), & - State_Met = State_Met(LCHNK), & - RC = RC ) - - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Error encountered in "Do_WetDep"!' - CALL Error_Stop( ErrMsg, ThisLoc ) - ENDIF - - ENDIF - - ! Make sure State_Chm(lchnk) is back in kg/kg dry! - ! Reset H2O MMR to the initial value (no chemistry tendency in H2O just yet) - State_Chm(LCHNK)%Species(1,:,:,iH2O) = MMR_Beg(:,:,iH2O) - - ! Store unadvected species data - SlsData = 0.0e+0_r8 - DO N = 1, nSls - M = map2GC_Sls(N) - IF ( M > 0 ) THEN - DO J = 1, nY - DO K = 1, nZ - SlsData(J,nZ+1-K,N) = REAL(State_Chm(LCHNK)%Species(1,J,K,M),r8) - ENDDO - ENDDO - ENDIF - ENDDO - CALL Set_Short_Lived_Species( SlsData, LCHNK, nY, Pbuf ) - - ! Write diagnostic output - DO N = 1, pcnst - M = map2GC(N) - I = map2Idx(N) - IF ( M > 0 ) THEN - SpcName = tracerNames(I) - VMR = 0.0e+0_r8 - DO J = 1, nY - DO K = 1, nZ - VMR(J,nZ+1-K) = REAL(State_Chm(LCHNK)%Species(1,J,K,M),r8) * MWRatio(I) - ENDDO - ENDDO - CALL OutFld( TRIM(SpcName), VMR(:nY,:), nY, LCHNK ) - ENDIF - ENDDO - -#if defined( CLM40 ) - SpcName = 'lu_soil' - CALL OutFld( TRIM(SpcName), cam_in%lwtgcell(:,1), nY, LCHNK ) - SpcName = 'lu_landice' - CALL OutFld( TRIM(SpcName), cam_in%lwtgcell(:,2), nY, LCHNK ) - SpcName = 'lu_deeplake' - CALL OutFld( TRIM(SpcName), cam_in%lwtgcell(:,3), nY, LCHNK ) - SpcName = 'lu_shallowlake' - CALL OutFld( TRIM(SpcName), cam_in%lwtgcell(:,4), nY, LCHNK ) - SpcName = 'lu_wetland' - CALL OutFld( TRIM(SpcName), cam_in%lwtgcell(:,5), nY, LCHNK ) - SpcName = 'lu_urban' - CALL OutFld( TRIM(SpcName), cam_in%lwtgcell(:,6), nY, LCHNK ) - SpcName = 'lu_icemec' - CALL OutFld( TRIM(SpcName), cam_in%lwtgcell(:,7), nY, LCHNK ) - SpcName = 'lu_crop' - CALL OutFld( TRIM(SpcName), cam_in%lwtgcell(:,8), nY, LCHNK ) -#elif defined( CLM45 ) || defined( CLM50 ) - SpcName = 'lu_soil' - CALL OutFld( TRIM(SpcName), cam_in%lwtgcell(:,1), nY, LCHNK ) - SpcName = 'lu_crop' - CALL OutFld( TRIM(SpcName), cam_in%lwtgcell(:,2), nY, LCHNK ) - SpcName = 'lu_landice' - CALL OutFld( TRIM(SpcName), cam_in%lwtgcell(:,4), nY, LCHNK ) - SpcName = 'lu_deeplake' - CALL OutFld( TRIM(SpcName), cam_in%lwtgcell(:,5), nY, LCHNK ) - SpcName = 'lu_wetland' - CALL OutFld( TRIM(SpcName), cam_in%lwtgcell(:,6), nY, LCHNK ) - SpcName = 'lu_urban' - CALL OutFld( TRIM(SpcName), cam_in%lwtgcell(:,7) & - + cam_in%lwtgcell(:,8) & - + cam_in%lwtgcell(:,9), nY, LCHNK ) -#endif - SpcName = 'p_notveg' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,1), nY, LCHNK ) - SpcName = 'p_needle_eg_temp' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,2), nY, LCHNK ) - SpcName = 'p_needle_eg_bor' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,3), nY, LCHNK ) - SpcName = 'p_needle_dd_bor' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,4), nY, LCHNK ) - SpcName = 'p_broad_eg_trop' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,5), nY, LCHNK ) - SpcName = 'p_broad_eg_temp' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,6), nY, LCHNK ) - SpcName = 'p_broad_dd_trop' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,7), nY, LCHNK ) - SpcName = 'p_broad_dd_temp' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,8), nY, LCHNK ) - SpcName = 'p_broad_dd_bor' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,9), nY, LCHNK ) - SpcName = 'p_broad_eg_sh' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,10), nY, LCHNK ) - SpcName = 'p_broad_dd_temp_sh' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,11), nY, LCHNK ) - SpcName = 'p_broad_dd_bor_sh' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,12), nY, LCHNK ) - SpcName = 'p_c3_arctic_grass' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,13), nY, LCHNK ) - SpcName = 'p_c3_narctic_grass' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,14), nY, LCHNK ) - SpcName = 'p_c4_grass' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,15), nY, LCHNK ) - SpcName = 'p_c3_crop' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,16), nY, LCHNK ) - SpcName = 'p_c3_irrigated' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,17), nY, LCHNK ) -#if defined( CLM40 ) - SpcName = 'p_c3_corn' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,18), nY, LCHNK ) - SpcName = 'p_spring_cereal' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,19), nY, LCHNK ) - SpcName = 'p_winter_cereal' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,20), nY, LCHNK ) - SpcName = 'p_soybean' -#elif defined( CLM45 ) || defined( CLM50 ) - SpcName = 'p_temp_corn' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,18), nY, LCHNK ) - SpcName = 'p_irr_temp_corn' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,19), nY, LCHNK ) - SpcName = 'p_spring_wheat' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,20), nY, LCHNK ) - SpcName = 'p_irr_spring_wheat' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,21), nY, LCHNK ) - SpcName = 'p_winter_wheat' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,22), nY, LCHNK ) - SpcName = 'p_irr_winter_wheat' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,23), nY, LCHNK ) - SpcName = 'p_temp_soybean' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,24), nY, LCHNK ) - SpcName = 'p_irr_temp_soybean' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,25), nY, LCHNK ) - SpcName = 'p_barley' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,26), nY, LCHNK ) - SpcName = 'p_irr_barley' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,27), nY, LCHNK ) - SpcName = 'p_winter_barley' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,28), nY, LCHNK ) - SpcName = 'p_irr_winter_barley' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,29), nY, LCHNK ) - SpcName = 'p_rye' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,30), nY, LCHNK ) - SpcName = 'p_irr_rye' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,31), nY, LCHNK ) - SpcName = 'p_winter_rye' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,32), nY, LCHNK ) - SpcName = 'p_irr_winter_rye' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,33), nY, LCHNK ) - SpcName = 'p_cassava' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,34), nY, LCHNK ) - SpcName = 'p_irr_cassava' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,35), nY, LCHNK ) - SpcName = 'p_citrus' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,36), nY, LCHNK ) - SpcName = 'p_irr_citrus' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,37), nY, LCHNK ) - SpcName = 'p_cocoa' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,38), nY, LCHNK ) - SpcName = 'p_irr_cocoa' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,39), nY, LCHNK ) - SpcName = 'p_coffee' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,40), nY, LCHNK ) - SpcName = 'p_irr_coffee' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,41), nY, LCHNK ) - SpcName = 'p_cotton' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,42), nY, LCHNK ) - SpcName = 'p_irr_cotton' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,43), nY, LCHNK ) - SpcName = 'p_datepalm' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,44), nY, LCHNK ) - SpcName = 'p_irr_datepalm' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,45), nY, LCHNK ) - SpcName = 'p_foddergrass' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,46), nY, LCHNK ) - SpcName = 'p_irr_foddergrass' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,47), nY, LCHNK ) - SpcName = 'p_grapes' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,48), nY, LCHNK ) - SpcName = 'p_irr_grapes' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,49), nY, LCHNK ) - SpcName = 'p_groundnuts' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,50), nY, LCHNK ) - SpcName = 'p_irr_groundnuts' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,51), nY, LCHNK ) - SpcName = 'p_millet' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,52), nY, LCHNK ) - SpcName = 'p_irr_millet' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,53), nY, LCHNK ) - SpcName = 'p_oilpalm' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,54), nY, LCHNK ) - SpcName = 'p_irr_oilpalm' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,55), nY, LCHNK ) - SpcName = 'p_potatoes' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,56), nY, LCHNK ) - SpcName = 'p_irr_potatoes' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,57), nY, LCHNK ) - SpcName = 'p_pulses' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,58), nY, LCHNK ) - SpcName = 'p_irr_pulses' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,59), nY, LCHNK ) - SpcName = 'p_rapeseed' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,60), nY, LCHNK ) - SpcName = 'p_irr_rapessed' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,61), nY, LCHNK ) - SpcName = 'p_rice' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,62), nY, LCHNK ) - SpcName = 'p_irr_rice' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,63), nY, LCHNK ) - SpcName = 'p_sorghum' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,64), nY, LCHNK ) - SpcName = 'p_irr_sorghum' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,65), nY, LCHNK ) - SpcName = 'p_sugarbeet' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,66), nY, LCHNK ) - SpcName = 'p_irr_sugarbeet' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,67), nY, LCHNK ) - SpcName = 'p_sugarcane' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,68), nY, LCHNK ) - SpcName = 'p_irr_sugarcane' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,69), nY, LCHNK ) - SpcName = 'p_sunflower' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,70), nY, LCHNK ) - SpcName = 'p_irr_sunflower' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,71), nY, LCHNK ) - SpcName = 'p_miscanthus' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,72), nY, LCHNK ) - SpcName = 'p_irr_miscanthus' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,73), nY, LCHNK ) - SpcName = 'p_switchgrass' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,74), nY, LCHNK ) - SpcName = 'p_irr_switchgrass' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,75), nY, LCHNK ) - SpcName = 'p_trop_corn' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,76), nY, LCHNK ) - SpcName = 'p_irr_trop_corn' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,77), nY, LCHNK ) - SpcName = 'p_trop_soybean' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,78), nY, LCHNK ) - SpcName = 'p_irr_trop_soybean' - CALL OutFld( TRIM(SpcName), cam_in%pwtgcell(:,79), nY, LCHNK ) -#endif - SpcName = 'pla_notveg' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,1), nY, LCHNK ) - SpcName = 'pla_needle_eg_temp' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,2), nY, LCHNK ) - SpcName = 'pla_needle_eg_bor' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,3), nY, LCHNK ) - SpcName = 'pla_needle_dd_bor' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,4), nY, LCHNK ) - SpcName = 'pla_broad_eg_trop' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,5), nY, LCHNK ) - SpcName = 'pla_broad_eg_temp' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,6), nY, LCHNK ) - SpcName = 'pla_broad_dd_trop' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,7), nY, LCHNK ) - SpcName = 'pla_broad_dd_temp' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,8), nY, LCHNK ) - SpcName = 'pla_broad_dd_bor' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,9), nY, LCHNK ) - SpcName = 'pla_broad_eg_sh' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,10), nY, LCHNK ) - SpcName = 'pla_broad_dd_temp_sh' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,11), nY, LCHNK ) - SpcName = 'pla_broad_dd_bor_sh' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,12), nY, LCHNK ) - SpcName = 'pla_c3_arctic_grass' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,13), nY, LCHNK ) - SpcName = 'pla_c3_narctic_grass' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,14), nY, LCHNK ) - SpcName = 'pla_c4_grass' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,15), nY, LCHNK ) - SpcName = 'pla_c3_crop' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,16), nY, LCHNK ) - SpcName = 'pla_c3_irrigated' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,17), nY, LCHNK ) -#if defined( CLM40 ) - SpcName = 'pla_c3_corn' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,18), nY, LCHNK ) - SpcName = 'pla_spring_cereal' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,19), nY, LCHNK ) - SpcName = 'pla_winter_cereal' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,20), nY, LCHNK ) - SpcName = 'pla_soybean' -#elif defined( CLM45 ) || defined( CLM50 ) - SpcName = 'pla_temp_corn' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,18), nY, LCHNK ) - SpcName = 'pla_irr_temp_corn' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,19), nY, LCHNK ) - SpcName = 'pla_spring_wheat' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,20), nY, LCHNK ) - SpcName = 'pla_irr_spring_wheat' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,21), nY, LCHNK ) - SpcName = 'pla_winter_wheat' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,22), nY, LCHNK ) - SpcName = 'pla_irr_winter_wheat' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,23), nY, LCHNK ) - SpcName = 'pla_temp_soybean' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,24), nY, LCHNK ) - SpcName = 'pla_irr_temp_soybean' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,25), nY, LCHNK ) - SpcName = 'pla_barley' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,26), nY, LCHNK ) - SpcName = 'pla_irr_barley' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,27), nY, LCHNK ) - SpcName = 'pla_winter_barley' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,28), nY, LCHNK ) - SpcName = 'pla_irr_winter_barley' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,29), nY, LCHNK ) - SpcName = 'pla_rye' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,30), nY, LCHNK ) - SpcName = 'pla_irr_rye' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,31), nY, LCHNK ) - SpcName = 'pla_winter_rye' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,32), nY, LCHNK ) - SpcName = 'pla_irr_winter_rye' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,33), nY, LCHNK ) - SpcName = 'pla_cassava' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,34), nY, LCHNK ) - SpcName = 'pla_irr_cassava' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,35), nY, LCHNK ) - SpcName = 'pla_citrus' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,36), nY, LCHNK ) - SpcName = 'pla_irr_citrus' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,37), nY, LCHNK ) - SpcName = 'pla_cocoa' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,38), nY, LCHNK ) - SpcName = 'pla_irr_cocoa' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,39), nY, LCHNK ) - SpcName = 'pla_coffee' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,40), nY, LCHNK ) - SpcName = 'pla_irr_coffee' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,41), nY, LCHNK ) - SpcName = 'pla_cotton' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,42), nY, LCHNK ) - SpcName = 'pla_irr_cotton' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,43), nY, LCHNK ) - SpcName = 'pla_datepalm' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,44), nY, LCHNK ) - SpcName = 'pla_irr_datepalm' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,45), nY, LCHNK ) - SpcName = 'pla_foddergrass' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,46), nY, LCHNK ) - SpcName = 'pla_irr_foddergrass' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,47), nY, LCHNK ) - SpcName = 'pla_grapes' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,48), nY, LCHNK ) - SpcName = 'pla_irr_grapes' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,49), nY, LCHNK ) - SpcName = 'pla_groundnuts' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,50), nY, LCHNK ) - SpcName = 'pla_irr_groundnuts' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,51), nY, LCHNK ) - SpcName = 'pla_millet' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,52), nY, LCHNK ) - SpcName = 'pla_irr_millet' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,53), nY, LCHNK ) - SpcName = 'pla_oilpalm' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,54), nY, LCHNK ) - SpcName = 'pla_irr_oilpalm' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,55), nY, LCHNK ) - SpcName = 'pla_potatoes' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,56), nY, LCHNK ) - SpcName = 'pla_irr_potatoes' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,57), nY, LCHNK ) - SpcName = 'pla_pulses' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,58), nY, LCHNK ) - SpcName = 'pla_irr_pulses' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,59), nY, LCHNK ) - SpcName = 'pla_rapeseed' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,60), nY, LCHNK ) - SpcName = 'pla_irr_rapessed' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,61), nY, LCHNK ) - SpcName = 'pla_rice' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,62), nY, LCHNK ) - SpcName = 'pla_irr_rice' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,63), nY, LCHNK ) - SpcName = 'pla_sorghum' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,64), nY, LCHNK ) - SpcName = 'pla_irr_sorghum' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,65), nY, LCHNK ) - SpcName = 'pla_sugarbeet' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,66), nY, LCHNK ) - SpcName = 'pla_irr_sugarbeet' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,67), nY, LCHNK ) - SpcName = 'pla_sugarcane' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,68), nY, LCHNK ) - SpcName = 'pla_irr_sugarcane' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,69), nY, LCHNK ) - SpcName = 'pla_sunflower' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,70), nY, LCHNK ) - SpcName = 'pla_irr_sunflower' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,71), nY, LCHNK ) - SpcName = 'pla_miscanthus' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,72), nY, LCHNK ) - SpcName = 'pla_irr_miscanthus' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,73), nY, LCHNK ) - SpcName = 'pla_switchgrass' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,74), nY, LCHNK ) - SpcName = 'pla_irr_switchgrass' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,75), nY, LCHNK ) - SpcName = 'pla_trop_corn' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,76), nY, LCHNK ) - SpcName = 'pla_irr_trop_corn' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,77), nY, LCHNK ) - SpcName = 'pla_trop_soybean' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,78), nY, LCHNK ) - SpcName = 'pla_irr_trop_soybean' - CALL OutFld( TRIM(SpcName), cam_in%lai(:,79), nY, LCHNK ) -#endif - - DO N = 1, nSls - SpcName = slsNames(n) - VMR = 0.0e+0_r8 - M = map2GC_Sls(n) - IF ( M > 0 ) THEN - DO J = 1, nY - DO K = 1, nZ - VMR(J,nZ+1-K) = REAL(State_Chm(LCHNK)%Species(1,J,K,M),r8) * SLSMWratio(N) - ENDDO - ENDDO - CALL OutFld( TRIM(SpcName), VMR(:nY,:), nY, LCHNK ) - ENDIF - ENDDO - - ! NOTE: Re-flip all the arrays vertically or suffer the consequences - ! ptend%q dimensions: [column, ?, species] - Ptend%Q(:,:,:) = 0.0e+0_r8 - MMR_End = 0.0e+0_r8 - DO N = 1, pcnst - M = map2GC(N) - IF (M > 0) THEN - I = 1 - DO J = 1, nY - DO K = 1, nZ - ! CURRENTLY KG/KG - MMR_End (J,K,M) = REAL(State_Chm(LCHNK)%Species(1,J,K,M),r8) - MMR_TEnd(J,K,M) = MMR_End(J,K,M) - MMR_Beg(J,K,M) - ptend%q(J,nZ+1-K,N) = (MMR_End(J,K,M)-MMR_Beg(J,K,M))/dT - ENDDO - ENDDO - ENDIF - ENDDO - - IF (PRESENT(fh2o)) THEN - fh2o(:nY) = 0.0e+0_r8 - !DO K = 1, nZ - ! fh2o(:nY) = fh2o(:nY) + Ptend%Q(:nY,K,iH2O)*State%Pdel(:nY,K)/Gravit - !ENDDO - ENDIF - - IF (rootChunk) WRITE(iulog,'(a)') ' GEOS-Chem chemistry step completed' - - end subroutine chem_timestep_tend - -!=============================================================================== - subroutine chem_init_cnst(name, latvals, lonvals, mask, q) - - CHARACTER(LEN=*), INTENT(IN) :: name ! constituent name - 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(OUT) :: q(:,:) ! kg tracer/kg dry air (NCOL, PVER - ! Used to initialize tracer fields if desired. - ! Will need a simple mapping structure as well as the CAM tracer registration - ! routines. - - INTEGER :: ILEV, NLEV, I - REAL(r8) :: QTemp, Min_MMR - - IF (MasterProc) WRITE(iulog,'(a)') 'GCCALL CHEM_INIT_CNST' - - NLEV = SIZE(Q, 2) - ! Retrieve a "background value" for this from the database - Min_MMR = 1.0e-38_r8 - DO I = 1, nTracers - IF (TRIM(tracerNames(I)).eq.TRIM(name)) THEN - Min_MMR = ref_MMR(i) - EXIT - ENDIF - ENDDO - - DO ILEV = 1, NLEV - WHERE(MASK) - ! Set to the minimum mixing ratio - Q(:,ILEV) = Min_MMR - END WHERE - ENDDO - - end subroutine chem_init_cnst - -!=============================================================================== - subroutine chem_final - - use Input_Opt_Mod, only : Cleanup_Input_Opt - use State_Chm_Mod, only : Cleanup_State_Chm - use State_Diag_Mod, only : Cleanup_State_Diag - use State_Grid_Mod, only : Cleanup_State_Grid - use State_Met_Mod, only : Cleanup_State_Met - use Error_Mod, only : Cleanup_Error - - use FlexChem_Mod, only : Cleanup_FlexChem - use UCX_Mod, only : Cleanup_UCX - use Drydep_Mod, only : Cleanup_Drydep - use WetScav_Mod, only : Cleanup_Wetscav - use Carbon_Mod, only : Cleanup_Carbon - use Dust_Mod, only : Cleanup_Dust - use Seasalt_Mod, only : Cleanup_Seasalt - use Aerosol_Mod, only : Cleanup_Aerosol - use Sulfate_Mod, only : Cleanup_Sulfate - use Pressure_Mod, only : Cleanup_Pressure - use Strat_Chem_Mod, only : Cleanup_Strat_Chem - use PBL_Mix_Mod, only : Cleanup_PBL_Mix - - use CMN_Size_Mod, only : Cleanup_CMN_Size - use CMN_O3_Mod, only : Cleanup_CMN_O3 - use CMN_FJX_Mod, only : Cleanup_CMN_FJX - - ! Special: cleans up after NDXX_Setup - use Diag_Mod, only : Cleanup_Diag - - use GC_Emissions_Mod, only: GC_Emissions_Final - - INTEGER :: I, RC - - ! Finalize GEOS-Chem - IF (MasterProc) WRITE(iulog,'(a)') 'GCCALL CHEM_FINAL' - - CALL Cleanup_UCX( MasterProc ) - CALL Cleanup_Aerosol - CALL Cleanup_Carbon - CALL Cleanup_Drydep - CALL Cleanup_Dust - CALL Cleanup_FlexChem( RC ) - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Error encountered in "Cleanup_FlexChem"!' - CALL Error_Stop( ErrMsg, ThisLoc ) - ENDIF - - CALL Cleanup_PBL_Mix - CALL Cleanup_Pressure - CALL Cleanup_Seasalt - CALL Cleanup_Sulfate - CALL Cleanup_Strat_Chem - - CALL Cleanup_WetScav( RC) - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Error encountered in "Cleanup_WetScav"!' - CALL Error_Stop( ErrMsg, ThisLoc ) - ENDIF - - CALL GC_Emissions_Final - - ! Call extra cleanup routines, from modules in Headers/ - CALL Cleanup_CMN_O3( MasterProc, RC ) - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Error encountered in "Cleanup_CMN_O3"!' - CALL Error_Stop( ErrMsg, ThisLoc ) - ENDIF - - CALL Cleanup_CMN_SIZE( MasterProc, RC ) - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Error encountered in "Cleanup_CMN_SIZE"!' - CALL Error_Stop( ErrMsg, ThisLoc ) - ENDIF - - CALL Cleanup_CMN_FJX( MasterProc, RC ) - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Error encountered in "Cleanup_CMN_FJX"!' - CALL Error_Stop( ErrMsg, ThisLoc ) - ENDIF - - CALL Cleanup_Diag - - ! Cleanup Input_Opt - CALL Cleanup_Input_Opt( MasterProc, Input_Opt, RC ) - - ! Loop over each chunk and cleanup the variables - DO I = BEGCHUNK, ENDCHUNK - - CALL Cleanup_State_Chm ( State_Chm(I), RC ) - CALL Cleanup_State_Diag( State_Diag(I), RC ) - CALL Cleanup_State_Grid( State_Grid(I), RC ) - CALL Cleanup_State_Met ( State_Met(I), RC ) - ENDDO - CALL Cleanup_Error - - ! Finally deallocate state variables - IF (ALLOCATED(State_Chm)) DEALLOCATE(State_Chm) - IF (ALLOCATED(State_Diag)) DEALLOCATE(State_Diag) - IF (ALLOCATED(State_Grid)) DEALLOCATE(State_Grid) - IF (ALLOCATED(State_Met)) DEALLOCATE(State_Met) - - IF (ALLOCATED(slvd_Lst )) DEALLOCATE(slvd_Lst) - IF (ALLOCATED(slvd_ref_MMR)) DEALLOCATE(slvd_ref_MMR) - - RETURN - - end subroutine chem_final -!=============================================================================== - subroutine chem_init_restart(File) - use pio, only : file_desc_t - TYPE(file_desc_t) :: File - - IF (MasterProc) WRITE(iulog,'(a)') 'GCCALL CHEM_INIT_RESTART' - - RETURN - - end subroutine chem_init_restart -!=============================================================================== - subroutine chem_write_restart( File ) - !use tracer_cnst, only: write_tracer_cnst_restart - !use tracer_srcs, only: write_tracer_srcs_restart - !use linoz_data, only: write_linoz_data_restart - use pio, only : file_desc_t - IMPLICIT NONE - TYPE(file_desc_t) :: File - - IF (MasterProc) WRITE(iulog,'(a)') 'GCCALL CHEM_WRITE_RESTART' - ! - ! data for offline tracers - ! - !call write_tracer_cnst_restart(File) - !call write_tracer_srcs_restart(File) - !call write_linoz_data_restart(File) - end subroutine chem_write_restart -!=============================================================================== - subroutine chem_read_restart( File ) - !use tracer_cnst, only: read_tracer_cnst_restart - !use tracer_srcs, only: read_tracer_srcs_restart - !use linoz_data, only: read_linoz_data_restart - - use pio, only : file_desc_t - IMPLICIT NONE - TYPE(file_desc_t) :: File - - if (MasterProc) WRITE(iulog,'(a)') 'GCCALL CHEM_READ_RESTART' - ! - ! data for offline tracers - ! - !call read_tracer_cnst_restart(File) - !call read_tracer_srcs_restart(File) - !call read_linoz_data_restart(File) - end subroutine chem_read_restart -!================================================================================ - subroutine chem_emissions( state, cam_in ) - use camsrfexch, only: cam_in_t - - use PhysConstants, only: PI, PI_180 - - ! Arguments: - - TYPE(physics_state), INTENT(IN) :: state ! Physics state variables - TYPE(cam_in_t), INTENT(INOUT) :: cam_in ! import state - - REAL(r8) :: Rlats(State%NCOL) - REAL(r8) :: Rlons(State%NCOL) - REAL(r8) :: Dlat, Dlon - REAL(r8) :: SFlx(State%NCOL,nTracers) - - INTEGER :: M, N, I - INTEGER :: LCHNK, NCOL - LOGICAL :: rootChunk - - LOGICAL, SAVE :: FIRST = .TRUE. - - ! LCHNK: which chunk we have on this process - LCHNK = State%LCHNK - ! NCOL: number of atmospheric columns on this chunk - NCOL = State%NCOL - rootChunk = ( MasterProc.and.(LCHNK.EQ.BEGCHUNK) ) - - SFlx(:,:) = 0.0e+0_r8 - Rlats(1:ncol) = State%Lat(1:NCOL) - Rlons(1:ncol) = State%Lon(1:NCOL) - - IF (FIRST) THEN - ENDIF - - !TMMF - ! Test: emit 1e-10 kg/m2/s of NO in a square around Europe - DO M = 1, PCNST - N = map2GC(M) - IF ((N>0).and.(N==iNO)) THEN - SFlx(:,N) = 0.0e+0_r8 - DO I = 1, NCOL - Dlat = Rlats(i) / REAL(PI_180,r8) - Dlon = Rlons(i) / REAL(PI_180,r8) - IF ((Dlat > 50.0e+0_r8).and.(Dlat < 60.0e+0_r8).and.(Dlon > -15.0e+0_r8).and.(Dlon < 5.0e+0_r8)) THEN - SFlx(I,N) = SFlx(I,N) + 1.0e-10_r8 - ENDIF - ENDDO - cam_in%CFlx(:NCOL,M) = cam_in%CFlx(:NCOL,M) + SFlx(:NCOL,N) - ENDIF - ENDDO - - end subroutine chem_emissions - -end module chemistry diff --git a/src/chemistry/pp_geoschem/gc_emissions.F90 b/src/chemistry/pp_geoschem/gc_emissions.F90 deleted file mode 100644 index 05841a9e66..0000000000 --- a/src/chemistry/pp_geoschem/gc_emissions.F90 +++ /dev/null @@ -1,76 +0,0 @@ -!================================================================================================ -! This is the "GEOS-Chem" chemistry emissions interface -!================================================================================================ -module GC_Emissions_Mod - - use Shr_kind_mod, only : r8 => shr_kind_r8 - use Spmd_utils, only : MasterProc, myCPU=>iam, nCPUs=>npes - use Cam_logfile, only : iulog - use Cam_abortutils, only : endrun - - use Chem_mods, only : NTracers - use Chem_mods, only : TracerNames - use Chem_mods, only : Map2GC - - use Tracer_data, only : trfld,trfile - - IMPLICIT NONE - - TYPE :: Emission - INTEGER :: Spc_Ndx - REAL(r8) :: MW - 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 - ENDTYPE Emission - - PRIVATE - - PUBLIC :: GC_Emissions_Init - PUBLIC :: GC_Emissions_Calc - PUBLIC :: GC_Emissions_Final - - ! Stand-in: emissions - TYPE(Emission), ALLOCATABLE :: Emissions(:) - INTEGER :: N_Emis_Files - -!================================================================================================ -contains -!================================================================================================ - - subroutine GC_Emissions_Init - - INTEGER :: Ierr - - N_Emis_Files=1 - ALLOCATE(Emissions(N_Emis_Files), STAT=IERR) - IF (IERR.NE.0) CALL ENDRUN('Could not allocate GC emissions') - - end subroutine GC_Emissions_Init - - subroutine GC_Emissions_Calc(Eflx) - - ! Emissions in kg/m2/s - ! Dimensions: [N columns x K levels x C constituents ] - REAL(r8), INTENT(OUT) :: EFlx(:,:,:) - INTEGER :: I_Trc, I_Emis - - EFlx(:,:,:) = 0.0e+0_r8 - DO I_Emis = 1, N_Emis_Files - ! Read emissions file - DO I_Trc = 1, NTracers - ENDDO - ENDDO - - end subroutine GC_Emissions_Calc - - subroutine GC_Emissions_Final - IF (ALLOCATED(Emissions)) DEALLOCATE(Emissions) - end subroutine GC_Emissions_Final - - end module GC_Emissions_Mod diff --git a/src/chemistry/pp_geoschem/mo_chem_utls.F90 b/src/chemistry/pp_geoschem/mo_chem_utls.F90 deleted file mode 100644 index 1d709c09dc..0000000000 --- a/src/chemistry/pp_geoschem/mo_chem_utls.F90 +++ /dev/null @@ -1,162 +0,0 @@ - -module mo_chem_utls - - private - public :: get_spc_ndx!, get_het_ndx, get_extfrc_ndx, get_rxt_ndx, get_inv_ndx - - save - -contains - - integer function get_spc_ndx( spc_name ) - !----------------------------------------------------------------------- - ! ... return overall species index associated with spc_name - !----------------------------------------------------------------------- - - use chem_mods, only : nTracers, tracnam => tracerNames - use string_utils, only : to_upper - - implicit none - - !----------------------------------------------------------------------- - ! ... dummy arguments - !----------------------------------------------------------------------- - character(len=*), intent(in) :: spc_name - - !----------------------------------------------------------------------- - ! ... local variables - !----------------------------------------------------------------------- - integer :: m - - get_spc_ndx = -1 - do m = 1, nTracers - if( trim( spc_name ) == trim( to_upper( tracnam(m) ) ) ) then - get_spc_ndx = m - exit - end if - end do - - end function get_spc_ndx - -! integer function get_inv_ndx( invariant ) -! !----------------------------------------------------------------------- -! ! ... return overall external frcing index associated with spc_name -! !----------------------------------------------------------------------- -! -! use chem_mods, only : nfs, inv_lst -! -! implicit none -! -! !----------------------------------------------------------------------- -! ! ... dummy arguments -! !----------------------------------------------------------------------- -! character(len=*), intent(in) :: invariant -! -! !----------------------------------------------------------------------- -! ! ... local variables -! !----------------------------------------------------------------------- -! integer :: m -! -! get_inv_ndx = -1 -! do m = 1,nfs -! if( trim( invariant ) == trim( inv_lst(m) ) ) then -! get_inv_ndx = m -! exit -! end if -! end do -! -! end function get_inv_ndx -! -! integer function get_het_ndx( het_name ) -! !----------------------------------------------------------------------- -! ! ... return overall het process index associated with spc_name -! !----------------------------------------------------------------------- -! -! use gas_wetdep_opts,only : gas_wetdep_method, gas_wetdep_list, gas_wetdep_cnt -! -! implicit none -! -! !----------------------------------------------------------------------- -! ! ... dummy arguments -! !----------------------------------------------------------------------- -! character(len=*), intent(in) :: het_name -! -! !----------------------------------------------------------------------- -! ! ... local variables -! !----------------------------------------------------------------------- -! integer :: m -! -! get_het_ndx=-1 -! -! do m=1,gas_wetdep_cnt -! -! if( trim( het_name ) == trim( gas_wetdep_list(m) ) ) then -! get_het_ndx = get_spc_ndx( gas_wetdep_list(m) ) -! return -! endif -! -! enddo -! -! end function get_het_ndx -! -! integer function get_extfrc_ndx( frc_name ) -! !----------------------------------------------------------------------- -! ! ... return overall external frcing index associated with spc_name -! !----------------------------------------------------------------------- -! -! use chem_mods, only : extcnt, extfrc_lst -! -! implicit none -! -! !----------------------------------------------------------------------- -! ! ... dummy arguments -! !----------------------------------------------------------------------- -! character(len=*), intent(in) :: frc_name -! -! !----------------------------------------------------------------------- -! ! ... local variables -! !----------------------------------------------------------------------- -! integer :: m -! -! get_extfrc_ndx = -1 -! if( extcnt > 0 ) then -! do m = 1,max(1,extcnt) -! if( trim( frc_name ) == trim( extfrc_lst(m) ) ) then -! get_extfrc_ndx = m -! exit -! end if -! end do -! end if -! -! end function get_extfrc_ndx -! -! integer function get_rxt_ndx( rxt_tag ) -! !----------------------------------------------------------------------- -! ! ... return overall external frcing index associated with spc_name -! !----------------------------------------------------------------------- -! -! use chem_mods, only : rxt_tag_cnt, rxt_tag_lst, rxt_tag_map -! -! implicit none -! -! !----------------------------------------------------------------------- -! ! ... dummy arguments -! !----------------------------------------------------------------------- -! character(len=*), intent(in) :: rxt_tag -! -! !----------------------------------------------------------------------- -! ! ... local variables -! !----------------------------------------------------------------------- -! integer :: m -! -! get_rxt_ndx = -1 -! do m = 1,rxt_tag_cnt -! if( trim( rxt_tag ) == trim( rxt_tag_lst(m) ) ) then -! get_rxt_ndx = rxt_tag_map(m) -! exit -! end if -! end do -! -! end function get_rxt_ndx - -end module mo_chem_utls diff --git a/src/chemistry/pp_geoschem/mo_lightning.F90 b/src/chemistry/pp_geoschem/mo_lightning.F90 deleted file mode 100644 index 206c1e7fc6..0000000000 --- a/src/chemistry/pp_geoschem/mo_lightning.F90 +++ /dev/null @@ -1,182 +0,0 @@ -module mo_lightning - !---------------------------------------------------------------------- - ! ... the lightning module - !---------------------------------------------------------------------- - - use shr_kind_mod, only : r8 => shr_kind_r8 - use ppgrid, only : begchunk, endchunk, pcols, pver - use phys_grid, only : ngcols_p - use cam_abortutils, only : endrun - use cam_logfile, only : iulog - use spmd_utils, only : masterproc, mpicom - - implicit none - - private - public :: lightning_inti - public :: lightning_no_prod - public :: prod_no - - save - - real(r8) :: csrf - real(r8) :: factor = 0.1_r8 ! user-controlled scaling factor to achieve arbitrary no prod. - real(r8) :: geo_factor ! grid cell area factor - real(r8) :: vdist(16,3) ! vertical distribution of lightning - real(r8), allocatable :: prod_no(:,:,:) - real(r8), allocatable :: glob_prod_no_col(:,:) - real(r8), allocatable :: flash_freq(:,:) - integer :: no_ndx,xno_ndx - logical :: has_no_lightning_prod = .false. - -contains - - subroutine lightning_inti( lght_no_prd_factor ) - !---------------------------------------------------------------------- - ! ... initialize the lightning module - !---------------------------------------------------------------------- - use mo_constants, only : pi - use ioFileMod, only : getfil - !use mo_chem_utls, only : get_spc_ndx - - use cam_history, only : addfld, add_default, horiz_only - use dyn_grid, only : get_dyn_grid_parm - use phys_control, only : phys_getopts - - implicit none - - !---------------------------------------------------------------------- - ! ... dummy args - !---------------------------------------------------------------------- - real(r8), intent(in) :: lght_no_prd_factor ! lightning no production factor - - !!---------------------------------------------------------------------- - !! ... local variables - !!---------------------------------------------------------------------- - !integer :: astat - !integer :: ncid - !integer :: dimid - !integer :: vid - !integer :: gndx - !integer :: jl, ju - !integer :: nlat, nlon - !integer :: plon, plat - !real(r8), allocatable :: lats(:) - !real(r8), allocatable :: lons(:) - !real(r8), allocatable :: landmask(:,:) - !character(len=256) :: locfn - !logical :: history_cesm_forcing - - !call phys_getopts( history_cesm_forcing_out = history_cesm_forcing ) - - !no_ndx = get_spc_ndx('NO') - !xno_ndx = get_spc_ndx('XNO') - - !has_no_lightning_prod = no_ndx>0 .or. xno_ndx>0 - !if (.not.has_no_lightning_prod) return - - ! - !if( lght_no_prd_factor /= 1._r8 ) then - ! factor = factor*lght_no_prd_factor - !end if - - - !if (masterproc) write(iulog,*) 'lght_inti: lightning no production scaling factor = ',factor - - !!---------------------------------------------------------------------- - !! ... vdist(kk,itype) = % of lightning nox between (kk-1) and (kk) - !! km for profile itype - !!---------------------------------------------------------------------- - !vdist(:,1) = (/ 3.0_r8, 3.0_r8, 3.0_r8, 3.0_r8, 3.4_r8, 3.5_r8, 3.6_r8, 4.0_r8, & ! midlat cont - ! 5.0_r8, 7.0_r8, 9.0_r8, 14.0_r8, 16.0_r8, 14.0_r8, 8.0_r8, 0.5_r8 /) - !vdist(:,2) = (/ 2.5_r8, 2.5_r8, 2.5_r8, 2.5_r8, 2.5_r8, 2.5_r8, 2.5_r8, 6.1_r8, & ! trop marine - ! 17.0_r8, 15.4_r8, 14.5_r8, 13.0_r8, 12.5_r8, 2.8_r8, 0.9_r8, 0.3_r8 /) - !vdist(:,3) = (/ 2.0_r8, 2.0_r8, 2.0_r8, 1.5_r8, 1.5_r8, 1.5_r8, 3.0_r8, 5.8_r8, & ! trop cont - ! 7.6_r8, 9.6_r8, 11.0_r8, 14.0_r8, 14.0_r8, 14.0_r8, 8.2_r8, 2.3_r8 /) - - !allocate( prod_no(pcols,pver,begchunk:endchunk),stat=astat ) - !if( astat /= 0 ) then - ! write(iulog,*) 'lght_inti: failed to allocate prod_no; error = ',astat - ! call endrun - !end if - !allocate( flash_freq(pcols,begchunk:endchunk),stat=astat ) - !if( astat /= 0 ) then - ! write(iulog,*) 'lght_inti: failed to allocate flash_freq; error = ',astat - ! call endrun - !end if - !allocate( glob_prod_no_col(pcols,begchunk:endchunk),stat=astat ) - !if( astat /= 0 ) then - ! write(iulog,*) 'lght_inti: failed to allocate glob_prod_no_col; error = ',astat - ! call endrun - !end if - !prod_no(:,:,:) = 0._r8 - !flash_freq(:,:) = 0._r8 - !geo_factor = ngcols_p/(4._r8*pi) - - - !call addfld( 'LNO_COL_PROD', horiz_only, 'I', 'TG N/YR', 'lighting column NO source' ) - !call addfld( 'LNO_PROD', (/ 'lev' /), 'I', '/cm3/s', 'lighting insitu NO source' ) - !call addfld( 'FLASHFRQ', horiz_only, 'I', '1/MIN', 'lighting flash rate' ) ! flash frequency in grid box per minute (PPP) - !call addfld( 'FLASHENGY', horiz_only, 'I', ' ', 'lighting flash rate' ) ! flash frequency in grid box per minute (PPP) - !call addfld( 'CLDHGT', horiz_only, 'I', 'KM', 'cloud top height' ) ! cloud top height - !call addfld( 'DCHGZONE', horiz_only, 'I', 'KM', 'depth of discharge zone' ) ! depth of discharge zone - !call addfld( 'CGIC', horiz_only, 'I', 'RATIO', 'ratio of cloud-ground/intracloud discharges' ) ! ratio of cloud-ground/intracloud discharges - - !if ( history_cesm_forcing ) then - ! call add_default('LNO_COL_PROD',1,' ') - !endif - - end subroutine lightning_inti - - subroutine lightning_no_prod( state, pbuf2d, cam_in ) - !---------------------------------------------------------------------- - ! ... set no production from lightning - !---------------------------------------------------------------------- - use physics_types, only : physics_state - - use physics_buffer, only : pbuf_get_index, physics_buffer_desc, pbuf_get_field, pbuf_get_chunk - use physconst, only : rga - use phys_grid, only : get_rlat_all_p, get_lat_all_p, get_lon_all_p, get_wght_all_p - use cam_history, only : outfld - use camsrfexch, only : cam_in_t - use shr_reprosum_mod, only : shr_reprosum_calc - !use mo_constants, only : rearth, d2r - implicit none - - !---------------------------------------------------------------------- - ! ... dummy args - !---------------------------------------------------------------------- - type(physics_state), intent(in) :: state(begchunk:endchunk) ! physics state - - type(physics_buffer_desc), pointer :: pbuf2d(:,:) - type(cam_in_t), intent(in) :: cam_in(begchunk:endchunk) ! physics state - - !---------------------------------------------------------------------- - ! ... local variables - !---------------------------------------------------------------------- - - !---------------------------------------------------------------------- - ! ... parameters to determine cg/ic ratio [price and rind, 1993] - !---------------------------------------------------------------------- - - if (.not.has_no_lightning_prod) return - - ! < === INSERT CALCULATION HERE === > - - !!-------------------------------------------------------------------------------- - !! ... output lightning no production to history file - !!-------------------------------------------------------------------------------- - !do c = begchunk,endchunk - ! lchnk = state(c)%lchnk - ! call outfld( 'LNO_PROD', prod_no(:,:,c), pcols, lchnk ) - ! call outfld( 'LNO_COL_PROD', glob_prod_no_col(:,c), pcols, lchnk ) - ! call outfld( 'FLASHFRQ', flash_freq(:,c), pcols, lchnk ) - ! call outfld( 'FLASHENGY', flash_energy(:,c), pcols, lchnk ) - ! call outfld( 'CLDHGT', cldhgt(:,c), pcols, lchnk ) - ! call outfld( 'DCHGZONE', dchgzone(:,c), pcols, lchnk ) - ! call outfld( 'CGIC', cgic(:,c), pcols, lchnk ) - !enddo - - end subroutine lightning_no_prod - -end module mo_lightning From 6c3299f1a38262c344ca57fd9d7265ebb5ea44a1 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Wed, 24 Feb 2021 13:16:28 -0500 Subject: [PATCH 007/291] Feat: Write ZPJ values for RXN_NO2, RXN_O3_1/2a into HCO_IN_JNO2, HCO_IN_JOH for HEMCO ParaNOx extension. Fix: fldname_ns fix to FIELDNAME --- src/chemistry/geoschem/chemistry.F90 | 66 +++++++++++++++++++++++----- 1 file changed, 55 insertions(+), 11 deletions(-) diff --git a/src/chemistry/geoschem/chemistry.F90 b/src/chemistry/geoschem/chemistry.F90 index ec97c95ec1..ad23371913 100644 --- a/src/chemistry/geoschem/chemistry.F90 +++ b/src/chemistry/geoschem/chemistry.F90 @@ -216,6 +216,7 @@ subroutine chem_register INTEGER :: I, N, M, L INTEGER :: nIgnored + INTEGER :: tmpIdx REAL(r8) :: cptmp REAL(r8) :: MWTmp REAL(r8) :: qmin @@ -635,6 +636,11 @@ subroutine chem_register Call Cleanup_State_Grid( SG, RC ) Call Cleanup_Input_Opt ( IO, RC ) + ! Add data for HEMCO extensions to buffers + call pbuf_add_field('HCO_IN_JNO2', 'global', dtype_r8, (/pcols/), tmpIdx) + call pbuf_add_field('HCO_IN_JOH', 'global', dtype_r8, (/pcols/), tmpIdx) + + end subroutine chem_register !=============================================================================== @@ -1873,6 +1879,7 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) use PBL_Mix_Mod, only : Compute_PBL_Height use UCX_Mod, only : Set_H2O_Trac use CMN_FJX_MOD, only : ZPJ + USE FAST_JX_MOD, only : RXN_NO2, RXN_O3_1, RXN_O3_2a use State_Diag_Mod, only : get_TagInfo use Unitconv_Mod, only : Convert_Spc_Units @@ -3119,10 +3126,9 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) ! Day FIELDNAME = TRIM(PREFIX) // '_DAY' - fldname_ns = FIELDNAME - tmpIdx = pbuf_get_index(fldname_ns, RC) + tmpIdx = pbuf_get_index(FIELDNAME, RC) IF ( tmpIdx < 0 .or. ( iStep == 1 ) ) THEN - IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(fldname_ns) + IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(FIELDNAME) BrPtrDay(N)%MR(1,:nY,nZ:1:-1) = 0.0e+0_f4 ELSE pbuf_chnk => pbuf_get_chunk(hco_pbuf2d, LCHNK) @@ -3135,9 +3141,9 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) ! Night FIELDNAME = TRIM(PREFIX) // '_NIGHT' - tmpIdx = pbuf_get_index(fldname_ns, RC) + tmpIdx = pbuf_get_index(FIELDNAME, RC) IF ( tmpIdx < 0 .or. ( iStep == 1 ) ) THEN - IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(fldname_ns) + IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(FIELDNAME) BrPtrDay(N)%MR(1,:nY,nZ:1:-1) = 0.0e+0_f4 ELSE pbuf_chnk => pbuf_get_chunk(hco_pbuf2d, LCHNK) @@ -3178,9 +3184,9 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating PLVEC%PROD') ! Get pointer from HEMCO - tmpIdx = pbuf_get_index(fldname_ns, RC) + tmpIdx = pbuf_get_index(FIELDNAME, RC) IF ( tmpIdx < 0 .or. ( iStep == 1 ) ) THEN - IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(fldname_ns) + IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(FIELDNAME) PLVEC(N)%PROD(1,:nY,nZ:1:-1) = 0.0e+0_f4 FND = .False. ELSE @@ -3210,9 +3216,9 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) ENDIF ! Get pointer from HEMCO - tmpIdx = pbuf_get_index(fldname_ns, RC) + tmpIdx = pbuf_get_index(FIELDNAME, RC) IF ( tmpIdx < 0 .or. ( iStep == 1 ) ) THEN - IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(fldname_ns) + IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(FIELDNAME) PLVEC(N)%LOSS(1,:nY,nZ:1:-1) = 0.0e+0_f4 FND = .False. ELSE @@ -3241,9 +3247,9 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) ALLOCATE( STRAT_OH(1,PCOLS,nZ), STAT=IERR ) IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating STRAT_OH') - tmpIdx = pbuf_get_index(fldname_ns, RC) + tmpIdx = pbuf_get_index(FIELDNAME, RC) IF ( tmpIdx < 0 .or. ( iStep == 1 ) ) THEN - IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(fldname_ns) + IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(FIELDNAME) STRAT_OH(1,:nY,nZ:1:-1) = 0.0e+0_f4 ELSE pbuf_chnk => pbuf_get_chunk(hco_pbuf2d, LCHNK) @@ -3730,6 +3736,44 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) CALL ENDRUN('Incorrect unit in GEOS-Chem State_Chm%Species') ENDIF + ! Save and write J-values to pbuf for HEMCO + ! in HCO_IN_JNO2, HCO_IN_JOH + FIELDNAME = 'HCO_IN_JNO2' + tmpIdx = pbuf_get_index(FIELDNAME, RC) + IF ( tmpIdx < 0 .or. ( iStep == 1 ) ) THEN + IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(FIELDNAME) + ELSE + pbuf_chnk => pbuf_get_chunk(hco_pbuf2d, LCHNK) + CALL pbuf_get_field(pbuf_chnk, tmpIdx, pbuf_ik) + + ! RXN_NO2: NO2 + hv --> NO + O + pbuf_ik(:nY,:nZ) = ZPJ(nZ:1:-1, RXN_NO2, 1, :nY) + + pbuf_chnk => NULL() + pbuf_ik => NULL() + ENDIF + + + FIELDNAME = 'HCO_IN_JOH' + tmpIdx = pbuf_get_index(FIELDNAME, RC) + IF ( tmpIdx < 0 .or. ( iStep == 1 ) ) THEN + IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(FIELDNAME) + ELSE + pbuf_chnk => pbuf_get_chunk(hco_pbuf2d, LCHNK) + CALL pbuf_get_field(pbuf_chnk, tmpIdx, pbuf_ik) + + IF ( Input_Opt%LUCX ) THEN + ! RXN_O3_1: O3 + hv --> O2 + O + pbuf_ik(:nY,:nZ) = ZPJ(nZ:1:-1, RXN_O3_1, 1, :nY) + ELSE + ! RXN_O3_2a: O3 + hv --> 2OH + pbuf_ik(:nY,:nZ) = ZPJ(nZ:1:-1, RXN_O3_2a, 1, :nY) + ENDIF + + pbuf_chnk => NULL() + pbuf_ik => NULL() + ENDIF + ! GEOS-Chem considers CO2 as a dead species and resets its concentration ! internally. Right after the call to `Do_Chemistry`, State_Chm%Species(iCO2) ! corresponds to the chemically-produced CO2. The real CO2 concentration From edf905677eb53ad73986d673f04ee3e7bec6dc1b Mon Sep 17 00:00:00 2001 From: Thibaud Fritz Date: Wed, 24 Feb 2021 15:17:30 -0500 Subject: [PATCH 008/291] Squashed 4 commits from Thibaud Fritz Feat: Uniformize calls to HEMCO Fix: Replace SO4S with SO4s Fix: Fix XML file name Feat: Capitalize all GC constituents name, and other updates: (1) This is required because boundary conditions are stored with capitalized name. I would rather follow the same terminology as MOZART (with capitalized constituents) rather than modify the interface with flbc. (2) Update geoschem.xml to match FC2000climo compset (3) Fix bug where lght_no_prod_factor was not applied in CESM-GC (4) Set ext_frc_specifier to '' for CESM-GC compsets as we rely on HEMCO --- bld/build-namelist | 9 +- bld/namelist_files/use_cases/geoschem.xml | 49 +++---- .../use_cases/hist_geoschem.xml | 10 +- bld/namelist_files/use_cases/sd_geoschem.xml | 10 +- cime_config/config_component.xml | 2 +- src/chemistry/geoschem/chemistry.F90 | 130 ++++++++---------- src/chemistry/geoschem/mo_neu_wetdep.F90 | 14 +- src/chemistry/geoschem/mo_sim_dat.F90 | 46 +++---- 8 files changed, 123 insertions(+), 147 deletions(-) diff --git a/bld/build-namelist b/bld/build-namelist index c0e4bc0a25..a14d37639e 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -1898,7 +1898,7 @@ my $megan_emis = defined $nl->get_value('megan_specifier'); if ( $megan_emis ) { add_default($nl, 'megan_factors_file'); } # Tropospheric full chemistry options -if (($chem =~ /geoschem/ or $chem =~ /trop_mozart/ or $chem =~ /trop_strat/ or $chem =~ /waccm_tsmlt/) and ($phys !~ /cam6/)) { +if (($chem =~ /trop_mozart/ or $chem =~ /trop_strat/ or $chem =~ /waccm_tsmlt/) and ($phys !~ /cam6/)) { # Surface emission datasets: my %verhash; @@ -2084,7 +2084,8 @@ if ($chem =~ /geoschem/) { my $val; # Species with fixed lower boundary - $val = "'CH4','OCS','N2O','CO2','CFC11','CFC12'"; + $val = "'CCL4','CH4','N2O','CO2','CFC11','CFC12','CH3BR','CH3CCL3','CH3CL'" + .",'HCFC22','CFC114','CFC115','HCFC141B','HCFC142B','CH2BR2','CHBR3','H2402'"; if ($chem_has_ocs) { $val .= ",'OCS'"; @@ -3009,7 +3010,7 @@ if ($clubb_sgs =~ /$TRUE/io) { add_default($nl, 'clubb_history'); add_default($nl, 'clubb_rad_history'); - if ($nl->get_value('clubb_history') =~ "true" && $nl->get_value('atm_nthreads') != 1) { + if ($nl->get_value('clubb_history') =~ "true" && $nl->get_value('atm_nthreads') > 1) { die "$ProgName - ERROR: clubb_history = .true. with multiple threads is not supported. \n"; } @@ -3185,7 +3186,7 @@ if ( length($nl->get_value('soil_erod_file'))>0 ) { add_default($nl, 'dust_emis_fact', 'tms'=>'1'); } else { - if ($chem =~ /trop_strat/ or $chem =~ /waccm_ma/ or $chem =~ /waccm_tsmlt/ or $chem =~ /trop_mozart/) { + if ($chem =~ /trop_strat/ or $chem =~ /geoschem/ or $chem =~ /waccm_ma/ or $chem =~ /waccm_tsmlt/ or $chem =~ /trop_mozart/) { add_default($nl, 'dust_emis_fact', 'ver'=>'chem'); # set scaling of lightning NOx production add_default($nl, 'lght_no_prd_factor' ); diff --git a/bld/namelist_files/use_cases/geoschem.xml b/bld/namelist_files/use_cases/geoschem.xml index ce495dbfb2..39fc45bf7e 100644 --- a/bld/namelist_files/use_cases/geoschem.xml +++ b/bld/namelist_files/use_cases/geoschem.xml @@ -3,58 +3,41 @@ 00010101 -367.0e-6 - /glade/p/univ/umit0034/ExtData/CHEM_INPUTS/ /glade/p/univ/umit0034/Shared/f.e20.FWAMIP.f09_f09.134.1975.009.cam.i.2010-01-01_32L_c170403.nc /glade/p/univ/umit0034/Shared/f.e20.FWAMIP.f19_f19.134.1975.009.cam.i.2010-01-01_32L_c170403.nc ->&gt; Solar constant from Lean (via Caspar Ammann) &lt;/!</! -atm/cam/solar/spectral_irradiance_Lean_1610-2009_ann_c100405.nc + +atm/cam/solar/SolarForcing1995-2005avg_c160929.nc 20000101 FIXED ->&gt; Prescribed BAM data is from Jean-Francois Lamarque &lt;/!</! -atm/cam/chem/trop_mozart_aero/aero -aero_1.9x2.5_L26_1850-2005_c091112.nc -CYCLICAL -2000 - ->&gt; aerosol deposition &lt;/!</! -atm/cam/chem/trop_mozart_aero/aero -aerosoldep_monthly_2000_mean_1.9x2.5_c090421.nc -CYCLICAL -2000 - ->&gt; Prescribed ozone data is from Jean-Francois Lamarque &lt;/!</! - atm/cam/ozone - ozone_1.9x2.5_L26_1850-2005_c090803.nc - O3 - CYCLICAL - 2000 - 'xactive_lnd' ->&gt; sim_year used for CLM datasets &lt;/!</! -2000 + +.true. +.true. +.false. +0.25D0 ->&gt; fixed lower boundary data &lt;/!</! -2000 -atm/waccm/lb/LBC_1765-2500_1.9x2.5_CMIP5_RCP45_za_c120204.nc + CYCLICAL +2000 +atm/waccm/lb/LBC_2000climo_CMIP6_0p5degLat_c180227.nc >&gt; emissions timing &lt;/!</! >&gt; &amp;lt;ext_frc_type&amp;gt;'SERIAL'&amp;lt;/ext_frc_type&amp;gt; &lt;/!</! 'CYCLICAL' + 2000 >&gt; History Files &lt;/!</! - 1, 24 - 0, -1 - 'A', 'A' + 1,30,365,240,240,480,365,73,30 + 0,-24,-24,-3,-1,1,-24,-120,-240 +'A','A','A','A','A','A','A','A','I' 'Q', 'U', 'V', 'OMEGA', 'T', 'PS', @@ -65,7 +48,7 @@ - 'ACET','ACTA','ALD2','ASOG1','ASOG2','ASOG3','ATOOH','Br2','BrCl','BrNO3','CH2O','Cl2','ClNO2','ClNO3','ClO','ClOO','EOH','ETHLN','ETNO3','ETP','GLYC','GLYX','H2O2','HAC','HBr','HC5A','HCl','HCOOH','Hg0','Hg0_ANT','Hg0_ARC','Hg0_ATL','Hg0_BB','Hg0_CAM','Hg0_CAN','Hg0_EAF','Hg0_EAS','Hg0_EEU','Hg0_EUR','Hg0_GEO','Hg0_JPN','Hg0_MDE','Hg0_NAF','Hg0_NAT','Hg0_NPA','Hg0_OCE','Hg0_OCN','Hg0_SAF','Hg0_SAM','Hg0_SAS','Hg0_SAT','Hg0_SEA','Hg0_SO','Hg0_SOV','Hg0_STR','Hg0_USA','Hg0_WAF','Hg2','Hg2_ANT','Hg2_ARC','Hg2_ATL','Hg2_BB','Hg2_CAM','Hg2_CAN','Hg2_EAF','Hg2_EAS','Hg2_EEU','Hg2_EUR','Hg2_GEO','Hg2_JPN','Hg2_MDE','Hg2_NAF','Hg2_NAT','Hg2_NPA','Hg2_OCE','Hg2_OCN','Hg2_SAF','Hg2_SAM','Hg2_SAS','Hg2_SAT','Hg2_SEA','Hg2_SO','Hg2_SOV','Hg2_STR','Hg2_USA','Hg2_WAF','HI','HMHP','HMML','HNO3','HOBr','HOCl','HOI','HONIT','HPALD1','HPALD2','HPALD3','HPALD4','HPETHNL','I2','I2O2','I2O3','I2O4','IBr','ICHE','ICl','ICN','ICPDH','IDC','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','IPRNO3','ITCN','ITHN','LIMO','LVOC','MACR','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MENO3','MGLY','MOH','MONITS','MONITU','MPAN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','N2O5','NH3','NO2','NPRNO3','O3','O3AFBL','O3ASBL','O3ATBL','O3EUBL','O3INIT','O3MT','O3NABL','O3PCBL','O3ROW','O3Strat','O3USA','O3UT','OPOG1','OPOG2','PAN','POG1','POG2','POPG_BAP','POPG_PHE','POPG_PYR','PP','PPN','PROPNN','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2','TSOG0','TSOG1','TSOG2','TSOG3','AERI','ASOA1','ASOA2','ASOA3','ASOAN','BCPI','BCPO','Be10','Be10Strat','Be7','Be7Strat','BrSALA','BrSALC','DST1','DST2','DST3','DST4','DSTAL1','DSTAL2','DSTAL3','DSTAL4','HgP','HgP_ANT','HgP_ARC','HgP_ATL','HgP_BB','HgP_CAM','HgP_CAN','HgP_EAF','HgP_EAS','HgP_EEU','HgP_EUR','HgP_GEO','HgP_JPN','HgP_MDE','HgP_NAF','HgP_NAT','HgP_NPA','HgP_OCE','HgP_OCN','HgP_SAF','HgP_SAM','HgP_SAS','HgP_SAT','HgP_SEA','HgP_SO','HgP_SOV','HgP_STR','HgP_USA','HgP_WAF','INDIOL','IONITA','ISALA','ISALC','LVOCOA','MONITA','MOPI','MOPO','MSA','NH4','NIT','NITD1','NITD2','NITD3','NITD4','NITs','OCPI','OCPO','OPOA1','OPOA2','Pb210','Pb210Strat','pFe','POA1','POA2','POPPBCPI_BAP','POPPBCPI_PHE','POPPBCPI_PYR','POPPBCPO_BAP','POPPBCPO_PHE','POPPBCPO_PYR','POPPOCPI_BAP','POPPOCPI_PHE','POPPOCPI_PYR','POPPOCPO_BAP','POPPOCPO_PHE','POPPOCPO_PYR','SALA','SALAAL','SALACL','SALC','SALCAL','SALCCL','SO4','SO4D1','SO4D2','SO4D3','SO4D4','SO4S','SOAGX','SOAIE','SOAS','TSOA0','TSOA1','TSOA2','TSOA3', + 'ACET','ACTA','ALD2','ASOG1','ASOG2','ASOG3','ATOOH','BR2','BRCL','BRNO3','CH2O','CL2','CLNO2','CLNO3','CLO','CLOO','EOH','ETHLN','ETNO3','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HG0','HG0_ANT','HG0_ARC','HG0_ATL','HG0_BB','HG0_CAM','HG0_CAN','HG0_EAF','HG0_EAS','HG0_EEU','HG0_EUR','HG0_GEO','HG0_JPN','HG0_MDE','HG0_NAF','HG0_NAT','HG0_NPA','HG0_OCE','HG0_OCN','HG0_SAF','HG0_SAM','HG0_SAS','HG0_SAT','HG0_SEA','HG0_SO','HG0_SOV','HG0_STR','HG0_USA','HG0_WAF','HG2','HG2_ANT','HG2_ARC','HG2_ATL','HG2_BB','HG2_CAM','HG2_CAN','HG2_EAF','HG2_EAS','HG2_EEU','HG2_EUR','HG2_GEO','HG2_JPN','HG2_MDE','HG2_NAF','HG2_NAT','HG2_NPA','HG2_OCE','HG2_OCN','HG2_SAF','HG2_SAM','HG2_SAS','HG2_SAT','HG2_SEA','HG2_SO','HG2_SOV','HG2_STR','HG2_USA','HG2_WAF','HI','HMHP','HMML','HNO3','HOBR','HOCL','HOI','HONIT','HPALD1','HPALD2','HPALD3','HPALD4','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDC','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','IPRNO3','ITCN','ITHN','LIMO','LVOC','MACR','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MENO3','MGLY','MOH','MONITS','MONITU','MPAN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','N2O5','NH3','NO2','NPRNO3','O3','O3AFBL','O3ASBL','O3ATBL','O3EUBL','O3INIT','O3MT','O3NABL','O3PCBL','O3ROW','O3STRAT','O3USA','O3UT','OPOG1','OPOG2','PAN','POG1','POG2','POPG_BAP','POPG_PHE','POPG_PYR','PP','PPN','PROPNN','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2','TSOG0','TSOG1','TSOG2','TSOG3','AERI','ASOA1','ASOA2','ASOA3','ASOAN','BCPI','BCPO','BE10','BE10STRAT','BE7','BE7STRAT','BRSALA','BRSALC','DST1','DST2','DST3','DST4','DSTAL1','DSTAL2','DSTAL3','DSTAL4','HGP','HGP_ANT','HGP_ARC','HGP_ATL','HGP_BB','HGP_CAM','HGP_CAN','HGP_EAF','HGP_EAS','HGP_EEU','HGP_EUR','HGP_GEO','HGP_JPN','HGP_MDE','HGP_NAF','HGP_NAT','HGP_NPA','HGP_OCE','HGP_OCN','HGP_SAF','HGP_SAM','HGP_SAS','HGP_SAT','HGP_SEA','HGP_SO','HGP_SOV','HGP_STR','HGP_USA','HGP_WAF','INDIOL','IONITA','ISALA','ISALC','LVOCOA','MONITA','MOPI','MOPO','MSA','NH4','NIT','NITD1','NITD2','NITD3','NITD4','NITS','OCPI','OCPO','OPOA1','OPOA2','PB210','PB210STRAT','PFE','POA1','POA2','POPPBCPI_BAP','POPPBCPI_PHE','POPPBCPI_PYR','POPPBCPO_BAP','POPPBCPO_PHE','POPPBCPO_PYR','POPPOCPI_BAP','POPPOCPI_PHE','POPPOCPI_PYR','POPPOCPO_BAP','POPPOCPO_PHE','POPPOCPO_PYR','SALA','SALAAL','SALACL','SALC','SALCAL','SALCCL','SO4','SO4D1','SO4D2','SO4D3','SO4D4','SO4S','SOAGX','SOAIE','SOAS','TSOA0','TSOA1','TSOA2','TSOA3', @@ -73,7 +56,7 @@ - 'ACTA','ALD2','ASOG1','ASOG2','ASOG3','ATOOH','Br2','BrCl','CH2O','EOH','ETHLN','ETP','GLYC','GLYX','H2O2','HAC','HBr','HC5A','HCl','HCOOH','Hg2','Hg2_ANT','Hg2_ARC','Hg2_ATL','Hg2_BB','Hg2_CAM','Hg2_CAN','Hg2_EAF','Hg2_EAS','Hg2_EEU','Hg2_EUR','Hg2_GEO','Hg2_JPN','Hg2_MDE','Hg2_NAF','Hg2_NAT','Hg2_NPA','Hg2_OCE','Hg2_OCN','Hg2_SAF','Hg2_SAM','Hg2_SAS','Hg2_SAT','Hg2_SEA','Hg2_SO','Hg2_SOV','Hg2_STR','Hg2_USA','Hg2_WAF','HI','HMHP','HMML','HNO3','HOBr','HOCl','HOI','HONIT','HPETHNL','I2','I2O2','I2O3','I2O4','IBr','ICHE','ICl','ICN','ICPDH','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','ITCN','ITHN','LIMO','LVOC','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MEK','MGLY','MOH','MONITS','MONITU','MP','MPAN','MPN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','NH3','OPOG1','OPOG2','PAN','POG1','POG2','POPG_BAP','POPG_PHE','POPG_PYR','PP','PPN','PROPNN','PRPE','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2','TSOG0','TSOG1','TSOG2','TSOG3','AERI','ASOA1','ASOA2','ASOA3','ASOAN','BCPI','BCPO','Be10','Be10Strat','Be7','Be7Strat','BrSALA','BrSALC','DST1','DST2','DST3','DST4','DSTAL1','DSTAL2','DSTAL3','DSTAL4','HgP','HgP_ANT','HgP_ARC','HgP_ATL','HgP_BB','HgP_CAM','HgP_CAN','HgP_EAF','HgP_EAS','HgP_EEU','HgP_EUR','HgP_GEO','HgP_JPN','HgP_MDE','HgP_NAF','HgP_NAT','HgP_NPA','HgP_OCE','HgP_OCN','HgP_SAF','HgP_SAM','HgP_SAS','HgP_SAT','HgP_SEA','HgP_SO','HgP_SOV','HgP_STR','HgP_USA','HgP_WAF','INDIOL','IONITA','ISALA','ISALC','LVOCOA','MONITA','MOPI','MOPO','MSA','NH4','NIT','NITD1','NITD2','NITD3','NITD4','NITs','OCPI','OCPO','OPOA1','OPOA2','Pb210','Pb210Strat','pFe','POA1','POA2','POPPBCPI_BAP','POPPBCPI_PHE','POPPBCPI_PYR','POPPBCPO_BAP','POPPBCPO_PHE','POPPBCPO_PYR','POPPOCPI_BAP','POPPOCPI_PHE','POPPOCPI_PYR','POPPOCPO_BAP','POPPOCPO_PHE','POPPOCPO_PYR','SALA','SALAAL','SALACL','SALC','SALCAL','SALCCL','SO4','SO4D1','SO4D2','SO4D3','SO4D4','SO4S','SOAGX','SOAIE','SOAS','TSOA0','TSOA1','TSOA2','TSOA3', + 'ACTA','ALD2','ASOG1','ASOG2','ASOG3','ATOOH','BR2','BRCL','CH2O','EOH','ETHLN','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HG2','HG2_ANT','HG2_ARC','HG2_ATL','HG2_BB','HG2_CAM','HG2_CAN','HG2_EAF','HG2_EAS','HG2_EEU','HG2_EUR','HG2_GEO','HG2_JPN','HG2_MDE','HG2_NAF','HG2_NAT','HG2_NPA','HG2_OCE','HG2_OCN','HG2_SAF','HG2_SAM','HG2_SAS','HG2_SAT','HG2_SEA','HG2_SO','HG2_SOV','HG2_STR','HG2_USA','HG2_WAF','HI','HMHP','HMML','HNO3','HOBR','HOCL','HOI','HONIT','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','ITCN','ITHN','LIMO','LVOC','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MEK','MGLY','MOH','MONITS','MONITU','MP','MPAN','MPN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','NH3','OPOG1','OPOG2','PAN','POG1','POG2','POPG_BAP','POPG_PHE','POPG_PYR','PP','PPN','PROPNN','PRPE','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2','TSOG0','TSOG1','TSOG2','TSOG3','AERI','ASOA1','ASOA2','ASOA3','ASOAN','BCPI','BCPO','BE10','BE10STRAT','BE7','BE7STRAT','BRSALA','BRSALC','DST1','DST2','DST3','DST4','DSTAL1','DSTAL2','DSTAL3','DSTAL4','HGP','HGP_ANT','HGP_ARC','HGP_ATL','HGP_BB','HGP_CAM','HGP_CAN','HGP_EAF','HGP_EAS','HGP_EEU','HGP_EUR','HGP_GEO','HGP_JPN','HGP_MDE','HGP_NAF','HGP_NAT','HGP_NPA','HGP_OCE','HGP_OCN','HGP_SAF','HGP_SAM','HGP_SAS','HGP_SAT','HGP_SEA','HGP_SO','HGP_SOV','HGP_STR','HGP_USA','HGP_WAF','INDIOL','IONITA','ISALA','ISALC','LVOCOA','MONITA','MOPI','MOPO','MSA','NH4','NIT','NITD1','NITD2','NITD3','NITD4','NITS','OCPI','OCPO','OPOA1','OPOA2','PB210','PB210STRAT','PFE','POA1','POA2','POPPBCPI_BAP','POPPBCPI_PHE','POPPBCPI_PYR','POPPBCPO_BAP','POPPBCPO_PHE','POPPBCPO_PYR','POPPOCPI_BAP','POPPOCPI_PHE','POPPOCPI_PYR','POPPOCPO_BAP','POPPOCPO_PHE','POPPOCPO_PYR','SALA','SALAAL','SALACL','SALC','SALCAL','SALCCL','SO4','SO4D1','SO4D2','SO4D3','SO4D4','SO4S','SOAGX','SOAIE','SOAS','TSOA0','TSOA1','TSOA2','TSOA3', diff --git a/bld/namelist_files/use_cases/hist_geoschem.xml b/bld/namelist_files/use_cases/hist_geoschem.xml index 606e409b36..8d8dce5377 100644 --- a/bld/namelist_files/use_cases/hist_geoschem.xml +++ b/bld/namelist_files/use_cases/hist_geoschem.xml @@ -27,7 +27,7 @@ INTERP_MISSING_MONTHS - + INTERP_MISSING_MONTHS 'noy', 'nhx' @@ -82,8 +82,8 @@ 'EXTINCTNIRdn', 'EXTINCTUVdn', 'WD_EOH', 'WD_ETP', 'WD_RA3P', 'WD_CH2O', 'WD_ALD2', 'WD_MGLY', 'WD_ACTA', 'WD_MAP', 'WD_MOH', 'WD_MP', - 'WD_GLYC', 'WD_H2O2', 'WD_SO4', 'WD_HBr', 'WD_HCl', - 'WD_HNO3', 'WD_HOBr', 'WD_HOCl', 'WD_HONIT', 'WD_HAC', 'WD_IEPOXA', + 'WD_GLYC', 'WD_H2O2', 'WD_SO4', 'WD_HBR', 'WD_HCL', + 'WD_HNO3', 'WD_HOBR', 'WD_HOCL', 'WD_HONIT', 'WD_HAC', 'WD_IEPOXA', 'WD_IEPOXB', 'WD_IEPOXD', 'WD_MVK', 'WD_NH3', 'WD_NH4', 'WD_SO2', 'DF_EOH', 'DF_ETP', 'DF_RA3P', 'DF_CH2O', 'DF_ALD2', 'DF_ACET', 'DF_MGLY', 'DF_ACTA', 'DF_MAP', 'DF_MOH', 'DF_MP', 'DF_CO', @@ -154,7 +154,7 @@ 'so4_a2_CHMP', 'so4_a3_CHMP', 'H2SO4_sfnnuc1', 'num_a2_sfnnuc1', --> - 'ACET','ACTA','ALD2','ASOG1','ASOG2','ASOG3','ATOOH','Br2','BrCl','BrNO3','CH2O','Cl2','ClNO2','ClNO3','ClO','ClOO','EOH','ETHLN','ETNO3','ETP','GLYC','GLYX','H2O2','HAC','HBr','HC5A','HCl','HCOOH','Hg0','Hg0_ANT','Hg0_ARC','Hg0_ATL','Hg0_BB','Hg0_CAM','Hg0_CAN','Hg0_EAF','Hg0_EAS','Hg0_EEU','Hg0_EUR','Hg0_GEO','Hg0_JPN','Hg0_MDE','Hg0_NAF','Hg0_NAT','Hg0_NPA','Hg0_OCE','Hg0_OCN','Hg0_SAF','Hg0_SAM','Hg0_SAS','Hg0_SAT','Hg0_SEA','Hg0_SO','Hg0_SOV','Hg0_STR','Hg0_USA','Hg0_WAF','Hg2','Hg2_ANT','Hg2_ARC','Hg2_ATL','Hg2_BB','Hg2_CAM','Hg2_CAN','Hg2_EAF','Hg2_EAS','Hg2_EEU','Hg2_EUR','Hg2_GEO','Hg2_JPN','Hg2_MDE','Hg2_NAF','Hg2_NAT','Hg2_NPA','Hg2_OCE','Hg2_OCN','Hg2_SAF','Hg2_SAM','Hg2_SAS','Hg2_SAT','Hg2_SEA','Hg2_SO','Hg2_SOV','Hg2_STR','Hg2_USA','Hg2_WAF','HI','HMHP','HMML','HNO3','HOBr','HOCl','HOI','HONIT','HPALD1','HPALD2','HPALD3','HPALD4','HPETHNL','I2','I2O2','I2O3','I2O4','IBr','ICHE','ICl','ICN','ICPDH','IDC','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','IPRNO3','ITCN','ITHN','LIMO','LVOC','MACR','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MENO3','MGLY','MOH','MONITS','MONITU','MPAN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','N2O5','NH3','NO2','NPRNO3','O3','O3AFBL','O3ASBL','O3ATBL','O3EUBL','O3INIT','O3MT','O3NABL','O3PCBL','O3ROW','O3Strat','O3USA','O3UT','OPOG1','OPOG2','PAN','POG1','POG2','POPG_BAP','POPG_PHE','POPG_PYR','PP','PPN','PROPNN','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2','TSOG0','TSOG1','TSOG2','TSOG3','AERI','ASOA1','ASOA2','ASOA3','ASOAN','BCPI','BCPO','Be10','Be10Strat','Be7','Be7Strat','BrSALA','BrSALC','DST1','DST2','DST3','DST4','DSTAL1','DSTAL2','DSTAL3','DSTAL4','HgP','HgP_ANT','HgP_ARC','HgP_ATL','HgP_BB','HgP_CAM','HgP_CAN','HgP_EAF','HgP_EAS','HgP_EEU','HgP_EUR','HgP_GEO','HgP_JPN','HgP_MDE','HgP_NAF','HgP_NAT','HgP_NPA','HgP_OCE','HgP_OCN','HgP_SAF','HgP_SAM','HgP_SAS','HgP_SAT','HgP_SEA','HgP_SO','HgP_SOV','HgP_STR','HgP_USA','HgP_WAF','INDIOL','IONITA','ISALA','ISALC','LVOCOA','MONITA','MOPI','MOPO','MSA','NH4','NIT','NITD1','NITD2','NITD3','NITD4','NITs','OCPI','OCPO','OPOA1','OPOA2','Pb210','Pb210Strat','pFe','POA1','POA2','POPPBCPI_BAP','POPPBCPI_PHE','POPPBCPI_PYR','POPPBCPO_BAP','POPPBCPO_PHE','POPPBCPO_PYR','POPPOCPI_BAP','POPPOCPI_PHE','POPPOCPI_PYR','POPPOCPO_BAP','POPPOCPO_PHE','POPPOCPO_PYR','SALA','SALAAL','SALACL','SALC','SALCAL','SALCCL','SO4','SO4D1','SO4D2','SO4D3','SO4D4','SO4S','SOAGX','SOAIE','SOAS','TSOA0','TSOA1','TSOA2','TSOA3', + 'ACET','ACTA','ALD2','ASOG1','ASOG2','ASOG3','ATOOH','BR2','BRCL','BRNO3','CH2O','CL2','CLNO2','CLNO3','CLO','CLOO','EOH','ETHLN','ETNO3','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HG0','HG0_ANT','HG0_ARC','HG0_ATL','HG0_BB','HG0_CAM','HG0_CAN','HG0_EAF','HG0_EAS','HG0_EEU','HG0_EUR','HG0_GEO','HG0_JPN','HG0_MDE','HG0_NAF','HG0_NAT','HG0_NPA','HG0_OCE','HG0_OCN','HG0_SAF','HG0_SAM','HG0_SAS','HG0_SAT','HG0_SEA','HG0_SO','HG0_SOV','HG0_STR','HG0_USA','HG0_WAF','HG2','HG2_ANT','HG2_ARC','HG2_ATL','HG2_BB','HG2_CAM','HG2_CAN','HG2_EAF','HG2_EAS','HG2_EEU','HG2_EUR','HG2_GEO','HG2_JPN','HG2_MDE','HG2_NAF','HG2_NAT','HG2_NPA','HG2_OCE','HG2_OCN','HG2_SAF','HG2_SAM','HG2_SAS','HG2_SAT','HG2_SEA','HG2_SO','HG2_SOV','HG2_STR','HG2_USA','HG2_WAF','HI','HMHP','HMML','HNO3','HOBR','HOCL','HOI','HONIT','HPALD1','HPALD2','HPALD3','HPALD4','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDC','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','IPRNO3','ITCN','ITHN','LIMO','LVOC','MACR','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MENO3','MGLY','MOH','MONITS','MONITU','MPAN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','N2O5','NH3','NO2','NPRNO3','O3','O3AFBL','O3ASBL','O3ATBL','O3EUBL','O3INIT','O3MT','O3NABL','O3PCBL','O3ROW','O3STRAT','O3USA','O3UT','OPOG1','OPOG2','PAN','POG1','POG2','POPG_BAP','POPG_PHE','POPG_PYR','PP','PPN','PROPNN','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2','TSOG0','TSOG1','TSOG2','TSOG3','AERI','ASOA1','ASOA2','ASOA3','ASOAN','BCPI','BCPO','BE10','BE10STRAT','BE7','BE7STRAT','BRSALA','BRSALC','DST1','DST2','DST3','DST4','DSTAL1','DSTAL2','DSTAL3','DSTAL4','HGP','HGP_ANT','HGP_ARC','HGP_ATL','HGP_BB','HGP_CAM','HGP_CAN','HGP_EAF','HGP_EAS','HGP_EEU','HGP_EUR','HGP_GEO','HGP_JPN','HGP_MDE','HGP_NAF','HGP_NAT','HGP_NPA','HGP_OCE','HGP_OCN','HGP_SAF','HGP_SAM','HGP_SAS','HGP_SAT','HGP_SEA','HGP_SO','HGP_SOV','HGP_STR','HGP_USA','HGP_WAF','INDIOL','IONITA','ISALA','ISALC','LVOCOA','MONITA','MOPI','MOPO','MSA','NH4','NIT','NITD1','NITD2','NITD3','NITD4','NITS','OCPI','OCPO','OPOA1','OPOA2','PB210','PB210STRAT','PFE','POA1','POA2','POPPBCPI_BAP','POPPBCPI_PHE','POPPBCPI_PYR','POPPBCPO_BAP','POPPBCPO_PHE','POPPBCPO_PYR','POPPOCPI_BAP','POPPOCPI_PHE','POPPOCPI_PYR','POPPOCPO_BAP','POPPOCPO_PHE','POPPOCPO_PYR','SALA','SALAAL','SALACL','SALC','SALCAL','SALCCL','SO4','SO4D1','SO4D2','SO4D3','SO4D4','SO4S','SOAGX','SOAIE','SOAS','TSOA0','TSOA1','TSOA2','TSOA3', @@ -162,7 +162,7 @@ - 'ACTA','ALD2','ASOG1','ASOG2','ASOG3','ATOOH','Br2','BrCl','CH2O','EOH','ETHLN','ETP','GLYC','GLYX','H2O2','HAC','HBr','HC5A','HCl','HCOOH','Hg2','Hg2_ANT','Hg2_ARC','Hg2_ATL','Hg2_BB','Hg2_CAM','Hg2_CAN','Hg2_EAF','Hg2_EAS','Hg2_EEU','Hg2_EUR','Hg2_GEO','Hg2_JPN','Hg2_MDE','Hg2_NAF','Hg2_NAT','Hg2_NPA','Hg2_OCE','Hg2_OCN','Hg2_SAF','Hg2_SAM','Hg2_SAS','Hg2_SAT','Hg2_SEA','Hg2_SO','Hg2_SOV','Hg2_STR','Hg2_USA','Hg2_WAF','HI','HMHP','HMML','HNO3','HOBr','HOCl','HOI','HONIT','HPETHNL','I2','I2O2','I2O3','I2O4','IBr','ICHE','ICl','ICN','ICPDH','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','ITCN','ITHN','LIMO','LVOC','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MEK','MGLY','MOH','MONITS','MONITU','MP','MPAN','MPN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','NH3','OPOG1','OPOG2','PAN','POG1','POG2','POPG_BAP','POPG_PHE','POPG_PYR','PP','PPN','PROPNN','PRPE','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2','TSOG0','TSOG1','TSOG2','TSOG3','AERI','ASOA1','ASOA2','ASOA3','ASOAN','BCPI','BCPO','Be10','Be10Strat','Be7','Be7Strat','BrSALA','BrSALC','DST1','DST2','DST3','DST4','DSTAL1','DSTAL2','DSTAL3','DSTAL4','HgP','HgP_ANT','HgP_ARC','HgP_ATL','HgP_BB','HgP_CAM','HgP_CAN','HgP_EAF','HgP_EAS','HgP_EEU','HgP_EUR','HgP_GEO','HgP_JPN','HgP_MDE','HgP_NAF','HgP_NAT','HgP_NPA','HgP_OCE','HgP_OCN','HgP_SAF','HgP_SAM','HgP_SAS','HgP_SAT','HgP_SEA','HgP_SO','HgP_SOV','HgP_STR','HgP_USA','HgP_WAF','INDIOL','IONITA','ISALA','ISALC','LVOCOA','MONITA','MOPI','MOPO','MSA','NH4','NIT','NITD1','NITD2','NITD3','NITD4','NITs','OCPI','OCPO','OPOA1','OPOA2','Pb210','Pb210Strat','pFe','POA1','POA2','POPPBCPI_BAP','POPPBCPI_PHE','POPPBCPI_PYR','POPPBCPO_BAP','POPPBCPO_PHE','POPPBCPO_PYR','POPPOCPI_BAP','POPPOCPI_PHE','POPPOCPI_PYR','POPPOCPO_BAP','POPPOCPO_PHE','POPPOCPO_PYR','SALA','SALAAL','SALACL','SALC','SALCAL','SALCCL','SO4','SO4D1','SO4D2','SO4D3','SO4D4','SO4S','SOAGX','SOAIE','SOAS','TSOA0','TSOA1','TSOA2','TSOA3', + 'ACTA','ALD2','ASOG1','ASOG2','ASOG3','ATOOH','BR2','BRCL','CH2O','EOH','ETHLN','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HG2','HG2_ANT','HG2_ARC','HG2_ATL','HG2_BB','HG2_CAM','HG2_CAN','HG2_EAF','HG2_EAS','HG2_EEU','HG2_EUR','HG2_GEO','HG2_JPN','HG2_MDE','HG2_NAF','HG2_NAT','HG2_NPA','HG2_OCE','HG2_OCN','HG2_SAF','HG2_SAM','HG2_SAS','HG2_SAT','HG2_SEA','HG2_SO','HG2_SOV','HG2_STR','HG2_USA','HG2_WAF','HI','HMHP','HMML','HNO3','HOBR','HOCL','HOI','HONIT','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','ITCN','ITHN','LIMO','LVOC','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MEK','MGLY','MOH','MONITS','MONITU','MP','MPAN','MPN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','NH3','OPOG1','OPOG2','PAN','POG1','POG2','POPG_BAP','POPG_PHE','POPG_PYR','PP','PPN','PROPNN','PRPE','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2','TSOG0','TSOG1','TSOG2','TSOG3','AERI','ASOA1','ASOA2','ASOA3','ASOAN','BCPI','BCPO','BE10','BE10STRAT','BE7','BE7STRAT','BRSALA','BRSALC','DST1','DST2','DST3','DST4','DSTAL1','DSTAL2','DSTAL3','DSTAL4','HGP','HGP_ANT','HGP_ARC','HGP_ATL','HGP_BB','HGP_CAM','HGP_CAN','HGP_EAF','HGP_EAS','HGP_EEU','HGP_EUR','HGP_GEO','HGP_JPN','HGP_MDE','HGP_NAF','HGP_NAT','HGP_NPA','HGP_OCE','HGP_OCN','HGP_SAF','HGP_SAM','HGP_SAS','HGP_SAT','HGP_SEA','HGP_SO','HGP_SOV','HGP_STR','HGP_USA','HGP_WAF','INDIOL','IONITA','ISALA','ISALC','LVOCOA','MONITA','MOPI','MOPO','MSA','NH4','NIT','NITD1','NITD2','NITD3','NITD4','NITS','OCPI','OCPO','OPOA1','OPOA2','PB210','PB210STRAT','PFE','POA1','POA2','POPPBCPI_BAP','POPPBCPI_PHE','POPPBCPI_PYR','POPPBCPO_BAP','POPPBCPO_PHE','POPPBCPO_PYR','POPPOCPI_BAP','POPPOCPI_PHE','POPPOCPI_PYR','POPPOCPO_BAP','POPPOCPO_PHE','POPPOCPO_PYR','SALA','SALAAL','SALACL','SALC','SALCAL','SALCCL','SO4','SO4D1','SO4D2','SO4D3','SO4D4','SO4S','SOAGX','SOAIE','SOAS','TSOA0','TSOA1','TSOA2','TSOA3', diff --git a/bld/namelist_files/use_cases/sd_geoschem.xml b/bld/namelist_files/use_cases/sd_geoschem.xml index 40d1799727..02c3508e54 100644 --- a/bld/namelist_files/use_cases/sd_geoschem.xml +++ b/bld/namelist_files/use_cases/sd_geoschem.xml @@ -39,7 +39,7 @@ INTERP_MISSING_MONTHS - + INTERP_MISSING_MONTHS @@ -92,8 +92,8 @@ 'EXTINCTNIRdn', 'EXTINCTUVdn', 'WD_EOH', 'WD_ETP', 'WD_RA3P', 'WD_CH2O', 'WD_ALD2', 'WD_MGLY', 'WD_ACTA', 'WD_MAP', 'WD_MOH', 'WD_MP', - 'WD_GLYC', 'WD_H2O2', 'WD_SO4', 'WD_HBr', 'WD_HCl', - 'WD_HNO3', 'WD_HOBr', 'WD_HOCl', 'WD_HONIT', 'WD_HAC', 'WD_IEPOXA', + 'WD_GLYC', 'WD_H2O2', 'WD_SO4', 'WD_HBR', 'WD_HCL', + 'WD_HNO3', 'WD_HOBR', 'WD_HOCL', 'WD_HONIT', 'WD_HAC', 'WD_IEPOXA', 'WD_IEPOXB', 'WD_IEPOXD', 'WD_MVK', 'WD_NH3', 'WD_NH4', 'WD_SO2', 'DF_EOH', 'DF_ETP', 'DF_RA3P', 'DF_CH2O', 'DF_ALD2', 'DF_ACET', 'DF_MGLY', 'DF_ACTA', 'DF_MAP', 'DF_MOH', 'DF_MP', 'DF_CO', @@ -159,7 +159,7 @@ - 'ACET','ACTA','ALD2','ASOG1','ASOG2','ASOG3','ATOOH','Br2','BrCl','BrNO3','CH2O','Cl2','ClNO2','ClNO3','ClO','ClOO','EOH','ETHLN','ETNO3','ETP','GLYC','GLYX','H2O2','HAC','HBr','HC5A','HCl','HCOOH','Hg0','Hg0_ANT','Hg0_ARC','Hg0_ATL','Hg0_BB','Hg0_CAM','Hg0_CAN','Hg0_EAF','Hg0_EAS','Hg0_EEU','Hg0_EUR','Hg0_GEO','Hg0_JPN','Hg0_MDE','Hg0_NAF','Hg0_NAT','Hg0_NPA','Hg0_OCE','Hg0_OCN','Hg0_SAF','Hg0_SAM','Hg0_SAS','Hg0_SAT','Hg0_SEA','Hg0_SO','Hg0_SOV','Hg0_STR','Hg0_USA','Hg0_WAF','Hg2','Hg2_ANT','Hg2_ARC','Hg2_ATL','Hg2_BB','Hg2_CAM','Hg2_CAN','Hg2_EAF','Hg2_EAS','Hg2_EEU','Hg2_EUR','Hg2_GEO','Hg2_JPN','Hg2_MDE','Hg2_NAF','Hg2_NAT','Hg2_NPA','Hg2_OCE','Hg2_OCN','Hg2_SAF','Hg2_SAM','Hg2_SAS','Hg2_SAT','Hg2_SEA','Hg2_SO','Hg2_SOV','Hg2_STR','Hg2_USA','Hg2_WAF','HI','HMHP','HMML','HNO3','HOBr','HOCl','HOI','HONIT','HPALD1','HPALD2','HPALD3','HPALD4','HPETHNL','I2','I2O2','I2O3','I2O4','IBr','ICHE','ICl','ICN','ICPDH','IDC','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','IPRNO3','ITCN','ITHN','LIMO','LVOC','MACR','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MENO3','MGLY','MOH','MONITS','MONITU','MPAN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','N2O5','NH3','NO2','NPRNO3','O3','O3AFBL','O3ASBL','O3ATBL','O3EUBL','O3INIT','O3MT','O3NABL','O3PCBL','O3ROW','O3Strat','O3USA','O3UT','OPOG1','OPOG2','PAN','POG1','POG2','POPG_BAP','POPG_PHE','POPG_PYR','PP','PPN','PROPNN','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2','TSOG0','TSOG1','TSOG2','TSOG3','AERI','ASOA1','ASOA2','ASOA3','ASOAN','BCPI','BCPO','Be10','Be10Strat','Be7','Be7Strat','BrSALA','BrSALC','DST1','DST2','DST3','DST4','DSTAL1','DSTAL2','DSTAL3','DSTAL4','HgP','HgP_ANT','HgP_ARC','HgP_ATL','HgP_BB','HgP_CAM','HgP_CAN','HgP_EAF','HgP_EAS','HgP_EEU','HgP_EUR','HgP_GEO','HgP_JPN','HgP_MDE','HgP_NAF','HgP_NAT','HgP_NPA','HgP_OCE','HgP_OCN','HgP_SAF','HgP_SAM','HgP_SAS','HgP_SAT','HgP_SEA','HgP_SO','HgP_SOV','HgP_STR','HgP_USA','HgP_WAF','INDIOL','IONITA','ISALA','ISALC','LVOCOA','MONITA','MOPI','MOPO','MSA','NH4','NIT','NITD1','NITD2','NITD3','NITD4','NITs','OCPI','OCPO','OPOA1','OPOA2','Pb210','Pb210Strat','pFe','POA1','POA2','POPPBCPI_BAP','POPPBCPI_PHE','POPPBCPI_PYR','POPPBCPO_BAP','POPPBCPO_PHE','POPPBCPO_PYR','POPPOCPI_BAP','POPPOCPI_PHE','POPPOCPI_PYR','POPPOCPO_BAP','POPPOCPO_PHE','POPPOCPO_PYR','SALA','SALAAL','SALACL','SALC','SALCAL','SALCCL','SO4','SO4D1','SO4D2','SO4D3','SO4D4','SO4S','SOAGX','SOAIE','SOAS','TSOA0','TSOA1','TSOA2','TSOA3', + 'ACET','ACTA','ALD2','ASOG1','ASOG2','ASOG3','ATOOH','BR2','BRCL','BRNO3','CH2O','CL2','CLNO2','CLNO3','CLO','CLOO','EOH','ETHLN','ETNO3','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HG0','HG0_ANT','HG0_ARC','HG0_ATL','HG0_BB','HG0_CAM','HG0_CAN','HG0_EAF','HG0_EAS','HG0_EEU','HG0_EUR','HG0_GEO','HG0_JPN','HG0_MDE','HG0_NAF','HG0_NAT','HG0_NPA','HG0_OCE','HG0_OCN','HG0_SAF','HG0_SAM','HG0_SAS','HG0_SAT','HG0_SEA','HG0_SO','HG0_SOV','HG0_STR','HG0_USA','HG0_WAF','HG2','HG2_ANT','HG2_ARC','HG2_ATL','HG2_BB','HG2_CAM','HG2_CAN','HG2_EAF','HG2_EAS','HG2_EEU','HG2_EUR','HG2_GEO','HG2_JPN','HG2_MDE','HG2_NAF','HG2_NAT','HG2_NPA','HG2_OCE','HG2_OCN','HG2_SAF','HG2_SAM','HG2_SAS','HG2_SAT','HG2_SEA','HG2_SO','HG2_SOV','HG2_STR','HG2_USA','HG2_WAF','HI','HMHP','HMML','HNO3','HOBR','HOCL','HOI','HONIT','HPALD1','HPALD2','HPALD3','HPALD4','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDC','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','IPRNO3','ITCN','ITHN','LIMO','LVOC','MACR','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MENO3','MGLY','MOH','MONITS','MONITU','MPAN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','N2O5','NH3','NO2','NPRNO3','O3','O3AFBL','O3ASBL','O3ATBL','O3EUBL','O3INIT','O3MT','O3NABL','O3PCBL','O3ROW','O3STRAT','O3USA','O3UT','OPOG1','OPOG2','PAN','POG1','POG2','POPG_BAP','POPG_PHE','POPG_PYR','PP','PPN','PROPNN','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2','TSOG0','TSOG1','TSOG2','TSOG3','AERI','ASOA1','ASOA2','ASOA3','ASOAN','BCPI','BCPO','BE10','BE10STRAT','BE7','BE7STRAT','BRSALA','BRSALC','DST1','DST2','DST3','DST4','DSTAL1','DSTAL2','DSTAL3','DSTAL4','HGP','HGP_ANT','HGP_ARC','HGP_ATL','HGP_BB','HGP_CAM','HGP_CAN','HGP_EAF','HGP_EAS','HGP_EEU','HGP_EUR','HGP_GEO','HGP_JPN','HGP_MDE','HGP_NAF','HGP_NAT','HGP_NPA','HGP_OCE','HGP_OCN','HGP_SAF','HGP_SAM','HGP_SAS','HGP_SAT','HGP_SEA','HGP_SO','HGP_SOV','HGP_STR','HGP_USA','HGP_WAF','INDIOL','IONITA','ISALA','ISALC','LVOCOA','MONITA','MOPI','MOPO','MSA','NH4','NIT','NITD1','NITD2','NITD3','NITD4','NITS','OCPI','OCPO','OPOA1','OPOA2','PB210','PB210STRAT','PFE','POA1','POA2','POPPBCPI_BAP','POPPBCPI_PHE','POPPBCPI_PYR','POPPBCPO_BAP','POPPBCPO_PHE','POPPBCPO_PYR','POPPOCPI_BAP','POPPOCPI_PHE','POPPOCPI_PYR','POPPOCPO_BAP','POPPOCPO_PHE','POPPOCPO_PYR','SALA','SALAAL','SALACL','SALC','SALCAL','SALCCL','SO4','SO4D1','SO4D2','SO4D3','SO4D4','SO4S','SOAGX','SOAIE','SOAS','TSOA0','TSOA1','TSOA2','TSOA3', @@ -167,7 +167,7 @@ - 'ACTA','ALD2','ASOG1','ASOG2','ASOG3','ATOOH','Br2','BrCl','CH2O','EOH','ETHLN','ETP','GLYC','GLYX','H2O2','HAC','HBr','HC5A','HCl','HCOOH','Hg2','Hg2_ANT','Hg2_ARC','Hg2_ATL','Hg2_BB','Hg2_CAM','Hg2_CAN','Hg2_EAF','Hg2_EAS','Hg2_EEU','Hg2_EUR','Hg2_GEO','Hg2_JPN','Hg2_MDE','Hg2_NAF','Hg2_NAT','Hg2_NPA','Hg2_OCE','Hg2_OCN','Hg2_SAF','Hg2_SAM','Hg2_SAS','Hg2_SAT','Hg2_SEA','Hg2_SO','Hg2_SOV','Hg2_STR','Hg2_USA','Hg2_WAF','HI','HMHP','HMML','HNO3','HOBr','HOCl','HOI','HONIT','HPETHNL','I2','I2O2','I2O3','I2O4','IBr','ICHE','ICl','ICN','ICPDH','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','ITCN','ITHN','LIMO','LVOC','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MEK','MGLY','MOH','MONITS','MONITU','MP','MPAN','MPN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','NH3','OPOG1','OPOG2','PAN','POG1','POG2','POPG_BAP','POPG_PHE','POPG_PYR','PP','PPN','PROPNN','PRPE','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2','TSOG0','TSOG1','TSOG2','TSOG3','AERI','ASOA1','ASOA2','ASOA3','ASOAN','BCPI','BCPO','Be10','Be10Strat','Be7','Be7Strat','BrSALA','BrSALC','DST1','DST2','DST3','DST4','DSTAL1','DSTAL2','DSTAL3','DSTAL4','HgP','HgP_ANT','HgP_ARC','HgP_ATL','HgP_BB','HgP_CAM','HgP_CAN','HgP_EAF','HgP_EAS','HgP_EEU','HgP_EUR','HgP_GEO','HgP_JPN','HgP_MDE','HgP_NAF','HgP_NAT','HgP_NPA','HgP_OCE','HgP_OCN','HgP_SAF','HgP_SAM','HgP_SAS','HgP_SAT','HgP_SEA','HgP_SO','HgP_SOV','HgP_STR','HgP_USA','HgP_WAF','INDIOL','IONITA','ISALA','ISALC','LVOCOA','MONITA','MOPI','MOPO','MSA','NH4','NIT','NITD1','NITD2','NITD3','NITD4','NITs','OCPI','OCPO','OPOA1','OPOA2','Pb210','Pb210Strat','pFe','POA1','POA2','POPPBCPI_BAP','POPPBCPI_PHE','POPPBCPI_PYR','POPPBCPO_BAP','POPPBCPO_PHE','POPPBCPO_PYR','POPPOCPI_BAP','POPPOCPI_PHE','POPPOCPI_PYR','POPPOCPO_BAP','POPPOCPO_PHE','POPPOCPO_PYR','SALA','SALAAL','SALACL','SALC','SALCAL','SALCCL','SO4','SO4D1','SO4D2','SO4D3','SO4D4','SO4S','SOAGX','SOAIE','SOAS','TSOA0','TSOA1','TSOA2','TSOA3', + 'ACTA','ALD2','ASOG1','ASOG2','ASOG3','ATOOH','BR2','BRCL','CH2O','EOH','ETHLN','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HG2','HG2_ANT','HG2_ARC','HG2_ATL','HG2_BB','HG2_CAM','HG2_CAN','HG2_EAF','HG2_EAS','HG2_EEU','HG2_EUR','HG2_GEO','HG2_JPN','HG2_MDE','HG2_NAF','HG2_NAT','HG2_NPA','HG2_OCE','HG2_OCN','HG2_SAF','HG2_SAM','HG2_SAS','HG2_SAT','HG2_SEA','HG2_SO','HG2_SOV','HG2_STR','HG2_USA','HG2_WAF','HI','HMHP','HMML','HNO3','HOBR','HOCL','HOI','HONIT','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','ITCN','ITHN','LIMO','LVOC','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MEK','MGLY','MOH','MONITS','MONITU','MP','MPAN','MPN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','NH3','OPOG1','OPOG2','PAN','POG1','POG2','POPG_BAP','POPG_PHE','POPG_PYR','PP','PPN','PROPNN','PRPE','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2','TSOG0','TSOG1','TSOG2','TSOG3','AERI','ASOA1','ASOA2','ASOA3','ASOAN','BCPI','BCPO','BE10','BE10STRAT','BE7','BE7STRAT','BRSALA','BRSALC','DST1','DST2','DST3','DST4','DSTAL1','DSTAL2','DSTAL3','DSTAL4','HGP','HGP_ANT','HGP_ARC','HGP_ATL','HGP_BB','HGP_CAM','HGP_CAN','HGP_EAF','HGP_EAS','HGP_EEU','HGP_EUR','HGP_GEO','HGP_JPN','HGP_MDE','HGP_NAF','HGP_NAT','HGP_NPA','HGP_OCE','HGP_OCN','HGP_SAF','HGP_SAM','HGP_SAS','HGP_SAT','HGP_SEA','HGP_SO','HGP_SOV','HGP_STR','HGP_USA','HGP_WAF','INDIOL','IONITA','ISALA','ISALC','LVOCOA','MONITA','MOPI','MOPO','MSA','NH4','NIT','NITD1','NITD2','NITD3','NITD4','NITS','OCPI','OCPO','OPOA1','OPOA2','PB210','PB210STRAT','PFE','POA1','POA2','POPPBCPI_BAP','POPPBCPI_PHE','POPPBCPI_PYR','POPPBCPO_BAP','POPPBCPO_PHE','POPPBCPO_PYR','POPPOCPI_BAP','POPPOCPI_PHE','POPPOCPI_PYR','POPPOCPO_BAP','POPPOCPO_PHE','POPPOCPO_PYR','SALA','SALAAL','SALACL','SALC','SALCAL','SALCCL','SO4','SO4D1','SO4D2','SO4D3','SO4D4','SO4S','SOAGX','SOAIE','SOAS','TSOA0','TSOA1','TSOA2','TSOA3', diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index c700a521ea..2ba9e9a0e7 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -210,7 +210,7 @@ waccm_ma_2000_cam6 waccm_sc_2000_cam6 2000_trop_strat_vbs_cam6 - geoschem_2000 + geoschem aquaplanet_cam4 aquaplanet_cam4 diff --git a/src/chemistry/geoschem/chemistry.F90 b/src/chemistry/geoschem/chemistry.F90 index ad23371913..ef153018e7 100644 --- a/src/chemistry/geoschem/chemistry.F90 +++ b/src/chemistry/geoschem/chemistry.F90 @@ -333,7 +333,7 @@ subroutine chem_register DO I = 1, nTracersMax IF ( I .LE. nTracers ) THEN - cnstName = TRIM(tracerNames(I)) + cnstName = to_upper(TRIM(tracerNames(I))) trueName = cnstName N = Ind_(cnstName) ThisSpc => SC%SpcData(N)%Info @@ -2036,7 +2036,6 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) TYPE(physics_buffer_desc), POINTER :: pbuf_chnk(:) ! slice of pbuf in chnk REAL(r8), POINTER :: pbuf_ik(:,:) ! ptr to pbuf data (/pcols,pver/) INTEGER :: tmpIdx ! pbuf field id - CHARACTER(LEN=255) :: fldname_ns ! field name INTEGER :: TIM_NDX INTEGER :: IERR @@ -2442,11 +2441,10 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) ENDIF ELSE DO N = 1, NSURFTYPE - Write(fldname_ns, '(a,i2.2)') 'HCO_LANDTYPE', N-1 - tmpIdx = pbuf_get_index(fldname_ns, rc) - IF ( tmpIdx < 0 ) THEN - ! there is an error here and the field was not found - IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(fldname_ns) + Write(FieldName, '(a,i2.2)') 'HCO_LANDTYPE', N-1 + tmpIdx = pbuf_get_index(FieldName, rc) + IF ( tmpIdx < 0 .or. ( iStep == 1 ) ) THEN + IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(FieldName) ELSE CALL pbuf_get_field(pbuf, tmpIdx, pbuf_ik) DO J = 1, nY @@ -2457,23 +2455,21 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) pbuf_ik => NULL() ENDIF - Write(fldname_ns, '(a,i2.2)') 'HCO_XLAI', N-1 - tmpIdx = pbuf_get_index(fldname_ns, rc) - IF ( tmpIdx < 0 ) THEN - ! there is an error here and the field was not found - IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(fldname_ns) - - ELSE - CALL pbuf_get_field(pbuf, tmpIdx, pbuf_ik) - DO J = 1, nY - State_Met(LCHNK)%XLAI_NATIVE(1,J,N) = pbuf_ik(J,nZ) - ! 2-D data is stored in the 1st level of a - ! 3-D array due to laziness - ENDDO - pbuf_ik => NULL() - ENDIF - ENDDO -#endif + Write(FieldName, '(a,i2.2)') 'HCO_XLAI', N-1 + tmpIdx = pbuf_get_index(FieldName, rc) + IF ( tmpIdx < 0 .or. ( iStep == 1 ) ) THEN + IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(FieldName) + ELSE + CALL pbuf_get_field(pbuf, tmpIdx, pbuf_ik) + DO J = 1, nY + State_Met(LCHNK)%XLAI_NATIVE(1,J,N) = pbuf_ik(J,nZ) + ! 2-D data is stored in the 1st level of a + ! 3-D array due to laziness + ENDDO + pbuf_ik => NULL() + ENDIF + ENDDO + ENDIF ! Field : FRCLND, FRLAND, FROCEAN, FRSEAICE, FRLAKE, FRLANDIC ! Description: Olson land fraction @@ -2601,10 +2597,10 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) IF ( Input_Opt%onlineAlbedo ) THEN State_Met(LCHNK)%UVALBEDO(1,:nY) = cam_in%asdir(:nY) ELSE - fldname_ns = 'HCO_UV_ALBEDO' - tmpIdx = pbuf_get_index(fldname_ns, RC) + FieldName = 'HCO_UV_ALBEDO' + tmpIdx = pbuf_get_index(FieldName, RC) IF ( tmpIdx < 0 .or. ( iStep == 1 ) ) THEN - IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(fldname_ns) + IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(FieldName) State_Met(LCHNK)%UVALBEDO(1,:nY) = 0.0e+0_fp ELSE pbuf_chnk => pbuf_get_chunk(hco_pbuf2d, LCHNK) @@ -2644,11 +2640,11 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) ! Description: Surface iodide concentration ! Unit : nM ! Dimensions : nX, nY - fldname_ns = 'HCO_iodide' - tmpIdx = pbuf_get_index(fldname_ns, RC) + FieldName = 'HCO_iodide' + tmpIdx = pbuf_get_index(FieldName, RC) IF ( tmpIdx < 0 .or. ( iStep == 1 ) ) THEN - IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(fldname_ns) - State_Chm(LCHNK)%IODIDE(1,:nY) = 0.0e+0_fp + IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(FieldName) + State_Chm(LCHNK)%IODIDE(1,:nY) = 0.0e+0_fp ELSE pbuf_chnk => pbuf_get_chunk(hco_pbuf2d, LCHNK) CALL pbuf_get_field(pbuf_chnk, tmpIdx, pbuf_ik) @@ -2662,10 +2658,10 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) ! Unit : PSU ! Dimensions : nX, nY ! Note : Possibly get ocean salinity from POP? - fldname_ns = 'HCO_salinity' - tmpIdx = pbuf_get_index(fldname_ns, RC) + FieldName = 'HCO_salinity' + tmpIdx = pbuf_get_index(FieldName, RC) IF ( tmpIdx < 0 .or. ( iStep == 1 ) ) THEN - IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(fldname_ns) + IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(FieldName) State_Chm(LCHNK)%SALINITY(1,:nY) = 0.0e+0_fp ELSE pbuf_chnk => pbuf_get_chunk(hco_pbuf2d, LCHNK) @@ -2680,18 +2676,18 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) ! Unit : - ! Dimensions : nX, nY IF ( currMo == 12 .or. currMo == 1 .or. currMo == 2 ) THEN - fldname_ns = 'HCO_OMOC_DJF' + FieldName = 'HCO_OMOC_DJF' ELSE IF ( currMo == 3 .or. currMo == 4 .or. currMo == 5 ) THEN - fldname_ns = 'HCO_OMOC_MAM' + FieldName = 'HCO_OMOC_MAM' ELSE IF ( currMo == 6 .or. currMo == 7 .or. currMo == 8 ) THEN - fldname_ns = 'HCO_OMOC_JJA' + FieldName = 'HCO_OMOC_JJA' ELSE IF ( currMo == 9 .or. currMo == 10 .or. currMo == 11 ) THEN - fldname_ns = 'HCO_OMOC_SON' + FieldName = 'HCO_OMOC_SON' ENDIF - tmpIdx = pbuf_get_index(fldname_ns, rc) - IF ( tmpIdx < 0 ) THEN + tmpIdx = pbuf_get_index(FieldName, rc) + IF ( tmpIdx < 0 .or. ( iStep == 1 ) ) THEN ! there is an error here and the field was not found - IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(fldname_ns) + IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(FieldName) ELSE CALL pbuf_get_field(pbuf, tmpIdx, pbuf_ik) DO J = 1, nY @@ -3125,10 +3121,10 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) ! Get pointer to this field. These are the mixing ratios (pptv). ! Day - FIELDNAME = TRIM(PREFIX) // '_DAY' - tmpIdx = pbuf_get_index(FIELDNAME, RC) + FieldName = TRIM(PREFIX) // '_DAY' + tmpIdx = pbuf_get_index(FieldName, RC) IF ( tmpIdx < 0 .or. ( iStep == 1 ) ) THEN - IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(FIELDNAME) + IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(FieldName) BrPtrDay(N)%MR(1,:nY,nZ:1:-1) = 0.0e+0_f4 ELSE pbuf_chnk => pbuf_get_chunk(hco_pbuf2d, LCHNK) @@ -3137,13 +3133,12 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) pbuf_chnk => NULL() pbuf_ik => NULL() ENDIF - !CALL HCO_GetPtr( HcoState, FIELDNAME, BrPtrDay(N)%MR, RC ) ! Night - FIELDNAME = TRIM(PREFIX) // '_NIGHT' - tmpIdx = pbuf_get_index(FIELDNAME, RC) + FieldName = TRIM(PREFIX) // '_NIGHT' + tmpIdx = pbuf_get_index(FieldName, RC) IF ( tmpIdx < 0 .or. ( iStep == 1 ) ) THEN - IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(FIELDNAME) + IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(FieldName) BrPtrDay(N)%MR(1,:nY,nZ:1:-1) = 0.0e+0_f4 ELSE pbuf_chnk => pbuf_get_chunk(hco_pbuf2d, LCHNK) @@ -3152,7 +3147,6 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) pbuf_chnk => NULL() pbuf_ik => NULL() ENDIF - !CALL HCO_GetPtr( HcoState, FIELDNAME, BrPtrNight(N)%MR, RC ) ENDDO @@ -3173,9 +3167,9 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) ! Production rates [v/v/s] IF ( Input_Opt%LUCX ) THEN - FIELDNAME = 'GMI_PROD_'//TRIM(SpcName) + FieldName = 'GMI_PROD_'//TRIM(SpcName) ELSE - FIELDNAME = 'UCX_PROD_'//TRIM(SpcName) + FieldName = 'UCX_PROD_'//TRIM(SpcName) ENDIF ALLOCATE( PLVEC(N)%PROD(1,PCOLS,nZ), STAT=IERR ) @@ -3184,9 +3178,9 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating PLVEC%PROD') ! Get pointer from HEMCO - tmpIdx = pbuf_get_index(FIELDNAME, RC) + tmpIdx = pbuf_get_index(FieldName, RC) IF ( tmpIdx < 0 .or. ( iStep == 1 ) ) THEN - IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(FIELDNAME) + IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(FieldName) PLVEC(N)%PROD(1,:nY,nZ:1:-1) = 0.0e+0_f4 FND = .False. ELSE @@ -3197,28 +3191,27 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) pbuf_chnk => NULL() pbuf_ik => NULL() ENDIF - !CALL HCO_GetPtr( HcoState, FIELDNAME, PLVEC(N)%PROD, RC, FOUND=FND ) ! Warning message IF ( .NOT. FND .AND. Input_Opt%amIRoot ) THEN ErrMsg = 'Cannot find archived production rates for ' // & TRIM(SpcName) // ' - will use value of 0.0. ' // & 'To use archived rates, add the following field ' // & - 'to the HEMCO configuration file: '// TRIM( FIELDNAME ) + 'to the HEMCO configuration file: '// TRIM( FieldName ) CALL GC_Warning( ErrMsg, RC, ThisLoc ) ENDIF ! Loss frequency [s-1] IF ( Input_Opt%LUCX ) THEN - FIELDNAME = 'GMI_LOSS_'//TRIM(SpcName) + FieldName = 'GMI_LOSS_'//TRIM(SpcName) ELSE - FIELDNAME = 'UCX_LOSS_'//TRIM(SpcName) + FieldName = 'UCX_LOSS_'//TRIM(SpcName) ENDIF ! Get pointer from HEMCO - tmpIdx = pbuf_get_index(FIELDNAME, RC) + tmpIdx = pbuf_get_index(FieldName, RC) IF ( tmpIdx < 0 .or. ( iStep == 1 ) ) THEN - IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(FIELDNAME) + IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(FieldName) PLVEC(N)%LOSS(1,:nY,nZ:1:-1) = 0.0e+0_f4 FND = .False. ELSE @@ -3229,14 +3222,13 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) pbuf_chnk => NULL() pbuf_ik => NULL() ENDIF - !CALL HCO_GetPtr( HcoState, FIELDNAME, PLVEC(N)%LOSS, RC, FOUND=FND ) ! Warning message IF ( .NOT. FND .AND. Input_Opt%amIRoot ) THEN ErrMsg= 'Cannot find archived loss frequencies for ' // & TRIM(SpcName) // ' - will use value of 0.0. ' // & 'To use archived rates, add the following field ' // & - 'to the HEMCO configuration file: '//TRIM(FIELDNAME) + 'to the HEMCO configuration file: '//TRIM(FieldName) CALL GC_Warning( ErrMsg, RC, ThisLoc ) ENDIF @@ -3247,9 +3239,9 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) ALLOCATE( STRAT_OH(1,PCOLS,nZ), STAT=IERR ) IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating STRAT_OH') - tmpIdx = pbuf_get_index(FIELDNAME, RC) + tmpIdx = pbuf_get_index(FieldName, RC) IF ( tmpIdx < 0 .or. ( iStep == 1 ) ) THEN - IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(FIELDNAME) + IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(FieldName) STRAT_OH(1,:nY,nZ:1:-1) = 0.0e+0_f4 ELSE pbuf_chnk => pbuf_get_chunk(hco_pbuf2d, LCHNK) @@ -3738,10 +3730,10 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) ! Save and write J-values to pbuf for HEMCO ! in HCO_IN_JNO2, HCO_IN_JOH - FIELDNAME = 'HCO_IN_JNO2' - tmpIdx = pbuf_get_index(FIELDNAME, RC) + FieldName = 'HCO_IN_JNO2' + tmpIdx = pbuf_get_index(FieldName, RC) IF ( tmpIdx < 0 .or. ( iStep == 1 ) ) THEN - IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(FIELDNAME) + IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(FieldName) ELSE pbuf_chnk => pbuf_get_chunk(hco_pbuf2d, LCHNK) CALL pbuf_get_field(pbuf_chnk, tmpIdx, pbuf_ik) @@ -3754,10 +3746,10 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) ENDIF - FIELDNAME = 'HCO_IN_JOH' - tmpIdx = pbuf_get_index(FIELDNAME, RC) + FieldName = 'HCO_IN_JOH' + tmpIdx = pbuf_get_index(FieldName, RC) IF ( tmpIdx < 0 .or. ( iStep == 1 ) ) THEN - IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(FIELDNAME) + IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(FieldName) ELSE pbuf_chnk => pbuf_get_chunk(hco_pbuf2d, LCHNK) CALL pbuf_get_field(pbuf_chnk, tmpIdx, pbuf_ik) diff --git a/src/chemistry/geoschem/mo_neu_wetdep.F90 b/src/chemistry/geoschem/mo_neu_wetdep.F90 index c48af5cc0c..d31ab9d7f4 100644 --- a/src/chemistry/geoschem/mo_neu_wetdep.F90 +++ b/src/chemistry/geoschem/mo_neu_wetdep.F90 @@ -132,22 +132,22 @@ subroutine neu_wetdep_init test_name = 'GC_CH2O' case( 'NO2' ) test_name = 'GC_NO2' - case( 'HNO3' ) - test_name = 'GC_HNO3' + !case( 'HNO3' ) + ! test_name = 'GC_HNO3' case( 'NH3' ) test_name = 'GC_NH3' case( 'N2O5' ) test_name = 'GC_N2O5' case( 'PAN' ) test_name = 'GC_PAN' - case( 'SO2' ) - test_name = 'GC_SO2' + !case( 'SO2' ) + ! test_name = 'GC_SO2' ! Now list all non-MAM GEOS-Chem aerosols. These will be scavenged similarly ! to HNO3 - case( 'AERI', 'BrSALA', 'BrSALC', 'DMS', 'INDIOL', & + case( 'AERI', 'BRSALA', 'BRSALC', 'INDIOL', & 'IONITA', 'ISALA', 'ISALC', 'LVOCOA', 'MONITA', & - 'MSA', 'NH4', 'NIT', 'NITs', 'pFe', & - 'SALAAL', 'SALACL', 'SALCAL', 'SALCCL', 'SO4s', & + 'MSA', 'NH4', 'NIT', 'NITS', 'PFE', & + 'SALAAL', 'SALACL', 'SALCAL', 'SALCCL', 'SO4S', & 'SOAGX', 'SOAIE' ) test_name = 'HNO3' end select diff --git a/src/chemistry/geoschem/mo_sim_dat.F90 b/src/chemistry/geoschem/mo_sim_dat.F90 index 44997c160e..442e2fc4a0 100644 --- a/src/chemistry/geoschem/mo_sim_dat.F90 +++ b/src/chemistry/geoschem/mo_sim_dat.F90 @@ -43,18 +43,18 @@ subroutine set_sim_dat solsym(:318) = (/ 'ACET ','ACTA ','AERI ', & 'ALD2 ','ALK4 ','ATOOH ', & 'BCPI ','BCPO ','BENZ ', & - 'Br ','Br2 ','BrCl ', & - 'BrNO2 ','BrNO3 ','BrO ', & - 'BrSALA ','BrSALC ','C2H6 ', & - 'C3H8 ','CCl4 ','CFC11 ', & + 'BR ','BR2 ','BRCL ', & + 'BRNO2 ','BRNO3 ','BRO ', & + 'BRSALA ','BRSALC ','C2H6 ', & + 'C3H8 ','CCL4 ','CFC11 ', & 'CFC113 ','CFC114 ','CFC115 ', & - 'CFC12 ','CH2Br2 ','CH2Cl2 ', & - 'CH2I2 ','CH2IBr ','CH2ICl ', & - 'CH2O ','CH3Br ','CH3CCl3 ', & - 'CH3Cl ','CH3I ','CH4 ', & - 'CHBr3 ','CHCl3 ','Cl ', & - 'Cl2 ','Cl2O2 ','ClNO2 ', & - 'ClNO3 ','ClO ','ClOO ', & + 'CFC12 ','CH2BR2 ','CH2CL2 ', & + 'CH2I2 ','CH2IBR ','CH2ICL ', & + 'CH2O ','CH3BR ','CH3CCL3 ', & + 'CH3CL ','CH3I ','CH4 ', & + 'CHBR3 ','CHCL3 ','CL ', & + 'CL2 ','CL2O2 ','CLNO2 ', & + 'CLNO3 ','CLO ','CLOO ', & 'CLOCK ', & 'CO ','DMS ','DST1 ', & 'DST2 ','DST3 ','DST4 ', & @@ -62,17 +62,17 @@ subroutine set_sim_dat 'ETP ','GLYC ','GLYX ', & 'H1211 ','H1301 ','H2402 ', & 'H2O ','H2O2 ','HAC ', & - 'HBr ','HC5A ','HCFC123 ', & - 'HCFC141b ','HCFC142b ','HCFC22 ', & - 'HCl ','HCOOH ','HI ', & + 'HBR ','HC5A ','HCFC123 ', & + 'HCFC141B ','HCFC142B ','HCFC22 ', & + 'HCL ','HCOOH ','HI ', & 'HMHP ','HMML ','HNO2 ', & - 'HNO3 ','HNO4 ','HOBr ', & - 'HOCl ','HOI ','HONIT ', & + 'HNO3 ','HNO4 ','HOBR ', & + 'HOCL ','HOI ','HONIT ', & 'HPALD1 ','HPALD2 ','HPALD3 ', & 'HPALD4 ','HPETHNL ','I ', & 'I2 ','I2O2 ','I2O3 ', & - 'I2O4 ','IBr ','ICHE ', & - 'ICl ','ICN ','ICPDH ', & + 'I2O4 ','IBR ','ICHE ', & + 'ICL ','ICN ','ICPDH ', & 'IDC ','IDCHP ','IDHDP ', & 'IDHPE ','IDN ','IEPOXA ', & 'IEPOXB ','IEPOXD ','IHN1 ', & @@ -93,11 +93,11 @@ subroutine set_sim_dat 'MVKDH ','MVKHC ','MVKHCB ', & 'MVKHP ','MVKN ','MVKPC ', & 'N2O ','N2O5 ','NH3 ', & - 'NH4 ','NIT ','NITs ', & + 'NH4 ','NIT ','NITS ', & 'NO ','NO2 ','NO3 ', & - 'NPRNO3 ','O3 ','OClO ', & + 'NPRNO3 ','O3 ','OCLO ', & 'OCPI ','OCPO ','OCS ', & - 'OIO ','PAN ','pFe ', & + 'OIO ','PAN ','PFE ', & 'PIP ','PP ','PPN ', & 'PROPNN ','PRPE ','PRPN ', & 'PYAC ','R4N2 ','R4P ', & @@ -106,7 +106,7 @@ subroutine set_sim_dat 'RIPD ','RP ','SALA ', & 'SALAAL ','SALACL ','SALC ', & 'SALCAL ','SALCCL ','SO2 ', & - 'SO4 ','SO4s ','SOAGX ', & + 'SO4 ','SO4S ','SOAGX ', & 'SOAIE ','SOAP ','SOAS ', & 'TOLU ','XYLE ','bc_a1 ', & 'bc_a4 ','dst_a1 ','dst_a2 ', & @@ -124,7 +124,7 @@ subroutine set_sim_dat 'LISOPNO3 ','LTRO2H ','LTRO2N ', & 'LXRO2H ','LXRO2N ','SO4H1 ', & 'SO4H2 ','SO4H3 ','SO4H4 ', & - 'POx ','LOx ','PCO ', & + 'POX ','LOX ','PCO ', & 'LCO ','PSO4 ','LCH4 ', & 'PH2O2 ','BRO2 ','TRO2 ', & 'N ','XRO2 ','HPALD2OO ', & From 7afe235661871151e7713464a739ac2340c6849a Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Sun, 28 Feb 2021 22:51:12 -0500 Subject: [PATCH 009/291] Feat: Now retrieve fields from HEMCO using 2-D pbuf fields --- src/chemistry/geoschem/chemistry.F90 | 39 ++++++++++++---------------- 1 file changed, 17 insertions(+), 22 deletions(-) diff --git a/src/chemistry/geoschem/chemistry.F90 b/src/chemistry/geoschem/chemistry.F90 index ef153018e7..d01db107cd 100644 --- a/src/chemistry/geoschem/chemistry.F90 +++ b/src/chemistry/geoschem/chemistry.F90 @@ -2035,6 +2035,7 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) TYPE(physics_buffer_desc), POINTER :: pbuf_chnk(:) ! slice of pbuf in chnk REAL(r8), POINTER :: pbuf_ik(:,:) ! ptr to pbuf data (/pcols,pver/) + REAL(r8), POINTER :: pbuf_i(:) ! ptr to pbuf data (/pcols/) horizontal only (horiz_only) INTEGER :: tmpIdx ! pbuf field id INTEGER :: TIM_NDX @@ -2446,11 +2447,9 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) IF ( tmpIdx < 0 .or. ( iStep == 1 ) ) THEN IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(FieldName) ELSE - CALL pbuf_get_field(pbuf, tmpIdx, pbuf_ik) + CALL pbuf_get_field(pbuf, tmpIdx, pbuf_i) DO J = 1, nY - State_Met(LCHNK)%LandTypeFrac(1,J,N) = pbuf_ik(J,nZ) - ! 2-D data is stored in the 1st level of a - ! 3-D array due to laziness + State_Met(LCHNK)%LandTypeFrac(1,J,N) = pbuf_i(J) ENDDO pbuf_ik => NULL() ENDIF @@ -2460,11 +2459,9 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) IF ( tmpIdx < 0 .or. ( iStep == 1 ) ) THEN IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(FieldName) ELSE - CALL pbuf_get_field(pbuf, tmpIdx, pbuf_ik) + CALL pbuf_get_field(pbuf, tmpIdx, pbuf_i) DO J = 1, nY - State_Met(LCHNK)%XLAI_NATIVE(1,J,N) = pbuf_ik(J,nZ) - ! 2-D data is stored in the 1st level of a - ! 3-D array due to laziness + State_Met(LCHNK)%XLAI_NATIVE(1,J,N) = pbuf_i(J) ENDDO pbuf_ik => NULL() ENDIF @@ -2604,10 +2601,10 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) State_Met(LCHNK)%UVALBEDO(1,:nY) = 0.0e+0_fp ELSE pbuf_chnk => pbuf_get_chunk(hco_pbuf2d, LCHNK) - CALL pbuf_get_field(pbuf_chnk, tmpIdx, pbuf_ik) - State_Met(LCHNK)%UVALBEDO(1,:nY) = pbuf_ik(:nY,nZ) + CALL pbuf_get_field(pbuf_chnk, tmpIdx, pbuf_i) + State_Met(LCHNK)%UVALBEDO(1,:nY) = pbuf_i(:nY) pbuf_chnk => NULL() - pbuf_ik => NULL() + pbuf_i => NULL() ENDIF ENDIF @@ -2647,10 +2644,10 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) State_Chm(LCHNK)%IODIDE(1,:nY) = 0.0e+0_fp ELSE pbuf_chnk => pbuf_get_chunk(hco_pbuf2d, LCHNK) - CALL pbuf_get_field(pbuf_chnk, tmpIdx, pbuf_ik) - State_Chm(LCHNK)%IODIDE(1,:nY) = pbuf_ik(:nY,nZ) + CALL pbuf_get_field(pbuf_chnk, tmpIdx, pbuf_i) + State_Chm(LCHNK)%IODIDE(1,:nY) = pbuf_i(:nY) pbuf_chnk => NULL() - pbuf_ik => NULL() + pbuf_i => NULL() ENDIF ! Field : SALINITY @@ -2665,10 +2662,10 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) State_Chm(LCHNK)%SALINITY(1,:nY) = 0.0e+0_fp ELSE pbuf_chnk => pbuf_get_chunk(hco_pbuf2d, LCHNK) - CALL pbuf_get_field(pbuf_chnk, tmpIdx, pbuf_ik) - State_Chm(LCHNK)%SALINITY(1,:nY) = pbuf_ik(:nY,nZ) + CALL pbuf_get_field(pbuf_chnk, tmpIdx, pbuf_i) + State_Chm(LCHNK)%SALINITY(1,:nY) = pbuf_i(:nY) pbuf_chnk => NULL() - pbuf_ik => NULL() + pbuf_i => NULL() ENDIF ! Field : OMOC @@ -2689,13 +2686,11 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) ! there is an error here and the field was not found IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(FieldName) ELSE - CALL pbuf_get_field(pbuf, tmpIdx, pbuf_ik) + CALL pbuf_get_field(pbuf, tmpIdx, pbuf_i) DO J = 1, nY - State_Chm(LCHNK)%OMOC(1,J) = pbuf_ik(J,nZ) - ! 2-D data is stored in the 1st level of a - ! 3-D array due to laziness + State_Chm(LCHNK)%OMOC(1,J) = pbuf_i(J) ENDDO - pbuf_ik => NULL() + pbuf_i => NULL() ENDIF ! Three-dimensional fields on level edges From de05dff245a7805ef7167839c963d0037b41a58e Mon Sep 17 00:00:00 2001 From: Thibaud Fritz Date: Tue, 2 Mar 2021 17:09:19 -0500 Subject: [PATCH 010/291] Squashed 10 commits from Thibaud Fritz Fix: Pass surface J-Rates to HEMCO for PARANOX Fix: Update MMR_Beg for MAM aerosols: (1) This fix avoids a slow, but steady build up of some MAM aerosols Fix: Make sure GEOS-Chem (aerosol phase) MSA is not picked up by MAM Feat: Diagnose constituents as mol/mol apart from MAM aerosols Feat: Update namelist_defaults s.t. geoschem mimics trop_strat_mam4vbs Feat: Update geoschem.xml to mimic history_* XML variables Feat: Add history_* options to save out fields in cesmgc_diag_mod Feat: Don't make solsym fixed size, but rather of size gas_pcnst Feat: Change nadv_chem from 240 to 238 Feat: Add more history_* options to save out fields (mimic CAM-Chem) Signed-off-by: Thibaud Fritz --- bld/configure | 3 +- bld/namelist_files/namelist_defaults_cam.xml | 6 + bld/namelist_files/use_cases/geoschem.xml | 10 + src/chemistry/geoschem/cesmgc_diag_mod.F90 | 231 +++++++++++++++--- .../geoschem/cesmgc_emissions_mod.F90 | 28 ++- src/chemistry/geoschem/chem_mods.F90 | 12 +- src/chemistry/geoschem/chemistry.F90 | 42 ++-- src/chemistry/geoschem/mo_neu_wetdep.F90 | 15 +- src/chemistry/geoschem/mo_tracname.F90 | 7 +- .../modal_aero/modal_aero_gasaerexch.F90 | 8 +- 10 files changed, 278 insertions(+), 84 deletions(-) diff --git a/bld/configure b/bld/configure index 56673cb754..f026dcd844 100755 --- a/bld/configure +++ b/bld/configure @@ -1441,8 +1441,7 @@ if ($chem_pkg =~ '_mam3') { # TMMF - wedge in GEOS-Chem CPP definitions here if ($chem_pkg =~ 'geoschem') { $chem_cppdefs .= ' -DEXTERNAL_GRID -DEXTERNAL_FORCING -DLINUX_IFORT -DUSE_REAL8 -DMODEL_ -DMODEL_CESM'; - # TMMF - Temporary fix - $chem_nadv = 250; + $chem_nadv = 238; if (defined $opts{'clm_vers'}) { if ($opts{'clm_vers'} =~ 'CLM4.0') { $chem_cppdefs .= ' -DCLM40' diff --git a/bld/namelist_files/namelist_defaults_cam.xml b/bld/namelist_files/namelist_defaults_cam.xml index aa77beaba3..b006ed26d1 100644 --- a/bld/namelist_files/namelist_defaults_cam.xml +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -541,6 +541,7 @@ 0.4D0 0.55D0 0.5D0 +0.5D0 0.5D0 0.5D0 0.0625D0 @@ -553,22 +554,27 @@ atm/waccm/gw/mfspectra_shallow_c140530.nc 0.25d0 0.5d0 +0.5d0 0.5d0 0.5d0 1.d0 2.d0 +2.d0 2.d0 2.d0 .true. .false. +.false. .false. .false. .false. .true. +.true. .true. .true. .true. .false. +.false. .false. .false. diff --git a/bld/namelist_files/use_cases/geoschem.xml b/bld/namelist_files/use_cases/geoschem.xml index 39fc45bf7e..ecdb9aaa06 100644 --- a/bld/namelist_files/use_cases/geoschem.xml +++ b/bld/namelist_files/use_cases/geoschem.xml @@ -39,6 +39,16 @@ 0,-24,-24,-3,-1,1,-24,-120,-240 'A','A','A','A','A','A','A','A','I' +.true. +.false. +.false. +.false. +.false. +.false. +.false. +.false. +.false. + 'Q', 'U', 'V', 'OMEGA', 'T', 'PS', diff --git a/src/chemistry/geoschem/cesmgc_diag_mod.F90 b/src/chemistry/geoschem/cesmgc_diag_mod.F90 index 7c3180ddd6..f27dfa7e53 100644 --- a/src/chemistry/geoschem/cesmgc_diag_mod.F90 +++ b/src/chemistry/geoschem/cesmgc_diag_mod.F90 @@ -45,11 +45,12 @@ MODULE CESMGC_Diag_Mod CHARACTER(LEN=fieldname_len) :: wetdep_name(gas_pcnst) ! Wet deposition tendencies CHARACTER(LEN=fieldname_len) :: wtrate_name(gas_pcnst) ! Column tendencies for wet dep CHARACTER(LEN=fieldname_len) :: dtchem_name(gas_pcnst) ! Chemical tendencies - CHARACTER(LEN=16) :: sflxnam_loc(pcnst) ! Names of surface fluxes + + INTEGER :: aer_species(gas_pcnst) ! Chemical families INTEGER :: NOx_species(3) - INTEGER :: NOy_species(63) + INTEGER :: NOy_species(62) INTEGER :: HOx_species(4) INTEGER :: ClOx_species(6) INTEGER :: ClOy_species(11) @@ -61,7 +62,7 @@ MODULE CESMGC_Diag_Mod INTEGER :: NHx_species(2) INTEGER :: TOTH_species(3) REAL(r8) :: NOx_MWs(3) - REAL(r8) :: NOy_MWs(64) + REAL(r8) :: NOy_MWs(62) REAL(r8) :: HOx_MWs(4) REAL(r8) :: ClOx_MWs(6) REAL(r8) :: ClOy_MWs(11) @@ -90,7 +91,7 @@ MODULE CESMGC_Diag_Mod i_MACRNO2, i_MCRHN, i_MCRHNB, i_MENO3, i_MONITS, i_MONITU, & i_MPAN, i_MPN, i_MVKN, i_N2O5, i_NO3, i_NPRNO3, i_OLND, & i_OLNN, i_PAN, i_PPN, i_PRN1, i_PROPNN, i_PRPN, i_R4N1, & - i_R4N2, i_HONIT, i_IONITA, i_NIT, i_NITs, i_NH4 + i_R4N2, i_HONIT, i_IONITA, i_NIT, i_NITs ! HOx INTEGER :: i_H, i_OH, i_HO2, i_H2O2 ! ClOx @@ -112,9 +113,18 @@ MODULE CESMGC_Diag_Mod ! SOx INTEGER :: i_SO2, i_SO4 ! NHx - INTEGER :: i_NH3 !NH4 already defined in NOy_species + INTEGER :: i_NH3, i_NH4 ! TOTH INTEGER :: i_CH4, i_H2O, i_H2 + + + ! Index in solsym + integer :: id_no,id_no3 + integer :: id_cfc11,id_cfc12 + integer :: id_ch4,id_h2o + integer :: id_o,id_o2,id_h,id_n2o + integer :: id_co2,id_o3,id_oh,id_ho2,id_so4_a1,id_so4_a2,id_so4_a3 + integer :: id_num_a2,id_num_a3,id_dst_a3,id_ncl_a3 ! ! !REVISION HISTORY: ! 28 Oct 2020 - T. M. Fritz - Initial version @@ -150,7 +160,9 @@ SUBROUTINE CESMGC_Diag_Init( Input_Opt, State_Chm, State_Met ) USE CONSTITUENTS, ONLY : cnst_name, sflxnam USE CONSTITUENTS, ONLY : cnst_get_ind USE CAM_HISTORY, ONLY : addfld, add_default, horiz_only + USE PHYS_CONTROL, ONLY : phys_getopts USE DRYDEP_MOD, ONLY : depName + USE MO_CHEM_UTLS, ONLY : get_spc_ndx ! ! !INPUT PARAMETERS: ! @@ -165,12 +177,35 @@ SUBROUTINE CESMGC_Diag_Init( Input_Opt, State_Chm, State_Met ) !BOC ! ! Integer - INTEGER :: M, N, SM + INTEGER :: M, N, K, SM INTEGER :: idx INTEGER :: RC + INTEGER :: bulkaero_species(20) + INTEGER :: id_so4, id_nh4no3 + INTEGER :: id_dst01, id_dst02, id_dst03, id_dst04 + INTEGER :: id_sslt01, id_sslt02, id_sslt03, id_sslt04 + INTEGER :: id_soa, id_oc1, id_oc2, id_cb1, id_cb2 + INTEGER :: id_soam,id_soai,id_soat,id_soab,id_soax + INTEGER :: id_bry, id_cly + INTEGER :: history_budget_histfile_num ! output history file number + ! for budget fields ! Logical LOGICAL :: Found + LOGICAL :: history_aerosol ! Output the MAM aerosol + ! tendencies + LOGICAL :: history_chemistry + LOGICAL :: history_cesm_forcing + LOGICAL :: history_scwaccm_forcing + LOGICAL :: history_chemspecies_srf ! Output the chemistry + ! constituents species + ! in the surface layer + LOGICAL :: history_dust + LOGICAL :: history_budget ! output tendencies and state + ! variables for CAM + ! temperature, water vapor, + ! cloud ice and cloud + ! liquid budgets. ! Strings CHARACTER(LEN=255) :: SpcName @@ -196,6 +231,79 @@ SUBROUTINE CESMGC_Diag_Init( Input_Opt, State_Chm, State_Met ) ! Assume a successful return until otherwise RC = GC_SUCCESS + CALL phys_getopts( history_aerosol_out = history_aerosol, & + history_chemistry_out = history_chemistry, & + history_chemspecies_srf_out = history_chemspecies_srf, & + history_budget_out = history_budget , & + history_budget_histfile_num_out = history_budget_histfile_num, & + history_cesm_forcing_out = history_cesm_forcing, & + history_scwaccm_forcing_out = history_scwaccm_forcing, & + history_dust_out = history_dust ) + + id_no3 = get_spc_ndx( 'NO3' ) + id_o3 = get_spc_ndx( 'O3' ) + id_oh = get_spc_ndx( 'OH' ) + id_ho2 = get_spc_ndx( 'HO2' ) + id_so4_a1 = get_spc_ndx( 'so4_a1' ) + id_so4_a2 = get_spc_ndx( 'so4_a2' ) + id_so4_a3 = get_spc_ndx( 'so4_a3' ) + id_num_a2 = get_spc_ndx( 'num_a2' ) + id_num_a3 = get_spc_ndx( 'num_a3' ) + id_dst_a3 = get_spc_ndx( 'dst_a3' ) + id_ncl_a3 = get_spc_ndx( 'ncl_a3' ) + id_co2 = get_spc_ndx( 'CO2' ) + id_no = get_spc_ndx( 'NO' ) + id_h = get_spc_ndx( 'H' ) + id_o = get_spc_ndx( 'O' ) + id_o2 = get_spc_ndx( 'O2' ) + id_ch4 = get_spc_ndx( 'CH4' ) + id_h2o = get_spc_ndx( 'H2O' ) + id_n2o = get_spc_ndx( 'N2O' ) + id_cfc11 = get_spc_ndx( 'CFC11' ) + id_cfc12 = get_spc_ndx( 'CFC12' ) + + id_bry = get_spc_ndx( 'BRY' ) + id_cly = get_spc_ndx( 'CLY' ) + + id_dst01 = get_spc_ndx( 'DST01' ) + id_dst02 = get_spc_ndx( 'DST02' ) + id_dst03 = get_spc_ndx( 'DST03' ) + id_dst04 = get_spc_ndx( 'DST04' ) + id_sslt01 = get_spc_ndx( 'SSLT01' ) + id_sslt02 = get_spc_ndx( 'SSLT02' ) + id_sslt03 = get_spc_ndx( 'SSLT03' ) + id_sslt04 = get_spc_ndx( 'SSLT04' ) + id_soa = get_spc_ndx( 'SOA' ) + id_so4 = get_spc_ndx( 'SO4' ); id_so4 = -1 ! Don't pick up GEOS-Chem's SO4! + id_oc1 = get_spc_ndx( 'OC1' ) + id_oc2 = get_spc_ndx( 'OC2' ) + id_cb1 = get_spc_ndx( 'CB1' ) + id_cb2 = get_spc_ndx( 'CB2' ) + id_nh4no3 = get_spc_ndx( 'NH4NO3' ) + id_soam = get_spc_ndx( 'SOAM' ) + id_soai = get_spc_ndx( 'SOAI' ) + id_soat = get_spc_ndx( 'SOAT' ) + id_soab = get_spc_ndx( 'SOAB' ) + id_soax = get_spc_ndx( 'SOAX' ) + + bulkaero_species(:) = -1 + bulkaero_species(1:20) = (/ id_dst01, id_dst02, id_dst03, id_dst04, & + id_sslt01, id_sslt02, id_sslt03, id_sslt04, & + id_soa, id_so4, id_oc1, id_oc2, id_cb1, id_cb2, id_nh4no3, & + id_soam,id_soai,id_soat,id_soab,id_soax /) + aer_species(:) = -1 + n = 1 + do m = 1,gas_pcnst + k=0 + if ( any(bulkaero_species(:)==m) ) k=1 + if ( k==0 ) k = index(trim(solsym(m)), '_a') + if ( k==0 ) k = index(trim(solsym(m)), '_c') + if ( k>0 ) then ! must be aerosol species + aer_species(n) = m + n = n+1 + endif + enddo + CALL Addfld( 'MASS', (/ 'lev' /), 'A', 'kg', 'Mass of grid box' ) CALL Addfld( 'AREA', horiz_only, 'A', 'm2', 'Area of grid box' ) CALL Addfld( 'HEIGHT', (/ 'ilev' /),'A','m', 'Geopotential height above surface at interfaces' ) @@ -203,17 +311,7 @@ SUBROUTINE CESMGC_Diag_Init( Input_Opt, State_Chm, State_Met ) ! Note that constituents are already output by default ! Add all species as output fields if desired DO N = 1, gas_pcnst - M = map2chm(N) - IF ( M > 0 ) THEN - ! It's a GEOS-Chem species - SpcName = to_upper(TRIM(solsym(N))) - CALL AddFld( TRIM(SpcName), (/ 'lev' /), 'A', 'mol/mol', & - TRIM(SpcName)//' volume mixing ratio') - CALL AddFld( TRIM(SpcName)//'_SRF', horiz_only, 'A', 'mol/mol', & - TRIM(SpcName)//' in bottom layer') - IF (TRIM(SpcName) == 'O3') CALL Add_Default( TRIM(SpcName), 2, ' ' ) - ELSE - ! MAM aerosols + IF ( ANY( aer_species == N ) ) THEN SpcName = TRIM(solsym(N)) unit_basename = 'kg' IF ( SpcName(1:3) == 'num' ) unit_basename = ' 1' @@ -221,6 +319,56 @@ SUBROUTINE CESMGC_Diag_Init( Input_Opt, State_Chm, State_Met ) TRIM(SpcName)//' concentration' ) CALL AddFld( TRIM(SpcName)//'_SRF', horiz_only, 'A', unit_basename//'/kg', & TRIM(SpcName)//' in bottom layer' ) + ELSE + M = map2chm(N) + SpcName = TRIM(solsym(N)) + CALL AddFld( TRIM(SpcName), (/ 'lev' /), 'A', 'mol/mol', & + TRIM(SpcName)//' volume mixing ratio') + CALL AddFld( TRIM(SpcName)//'_SRF', horiz_only, 'A', 'mol/mol', & + TRIM(SpcName)//' in bottom layer') + ENDIF + IF ( ( N /= id_cly ) .AND. ( N /= id_bry ) ) THEN + IF ( history_aerosol .OR. history_chemistry ) THEN + CALL Add_Default( TRIM(SpcName), 1, ' ' ) + ENDIF + IF ( history_chemspecies_srf ) THEN + CALL Add_Default( TRIM(SpcName)//'_SRF', 1, ' ' ) + ENDIF + ENDIF + + IF ( history_cesm_forcing ) THEN + IF ( N == id_o3 ) CALL Add_Default( TRIM(SpcName), 1, ' ') + IF ( N == id_oh ) CALL Add_Default( TRIM(SpcName), 1, ' ') + IF ( N == id_no3 ) CALL Add_Default( TRIM(SpcName), 1, ' ') + IF ( N == id_ho2 ) CALL Add_Default( TRIM(SpcName), 1, ' ') + + IF ( N == id_o3 ) CALL Add_Default( TRIM(SpcName), 8, ' ') + IF ( N == id_so4_a1 ) CALL Add_Default( TRIM(SpcName), 8, ' ') + IF ( N == id_so4_a2 ) CALL Add_Default( TRIM(SpcName), 8, ' ') + IF ( N == id_so4_a3 ) CALL Add_Default( TRIM(SpcName), 8, ' ') + + IF ( N == id_num_a2 ) CALL Add_Default( TRIM(SpcName), 8, ' ') + IF ( N == id_num_a3 ) CALL Add_Default( TRIM(SpcName), 8, ' ') + IF ( N == id_dst_a3 ) CALL Add_Default( TRIM(SpcName), 8, ' ') + IF ( N == id_ncl_a3 ) CALL Add_Default( TRIM(SpcName), 8, ' ') + + ENDIF + IF ( history_scwaccm_forcing ) THEN + IF ( N == id_co2 ) CALL Add_Default( TRIM(SpcName), 8, ' ') + IF ( N == id_h ) CALL Add_Default( TRIM(SpcName), 8, ' ') + IF ( N == id_no ) CALL Add_Default( TRIM(SpcName), 8, ' ') + IF ( N == id_o ) CALL Add_Default( TRIM(SpcName), 8, ' ') + IF ( N == id_o2 ) CALL Add_Default( TRIM(SpcName), 8, ' ') + IF ( N == id_o3 ) CALL Add_Default( TRIM(SpcName), 8, ' ') + IF ( N == id_h2o ) CALL Add_Default( TRIM(SpcName), 1, ' ') + IF ( N == id_ch4 ) CALL Add_Default( TRIM(SpcName), 1, ' ') + IF ( N == id_n2o ) CALL Add_Default( TRIM(SpcName), 1, ' ') + IF ( N == id_cfc11 ) CALL Add_Default( TRIM(SpcName), 1, ' ') + IF ( N == id_cfc12 ) CALL Add_Default( TRIM(SpcName), 1, ' ') + ENDIF + + IF (history_dust .AND. (index(TRIM(SpcName),'dst_') > 0)) THEN + CALL Add_Default( TRIM(SpcName), 1, ' ') ENDIF ENDDO @@ -240,13 +388,15 @@ SUBROUTINE CESMGC_Diag_Init( Input_Opt, State_Chm, State_Met ) SpcName = 'DF_'//to_upper(TRIM(SpcInfo%Name)) CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'kg/m2/s', & TRIM(SpcName)//' dry deposition flux') + IF ( history_chemistry ) THEN + CALL Add_Default( TRIM(SpcName), 1, ' ' ) + ENDIF ! Free pointer SpcInfo => NULL() ENDDO ENDIF - sflxnam_loc(:) = '' ! Chemical tendencies and surface fluxes DO N = 1, gas_pcnst IF ( map2chm(N) > 0 ) THEN @@ -263,22 +413,31 @@ SUBROUTINE CESMGC_Diag_Init( Input_Opt, State_Chm, State_Met ) SpcName = TRIM(solsym(N)) CALL cnst_get_ind( SpcName, M, abort=.false. ) IF ( M > 0 ) THEN - IF (sflxnam(M)(3:5) == 'num') then ! name is in the form of "SF****" + IF (sflxnam(M)(3:5) == 'num') THEN ! name is in the form of "SF****" unit_basename = ' 1' ELSE unit_basename = 'kg' ENDIF - IF ( map2chm(N) > 0 ) THEN - sflxnam_loc(M) = to_upper(sflxnam(M)) - ELSE - sflxnam_loc(M) = sflxnam(M) - ENDIF - SpcName = sflxnam_loc(M) + SpcName = sflxnam(M) CALL Addfld ( TRIM(SpcName), horiz_only, 'A', unit_basename//'/m2/s', & TRIM(solsym(N))//' surface flux') + IF ( history_aerosol .OR. history_chemistry ) THEN + CALL Add_Default( TRIM(SpcName), 1, ' ' ) + ENDIF + + IF ( history_cesm_forcing ) THEN + IF ( TRIM(SpcName(3:)) == 'NO' .OR. TRIM(SpcName(3:)) == 'NH3' ) THEN + CALL Add_Default( TRIM(SpcName), 1, ' ' ) + ENDIF + ENDIF ENDIF ENDDO + ! Add chemical tendency of water vapor to water budget output + IF ( history_budget ) THEN + CALL Add_Default ('CT_H2O' , history_budget_histfile_num, ' ') + ENDIF + CALL get_TagInfo( Input_Opt = Input_Opt, & tagID = 'PHO', & State_Chm = State_Chm, & @@ -502,7 +661,7 @@ SUBROUTINE CESMGC_Diag_Init( Input_Opt, State_Chm, State_Met ) i_MCRHNB, i_MENO3, i_MONITS, i_MONITU, i_MPAN, i_MPN,& i_MVKN, i_N2O5, i_NO3, i_NPRNO3, i_OLND, i_OLNN, & i_PAN, i_PPN, i_PRN1, i_PROPNN, i_PRPN, i_R4N1, & - i_R4N2, i_HONIT, i_IONITA, i_NIT, i_NITs, i_NH4 /) + i_R4N2, i_HONIT, i_IONITA, i_NIT, i_NITs /) HOx_species = (/ i_H, i_OH, i_HO2, i_H2O2 /) ClOx_species = (/ i_Cl, i_ClO, i_HOCl, i_Cl2, i_Cl2O2, i_OClO /) ClOy_species = (/ i_Cl, i_ClO, i_HOCl, i_Cl2, i_Cl2O2, i_OClO, & @@ -733,6 +892,9 @@ SUBROUTINE CESMGC_Diag_Init( Input_Opt, State_Chm, State_Met ) CALL Addfld( 'RAD_PSC', (/ 'lev' /), 'I', 'cm', 'PSC aerosol radius' ) CALL Addfld( 'SAD_TROP', (/ 'lev' /), 'I', 'cm2/cm3', 'Tropospheric aerosol SAD' ) CALL Addfld( 'SAD_AERO', (/ 'lev' /), 'I', 'cm2/cm3', 'Aerosol surface area density' ) + IF ( history_cesm_forcing ) THEN + CALL Add_Default( 'SAD_AERO', 8, ' ' ) + ENDIF CALL Addfld( 'REFF_AERO', (/ 'lev' /), 'I', 'cm', 'Aerosol effective radius') CALL Addfld( 'SULF_TROP', (/ 'lev' /), 'I', 'cm2/cm3', 'Tropospheric sulfate area density') @@ -889,19 +1051,18 @@ SUBROUTINE CESMGC_Diag_Calc( Input_Opt, State_Chm, State_Diag, & DO N = 1, gas_pcnst M = map2chm(N) - IF ( M > 0 ) THEN - ! It's a GEOS-Chem species - SpcName = to_upper(TRIM(solsym(N))) - ELSE - ! MAM aerosols - SpcName = TRIM(solsym(N)) - ENDIF + SpcName = TRIM(solsym(N)) outTmp = 0.0e+00_r8 IF ( adv_mass(N) > 0.0e+00_r8 .AND. M /= 0 .AND. hist_fld_active(TRIM(SpcName)) ) THEN IF ( M > 0 ) THEN + ! mol/mol outTmp(:nY,:) = REAL(State_Chm%Species(1,:nY,nZ:1:-1,M),r8) * MWDry / adv_mass(N) - ELSE + ELSEIF ( ANY( aer_species == N ) ) THEN + ! kg/kg outTmp(:nY,:) = state%q(:nY,:nZ,-M) + ELSE + ! mol/mol + outTmp(:nY,:) = state%q(:nY,:nZ,-M) * MWDry / adv_mass(N) ENDIF CALL OutFld( TRIM(SpcName), outTmp(:nY,:), nY, LCHNK ) CALL OutFld( TRIM(SpcName)//'_SRF', outTmp(:nY,nZ), nY, LCHNK ) @@ -1287,7 +1448,7 @@ SUBROUTINE CESMGC_Diag_Calc( Input_Opt, State_Chm, State_Diag, & ! =============================================== DO N = iFirstCnst, pcnst - SpcName = TRIM(sflxnam_loc(N)) + SpcName = TRIM(sflxnam(N)) IF ( TRIM(SpcName) == '' ) CYCLE IF ( .NOT. hist_fld_active(TRIM(SpcName)) ) CYCLE CALL OutFld( TRIM(SpcName), cam_in%cflx(:nY,N), nY, LCHNK ) diff --git a/src/chemistry/geoschem/cesmgc_emissions_mod.F90 b/src/chemistry/geoschem/cesmgc_emissions_mod.F90 index 2a1ff841b2..4709699035 100644 --- a/src/chemistry/geoschem/cesmgc_emissions_mod.F90 +++ b/src/chemistry/geoschem/cesmgc_emissions_mod.F90 @@ -92,6 +92,7 @@ SUBROUTINE CESMGC_Emissions_Init( lght_no_prd_factor ) ! USE PHYSICS_TYPES, ONLY : physics_state USE CONSTITUENTS, ONLY : cnst_get_ind + USE PHYS_CONTROL, ONLY : phys_getopts USE MO_CHEM_UTLS, ONLY : get_spc_ndx USE CAM_HISTORY, ONLY : addfld, add_default, horiz_only USE MO_LIGHTNING, ONLY : lightning_inti @@ -113,6 +114,11 @@ SUBROUTINE CESMGC_Emissions_Init( lght_no_prd_factor ) INTEGER :: IERR INTEGER :: N, II + ! Logicals + LOGICAL :: history_aerosol + LOGICAL :: history_chemistry + LOGICAL :: history_cesm_forcing + ! Strings CHARACTER(LEN=255) :: SpcName CHARACTER(LEN=255) :: Description @@ -124,6 +130,10 @@ SUBROUTINE CESMGC_Emissions_Init( lght_no_prd_factor ) ! CESMGC_Emissions_Init begins here! !================================================================= + CALL phys_getopts( history_aerosol_out = history_aerosol, & + history_chemistry_out = history_chemistry, & + history_cesm_forcing_out = history_cesm_forcing ) + ! Get constituent index for NO CALL cnst_get_ind('NO', iNO, abort=.True.) @@ -216,9 +226,9 @@ SUBROUTINE CESMGC_Emissions_Init( lght_no_prd_factor ) CALL Addfld( 'MEG_'//TRIM(SpcName), horiz_only, 'A', 'kg/m2/s', & Description ) - !if (history_chemistry) then - CALL Add_default('MEG_'//TRIM(SpcName), 1, ' ') - !endif + IF ( history_chemistry ) THEN + CALL Add_default('MEG_'//TRIM(SpcName), 1, ' ') + ENDIF ENDDO ENDIF @@ -229,9 +239,21 @@ SUBROUTINE CESMGC_Emissions_Init( lght_no_prd_factor ) SpcName = TRIM(cnst_name(N))//'_CLXF' CALL Addfld( TRIM(SpcName), horiz_only, 'A', 'molec/cm2/s', & 'Vertically-integrated external forcing for '//TRIM(cnst_name(N))) + IF ( history_aerosol .OR. history_chemistry ) THEN + CALL Add_Default( TRIM(SpcName), 1, ' ' ) + ENDIF + IF ( history_cesm_forcing .AND. TRIM(cnst_name(N)) == 'NO2' ) THEN + CALL Add_Default( TRIM(SpcName), 1, ' ' ) + ENDIF SpcName = TRIM(cnst_name(N))//'_CMXF' CALL Addfld( TRIM(SpcName), horiz_only, 'A', 'kg/m2/s', & 'Vertically-integrated external forcing for '//TRIM(cnst_name(N))) + IF ( history_aerosol .OR. history_chemistry ) THEN + CALL Add_Default( TRIM(SpcName), 1, ' ' ) + ENDIF + IF ( history_cesm_forcing .AND. TRIM(cnst_name(N)) == 'NO2' ) THEN + CALL Add_Default( TRIM(SpcName), 1, ' ' ) + ENDIF ENDDO CALL Addfld( 'NO_Lightning', (/ 'lev' /), 'A','molec/cm3/s', & diff --git a/src/chemistry/geoschem/chem_mods.F90 b/src/chemistry/geoschem/chem_mods.F90 index c2b9919a94..5e00fddcdb 100644 --- a/src/chemistry/geoschem/chem_mods.F90 +++ b/src/chemistry/geoschem/chem_mods.F90 @@ -7,13 +7,11 @@ module chem_mods implicit none save - INTEGER, PARAMETER :: nTracersMax = 250 ! Must be equal to nadv_chem - INTEGER :: nTracers - CHARACTER(LEN=255) :: tracerNames(nTracersMax) - CHARACTER(LEN=255) :: tracerLongNames(nTracersMax) - REAL(r8) :: adv_Mass(nTracersMax) - REAL(r8) :: MWRatio(nTracersMax) - REAL(r8) :: ref_MMR(nTracersMax) + INTEGER, PARAMETER :: nTracersMax = 238 ! Must be equal to chem_nadv + INTEGER :: nTracers + CHARACTER(LEN=255) :: tracerNames(nTracersMax) + CHARACTER(LEN=255) :: tracerLongNames(nTracersMax) + REAL(r8) :: ref_MMR(pcnst) ! Index of first constituent INTEGER :: iFirstCnst diff --git a/src/chemistry/geoschem/chemistry.F90 b/src/chemistry/geoschem/chemistry.F90 index d01db107cd..7b568b72b8 100644 --- a/src/chemistry/geoschem/chemistry.F90 +++ b/src/chemistry/geoschem/chemistry.F90 @@ -433,9 +433,6 @@ subroutine chem_register ! cnstName = 'TOLUENE' ENDIF - ! For debug, only - !If ( MasterProc ) Write(iulog,*) " Species = ", TRIM(cnstName) - CALL cnst_add( cnstName, MWtmp, cptmp, qmin, N, & readiv=ic_from_cam2, mixtype=mixtype, & cam_outfld=camout, molectype=molectype, & @@ -2212,6 +2209,8 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) DO SM = 1, nspec_amode(M) P = map2MAM4(SM,M) IF ( P <= 0 ) CYCLE + ! Overwrite MMR_Beg with MAM value + MMR_Beg(:nY,:nZ,P) = State_Chm(LCHNK)%Species(1,:nY,:nZ,P) N = lmassptr_amode(SM,M) DO J = 1, nY DO L = 1, nZ @@ -2451,7 +2450,7 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) DO J = 1, nY State_Met(LCHNK)%LandTypeFrac(1,J,N) = pbuf_i(J) ENDDO - pbuf_ik => NULL() + pbuf_i => NULL() ENDIF Write(FieldName, '(a,i2.2)') 'HCO_XLAI', N-1 @@ -2463,7 +2462,7 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) DO J = 1, nY State_Met(LCHNK)%XLAI_NATIVE(1,J,N) = pbuf_i(J) ENDDO - pbuf_ik => NULL() + pbuf_i => NULL() ENDIF ENDDO ENDIF @@ -3715,6 +3714,12 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) CALL Error_Stop( ErrMsg, ThisLoc ) ENDIF + ! GEOS-Chem considers CO2 as a dead species and resets its concentration + ! internally. Right after the call to `Do_Chemistry`, State_Chm%Species(iCO2) + ! corresponds to the chemically-produced CO2. The real CO2 concentration + ! is thus the concentration before chemistry + the chemically-produced CO2. + State_Chm(LCHNK)%Species(1,:nY,:nZ,iCO2) = State_Chm(LCHNK)%Species(1,:nY,:nZ,iCO2) & + + MMR_Beg(:nY,:nZ,iCO2) ! Make sure State_Chm(LCHNK) is back in kg/kg dry! IF ( TRIM(State_Chm(LCHNK)%Spc_Units) /= 'kg/kg dry' ) THEN @@ -3731,43 +3736,34 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(FieldName) ELSE pbuf_chnk => pbuf_get_chunk(hco_pbuf2d, LCHNK) - CALL pbuf_get_field(pbuf_chnk, tmpIdx, pbuf_ik) + CALL pbuf_get_field(pbuf_chnk, tmpIdx, pbuf_i) ! RXN_NO2: NO2 + hv --> NO + O - pbuf_ik(:nY,:nZ) = ZPJ(nZ:1:-1, RXN_NO2, 1, :nY) + pbuf_i(:nY) = ZPJ(1,RXN_NO2,1,:nY) pbuf_chnk => NULL() - pbuf_ik => NULL() + pbuf_i => NULL() ENDIF - FieldName = 'HCO_IN_JOH' tmpIdx = pbuf_get_index(FieldName, RC) IF ( tmpIdx < 0 .or. ( iStep == 1 ) ) THEN IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(FieldName) ELSE pbuf_chnk => pbuf_get_chunk(hco_pbuf2d, LCHNK) - CALL pbuf_get_field(pbuf_chnk, tmpIdx, pbuf_ik) + CALL pbuf_get_field(pbuf_chnk, tmpIdx, pbuf_i) IF ( Input_Opt%LUCX ) THEN - ! RXN_O3_1: O3 + hv --> O2 + O - pbuf_ik(:nY,:nZ) = ZPJ(nZ:1:-1, RXN_O3_1, 1, :nY) + ! RXN_O3_1: O3 + hv --> O2 + O + pbuf_i(:nY) = ZPJ(1,RXN_O3_1,1,:nY) ELSE - ! RXN_O3_2a: O3 + hv --> 2OH - pbuf_ik(:nY,:nZ) = ZPJ(nZ:1:-1, RXN_O3_2a, 1, :nY) + ! RXN_O3_2a: O3 + hv --> 2OH + pbuf_i(:nY) = ZPJ(1,RXN_O3_2a,1,:nY) ENDIF - pbuf_chnk => NULL() - pbuf_ik => NULL() + pbuf_i => NULL() ENDIF - ! GEOS-Chem considers CO2 as a dead species and resets its concentration - ! internally. Right after the call to `Do_Chemistry`, State_Chm%Species(iCO2) - ! corresponds to the chemically-produced CO2. The real CO2 concentration - ! is thus the concentration before chemistry + the chemically-produced CO2. - State_Chm(LCHNK)%Species(1,:nY,:nZ,iCO2) = State_Chm(LCHNK)%Species(1,:nY,:nZ,iCO2) & - + MMR_Beg(:nY,:nZ,iCO2) - call t_stopf( 'chemdr' ) !============================================================== diff --git a/src/chemistry/geoschem/mo_neu_wetdep.F90 b/src/chemistry/geoschem/mo_neu_wetdep.F90 index d31ab9d7f4..49a9acb3a0 100644 --- a/src/chemistry/geoschem/mo_neu_wetdep.F90 +++ b/src/chemistry/geoschem/mo_neu_wetdep.F90 @@ -226,12 +226,13 @@ subroutine neu_wetdep_init call addfld ('DTWR_'//trim(gas_wetdep_list(m)),(/ 'lev' /), 'A','kg/kg/s','wet removal Neu scheme tendency') call addfld ('WD_'//trim(gas_wetdep_list(m)),horiz_only, 'A','kg/m2/s','vertical integrated wet deposition flux') call addfld ('HEFF_'//trim(gas_wetdep_list(m)),(/ 'lev' /), 'A','M/atm','Effective Henrys Law coeff.') - call add_default('DTWR_'//trim(gas_wetdep_list(m)), 4, ' ') - call add_default('WD_'//trim(gas_wetdep_list(m)), 4, ' ') - !if (history_chemistry) then - ! call add_default('DTWR_'//trim(gas_wetdep_list(m)), 1, ' ') - ! call add_default('WD_'//trim(gas_wetdep_list(m)), 1, ' ') - !end if + call add_default('DTWR_'//trim(gas_wetdep_list(m)), 2, ' ') + call add_default('WD_'//trim(gas_wetdep_list(m)), 2, ' ') + !call add_default('HEFF_'//trim(gas_wetdep_list(m)), 2, ' ') + if (history_chemistry) then + call add_default('DTWR_'//trim(gas_wetdep_list(m)), 1, ' ') + call add_default('WD_'//trim(gas_wetdep_list(m)), 1, ' ') + end if end do ! if ( do_diag ) then @@ -481,7 +482,7 @@ subroutine neu_wetdep_tend(lchnk,ncol,mmr,pmid,pdel,zint,tfld,delt, & do m=1,gas_wetdep_cnt wd_tend(1:ncol,:,mapping_to_mmr(m)) = wd_tend(1:ncol,:,mapping_to_mmr(m)) + dtwr(1:ncol,:,m) call outfld( 'DTWR_'//trim(gas_wetdep_list(m)),dtwr(:,:,m),ncol,lchnk ) - + call outfld( 'HEFF_'//trim(gas_wetdep_list(m)),heff(:,pver:1:-1,m),ncol,lchnk ) ! ! vertical integrated wet deposition rate [kg/m2/s] diff --git a/src/chemistry/geoschem/mo_tracname.F90 b/src/chemistry/geoschem/mo_tracname.F90 index be9c474506..8e8a80b9a3 100644 --- a/src/chemistry/geoschem/mo_tracname.F90 +++ b/src/chemistry/geoschem/mo_tracname.F90 @@ -5,13 +5,10 @@ module mo_tracname ! surface fluxes for the advected species. !----------------------------------------------------------- - use chem_mods, only : nTracersMax + use chem_mods, only : gas_pcnst implicit none -! modified to an arbitrary high #, was gas_pcnst. this would cause a memory -! overflow overwrite in mo_sim_dat, which allocates :273 larger than -! the default specified gas_pcnst (hplin, 5/16/20) - character(len=16) :: solsym(318) ! species names + character(len=16) :: solsym(gas_pcnst) ! species names end module mo_tracname diff --git a/src/chemistry/modal_aero/modal_aero_gasaerexch.F90 b/src/chemistry/modal_aero/modal_aero_gasaerexch.F90 index aa7155a78a..b940757b1d 100644 --- a/src/chemistry/modal_aero/modal_aero_gasaerexch.F90 +++ b/src/chemistry/modal_aero/modal_aero_gasaerexch.F90 @@ -106,6 +106,7 @@ subroutine modal_aero_gasaerexch_sub( & use physconst, only: gravit, mwdry, rair use cam_abortutils, only: endrun use spmd_utils, only: iam, masterproc +use mo_chem_utls, only: utls_chem_is implicit none @@ -260,7 +261,11 @@ subroutine modal_aero_gasaerexch_sub( & ! set gas species indices call cnst_get_ind( 'H2SO4', l_so4g, .false. ) call cnst_get_ind( 'NH3', l_nh4g, .false. ) - call cnst_get_ind( 'MSA', l_msag, .false. ) + if ( .not. utls_chem_is('GEOS-Chem') ) then + call cnst_get_ind( 'MSA', l_msag, .false. ) + else + l_msag = 0 + endif l_so4g = l_so4g - loffset l_nh4g = l_nh4g - loffset l_msag = l_msag - loffset @@ -590,7 +595,6 @@ subroutine modal_aero_gasaerexch_sub( & end do mw_poa_host = 12.0_r8 mw_soa_host = 250.0_r8 - call modal_aero_soaexch( deltat, t(i,k), pmid(i,k), & niter, niter_max, ntot_amode, ntot_soamode, npoa, nsoa, & mw_poa_host, mw_soa_host, & From 2343800365dbd81c3435095d9bdf73a699acabec Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Wed, 24 Mar 2021 11:30:20 -0400 Subject: [PATCH 011/291] Feat: Retrieve ParaNOx deposition fluxes from HEMCO --- .../geoschem/cesmgc_emissions_mod.F90 | 96 +++++++++++++++++-- 1 file changed, 87 insertions(+), 9 deletions(-) diff --git a/src/chemistry/geoschem/cesmgc_emissions_mod.F90 b/src/chemistry/geoschem/cesmgc_emissions_mod.F90 index 4709699035..54d75a01b9 100644 --- a/src/chemistry/geoschem/cesmgc_emissions_mod.F90 +++ b/src/chemistry/geoschem/cesmgc_emissions_mod.F90 @@ -334,26 +334,29 @@ SUBROUTINE CESMGC_Emissions_Calc( state, hco_pbuf2d, State_Met, cam_in, eflx, iS INTEGER :: LCHNK INTEGER :: nY, nZ INTEGER :: J, L, N - INTEGER :: RC ! return code - INTEGER :: tmpIdx ! pbuf field id + INTEGER :: RC ! return code + INTEGER :: tmpIdx ! pbuf field id + + INTEGER :: id_O3, id_HNO3 ! Species IDs for reuse ! Logical LOGICAL :: rootChunk ! Objects - TYPE(physics_buffer_desc), POINTER :: pbuf_chnk(:) ! slice of pbuf in current chunk + TYPE(physics_buffer_desc), POINTER :: pbuf_chnk(:) ! slice of pbuf in current chunk ! Real - REAL(r8), POINTER :: pbuf_ik(:,:) ! pointer to pbuf data (/pcols,pver/) - REAL(r8), DIMENSION(state%NCOL,PVER+1) :: zint ! Interface geopotential in km - REAL(r8), DIMENSION(state%NCOL) :: zsurf ! Surface height - REAL(r8) :: SCALFAC ! Multiplying factor - REAL(r8) :: megflx(pcols) ! For MEGAN emissions + REAL(r8), POINTER :: pbuf_ik(:,:) ! pointer to pbuf data (/pcols,pver/) + REAL(r8), POINTER :: pbuf_i(:) ! pointer to 2-D (1-D in CAM) data (/pcols/) + REAL(r8), DIMENSION(state%NCOL,PVER+1) :: zint ! Interface geopotential in km + REAL(r8), DIMENSION(state%NCOL) :: zsurf ! Surface height + REAL(r8) :: SCALFAC ! Multiplying factor + REAL(r8) :: megflx(pcols) ! For MEGAN emissions REAL(r8), PARAMETER :: m2km = 1.e-3_r8 ! Strings CHARACTER(LEN=255) :: SpcName - CHARACTER(LEN=255) :: fldname_ns ! field name HCO_* + CHARACTER(LEN=255) :: fldname_ns ! field name HCO_* !================================================================= ! CESMGC_Emissions_Calc begins here! @@ -362,6 +365,7 @@ SUBROUTINE CESMGC_Emissions_Calc( state, hco_pbuf2d, State_Met, cam_in, eflx, iS ! Initialize pointers pbuf_chnk => NULL() pbuf_ik => NULL() + pbuf_i => NULL() ! LCHNK: which chunk we have on this process LCHNK = state%LCHNK @@ -410,6 +414,80 @@ SUBROUTINE CESMGC_Emissions_Calc( state, hco_pbuf2d, State_Met, cam_in, eflx, iS ENDIF ENDDO + !----------------------------------------------------------------------- + ! Deposition fluxes from HEMCO + !----------------------------------------------------------------------- + + ! Part 1: Eventually retrieve deposition velocities [1/s] from HEMCO + ! and convert to negative flux and apply. + ! TODO hplin 3/24/21 + + + ! Part 2: Handle special deposition fluxes for the ParaNOx extension + ! for PAR_O3_DEP and PAR_HNO3_DEP + CALL cnst_get_ind('O3', id_O3) + CALL cnst_get_ind('HNO3', id_HNO3) + + ! write(iulog,*) 'id_O3, cnst_name, id_HNO3, cnst_name', id_O3, cnst_name(id_O3), id_HNO3, cnst_name(id_HNO3) + + tmpIdx = pbuf_get_index('HCO_PAR_O3_DEP', RC) + IF(tmpIdx < 0 .OR. ( iStep == 1 )) then + ! No ParaNOx dep flux for O3 + ELSE + pbuf_chnk => pbuf_get_chunk(hco_pbuf2d, LCHNK) + CALL pbuf_get_field(pbuf_chnk, tmpIdx, pbuf_i) + + IF ( .NOT. ASSOCIATED(pbuf_i) ) THEN ! Sanity check + CALL ENDRUN("CESMGC_Emissions_Calc: FATAL - tmpIdx > 0 but pbuf_i not associated (2)") + ENDIF + + ! apply loss flux to surface (level nZ) + eflx(1:NY,nZ,id_O3) = eflx(1:NY,nZ,id_O3) - pbuf_i(1:nY) + + IF ( MINVAL(eflx(:nY,nZ,id_O3)) < 0.0e+00_r8 ) THEN + Write(iulog,*) " CESMGC_Emissions_Calc: HEMCO sfc flux after ParaNOx is negative for O3 with value ", MINVAL(eflx(:nY,:nZ,id_O3)), " at ", & + MINLOC(eflx(:nY,nZ,id_O3)) + ENDIF + + IF ( rootChunk .and. ( MINVAL(pbuf_i(1:nY)) < 0.0e+0_r8 ) ) THEN + Write(iulog,'(a,a,a,a)') " CESMGC_Emissions_Calc: HEMCO dflx(paranox) O3 added to ", TRIM(cnst_name(id_O3)) + Write(iulog,'(a,a,E16.4)') " CESMGC_Emissions_Calc: Minval dflx(paranox), eflx(sfc) O3 ", MINVAL(pbuf_i(1:nY)), MINVAL(eflx(:nY,nZ,id_O3)) + ENDIF + + ! Reset pointers + pbuf_i => NULL() + pbuf_chnk => NULL() + ENDIF + + tmpIdx = pbuf_get_index('HCO_PAR_HNO3_DEP', RC) + IF(tmpIdx < 0 .OR. ( iStep == 1 )) then + ! No ParaNOx dep flux for HNO3 + ELSE + pbuf_chnk => pbuf_get_chunk(hco_pbuf2d, LCHNK) + CALL pbuf_get_field(pbuf_chnk, tmpIdx, pbuf_i) + + IF ( .NOT. ASSOCIATED(pbuf_i) ) THEN ! Sanity check + CALL ENDRUN("CESMGC_Emissions_Calc: FATAL - tmpIdx > 0 but pbuf_i not associated (3)") + ENDIF + + eflx(1:NY,nZ,id_HNO3) = eflx(1:NY,nZ,id_HNO3) - pbuf_i(1:nY) + + IF ( MINVAL(eflx(:nY,nZ,id_HNO3)) < 0.0e+00_r8 ) THEN + Write(iulog,*) " CESMGC_Emissions_Calc: HEMCO sfc flux after ParaNOx is negative for HNO3 with value ", MINVAL(eflx(:nY,nZ,id_HNO3)), " at ", & + MINLOC(eflx(:nY,nZ,id_HNO3)) + ENDIF + + IF ( rootChunk .and. ( MINVAL(pbuf_i(1:nY)) < 0.0e+0_r8 ) ) THEN + Write(iulog,'(a,a,a,a)') " CESMGC_Emissions_Calc: HEMCO dflx(paranox) HNO3 added to ", TRIM(cnst_name(id_HNO3)) + Write(iulog,'(a,a,E16.4)') " CESMGC_Emissions_Calc: Minval dflx(paranox), eflx(sfc) HNO3 ", MINVAL(pbuf_i(1:nY)), MINVAL(eflx(:nY,nZ,id_HNO3)) + ENDIF + + ! Reset pointers + pbuf_i => NULL() + pbuf_chnk => NULL() + ENDIF + + #if defined( MODAL_AERO_4MODE ) !----------------------------------------------------------------------- ! Aerosol emissions (dust + seasalt) ... From b1d572e117d2380060cd4d49393d16e3a9bbb707 Mon Sep 17 00:00:00 2001 From: Thibaud Fritz Date: Tue, 23 Mar 2021 22:34:39 -0400 Subject: [PATCH 012/291] Squashed 18 commits from Thibaud Fritz Feat: Revert mo_drydep to MOZART's version + Update chemistry.F90 (1) Note that most of the mo_drydep routines are unused. We only need to load in landtypes for MAM Feat: Add aerosol number emissions in CESM-GC (1) Emission diameters are taken from: Emmons, Louisa K., et al. "The chemistry mechanism in the Community Earth System Model version 2 (CESM2)." Journal of Advances in Modeling Earth Systems 12.4 (2020). Feat: Lump GEOS-Chem SO4 with so4_a* and H2SO4 Fix: Remove hard-wired number emissions as this has been moved to HEMCO Feat: Update .xml files with GEOS-Chem chemistry (MEGAN) Feat: Add MEGAN emissions with GEOS-Chem species Fix: Update IF condition for SRF diagnostics Feat: Add hemco_nl in build-namelist Feat: Rename geoschem.xml to 2000_geoscheml.xml (FC2000climo_GC) Feat: Add 2010_geoscheml.xml (FC2010climo_GC) Feat: Update config_component to reflect recent changes to xml files Feat: Add SOA mapping between MAM and GEOS-Chem complex SOA option (1) Add mapping (2) Extend number of constituents Feat: Add AEIC organic species to external forcings list Feat: Add GEOS-Chem surface boundary conditions Feat: Update .gitignore to exclude GEOS-Chem source code Fix: Fix for sulfur mapping between CESM2 and GEOS-Chem (1) SO4_gasRatio and binRatio are in mol/mol, not kg/kg Feat: Update .exclude for GEOS-Chem 13.1 Fix: Update in-cloud opticaldepth with cloud fractions --- .gitignore | 2 +- bld/build-namelist | 3 + bld/configure | 2 +- .../{geoschem.xml => 2000_geoschem.xml} | 29 +- .../use_cases/2010_geoschem.xml | 91 + .../use_cases/hist_geoschem.xml | 49 +- bld/namelist_files/use_cases/sd_geoschem.xml | 62 +- cime_config/config_component.xml | 4 +- src/chemistry/geoschem/.exclude | 3 - src/chemistry/geoschem/cesmgc_diag_mod.F90 | 19 +- .../geoschem/cesmgc_emissions_mod.F90 | 144 +- src/chemistry/geoschem/chem_mods.F90 | 4 +- src/chemistry/geoschem/chemistry.F90 | 800 +++- src/chemistry/geoschem/mo_drydep.F90 | 3495 +---------------- src/chemistry/geoschem/mo_neu_wetdep.F90 | 12 +- src/chemistry/geoschem/mo_sim_dat.F90 | 697 +--- .../pp_trop_strat_mam4_vbs/chem_mods.F90 | 2 +- .../pp_trop_strat_mam4_vbs/mo_sim_dat.F90 | 14 +- .../pp_trop_strat_mam4_vbsext/chem_mods.F90 | 2 +- .../pp_trop_strat_mam4_vbsext/mo_sim_dat.F90 | 10 +- 20 files changed, 1008 insertions(+), 4436 deletions(-) rename bld/namelist_files/use_cases/{geoschem.xml => 2000_geoschem.xml} (89%) create mode 100644 bld/namelist_files/use_cases/2010_geoschem.xml mode change 100644 => 120000 src/chemistry/geoschem/mo_drydep.F90 diff --git a/.gitignore b/.gitignore index fcb95837b8..2ff73275bf 100644 --- a/.gitignore +++ b/.gitignore @@ -7,7 +7,7 @@ src/physics/carma/base src/physics/clubb src/physics/cosp2/src src/physics/silhs -src/chemistry/pp_geoschem/geoschem_src +src/chemistry/geoschem/geoschem_src src/hemco # Ignore compiled python diff --git a/bld/build-namelist b/bld/build-namelist index a14d37639e..1558babc94 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -2787,6 +2787,9 @@ else { } } +# HEMCO +$nl->set_variable_value('hemco_nl', 'hemco_config_File', "'HEMCO_Config.rc'"); + # Physics options # Add the name of the physics package based on the info in configure. If the user tries diff --git a/bld/configure b/bld/configure index f026dcd844..9dbb968970 100755 --- a/bld/configure +++ b/bld/configure @@ -1441,7 +1441,7 @@ if ($chem_pkg =~ '_mam3') { # TMMF - wedge in GEOS-Chem CPP definitions here if ($chem_pkg =~ 'geoschem') { $chem_cppdefs .= ' -DEXTERNAL_GRID -DEXTERNAL_FORCING -DLINUX_IFORT -DUSE_REAL8 -DMODEL_ -DMODEL_CESM'; - $chem_nadv = 238; + $chem_nadv = 251; if (defined $opts{'clm_vers'}) { if ($opts{'clm_vers'} =~ 'CLM4.0') { $chem_cppdefs .= ' -DCLM40' diff --git a/bld/namelist_files/use_cases/geoschem.xml b/bld/namelist_files/use_cases/2000_geoschem.xml similarity index 89% rename from bld/namelist_files/use_cases/geoschem.xml rename to bld/namelist_files/use_cases/2000_geoschem.xml index ecdb9aaa06..7b4aa03782 100644 --- a/bld/namelist_files/use_cases/geoschem.xml +++ b/bld/namelist_files/use_cases/2000_geoschem.xml @@ -5,9 +5,32 @@ /glade/p/univ/umit0034/ExtData/CHEM_INPUTS/ -/glade/p/univ/umit0034/Shared/f.e20.FWAMIP.f09_f09.134.1975.009.cam.i.2010-01-01_32L_c170403.nc - -/glade/p/univ/umit0034/Shared/f.e20.FWAMIP.f19_f19.134.1975.009.cam.i.2010-01-01_32L_c170403.nc +/glade/p/univ/umit0034/Shared/GEOS-Chem/f.e20.FC2010.f09_f09.144.GC_vbsext.001.cam.i.0007-01-01-00000.nc + +/glade/p/univ/umit0034/Shared/GEOS-Chem/f.e20.FC2010.f19_f19.144.GC_vbsext.001.cam.i.0007-01-01-00000.nc + + + + 'ISOP = isoprene', + 'MOH = methanol', + 'EOH = ethanol', + 'CH2O = formaldehyde', + 'ALD2 = acetaldehyde', + 'ACTA = acetic_acid', + 'ACET = acetone', + 'HCOOH = formic_acid', + 'HCN = hydrogen_cyanide', + 'CO = carbon_monoxide', + 'C2H6 = ethane', + 'C2H4 = ethene', + 'C3H8 = propane', + 'ALK4 = pentane + hexane + heptane + tricyclene', + 'PRPE = propene + butene', + 'TOLU = toluene', + 'LIMO = limonene', + 'MTPA = pinene_a + pinene_b + sabinene + carene_3', + 'MTPO = terpinene_g + terpinene_a + terpinolene + myrcene + ocimene_al + ocimene_t_b + ocimene_c_b + thujene_a + 2met_styrene + cymene_p + cymene_o + bornene + fenchene_a + camphene + phellandrene_a + phellandrene_b' + atm/cam/solar/SolarForcing1995-2005avg_c160929.nc diff --git a/bld/namelist_files/use_cases/2010_geoschem.xml b/bld/namelist_files/use_cases/2010_geoschem.xml new file mode 100644 index 0000000000..6d10dd02df --- /dev/null +++ b/bld/namelist_files/use_cases/2010_geoschem.xml @@ -0,0 +1,91 @@ + + + + +00010101 + +/glade/p/univ/umit0034/ExtData/CHEM_INPUTS/ + +/glade/p/univ/umit0034/Shared/GEOS-Chem/f.e20.FC2010.f09_f09.144.GC_vbsext.001.cam.i.0007-01-01-00000.nc + +/glade/p/univ/umit0034/Shared/GEOS-Chem/f.e20.FC2010.f19_f19.144.GC_vbsext.001.cam.i.0007-01-01-00000.nc + + + + 'ISOP = isoprene', + 'MOH = methanol', + 'EOH = ethanol', + 'CH2O = formaldehyde', + 'ALD2 = acetaldehyde', + 'ACTA = acetic_acid', + 'ACET = acetone', + 'HCOOH = formic_acid', + 'HCN = hydrogen_cyanide', + 'CO = carbon_monoxide', + 'C2H6 = ethane', + 'C2H4 = ethene', + 'C3H8 = propane', + 'ALK4 = pentane + hexane + heptane + tricyclene', + 'PRPE = propene + butene', + 'TOLU = toluene', + 'LIMO = limonene', + 'MTPA = pinene_a + pinene_b + sabinene + carene_3', + 'MTPO = terpinene_g + terpinene_a + terpinolene + myrcene + ocimene_al + ocimene_t_b + ocimene_c_b + thujene_a + 2met_styrene + cymene_p + cymene_o + bornene + fenchene_a + camphene + phellandrene_a + phellandrene_b' + + + +atm/cam/solar/SolarForcing2006-2014avg_c180917.nc +20100101 +FIXED + +'xactive_lnd' + + +.true. +.true. +.false. +0.25D0 + + +CYCLICAL +2010 +atm/waccm/lb/LBC_2010climo_CMIP6_0p5degLat_c180227.nc + + + + + 1,30,365,240,240,480,365,73,30 + 0,-24,-24,-3,-1,1,-24,-120,-240 +'A','A','A','A','A','A','A','A','I' + +.true. +.false. +.false. +.false. +.false. +.false. +.false. +.false. +.false. + + + 'Q', 'U', 'V', 'OMEGA', 'T', 'PS', + + + + 'ACET','ACTA','ALD2','ASOG1','ASOG2','ASOG3','ATOOH','BR2','BRCL','BRNO3','CH2O','CL2','CLNO2','CLNO3','CLO','CLOO','EOH','ETHLN','ETNO3','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HG0','HG0_ANT','HG0_ARC','HG0_ATL','HG0_BB','HG0_CAM','HG0_CAN','HG0_EAF','HG0_EAS','HG0_EEU','HG0_EUR','HG0_GEO','HG0_JPN','HG0_MDE','HG0_NAF','HG0_NAT','HG0_NPA','HG0_OCE','HG0_OCN','HG0_SAF','HG0_SAM','HG0_SAS','HG0_SAT','HG0_SEA','HG0_SO','HG0_SOV','HG0_STR','HG0_USA','HG0_WAF','HG2','HG2_ANT','HG2_ARC','HG2_ATL','HG2_BB','HG2_CAM','HG2_CAN','HG2_EAF','HG2_EAS','HG2_EEU','HG2_EUR','HG2_GEO','HG2_JPN','HG2_MDE','HG2_NAF','HG2_NAT','HG2_NPA','HG2_OCE','HG2_OCN','HG2_SAF','HG2_SAM','HG2_SAS','HG2_SAT','HG2_SEA','HG2_SO','HG2_SOV','HG2_STR','HG2_USA','HG2_WAF','HI','HMHP','HMML','HNO3','HOBR','HOCL','HOI','HONIT','HPALD1','HPALD2','HPALD3','HPALD4','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDC','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','IPRNO3','ITCN','ITHN','LIMO','LVOC','MACR','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MENO3','MGLY','MOH','MONITS','MONITU','MPAN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','N2O5','NH3','NO2','NPRNO3','O3','O3AFBL','O3ASBL','O3ATBL','O3EUBL','O3INIT','O3MT','O3NABL','O3PCBL','O3ROW','O3STRAT','O3USA','O3UT','OPOG1','OPOG2','PAN','POG1','POG2','POPG_BAP','POPG_PHE','POPG_PYR','PP','PPN','PROPNN','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2','TSOG0','TSOG1','TSOG2','TSOG3','AERI','ASOA1','ASOA2','ASOA3','ASOAN','BCPI','BCPO','BE10','BE10STRAT','BE7','BE7STRAT','BRSALA','BRSALC','DST1','DST2','DST3','DST4','DSTAL1','DSTAL2','DSTAL3','DSTAL4','HGP','HGP_ANT','HGP_ARC','HGP_ATL','HGP_BB','HGP_CAM','HGP_CAN','HGP_EAF','HGP_EAS','HGP_EEU','HGP_EUR','HGP_GEO','HGP_JPN','HGP_MDE','HGP_NAF','HGP_NAT','HGP_NPA','HGP_OCE','HGP_OCN','HGP_SAF','HGP_SAM','HGP_SAS','HGP_SAT','HGP_SEA','HGP_SO','HGP_SOV','HGP_STR','HGP_USA','HGP_WAF','INDIOL','IONITA','ISALA','ISALC','LVOCOA','MONITA','MOPI','MOPO','MSA','NH4','NIT','NITD1','NITD2','NITD3','NITD4','NITS','OCPI','OCPO','OPOA1','OPOA2','PB210','PB210STRAT','PFE','POA1','POA2','POPPBCPI_BAP','POPPBCPI_PHE','POPPBCPI_PYR','POPPBCPO_BAP','POPPBCPO_PHE','POPPBCPO_PYR','POPPOCPI_BAP','POPPOCPI_PHE','POPPOCPI_PYR','POPPOCPO_BAP','POPPOCPO_PHE','POPPOCPO_PYR','SALA','SALAAL','SALACL','SALC','SALCAL','SALCCL','SO4','SO4D1','SO4D2','SO4D3','SO4D4','SO4S','SOAGX','SOAIE','SOAS','TSOA0','TSOA1','TSOA2','TSOA3', + + + + 'dst_a1','so4_a1','nh4_a1','pom_a1','pomff1_a1','pombb1_a1','soa_a1','bc_a1','ncl_a1','num_a1','so4_a2','nh4_a2','soa_a2','ncl_a2','dst_a2','num_a2','dst_a3','ncl_a3','so4_a3','pom_a3','bc_a3','num_a3','ncl_a4','so4_a4','pom_a4','pomff1_a4','pombb1_a4','bc_a4','nh4_a4','num_a4','dst_a5','so4_a5','nh4_a5','num_a5','ncl_a6','so4_a6','nh4_a6','num_a6','dst_a7','so4_a7','nh4_a7','num_a7','soa1_a1','soa1_a2','soa2_a1','soa2_a2','soa3_a1','soa3_a2','soa4_a1','soa4_a2','soa5_a1','soa5_a2','soaff1_a1','soaff2_a1','soaff3_a1','soaff4_a1','soaff5_a1','soabb1_a1','soabb2_a1','soabb3_a1','soabb4_a1','soabb5_a1','soabg1_a1','soabg2_a1','soabg3_a1','soabg4_a1','soabg5_a1','soaff1_a2','soaff2_a2','soaff3_a2','soaff4_a2','soaff5_a2','soabb1_a2','soabb2_a2','soabb3_a2','soabb4_a2','soabb5_a2','soabg1_a2','soabg2_a2','soabg3_a2','soabg4_a2','soabg5_a2' + + + + 'ACTA','ALD2','ASOG1','ASOG2','ASOG3','ATOOH','BR2','BRCL','CH2O','EOH','ETHLN','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HG2','HG2_ANT','HG2_ARC','HG2_ATL','HG2_BB','HG2_CAM','HG2_CAN','HG2_EAF','HG2_EAS','HG2_EEU','HG2_EUR','HG2_GEO','HG2_JPN','HG2_MDE','HG2_NAF','HG2_NAT','HG2_NPA','HG2_OCE','HG2_OCN','HG2_SAF','HG2_SAM','HG2_SAS','HG2_SAT','HG2_SEA','HG2_SO','HG2_SOV','HG2_STR','HG2_USA','HG2_WAF','HI','HMHP','HMML','HNO3','HOBR','HOCL','HOI','HONIT','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','ITCN','ITHN','LIMO','LVOC','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MEK','MGLY','MOH','MONITS','MONITU','MP','MPAN','MPN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','NH3','OPOG1','OPOG2','PAN','POG1','POG2','POPG_BAP','POPG_PHE','POPG_PYR','PP','PPN','PROPNN','PRPE','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2','TSOG0','TSOG1','TSOG2','TSOG3','AERI','ASOA1','ASOA2','ASOA3','ASOAN','BCPI','BCPO','BE10','BE10STRAT','BE7','BE7STRAT','BRSALA','BRSALC','DST1','DST2','DST3','DST4','DSTAL1','DSTAL2','DSTAL3','DSTAL4','HGP','HGP_ANT','HGP_ARC','HGP_ATL','HGP_BB','HGP_CAM','HGP_CAN','HGP_EAF','HGP_EAS','HGP_EEU','HGP_EUR','HGP_GEO','HGP_JPN','HGP_MDE','HGP_NAF','HGP_NAT','HGP_NPA','HGP_OCE','HGP_OCN','HGP_SAF','HGP_SAM','HGP_SAS','HGP_SAT','HGP_SEA','HGP_SO','HGP_SOV','HGP_STR','HGP_USA','HGP_WAF','INDIOL','IONITA','ISALA','ISALC','LVOCOA','MONITA','MOPI','MOPO','MSA','NH4','NIT','NITD1','NITD2','NITD3','NITD4','NITS','OCPI','OCPO','OPOA1','OPOA2','PB210','PB210STRAT','PFE','POA1','POA2','POPPBCPI_BAP','POPPBCPI_PHE','POPPBCPI_PYR','POPPBCPO_BAP','POPPBCPO_PHE','POPPBCPO_PYR','POPPOCPI_BAP','POPPOCPI_PHE','POPPOCPI_PYR','POPPOCPO_BAP','POPPOCPO_PHE','POPPOCPO_PYR','SALA','SALAAL','SALACL','SALC','SALCAL','SALCCL','SO4','SO4D1','SO4D2','SO4D3','SO4D4','SO4S','SOAGX','SOAIE','SOAS','TSOA0','TSOA1','TSOA2','TSOA3', + + + + 'dst_a1','so4_a1','nh4_a1','pom_a1','pomff1_a1','pombb1_a1','soa_a1','bc_a1','ncl_a1','num_a1','so4_a2','nh4_a2','soa_a2','ncl_a2','dst_a2','num_a2','dst_a3','ncl_a3','so4_a3','pom_a3','bc_a3','num_a3','ncl_a4','so4_a4','pom_a4','pomff1_a4','pombb1_a4','bc_a4','nh4_a4','num_a4','dst_a5','so4_a5','nh4_a5','num_a5','ncl_a6','so4_a6','nh4_a6','num_a6','dst_a7','so4_a7','nh4_a7','num_a7','soa1_a1','soa1_a2','soa2_a1','soa2_a2','soa3_a1','soa3_a2','soa4_a1','soa4_a2','soa5_a1','soa5_a2','soaff1_a1','soaff2_a1','soaff3_a1','soaff4_a1','soaff5_a1','soabb1_a1','soabb2_a1','soabb3_a1','soabb4_a1','soabb5_a1','soabg1_a1','soabg2_a1','soabg3_a1','soabg4_a1','soabg5_a1','soaff1_a2','soaff2_a2','soaff3_a2','soaff4_a2','soaff5_a2','soabb1_a2','soabb2_a2','soabb3_a2','soabb4_a2','soabb5_a2','soabg1_a2','soabg2_a2','soabg3_a2','soabg4_a2','soabg5_a2' + + + diff --git a/bld/namelist_files/use_cases/hist_geoschem.xml b/bld/namelist_files/use_cases/hist_geoschem.xml index 8d8dce5377..9eac1a5be6 100644 --- a/bld/namelist_files/use_cases/hist_geoschem.xml +++ b/bld/namelist_files/use_cases/hist_geoschem.xml @@ -6,9 +6,32 @@ /glade/p/univ/umit0034/ExtData/CHEM_INPUTS/ -/glade/p/univ/umit0034/Shared/f.e20.FWAMIP.f09_f09.134.1975.009.cam.i.2010-01-01_32L_c170403.nc - -/glade/p/univ/umit0034/Shared/f.e20.FWAMIP.f19_f19.134.1975.009.cam.i.2010-01-01_32L_c170403.nc +/glade/p/univ/umit0034/Shared/GEOS-Chem/f.e20.FC2010.f09_f09.144.GC_vbsext.001.cam.i.0007-01-01-00000.nc + +/glade/p/univ/umit0034/Shared/GEOS-Chem/f.e20.FC2010.f19_f19.144.GC_vbsext.001.cam.i.0007-01-01-00000.nc + + + + 'ISOP = isoprene', + 'MOH = methanol', + 'EOH = ethanol', + 'CH2O = formaldehyde', + 'ALD2 = acetaldehyde', + 'ACTA = acetic_acid', + 'ACET = acetone', + 'HCOOH = formic_acid', + 'HCN = hydrogen_cyanide', + 'CO = carbon_monoxide', + 'C2H6 = ethane', + 'C2H4 = ethene', + 'C3H8 = propane', + 'ALK4 = pentane + hexane + heptane + tricyclene', + 'PRPE = propene + butene', + 'TOLU = toluene', + 'LIMO = limonene', + 'MTPA = pinene_a + pinene_b + sabinene + carene_3', + 'MTPO = terpinene_g + terpinene_a + terpinolene + myrcene + ocimene_al + ocimene_t_b + ocimene_c_b + thujene_a + 2met_styrene + cymene_p + cymene_o + bornene + fenchene_a + camphene + phellandrene_a + phellandrene_b' + atm/cam/solar/SolarForcingCMIP6_18491230-23000102_c20200615.nc @@ -52,7 +75,7 @@ 'AODDUST', 'AODDUST2', 'T', 'U', 'V', 'O3', 'OH', 'NO3', 'HO2', 'LNO_COL_PROD', 'NO2_CLXF', 'SFNO', 'SFNH3', 'BRO', - 'CH3CL', 'CLO', 'CO2', 'HCL', 'HO2', 'HOCL', 'H2O', 'PHIS', 'Z3', + 'CH3CL', 'CLO', 'CO2', 'HCL', 'HO2', 'HOCL', 'PHIS', 'Z3', 'BENZ', 'C2H6', 'C3H8', 'CCL4', 'CFC11', 'CFC113', 'CFC12', 'CH2O', 'CH3BR', 'CH3CCL3', 'ALD2', 'CH3CL', 'ACET', 'MOH', 'CH4', 'CO', 'H2O2', 'HCFC22', 'HNO3', 'ISOP', 'MTPA', 'N2O', 'O3', @@ -68,8 +91,10 @@ 'IHN4', 'INO2B', 'INO2D', 'INPB', 'INPD', 'RIPA', 'RIPB', 'RIPC', 'RIPD', 'MACR', 'MVKHP', 'MEK', 'MCRDH', 'MPAN', 'MVK', 'N', 'N2O', 'N2O5', 'ICN', 'NH3', 'NH4', 'NO', 'NO2', 'NO3', 'PROPNN', 'OLND', 'OLNN', 'O', 'OCLO', - 'OCS', 'PAN', 'SO2', 'SO4', 'SOAP', 'TOLU', 'XYLE', + 'OCS', 'PAN', 'SO2', 'SO4', 'TOLU', 'XYLE', 'R4O2', 'BRO2', 'ETO2', 'A3O2', 'MCO3', 'MO2', 'HO2', 'O1D', 'OH', + 'TSOA0', 'TSOA1', 'TSOA2', 'TSOA3', 'ASOAN', 'ASOA1', 'ASOA2', 'ASOA3', + 'SOAIE', 'SOAGX', 'H2O', 'SAD_PSC', 'SAD_SULFC', 'SAD_TROP', 'SAD_AERO', 'REFF_AERO', 'PDELDRY', 'RAD_PSC', 'RAD_SULFC', 'HNO3_GAS', 'HNO3_STS', 'HNO3_NAT', 'NOX', 'NOY', 'CLOX', 'CLOY', @@ -92,16 +117,16 @@ 'DF_HAC', 'DF_IEPOXA', 'DF_IEPOXB', 'DF_IEPOXD', 'DF_MPAN', 'DF_NH3', 'DF_NH4', 'DF_NO', 'DF_NO2', 'DF_O3', 'DF_PAN', 'DF_SO2', - 'DF_SOAP', 'SO2_CLXF', 'SO2_XFRC', - 'CO_CLXF', 'NO2_CLXF', 'LNO_PROD', 'LNO_COL_PROD', 'SOAP_CLXF', + 'SO2_CLXF', 'SO2_XFRC', + 'CO_CLXF', 'NO2_CLXF', 'LNO_PROD', 'LNO_COL_PROD', 'SFEOH', 'SFALD2', 'SFMEK', 'SFCH2O', 'SFC2H6', 'SFC3H8', 'SFALK4', 'SFPRPE', 'SFBENZ', 'SFTOLU', 'SFXYLE', 'SFNO', 'SFACTA', 'SFDMS', 'SFMEK', 'SFSO2', 'SFNH3', - 'SFISOP', 'SFMTPA', 'SFMOH', 'SFACET', 'SFCO', 'SFSOAP', - 'MEG_ISOP', 'MEG_MTERP', 'MEG_BCARY', 'MEG_CH3OH', 'MEG_C2H5OH', 'MEG_CH2O', - 'MEG_CH3CHO', 'MEG_CH3COOH', 'MEG_CH3COCH3', 'MEG_HCOOH', 'MEG_HCN', 'MEG_CO', - 'MEG_C2H6', 'MEG_C2H4', 'MEG_C3H8', 'MEG_C3H6', 'MEG_BIGALK', 'MEG_BIGENE', - 'MEG_TOLUENE', 'Dso4_a1CHM', 'Dso4_a2CHM', 'Dso4_a3CHM', 'DO3CHM', 'DCOCHM', + 'SFISOP', 'SFMTPA', 'SFMOH', 'SFACET', 'SFCO', + 'MEG_ISOP', 'MEG_MOH', 'MEG_EOH', 'MEG_CH2O', 'MEG_ALD2', 'MEG_ACTA', + 'MEG_ACET', 'MEG_HCOOH', 'MEG_HCN', 'MEG_CO', 'MEG_C2H6', 'MEG_C2H4', + 'MEG_C3H8', 'MEG_ALK4', 'MEG_PRPE', 'MEG_TOLU', 'MEG_LIMO', 'MEG_MTPA', + 'MEG_MTPO', 'Dso4_a1CHM', 'Dso4_a2CHM', 'Dso4_a3CHM', 'DO3CHM', 'DCOCHM', 'DHNO3CHM', 'DH2O2CHM', 'DO3CHM', 'DCOCHM', 'AQ_SO2', 'GS_SO2', 'SO2_CLXF', 'MASS', 'ABSORB', 'Jval_O3O1D', 'Jval_NO2', 'Jval_PAN', 'Jval_H2O2', 'Jval_Cl2O2', diff --git a/bld/namelist_files/use_cases/sd_geoschem.xml b/bld/namelist_files/use_cases/sd_geoschem.xml index 02c3508e54..e420cc20bb 100644 --- a/bld/namelist_files/use_cases/sd_geoschem.xml +++ b/bld/namelist_files/use_cases/sd_geoschem.xml @@ -6,14 +6,52 @@ /glade/p/univ/umit0034/ExtData/CHEM_INPUTS/ -/glade/p/univ/umit0034/Shared/f.e20.FWAMIP.f09_f09.134.1975.009.cam.i.2010-01-01_56L_c170403.nc +atm/cam/met/MERRA2/0.5x0.63/fv_0.47x0.63_nc3000_Co030_Fi001_PF_nullRR_Nsw021_MERRA2_c180612.nc + +/glade/p/univ/umit0034/Shared/GEOS-Chem/f.e20.FCSD.f09_f09_mg17.cesm2.1-exp002.001.cam.i.2005-01-01-00000_c180801.nc 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/0.5x0.63/fv_0.47x0.63_nc3000_Co030_Fi001_PF_nullRR_Nsw021_MERRA2_c180612.nc +/glade/p/univ/umit0034/Shared/GEOS-Chem/f.e20.FCSD.f19_f19_mg17.cesm2.1-exp002.001.cam.i.2005-01-01-00000_c180801.nc +atm/cam/met/MERRA2/1.9x2.5/fv_1.9x2.5_nc3000_Nsw084_Nrs016_Co120_Fi001_ZR_GRNL_MERRA2_c190617.nc + + + + 'ISOP = isoprene', + 'MOH = methanol', + 'EOH = ethanol', + 'CH2O = formaldehyde', + 'ALD2 = acetaldehyde', + 'ACTA = acetic_acid', + 'ACET = acetone', + 'HCOOH = formic_acid', + 'HCN = hydrogen_cyanide', + 'CO = carbon_monoxide', + 'C2H6 = ethane', + 'C2H4 = ethene', + 'C3H8 = propane', + 'ALK4 = pentane + hexane + heptane + tricyclene', + 'PRPE = propene + butene', + 'TOLU = toluene', + 'LIMO = limonene', + 'MTPA = pinene_a + pinene_b + sabinene + carene_3', + 'MTPO = terpinene_g + terpinene_a + terpinolene + myrcene + ocimene_al + ocimene_t_b + ocimene_c_b + thujene_a + 2met_styrene + cymene_p + cymene_o + bornene + fenchene_a + camphene + phellandrene_a + phellandrene_b' + 50. .true. +2005/MERRA2_1.9x2.5_20050101.nc +atm/cam/met/MERRA2/1.9x2.5 +atm/cam/met/MERRA2/1.9x2.5/filenames_list_c20210302 + +2005/MERRA2_0.9x1.25_20050101.nc +atm/cam/met/MERRA2/0.9x1.25 +atm/cam/met/MERRA2/0.9x1.25/filenames_1975-2017_c190125.txt + +2010/MERRA2_0.5x0.63_20100101.nc +atm/cam/met/MERRA2/0.5x0.63 +atm/cam/met/MERRA2/0.5x0.63/filenames_list_c180612 + 2005/MERRA2_0.9x1.25_20050101.nc atm/cam/met/MERRA2/0.9x1.25 atm/cam/met/MERRA2/0.9x1.25/filenames_1975-2017_c190125.txt @@ -62,7 +100,7 @@ 'AODDUST', 'AODDUST2', 'T', 'U', 'V', 'O3', 'OH', 'NO3', 'HO2', 'LNO_COL_PROD', 'NO2_CLXF', 'SFNO', 'SFNH3', 'BRO', - 'CH3CL', 'CLO', 'CO2', 'HCL', 'HO2', 'HOCL', 'H2O', 'PHIS', 'Z3', + 'CH3CL', 'CLO', 'CO2', 'HCL', 'HO2', 'HOCL', 'PHIS', 'Z3', 'BENZ', 'C2H6', 'C3H8', 'CCL4', 'CFC11', 'CFC113', 'CFC12', 'CH2O', 'CH3BR', 'CH3CCL3', 'ALD2', 'CH3CL', 'ACET', 'MOH', 'CH4', 'CO', 'H2O2', 'HCFC22', 'HNO3', 'ISOP', 'MTPA', 'N2O', 'O3', @@ -78,8 +116,10 @@ 'IHN4', 'INO2B', 'INO2D', 'INPB', 'INPD', 'RIPA', 'RIPB', 'RIPC', 'RIPD', 'MACR', 'MVKHP', 'MEK', 'MCRDH', 'MPAN', 'MVK', 'N', 'N2O', 'N2O5', 'ICN', 'NH3', 'NH4', 'NO', 'NO2', 'NO3', 'PROPNN', 'OLND', 'OLNN', 'O', 'OCLO', - 'OCS', 'PAN', 'SO2', 'SO4', 'SOAP', 'TOLU', 'XYLE', + 'OCS', 'PAN', 'SO2', 'SO4', 'TOLU', 'XYLE', 'R4O2', 'BRO2', 'ETO2', 'A3O2', 'MCO3', 'MO2', 'HO2', 'O1D', 'OH', + 'TSOA0', 'TSOA1', 'TSOA2', 'TSOA3', 'ASOAN', 'ASOA1', 'ASOA2', 'ASOA3', + 'SOAIE', 'SOAGX', 'H2O', 'SAD_PSC', 'SAD_SULFC', 'SAD_TROP', 'SAD_AERO', 'REFF_AERO', 'PDELDRY', 'RAD_PSC', 'RAD_SULFC', 'HNO3_GAS', 'HNO3_STS', 'HNO3_NAT', 'NOX', 'NOY', 'CLOX', 'CLOY', @@ -102,16 +142,16 @@ 'DF_HAC', 'DF_IEPOXA', 'DF_IEPOXB', 'DF_IEPOXD', 'DF_MPAN', 'DF_NH3', 'DF_NH4', 'DF_NO', 'DF_NO2', 'DF_O3', 'DF_PAN', 'DF_SO2', - 'DF_SOAP', 'SO2_CLXF', 'SO2_XFRC', - 'CO_CLXF', 'NO2_CLXF', 'LNO_PROD', 'LNO_COL_PROD', 'SOAP_CLXF', + 'SO2_CLXF', 'SO2_XFRC', + 'CO_CLXF', 'NO2_CLXF', 'LNO_PROD', 'LNO_COL_PROD', 'SFEOH', 'SFALD2', 'SFMEK', 'SFCH2O', 'SFC2H6', 'SFC3H8', 'SFALK4', 'SFPRPE', 'SFBENZ', 'SFTOLU', 'SFXYLE', 'SFNO', 'SFACTA', 'SFDMS', 'SFMEK', 'SFSO2', 'SFNH3', - 'SFISOP', 'SFMTPA', 'SFMOH', 'SFACET', 'SFCO', 'SFSOAP', - 'MEG_ISOP', 'MEG_MTERP', 'MEG_BCARY', 'MEG_CH3OH', 'MEG_C2H5OH', 'MEG_CH2O', - 'MEG_CH3CHO', 'MEG_CH3COOH', 'MEG_CH3COCH3', 'MEG_HCOOH', 'MEG_HCN', 'MEG_CO', - 'MEG_C2H6', 'MEG_C2H4', 'MEG_C3H8', 'MEG_C3H6', 'MEG_BIGALK', 'MEG_BIGENE', - 'MEG_TOLUENE', 'Dso4_a1CHM', 'Dso4_a2CHM', 'Dso4_a3CHM', 'DO3CHM', 'DCOCHM', + 'SFISOP', 'SFMTPA', 'SFMOH', 'SFACET', 'SFCO', + 'MEG_ISOP', 'MEG_MOH', 'MEG_EOH', 'MEG_CH2O', 'MEG_ALD2', 'MEG_ACTA', + 'MEG_ACET', 'MEG_HCOOH', 'MEG_HCN', 'MEG_CO', 'MEG_C2H6', 'MEG_C2H4', + 'MEG_C3H8', 'MEG_ALK4', 'MEG_PRPE', 'MEG_TOLU', 'MEG_LIMO', 'MEG_MTPA', + 'MEG_MTPO', 'Dso4_a1CHM', 'Dso4_a2CHM', 'Dso4_a3CHM', 'DO3CHM', 'DCOCHM', 'DHNO3CHM', 'DH2O2CHM', 'DO3CHM', 'DCOCHM', 'AQ_SO2', 'GS_SO2', 'SO2_CLXF', 'MASS', 'ABSORB', 'Jval_O3O1D', 'Jval_NO2', 'Jval_PAN', 'Jval_H2O2', 'Jval_Cl2O2', diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index 2ba9e9a0e7..10e9370dc5 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -210,7 +210,7 @@ waccm_ma_2000_cam6 waccm_sc_2000_cam6 2000_trop_strat_vbs_cam6 - geoschem + 2000_geoschem aquaplanet_cam4 aquaplanet_cam4 @@ -223,7 +223,7 @@ 2010_trop_strat_vbs_cam6 waccm_tsmlt_2010_cam6 waccm_sc_2010_cam6 - geoschem_2010 + 2010_geoschem 1850-2005_cam5 1850-2005_cam4 diff --git a/src/chemistry/geoschem/.exclude b/src/chemistry/geoschem/.exclude index b0c26be3ef..b8418763c5 100644 --- a/src/chemistry/geoschem/.exclude +++ b/src/chemistry/geoschem/.exclude @@ -18,6 +18,3 @@ tccon_ch4_mod.F90 initialize.F90 cleanup.F90 main.F90 -hcoi_gc_diagn_include.H -hcoi_gc_diagn_mod.F90 -hco_interface_gc_mod.F90 diff --git a/src/chemistry/geoschem/cesmgc_diag_mod.F90 b/src/chemistry/geoschem/cesmgc_diag_mod.F90 index f27dfa7e53..584ab12a07 100644 --- a/src/chemistry/geoschem/cesmgc_diag_mod.F90 +++ b/src/chemistry/geoschem/cesmgc_diag_mod.F90 @@ -471,13 +471,14 @@ SUBROUTINE CESMGC_Diag_Init( Input_Opt, State_Chm, State_Met ) CALL Addfld( TRIM(SpcName), (/ 'lev' /), 'A', '1/s', & TRIM(tagName) // ' photolysis rate' ) ENDDO - ! Add Jval_O3O1D and Jval_O3O3P - SpcName = 'Jval_O3O1D' + ! Add JvalO3O1D and JvalO3O3P + SpcName = 'JvalO3O1D' CALL Addfld( TRIM(SpcName), (/ 'lev' /), 'A', '1/s', & - TRIM(tagName) // ' photolysis rate' ) - SpcName = 'Jval_O3O3P' + 'O3 -> O1D photolysis rate' ) + + SpcName = 'JvalO3O3P' CALL Addfld( TRIM(SpcName), (/ 'lev' /), 'A', '1/s', & - TRIM(tagName) // ' photolysis rate' ) + 'O3 -> O3P photolysis rate' ) ! ========================================== ! Now add fields corresponding to State_Met @@ -960,6 +961,7 @@ SUBROUTINE CESMGC_Diag_Calc( Input_Opt, State_Chm, State_Diag, & USE PHYSCONST, ONLY : MWDry USE UCX_MOD, ONLY : GET_STRAT_OPT!, AERFRAC USE CMN_SIZE_MOD, ONLY : NDUST + USE CMN_FJX_MOD ! ! !INPUT PARAMETERS: ! @@ -1053,7 +1055,8 @@ SUBROUTINE CESMGC_Diag_Calc( Input_Opt, State_Chm, State_Diag, & M = map2chm(N) SpcName = TRIM(solsym(N)) outTmp = 0.0e+00_r8 - IF ( adv_mass(N) > 0.0e+00_r8 .AND. M /= 0 .AND. hist_fld_active(TRIM(SpcName)) ) THEN + IF ( adv_mass(N) > 0.0e+00_r8 .AND. M /= 0 .AND. & + (hist_fld_active(TRIM(SpcName)) .OR. hist_fld_active(TRIM(SpcName)//'_SRF')) ) THEN IF ( M > 0 ) THEN ! mol/mol outTmp(:nY,:) = REAL(State_Chm%Species(1,:nY,nZ:1:-1,M),r8) * MWDry / adv_mass(N) @@ -1502,14 +1505,14 @@ SUBROUTINE CESMGC_Diag_Calc( Input_Opt, State_Chm, State_Diag, & ENDDO ENDIF IF ( ASSOCIATED(State_Diag%JvalO3O1D) ) THEN - SpcName = 'Jval_O3O1D' + SpcName = 'JvalO3O1D' IF ( hist_fld_active(TRIM(SpcName)) ) THEN outTmp(:nY,:nZ) = REAL(State_Diag%JvalO3O1D(1,:nY,nZ:1:-1),r8) CALL OutFld( TRIM(SpcName), outTmp(:nY,:), nY, LCHNK ) ENDIF ENDIF IF ( ASSOCIATED(State_Diag%JvalO3O3P) ) THEN - SpcName = 'Jval_O3O3P' + SpcName = 'JvalO3O3P' IF ( hist_fld_active(TRIM(SpcName)) ) THEN outTmp(:nY,:nZ) = REAL(State_Diag%JvalO3O3P(1,:nY,nZ:1:-1),r8) CALL OutFld( TRIM(SpcName), outTmp(:nY,:), nY, LCHNK ) diff --git a/src/chemistry/geoschem/cesmgc_emissions_mod.F90 b/src/chemistry/geoschem/cesmgc_emissions_mod.F90 index 54d75a01b9..5489b0f043 100644 --- a/src/chemistry/geoschem/cesmgc_emissions_mod.F90 +++ b/src/chemistry/geoschem/cesmgc_emissions_mod.F90 @@ -41,25 +41,12 @@ MODULE CESMGC_Emissions_Mod INTEGER :: iBC1 INTEGER :: iBC4 INTEGER :: iH2SO4 - INTEGER :: iSOA11 - INTEGER :: iSOA12 - INTEGER :: iSOA21 - INTEGER :: iSOA22 - INTEGER :: iSOA31 - INTEGER :: iSOA32 - INTEGER :: iSOA41 - INTEGER :: iSOA42 - INTEGER :: iSOA51 - INTEGER :: iSOA52 - INTEGER :: iPOM1 - INTEGER :: iPOM4 INTEGER :: iBCPI INTEGER :: iBCPO INTEGER :: iOCPI INTEGER :: iOCPO INTEGER :: iSO4 - INTEGER :: iSOAS ! MEGAN Emissions INTEGER, ALLOCATABLE :: megan_indices_map(:) @@ -137,22 +124,6 @@ SUBROUTINE CESMGC_Emissions_Init( lght_no_prd_factor ) ! Get constituent index for NO CALL cnst_get_ind('NO', iNO, abort=.True.) -#if defined( MODAL_AERO_4MODE ) - ! Get constituent index for aerosols - CALL cnst_get_ind('soa1_a1', iSOA11, abort=.True.) - CALL cnst_get_ind('soa1_a2', iSOA12, abort=.True.) - CALL cnst_get_ind('soa2_a1', iSOA21, abort=.True.) - CALL cnst_get_ind('soa2_a2', iSOA22, abort=.True.) - CALL cnst_get_ind('soa3_a1', iSOA31, abort=.True.) - CALL cnst_get_ind('soa3_a2', iSOA32, abort=.True.) - CALL cnst_get_ind('soa4_a1', iSOA41, abort=.True.) - CALL cnst_get_ind('soa4_a2', iSOA42, abort=.True.) - CALL cnst_get_ind('soa5_a1', iSOA51, abort=.True.) - CALL cnst_get_ind('soa5_a2', iSOA52, abort=.True.) - - CALL cnst_get_ind('SOAS', iSOAS, abort=.True.) -#endif - !----------------------------------------------------------------------- ! ... initialize the lightning module !----------------------------------------------------------------------- @@ -171,41 +142,50 @@ SUBROUTINE CESMGC_Emissions_Init( lght_no_prd_factor ) DO N = 1, shr_megan_mechcomps_n SpcName = TRIM(shr_megan_mechcomps(N)%name) + ! Special handlings for GEOS-Chem species - IF ( TRIM(SpcName) == 'MTERP' ) THEN - SpcName = 'MTPA' - ELSEIF ( TRIM(SpcName) == 'BCARY' ) THEN - SpcName = 'None' - MW = 204.342600_r8 ! Taken from pp_trop_strat_mam4_vbs - ELSEIF ( TRIM(SpcName) == 'CH3OH' ) THEN - SpcName = 'MOH' - ELSEIF ( TRIM(SpcName) == 'C2H5OH' ) THEN - SpcName = 'EOH' - ELSEIF ( TRIM(SpcName) == 'CH3CHO' ) THEN - SpcName = 'ALD2' - ELSEIF ( TRIM(SpcName) == 'CH3COOH' ) THEN - SpcName = 'ACTA' - ELSEIF ( TRIM(SpcName) == 'CH3COCH3' ) THEN - SpcName = 'ACET' - ELSEIF ( TRIM(SpcName) == 'HCN' ) THEN + IF ( TRIM(SpcName) == 'HCN' ) THEN SpcName = 'None' MW = 27.025140_r8 ! Taken from pp_trop_strat_mam4_vbs ELSEIF ( TRIM(SpcName) == 'C2H4' ) THEN SpcName = 'None' MW = 28.051600_r8 ! Taken from pp_trop_strat_mam4_vbs - ELSEIF ( TRIM(SpcName) == 'C3H6' ) THEN - SpcName = 'PRPE' - ELSEIF ( TRIM(SpcName) == 'BIGALK' ) THEN - ! BIGALK = Pentane + Hexane + Heptane + Tricyclene - SpcName = 'ALK4' - ELSEIF ( TRIM(SpcName) == 'BIGENE' ) THEN - ! BIGENE = butene (C4H8) - SpcName = 'PRPE' ! Lumped >= C3 alkenes - ELSEIF ( TRIM(SpcName) == 'TOLUENE' ) THEN - SpcName = 'TOLU' ENDIF + !IF ( TRIM(SpcName) == 'MTERP' ) THEN + ! SpcName = 'MTPA' + !ELSEIF ( TRIM(SpcName) == 'BCARY' ) THEN + ! SpcName = 'None' + ! MW = 204.342600_r8 ! Taken from pp_trop_strat_mam4_vbs + !ELSEIF ( TRIM(SpcName) == 'CH3OH' ) THEN + ! SpcName = 'MOH' + !ELSEIF ( TRIM(SpcName) == 'C2H5OH' ) THEN + ! SpcName = 'EOH' + !ELSEIF ( TRIM(SpcName) == 'CH3CHO' ) THEN + ! SpcName = 'ALD2' + !ELSEIF ( TRIM(SpcName) == 'CH3COOH' ) THEN + ! SpcName = 'ACTA' + !ELSEIF ( TRIM(SpcName) == 'CH3COCH3' ) THEN + ! SpcName = 'ACET' + !ELSEIF ( TRIM(SpcName) == 'HCN' ) THEN + ! SpcName = 'None' + ! MW = 27.025140_r8 ! Taken from pp_trop_strat_mam4_vbs + !ELSEIF ( TRIM(SpcName) == 'C2H4' ) THEN + ! SpcName = 'None' + ! MW = 28.051600_r8 ! Taken from pp_trop_strat_mam4_vbs + !ELSEIF ( TRIM(SpcName) == 'C3H6' ) THEN + ! SpcName = 'PRPE' + !ELSEIF ( TRIM(SpcName) == 'BIGALK' ) THEN + ! ! BIGALK = Pentane + Hexane + Heptane + Tricyclene + ! SpcName = 'ALK4' + !ELSEIF ( TRIM(SpcName) == 'BIGENE' ) THEN + ! ! BIGENE = butene (C4H8) + ! SpcName = 'PRPE' ! Lumped >= C3 alkenes + !ELSEIF ( TRIM(SpcName) == 'TOLUENE' ) THEN + ! SpcName = 'TOLU' + !ENDIF CALL cnst_get_ind (SpcName, megan_indices_map(N), abort=.False.) + II = get_spc_ndx(SpcName) IF ( II > 0 ) THEN SpcName = TRIM(shr_megan_mechcomps(N)%name) @@ -291,6 +271,7 @@ SUBROUTINE CESMGC_Emissions_Calc( state, hco_pbuf2d, State_Met, cam_in, eflx, iS USE PPGRID, ONLY : pcols, pver, begchunk USE CAM_HISTORY, ONLY : outfld USE STRING_UTILS, ONLY : to_upper + USE PHYSCONSTANTS, ONLY : PI ! Data from CLM USE CAM_CPL_INDICES, ONLY : index_x2a_Fall_flxvoc @@ -399,13 +380,14 @@ SUBROUTINE CESMGC_Emissions_Calc( state, hco_pbuf2d, State_Met, cam_in, eflx, iS pbuf_ik => NULL() pbuf_chnk => NULL() - IF ( MINVAL(eflx(:nY,:nZ,N)) < 0.0e+00_r8 ) THEN - Write(iulog,*) " CESMGC_Emissions_Calc: HEMCO emission flux is negative for ", & - TRIM(cnst_name(N)), " with value ", MINVAL(eflx(:nY,:nZ,N)), " at ", & - MINLOC(eflx(:nY,:nZ,N)) - ENDIF + !IF ( MINVAL(eflx(:nY,:nZ,N)) < 0.0e+00_r8 ) THEN + ! Write(iulog,*) " CESMGC_Emissions_Calc: HEMCO emission flux is negative for ", & + ! TRIM(cnst_name(N)), " with value ", MINVAL(eflx(:nY,:nZ,N)), " at ", & + ! MINLOC(eflx(:nY,:nZ,N)) + !ENDIF - IF ( rootChunk .and. ( MAXVAL(eflx(:nY,:nZ,N)) > 0.0e+0_r8 ) ) THEN + IF ( rootChunk .AND. (iStep == 2) .AND. ( MAXVAL(eflx(:nY,:nZ,N)) > 0.0e+0_r8 ) ) THEN + ! Only print this once Write(iulog,'(a,a,a,a)') " CESMGC_Emissions_Calc: HEMCO flux ", & TRIM(fldname_ns), " added to ", TRIM(cnst_name(N)) Write(iulog,'(a,a,E16.4)') " CESMGC_Emissions_Calc: Maximum flux ", & @@ -444,10 +426,10 @@ SUBROUTINE CESMGC_Emissions_Calc( state, hco_pbuf2d, State_Met, cam_in, eflx, iS ! apply loss flux to surface (level nZ) eflx(1:NY,nZ,id_O3) = eflx(1:NY,nZ,id_O3) - pbuf_i(1:nY) - IF ( MINVAL(eflx(:nY,nZ,id_O3)) < 0.0e+00_r8 ) THEN - Write(iulog,*) " CESMGC_Emissions_Calc: HEMCO sfc flux after ParaNOx is negative for O3 with value ", MINVAL(eflx(:nY,:nZ,id_O3)), " at ", & - MINLOC(eflx(:nY,nZ,id_O3)) - ENDIF + !IF ( MINVAL(eflx(:nY,nZ,id_O3)) < 0.0e+00_r8 ) THEN + ! Write(iulog,*) " CESMGC_Emissions_Calc: HEMCO sfc flux after ParaNOx is negative for O3 with value ", MINVAL(eflx(:nY,:nZ,id_O3)), " at ", & + ! MINLOC(eflx(:nY,nZ,id_O3)) + !ENDIF IF ( rootChunk .and. ( MINVAL(pbuf_i(1:nY)) < 0.0e+0_r8 ) ) THEN Write(iulog,'(a,a,a,a)') " CESMGC_Emissions_Calc: HEMCO dflx(paranox) O3 added to ", TRIM(cnst_name(id_O3)) @@ -472,10 +454,10 @@ SUBROUTINE CESMGC_Emissions_Calc( state, hco_pbuf2d, State_Met, cam_in, eflx, iS eflx(1:NY,nZ,id_HNO3) = eflx(1:NY,nZ,id_HNO3) - pbuf_i(1:nY) - IF ( MINVAL(eflx(:nY,nZ,id_HNO3)) < 0.0e+00_r8 ) THEN - Write(iulog,*) " CESMGC_Emissions_Calc: HEMCO sfc flux after ParaNOx is negative for HNO3 with value ", MINVAL(eflx(:nY,nZ,id_HNO3)), " at ", & - MINLOC(eflx(:nY,nZ,id_HNO3)) - ENDIF + !IF ( MINVAL(eflx(:nY,nZ,id_HNO3)) < 0.0e+00_r8 ) THEN + ! Write(iulog,*) " CESMGC_Emissions_Calc: HEMCO sfc flux after ParaNOx is negative for HNO3 with value ", MINVAL(eflx(:nY,nZ,id_HNO3)), " at ", & + ! MINLOC(eflx(:nY,nZ,id_HNO3)) + !ENDIF IF ( rootChunk .and. ( MINVAL(pbuf_i(1:nY)) < 0.0e+0_r8 ) ) THEN Write(iulog,'(a,a,a,a)') " CESMGC_Emissions_Calc: HEMCO dflx(paranox) HNO3 added to ", TRIM(cnst_name(id_HNO3)) @@ -487,8 +469,8 @@ SUBROUTINE CESMGC_Emissions_Calc( state, hco_pbuf2d, State_Met, cam_in, eflx, iS pbuf_chnk => NULL() ENDIF +#if defined( MODAL_AERO ) -#if defined( MODAL_AERO_4MODE ) !----------------------------------------------------------------------- ! Aerosol emissions (dust + seasalt) ... !----------------------------------------------------------------------- @@ -502,35 +484,25 @@ SUBROUTINE CESMGC_Emissions_Calc( state, hco_pbuf2d, State_Met, cam_in, eflx, iS ! where all GEOS-Chem aerosols (BCPI, BCPO, OCPI, OCPO, SO4) have been ! replaced with the corresponding MAM aerosols - ! For SOA emission, split evently GEOS-Chem SOAS emission into each - ! VBS bin. - eflx(:nY,:nZ,iSOA11) = eflx(:nY,:nZ,iSOAS) / 10.0e+00_r8 - eflx(:nY,:nZ,iSOA12) = eflx(:nY,:nZ,iSOAS) / 10.0e+00_r8 - eflx(:nY,:nZ,iSOA21) = eflx(:nY,:nZ,iSOAS) / 10.0e+00_r8 - eflx(:nY,:nZ,iSOA22) = eflx(:nY,:nZ,iSOAS) / 10.0e+00_r8 - eflx(:nY,:nZ,iSOA31) = eflx(:nY,:nZ,iSOAS) / 10.0e+00_r8 - eflx(:nY,:nZ,iSOA32) = eflx(:nY,:nZ,iSOAS) / 10.0e+00_r8 - eflx(:nY,:nZ,iSOA41) = eflx(:nY,:nZ,iSOAS) / 10.0e+00_r8 - eflx(:nY,:nZ,iSOA42) = eflx(:nY,:nZ,iSOAS) / 10.0e+00_r8 - eflx(:nY,:nZ,iSOA51) = eflx(:nY,:nZ,iSOAS) / 10.0e+00_r8 - eflx(:nY,:nZ,iSOA52) = eflx(:nY,:nZ,iSOAS) / 10.0e+00_r8 - eflx(:nY,:nZ,iSOAS) = 0.0e+00_r8 - #endif ! Output fields before lightning NO emissions are applied to eflx + ! Make sure that we do not include surface emissions in the diagnostics! DO N = iFirstCnst, pcnst SpcName = TRIM(cnst_name(N))//'_XFRC' + ! Convert from kg/m2/s to molec/cm3/s + ! Note 1: cnst_mw is in kg/kmole + ! Note 2: avogad is in molecules/kmole CALL Outfld( TRIM(SpcName), eflx(:nY,:nZ,N) / State_Met%BXHEIGHT(1,:nY,nZ:1:-1) * 1.0E-06 / cnst_mw(N) * avogad, nY, LCHNK ) SpcName = TRIM(cnst_name(N))//'_CLXF' ! Convert from kg/m2/s to molec/cm2/s ! Note 1: cnst_mw is in kg/kmole ! Note 2: avogad is in molecules/kmole - CALL Outfld( TRIM(SpcName), SUM(eflx(:nY,:nZ,N), DIM=2) * 1.0E-04 / cnst_mw(N) * avogad, nY, LCHNK ) + CALL Outfld( TRIM(SpcName), SUM(eflx(:nY,:nZ-1,N), DIM=2) * 1.0E-04 / cnst_mw(N) * avogad, nY, LCHNK ) SpcName = TRIM(cnst_name(N))//'_CMXF' - CALL Outfld( TRIM(SpcName), SUM(eflx(:nY,:nZ,N), DIM=2), nY, LCHNK ) + CALL Outfld( TRIM(SpcName), SUM(eflx(:nY,:nZ-1,N), DIM=2), nY, LCHNK ) ENDDO !----------------------------------------------------------------------- diff --git a/src/chemistry/geoschem/chem_mods.F90 b/src/chemistry/geoschem/chem_mods.F90 index 5e00fddcdb..08733b6d85 100644 --- a/src/chemistry/geoschem/chem_mods.F90 +++ b/src/chemistry/geoschem/chem_mods.F90 @@ -7,7 +7,7 @@ module chem_mods implicit none save - INTEGER, PARAMETER :: nTracersMax = 238 ! Must be equal to chem_nadv + INTEGER, PARAMETER :: nTracersMax = 251 ! Must be equal to chem_nadv INTEGER :: nTracers CHARACTER(LEN=255) :: tracerNames(nTracersMax) CHARACTER(LEN=255) :: tracerLongNames(nTracersMax) @@ -61,7 +61,7 @@ module chem_mods rxntot = 212, & ! number of total reactions gascnt = 172, & ! number of gas phase reactions nabscol = 2, & ! number of absorbing column densities - gas_pcnst = 318, & ! number of "gas phase" species + gas_pcnst = 331, & ! number of "gas phase" species nfs = 6, & ! number of "fixed" species relcnt = 0, & ! number of relationship species grpcnt = 0, & ! number of group members diff --git a/src/chemistry/geoschem/chemistry.F90 b/src/chemistry/geoschem/chemistry.F90 index 7b568b72b8..f1bff359d2 100644 --- a/src/chemistry/geoschem/chemistry.F90 +++ b/src/chemistry/geoschem/chemistry.F90 @@ -61,6 +61,9 @@ module chemistry use chem_mods, only : mapCnst use chem_mods, only : map2chm use chem_mods, only : map2MAM4 +#if defined( MODAL_AERO ) + use modal_aero_data, only : ntot_amode +#endif use mo_tracname, only : solsym @@ -107,12 +110,31 @@ module chemistry type(physics_buffer_desc), pointer :: hco_pbuf2d(:,:) ! Pointer to 2D pbuf + ! Mimic code in sfcvmr_mod.F90 + TYPE :: SfcMrObj + CHARACTER(LEN=63) :: FldName ! Field name + INTEGER :: SpcID ! ID in species database + TYPE(SfcMrObj), POINTER :: Next ! Next element in list + END TYPE SfcMrObj + + ! Heat of linked list with SfcMrObj objects + TYPE(SfcMrObj), POINTER :: SfcMrHead => NULL() + + ! Field prefix + CHARACTER(LEN=63), PARAMETER :: Prefix_SfcVMR = 'VMR_' + + ! Indices of critical species in GEOS-Chem - INTEGER :: iH2O, iO3, iCO2 - INTEGER :: iO, iH, iO2, iPSO4 - REAL(r8) :: MWPSO4, MWO3 + INTEGER :: iH2O, iO3, iCO2, iSO4 + INTEGER :: iO, iH, iO2 + REAL(r8) :: MWO3 ! Indices of critical species in the constituent list - INTEGER :: cQ, cH2O + INTEGER :: cQ, cH2O, cH2SO4 + ! Indices of critical species in the solsym list + INTEGER :: l_H2SO4, l_SO4 +#if defined( MODAL_AERO ) + INTEGER, ALLOCATABLE :: iSulf(:) +#endif ! Indices in the physics buffer INTEGER :: NDX_PBLH ! PBL height [m] @@ -196,7 +218,7 @@ subroutine chem_register use mo_sim_dat, only : set_sim_dat use mo_chem_utls, only : get_spc_ndx use chem_mods, only : drySpc_ndx -#if defined( MODAL_AERO_4MODE ) +#if defined( MODAL_AERO ) use aero_model, only : aero_model_register use modal_aero_data, only : nspec_max use modal_aero_data, only : ntot_amode, nspec_amode @@ -496,9 +518,10 @@ subroutine chem_register ENDIF ENDDO ! Get constituent index of specific humidity - CALL cnst_get_ind('Q', cQ, abort=.True.) - CALL cnst_get_ind('H2O', cH2O, abort=.True.) - + CALL cnst_get_ind('Q', cQ, abort=.True.) + CALL cnst_get_ind('H2O', cH2O, abort=.True.) + CALL cnst_get_ind('H2SO4', cH2SO4, abort=.True.) + !============================================================== ! Get mapping between dry deposition species and species set !============================================================== @@ -543,8 +566,12 @@ subroutine chem_register ALLOCATE(map2MAM4(nspec_max,ntot_amode), STAT=IERR) IF ( IERR .NE. 0 ) CALL ENDRUN('Failed to allocate map2MAM4') + ALLOCATE(iSulf(ntot_amode), STAT=IERR) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failed to allocate iSulf') + ! Initialize indices map2MAM4(:,:) = -1 + iSulf(:) = -1 DO M = 1, ntot_amode DO L = 1, nspec_amode(M) @@ -552,9 +579,9 @@ subroutine chem_register CASE ( 'BC_' ) SELECT CASE ( to_upper(xname_massptr(L,M)(4:5)) ) CASE ( 'A1' ) - map2MAM4(L,M) = Ind_('BCPI') + CALL cnst_get_ind( 'BCPI', map2MAM4(L,M) ) CASE ( 'A4' ) - map2MAM4(L,M) = Ind_('BCPO') + CALL cnst_get_ind( 'BCPO', map2MAM4(L,M) ) END SELECT CASE ( 'DST' ) SELECT CASE ( to_upper(xname_massptr(L,M)(5:6)) ) @@ -563,33 +590,34 @@ subroutine chem_register ! DST3 - Dust aerosol, Reff = 2.4 micrometers ! DST4 - Dust aerosol, Reff = 4.5 micrometers CASE ( 'A1' ) - map2MAM4(L,M) = Ind_('DST1') + CALL cnst_get_ind( 'DST1', map2MAM4(L,M) ) CASE ( 'A2' ) - map2MAM4(L,M) = Ind_('DST1') + CALL cnst_get_ind( 'DST1', map2MAM4(L,M) ) CASE ( 'A3' ) - map2MAM4(L,M) = Ind_('DST4') + CALL cnst_get_ind( 'DST4', map2MAM4(L,M) ) END SELECT - CASE ( 'SOA' ) - map2MAM4(L,M) = Ind_('SOAS') + !CASE ( 'SOA' ) + ! CALL cnst_get_ind( 'SOAS', map2MAM4(L,M) ) CASE ( 'SO4' ) - map2MAM4(L,M) = Ind_('SO4') + CALL cnst_get_ind( 'SO4', map2MAM4(L,M) ) + iSulf(M) = L CASE ( 'NCL' ) SELECT CASE ( to_upper(xname_massptr(L,M)(5:6)) ) ! SALA - Fine (0.01-0.05 micros) sea salt aerosol ! SALC - Coarse (0.5-8 micros) sea salt aerosol CASE ( 'A1' ) - map2MAM4(L,M) = Ind_('SALA') + CALL cnst_get_ind( 'SALA', map2MAM4(L,M) ) CASE ( 'A2' ) - map2MAM4(L,M) = Ind_('SALA') + CALL cnst_get_ind( 'SALA', map2MAM4(L,M) ) CASE ( 'A3' ) - map2MAM4(L,M) = Ind_('SALC') + CALL cnst_get_ind( 'SALC', map2MAM4(L,M) ) END SELECT CASE ( 'POM' ) SELECT CASE ( to_upper(xname_massptr(L,M)(5:6)) ) CASE ( 'A1' ) - map2MAM4(L,M) = Ind_('OCPI') + CALL cnst_get_ind( 'OCPI', map2MAM4(L,M) ) CASE ( 'A4' ) - map2MAM4(L,M) = Ind_('OCPO') + CALL cnst_get_ind( 'OCPO', map2MAM4(L,M) ) END SELECT END SELECT ENDDO @@ -647,7 +675,7 @@ subroutine chem_readnl(nlfile) use cam_abortutils, only : endrun use units, only : getunit, freeunit use namelist_utils, only : find_group_name -#if defined( MODAL_AERO_4MODE ) +#if defined( MODAL_AERO ) use aero_model, only : aero_model_readnl use dust_model, only : dust_readnl #endif @@ -941,14 +969,14 @@ subroutine chem_init(phys_state, pbuf2d) use Phys_Grid, only : get_Area_All_p use hycoef, only : ps0, hyai, hybi, hyam - use seq_drydep_mod, only : drydep_method, DD_XLND + use seq_drydep_mod, only : drydep_method, DD_XLND, DD_XATM use gas_wetdep_opts, only : gas_wetdep_method use mo_neu_wetdep, only : neu_wetdep_init -#if defined( MODAL_AERO_4MODE ) +#if defined( MODAL_AERO ) use aero_model, only : aero_model_init use mo_setsox, only : sox_inti - use mo_drydep, only : drydep_inti_landuse + use mo_drydep, only : drydep_inti use modal_aero_data, only : ntot_amode, nspec_amode use modal_aero_data, only : xname_massptr #endif @@ -1127,7 +1155,7 @@ subroutine chem_init(phys_state, pbuf2d) CALL Read_Input_File( Input_Opt = Input_Opt, & State_Grid = maxGrid, & RC = RC ) - + ! First setup directories Input_Opt%Chem_Inputs_Dir = TRIM(gc_cheminputs) Input_Opt%SpcDatabaseFile = TRIM(speciesDB) @@ -1139,7 +1167,7 @@ subroutine chem_init(phys_state, pbuf2d) ! onlineAlbedo -> True (use CLM albedo) ! -> False (read monthly-mean albedo from HEMCO) - Input_Opt%onlineAlbedo = .True. + Input_Opt%onlineAlbedo = .False. ! onlineLandTypes -> True (use CLM landtypes) ! -> False (read landtypes from HEMCO) @@ -1151,6 +1179,11 @@ subroutine chem_init(phys_state, pbuf2d) ! applyQtend: apply tendencies of water vapor to specific humidity Input_Opt%applyQtend = .False. + + IF ( .NOT. Input_Opt%LSOA ) THEN + CALL ENDRUN('CESM2-GC requires the complex SOA option to be on!') + ENDIF + ENDIF CALL Validate_Directories( Input_Opt, RC ) @@ -1469,7 +1502,7 @@ subroutine chem_init(phys_state, pbuf2d) ENDDO ENDIF -#if defined( MODAL_AERO_4MODE ) +#if defined( MODAL_AERO ) ! Initialize aqueous chem CALL SOx_inti() @@ -1477,13 +1510,14 @@ subroutine chem_init(phys_state, pbuf2d) CALL aero_model_init( pbuf2d ) ! Initialize land maps for aerosol dry deposition - IF ( drydep_method == DD_XLND ) THEN - CALL drydep_inti_landuse( depvel_lnd_file, & - clim_soilw_file ) + IF ( drydep_method == DD_XATM .OR. drydep_method == DD_XLND ) THEN + CALL drydep_inti( depvel_lnd_file, & + clim_soilw_file, & + season_wes_file ) ELSE - Write(iulog,'(a,a)') ' drydep_method is set to: ', TRIM(drydep_method) - CALL ENDRUN('drydep_method must be DD_XLND to compute land maps for aerosol' // & - ' dry deposition!') + IF ( masterProc ) Write(iulog,'(a,a)') ' drydep_method is set to: ', TRIM(drydep_method) + CALL ENDRUN('drydep_method must be DD_XLND or DD_XATM to compute land '// & + 'maps for aerosol dry deposition!') ENDIF #endif @@ -1643,24 +1677,21 @@ subroutine chem_init(phys_state, pbuf2d) iH2O = Ind_('H2O') iO3 = Ind_('O3') iCO2 = Ind_('CO2') + iSO4 = Ind_('SO4') ! The following indices are needed to compute invariants iO = Ind_('O') iH = Ind_('H') iO2 = Ind_('O2') - ! This is used to compute gas-phase H2SO4 production - iPSO4 = Ind_('PSO4') - SpcInfo => State_Chm(BEGCHUNK)%SpcData(iPSO4)%Info - MWPSO4 = REAL(SpcInfo%MW_g,r8) - ! Free pointer - SpcInfo => NULL() - ! This is used to compute overhead ozone column SpcInfo => State_Chm(BEGCHUNK)%SpcData(iO3)%Info MWO3 = REAL(SpcInfo%MW_g,r8) ! Free pointer SpcInfo => NULL() + l_H2SO4 = get_spc_ndx('H2SO4') + l_SO4 = get_spc_ndx('SO4') + ! Get indices for physical fields in physics buffer NDX_PBLH = pbuf_get_index('pblh' ) NDX_FSDS = pbuf_get_index('FSDS' ) @@ -1700,8 +1731,6 @@ subroutine chem_init(phys_state, pbuf2d) hco_pbuf2d => pbuf2d - If ( MasterProc ) Write(iulog,*) "hco_pbuf2d now points to pbuf2d" - ! Cleanup Call Cleanup_State_Grid( maxGrid, RC ) @@ -1842,6 +1871,7 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) use phys_grid, only : get_ncols_p, get_rlat_all_p, get_rlon_all_p + use mo_chem_utls, only : get_spc_ndx use chem_mods, only : drySpc_ndx, map2GC_dryDep use chem_mods, only : nfs, indexm, gas_pcnst use mo_mean_mass, only : set_mean_mass @@ -1850,10 +1880,12 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) use mo_ghg_chem, only : ghg_chem_set_flbc use mo_neu_wetdep, only : neu_wetdep_tend use gas_wetdep_opts, only : gas_wetdep_method -#if defined( MODAL_AERO_4MODE ) +#if defined( MODAL_AERO ) use modal_aero_data, only : ntot_amode, nspec_amode - use modal_aero_data, only : lmassptr_amode - use modal_aero_data, only : xname_massptr + use modal_aero_data, only : nspec_max, nsoa + use modal_aero_data, only : lmassptr_amode, numptr_amode + use modal_aero_data, only : lptr_so4_a_amode + use modal_aero_data, only : lptr2_soa_a_amode, lptr2_soa_g_amode #endif use Olson_Landmap_Mod, only : Compute_Olson_Landmap @@ -1876,9 +1908,10 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) use PBL_Mix_Mod, only : Compute_PBL_Height use UCX_Mod, only : Set_H2O_Trac use CMN_FJX_MOD, only : ZPJ - USE FAST_JX_MOD, only : RXN_NO2, RXN_O3_1, RXN_O3_2a + use FAST_JX_MOD, only : RXN_NO2, RXN_O3_1, RXN_O3_2a use State_Diag_Mod, only : get_TagInfo use Unitconv_Mod, only : Convert_Spc_Units + use State_Chm_Mod, only : Ind_ use Strat_Chem_Mod, only : Strat_TrID_GC, GC_Bry_TrID, NSCHEM use Strat_Chem_Mod, only : BrPtrDay, BrPtrNight, PLVEC, STRAT_OH @@ -1888,7 +1921,7 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) use CESMGC_Diag_Mod, only : wetdep_name, wtrate_name use Tropopause, only : Tropopause_findChemTrop, Tropopause_Find - use HCO_Utilities_GC_Mod ! Utility routines for GC-HEMCO interface + use HCO_Interface_GC_Mod ! Utility routines for GC-HEMCO interface ! For calculating SZA use Orbit, only : zenith @@ -1931,7 +1964,7 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) LOGICAL :: lq(pcnst) ! Indexing - INTEGER :: N, M, P, SM, ND + INTEGER :: K, N, M, P, SM, ND INTEGER :: I, J, L, nX, nY, nZ INTEGER :: LCHNK, NCOL @@ -1968,12 +2001,28 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) ! For aerosol formation REAL(r8) :: del_h2so4_gasprod(state%NCOL,PVER) + REAL(r8) :: vmr0(state%NCOL,PVER,gas_pcnst) REAL(r8) :: vmr1(state%NCOL,PVER,gas_pcnst) + REAL(r8) :: vmr2(state%NCOL,PVER,gas_pcnst) + REAL(r8) :: wetdepflx(pcols,pcnst) ! Wet deposition fluxes (kg/m2/s) #if defined( MODAL_AERO ) - REAL(r8) :: binRatio(MAXVAL(nspec_amode(:)),ntot_amode,state%NCOL,PVER) + REAL(r8) :: binRatio(nspec_max,ntot_amode,state%NCOL,PVER) + + REAL(r8) :: SO4_gasRatio(state%NCOL,PVER) + + ! For SOA mapping + REAL(r8) :: totMass(state%NCOL,PVER) + REAL(r8) :: bulkMass(state%NCOL,PVER) + REAL(r8) :: tmpMW_g + CHARACTER(LEN=64) :: speciesName_1, speciesName_2, speciesName_3, speciesName_4 + INTEGER :: speciesId_1, speciesId_2, speciesId_3, speciesId_4 + INTEGER :: iMap, nMapping, iBin, binSOA_1, binSOA_2 + INTEGER :: K1, K2, K3, K4 + LOGICAL :: isSOA_aerosol + #endif ! For emissions @@ -2006,7 +2055,6 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) REAL(r8) :: Sd_Ice, Sd_Lnd, Sd_Avg, Frc_Ice ! Estimating cloud optical depth - REAL(r8) :: cld(PCOLS,PVER) REAL(r8) :: TauCli(PCOLS,PVER) REAL(r8) :: TauClw(PCOLS,PVER) REAL(r8), PARAMETER :: re_m = 1.0e-05_r8 ! Cloud drop radius in m @@ -2016,11 +2064,12 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) ! Calculating SZA REAL(r8) :: Calday - CHARACTER(LEN=255) :: SpcName - CHARACTER(LEN=255) :: Prefix, FieldName - LOGICAL :: FND - INTEGER :: SpcId - TYPE(Species), POINTER :: SpcInfo + CHARACTER(LEN=255) :: SpcName + CHARACTER(LEN=255) :: Prefix, FieldName + LOGICAL :: FND + INTEGER :: SpcId + TYPE(Species), POINTER :: SpcInfo + TYPE(SfcMrObj), POINTER :: iSfcMrObj CHARACTER(LEN=63) :: OrigUnit @@ -2057,6 +2106,7 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) cmfdqr => NULL() pbuf_chnk=> NULL() pbuf_ik => NULL() + pbuf_i => NULL() ! LCHNK: which chunk we have on this process LCHNK = state%LCHNK @@ -2138,11 +2188,11 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) MMR_Beg = 0.0e+0_r8 MMR_End = 0.0e+0_r8 DO N = 1, pcnst + IF ( mapCnst(N) > 0 ) lq(N) = .True. M = map2GC(N) IF ( M <= 0 ) CYCLE MMR_Beg(:nY,:nZ,M) = state%q(:nY,nZ:1:-1,N) State_Chm(LCHNK)%Species(1,:nY,:nZ,M) = REAL(MMR_Beg(:nY,:nZ,M),fp) - lq(N) = .True. ENDDO ! We need to let CAM know that 'H2O' and 'Q' are identical @@ -2153,6 +2203,54 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) SlsData(:,:,:) = 0.0e+0_r8 CALL get_short_lived_species( SlsData, LCHNK, nY, pbuf ) + IF ( iStep == 1 ) THEN + ! Retrieve list of species with surface boundary conditions (copied from + ! sfcvmr_mod.F90) + + ! Head of linked list + SfcMrHead => NULL() + iSfcMrObj => NULL() + SpcInfo => NULL() + + ! Loop over all species + DO N = 1, State_Chm(BEGCHUNK)%nSpecies + ! Species information + SpcInfo => State_Chm(BEGCHUNK)%SpcData(N)%Info + + ! Check if field exists (note: this needs to be less than 16 + ! characters long) + FieldName = 'HCO_'//TRIM(Prefix_SfcVMR)//TRIM(to_upper(SpcInfo%Name)) + M = pbuf_get_index(FieldName, RC) + IF ( M > 0 ) THEN + + ! Must have positive, non-zero MW + IF ( SpcInfo%MW_g <= 0.0_fp ) THEN + ErrMsg = 'Cannot use surface boundary condition for species ' & + // TRIM(SpcInfo%Name) // ' due to invalid MW!' + CALL ENDRUN(TRIM(ErrMsg)) + ENDIF + + ! Create new object, add to list + ALLOCATE( iSfcMrObj, STAT=RC ) + CALL GC_CheckVar( 'sfcvmr_mod.F90:iSfcMrObj', 0, RC ) + IF ( RC /= GC_SUCCESS ) CALL ENDRUN('Failure while allocating iSfcMrObj') + + iSfcMrObj%SpcID = N + iSfcMrObj%FldName = FieldName + iSfcMrObj%Next => SfcMrHead + SfcMrHead => iSfcMrObj + IF ( rootChunk ) THEN + WRITE( 6, 110 ) TRIM( SpcInfo%Name ), TRIM( iSfcMrObj%FldName ) + 110 FORMAT( '--> ', a, ' will use prescribed surface boundary ', & + 'conditions from field ', a ) + ENDIF + + ! Free the pointer + iSfcMrObj => NULL() + ENDIF + ENDDO + ENDIF + !----------------------------------------------------------------------- ! ... Set atmosphere mean mass !----------------------------------------------------------------------- @@ -2169,63 +2267,223 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) State_Chm(LCHNK)%Species(1,:nY,:nZ,M) = REAL(SlsData(:nY,nZ:1:-1,N),fp) ENDDO - DO N = 1, gas_pcnst - ! See definition of map2chm - M = map2chm(N) - IF ( M > 0 ) THEN - vmr0(:nY,:nZ,N) = State_Chm(LCHNK)%Species(1,:nY,nZ:1:-1,M) * & - MWDry / adv_mass(N) - ! We'll substract concentrations after chemistry later - mmr_tend(:nY,:nZ,N) = REAL(State_Chm(LCHNK)%Species(1,:nY,nZ:1:-1,M),r8) - ELSEIF ( M < 0 ) THEN - vmr0(:nY,:nZ,N) = state%q(:nY,:nZ,-M) * & - MWDry / adv_mass(N) - mmr_tend(:nY,:nZ,N) = state%q(:nY,:nZ,-M) - ENDIF - ENDDO - -#if defined( MODAL_AERO_4MODE ) - ! First reset State_Chm%Species to zero for aerosols +#if defined( MODAL_AERO ) + ! First reset State_Chm%Species to zero out MAM-inherited GEOS-Chem aerosols DO M = 1, ntot_amode DO SM = 1, nspec_amode(M) - P = map2MAM4(SM,M) - IF ( P > 0 ) State_Chm(LCHNK)%Species(1,:nY,:nZ,P) = 0.0e+00_fp + P = map2MAM4(SM,M) ! Constituent index for GEOS-Chem + IF ( P > 0 ) K = map2GC(P) ! Index in State_Chm + IF ( K > 0 ) State_Chm(LCHNK)%Species(1,:nY,:nZ,K) = 0.0e+00_fp ENDDO ENDDO - ! Map and flip aerosols + ! Map and vertically flip aerosols DO M = 1, ntot_amode DO SM = 1, nspec_amode(M) - ! TMMF - Should there be a ratio of molar weights involved? - P = map2MAM4(SM,M) + P = map2MAM4(SM,M) ! Constituent index for GEOS-Chem IF ( P <= 0 ) CYCLE N = lmassptr_amode(SM,M) + K = map2GC(P) ! Index in State_Chm + ! /!\ MAM aerosols (with cnst index N) is mapped onto GEOS-Chem + ! species (with cnst index P, which corresponds to index K in + ! State_Chm) + ! Multiple MAM4 bins are mapped to same GEOS-Chem species - State_Chm(LCHNK)%Species(1,:nY,:nZ,P) = State_Chm(LCHNK)%Species(1,:nY,:nZ,P) & - + REAL(state%q(:nY,nZ:1:-1,N),fp) + State_Chm(LCHNK)%Species(1,:nY,:nZ,K) = State_Chm(LCHNK)%Species(1,:nY,:nZ,K) & + + REAL(state%q(:nY,nZ:1:-1,N),fp) * & + adv_mass(mapCnst(P)) / & + adv_mass(mapCnst(N)) ENDDO ENDDO + + ! Compute ratios of bin to bulk mass + binRatio = 0.0e+00_r8 DO M = 1, ntot_amode DO SM = 1, nspec_amode(M) P = map2MAM4(SM,M) IF ( P <= 0 ) CYCLE - ! Overwrite MMR_Beg with MAM value - MMR_Beg(:nY,:nZ,P) = State_Chm(LCHNK)%Species(1,:nY,:nZ,P) + K = map2GC(P) ! Index in State_Chm N = lmassptr_amode(SM,M) + IF ( N < 0 ) CYCLE DO J = 1, nY DO L = 1, nZ - IF ( State_Chm(LCHNK)%Species(1,J,nZ+1-L,P) > 0.0e+00_r8 ) THEN - binRatio(SM,M,J,L) = REAL(state%q(J,L,N),r8) & - / State_Chm(LCHNK)%Species(1,J,nZ+1-L,P) - ELSE - binRatio(SM,M,J,L) = 0.0e+00_r8 + IF ( State_Chm(LCHNK)%Species(1,J,nZ+1-L,K) > 0.0e+00_r8 ) THEN + binRatio(SM,M,J,L) = state%q(J,L,N) & + * adv_mass(mapCnst(P)) / adv_mass(mapCnst(N)) & + / REAL(State_Chm(LCHNK)%Species(1,J,nZ+1-L,K), r8) ENDIF ENDDO ENDDO + ! Overwrite MMR_Beg with value from MAM + MMR_Beg(:nY,:nZ,K) = State_Chm(LCHNK)%Species(1,:nY,:nZ,K) ENDDO ENDDO + + ! Deal with secondary organic aerosols (SOAs). This mapping is using the + ! complex SOA option in GEOS-Chem. + ! MAM uses five volatility bins spanning saturation concentrations from 0.01 + ! to 100 ug/m3 (logarithmically). The complex SOA option has four volatility + ! bins that 0.1 to 100 ug/m3. We lump the lowest two bins in CESM2 to the + ! lowest bin in GEOS-Chem. + ! + ! The mapping goes as follows: + ! TSOA0 + ASOAN + SOAIE + SOAGX <- soa1_a* + soa2_a* + ! TSOA1 + ASOA1 <- soa3_a* + ! TSOA2 + ASOA2 <- soa4_a* + ! TSOA3 + ASOA3 <- soa5_a* + ! TSOG0 <- SOAG0 + SOAG1 + ! TSOG1 + ASOG1 <- SOAG2 + ! TSOG2 + ASOG2 <- SOAG3 + ! TSOG3 + ASOG3 <- SOAG4 + + IF ( iStep > 1 ) THEN + ! Do not perform this mapping on initialization as we first want to + ! overwrite soa*_a* with the GEOS-Chem SOAs. + nMapping = 8 + DO iMap = 1, nMapping + speciesName_1 = '' + speciesName_2 = '' + speciesName_3 = '' + speciesName_4 = '' + IF ( iMap == 1 ) THEN + binSOA_1 = 1 + binSOA_2 = 2 + speciesName_1 = 'TSOA0' + speciesName_2 = 'ASOAN' + speciesName_3 = 'SOAIE' + speciesName_4 = 'SOAGX' + ELSEIF ( iMap == 2 ) THEN + binSOA_1 = 3 + binSOA_2 = 3 + speciesName_1 = 'TSOA1' + speciesName_2 = 'ASOA1' + ELSEIF ( iMap == 3 ) THEN + binSOA_1 = 4 + binSOA_2 = 4 + speciesName_1 = 'TSOA2' + speciesName_2 = 'ASOA2' + ELSEIF ( iMap == 4 ) THEN + binSOA_1 = 5 + binSOA_2 = 5 + speciesName_1 = 'TSOA3' + speciesName_2 = 'ASOA3' + ELSEIF ( iMap == 5 ) THEN + binSOA_1 = 1 + binSOA_2 = 2 + speciesName_1 = 'TSOG0' + speciesName_2 = 'TSOG0' + ELSEIF ( iMap == 6 ) THEN + binSOA_1 = 3 + binSOA_2 = 3 + speciesName_1 = 'TSOG1' + speciesName_2 = 'ASOG1' + ELSEIF ( iMap == 7 ) THEN + binSOA_1 = 4 + binSOA_2 = 4 + speciesName_1 = 'TSOG2' + speciesName_2 = 'ASOG2' + ELSEIF ( iMap == 8 ) THEN + binSOA_1 = 5 + binSOA_2 = 5 + speciesName_1 = 'TSOG3' + speciesName_2 = 'ASOG3' + ELSE + CALL ENDRUN('Unknown SOA mapping!') + ENDIF + isSOA_aerosol = .False. + IF ( iMap <= 4 ) isSOA_aerosol = .True. + + ! Compute total mass from GEOS-Chem species. This sets the ratio between + ! speciesId_1 and speciesId_2 + totMass(:nY,:nZ) = 0.0e+00_r8 + + CALL cnst_get_ind( speciesName_1, speciesId_1, abort=.True. ) + CALL cnst_get_ind( speciesName_2, speciesId_2, abort=.False. ) + CALL cnst_get_ind( speciesName_3, speciesId_3, abort=.False. ) + CALL cnst_get_ind( speciesName_4, speciesId_4, abort=.False. ) + IF ( speciesId_1 > 0 ) totMass(:nY,:nZ) = totMass(:nY,:nZ) + state%q(:nY,:nZ,speciesId_1) + IF ( speciesId_2 > 0 ) totMass(:nY,:nZ) = totMass(:nY,:nZ) + state%q(:nY,:nZ,speciesId_2) + IF ( speciesId_3 > 0 ) totMass(:nY,:nZ) = totMass(:nY,:nZ) + state%q(:nY,:nZ,speciesId_3) + IF ( speciesId_4 > 0 ) totMass(:nY,:nZ) = totMass(:nY,:nZ) + state%q(:nY,:nZ,speciesId_4) + + ! Compute total bulk mass from MAM + bulkMass(:nY,:nZ) = 0.0e+00_r8 + IF ( isSOA_aerosol ) THEN + DO iBin = binSOA_1, binSOA_2 + DO M = 1, ntot_amode + N = lptr2_soa_a_amode(M,iBin) + IF ( N <= 0 ) CYCLE + tmpMW_g = adv_mass(mapCnst(N)) + bulkMass(:nY,:nZ) = bulkMass(:nY,:nZ) + state%q(:nY,:nZ,N) + ENDDO + ENDDO + ELSE + DO iBin = binSOA_1, binSOA_2 + N = lptr2_soa_g_amode(iBin) + IF ( N <= 0 ) CYCLE + tmpMW_g = adv_mass(mapCnst(N)) + bulkMass(:nY,:nZ) = bulkMass(:nY,:nZ) + state%q(:nY,:nZ,N) + ENDDO + ENDIF + + K1 = Ind_(speciesName_1) + K2 = Ind_(speciesName_2) + K3 = Ind_(speciesName_3) + K4 = Ind_(speciesName_4) + DO J = 1, nY + DO L = 1, nZ + IF ( totMass(J,L) > 0.0e+00_r8 ) THEN + IF ( K1 > 0 ) State_Chm(LCHNK)%Species(1,J,L,K1) = state%q(J,nZ+1-L,speciesId_1) / totMass(J,nZ+1-L) * bulkMass(J,nZ+1-L) * adv_mass(mapCnst(speciesId_1)) / tmpMW_g + IF ( K2 > 0 ) State_Chm(LCHNK)%Species(1,J,L,K2) = state%q(J,nZ+1-L,speciesId_2) / totMass(J,nZ+1-L) * bulkMass(J,nZ+1-L) * adv_mass(mapCnst(speciesId_2)) / tmpMW_g + IF ( K3 > 0 ) State_Chm(LCHNK)%Species(1,J,L,K3) = state%q(J,nZ+1-L,speciesId_3) / totMass(J,nZ+1-L) * bulkMass(J,nZ+1-L) * adv_mass(mapCnst(speciesId_3)) / tmpMW_g + IF ( K4 > 0 ) State_Chm(LCHNK)%Species(1,J,L,K4) = state%q(J,nZ+1-L,speciesId_4) / totMass(J,nZ+1-L) * bulkMass(J,nZ+1-L) * adv_mass(mapCnst(speciesId_4)) / tmpMW_g + ELSE + IF ( K1 == K2 ) THEN + State_Chm(LCHNK)%Species(1,J,L,K1) = bulkMass(J,nZ+1-L) * adv_mass(mapCnst(speciesId_1)) / tmpMW_g + ELSE + State_Chm(LCHNK)%Species(1,J,L,K1) = bulkMass(J,nZ+1-L) * adv_mass(mapCnst(speciesId_1)) / tmpMW_g / 2.0_r8 + State_Chm(LCHNK)%Species(1,J,L,K2) = bulkMass(J,nZ+1-L) * adv_mass(mapCnst(speciesId_1)) / tmpMW_g / 2.0_r8 + ENDIF + ENDIF + ENDDO + ENDDO + IF ( K1 > 0 ) MMR_Beg(:nY,:nZ,K1) = State_Chm(LCHNK)%Species(1,:nY,:nZ,K1) + IF ( K2 > 0 ) MMR_Beg(:nY,:nZ,K2) = State_Chm(LCHNK)%Species(1,:nY,:nZ,K2) + IF ( K3 > 0 ) MMR_Beg(:nY,:nZ,K4) = State_Chm(LCHNK)%Species(1,:nY,:nZ,K3) + IF ( K4 > 0 ) MMR_Beg(:nY,:nZ,K3) = State_Chm(LCHNK)%Species(1,:nY,:nZ,K4) + ENDDO + ENDIF + + ! Add gas-phase H2SO4 to GEOS-Chem SO4 (which lumps SO4 aerosol and gaseous) + K = iSO4 + N = cH2SO4 + IF ( K > 0 .AND. N > 0 .AND. l_SO4 > 0 ) THEN + State_Chm(LCHNK)%Species(1,:nY,:nZ,K) = State_Chm(LCHNK)%Species(1,:nY,:nZ,K) & + + REAL(state%q(:nY,nZ:1:-1,N),fp) * & + adv_mass(l_SO4) / adv_mass(mapCnst(N)) + ! SO4_gasRatio is in mol/mol + SO4_gasRatio(:nY,:nZ) = state%q(:nY,:nZ,N) & + * adv_mass(l_SO4) / adv_mass(mapCnst(N)) & + / State_Chm(LCHNK)%Species(1,:nY,nZ:1:-1,K) + MMR_Beg(:nY,:nZ,K) = State_Chm(LCHNK)%Species(1,:nY,:nZ,K) + ENDIF #endif + DO N = 1, gas_pcnst + ! See definition of map2chm + M = map2chm(N) + IF ( M > 0 ) THEN + vmr0(:nY,:nZ,N) = State_Chm(LCHNK)%Species(1,:nY,nZ:1:-1,M) * & + MWDry / adv_mass(N) + ! We'll substract concentrations after chemistry later + mmr_tend(:nY,:nZ,N) = REAL(State_Chm(LCHNK)%Species(1,:nY,nZ:1:-1,M),r8) + ELSEIF ( M < 0 ) THEN + vmr0(:nY,:nZ,N) = state%q(:nY,:nZ,-M) * & + MWDry / adv_mass(N) + mmr_tend(:nY,:nZ,N) = state%q(:nY,:nZ,-M) + ENDIF + ENDDO + ! If H2O tendencies are propagated to specific humidity, then make sure ! that Q actually applies tendencies IF ( Input_Opt%applyQtend ) lq(cQ) = .True. @@ -2325,58 +2583,45 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) TauCli = 0.0e+0_r8 TauClw = 0.0e+0_r8 - ! Note: all using CAM vertical convention (1 = TOA) - ! Calculation is based on that done for MOZART + cldW(:nY,:nZ) = state%q(:nY,:nZ,ixCldLiq) + state%q(:nY,:nZ,ixCldIce) + IF ( ixNDrop > 0 ) nCldWtr(:nY,:nZ) = state%q(:nY,:nZ,ixNDrop) + DO J = 1, nY DO L = nZ, 1, -1 - cldW(J,L) = state%q(J,L,ixCldLiq) + state%q(J,L,ixCldIce) - ! Convert water mixing ratio [kg/kg] to water content [g/m^3] - IF ( cldW(J,L) * state%pmid(J,L) / & - (state%T(J,L) * 287.0e+00_r8) * 1.0e+03_r8 <= 0.01_r8 .AND. & - cldFrc(J,L) /= 0.0e+00_r8 ) THEN - cld(J,L) = 0.0e+00_r8 - ELSE - cld(J,L) = cldFrc(J,L) + ! ================================================================= + ! =========== Compute cloud optical depth based on ============ + ! =========== Liao et al. JGR, 104, 23697, 1999 ============ + ! ================================================================= + ! + ! Tau = 3/2 * LWC * dZ / ( \rho_w * r_e ) + ! dZ = - dP / ( \rho_air * g ) + ! since Pint is ascending, we can neglect the minus sign + ! + ! Tau = 3/2 * LWC * dP / ( \rho_air * r_e * \rho_w * g ) + ! LWC / \rho_air = Q + ! + ! Tau = 3/2 * Q * dP / ( r_e * rho_w * g ) + ! Tau(L) = 3/2 * Q(L) * (Pint(L+1) - Pint(L)) / (re * rho_w * g ) + ! Tau(L) = Q(L) * (Pint(L+1) - Pint(L)) * Cnst + ! Then divide by cloud fraction to get the in-cloud optical depth + + ! Unit check: | + ! Q : [kg H2O/kg air] | + ! Pint : [Pa]=[kg air/m/s^2] | + ! re : [m] | = 1.0e-5 + ! rho_w: [kg H2O/m^3] | = 1.0e+3 + ! g : [m/s^2] | = 9.81 + IF ( cldFrc(J,L) > cldMin ) THEN + TauClw(J,L) = state%q(J,L,ixCldLiq) & + * (state%pint(J,L+1)-state%pint(J,L)) & + * cnst / cldFrc(J,L) + TauClw(J,L) = MAX(TauClw(J,L), 0.0e+00_r8) + TauCli(J,L) = state%q(J,L,ixCldIce) & + * (state%pint(J,L+1)-state%pint(J,L)) & + * cnst / cldFrc(J,L) + TauCli(J,L) = MAX(TauCli(J,L), 0.0e+00_r8) ENDIF - IF ( ixNDrop > 0 ) nCldWtr(J,L) = state%q(J,L,ixNDrop) - ENDDO ENDDO - - DO J = 1, nY - IF ( COUNT( cld(J,:nZ) > cldMin ) > 0 ) THEN - DO L = nZ, 1, -1 - ! ================================================================= - ! =========== Compute cloud optical depth based on ============ - ! =========== Liao et al. JGR, 104, 23697, 1999 ============ - ! ================================================================= - ! - ! Tau = 3/2 * LWC * dZ / ( \rho_w * r_e ) - ! dZ = - dP / ( \rho_air * g ) - ! since Pint is ascending, we can neglect the minus sign - ! - ! Tau = 3/2 * LWC * dP / ( \rho_air * r_e * \rho_w * g ) - ! LWC / \rho_air = Q - ! - ! Tau = 3/2 * Q * dP / ( r_e * rho_w * g ) - ! Tau(L) = 3/2 * Q(L) * (Pint(L+1) - Pint(L)) / (re * rho_w * g ) - ! Tau(L) = Q(L) * (Pint(L+1) - Pint(L)) * Cnst - ! - ! Unit check: | - ! Q : [kg H2O/kg air] | - ! Pint : [Pa]=[kg air/m/s^2] | - ! re : [m] | = 1.0e-5 - ! rho_w: [kg H2O/m^3] | = 1.0e+3 - ! g : [m/s^2] | = 9.81 - TauClw(J,L) = state%q(J,L,ixCldLiq) & - * (state%pint(J,L+1)-state%pint(J,L)) & - * cnst - TauClw(J,L) = MAX(TauClw(J,L), 0.0e+00_r8) - TauCli(J,L) = state%q(J,L,ixCldIce) & - * (state%pint(J,L+1)-state%pint(J,L)) & - * cnst - TauCli(J,L) = MAX(TauCli(J,L), 0.0e+00_r8) - ENDDO - ENDIF ENDDO ! Retrieve tropopause level @@ -3244,7 +3489,6 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) pbuf_chnk => NULL() pbuf_ik => NULL() ENDIF - !CALL HCO_GetPtr( HcoState, 'STRAT_OH', STRAT_OH, RC, FOUND=FND ) ENDIF ENDIF @@ -3698,6 +3942,39 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) ENDIF ENDIF + ! Here, we apply surface mixing ratios for long-lived species + ! (copied from sfcvmr_mod.F90) + ! Loop over all objects + iSfcMrObj => SfcMrHead + DO WHILE( ASSOCIATED( iSfcMrObj ) ) + + ! Get concentration for this species + tmpIdx = pbuf_get_index(TRIM(iSfcMrObj%FldName), RC) + IF ( tmpIdx < 0 .OR. (iStep == 1) ) THEN + IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(iSfcMrObj%FldName) + ELSE + CALL pbuf_get_field(pbuf, tmpIdx, pbuf_i) + + ! Set mixing ratio in PBL + SpcInfo => State_Chm(LCHNK)%SpcData(iSfcMrObj%SpcID)%Info + N = SpcInfo%ModelID + IF ( N > 0 ) THEN + DO L = 1, nZ + DO J = 1, nY + IF ( State_Met(LCHNK)%F_UNDER_PBLTOP(1,J,L) > 0.0_fp ) THEN + State_Chm(LCHNK)%Species(1,J,L,N) = & + ( pbuf_i(J) * 1.0e-9_fp ) & + / ( MWDry / SpcInfo%MW_g ) + ENDIF ! end selection of PBL boxes + ENDDO + ENDDO + ENDIF + ENDIF + + ! Point to next element in list + iSfcMrObj => iSfcMrObj%Next + ENDDO + ! Reset photolysis rates ZPJ = 0.0e+0_r8 @@ -3728,6 +4005,8 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) CALL ENDRUN('Incorrect unit in GEOS-Chem State_Chm%Species') ENDIF + call t_stopf( 'chemdr' ) + ! Save and write J-values to pbuf for HEMCO ! in HCO_IN_JNO2, HCO_IN_JOH FieldName = 'HCO_IN_JNO2' @@ -3764,35 +4043,6 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) pbuf_i => NULL() ENDIF - call t_stopf( 'chemdr' ) - - !============================================================== - ! ***** W E T D E P O S I T I O N (rainout + washout) ***** - !============================================================== - IF ( Input_Opt%LWetD ) THEN - - IF ( gas_wetdep_method == 'NEU' ) THEN - CALL Neu_wetdep_tend( LCHNK = LCHNK, & - NCOL = NCOL, & - mmr = state%q, & - pmid = state%pmid, & - pdel = state%pdel, & - zint = state%zi, & - tfld = state%t, & - delt = dT, & - prain = PRain, & - nevapr = NEvapr, & - cld = cldFrc, & - cmfdqr = cmfdqr, & - wd_tend = ptend%q, & - wd_tend_int = wetdepflx ) - ELSE - ErrMsg = 'Unknown gas_wetdep_method '//TRIM(gas_wetdep_method) - CALL Error_Stop( ErrMsg, ThisLoc ) - ENDIF - - ENDIF - DO N = 1, gas_pcnst ! See definition of map2chm M = map2chm(N) @@ -3810,17 +4060,26 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) !============================================================== #if defined( MODAL_AERO ) - - del_h2so4_gasprod = 0.0e+00_fp - ! This needs to be in mol/mol over this timestep - IF ( ( iPSO4 > 0 ) .and. ( MWPSO4 > 0.0e+00_fp ) ) THEN - DO L = 1, nZ - ! Convert from kg SO4/kg to mol/mol - del_h2so4_gasprod(:nY,L) = & - State_Chm(LCHNK)%Species(1,:nY,nZ+1-L,iPSO4) * MWDry / MWPSO4 + ! Repartition SO4 into H2SO4 and so4_a* + IF ( l_H2SO4 > 0 .AND. l_SO4 > 0 ) THEN + P = l_H2SO4 + ! SO4_gasRatio is mol(SO4) (gaseous) / mol(SO4) (gaseous+aerosol) + vmr1(:nY,:nZ,P) = SO4_gasRatio(:nY,:nZ) * vmr1(:nY,:nZ,l_SO4) + ! binRatio is mol(SO4) (current bin) / mol(SO4) (all bins) + DO M = 1, ntot_amode + N = lptr_so4_a_amode(M) + IF ( N <= 0 ) CYCLE + P = mapCnst(N) + vmr1(:nY,:nZ,P) = vmr1(:nY,:nZ,l_SO4) & + * ( 1.0_r8 - SO4_gasRatio(:nY,:nZ) ) & + * binRatio(iSulf(M),M,:nY,:nZ) ENDDO ENDIF + ! Amount of chemically-produced H2SO4 (mol/mol) + del_h2so4_gasprod(:nY,:nZ) = vmr1(:nY,:nZ,l_H2SO4) & + - vmr0(:nY,:nZ,l_H2SO4) + call aero_model_gasaerexch( loffset = iFirstCnst - 1, & ncol = NCOL, & lchnk = LCHNK, & @@ -3843,8 +4102,143 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) vmr0 = vmr0, & vmr = vmr1, & pbuf = pbuf ) + + ! Repartition MAM SOAs following mapping: + ! TSOA0 + ASOAN + SOAIE + SOAGX -> soa1_a* + soa2_a* + ! TSOA1 + ASOA1 -> soa3_a* + ! TSOA2 + ASOA2 -> soa4_a* + ! TSOA3 + ASOA3 -> soa5_a* + ! TSOG0 -> SOAG0 + SOAG1 + ! TSOG1 + ASOG1 -> SOAG2 + ! TSOG2 + ASOG2 -> SOAG3 + ! TSOG3 + ASOG3 -> SOAG4 + + ! Deal with aerosol SOA species + ! First deal with lowest two volatility bins + speciesName_1 = 'TSOA0' + speciesName_2 = 'ASOAN' + speciesName_2 = 'SOAIE' + speciesName_2 = 'SOAGX' + K1 = get_spc_ndx(TRIM(speciesName_1)) + K2 = get_spc_ndx(TRIM(speciesName_2)) + K3 = get_spc_ndx(TRIM(speciesName_3)) + K4 = get_spc_ndx(TRIM(speciesName_4)) + bulkMass(:nY,:nZ) = 0.0e+00_r8 + DO iBin = 1, 2 + DO M = 1, ntot_amode + N = lptr2_soa_a_amode(M,iBin) + IF ( N <= 0 ) CYCLE + bulkMass(:nY,:nZ) = bulkMass(:nY,:nZ) + state%q(:nY,:nZ,N) + ENDDO + ENDDO + DO iBin = 1, 2 + DO M = 1, ntot_amode + N = lptr2_soa_a_amode(M,iBin) + IF ( N <= 0 ) CYCLE + P = mapCnst(N) + IF ( P > 0 .AND. K1 > 0 .AND. K2 > 0 .AND. K3 > 0 .AND. K4 > 0 ) THEN + vmr1(:nY,:nZ,P) = state%q(:nY,:nZ,N) / bulkMass(:nY,:nZ) & + * (vmr1(:nY,:nZ,K1) + vmr1(:nY,:nZ,K2) + & + vmr1(:nY,:nZ,K3) + vmr1(:nY,:nZ,K4)) + ENDIF + ENDDO + ENDDO + + ! Now deal with other volatility bins + DO iBin = 3, nsoa + IF ( iBin == 3 ) THEN + speciesName_1 = 'TSOA1' + speciesName_2 = 'ASOA1' + ELSEIF ( iBin == 4 ) THEN + speciesName_1 = 'TSOA2' + speciesName_2 = 'ASOA2' + ELSEIF ( iBin == 5 ) THEN + speciesName_1 = 'TSOA3' + speciesName_2 = 'ASOA3' + ENDIF + K1 = get_spc_ndx(TRIM(speciesName_1)) + K2 = get_spc_ndx(TRIM(speciesName_2)) + bulkMass(:nY,:nZ) = 0.0e+00_r8 + DO M = 1, ntot_amode + N = lptr2_soa_a_amode(M,iBin) + IF ( N <= 0 ) CYCLE + bulkMass(:nY,:nZ) = bulkMass(:nY,:nZ) + state%q(:nY,:nZ,N) + ENDDO + DO M = 1, ntot_amode + N = lptr2_soa_a_amode(M,iBin) + IF ( N <= 0 ) CYCLE + P = mapCnst(N) + IF ( P > 0 .AND. K1 > 0 .AND. K2 > 0 ) THEN + vmr1(:nY,:nZ,P) = state%q(:nY,:nZ,N) / bulkMass(:nY,:nZ) & + * (vmr1(:nY,:nZ,K1) + vmr1(:nY,:nZ,K2)) + ENDIF + ENDDO + ENDDO + + ! Now deal with gaseous SOA species + ! Deal with lowest two volatility bins + speciesName_1 = 'TSOG0' + K1 = get_spc_ndx(TRIM(speciesName_1)) + N = lptr2_soa_g_amode(1) + P = mapCnst(N) + vmr1(:nY,:nZ,P) = vmr0(:nY,:nZ,P) / (vmr0(:nY,:nZ,P) + vmr0(:nY,:nZ,mapCnst(lptr2_soa_g_amode(2)))) & + * vmr1(:nY,:nZ,K1) + N = lptr2_soa_g_amode(2) + P = mapCnst(N) + vmr1(:nY,:nZ,P) = vmr0(:nY,:nZ,P) / (vmr0(:nY,:nZ,P) + vmr0(:nY,:nZ,mapCnst(lptr2_soa_g_amode(1)))) & + * vmr1(:nY,:nZ,K1) + + ! Deal with other volatility bins + DO iBin = 3, nsoa + N = lptr2_soa_g_amode(iBin) + P = mapCnst(N) + IF ( iBin == 3 ) THEN + speciesName_1 = 'TSOG1' + speciesName_2 = 'ASOG1' + ELSEIF ( iBin == 4 ) THEN + speciesName_1 = 'TSOG2' + speciesName_2 = 'ASOG2' + ELSEIF ( iBin == 5 ) THEN + speciesName_1 = 'TSOG3' + speciesName_2 = 'ASOG3' + ENDIF + K1 = get_spc_ndx(TRIM(speciesName_1)) + K2 = get_spc_ndx(TRIM(speciesName_2)) + IF ( P > 0 .AND. K1 > 0 .AND. K2 > 0 ) vmr1(:nY,:nZ,P) = vmr1(:nY,:nZ,K1) + vmr1(:nY,:nZ,K2) + ENDDO + #endif + !============================================================== + ! ***** W E T D E P O S I T I O N (rainout + washout) ***** + !============================================================== + IF ( Input_Opt%LWetD ) THEN + + IF ( gas_wetdep_method == 'NEU' ) THEN + CALL Neu_wetdep_tend( LCHNK = LCHNK, & + NCOL = NCOL, & + mmr = state%q, & + pmid = state%pmid, & + pdel = state%pdel, & + zint = state%zi, & + tfld = state%t, & + delt = dT, & + prain = PRain, & + nevapr = NEvapr, & + cld = cldFrc, & + cmfdqr = cmfdqr, & + wd_tend = ptend%q, & + wd_tend_int = wetdepflx ) + ELSE + ErrMsg = 'Unknown gas_wetdep_method '//TRIM(gas_wetdep_method) + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + ENDIF + + !============================================================== + ! ***** B O U N D A R Y C O N D I T I O N S ***** + !============================================================== ! Set boundary conditions of long-lived species (most likely ! CH4, OCS, N2O, CFC11, CFC12). ! Note: This will overwrite the UCX boundary conditions @@ -3882,6 +4276,7 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) ENDDO CALL set_short_lived_species( SlsData, LCHNK, nY, pbuf ) + ! Apply tendencies to GEOS-Chem species DO N = 1, pcnst M = map2GC(N) IF ( M <= 0 ) CYCLE @@ -3893,25 +4288,56 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) + (MMR_End(:nY,:nZ,M)-MMR_Beg(:nY,:nZ,M))/dT ENDDO -#if defined( MODAL_AERO_4MODE ) +#if defined( MODAL_AERO ) ! Here apply tendencies to MAM aerosols ! Initial mass in bin SM is stored as state%q(N) ! Final mass in bin SM is stored as binRatio(SM,M) * State_Chm(P) ! ! We decide to apply chemical tendencies to all MAM aerosols, ! except so4, for which the chemically-produced sulfate gets - ! partitioned in aero_model_gasaerexch + ! partitioned in aero_model_gasaerexch. DO M = 1, ntot_amode DO SM = 1, nspec_amode(M) - P = map2MAM4(SM,M) - IF ( P <= 0 .OR. to_upper(xname_massptr(SM,M)(:3)) == 'SO4' ) CYCLE N = lmassptr_amode(SM,M) - ! Apply MAM4 chemical tendencies owing to GEOS-Chem aerosol processing + P = mapCnst(N) + IF ( P <= 0 ) CYCLE + ! Apply tendency from MAM gasaerexch ptend%q(:nY,:nZ,N) = ptend%q(:nY,:nZ,N) & - + (binRatio(SM,M,:nY,:nZ) * & - REAL(State_Chm(LCHNK)%Species(1,:nY,nZ:1:-1,P),r8) & + + (vmr1(:nY,:nZ,P) - vmr0(:nY,:nZ,P))/dT & + * adv_mass(P) / MWDry + P = map2MAM4(SM,M) + IF ( P <= 0 ) CYCLE + K = map2GC(P) + IF ( K <= 0 .or. K == iSO4 ) CYCLE + ! Apply MAM4 chemical tendencies owing to GEOS-Chem aerosol processing + ptend%q(:nY,:nZ,N) = ptend%q(:nY,:nZ,N) & + + (binRatio(SM,M,:nY,:nZ) * & + REAL(State_Chm(LCHNK)%Species(1,:nY,nZ:1:-1,K),r8) & + * adv_mass(mapCnst(N)) / adv_mass(mapCnst(P)) & - state%q(:nY,:nZ,N))/dT ENDDO + N = numptr_amode(M) + P = mapCnst(N) + IF ( P <= 0 ) CYCLE + ptend%q(:nY,:nZ,N) = ptend%q(:nY,:nZ,N) & + + (vmr1(:nY,:nZ,P) - vmr0(:nY,:nZ,P))/dT & + * adv_mass(P) / MWDry + ENDDO + N = cH2SO4 + P = l_H2SO4 + IF ( P > 0 ) THEN + ptend%q(:nY,:nZ,N) = ptend%q(:nY,:nZ,N) & + + (vmr1(:nY,:nZ,P) - vmr0(:nY,:nZ,P))/dT & + * adv_mass(P) / MWDry + ENDIF + DO iBin = 1, nsoa + N = lptr2_soa_g_amode(iBin) + P = mapCnst(N) + IF ( P > 0 ) THEN + ptend%q(:nY,:nZ,N) = ptend%q(:nY,:nZ,N) & + + (vmr1(:nY,:nZ,P) - vmr0(:nY,:nZ,P))/dT & + * adv_mass(P) / MWDry + ENDIF ENDDO #endif @@ -3946,12 +4372,12 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) CALL outfld( 'CT_H2O_GHG', ptend%q(:,:,1), PCOLS, LCHNK ) ENDIF - ! Debug statements - ! Ozone tendencies - IF ( rootChunk ) THEN - Write(iulog,*) " MMR_Beg = ", MMR_Beg(1,:,iO3) - Write(iulog,*) " MMR_End = ", MMR_End(1,:,iO3) - ENDIF + !! Debug statements + !! Ozone tendencies + !IF ( rootChunk ) THEN + ! Write(iulog,*) " MMR_Beg = ", MMR_Beg(1,:,iO3) + ! Write(iulog,*) " MMR_End = ", MMR_End(1,:,iO3) + !ENDIF IF (PRESENT(fh2o)) THEN fh2o(:nY) = 0.0e+0_r8 diff --git a/src/chemistry/geoschem/mo_drydep.F90 b/src/chemistry/geoschem/mo_drydep.F90 deleted file mode 100644 index 66f4b122f0..0000000000 --- a/src/chemistry/geoschem/mo_drydep.F90 +++ /dev/null @@ -1,3494 +0,0 @@ -module mo_drydep - - !--------------------------------------------------------------------- - ! ... Dry deposition velocity input data and code for netcdf input - !--------------------------------------------------------------------- - -!LKE (10/11/2010): added HCN, CH3CN, HCOOH -!LKE (7/30/2015): added new TS1 species (phenooh, iepox, noa, etc.) - - use shr_kind_mod, only : r8 => shr_kind_r8, shr_kind_cl - !use chem_mods, only : gas_pcnst !This needs to be replaced by nTracersMax - use pmgrid, only : plev, plevp - use spmd_utils, only : masterproc, iam - use ppgrid, only : pcols, begchunk, endchunk - !use mo_tracname, only : solsym !This is replaced by tracerNames - use chem_mods, only : tracerNames, nTracersMax, nTracers, drySpc_ndx - use cam_abortutils, only : endrun - use ioFileMod, only : getfil - use pio - use cam_pio_utils, only : cam_pio_openfile, cam_pio_closefile - use cam_logfile, only : iulog - use dyn_grid, only : get_dyn_grid_parm, get_horiz_grid_d - use scamMod, only : single_column - - use seq_drydep_mod, only : nddvels => n_drydep, drydep_list, mapping - use physconst, only : karman - - use State_Chm_Mod, only : ChmState ! Derived type for Chemistry State object - - implicit none - - save - - interface drydep_inti - module procedure dvel_inti_table - module procedure dvel_inti_xactive - module procedure dvel_inti_fromlnd - end interface - - interface drydep_inti_landuse - module procedure dvel_inti_xactive_landuse - end interface - - interface drydep - !module procedure drydep_table - module procedure drydep_xactive - module procedure drydep_fromlnd - end interface - - private - public :: drydep_inti, drydep, set_soilw, chk_soilw, has_drydep - public :: drydep_inti_landuse - public :: drydep_update - public :: drydep_fromlnd - public :: n_land_type, fraction_landuse, drydep_srf_file - - real(r8) :: dels - real(r8), allocatable :: days(:) ! day of year for soilw - real(r8), allocatable :: dvel(:,:,:,:) ! depvel array interpolated to model grid - real(r8), allocatable :: dvel_interp(:,:,:) ! depvel array interpolated to grid and time - integer :: last, next ! day indicies - integer :: ndays ! # of days in soilw file - !integer :: map(gas_pcnst) ! indices for drydep species - integer :: map(nTracersMax) ! indices for drydep species - integer :: nspecies ! number of depvel species in input file - - integer :: pan_ndx, mpan_ndx, no2_ndx, hno3_ndx, o3_ndx, & - h2o2_ndx, onit_ndx, onitr_ndx, ch4_ndx, ch2o_ndx, & - ch3ooh_ndx, pooh_ndx, ch3coooh_ndx, c2h5ooh_ndx, eooh_ndx, & - c3h7ooh_ndx, rooh_ndx, ch3cocho_ndx, co_ndx, ch3coch3_ndx, & - no_ndx, ho2no2_ndx, glyald_ndx, hyac_ndx, ch3oh_ndx, c2h5oh_ndx, & - hydrald_ndx, h2_ndx, Pb_ndx, o3s_ndx, o3inert_ndx, macrooh_ndx, & - xooh_ndx, ch3cho_ndx, isopooh_ndx - integer :: alkooh_ndx, mekooh_ndx, tolooh_ndx, terpooh_ndx, ch3cooh_ndx - integer :: soa_ndx, so4_ndx, cb1_ndx, cb2_ndx, oc1_ndx, oc2_ndx, nh3_ndx, nh4no3_ndx, & - sa1_ndx, sa2_ndx, sa3_ndx, sa4_ndx, nh4_ndx - integer :: soam_ndx, soai_ndx, soat_ndx, soab_ndx, soax_ndx, & - sogm_ndx, sogi_ndx, sogt_ndx, sogb_ndx, sogx_ndx - - logical :: alkooh_dd, mekooh_dd, tolooh_dd, terpooh_dd, ch3cooh_dd - logical :: soa_dd, so4_dd, cb1_dd, cb2_dd, oc1_dd, oc2_dd, nh3_dd, nh4no3_dd, & - sa1_dd, sa2_dd, sa3_dd, sa4_dd, nh4_dd - logical :: soam_dd, soai_dd, soat_dd, soab_dd, soax_dd, & - sogm_dd, sogi_dd, sogt_dd, sogb_dd, sogx_dd - - logical :: pan_dd, mpan_dd, no2_dd, hno3_dd, o3_dd, isopooh_dd, ch4_dd,& - h2o2_dd, onit_dd, onitr_dd, ch2o_dd, macrooh_dd, xooh_dd, & - ch3ooh_dd, pooh_dd, ch3coooh_dd, c2h5ooh_dd, eooh_dd, ch3cho_dd, c2h5oh_dd, & - c3h7ooh_dd, rooh_dd, ch3cocho_dd, co_dd, ch3coch3_dd, & - glyald_dd, hyac_dd, ch3oh_dd, hydrald_dd, h2_dd, Pb_dd, o3s_dd, o3inert_dd - - integer :: so2_ndx - integer :: ch3cn_ndx, hcn_ndx, hcooh_ndx - logical :: ch3cn_dd, hcn_dd, hcooh_dd - - integer :: o3a_ndx,xpan_ndx,xmpan_ndx,xno2_ndx,xhno3_ndx,xonit_ndx,xonitr_ndx,xno_ndx,xho2no2_ndx,xnh4no3_ndx - logical :: o3a_dd, xpan_dd, xmpan_dd, xno2_dd, xhno3_dd, xonit_dd, xonitr_dd, xno_dd, xho2no2_dd, xnh4no3_dd - -!lke-TS1 - integer :: phenooh_ndx, benzooh_ndx, c6h5ooh_ndx, bzooh_ndx, xylolooh_ndx, xylenooh_ndx - integer :: terp2ooh_ndx, terprod1_ndx, terprod2_ndx, hmprop_ndx, mboooh_ndx, hpald_ndx, iepox_ndx - integer :: noa_ndx, alknit_ndx, isopnita_ndx, isopnitb_ndx, honitr_ndx, isopnooh_ndx - integer :: nc4cho_ndx, nc4ch2oh_ndx, terpnit_ndx, nterpooh_ndx - logical :: phenooh_dd, benzooh_dd, c6h5ooh_dd, bzooh_dd, xylolooh_dd, xylenooh_dd - logical :: terp2ooh_dd, terprod1_dd, terprod2_dd, hmprop_dd, mboooh_dd, hpald_dd, iepox_dd - logical :: noa_dd, alknit_dd, isopnita_dd, isopnitb_dd, honitr_dd, isopnooh_dd - logical :: nc4cho_dd, nc4ch2oh_dd, terpnit_dd, nterpooh_dd - - integer :: cohc_ndx=-1, come_ndx=-1 - integer, parameter :: NTAGS = 50 - integer :: cotag_ndx(NTAGS) - integer :: tag_cnt - - integer :: & - o3_tab_ndx = -1, & - h2o2_tab_ndx = -1, & - ch3ooh_tab_ndx = -1, & - co_tab_ndx = -1, & - ch3cho_tab_ndx = -1 - logical :: & - o3_in_tab = .false., & - h2o2_in_tab = .false., & - ch3ooh_in_tab = .false., & - co_in_tab = .false., & - ch3cho_in_tab = .false. - - real(r8), parameter :: small_value = 1.e-36_r8 - real(r8), parameter :: large_value = 1.e36_r8 - real(r8), parameter :: diffm = 1.789e-5_r8 - real(r8), parameter :: diffk = 1.461e-5_r8 - real(r8), parameter :: difft = 2.060e-5_r8 - real(r8), parameter :: vonkar = karman - real(r8), parameter :: ric = 0.2_r8 - real(r8), parameter :: r = 287.04_r8 - real(r8), parameter :: cp = 1004._r8 - real(r8), parameter :: grav = 9.81_r8 - real(r8), parameter :: p00 = 100000._r8 - real(r8), parameter :: wh2o = 18.0153_r8 - real(r8), parameter :: ph = 1.e-5_r8 - real(r8), parameter :: ph_inv = 1._r8/ph - real(r8), parameter :: rovcp = r/cp - - integer, pointer :: index_season_lai(:,:) - - !logical, public :: has_dvel(gas_pcnst) = .false. - !integer :: map_dvel(gas_pcnst) = 0 - logical, public :: has_dvel(nTracersMax) = .false. - integer :: map_dvel(nTracersMax) = 0 - real(r8) , allocatable :: soilw_3d(:,:,:) - - logical, parameter :: dyn_soilw = .false. - - real(r8), allocatable :: fraction_landuse(:,:,:) - real(r8), allocatable, dimension(:,:,:) :: dep_ra ! [s/m] aerodynamic resistance - real(r8), allocatable, dimension(:,:,:) :: dep_rb ! [s/m] resistance across sublayer - integer, parameter :: n_land_type = 11 - - real(r8), public :: crb - - type lnd_dvel_type - real(r8), pointer :: dvel(:,:) ! deposition velocity over land (cm/s) - end type lnd_dvel_type - - type(lnd_dvel_type), allocatable :: lnd(:) - character(len=SHR_KIND_CL) :: drydep_srf_file - -contains - - !--------------------------------------------------------------------------- - !--------------------------------------------------------------------------- - subroutine dvel_inti_fromlnd - use cam_abortutils, only : endrun - use seq_drydep_mod, only : dfoxd - - implicit none - - allocate( lnd(begchunk:endchunk) ) - - crb = (difft/diffm)**(2._r8/3._r8) !.666666_r8 - - endsubroutine dvel_inti_fromlnd - - !------------------------------------------------------------------------------------- - !------------------------------------------------------------------------------------- - subroutine drydep_update( state, cam_in ) - use physics_types, only : physics_state - use camsrfexch, only : cam_in_t - use seq_drydep_mod, only : drydep_method, DD_XLND - - type(physics_state), intent(in) :: state ! Physics state variables - type(cam_in_t), intent(in) :: cam_in - integer :: ispec - - if (nddvels<1) return - if (drydep_method /= DD_XLND) return - - lnd(state%lchnk)%dvel => cam_in%depvel - - end subroutine drydep_update - - !------------------------------------------------------------------------------------- - !------------------------------------------------------------------------------------- - subroutine drydep_fromlnd( ocnfrac, icefrac, ncdate, sfc_temp, pressure_sfc, & - wind_speed, spec_hum, air_temp, pressure_10m, rain, & - snow, solar_flux, dvelocity, dflx, State_Chm, & - tv, soilw, rh, ncol, lonndx, latndx, lchnk ) - - !------------------------------------------------------------------------------------- - ! combines the deposition velocities provided by the land model with deposition - ! velocities over ocean and sea ice - !------------------------------------------------------------------------------------- - - use ppgrid, only : pcols - -#if (defined OFFLINE_DYN) - use metdata, only: get_met_fields -#endif - - implicit none - - !------------------------------------------------------------------------------------- - ! ... dummy arguments - !------------------------------------------------------------------------------------- - - real(r8), intent(in) :: icefrac(pcols) - real(r8), intent(in) :: ocnfrac(pcols) - - integer, intent(in) :: ncol - integer, intent(in) :: ncdate ! present date (yyyymmdd) - real(r8), intent(in) :: sfc_temp(pcols) ! surface temperature (K) - real(r8), intent(in) :: pressure_sfc(pcols) ! surface pressure (Pa) - real(r8), intent(in) :: wind_speed(pcols) ! 10 meter wind speed (m/s) - real(r8), intent(in) :: spec_hum(pcols) ! specific humidity (kg/kg) - real(r8), intent(in) :: rh(ncol,1) ! relative humidity - real(r8), intent(in) :: air_temp(pcols) ! surface air temperature (K) - real(r8), intent(in) :: pressure_10m(pcols) ! 10 meter pressure (Pa) - real(r8), intent(in) :: rain(pcols) - real(r8), intent(in) :: snow(pcols) ! snow height (m) - real(r8), intent(in) :: soilw(pcols) ! soil moisture fraction - real(r8), intent(in) :: solar_flux(pcols) ! direct shortwave radiation at surface (W/m^2) - real(r8), intent(in) :: tv(pcols) ! potential temperature - type(ChmState), intent(in):: State_Chm ! GEOS-Chem State Chem - real(r8), intent(out) :: dvelocity(ncol,nTracersMax) ! deposition velocity (cm/s) - real(r8), intent(inout) :: dflx(pcols,nTracersMax) ! deposition flux (/cm^2/s) - - integer, intent(in) :: latndx(pcols) ! chunk latitude indicies - integer, intent(in) :: lonndx(pcols) ! chunk longitude indicies - integer, intent(in) :: lchnk ! chunk number - - !------------------------------------------------------------------------------------- - ! ... local variables - !------------------------------------------------------------------------------------- - real(r8) :: ocnice_dvel(ncol,nTracersMax) - real(r8) :: ocnice_dflx(pcols,nTracersMax) - - real(r8), dimension(ncol) :: term ! work array - integer :: ispec - real(r8) :: lndfrac(pcols) -#if (defined OFFLINE_DYN) - real(r8) :: met_ocnfrac(pcols) - real(r8) :: met_icefrac(pcols) -#endif - integer :: i - - lndfrac(:ncol) = 1._r8 - ocnfrac(:ncol) - icefrac(:ncol) - - where( lndfrac(:ncol) < 0._r8 ) - lndfrac(:ncol) = 0._r8 - endwhere - -#if (defined OFFLINE_DYN) - call get_met_fields(lndfrac, met_ocnfrac, met_icefrac, lchnk, ncol) -#endif - - !------------------------------------------------------------------------------------- - ! ... initialize - !------------------------------------------------------------------------------------- - dvelocity(:,:) = 0._r8 - - !------------------------------------------------------------------------------------- - ! ... compute the dep velocities over ocean and sea ice - ! land type 7 is used for ocean - ! land type 8 is used for sea ice - !------------------------------------------------------------------------------------- - call drydep_xactive( ncdate, sfc_temp, pressure_sfc, & - wind_speed, spec_hum, air_temp, pressure_10m, rain, & - snow, solar_flux, ocnice_dvel, ocnice_dflx, & - State_Chm, tv, soilw, & - rh, ncol, lonndx, latndx, lchnk, & -#if (defined OFFLINE_DYN) - ocnfrc=met_ocnfrac,icefrc=met_icefrac, beglandtype=7, endlandtype=8 ) -#else - ocnfrc=ocnfrac,icefrc=icefrac, beglandtype=7, endlandtype=8 ) -#endif - term(:ncol) = 1.e-2_r8 * pressure_10m(:ncol) / (r*tv(:ncol)) - - do ispec = 1, nddvels - !------------------------------------------------------------------------------------- - ! ... merge the land component with the non-land component - ! ocn and ice already have fractions factored in - !------------------------------------------------------------------------------------- - if ( drySpc_ndx(ispec) > 0 ) then - !Write(6,*) " Spec = ", drydep_list(iSpec), lchnk - !Write(6,*) " lndfrac = ", MAXVAL(lndfrac(:)), lchnk - !Write(6,*) " lndfrac = ", MINVAL(lndfrac(:)), lchnk - !Write(6,*) " lndvel = ", MAXVAL(lnd(lchnk)%dvel(:,iSpec)), " [cm/s]", lchnk - !Write(6,*) " ocnvel = ", MAXVAL(ocnice_dvel(:,drySpc_ndx(iSpec))), " [cm/s]", lchnk - dvelocity(:ncol,drySpc_ndx(ispec)) = lnd(lchnk)%dvel(:ncol,ispec)*lndfrac(:ncol) & - + ocnice_dvel(:ncol,drySpc_ndx(ispec)) - !Write(6,*) " dvel = ", MAXVAL(dvelocity(:,drySpc_ndx(iSpec))), " [cm/s]", lchnk - endif - enddo - - !------------------------------------------------------------------------------------- - ! ... special adjustments - !------------------------------------------------------------------------------------- - if( mpan_ndx>0 ) then - dvelocity(:ncol,mpan_ndx) = dvelocity(:ncol,mpan_ndx)/3._r8 - endif - if( xmpan_ndx>0 ) then - dvelocity(:ncol,xmpan_ndx) = dvelocity(:ncol,xmpan_ndx)/3._r8 - endif - if( hcn_ndx>0 ) then - dvelocity(:ncol,hcn_ndx) = ocnice_dvel(:ncol,hcn_ndx) ! should be zero over land - endif - if( ch3cn_ndx>0 ) then - dvelocity(:ncol,ch3cn_ndx) = ocnice_dvel(:ncol,ch3cn_ndx) ! should be zero over land - endif - - ! HCOOH, use CH3COOH dep.vel - if( hcooh_ndx > 0 .and. ch3cooh_ndx > 0 ) then - if( has_dvel(hcooh_ndx) ) then - dvelocity(:ncol,hcooh_ndx) = dvelocity(:ncol,ch3cooh_ndx) - end if - end if - - !------------------------------------------------------------------------------------- - ! ... assign CO tags to CO - ! put this kludge in for now ... - ! -- should be able to set all these via the table mapping in seq_drydep_mod - !------------------------------------------------------------------------------------- - if( cohc_ndx>0 .and. co_ndx>0 ) then - dvelocity(:ncol,cohc_ndx) = dvelocity(:ncol,co_ndx) - dflx(:ncol,cohc_ndx) = dvelocity(:ncol,co_ndx) * term(:ncol) * State_Chm%Species(1,:ncol,plev,cohc_ndx) - endif - if( come_ndx>0 .and. co_ndx>0 ) then - dvelocity(:ncol,come_ndx) = dvelocity(:ncol,co_ndx) - dflx(:ncol,come_ndx) = dvelocity(:ncol,co_ndx) * term(:ncol) * State_Chm%Species(1,:ncol,plev,come_ndx) - endif - - if ( co_ndx>0 ) then - do i=1,tag_cnt - dvelocity(:ncol,cotag_ndx(i)) = dvelocity(:ncol,co_ndx) - dflx(:ncol,cotag_ndx(i)) = dvelocity(:ncol,co_ndx) * term(:ncol) * State_Chm%Species(1,:ncol,plev,cotag_ndx(i)) - enddo - endif - - do ispec = 1,nddvels - !------------------------------------------------------------------------------------- - ! ... compute the deposition flux - !------------------------------------------------------------------------------------- - if ( drySpc_ndx(ispec) > 0 ) then - dflx(:ncol,drySpc_ndx(ispec)) = dvelocity(:ncol,drySpc_ndx(ispec)) * term(:ncol) * State_Chm%Species(1,:ncol,plev,drySpc_ndx(ispec)) - endif - end do - - end subroutine drydep_fromlnd - - !--------------------------------------------------------------------------- - !--------------------------------------------------------------------------- - subroutine dvel_inti_table( depvel_file ) - !--------------------------------------------------------------------------- - ! ... Initialize module, depvel arrays, and a few other variables. - ! The depvel fields will be linearly interpolated to the correct time - !--------------------------------------------------------------------------- - - use mo_constants, only : d2r, r2d - use ioFileMod, only : getfil - use string_utils, only : to_lower, GLC - use mo_chem_utls, only : get_spc_ndx - use constituents, only : pcnst - use chem_mods, only : drySpc_ndx - use interpolate_data, only : lininterp_init, lininterp, lininterp_finish,interp_type - use mo_constants, only : pi - use phys_grid, only : get_ncols_p, get_rlat_all_p, get_rlon_all_p - - implicit none - - character(len=*), intent(in) :: depvel_file - - !--------------------------------------------------------------------------- - ! ... Local variables - !--------------------------------------------------------------------------- - integer :: nlat, nlon, nmonth, ndims - integer :: dimid_lat, dimid_lon, dimid_species, dimid_time - integer :: dimid(4), count(4), start(4) - integer :: m, ispecies, nchar, ierr - real(r8) :: scale_factor - - real(r8), allocatable :: dvel_lats(:), dvel_lons(:) - real(r8), allocatable :: dvel_in(:,:,:,:) ! input depvel array - character(len=50) :: units - character(len=20), allocatable :: species_names(:) ! names of depvel species - logical :: found - type(file_desc_t) :: piofile - type(var_desc_t) :: vid, vid_dvel - - character(len=shr_kind_cl) :: locfn - integer :: mm,n - - integer :: i, c, ncols - real(r8) :: to_lats(pcols), to_lons(pcols) - type(interp_type) :: lon_wgts, lat_wgts - real(r8), parameter :: zero=0._r8, twopi=2._r8*pi - - mm = 1 - do m = 1,pcnst - if ( len_trim(drydep_list(m))==0 ) exit - n = drySpc_ndx(m) - !n = get_spc_ndx(drydep_list(m)) - if ( n < 1 ) then - write(iulog,*) 'drydep_inti: '//drydep_list(m)//' is not included in species set' - call endrun('drydep_init: invalid dry deposition species') - endif - enddo - - if( masterproc ) then - write(iulog,*) 'drydep_inti: following species have dry deposition' - do i=1,nddvels - if( len_trim(drydep_list(i)) > 0 ) then - write(iulog,*) 'drydep_inti: '//trim(drydep_list(i))//' is requested to have dry dep' - endif - enddo - write(iulog,*) 'drydep_inti:' - endif - - if ( nddvels < 1 ) return - - !--------------------------------------------------------------------------- - ! ... Setup species maps - !--------------------------------------------------------------------------- - o3a_ndx = get_spc_ndx( 'O3A') - xpan_ndx = get_spc_ndx( 'XPAN') - xmpan_ndx = get_spc_ndx( 'XMPAN') - xno2_ndx = get_spc_ndx( 'XNO2') - xhno3_ndx = get_spc_ndx( 'XHNO3') - xonit_ndx = get_spc_ndx( 'XONIT') - xonitr_ndx = get_spc_ndx( 'XONITR') - xno_ndx = get_spc_ndx( 'XNO') - xho2no2_ndx = get_spc_ndx( 'XHO2NO2') - o3a_dd = has_drydep( 'O3A') - xpan_dd = has_drydep( 'XPAN') - xmpan_dd = has_drydep( 'XMPAN') - xno2_dd = has_drydep( 'XNO2') - xhno3_dd = has_drydep( 'XHNO3') - xonit_dd = has_drydep( 'XONIT') - xonitr_dd = has_drydep( 'XONITR') - xno_dd = has_drydep( 'XNO') - xho2no2_dd = has_drydep( 'XHO2NO2') - - pan_ndx = get_spc_ndx( 'PAN') - mpan_ndx = get_spc_ndx( 'MPAN') - no2_ndx = get_spc_ndx( 'NO2') - hno3_ndx = get_spc_ndx( 'HNO3') - co_ndx = get_spc_ndx( 'CO') - o3_ndx = get_spc_ndx( 'O3') - if( o3_ndx < 1 ) then - o3_ndx = get_spc_ndx( 'OX') - end if - h2o2_ndx = get_spc_ndx( 'H2O2') - onit_ndx = get_spc_ndx( 'ONIT') - onitr_ndx = get_spc_ndx( 'ONITR') - ch4_ndx = get_spc_ndx( 'CH4') - ch2o_ndx = get_spc_ndx( 'CH2O') - ch3ooh_ndx = get_spc_ndx( 'CH3OOH') - ch3cho_ndx = get_spc_ndx( 'CH3CHO') - ch3cocho_ndx = get_spc_ndx( 'CH3COCHO') - pooh_ndx = get_spc_ndx( 'POOH') - ch3coooh_ndx = get_spc_ndx( 'CH3COOOH') - c2h5ooh_ndx = get_spc_ndx( 'C2H5OOH') - eooh_ndx = get_spc_ndx( 'EOOH') - c3h7ooh_ndx = get_spc_ndx( 'C3H7OOH') - rooh_ndx = get_spc_ndx( 'ROOH') - ch3coch3_ndx = get_spc_ndx( 'CH3COCH3') - no_ndx = get_spc_ndx( 'NO') - ho2no2_ndx = get_spc_ndx( 'HO2NO2') - glyald_ndx = get_spc_ndx( 'GLYALD') - hyac_ndx = get_spc_ndx( 'HYAC') - ch3oh_ndx = get_spc_ndx( 'CH3OH') - c2h5oh_ndx = get_spc_ndx( 'C2H5OH') - macrooh_ndx = get_spc_ndx( 'MACROOH') - isopooh_ndx = get_spc_ndx( 'ISOPOOH') - xooh_ndx = get_spc_ndx( 'XOOH') - hydrald_ndx = get_spc_ndx( 'HYDRALD') - h2_ndx = get_spc_ndx( 'H2') - Pb_ndx = get_spc_ndx( 'Pb') - o3s_ndx = get_spc_ndx( 'O3S') - o3inert_ndx = get_spc_ndx( 'O3INERT') - alkooh_ndx = get_spc_ndx( 'ALKOOH') - mekooh_ndx = get_spc_ndx( 'MEKOOH') - tolooh_ndx = get_spc_ndx( 'TOLOOH') - terpooh_ndx = get_spc_ndx( 'TERPOOH') - ch3cooh_ndx = get_spc_ndx( 'CH3COOH') - soam_ndx = get_spc_ndx( 'SOAM' ) - soai_ndx = get_spc_ndx( 'SOAI' ) - soat_ndx = get_spc_ndx( 'SOAT' ) - soab_ndx = get_spc_ndx( 'SOAB' ) - soax_ndx = get_spc_ndx( 'SOAX' ) - sogm_ndx = get_spc_ndx( 'SOGM' ) - sogi_ndx = get_spc_ndx( 'SOGI' ) - sogt_ndx = get_spc_ndx( 'SOGT' ) - sogb_ndx = get_spc_ndx( 'SOGB' ) - sogx_ndx = get_spc_ndx( 'SOGX' ) - soa_ndx = get_spc_ndx( 'SOA' ) - so4_ndx = get_spc_ndx( 'SO4' ) - cb1_ndx = get_spc_ndx( 'CB1' ) - cb2_ndx = get_spc_ndx( 'CB2' ) - oc1_ndx = get_spc_ndx( 'OC1' ) - oc2_ndx = get_spc_ndx( 'OC2' ) - nh3_ndx = get_spc_ndx( 'NH3' ) - nh4no3_ndx = get_spc_ndx( 'NH4NO3' ) - xnh4no3_ndx = get_spc_ndx( 'XNH4NO3' ) - sa1_ndx = get_spc_ndx( 'SA1' ) - sa2_ndx = get_spc_ndx( 'SA2' ) - sa3_ndx = get_spc_ndx( 'SA3' ) - sa4_ndx = get_spc_ndx( 'SA4' ) - nh4_ndx = get_spc_ndx( 'NH4' ) - alkooh_dd = has_drydep( 'ALKOOH') - mekooh_dd = has_drydep( 'MEKOOH') - tolooh_dd = has_drydep( 'TOLOOH') - terpooh_dd = has_drydep( 'TERPOOH') - ch3cooh_dd = has_drydep( 'CH3COOH') - soam_dd = has_drydep( 'SOAM' ) - soai_dd = has_drydep( 'SOAI' ) - soat_dd = has_drydep( 'SOAT' ) - soab_dd = has_drydep( 'SOAB' ) - soax_dd = has_drydep( 'SOAX' ) - sogm_dd = has_drydep( 'SOGM' ) - sogi_dd = has_drydep( 'SOGI' ) - sogt_dd = has_drydep( 'SOGT' ) - sogb_dd = has_drydep( 'SOGB' ) - sogx_dd = has_drydep( 'SOGX' ) - soa_dd = has_drydep( 'SOA' ) - so4_dd = has_drydep( 'SO4' ) - cb1_dd = has_drydep( 'CB1' ) - cb2_dd = has_drydep( 'CB2' ) - oc1_dd = has_drydep( 'OC1' ) - oc2_dd = has_drydep( 'OC2' ) - nh3_dd = has_drydep( 'NH3' ) - nh4no3_dd = has_drydep( 'NH4NO3' ) - xnh4no3_dd = has_drydep( 'XNH4NO3' ) - sa1_dd = has_drydep( 'SA1' ) - sa2_dd = has_drydep( 'SA2' ) - sa3_dd = has_drydep( 'SA3' ) - sa4_dd = has_drydep( 'SA4' ) - nh4_dd = has_drydep( 'NH4' ) - pan_dd = has_drydep( 'PAN') - mpan_dd = has_drydep( 'MPAN') - no2_dd = has_drydep( 'NO2') - hno3_dd = has_drydep( 'HNO3') - co_dd = has_drydep( 'CO') - o3_dd = has_drydep( 'O3') - if( .not. o3_dd ) then - o3_dd = has_drydep( 'OX') - end if - h2o2_dd = has_drydep( 'H2O2') - onit_dd = has_drydep( 'ONIT') - onitr_dd = has_drydep( 'ONITR') - ch4_dd = has_drydep( 'CH4') - ch2o_dd = has_drydep( 'CH2O') - ch3ooh_dd = has_drydep( 'CH3OOH') - ch3cho_dd = has_drydep( 'CH3CHO') - c2h5oh_dd = has_drydep( 'C2H5OH') - eooh_dd = has_drydep( 'EOOH') - ch3cocho_dd = has_drydep( 'CH3COCHO') - pooh_dd = has_drydep( 'POOH') - ch3coooh_dd = has_drydep( 'CH3COOOH') - c2h5ooh_dd = has_drydep( 'C2H5OOH') - c3h7ooh_dd = has_drydep( 'C3H7OOH') - rooh_dd = has_drydep( 'ROOH') - ch3coch3_dd = has_drydep( 'CH3COCH3') - glyald_dd = has_drydep( 'GLYALD') - hyac_dd = has_drydep( 'HYAC') - ch3oh_dd = has_drydep( 'CH3OH') - macrooh_dd = has_drydep( 'MACROOH') - isopooh_dd = has_drydep( 'ISOPOOH') - xooh_dd = has_drydep( 'XOOH') - hydrald_dd = has_drydep( 'HYDRALD') - h2_dd = has_drydep( 'H2') - Pb_dd = has_drydep( 'Pb') - o3s_dd = has_drydep( 'O3S') - o3inert_dd = has_drydep( 'O3INERT') - ch3cn_dd = has_drydep( 'CH3CN') - hcn_dd = has_drydep( 'HCN') - hcooh_dd = has_drydep( 'HCOOH') - ch3cn_ndx = get_spc_ndx( 'CH3CN') - hcn_ndx = get_spc_ndx( 'HCN') - hcooh_ndx = get_spc_ndx( 'HCOOH' ) - - if( masterproc ) then - write(iulog,*) 'dvel_inti: diagnostics' - write(iulog,'(10i5)') pan_ndx, mpan_ndx, no2_ndx, hno3_ndx, o3_ndx, & - h2o2_ndx, onit_ndx, onitr_ndx, ch4_ndx, ch2o_ndx, & - ch3ooh_ndx, pooh_ndx, ch3coooh_ndx, c2h5ooh_ndx, eooh_ndx, & - c3h7ooh_ndx, rooh_ndx, ch3cocho_ndx, co_ndx, ch3coch3_ndx, & - no_ndx, ho2no2_ndx, glyald_ndx, hyac_ndx, ch3oh_ndx, c2h5oh_ndx, & - hydrald_ndx, h2_ndx, Pb_ndx, o3s_ndx, o3inert_ndx, macrooh_ndx, & - xooh_ndx, ch3cho_ndx, isopooh_ndx, noa_ndx, alknit_ndx, isopnita_ndx, & - honitr_ndx, isopnooh_ndx, nc4cho_ndx, nc4ch2oh_ndx, terpnit_ndx, nterpooh_ndx - write(iulog,*) pan_dd, mpan_dd, no2_dd, hno3_dd, o3_dd, isopooh_dd, ch4_dd,& - h2o2_dd, onit_dd, onitr_dd, ch2o_dd, macrooh_dd, xooh_dd, & - ch3ooh_dd, pooh_dd, ch3coooh_dd, c2h5ooh_dd, eooh_dd, ch3cho_dd, c2h5oh_dd, & - c3h7ooh_dd, rooh_dd, ch3cocho_dd, co_dd, ch3coch3_dd, & - glyald_dd, hyac_dd, ch3oh_dd, hydrald_dd, h2_dd, Pb_dd, o3s_dd, o3inert_dd, & - noa_dd, alknit_dd, isopnita_dd, & - honitr_dd, isopnooh_dd, nc4cho_dd, nc4ch2oh_dd, terpnit_dd, nterpooh_dd - endif - !--------------------------------------------------------------------------- - ! ... Open NetCDF file - !--------------------------------------------------------------------------- - call getfil (depvel_file, locfn, 0) - call cam_pio_openfile (piofile, trim(locfn), PIO_NOWRITE) - - !--------------------------------------------------------------------------- - ! ... Get variable ID for dep vel array - !--------------------------------------------------------------------------- - ierr = pio_inq_varid( piofile, 'dvel', vid_dvel ) - - !--------------------------------------------------------------------------- - ! ... Inquire about dimensions - !--------------------------------------------------------------------------- - ierr = pio_inq_dimid( piofile, 'lon', dimid_lon ) - ierr = pio_inq_dimlen( piofile, dimid_lon, nlon ) - ierr = pio_inq_dimid( piofile, 'lat', dimid_lat ) - ierr = pio_inq_dimlen( piofile, dimid_lat, nlat ) - ierr = pio_inq_dimid( piofile, 'species', dimid_species ) - ierr = pio_inq_dimlen( piofile, dimid_species, nspecies ) - ierr = pio_inq_dimid( piofile, 'time', dimid_time ) - ierr = pio_inq_dimlen( piofile, dimid_time, nmonth ) - if(masterproc) write(iulog,*) 'dvel_inti: dimensions (nlon,nlat,nspecies,nmonth) = ',nlon,nlat,nspecies,nmonth - - !--------------------------------------------------------------------------- - ! ... Check dimensions of dvel variable. Must be (lon, lat, species, month). - !--------------------------------------------------------------------------- - ierr = pio_inq_varndims( piofile, vid_dvel, ndims ) - - if( masterproc .and. ndims /= 4 ) then - write(iulog,*) 'dvel_inti: dvel has ',ndims,' dimensions. Expecting 4.' - call endrun - end if - ierr = pio_inq_vardimid( piofile, vid_dvel, dimid ) - - if( dimid(1) /= dimid_lon .or. dimid(2) /= dimid_lat .or. & - dimid(3) /= dimid_species .or. dimid(4) /= dimid_time ) then - write(iulog,*) 'dvel_inti: Dimensions in wrong order for dvel' - write(iulog,*) '... Expecting (lon, lat, species, month)' - call endrun - end if - - !--------------------------------------------------------------------------- - ! ... Allocate depvel lats, lons and read - !--------------------------------------------------------------------------- - allocate( dvel_lats(nlat), stat=ierr ) - if( ierr /= 0 ) then - write(iulog,*) 'dvel_inti: Failed to allocate dvel_lats vector' - call endrun - end if - allocate( dvel_lons(nlon), stat=ierr ) - if( ierr /= 0 ) then - write(iulog,*) 'dvel_inti: Failed to allocate dvel_lons vector' - call endrun - end if - - ierr = pio_inq_varid( piofile, 'lat', vid ) - ierr = pio_get_var( piofile, vid, dvel_lats ) - ierr = pio_inq_varid( piofile, 'lon', vid ) - ierr = pio_get_var( piofile, vid, dvel_lons ) - - !--------------------------------------------------------------------------- - ! ... Set the transform from inputs lats to simulation lats - !--------------------------------------------------------------------------- - dvel_lats(:nlat) = d2r * dvel_lats(:nlat) - dvel_lons(:nlon) = d2r * dvel_lons(:nlon) - - !--------------------------------------------------------------------------- - ! ... Allocate dvel and read data from file - !--------------------------------------------------------------------------- - allocate( dvel_in(nlon, nlat ,nspecies, nmonth), stat=ierr ) - if( ierr /= 0 ) then - write(iulog,*) 'dvel_inti: Failed to allocate dvel_in' - call endrun - end if - start = (/ 1, 1, 1, 1 /) - count = (/ nlon, nlat, nspecies, nmonth /) - - ierr = pio_get_var( piofile, vid_dvel, start, count, dvel_in ) - - - !--------------------------------------------------------------------------- - ! ... Check units of deposition velocity. If necessary, convert to cm/s. - !--------------------------------------------------------------------------- - units(:) = ' ' - ierr = pio_get_att( piofile, vid_dvel, 'units', units ) - if( to_lower(trim(units(:GLC(units)))) == 'm/s' ) then -#ifdef DEBUG - if(masterproc) write(iulog,*) 'dvel_inti: depvel units = m/s. Converting to cm/s' -#endif - scale_factor = 100._r8 - elseif( to_lower(trim(units(:GLC(units)))) == 'cm/s' ) then -#ifdef DEBUG - if(masterproc) write(iulog,*) 'dvel_inti: depvel units = cm/s' -#endif - scale_factor = 1._r8 - else -#ifdef DEBUG - if(masterproc) then - write(iulog,*) 'dvel_inti: Warning! depvel units unknown = ', to_lower(trim(units)) - write(iulog,*) ' ... proceeding with scale_factor=1' - end if -#endif - scale_factor = 1._r8 - end if - - dvel_in(:,:,:,:) = scale_factor*dvel_in(:,:,:,:) - - !--------------------------------------------------------------------------- - ! ... Regrid deposition velocities - !--------------------------------------------------------------------------- - allocate( dvel(pcols,begchunk:endchunk,nspecies,nmonth),stat=ierr ) - if( ierr /= 0 ) then - write(iulog,*) 'dvel_inti: Failed to allocate dvel' - call endrun - end if - - do c=begchunk,endchunk - ncols = get_ncols_p(c) - call get_rlat_all_p(c, pcols, to_lats) - call get_rlon_all_p(c, pcols, to_lons) - call lininterp_init(dvel_lons, nlon, to_lons, ncols, 2, lon_wgts, zero, twopi) - call lininterp_init(dvel_lats, nlat, to_lats, ncols, 1, lat_wgts) - - do ispecies = 1,nspecies - do m = 1,12 - call lininterp( dvel_in( :,:,ispecies,m ), nlon, nlat, dvel(:,c,ispecies,m), ncols,lon_wgts,lat_wgts) - end do - end do - - call lininterp_finish(lat_wgts) - call lininterp_finish(lon_wgts) - end do - - deallocate( dvel_in ) - deallocate( dvel_lats, dvel_lons ) - - !--------------------------------------------------------------------------- - ! ... Read in species names and determine mapping to tracer numbers - !--------------------------------------------------------------------------- - allocate( species_names(nspecies), stat=ierr ) - if( ierr /= 0 ) then - write(iulog,*) 'dvel_inti: species_names allocation error = ',ierr - call endrun - end if - ierr = pio_inq_varid( piofile, 'species_name', vid ) - ierr = pio_inq_varndims( piofile, vid, ndims ) - - ierr = pio_inq_vardimid( piofile, vid, dimid ) - - ierr = pio_inq_dimlen( piofile, dimid(1), nchar ) - map(:) = 0 - do ispecies = 1,nspecies - start(:2) = (/ 1, ispecies /) - count(:2) = (/ nchar, 1 /) - species_names(ispecies)(:) = ' ' - ierr = pio_get_var( piofile, vid, start(1:2), count(1:2), species_names(ispecies:ispecies) ) - if( species_names(ispecies) == 'O3' ) then - o3_in_tab = .true. - o3_tab_ndx = ispecies - else if( species_names(ispecies) == 'H2O2' ) then - h2o2_in_tab = .true. - h2o2_tab_ndx = ispecies - else if( species_names(ispecies) == 'CH3OOH' ) then - ch3ooh_in_tab = .true. - ch3ooh_tab_ndx = ispecies - else if( species_names(ispecies) == 'CO' ) then - co_in_tab = .true. - co_tab_ndx = ispecies - else if( species_names(ispecies) == 'CH3CHO' ) then - ch3cho_in_tab = .true. - ch3cho_tab_ndx = ispecies - end if - found = .false. - do m = 1, nTracers - if( species_names(ispecies) == tracerNames(m) .or. & - (species_names(ispecies) == 'O3' .and. tracerNames(m) == 'OX') .or. & - (species_names(ispecies) == 'HNO4' .and. tracerNames(m) == 'HO2NO2') ) then - if ( has_drydep( tracerNames(m) ) ) then - map(m) = ispecies - found = .true. -#ifdef DEBUG - if( masterproc ) then - write(iulog,*) 'dvel_inti: ispecies, m, tracnam = ',ispecies,m,trim(tracerNames(m)) - end if -#endif - exit - end if - end if - end do - if( .not. found ) then - write(iulog,*) 'dvel_inti: Warning! DVEL species ',trim(species_names(ispecies)),' not found' - endif - end do - deallocate( species_names ) - - call cam_pio_closefile( piofile ) - - !--------------------------------------------------------------------------- - ! ... Allocate dvel_interp array - !--------------------------------------------------------------------------- - allocate( dvel_interp(pcols,begchunk:endchunk,nspecies),stat=ierr ) - if( ierr /= 0 ) then - write(iulog,*) 'dvel_inti: Failed to allocate dvel_interp; error = ',ierr - call endrun - end if - - end subroutine dvel_inti_table - - !------------------------------------------------------------------------------------- - !------------------------------------------------------------------------------------- - subroutine interpdvel( calday, ncol, lchnk ) - !--------------------------------------------------------------------------- - ! ... Interpolate the fields whose values are required at the - ! begining of a timestep. - !--------------------------------------------------------------------------- - - use time_manager, only : get_calday - - implicit none - - !--------------------------------------------------------------------------- - ! ... Dummy arguments - !--------------------------------------------------------------------------- - real(r8), intent(in) :: calday ! Interpolate the input data to calday - integer, intent(in) :: ncol, lchnk - - !--------------------------------------------------------------------------- - ! ... Local variables - !--------------------------------------------------------------------------- - integer :: m, last, next - integer :: dates(12) = (/ 116, 214, 316, 415, 516, 615, & - 716, 816, 915, 1016, 1115, 1216 /) - real(r8) :: calday_loc, last_days, next_days - real(r8), save :: dys(12) - logical, save :: entered = .false. - - if( .not. entered ) then - do m = 1,12 - dys(m) = get_calday( dates(m), 0 ) - end do - entered = .true. - end if - - if( calday < dys(1) ) then - next = 1 - last = 12 - else if( calday >= dys(12) ) then - next = 1 - last = 12 - else - do m = 11,1,-1 - if( calday >= dys(m) ) then - exit - end if - end do - last = m - next = m + 1 - end if - - last_days = dys( last ) - next_days = dys( next ) - calday_loc = calday - - if( next_days < last_days ) then - next_days = next_days + 365._r8 - end if - if( calday_loc < last_days ) then - calday_loc = calday_loc + 365._r8 - end if - - do m = 1,nspecies - call intp2d( last_days, next_days, calday_loc, ncol, lchnk, & - dvel(:,lchnk,m,last), & - dvel(:,lchnk,m,next), & - dvel_interp(:,lchnk,m) ) - end do - - end subroutine interpdvel - - !------------------------------------------------------------------------------------- - !------------------------------------------------------------------------------------- - subroutine intp2d( t1, t2, tint, ncol, lchnk, f1, f2, fint ) - !----------------------------------------------------------------------- - ! ... Linearly interpolate between f1(t1) and f2(t2) to fint(tint). - !----------------------------------------------------------------------- - - implicit none - - !----------------------------------------------------------------------- - ! ... Dummy arguments - !----------------------------------------------------------------------- - real(r8), intent(in) :: & - t1, & ! time level of f1 - t2, & ! time level of f2 - tint ! interpolant time - real(r8), dimension(pcols), intent(in) :: & - f1, & ! field at time t1 - f2 ! field at time t2 - - integer, intent(in) :: ncol, lchnk - - real(r8), intent(out) :: & - fint(pcols) ! field at time tint - - - !----------------------------------------------------------------------- - ! ... Local variables - !----------------------------------------------------------------------- - real(r8) :: factor - - factor = (tint - t1)/(t2 - t1) - - fint(:ncol) = f1(:ncol) + (f2(:ncol) - f1(:ncol))*factor - - end subroutine intp2d - - !------------------------------------------------------------------------------------- - !------------------------------------------------------------------------------------- - !subroutine drydep_table( calday, tsurf, zen_angle, & - ! depvel, dflx, q, p, & - ! tv, ncol, icefrac, ocnfrac, lchnk ) - ! !-------------------------------------------------------- - ! ! ... Form the deposition velocities for this - ! ! latitude slice - ! !-------------------------------------------------------- - - ! use physconst, only : rair,pi - ! use dycore, only : dycore_is - - ! implicit none - - ! !-------------------------------------------------------- - ! ! ... Dummy arguments - ! !-------------------------------------------------------- - ! integer, intent(in) :: ncol ! columns in chunk - ! real(r8), intent(in) :: q(pcols,plev,gas_pcnst) ! tracer mmr (kg/kg) - ! real(r8), intent(in) :: p(pcols) ! midpoint pressure in surface layer (Pa) - ! real(r8), intent(in) :: tv(pcols) ! virtual temperature in surface layer (K) - ! real(r8), intent(in) :: calday ! time of year in days - ! real(r8), intent(in) :: tsurf(pcols) ! surface temperature (K) - ! real(r8), intent(in) :: zen_angle(ncol) ! zenith angle (radians) - ! real(r8), intent(inout) :: dflx(pcols,gas_pcnst) ! flux due to dry deposition (kg/m^2/sec) - ! real(r8), intent(out) :: depvel(ncol,gas_pcnst) ! deposition vel (cm/s) - - ! real(r8), intent(in) :: icefrac(pcols) ! sea-ice areal fraction - ! real(r8), intent(in) :: ocnfrac(pcols) ! ocean areal fraction - ! - ! integer, intent(in) :: lchnk - ! !----------------------------------------------------------------------- - ! ! ... Local variables - ! !----------------------------------------------------------------------- - ! integer :: m, i - ! real(r8), dimension(ncol) :: vel, glace, temp_fac, wrk, tmp - ! real(r8), dimension(ncol) :: o3_tab_dvel - ! real(r8), dimension(ncol) :: ocean - - ! real(r8), parameter :: pid2 = .5_r8 * pi - - ! if(dycore_is('UNSTRUCTURED')) then - ! call endrun( 'Option not supported for unstructured atmosphere grids ') - ! end if - - ! !----------------------------------------------------------------------- - ! ! ... Note the factor 1.e-2 in the wrk array calculation is - ! ! to transform the incoming dep vel from cm/s to m/s - ! !----------------------------------------------------------------------- - ! wrk(:ncol) = 1.e-2_r8 * p(:ncol) / (rair * tv(:ncol)) - - ! !-------------------------------------------------------- - ! ! ... Initialize all deposition velocities to zero - ! !-------------------------------------------------------- - ! depvel(:,:) = 0._r8 - - ! !-------------------------------------------------------- - ! ! ... Time interpolate primary depvel array - ! ! (also seaice and npp) - ! !-------------------------------------------------------- - ! call interpdvel( calday, ncol, lchnk ) - - ! if( o3_in_tab ) then - ! do i=1,ncol - ! o3_tab_dvel(i) = dvel_interp(i,lchnk,o3_tab_ndx) - ! enddo - ! end if - - ! !-------------------------------------------------------- - ! ! ... Set deposition velocities - ! !-------------------------------------------------------- - ! do m = 1,gas_pcnst - ! if( map(m) /= 0 ) then - ! do i = 1,ncol - ! depvel(i,m) = dvel_interp(i,lchnk,map(m)) - ! dflx(i,m) = wrk(i) * depvel(i,m) * q(i,plev,m) - ! enddo - ! end if - ! end do - - ! !-------------------------------------------------------- - ! ! ... Set some variables needed for some dvel calculations - ! !-------------------------------------------------------- - ! temp_fac(:ncol) = min( 1._r8, max( 0._r8, (tsurf(:ncol) - 268._r8) / 5._r8 ) ) - ! ocean(:ncol) = icefrac(:ncol)+ocnfrac(:ncol) - ! glace(:ncol) = icefrac(:ncol) + (1._r8 - ocean(:ncol)) * (1._r8 - temp_fac(:ncol)) - ! glace(:ncol) = min( 1._r8,glace(:ncol) ) - - ! !-------------------------------------------------------- - ! ! ... Set pan & mpan - ! !-------------------------------------------------------- - ! if( o3_in_tab ) then - ! tmp(:ncol) = o3_tab_dvel(:ncol) / 3._r8 - ! else - ! tmp(:) = 0._r8 - ! end if - ! if( pan_dd ) then - ! if( map(pan_ndx) == 0 ) then - ! depvel(:ncol,pan_ndx) = tmp(:ncol) - ! dflx(:ncol,pan_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,pan_ndx) - ! end if - ! end if - ! if( mpan_dd ) then - ! if( map(mpan_ndx) == 0 ) then - ! depvel(:ncol,mpan_ndx) = tmp(:ncol) - ! dflx(:ncol,mpan_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,mpan_ndx) - ! end if - ! end if - - ! !-------------------------------------------------------- - ! ! ... Set no2 dvel - ! !-------------------------------------------------------- - ! if( no2_dd ) then - ! if( map(no2_ndx) == 0 .and. o3_in_tab ) then - ! depvel(:ncol,no2_ndx) = (.6_r8*o3_tab_dvel(:ncol) + .055_r8*ocean(:ncol)) * .9_r8 - ! dflx(:ncol,no2_ndx) = wrk(:) * depvel(:ncol,no2_ndx) * q(:ncol,plev,no2_ndx) - ! end if - ! end if - - ! !-------------------------------------------------------- - ! ! ... Set hno3 dvel - ! !-------------------------------------------------------- - ! tmp(:ncol) = (2._r8 - ocnfrac(:ncol)) * (1._r8 - glace(:ncol)) + .05_r8 * glace(:ncol) - ! if( hno3_dd ) then - ! if( map(hno3_ndx) == 0 ) then - ! depvel(:ncol,hno3_ndx) = tmp(:ncol) - ! dflx(:ncol,hno3_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,hno3_ndx) - ! else - ! tmp(:ncol) = depvel(:ncol,hno3_ndx) - ! end if - ! end if - ! if( onitr_dd ) then - ! if( map(onitr_ndx) == 0 ) then - ! depvel(:ncol,onitr_ndx) = tmp(:ncol) - ! dflx(:ncol,onitr_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,onitr_ndx) - ! end if - ! end if - ! if( isopooh_dd ) then - ! if( map(isopooh_ndx) == 0 ) then - ! depvel(:ncol,isopooh_ndx) = tmp(:ncol) - ! dflx(:ncol,isopooh_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,isopooh_ndx) - ! end if - ! end if - - ! !-------------------------------------------------------- - ! ! ... Set h2o2 dvel - ! !-------------------------------------------------------- - ! if( .not. h2o2_in_tab ) then - ! if( o3_in_tab ) then - ! tmp(:ncol) = .05_r8*glace(:ncol) + ocean(:ncol) - icefrac(:ncol) & - ! + (1._r8 - (glace(:) + ocean(:ncol)) + icefrac(:ncol)) & - ! *max( 1._r8,1._r8/(.5_r8 + 1._r8/(6._r8*o3_tab_dvel(:ncol))) ) - ! else - ! tmp(:ncol) = 0._r8 - ! end if - ! else - ! do i=1,ncol - ! tmp(i) = dvel_interp(i,lchnk,h2o2_tab_ndx) - ! enddo - ! end if - ! if( h2o2_dd ) then - ! if( map(h2o2_ndx) == 0 ) then - ! depvel(:ncol,h2o2_ndx) = tmp(:ncol) - ! dflx(:ncol,h2o2_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,h2o2_ndx) - ! end if - ! end if - ! !-------------------------------------------------------- - ! ! ... Set hcn dvel - ! !-------------------------------------------------------- - ! if( hcn_dd ) then - ! if( map(hcn_ndx) == 0 ) then - ! depvel(:ncol,hcn_ndx) = ocnfrac(:ncol)*0.2_r8 - ! endif - ! endif - ! !-------------------------------------------------------- - ! ! ... Set ch3cn dvel - ! !-------------------------------------------------------- - ! if( ch3cn_dd ) then - ! if( map(ch3cn_ndx) == 0 ) then - ! depvel(:,ch3cn_ndx) = ocnfrac(:ncol)*0.2_r8 - ! endif - ! endif - ! !-------------------------------------------------------- - ! ! ... Set onit - ! !-------------------------------------------------------- - ! if( onit_dd ) then - ! if( map(onit_ndx) == 0 ) then - ! depvel(:ncol,onit_ndx) = tmp(:ncol) - ! dflx(:ncol,onit_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,onit_ndx) - ! end if - ! end if - ! if( ch3cocho_dd ) then - ! if( map(ch3cocho_ndx) == 0 ) then - ! depvel(:ncol,ch3cocho_ndx) = tmp(:ncol) - ! dflx(:ncol,ch3cocho_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,ch3cocho_ndx) - ! end if - ! end if - ! if( ch3ooh_in_tab ) then - ! do i=1,ncol - ! tmp(i) = dvel_interp(i,lchnk,ch3ooh_tab_ndx) - ! enddo - ! else - ! tmp(:ncol) = .5_r8 * tmp(:ncol) - ! end if - ! if( ch3ooh_dd ) then - ! if( map(ch3ooh_ndx) == 0 ) then - ! depvel(:ncol,ch3ooh_ndx) = tmp(:ncol) - ! dflx(:ncol,ch3ooh_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,ch3ooh_ndx) - ! end if - ! end if - ! if( pooh_dd ) then - ! if( map(pooh_ndx) == 0 ) then - ! depvel(:ncol,pooh_ndx) = tmp(:ncol) - ! dflx(:ncol,pooh_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,pooh_ndx) - ! end if - ! end if - ! if( ch3coooh_dd ) then - ! if( map(ch3coooh_ndx) == 0 ) then - ! depvel(:ncol,ch3coooh_ndx) = tmp(:ncol) - ! dflx(:ncol,ch3coooh_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,ch3coooh_ndx) - ! end if - ! end if - ! if( c2h5ooh_dd ) then - ! if( map(c2h5ooh_ndx) == 0 ) then - ! depvel(:ncol,c2h5ooh_ndx) = tmp(:ncol) - ! dflx(:ncol,c2h5ooh_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,c2h5ooh_ndx) - ! end if - ! end if - ! if( c3h7ooh_dd ) then - ! if( map(c3h7ooh_ndx) == 0 ) then - ! depvel(:ncol,c3h7ooh_ndx) = tmp(:ncol) - ! dflx(:ncol,c3h7ooh_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,c3h7ooh_ndx) - ! end if - ! end if - ! if( rooh_dd ) then - ! if( map(rooh_ndx) == 0 ) then - ! depvel(:ncol,rooh_ndx) = tmp(:ncol) - ! dflx(:ncol,rooh_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,rooh_ndx) - ! end if - ! end if - ! if( macrooh_dd ) then - ! if( map(macrooh_ndx) == 0 ) then - ! depvel(:ncol,macrooh_ndx) = tmp(:ncol) - ! dflx(:ncol,macrooh_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,macrooh_ndx) - ! end if - ! end if - ! if( xooh_dd ) then - ! if( map(xooh_ndx) == 0 ) then - ! depvel(:ncol,xooh_ndx) = tmp(:ncol) - ! dflx(:ncol,xooh_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,xooh_ndx) - ! end if - ! end if - ! if( ch3oh_dd ) then - ! if( map(ch3oh_ndx) == 0 ) then - ! depvel(:ncol,ch3oh_ndx) = tmp(:ncol) - ! dflx(:ncol,ch3oh_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,ch3oh_ndx) - ! end if - ! end if - ! if( c2h5oh_dd ) then - ! if( map(c2h5oh_ndx) == 0 ) then - ! depvel(:ncol,c2h5oh_ndx) = tmp(:ncol) - ! dflx(:ncol,c2h5oh_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,c2h5oh_ndx) - ! end if - ! end if - ! if( alkooh_dd ) then - ! if( map(alkooh_ndx) == 0 ) then - ! depvel(:ncol,alkooh_ndx) = tmp(:ncol) - ! dflx(:ncol,alkooh_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,alkooh_ndx) - ! end if - ! end if - ! if( mekooh_dd ) then - ! if( map(mekooh_ndx) == 0 ) then - ! depvel(:ncol,mekooh_ndx) = tmp(:ncol) - ! dflx(:ncol,mekooh_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,mekooh_ndx) - ! end if - ! end if - ! if( tolooh_dd ) then - ! if( map(tolooh_ndx) == 0 ) then - ! depvel(:ncol,tolooh_ndx) = tmp(:ncol) - ! dflx(:ncol,tolooh_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,tolooh_ndx) - ! end if - ! end if - ! if( o3_in_tab ) then - ! tmp(:ncol) = o3_tab_dvel(:ncol) - ! else - ! tmp(:ncol) = 0._r8 - ! end if - ! if( ch2o_dd ) then - ! if( map(ch2o_ndx) == 0 ) then - ! depvel(:ncol,ch2o_ndx) = tmp(:ncol) - ! dflx(:ncol,ch2o_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,ch2o_ndx) - ! end if - ! end if - - ! if( hydrald_dd ) then - ! if( map(hydrald_ndx) == 0 ) then - ! depvel(:ncol,hydrald_ndx) = tmp(:ncol) - ! dflx(:ncol,hydrald_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,hydrald_ndx) - ! end if - ! end if - ! if( ch3cooh_dd ) then - ! if( map(ch3cooh_ndx) == 0 ) then - ! depvel(:ncol,ch3cooh_ndx) = depvel(:ncol,ch2o_ndx) - ! dflx(:ncol,ch3cooh_ndx) = wrk(:ncol) * depvel(:ncol,ch3cooh_ndx) * q(:ncol,plev,ch3cooh_ndx) - ! end if - ! end if - ! if( eooh_dd ) then - ! if( map(eooh_ndx) == 0 ) then - ! depvel(:ncol,eooh_ndx) = depvel(:ncol,ch2o_ndx) - ! dflx(:ncol,eooh_ndx) = wrk(:ncol) * depvel(:ncol,eooh_ndx) * q(:ncol,plev,eooh_ndx) - ! end if - ! end if - ! ! HCOOH - set to CH3COOH - ! if( hcooh_dd ) then - ! if( map(hcooh_ndx) == 0 ) then - ! depvel(:ncol,hcooh_ndx) = depvel(:ncol,ch2o_ndx) - ! dflx(:ncol,hcooh_ndx) = wrk(:ncol) * depvel(:ncol,hcooh_ndx) * q(:ncol,plev,hcooh_ndx) - ! end if - ! end if - - ! !-------------------------------------------------------- - ! ! ... Set co and related species dep vel - ! !-------------------------------------------------------- - ! if( co_in_tab ) then - ! do i=1,ncol - ! tmp(i) = dvel_interp(i,lchnk,co_tab_ndx) - ! enddo - ! else - ! tmp(:) = 0._r8 - ! end if - ! if( co_dd ) then - ! if( map(co_ndx) == 0 ) then - ! depvel(:ncol,co_ndx) = tmp(:ncol) - ! dflx(:ncol,co_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,co_ndx) - ! end if - ! end if - ! if( ch3coch3_dd ) then - ! if( map(ch3coch3_ndx) == 0 ) then - ! depvel(:ncol,ch3coch3_ndx) = tmp(:ncol) - ! dflx(:ncol,ch3coch3_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,ch3coch3_ndx) - ! end if - ! end if - ! if( hyac_dd ) then - ! if( map(hyac_ndx) == 0 ) then - ! depvel(:ncol,hyac_ndx) = tmp(:ncol) - ! dflx(:ncol,hyac_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,hyac_ndx) - ! end if - ! end if - ! if( h2_dd ) then - ! if( map(h2_ndx) == 0 ) then - ! depvel(:ncol,h2_ndx) = tmp(:ncol) * 1.5_r8 ! Hough(1991) - ! dflx(:ncol,h2_ndx) = wrk(:ncol) * depvel(:ncol,h2_ndx) * q(:ncol,plev,h2_ndx) - ! end if - ! end if - - ! !-------------------------------------------------------- - ! ! ... Set glyald - ! !-------------------------------------------------------- - ! if( glyald_dd ) then - ! if( map(glyald_ndx) == 0 ) then - ! if( ch3cho_dd ) then - ! depvel(:ncol,glyald_ndx) = depvel(:ncol,ch3cho_ndx) - ! else if( ch3cho_in_tab ) then - ! do i=1,ncol - ! depvel(i,glyald_ndx) = dvel_interp(i,lchnk,ch3cho_tab_ndx) - ! enddo - ! else - ! depvel(:ncol,glyald_ndx) = 0._r8 - ! end if - ! dflx(:ncol,glyald_ndx) = wrk(:ncol) * depvel(:ncol,glyald_ndx) * q(:ncol,plev,glyald_ndx) - ! end if - ! end if - - ! !-------------------------------------------------------- - ! ! ... Lead deposition - ! !-------------------------------------------------------- - ! if( Pb_dd ) then - ! if( map(Pb_ndx) == 0 ) then - ! depvel(:ncol,Pb_ndx) = ocean(:ncol) * .05_r8 + (1._r8 - ocean(:ncol)) * .2_r8 - ! dflx(:ncol,Pb_ndx) = wrk(:ncol) * depvel(:ncol,Pb_ndx) * q(:ncol,plev,Pb_ndx) - ! end if - ! end if - - ! !-------------------------------------------------------- - ! ! ... diurnal dependence for OX dvel - ! !-------------------------------------------------------- - ! if( o3_dd .or. o3s_dd .or. o3inert_dd ) then - ! if( o3_dd .or. o3_in_tab ) then - ! if( o3_dd ) then - ! tmp(:ncol) = max( 1._r8,sqrt( (depvel(:ncol,o3_ndx) - .2_r8)**3/.27_r8 + 4._r8*depvel(:ncol,o3_ndx) + .67_r8 ) ) - ! vel(:ncol) = depvel(:ncol,o3_ndx) - ! else if( o3_in_tab ) then - ! tmp(:ncol) = max( 1._r8,sqrt( (o3_tab_dvel(:ncol) - .2_r8)**3/.27_r8 + 4._r8*o3_tab_dvel(:ncol) + .67_r8 ) ) - ! vel(:ncol) = o3_tab_dvel(:ncol) - ! end if - ! where( abs( zen_angle(:) ) > pid2 ) - ! vel(:) = vel(:) / tmp(:) - ! elsewhere - ! vel(:) = vel(:) * tmp(:) - ! endwhere - - ! else - ! vel(:ncol) = 0._r8 - ! end if - ! if( o3_dd ) then - ! depvel(:ncol,o3_ndx) = vel(:ncol) - ! dflx(:ncol,o3_ndx) = wrk(:ncol) * vel(:ncol) * q(:ncol,plev,o3_ndx) - ! end if - ! !-------------------------------------------------------- - ! ! ... Set stratospheric O3 deposition - ! !-------------------------------------------------------- - ! if( o3s_dd ) then - ! depvel(:ncol,o3s_ndx) = vel(:ncol) - ! dflx(:ncol,o3s_ndx) = wrk(:ncol) * vel(:ncol) * q(:ncol,plev,o3s_ndx) - ! end if - ! if( o3inert_dd ) then - ! depvel(:ncol,o3inert_ndx) = vel(:ncol) - ! dflx(:ncol,o3inert_ndx) = wrk(:ncol) * vel(:ncol) * q(:ncol,plev,o3inert_ndx) - ! end if - ! end if - - ! if( xno2_dd ) then - ! if( map(xno2_ndx) == 0 ) then - ! depvel(:ncol,xno2_ndx) = depvel(:ncol,no2_ndx) - ! dflx(:ncol,xno2_ndx) = wrk(:ncol) * depvel(:ncol,xno2_ndx) * q(:ncol,plev,xno2_ndx) - ! end if - ! endif - ! if( o3a_dd ) then - ! if( map(o3a_ndx) == 0 ) then - ! depvel(:ncol,o3a_ndx) = depvel(:ncol,o3_ndx) - ! dflx(:ncol,o3a_ndx) = wrk(:ncol) * depvel(:ncol,o3a_ndx) * q(:ncol,plev,o3a_ndx) - ! end if - ! endif - ! if( xhno3_dd ) then - ! if( map(xhno3_ndx) == 0 ) then - ! depvel(:ncol,xhno3_ndx) = depvel(:ncol,hno3_ndx) - ! dflx(:ncol,xhno3_ndx) = wrk(:ncol) * depvel(:ncol,xhno3_ndx) * q(:ncol,plev,xhno3_ndx) - ! end if - ! endif - ! if( xnh4no3_dd ) then - ! if( map(xnh4no3_ndx) == 0 ) then - ! depvel(:ncol,xnh4no3_ndx) = depvel(:ncol,nh4no3_ndx) - ! dflx(:ncol,xnh4no3_ndx) = wrk(:ncol) * depvel(:ncol,xnh4no3_ndx) * q(:ncol,plev,xnh4no3_ndx) - ! end if - ! endif - ! if( xpan_dd ) then - ! if( map(xpan_ndx) == 0 ) then - ! depvel(:ncol,xpan_ndx) = depvel(:ncol,pan_ndx) - ! dflx(:ncol,xpan_ndx) = wrk(:ncol) * depvel(:ncol,xpan_ndx) * q(:ncol,plev,xpan_ndx) - ! end if - ! endif - ! if( xmpan_dd ) then - ! if( map(xmpan_ndx) == 0 ) then - ! depvel(:ncol,xmpan_ndx) = depvel(:ncol,mpan_ndx) - ! dflx(:ncol,xmpan_ndx) = wrk(:ncol) * depvel(:ncol,xmpan_ndx) * q(:ncol,plev,xmpan_ndx) - ! end if - ! endif - ! if( xonit_dd ) then - ! if( map(xonit_ndx) == 0 ) then - ! depvel(:ncol,xonit_ndx) = depvel(:ncol,onit_ndx) - ! dflx(:ncol,xonit_ndx) = wrk(:ncol) * depvel(:ncol,xonit_ndx) * q(:ncol,plev,xonit_ndx) - ! end if - ! endif - ! if( xonitr_dd ) then - ! if( map(xonitr_ndx) == 0 ) then - ! depvel(:ncol,xonitr_ndx) = depvel(:ncol,onitr_ndx) - ! dflx(:ncol,xonitr_ndx) = wrk(:ncol) * depvel(:ncol,xonitr_ndx) * q(:ncol,plev,xonitr_ndx) - ! end if - ! endif - ! if( xno_dd ) then - ! if( map(xno_ndx) == 0 ) then - ! depvel(:ncol,xno_ndx) = depvel(:ncol,no_ndx) - ! dflx(:ncol,xno_ndx) = wrk(:ncol) * depvel(:ncol,xno_ndx) * q(:ncol,plev,xno_ndx) - ! end if - ! endif - ! if( xho2no2_dd ) then - ! if( map(xho2no2_ndx) == 0 ) then - ! depvel(:ncol,xho2no2_ndx) = depvel(:ncol,ho2no2_ndx) - ! dflx(:ncol,xho2no2_ndx) = wrk(:ncol) * depvel(:ncol,xho2no2_ndx) * q(:ncol,plev,xho2no2_ndx) - ! end if - ! endif - ! !lke-TS1 - ! if( phenooh_dd ) then - ! if( map(phenooh_ndx) == 0 ) then - ! depvel(:ncol,phenooh_ndx) = depvel(:ncol,ch3ooh_ndx) - ! dflx(:ncol,phenooh_ndx) = wrk(:ncol) * depvel(:ncol,phenooh_ndx) * q(:ncol,plev,phenooh_ndx) - ! end if - ! endif - ! if( benzooh_dd ) then - ! if( map(benzooh_ndx) == 0 ) then - ! depvel(:ncol,benzooh_ndx) = depvel(:ncol,ch3ooh_ndx) - ! dflx(:ncol,benzooh_ndx) = wrk(:ncol) * depvel(:ncol,benzooh_ndx) * q(:ncol,plev,benzooh_ndx) - ! end if - ! endif - ! if( c6h5ooh_dd ) then - ! if( map(c6h5ooh_ndx) == 0 ) then - ! depvel(:ncol,c6h5ooh_ndx) = depvel(:ncol,ch3ooh_ndx) - ! dflx(:ncol,c6h5ooh_ndx) = wrk(:ncol) * depvel(:ncol,c6h5ooh_ndx) * q(:ncol,plev,c6h5ooh_ndx) - ! end if - ! endif - ! if( bzooh_dd ) then - ! if( map(bzooh_ndx) == 0 ) then - ! depvel(:ncol,bzooh_ndx) = depvel(:ncol,ch3ooh_ndx) - ! dflx(:ncol,bzooh_ndx) = wrk(:ncol) * depvel(:ncol,bzooh_ndx) * q(:ncol,plev,bzooh_ndx) - ! end if - ! endif - ! if( xylolooh_dd ) then - ! if( map(xylolooh_ndx) == 0 ) then - ! depvel(:ncol,xylolooh_ndx) = depvel(:ncol,ch3ooh_ndx) - ! dflx(:ncol,xylolooh_ndx) = wrk(:ncol) * depvel(:ncol,xylolooh_ndx) * q(:ncol,plev,xylolooh_ndx) - ! end if - ! endif - ! if( xylenooh_dd ) then - ! if( map(xylenooh_ndx) == 0 ) then - ! depvel(:ncol,xylenooh_ndx) = depvel(:ncol,ch3ooh_ndx) - ! dflx(:ncol,xylenooh_ndx) = wrk(:ncol) * depvel(:ncol,xylenooh_ndx) * q(:ncol,plev,xylenooh_ndx) - ! end if - ! endif - ! if( terpooh_dd ) then - ! if( map(terpooh_ndx) == 0 ) then - ! depvel(:ncol,terpooh_ndx) = depvel(:ncol,isopooh_ndx) - ! dflx(:ncol,terpooh_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,terpooh_ndx) - ! end if - ! end if - ! if( terp2ooh_dd ) then - ! if( map(terp2ooh_ndx) == 0 ) then - ! depvel(:ncol,terp2ooh_ndx) = depvel(:ncol,isopooh_ndx) - ! dflx(:ncol,terp2ooh_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,terp2ooh_ndx) - ! end if - ! end if - ! if( terprod1_dd ) then - ! if( map(terprod1_ndx) == 0 ) then - ! depvel(:ncol,terprod1_ndx) = depvel(:ncol,hyac_ndx) - ! dflx(:ncol,terprod1_ndx) = wrk(:ncol) * depvel(:ncol,terprod1_ndx) * q(:ncol,plev,terprod1_ndx) - ! end if - ! endif - ! if( terprod2_dd ) then - ! if( map(terprod2_ndx) == 0 ) then - ! depvel(:ncol,terprod2_ndx) = depvel(:ncol,hyac_ndx) - ! dflx(:ncol,terprod2_ndx) = wrk(:ncol) * depvel(:ncol,terprod2_ndx) * q(:ncol,plev,terprod2_ndx) - ! end if - ! endif - ! if( hmprop_dd ) then - ! if( map(hmprop_ndx) == 0 ) then - ! depvel(:ncol,hmprop_ndx) = depvel(:ncol,glyald_ndx) - ! dflx(:ncol,hmprop_ndx) = wrk(:ncol) * depvel(:ncol,hmprop_ndx) * q(:ncol,plev,hmprop_ndx) - ! end if - ! endif - ! if( mboooh_dd ) then - ! if( map(mboooh_ndx) == 0 ) then - ! depvel(:ncol,mboooh_ndx) = depvel(:ncol,isopooh_ndx) - ! dflx(:ncol,mboooh_ndx) = wrk(:ncol) * depvel(:ncol,mboooh_ndx) * q(:ncol,plev,mboooh_ndx) - ! end if - ! endif - ! if( hpald_dd ) then - ! if( map(hpald_ndx) == 0 ) then - ! depvel(:ncol,hpald_ndx) = depvel(:ncol,ch3ooh_ndx) - ! dflx(:ncol,hpald_ndx) = wrk(:ncol) * depvel(:ncol,hpald_ndx) * q(:ncol,plev,hpald_ndx) - ! end if - ! endif - ! if( iepox_dd ) then - ! if( map(iepox_ndx) == 0 ) then - ! depvel(:ncol,iepox_ndx) = depvel(:ncol,hyac_ndx) - ! dflx(:ncol,iepox_ndx) = wrk(:ncol) * depvel(:ncol,iepox_ndx) * q(:ncol,plev,iepox_ndx) - ! end if - ! endif - ! if( noa_dd ) then - ! if( map(noa_ndx) == 0 ) then - ! depvel(:ncol,noa_ndx) = depvel(:ncol,h2o2_ndx) - ! dflx(:ncol,noa_ndx) = wrk(:ncol) * depvel(:ncol,noa_ndx) * q(:ncol,plev,noa_ndx) - ! end if - ! endif - ! if( alknit_dd ) then - ! if( map(alknit_ndx) == 0 ) then - ! depvel(:ncol,alknit_ndx) = depvel(:ncol,h2o2_ndx) - ! dflx(:ncol,alknit_ndx) = wrk(:ncol) * depvel(:ncol,alknit_ndx) * q(:ncol,plev,alknit_ndx) - ! end if - ! endif - ! if( isopnita_dd ) then - ! if( map(isopnita_ndx) == 0 ) then - ! depvel(:ncol,isopnita_ndx) = depvel(:ncol,h2o2_ndx) - ! dflx(:ncol,isopnita_ndx) = wrk(:ncol) * depvel(:ncol,isopnita_ndx) * q(:ncol,plev,isopnita_ndx) - ! end if - ! endif - ! if( isopnitb_dd ) then - ! if( map(isopnitb_ndx) == 0 ) then - ! depvel(:ncol,isopnitb_ndx) = depvel(:ncol,h2o2_ndx) - ! dflx(:ncol,isopnitb_ndx) = wrk(:ncol) * depvel(:ncol,isopnitb_ndx) * q(:ncol,plev,isopnitb_ndx) - ! end if - ! endif - ! if( honitr_dd ) then - ! if( map(honitr_ndx) == 0 ) then - ! depvel(:ncol,honitr_ndx) = depvel(:ncol,h2o2_ndx) - ! dflx(:ncol,honitr_ndx) = wrk(:ncol) * depvel(:ncol,honitr_ndx) * q(:ncol,plev,honitr_ndx) - ! end if - ! endif - ! if( isopnooh_dd ) then - ! if( map(isopnooh_ndx) == 0 ) then - ! depvel(:ncol,isopnooh_ndx) = depvel(:ncol,h2o2_ndx) - ! dflx(:ncol,isopnooh_ndx) = wrk(:ncol) * depvel(:ncol,isopnooh_ndx) * q(:ncol,plev,isopnooh_ndx) - ! end if - ! endif - ! if( nc4cho_dd ) then - ! if( map(nc4cho_ndx) == 0 ) then - ! depvel(:ncol,nc4cho_ndx) = depvel(:ncol,h2o2_ndx) - ! dflx(:ncol,nc4cho_ndx) = wrk(:ncol) * depvel(:ncol,nc4cho_ndx) * q(:ncol,plev,nc4cho_ndx) - ! end if - ! endif - ! if( nc4ch2oh_dd ) then - ! if( map(nc4ch2oh_ndx) == 0 ) then - ! depvel(:ncol,nc4ch2oh_ndx) = depvel(:ncol,h2o2_ndx) - ! dflx(:ncol,nc4ch2oh_ndx) = wrk(:ncol) * depvel(:ncol,nc4ch2oh_ndx) * q(:ncol,plev,nc4ch2oh_ndx) - ! end if - ! endif - ! if( terpnit_dd ) then - ! if( map(terpnit_ndx) == 0 ) then - ! depvel(:ncol,terpnit_ndx) = depvel(:ncol,h2o2_ndx) - ! dflx(:ncol,terpnit_ndx) = wrk(:ncol) * depvel(:ncol,terpnit_ndx) * q(:ncol,plev,terpnit_ndx) - ! end if - ! endif - ! if( nterpooh_dd ) then - ! if( map(nterpooh_ndx) == 0 ) then - ! depvel(:ncol,nterpooh_ndx) = depvel(:ncol,h2o2_ndx) - ! dflx(:ncol,nterpooh_ndx) = wrk(:ncol) * depvel(:ncol,nterpooh_ndx) * q(:ncol,plev,nterpooh_ndx) - ! end if - ! endif - - - !end subroutine drydep_table - - !------------------------------------------------------------------------------------- - !------------------------------------------------------------------------------------- - subroutine dvel_inti_xactive( depvel_lnd_file, clim_soilw_file, season_wes_file ) - !------------------------------------------------------------------------------------- - ! ... intialize interactive drydep - !------------------------------------------------------------------------------------- - use dycore, only : dycore_is - use mo_constants, only : r2d - use chem_mods, only : adv_mass - use mo_chem_utls, only : get_spc_ndx ! Replaced, TMMF - use seq_drydep_mod,only : drydep_method, DD_XATM, DD_XLND - use phys_control, only : phys_getopts - - implicit none - - !------------------------------------------------------------------------------------- - ! ... dummy arguments - !------------------------------------------------------------------------------------- - character(len=*), intent(in) :: depvel_lnd_file, clim_soilw_file, season_wes_file - - !------------------------------------------------------------------------------------- - ! ... local variables - !------------------------------------------------------------------------------------- - integer :: i, j, ii, jj, jl, ju - integer :: nlon_veg, nlat_veg, npft_veg - integer :: nlat_lai, npft_lai, pos_min, imin - integer :: dimid - integer :: m, n, l, id - integer :: length1, astat - integer, allocatable :: wk_lai(:,:,:) - integer, allocatable :: index_season_lai_j(:,:) - integer :: k, num_max, k_max - integer :: num_seas(5) - integer :: plon, plat - integer :: ierr, ndx - - real(r8) :: spc_mass - real(r8) :: diff_min, target_lat - real(r8), allocatable :: vegetation_map(:,:,:) - real(r8), pointer :: soilw_map(:,:,:) - real(r8), allocatable :: work(:,:) - real(r8), allocatable :: landmask(:,:) - real(r8), allocatable :: urban(:,:) - real(r8), allocatable :: lake(:,:) - real(r8), allocatable :: wetland(:,:) - real(r8), allocatable :: lon_veg(:) - real(r8), allocatable :: lon_veg_edge(:) - real(r8), allocatable :: lat_veg(:) - real(r8), allocatable :: lat_veg_edge(:) - real(r8), allocatable :: lat_lai(:) - real(r8), allocatable :: clat(:) - character(len=32) :: test_name - character(len=4) :: tag_name - type(file_desc_t) :: piofile - type(var_desc_t) :: vid - logical :: do_soilw - - character(len=shr_kind_cl) :: locfn - logical :: prog_modal_aero - - ! determine if modal aerosols are active so that fraction_landuse array is initialized for modal aerosal dry dep - call phys_getopts(prog_modal_aero_out=prog_modal_aero) - - call dvel_inti_fromlnd() - - if( masterproc ) then - write(iulog,*) 'drydep_inti: following species have dry deposition' - do i=1,nddvels - if( len_trim(drydep_list(i)) > 0 ) then - write(iulog,*) 'drydep_inti: '//trim(drydep_list(i))//' is requested to have dry dep' - endif - enddo - write(iulog,*) 'drydep_inti:' - endif - - !------------------------------------------------------------------------------------- - ! ... get species indices - !------------------------------------------------------------------------------------- - xpan_ndx = get_spc_ndx( 'XPAN' ) - xmpan_ndx = get_spc_ndx( 'XMPAN' ) - o3a_ndx = get_spc_ndx( 'O3A' ) - - ch4_ndx = get_spc_ndx( 'CH4' ) - h2_ndx = get_spc_ndx( 'H2' ) - co_ndx = get_spc_ndx( 'CO' ) - Pb_ndx = get_spc_ndx( 'Pb' ) - pan_ndx = get_spc_ndx( 'PAN' ) - mpan_ndx = get_spc_ndx( 'MPAN' ) - o3_ndx = get_spc_ndx( 'OX' ) - if( o3_ndx < 0 ) then - o3_ndx = get_spc_ndx( 'O3' ) - end if - so2_ndx = get_spc_ndx( 'SO2' ) - alkooh_ndx = get_spc_ndx( 'ALKOOH') - mekooh_ndx = get_spc_ndx( 'MEKOOH') - tolooh_ndx = get_spc_ndx( 'TOLOOH') - terpooh_ndx = get_spc_ndx( 'TERPOOH') - ch3cooh_ndx = get_spc_ndx( 'CH3COOH') - soa_ndx = get_spc_ndx( 'SOA' ) - so4_ndx = get_spc_ndx( 'SO4' ) - cb1_ndx = get_spc_ndx( 'CB1' ) - cb2_ndx = get_spc_ndx( 'CB2' ) - oc1_ndx = get_spc_ndx( 'OC1' ) - oc2_ndx = get_spc_ndx( 'OC2' ) - nh3_ndx = get_spc_ndx( 'NH3' ) - nh4no3_ndx = get_spc_ndx( 'NH4NO3' ) - sa1_ndx = get_spc_ndx( 'SA1' ) - sa2_ndx = get_spc_ndx( 'SA2' ) - sa3_ndx = get_spc_ndx( 'SA3' ) - sa4_ndx = get_spc_ndx( 'SA4' ) - nh4_ndx = get_spc_ndx( 'NH4' ) - alkooh_dd = has_drydep( 'ALKOOH') - mekooh_dd = has_drydep( 'MEKOOH') - tolooh_dd = has_drydep( 'TOLOOH') - terpooh_dd = has_drydep( 'TERPOOH') - ch3cooh_dd = has_drydep( 'CH3COOH') - soa_dd = has_drydep( 'SOA' ) - so4_dd = has_drydep( 'SO4' ) - cb1_dd = has_drydep( 'CB1' ) - cb2_dd = has_drydep( 'CB2' ) - oc1_dd = has_drydep( 'OC1' ) - oc2_dd = has_drydep( 'OC2' ) - nh3_dd = has_drydep( 'NH3' ) - nh4no3_dd = has_drydep( 'NH4NO3' ) - sa1_dd = has_drydep( 'SA1' ) - sa2_dd = has_drydep( 'SA2' ) - sa3_dd = has_drydep( 'SA3' ) - sa4_dd = has_drydep( 'SA4' ) - nh4_dd = has_drydep( 'NH4' ) -! - soam_ndx = get_spc_ndx( 'SOAM' ) - soai_ndx = get_spc_ndx( 'SOAI' ) - soat_ndx = get_spc_ndx( 'SOAT' ) - soab_ndx = get_spc_ndx( 'SOAB' ) - soax_ndx = get_spc_ndx( 'SOAX' ) - sogm_ndx = get_spc_ndx( 'SOGM' ) - sogi_ndx = get_spc_ndx( 'SOGI' ) - sogt_ndx = get_spc_ndx( 'SOGT' ) - sogb_ndx = get_spc_ndx( 'SOGB' ) - sogx_ndx = get_spc_ndx( 'SOGX' ) - soam_dd = has_drydep ( 'SOAM' ) - soai_dd = has_drydep ( 'SOAI' ) - soat_dd = has_drydep ( 'SOAT' ) - soab_dd = has_drydep ( 'SOAB' ) - soax_dd = has_drydep ( 'SOAX' ) - sogm_dd = has_drydep ( 'SOGM' ) - sogi_dd = has_drydep ( 'SOGI' ) - sogt_dd = has_drydep ( 'SOGT' ) - sogb_dd = has_drydep ( 'SOGB' ) - sogx_dd = has_drydep ( 'SOGX' ) -! - hcn_ndx = get_spc_ndx( 'HCN') - ch3cn_ndx = get_spc_ndx( 'CH3CN') - -!lke-TS1 - phenooh_ndx = get_spc_ndx( 'PHENOOH') - benzooh_ndx = get_spc_ndx( 'BENZOOH') - c6h5ooh_ndx = get_spc_ndx( 'C6H5OOH') - bzooh_ndx = get_spc_ndx( 'BZOOH') - xylolooh_ndx = get_spc_ndx( 'XYLOLOOH') - xylenooh_ndx = get_spc_ndx( 'XYLENOOH') - terp2ooh_ndx = get_spc_ndx( 'TERP2OOH') - terprod1_ndx = get_spc_ndx( 'TERPROD1') - terprod2_ndx = get_spc_ndx( 'TERPROD2') - hmprop_ndx = get_spc_ndx( 'HMPROP') - mboooh_ndx = get_spc_ndx( 'MBOOOH') - hpald_ndx = get_spc_ndx( 'HPALD') - iepox_ndx = get_spc_ndx( 'IEPOX') - noa_ndx = get_spc_ndx( 'NOA') - alknit_ndx = get_spc_ndx( 'ALKNIT') - isopnita_ndx = get_spc_ndx( 'ISOPNITA') - isopnitb_ndx = get_spc_ndx( 'ISOPNITB') - honitr_ndx = get_spc_ndx( 'HONITR') - isopnooh_ndx = get_spc_ndx( 'ISOPNOOH') - nc4cho_ndx = get_spc_ndx( 'NC4CHO') - nc4ch2oh_ndx = get_spc_ndx( 'NC4CH2OH') - terpnit_ndx = get_spc_ndx( 'TERPNIT') - nterpooh_ndx = get_spc_ndx( 'NTERPOOH') - phenooh_dd = has_drydep( 'PHENOOH') - benzooh_dd = has_drydep( 'BENZOOH') - c6h5ooh_dd = has_drydep( 'C6H5OOH') - bzooh_dd = has_drydep( 'BZOOH') - xylolooh_dd = has_drydep( 'XYLOLOOH') - xylenooh_dd = has_drydep( 'XYLENOOH') - terp2ooh_dd = has_drydep( 'TERP2OOH') - terprod1_dd = has_drydep( 'TERPROD1') - terprod2_dd = has_drydep( 'TERPROD2') - hmprop_dd = has_drydep( 'HMPROP') - mboooh_dd = has_drydep( 'MBOOOH') - hpald_dd = has_drydep( 'HPALD') - iepox_dd = has_drydep( 'IEPOX') - noa_dd = has_drydep( 'NOA') - alknit_dd = has_drydep( 'ALKNIT') - isopnita_dd = has_drydep( 'ISOPNITA') - isopnitb_dd = has_drydep( 'ISOPNITB') - honitr_dd = has_drydep( 'HONITR') - isopnooh_dd = has_drydep( 'ISOPNOOH') - nc4cho_dd = has_drydep( 'NC4CHO') - nc4ch2oh_dd = has_drydep( 'NC4CH2OH') - terpnit_dd = has_drydep( 'TERPNIT') - nterpooh_dd = has_drydep( 'NTERPOOH') -! - cohc_ndx = get_spc_ndx( 'COhc' ) - come_ndx = get_spc_ndx( 'COme' ) - - tag_cnt=0 - cotag_ndx(:)=-1 - do i = 1,NTAGS - write(tag_name,'(a2,i2.2)') 'CO',i - ndx = get_spc_ndx(tag_name) - if (ndx>0) then - tag_cnt = tag_cnt+1 - cotag_ndx(tag_cnt) = ndx - endif - enddo - - o3s_ndx = get_spc_ndx( 'O3S' ) - - do i=1,nddvels - if ( ( mapping(i) > 0 ) .and. ( drySpc_ndx(i) > 0 ) ) then - m = drySpc_ndx(i) - has_dvel(m) = .true. - map_dvel(m) = i - endif - enddo - - if( all( .not. has_dvel(:) ) ) then - return - end if - - !--------------------------------------------------------------------------- - ! ... allocate module variables - !--------------------------------------------------------------------------- - allocate( dep_ra(pcols,n_land_type,begchunk:endchunk),stat=astat ) - if( astat /= 0 ) then - write(iulog,*) 'dvel_inti: failed to allocate dep_ra; error = ',astat - call endrun - end if - allocate( dep_rb(pcols,n_land_type,begchunk:endchunk),stat=astat ) - if( astat /= 0 ) then - write(iulog,*) 'dvel_inti: failed to allocate dep_rb; error = ',astat - call endrun - end if - - if (drydep_method == DD_XLND .and. (.not.prog_modal_aero)) then - return - endif - - do_soilw = .not. dyn_soilw .and. (has_drydep( 'H2' ) .or. has_drydep( 'CO' )) - allocate( fraction_landuse(pcols,n_land_type, begchunk:endchunk),stat=astat ) - if( astat /= 0 ) then - write(iulog,*) 'dvel_inti: failed to allocate fraction_landuse; error = ',astat - call endrun - end if - if(do_soilw) then - allocate(soilw_3d(pcols,12,begchunk:endchunk),stat=astat) - if( astat /= 0 ) then - write(iulog,*) 'dvel_inti: failed to allocate soilw_3d error = ',astat - call endrun - end if - end if - - plon = get_dyn_grid_parm('plon') - plat = get_dyn_grid_parm('plat') - allocate( index_season_lai_j(n_land_type,12),stat=astat ) - if( astat /= 0 ) then - write(iulog,*) 'dvel_inti: failed to allocate index_season_lai_j; error = ',astat - call endrun - end if - if(dycore_is('UNSTRUCTURED') ) then - call get_landuse_and_soilw_from_file(do_soilw) - allocate( index_season_lai(plon,12),stat=astat ) - if( astat /= 0 ) then - write(iulog,*) 'dvel_inti: failed to allocate index_season_lai; error = ',astat - call endrun - end if - else - allocate( index_season_lai(plat,12),stat=astat ) - if( astat /= 0 ) then - write(iulog,*) 'dvel_inti: failed to allocate index_season_lai; error = ',astat - call endrun - end if - !--------------------------------------------------------------------------- - ! ... read landuse map - !--------------------------------------------------------------------------- - call getfil (depvel_lnd_file, locfn, 0) - call cam_pio_openfile (piofile, trim(locfn), PIO_NOWRITE) - !--------------------------------------------------------------------------- - ! ... get the dimensions - !--------------------------------------------------------------------------- - ierr = pio_inq_dimid( piofile, 'lon', dimid ) - ierr = pio_inq_dimlen( piofile, dimid, nlon_veg ) - ierr = pio_inq_dimid( piofile, 'lat', dimid ) - ierr = pio_inq_dimlen( piofile, dimid, nlat_veg ) - ierr = pio_inq_dimid( piofile, 'pft', dimid ) - ierr = pio_inq_dimlen( piofile, dimid, npft_veg ) - !--------------------------------------------------------------------------- - ! ... allocate arrays - !--------------------------------------------------------------------------- - allocate( vegetation_map(nlon_veg,nlat_veg,npft_veg), work(nlon_veg,nlat_veg), stat=astat ) - if( astat /= 0 ) then - write(iulog,*) 'dvel_inti: failed to allocate vegation_map; error = ',astat - call endrun - end if - allocate( urban(nlon_veg,nlat_veg), lake(nlon_veg,nlat_veg), & - landmask(nlon_veg,nlat_veg), wetland(nlon_veg,nlat_veg), stat=astat ) - if( astat /= 0 ) then - write(iulog,*) 'dvel_inti: failed to allocate vegation_map; error = ',astat - call endrun - end if - allocate( lon_veg(nlon_veg), lat_veg(nlat_veg), & - lon_veg_edge(nlon_veg+1), lat_veg_edge(nlat_veg+1), stat=astat ) - if( astat /= 0 ) then - write(iulog,*) 'dvel_inti: failed to allocate vegation lon, lat arrays; error = ',astat - call endrun - end if - !--------------------------------------------------------------------------- - ! ... read the vegetation map and landmask - !--------------------------------------------------------------------------- - ierr = pio_inq_varid( piofile, 'PCT_PFT', vid ) - ierr = pio_get_var( piofile, vid, vegetation_map ) - - ierr = pio_inq_varid( piofile, 'LANDMASK', vid ) - ierr = pio_get_var( piofile, vid, landmask ) - - ierr = pio_inq_varid( piofile, 'PCT_URBAN', vid ) - ierr = pio_get_var( piofile, vid, urban ) - - ierr = pio_inq_varid( piofile, 'PCT_LAKE', vid ) - ierr = pio_get_var( piofile, vid, lake ) - - ierr = pio_inq_varid( piofile, 'PCT_WETLAND', vid ) - ierr = pio_get_var( piofile, vid, wetland ) - - call cam_pio_closefile( piofile ) - - !--------------------------------------------------------------------------- - ! scale vegetation, urban, lake, and wetland to fraction - !--------------------------------------------------------------------------- - vegetation_map(:,:,:) = .01_r8 * vegetation_map(:,:,:) - wetland(:,:) = .01_r8 * wetland(:,:) - lake(:,:) = .01_r8 * lake(:,:) - urban(:,:) = .01_r8 * urban(:,:) -#ifdef DEBUG - if(masterproc) then - write(iulog,*) 'minmax vegetation_map ',minval(vegetation_map),maxval(vegetation_map) - write(iulog,*) 'minmax wetland ',minval(wetland),maxval(wetland) - write(iulog,*) 'minmax landmask ',minval(landmask),maxval(landmask) - end if -#endif - !--------------------------------------------------------------------------- - ! ... define lat-lon of vegetation map (1x1) - !--------------------------------------------------------------------------- - lat_veg(:) = (/ (-89.5_r8 + (i-1),i=1,nlat_veg ) /) - lon_veg(:) = (/ ( 0.5_r8 + (i-1),i=1,nlon_veg ) /) - lat_veg_edge(:) = (/ (-90.0_r8 + (i-1),i=1,nlat_veg+1) /) - lon_veg_edge(:) = (/ ( 0.0_r8 + (i-1),i=1,nlon_veg+1) /) - !--------------------------------------------------------------------------- - ! ... read soilw table if necessary - !--------------------------------------------------------------------------- - - if( do_soilw ) then - call soilw_inti( clim_soilw_file, nlon_veg, nlat_veg, soilw_map ) - end if - - !--------------------------------------------------------------------------- - ! ... regrid to model grid - !--------------------------------------------------------------------------- - - call interp_map( plon, plat, nlon_veg, nlat_veg, npft_veg, lat_veg, lat_veg_edge, & - lon_veg, lon_veg_edge, landmask, urban, lake, & - wetland, vegetation_map, soilw_map, do_soilw ) - - deallocate( vegetation_map, work, stat=astat ) - deallocate( lon_veg, lat_veg, lon_veg_edge, lat_veg_edge, stat=astat ) - deallocate( landmask, urban, lake, wetland, stat=astat ) - if( do_soilw ) then - deallocate( soilw_map, stat=astat ) - end if - endif ! Unstructured grid - - if (drydep_method == DD_XLND) then - return - endif - - !--------------------------------------------------------------------------- - ! ... read LAI based season indeces - !--------------------------------------------------------------------------- - call getfil (season_wes_file, locfn, 0) - call cam_pio_openfile (piofile, trim(locfn), PIO_NOWRITE) - !--------------------------------------------------------------------------- - ! ... get the dimensions - !--------------------------------------------------------------------------- - ierr = pio_inq_dimid( piofile, 'lat', dimid ) - ierr = pio_inq_dimlen( piofile, dimid, nlat_lai ) - ierr = pio_inq_dimid( piofile, 'pft', dimid ) - ierr = pio_inq_dimlen( piofile, dimid, npft_lai ) - !--------------------------------------------------------------------------- - ! ... allocate arrays - !--------------------------------------------------------------------------- - allocate( lat_lai(nlat_lai), wk_lai(nlat_lai,npft_lai,12), stat=astat ) - if( astat /= 0 ) then - write(iulog,*) 'dvel_inti: failed to allocate vegation_map; error = ',astat - call endrun - end if - !--------------------------------------------------------------------------- - ! ... read the latitude and the season indicies - !--------------------------------------------------------------------------- - ierr = pio_inq_varid( piofile, 'lat', vid ) - ierr = pio_get_var( piofile, vid, lat_lai ) - - ierr = pio_inq_varid( piofile, 'season_wes', vid ) - ierr = pio_get_var( piofile, vid, wk_lai ) - - call cam_pio_closefile( piofile ) - - - if(dycore_is('UNSTRUCTURED') ) then - ! For unstructured grids plon is the 1d horizontal grid size and plat=1 - allocate(clat(plon)) - call get_horiz_grid_d(plon, clat_d_out=clat) - jl = 1 - ju = plon - else - allocate(clat(plat)) - call get_horiz_grid_d(plat, clat_d_out=clat) - jl = 1 - ju = plat - end if - imin = 1 - do j = 1,ju - diff_min = 10._r8 - pos_min = -99 - target_lat = clat(j)*r2d - do i = imin,nlat_lai - if( abs(lat_lai(i) - target_lat) < diff_min ) then - diff_min = abs(lat_lai(i) - target_lat) - pos_min = i - end if - end do - if( pos_min < 0 ) then - write(iulog,*) 'dvel_inti: cannot find ',target_lat,' at j,pos_min,diff_min = ',j,pos_min,diff_min - write(iulog,*) 'dvel_inti: imin,nlat_lai = ',imin,nlat_lai - write(iulog,*) 'dvel_inti: lat_lai' - write(iulog,'(1p,10g12.5)') lat_lai(:) - call endrun - end if - if(dycore_is('UNSTRUCTURED') ) then - imin=1 - else - imin = pos_min - end if - index_season_lai_j(:,:) = wk_lai(pos_min,:,:) - - !--------------------------------------------------------------------------- - ! specify the season as the most frequent in the 11 vegetation classes - ! this was done to remove a banding problem in dvel (JFL Oct 04) - !--------------------------------------------------------------------------- - do m = 1,12 - num_seas = 0 - do l = 1,11 - do k = 1,5 - if( index_season_lai_j(l,m) == k ) then - num_seas(k) = num_seas(k) + 1 - exit - end if - end do - end do - - num_max = -1 - do k = 1,5 - if( num_seas(k) > num_max ) then - num_max = num_seas(k) - k_max = k - endif - end do - - index_season_lai(j,m) = k_max - end do - end do - - deallocate( lat_lai, wk_lai, clat, index_season_lai_j) - - end subroutine dvel_inti_xactive - - subroutine dvel_inti_xactive_landuse( depvel_lnd_file, clim_soilw_file ) - !------------------------------------------------------------------------------------- - ! ... intialize interactive drydep - !------------------------------------------------------------------------------------- - use dycore, only : dycore_is - use mo_constants, only : r2d - use chem_mods, only : adv_mass - use mo_chem_utls, only : get_spc_ndx ! Replaced, TMMF - use seq_drydep_mod,only : drydep_method, DD_XATM, DD_XLND - use phys_control, only : phys_getopts - - implicit none - - !------------------------------------------------------------------------------------- - ! ... dummy arguments - !------------------------------------------------------------------------------------- - character(len=*), intent(in) :: depvel_lnd_file, clim_soilw_file - - !------------------------------------------------------------------------------------- - ! ... local variables - !------------------------------------------------------------------------------------- - integer :: i, j, ii, jj, jl, ju - integer :: nlon_veg, nlat_veg, npft_veg - integer :: nlat_lai, npft_lai, pos_min, imin - integer :: dimid - integer :: m, n, l, id - integer :: length1, astat - integer :: k, num_max, k_max - integer :: num_seas(5) - integer :: plon, plat - integer :: ierr, ndx - - real(r8) :: spc_mass - real(r8) :: diff_min, target_lat - real(r8), allocatable :: vegetation_map(:,:,:) - real(r8), pointer :: soilw_map(:,:,:) - real(r8), allocatable :: work(:,:) - real(r8), allocatable :: landmask(:,:) - real(r8), allocatable :: urban(:,:) - real(r8), allocatable :: lake(:,:) - real(r8), allocatable :: wetland(:,:) - real(r8), allocatable :: lon_veg(:) - real(r8), allocatable :: lon_veg_edge(:) - real(r8), allocatable :: lat_veg(:) - real(r8), allocatable :: lat_veg_edge(:) - character(len=32) :: test_name - character(len=4) :: tag_name - type(file_desc_t) :: piofile - type(var_desc_t) :: vid - logical :: do_soilw - - character(len=shr_kind_cl) :: locfn - logical :: prog_modal_aero - - ! determine if modal aerosols are active so that fraction_landuse array is initialized for modal aerosal dry dep - call phys_getopts(prog_modal_aero_out=prog_modal_aero) - - call dvel_inti_fromlnd() - - !--------------------------------------------------------------------------- - ! ... allocate module variables - !--------------------------------------------------------------------------- - if (drydep_method == DD_XLND .and. (.not.prog_modal_aero)) then - return - endif - - do_soilw = .not. dyn_soilw - allocate( fraction_landuse(pcols,n_land_type, begchunk:endchunk),stat=astat ) - if( astat /= 0 ) then - write(iulog,*) 'dvel_inti: failed to allocate fraction_landuse; error = ',astat - call endrun - end if - if(do_soilw) then - allocate(soilw_3d(pcols,12,begchunk:endchunk),stat=astat) - if( astat /= 0 ) then - write(iulog,*) 'dvel_inti: failed to allocate soilw_3d error = ',astat - call endrun - end if - end if - - plon = get_dyn_grid_parm('plon') - plat = get_dyn_grid_parm('plat') - if(dycore_is('UNSTRUCTURED') ) then - call get_landuse_and_soilw_from_file(do_soilw) - else - !--------------------------------------------------------------------------- - ! ... read landuse map - !--------------------------------------------------------------------------- - call getfil (depvel_lnd_file, locfn, 0) - call cam_pio_openfile (piofile, trim(locfn), PIO_NOWRITE) - !--------------------------------------------------------------------------- - ! ... get the dimensions - !--------------------------------------------------------------------------- - ierr = pio_inq_dimid( piofile, 'lon', dimid ) - ierr = pio_inq_dimlen( piofile, dimid, nlon_veg ) - ierr = pio_inq_dimid( piofile, 'lat', dimid ) - ierr = pio_inq_dimlen( piofile, dimid, nlat_veg ) - ierr = pio_inq_dimid( piofile, 'pft', dimid ) - ierr = pio_inq_dimlen( piofile, dimid, npft_veg ) - !--------------------------------------------------------------------------- - ! ... allocate arrays - !--------------------------------------------------------------------------- - allocate( vegetation_map(nlon_veg,nlat_veg,npft_veg), work(nlon_veg,nlat_veg), stat=astat ) - if( astat /= 0 ) then - write(iulog,*) 'dvel_inti: failed to allocate vegation_map; error = ',astat - call endrun - end if - allocate( urban(nlon_veg,nlat_veg), lake(nlon_veg,nlat_veg), & - landmask(nlon_veg,nlat_veg), wetland(nlon_veg,nlat_veg), stat=astat ) - if( astat /= 0 ) then - write(iulog,*) 'dvel_inti: failed to allocate vegation_map; error = ',astat - call endrun - end if - allocate( lon_veg(nlon_veg), lat_veg(nlat_veg), & - lon_veg_edge(nlon_veg+1), lat_veg_edge(nlat_veg+1), stat=astat ) - if( astat /= 0 ) then - write(iulog,*) 'dvel_inti: failed to allocate vegation lon, lat arrays; error = ',astat - call endrun - end if - !--------------------------------------------------------------------------- - ! ... read the vegetation map and landmask - !--------------------------------------------------------------------------- - ierr = pio_inq_varid( piofile, 'PCT_PFT', vid ) - ierr = pio_get_var( piofile, vid, vegetation_map ) - - ierr = pio_inq_varid( piofile, 'LANDMASK', vid ) - ierr = pio_get_var( piofile, vid, landmask ) - - ierr = pio_inq_varid( piofile, 'PCT_URBAN', vid ) - ierr = pio_get_var( piofile, vid, urban ) - - ierr = pio_inq_varid( piofile, 'PCT_LAKE', vid ) - ierr = pio_get_var( piofile, vid, lake ) - - ierr = pio_inq_varid( piofile, 'PCT_WETLAND', vid ) - ierr = pio_get_var( piofile, vid, wetland ) - - call cam_pio_closefile( piofile ) - - !--------------------------------------------------------------------------- - ! scale vegetation, urban, lake, and wetland to fraction - !--------------------------------------------------------------------------- - vegetation_map(:,:,:) = .01_r8 * vegetation_map(:,:,:) - wetland(:,:) = .01_r8 * wetland(:,:) - lake(:,:) = .01_r8 * lake(:,:) - urban(:,:) = .01_r8 * urban(:,:) -#ifdef DEBUG - if(masterproc) then - write(iulog,*) 'minmax vegetation_map ',minval(vegetation_map),maxval(vegetation_map) - write(iulog,*) 'minmax wetland ',minval(wetland),maxval(wetland) - write(iulog,*) 'minmax landmask ',minval(landmask),maxval(landmask) - end if -#endif - !--------------------------------------------------------------------------- - ! ... define lat-lon of vegetation map (1x1) - !--------------------------------------------------------------------------- - lat_veg(:) = (/ (-89.5_r8 + (i-1),i=1,nlat_veg ) /) - lon_veg(:) = (/ ( 0.5_r8 + (i-1),i=1,nlon_veg ) /) - lat_veg_edge(:) = (/ (-90.0_r8 + (i-1),i=1,nlat_veg+1) /) - lon_veg_edge(:) = (/ ( 0.0_r8 + (i-1),i=1,nlon_veg+1) /) - !--------------------------------------------------------------------------- - ! ... read soilw table if necessary - !--------------------------------------------------------------------------- - - if( do_soilw ) then - call soilw_inti( clim_soilw_file, nlon_veg, nlat_veg, soilw_map ) - end if - - !--------------------------------------------------------------------------- - ! ... regrid to model grid - !--------------------------------------------------------------------------- - - call interp_map( plon, plat, nlon_veg, nlat_veg, npft_veg, lat_veg, lat_veg_edge, & - lon_veg, lon_veg_edge, landmask, urban, lake, & - wetland, vegetation_map, soilw_map, do_soilw ) - - deallocate( vegetation_map, work, stat=astat ) - deallocate( lon_veg, lat_veg, lon_veg_edge, lat_veg_edge, stat=astat ) - deallocate( landmask, urban, lake, wetland, stat=astat ) - if( do_soilw ) then - deallocate( soilw_map, stat=astat ) - end if - endif ! Unstructured grid - - end subroutine dvel_inti_xactive_landuse - - !------------------------------------------------------------------------------------- - subroutine get_landuse_and_soilw_from_file(do_soilw) - use ncdio_atm, only : infld - logical, intent(in) :: do_soilw - logical :: readvar - - type(file_desc_t) :: piofile - character(len=shr_kind_cl) :: locfn - logical :: lexist - - call getfil (drydep_srf_file, locfn, 1, lexist) - if(lexist) then - call cam_pio_openfile(piofile, locfn, PIO_NOWRITE) - - call infld('fraction_landuse', piofile, 'ncol','class',1,pcols,1,n_land_type, begchunk,endchunk, & - fraction_landuse, readvar, gridname='physgrid') - if (.not. readvar) then - write(iulog,*)'**************************************' - write(iulog,*)'get_landuse_and_soilw_from_file: INFO:' - write(iulog,*)' fraction_landuse not read from file: ' - write(iulog,*)' ', trim(locfn) - write(iulog,*)' setting all values to zero' - write(iulog,*)'**************************************' - fraction_landuse = 0._r8 - end if - - if(do_soilw) then - call infld('soilw', piofile, 'ncol','month',1,pcols,1,12, begchunk,endchunk, & - soilw_3d, readvar, gridname='physgrid') - end if - - call cam_pio_closefile(piofile) - else - call endrun('Unstructured grids require drydep_srf_file ') - end if - - - end subroutine get_landuse_and_soilw_from_file - - !------------------------------------------------------------------------------------- - subroutine interp_map( plon, plat, nlon_veg, nlat_veg, npft_veg, lat_veg, lat_veg_edge, & - lon_veg, lon_veg_edge, landmask, urban, lake, & - wetland, vegetation_map, soilw_map, do_soilw ) - - use mo_constants, only : r2d - use scamMod, only : latiop,loniop,scmlat,scmlon,scm_cambfb_mode - use shr_scam_mod , only: shr_scam_getCloseLatLon ! Standardized system subroutines - use cam_initfiles, only: initial_file_get_id - use dycore, only : dycore_is - use phys_grid, only : scatter_field_to_chunk - implicit none - - !------------------------------------------------------------------------------------- - ! ... dummy arguments - !------------------------------------------------------------------------------------- - integer, intent(in) :: plon, plat, nlon_veg, nlat_veg, npft_veg - real(r8), pointer :: soilw_map(:,:,:) - real(r8), intent(in) :: landmask(nlon_veg,nlat_veg) - real(r8), intent(in) :: urban(nlon_veg,nlat_veg) - real(r8), intent(in) :: lake(nlon_veg,nlat_veg) - real(r8), intent(in) :: wetland(nlon_veg,nlat_veg) - real(r8), intent(in) :: vegetation_map(nlon_veg,nlat_veg,npft_veg) - real(r8), intent(in) :: lon_veg(nlon_veg) - real(r8), intent(in) :: lon_veg_edge(nlon_veg+1) - real(r8), intent(in) :: lat_veg(nlat_veg) - real(r8), intent(in) :: lat_veg_edge(nlat_veg+1) - logical, intent(in) :: do_soilw - - !------------------------------------------------------------------------------------- - ! ... local variables - !------------------------------------------------------------------------------------- - real(r8) :: closelat,closelon - integer :: latidx,lonidx - - integer, parameter :: veg_ext = 20 - type(file_desc_t), pointer :: piofile - integer :: i, j, ii, jj, jl, ju, i_ndx, n - integer, dimension(plon+1) :: ind_lon - integer, dimension(plat+1) :: ind_lat - real(r8) :: total_land - real(r8), dimension(plon+1) :: lon_edge - real(r8), dimension(plat+1) :: lat_edge - real(r8) :: lat1, lat2, lon1, lon2 - real(r8) :: x1, x2, y1, y2, dx, dy - real(r8) :: area, total_area - real(r8), dimension(npft_veg+3) :: fraction - real(r8) :: total_soilw_area - real(r8) :: fraction_soilw - real(r8) :: total_soilw(12) - - real(r8), dimension(-veg_ext:nlon_veg+veg_ext) :: lon_veg_edge_ext - integer, dimension(-veg_ext:nlon_veg+veg_ext) :: mapping_ext - - real(r8), allocatable :: lam(:), phi(:), garea(:) - - logical, parameter :: has_npole = .true. - integer :: ploniop,platiop - real(r8) :: tmp_frac_lu(plon,n_land_type,plat), tmp_soilw_3d(plon,12,plat) - - if(dycore_is('UNSTRUCTURED') ) then - ! For unstructured grids plon is the 1d horizontal grid size and plat=1 - allocate(lam(plon), phi(plon)) - call get_horiz_grid_d(plon, clat_d_out=phi) - else - allocate(lam(plon), phi(plat)) - call get_horiz_grid_d(plat, clat_d_out=phi) - endif - call get_horiz_grid_d(plon, clon_d_out=lam) - - - jl = 1 - ju = plon - - if (single_column) then - if (scm_cambfb_mode) then - piofile => initial_file_get_id() - call shr_scam_getCloseLatLon(piofile%fh,scmlat,scmlon,closelat,closelon,latidx,lonidx) - ploniop=size(loniop) - platiop=size(latiop) - else - latidx=1 - lonidx=1 - ploniop=1 - platiop=1 - end if - - lon_edge(1) = loniop(lonidx) * r2d - .5_r8*(loniop(2) - loniop(1)) * r2d - - if (lonidx.lt.ploniop) then - lon_edge(2) = loniop(lonidx+1) * r2d - .5_r8*(loniop(2) - loniop(1)) * r2d - else - lon_edge(2) = lon_edge(1) + (loniop(2) - loniop(1)) * r2d - end if - - lat_edge(1) = latiop(latidx) * r2d - .5_r8*(latiop(2) - latiop(1)) * r2d - - if (latidx.lt.platiop) then - lat_edge(2) = latiop(latidx+1) * r2d - .5_r8*(latiop(2) - latiop(1)) * r2d - else - lat_edge(2) = lat_edge(1) + (latiop(2) - latiop(1)) * r2d - end if - else - do i = 1,plon - lon_edge(i) = lam(i) * r2d - .5_r8*(lam(2) - lam(1)) * r2d - end do - lon_edge(plon+1) = lon_edge(plon) + (lam(2) - lam(1)) * r2d - if( .not. has_npole ) then - do j = 1,plat+1 - lat_edge(j) = phi(j) * r2d - .5_r8*(phi(2) - phi(1)) * r2d - end do - else - do j = 1,plat - lat_edge(j) = phi(j) * r2d - .5_r8*(phi(2) - phi(1)) * r2d - end do - lat_edge(plat+1) = lat_edge(plat) + (phi(2) - phi(1)) * r2d - end if - end if - do j = 1,plat+1 - lat_edge(j) = min( lat_edge(j), 90._r8 ) - lat_edge(j) = max( lat_edge(j),-90._r8 ) - end do - - !------------------------------------------------------------------------------------- - ! wrap around the longitudes - !------------------------------------------------------------------------------------- - do i = -veg_ext,0 - lon_veg_edge_ext(i) = lon_veg_edge(nlon_veg+i) - 360._r8 - mapping_ext (i) = nlon_veg+i - end do - do i = 1,nlon_veg - lon_veg_edge_ext(i) = lon_veg_edge(i) - mapping_ext (i) = i - end do - do i = nlon_veg+1,nlon_veg+veg_ext - lon_veg_edge_ext(i) = lon_veg_edge(i-nlon_veg) + 360._r8 - mapping_ext (i) = i-nlon_veg - end do -#ifdef DEBUG - write(iulog,*) 'interp_map : lon_edge ',lon_edge - write(iulog,*) 'interp_map : lat_edge ',lat_edge - write(iulog,*) 'interp_map : mapping_ext ',mapping_ext -#endif - do j = 1,plon+1 - lon1 = lon_edge(j) - do i = -veg_ext,nlon_veg+veg_ext - dx = lon_veg_edge_ext(i ) - lon1 - dy = lon_veg_edge_ext(i+1) - lon1 - if( dx*dy <= 0._r8 ) then - ind_lon(j) = i - exit - end if - end do - end do - - do j = 1,plat+1 - lat1 = lat_edge(j) - do i = 1,nlat_veg - dx = lat_veg_edge(i ) - lat1 - dy = lat_veg_edge(i+1) - lat1 - if( dx*dy <= 0._r8 ) then - ind_lat(j) = i - exit - end if - end do - end do -#ifdef DEBUG - write(iulog,*) 'interp_map : ind_lon ',ind_lon - write(iulog,*) 'interp_map : ind_lat ',ind_lat -#endif - lat_loop : do j = 1,plat - lon_loop : do i = 1,plon - total_area = 0._r8 - fraction = 0._r8 - total_soilw(:) = 0._r8 - total_soilw_area = 0._r8 - do jj = ind_lat(j),ind_lat(j+1) - y1 = max( lat_edge(j),lat_veg_edge(jj) ) - y2 = min( lat_edge(j+1),lat_veg_edge(jj+1) ) - dy = (y2 - y1)/(lat_veg_edge(jj+1) - lat_veg_edge(jj)) - do ii =ind_lon(i),ind_lon(i+1) - i_ndx = mapping_ext(ii) - x1 = max( lon_edge(i),lon_veg_edge_ext(ii) ) - x2 = min( lon_edge(i+1),lon_veg_edge_ext(ii+1) ) - dx = (x2 - x1)/(lon_veg_edge_ext(ii+1) - lon_veg_edge_ext(ii)) - area = dx * dy - total_area = total_area + area - !----------------------------------------------------------------- - ! ... special case for ocean grid point - !----------------------------------------------------------------- - if( nint(landmask(i_ndx,jj)) == 0 ) then - fraction(npft_veg+1) = fraction(npft_veg+1) + area - else - do n = 1,npft_veg - fraction(n) = fraction(n) + vegetation_map(i_ndx,jj,n) * area - end do - fraction(npft_veg+1) = fraction(npft_veg+1) + area * lake (i_ndx,jj) - fraction(npft_veg+2) = fraction(npft_veg+2) + area * wetland(i_ndx,jj) - fraction(npft_veg+3) = fraction(npft_veg+3) + area * urban (i_ndx,jj) - !----------------------------------------------------------------- - ! ... check if land accounts for the whole area. - ! If not, the remaining area is in the ocean - !----------------------------------------------------------------- - total_land = sum(vegetation_map(i_ndx,jj,:)) & - + urban (i_ndx,jj) & - + lake (i_ndx,jj) & - + wetland(i_ndx,jj) - if( total_land < 1._r8 ) then - fraction(npft_veg+1) = fraction(npft_veg+1) + (1._r8 - total_land) * area - end if - !------------------------------------------------------------------------------------- - ! ... compute weighted average of soilw over grid (non-water only) - !------------------------------------------------------------------------------------- - if( do_soilw ) then - fraction_soilw = total_land - (lake(i_ndx,jj) + wetland(i_ndx,jj)) - total_soilw_area = total_soilw_area + fraction_soilw * area - total_soilw(:) = total_soilw(:) + fraction_soilw * area * soilw_map(i_ndx,jj,:) - end if - end if - end do - end do - !------------------------------------------------------------------------------------- - ! ... divide by total area of grid box - !------------------------------------------------------------------------------------- - fraction(:) = fraction(:)/total_area - !------------------------------------------------------------------------------------- - ! ... make sure we don't have too much or too little - !------------------------------------------------------------------------------------- - if( abs( sum(fraction) - 1._r8) > .001_r8 ) then - fraction(:) = fraction(:)/sum(fraction) - end if - !------------------------------------------------------------------------------------- - ! ... map to Wesely land classification - !------------------------------------------------------------------------------------- - - - - - tmp_frac_lu(i, 1, j) = fraction(20) ! Urban - tmp_frac_lu(i, 2, j) = sum(fraction(16:17)) ! - tmp_frac_lu(i, 3, j) = sum(fraction(13:15)) ! - tmp_frac_lu(i, 4, j) = sum(fraction( 5: 9)) ! - tmp_frac_lu(i, 5, j) = sum(fraction( 2: 4)) ! - tmp_frac_lu(i, 6, j) = fraction(19) ! Wetland - tmp_frac_lu(i, 7, j) = fraction(18) ! Lake - tmp_frac_lu(i, 8, j) = fraction( 1) ! - tmp_frac_lu(i, 9, j) = 0._r8 - tmp_frac_lu(i,10, j) = 0._r8 - tmp_frac_lu(i,11, j) = sum(fraction(10:12)) ! - if( do_soilw ) then - if( total_soilw_area > 0._r8 ) then - tmp_soilw_3d(i,:,j) = total_soilw(:)/total_soilw_area - else - tmp_soilw_3d(i,:,j) = -99._r8 - end if - end if - end do lon_loop - end do lat_loop - !------------------------------------------------------------------------------------- - ! ... reshape according to lat-lon blocks - !------------------------------------------------------------------------------------- - call scatter_field_to_chunk(1,n_land_type,1,plon,tmp_frac_lu,fraction_landuse) - if(do_soilw) call scatter_field_to_chunk(1,12,1,plon,tmp_soilw_3d,soilw_3d) - !------------------------------------------------------------------------------------- - ! ... make sure there are no out of range values - !------------------------------------------------------------------------------------- - where (fraction_landuse < 0._r8) fraction_landuse = 0._r8 - where (fraction_landuse > 1._r8) fraction_landuse = 1._r8 - - end subroutine interp_map - - !------------------------------------------------------------------------------------- - !------------------------------------------------------------------------------------- - subroutine drydep_xactive( ncdate, sfc_temp, pressure_sfc, & - wind_speed, spec_hum, air_temp, pressure_10m, rain, & - snow, solar_flux, dvel, dflx, State_Chm, & - tv, soilw, rh, ncol, lonndx, latndx, lchnk, & - ocnfrc, icefrc, beglandtype, endlandtype ) - !------------------------------------------------------------------------------------- - ! code based on wesely (atmospheric environment, 1989, vol 23, p. 1293-1304) for - ! calculation of r_c, and on walcek et. al. (atmospheric enviroment, 1986, - ! vol. 20, p. 949-964) for calculation of r_a and r_b - ! - ! as suggested in walcek (u_i)(u*_i) = (u_a)(u*_a) - ! is kept constant where i represents a subgrid environment and a the - ! grid average environment. thus the calculation proceeds as follows: - ! va the grid averaged wind is calculated on dots - ! z0(i) the grid averaged roughness coefficient is calculated - ! ri(i) the grid averaged richardson number is calculated - ! --> the grid averaged (u_a)(u*_a) is calculated - ! --> subgrid scale u*_i is calculated assuming (u_i) given as above - ! --> final deposotion velocity is weighted average of subgrid scale velocities - ! - ! code written by P. Hess, rewritten in fortran 90 by JFL (August 2000) - ! modified by JFL to be used in MOZART-2 (October 2002) - !------------------------------------------------------------------------------------- - - use seq_drydep_mod, only: z0, rgso, rgss, h2_a, h2_b, h2_c, ri, rclo, rcls, rlu, rac - use seq_drydep_mod, only: seq_drydep_setHCoeff, foxd, drat - use physconst, only: tmelt - use seq_drydep_mod, only: drydep_method, DD_XLND - - implicit none - - !------------------------------------------------------------------------------------- - ! ... dummy arguments - !------------------------------------------------------------------------------------- - integer, intent(in) :: ncol - integer, intent(in) :: ncdate ! present date (yyyymmdd) - real(r8), intent(in) :: sfc_temp(pcols) ! surface temperature (K) - real(r8), intent(in) :: pressure_sfc(pcols) ! surface pressure (Pa) - real(r8), intent(in) :: wind_speed(pcols) ! 10 meter wind speed (m/s) - real(r8), intent(in) :: spec_hum(pcols) ! specific humidity (kg/kg) - real(r8), intent(in) :: rh(ncol,1) ! relative humidity - real(r8), intent(in) :: air_temp(pcols) ! surface air temperature (K) - real(r8), intent(in) :: pressure_10m(pcols) ! 10 meter pressure (Pa) - real(r8), intent(in) :: rain(pcols) - real(r8), intent(in) :: snow(pcols) ! snow height (m) - real(r8), intent(in) :: soilw(pcols) ! soil moisture fraction - real(r8), intent(in) :: solar_flux(pcols) ! direct shortwave radiation at surface (W/m^2) - real(r8), intent(in) :: tv(pcols) ! potential temperature - type(ChmState), intent(in):: State_Chm ! GEOS-Chem State Chem - real(r8), intent(out) :: dvel(ncol,nTracersMax) ! deposition velocity (cm/s) - real(r8), intent(inout) :: dflx(pcols,nTracersMax) ! deposition flux (/cm^2/s) - - integer, intent(in) :: latndx(pcols) ! chunk latitude indicies - integer, intent(in) :: lonndx(pcols) ! chunk longitude indicies - integer, intent(in) :: lchnk ! chunk number - - integer, intent(in), optional :: beglandtype - integer, intent(in), optional :: endlandtype - - real(r8), intent(in), optional :: ocnfrc(pcols) - real(r8), intent(in), optional :: icefrc(pcols) - - !------------------------------------------------------------------------------------- - ! ... local variables - !------------------------------------------------------------------------------------- - real(r8), parameter :: scaling_to_cm_per_s = 100._r8 - real(r8), parameter :: rain_threshold = 1.e-7_r8 ! of the order of 1cm/day expressed in m/s - - integer :: i, ispec, lt, m - integer :: sndx - integer :: month - - real(r8) :: slope = 0._r8 - real(r8) :: z0water ! revised z0 over water - real(r8) :: p ! pressure at midpoint first layer - real(r8) :: pg ! surface pressure - real(r8) :: es ! saturation vapor pressure - real(r8) :: ws ! saturation mixing ratio - real(r8) :: hvar ! constant to compute xmol - real(r8) :: h ! constant to compute xmol - real(r8) :: psih ! stability correction factor - real(r8) :: rs ! constant for calculating rsmx - real(r8) :: rmx ! resistance by vegetation - real(r8) :: zovl ! ratio of z to m-o length - real(r8) :: cvarb ! cvar averaged over landtypes - real(r8) :: bb ! b averaged over landtypes - real(r8) :: ustarb ! ustar averaged over landtypes - real(r8) :: tc(ncol) ! temperature in celsius - real(r8) :: cts(ncol) ! correction to rlu rcl and rgs for frost - - !------------------------------------------------------------------------------------- - ! local arrays: dependent on location and species - !------------------------------------------------------------------------------------- - real(r8), dimension(ncol,nddvels) :: heff - - !------------------------------------------------------------------------------------- - ! local arrays: dependent on location only - !------------------------------------------------------------------------------------- - integer :: index_season(ncol,n_land_type) - real(r8), dimension(ncol) :: tha ! atmospheric virtual potential temperature - real(r8), dimension(ncol) :: thg ! ground virtual potential temperature - real(r8), dimension(ncol) :: z ! height of lowest level - real(r8), dimension(ncol) :: va ! magnitude of v on cross points - real(r8), dimension(ncol) :: ribn ! richardson number - real(r8), dimension(ncol) :: qs ! saturation specific humidity - real(r8), dimension(ncol) :: crs ! multiplier to calculate crs - real(r8), dimension(ncol) :: rdc ! part of lower canopy resistance - real(r8), dimension(ncol) :: uustar ! u*ustar (assumed constant over grid) - real(r8), dimension(ncol) :: z0b ! average roughness length over grid - real(r8), dimension(ncol) :: wrk ! work array - real(r8), dimension(ncol) :: term ! work array - real(r8), dimension(ncol) :: resc ! work array - real(r8), dimension(ncol) :: lnd_frc ! work array - logical, dimension(ncol) :: unstable - logical, dimension(ncol) :: has_rain - logical, dimension(ncol) :: has_dew - - !------------------------------------------------------------------------------------- - ! local arrays: dependent on location and landtype - !------------------------------------------------------------------------------------- - real(r8), dimension(ncol,n_land_type) :: rds ! resistance for deposition of sulfate - real(r8), dimension(ncol,n_land_type) :: b ! buoyancy parameter for unstable conditions - real(r8), dimension(ncol,n_land_type) :: cvar ! height parameter - real(r8), dimension(ncol,n_land_type) :: ustar ! friction velocity - real(r8), dimension(ncol,n_land_type) :: xmol ! monin-obukhov length - - !------------------------------------------------------------------------------------- - ! local arrays: dependent on location, landtype and species - !------------------------------------------------------------------------------------- - real(r8), dimension(ncol,n_land_type,nTracersMax) :: rsmx ! vegetative resistance (plant mesophyll) - real(r8), dimension(ncol,n_land_type,nTracersMax) :: rclx ! lower canopy resistance - real(r8), dimension(ncol,n_land_type,nTracersMax) :: rlux ! vegetative resistance (upper canopy) - real(r8), dimension(ncol,n_land_type) :: rlux_o3 ! vegetative resistance (upper canopy) - real(r8), dimension(ncol,n_land_type,nTracersMax) :: rgsx ! ground resistance - real(r8) :: pmid(ncol,1) ! for seasalt aerosols - real(r8) :: tfld(ncol,1) ! for seasalt aerosols - real(r8) :: fact, vds - real(r8) :: rc ! combined surface resistance - real(r8) :: var_soilw, dv_soil_h2, fact_h2 ! h2 dvel wrking variables - logical :: fr_lnduse(ncol,n_land_type) ! wrking array - real(r8) :: dewm ! multiplier for rs when dew occurs - - real(r8) :: lcl_frc_landuse(ncol,n_land_type) - - integer :: beglt, endlt - - !------------------------------------------------------------------------------------- - ! jfl : mods for PAN - !------------------------------------------------------------------------------------- - real(r8) :: dv_pan - real(r8) :: c0_pan(11) = (/ 0.000_r8, 0.006_r8, 0.002_r8, 0.009_r8, 0.015_r8, & - 0.006_r8, 0.000_r8, 0.000_r8, 0.000_r8, 0.002_r8, 0.002_r8 /) - real(r8) :: k_pan (11) = (/ 0.000_r8, 0.010_r8, 0.005_r8, 0.004_r8, 0.003_r8, & - 0.005_r8, 0.000_r8, 0.000_r8, 0.000_r8, 0.075_r8, 0.002_r8 /) - - if (present( beglandtype)) then - beglt = beglandtype - else - beglt = 1 - endif - if (present( endlandtype)) then - endlt = endlandtype - else - endlt = n_land_type - endif - - !------------------------------------------------------------------------------------- - ! initialize - !------------------------------------------------------------------------------------- - do m = 1,nTracersMax - dvel(:,m) = 0._r8 - end do - - if( all( .not. has_dvel(:) ) ) then - return - end if - - !------------------------------------------------------------------------------------- - ! define species-dependent parameters (temperature dependent) - !------------------------------------------------------------------------------------- - call seq_drydep_setHCoeff( ncol, sfc_temp, heff ) - - do lt = 1,n_land_type - dep_ra (:,lt,lchnk) = 0._r8 - dep_rb (:,lt,lchnk) = 0._r8 - rds(:,lt) = 0._r8 - end do - - !------------------------------------------------------------------------------------- - ! ... set month - !------------------------------------------------------------------------------------- - month = mod( ncdate,10000 )/100 - - !------------------------------------------------------------------------------------- - ! define which season (relative to Northern hemisphere climate) - !------------------------------------------------------------------------------------- - - !------------------------------------------------------------------------------------- - ! define season index based on fixed LAI - !------------------------------------------------------------------------------------- - if ( drydep_method == DD_XLND ) then - index_season = 4 - else - do i = 1,ncol - index_season(i,:) = index_season_lai(latndx(i),month) - end do - endif - !------------------------------------------------------------------------------------- - ! special case for snow covered terrain - !------------------------------------------------------------------------------------- - do i = 1,ncol - if( snow(i) > .01_r8 ) then - index_season(i,:) = 4 - end if - end do - !------------------------------------------------------------------------------------- - ! scale rain and define logical arrays - !------------------------------------------------------------------------------------- - has_rain(:ncol) = rain(:ncol) > rain_threshold - - !------------------------------------------------------------------------------------- - ! loop over longitude points - !------------------------------------------------------------------------------------- - col_loop : do i = 1,ncol - p = pressure_10m(i) - pg = pressure_sfc(i) - !------------------------------------------------------------------------------------- - ! potential temperature - !------------------------------------------------------------------------------------- - tha(i) = air_temp(i) * (p00/p )**rovcp * (1._r8 + .61_r8*spec_hum(i)) - thg(i) = sfc_temp(i) * (p00/pg)**rovcp * (1._r8 + .61_r8*spec_hum(i)) - !------------------------------------------------------------------------------------- - ! height of 1st level - !------------------------------------------------------------------------------------- - z(i) = - r/grav * air_temp(i) * (1._r8 + .61_r8*spec_hum(i)) * log(p/pg) - !------------------------------------------------------------------------------------- - ! wind speed - !------------------------------------------------------------------------------------- - va(i) = max( .01_r8,wind_speed(i) ) - !------------------------------------------------------------------------------------- - ! Richardson number - !------------------------------------------------------------------------------------- - ribn(i) = z(i) * grav * (tha(i) - thg(i))/thg(i) / (va(i)*va(i)) - ribn(i) = min( ribn(i),ric ) - unstable(i) = ribn(i) < 0._r8 - !------------------------------------------------------------------------------------- - ! saturation vapor pressure (Pascals) - ! saturation mixing ratio - ! saturation specific humidity - !------------------------------------------------------------------------------------- - es = 611._r8*exp( 5414.77_r8*(sfc_temp(i) - tmelt)/(tmelt*sfc_temp(i)) ) - ws = .622_r8*es/(pg - es) - qs(i) = ws/(1._r8 + ws) - has_dew(i) = .false. - if( qs(i) <= spec_hum(i) ) then - has_dew(i) = .true. - end if - if( sfc_temp(i) < tmelt ) then - has_dew(i) = .false. - end if - !------------------------------------------------------------------------------------- - ! constant in determining rs - !------------------------------------------------------------------------------------- - tc(i) = sfc_temp(i) - tmelt - if( sfc_temp(i) > tmelt .and. sfc_temp(i) < 313.15_r8 ) then - crs(i) = (1._r8 + (200._r8/(solar_flux(i) + .1_r8))**2) * (400._r8/(tc(i)*(40._r8 - tc(i)))) - else - crs(i) = large_value - end if - !------------------------------------------------------------------------------------- - ! rdc (lower canopy res) - !------------------------------------------------------------------------------------- - rdc(i) = 100._r8*(1._r8 + 1000._r8/(solar_flux(i) + 10._r8))/(1._r8 + 1000._r8*slope) - end do col_loop - - !------------------------------------------------------------------------------------- - ! ... form working arrays - !------------------------------------------------------------------------------------- - do lt = 1,n_land_type - do i=1,ncol - if ( drydep_method == DD_XLND ) then - lcl_frc_landuse(i,lt) = 0._r8 - else - lcl_frc_landuse(i,lt) = fraction_landuse(i,lt,lchnk) - endif - enddo - end do - if ( present(ocnfrc) .and. present(icefrc) ) then - do i=1,ncol - ! land type 7 is used for ocean - ! land type 8 is used for sea ice - lcl_frc_landuse(i,7) = ocnfrc(i) - lcl_frc_landuse(i,8) = icefrc(i) - enddo - endif - do lt = 1,n_land_type - do i=1,ncol - fr_lnduse(i,lt) = lcl_frc_landuse(i,lt) > 0._r8 - enddo - end do - - !------------------------------------------------------------------------------------- - ! find grid averaged z0: z0bar (the roughness length) z_o=exp[S(f_i*ln(z_oi))] - ! this is calculated so as to find u_i, assuming u*u=u_i*u_i - !------------------------------------------------------------------------------------- - z0b(:) = 0._r8 - do lt = 1,n_land_type - do i = 1,ncol - if( fr_lnduse(i,lt) ) then - z0b(i) = z0b(i) + lcl_frc_landuse(i,lt) * log( z0(index_season(i,lt),lt) ) - end if - end do - end do - - !------------------------------------------------------------------------------------- - ! find the constant velocity uu*=(u_i)(u*_i) - !------------------------------------------------------------------------------------- - do i = 1,ncol - z0b(i) = exp( z0b(i) ) - cvarb = vonkar/log( z(i)/z0b(i) ) - !------------------------------------------------------------------------------------- - ! unstable and stable cases - !------------------------------------------------------------------------------------- - if( unstable(i) ) then - bb = 9.4_r8*(cvarb**2)*sqrt( abs(ribn(i))*z(i)/z0b(i) ) - ustarb = cvarb * va(i) * sqrt( 1._r8 - (9.4_r8*ribn(i)/(1._r8 + 7.4_r8*bb)) ) - else - ustarb = cvarb * va(i)/(1._r8 + 4.7_r8*ribn(i)) - end if - uustar(i) = va(i)*ustarb - end do - - !------------------------------------------------------------------------------------- - ! calculate the friction velocity for each land type u_i=uustar/u*_i - !------------------------------------------------------------------------------------- - do lt = beglt,endlt - do i = 1,ncol - if( fr_lnduse(i,lt) ) then - if( unstable(i) ) then - cvar(i,lt) = vonkar/log( z(i)/z0(index_season(i,lt),lt) ) - b(i,lt) = 9.4_r8*(cvar(i,lt)**2)* sqrt( abs(ribn(i))*z(i)/z0(index_season(i,lt),lt) ) - ustar(i,lt) = sqrt( cvar(i,lt)*uustar(i)*sqrt( 1._r8 - (9.4_r8*ribn(i)/(1._r8 + 7.4_r8*b(i,lt))) ) ) - else - cvar(i,lt) = vonkar/log( z(i)/z0(index_season(i,lt),lt) ) - ustar(i,lt) = sqrt( cvar(i,lt)*uustar(i)/(1._r8 + 4.7_r8*ribn(i)) ) - end if - end if - end do - end do - - !------------------------------------------------------------------------------------- - ! revise calculation of friction velocity and z0 over water - !------------------------------------------------------------------------------------- - lt = 7 - do i = 1,ncol - if( fr_lnduse(i,lt) ) then - if( unstable(i) ) then - z0water = (.016_r8*(ustar(i,lt)**2)/grav) + diffk/(9.1_r8*ustar(i,lt)) - cvar(i,lt) = vonkar/(log( z(i)/z0water )) - b(i,lt) = 9.4_r8*(cvar(i,lt)**2)*sqrt( abs(ribn(i))*z(i)/z0water ) - ustar(i,lt) = sqrt( cvar(i,lt)*uustar(i)* sqrt( 1._r8 - (9.4_r8*ribn(i)/(1._r8+ 7.4_r8*b(i,lt))) ) ) - else - z0water = (.016_r8*(ustar(i,lt)**2)/grav) + diffk/(9.1_r8*ustar(i,lt)) - cvar(i,lt) = vonkar/(log(z(i)/z0water)) - ustar(i,lt) = sqrt( cvar(i,lt)*uustar(i)/(1._r8 + 4.7_r8*ribn(i)) ) - end if - end if - end do - - !------------------------------------------------------------------------------------- - ! compute monin-obukhov length for unstable and stable conditions/ sublayer resistance - !------------------------------------------------------------------------------------- - do lt = beglt,endlt - do i = 1,ncol - if( fr_lnduse(i,lt) ) then - hvar = (va(i)/0.74_r8) * (tha(i) - thg(i)) * (cvar(i,lt)**2) - if( unstable(i) ) then ! unstable - h = hvar*(1._r8 - (9.4_r8*ribn(i)/(1._r8 + 5.3_r8*b(i,lt)))) - else - h = hvar/((1._r8+4.7_r8*ribn(i))**2) - end if - xmol(i,lt) = thg(i) * ustar(i,lt) * ustar(i,lt) / (vonkar * grav * h) - end if - end do - end do - - !------------------------------------------------------------------------------------- - ! psih - !------------------------------------------------------------------------------------- - do lt = beglt,endlt - do i = 1,ncol - if( fr_lnduse(i,lt) ) then - if( xmol(i,lt) < 0._r8 ) then - zovl = z(i)/xmol(i,lt) - zovl = max( -1._r8,zovl ) - psih = exp( .598_r8 + .39_r8*log( -zovl ) - .09_r8*(log( -zovl ))**2 ) - vds = 2.e-3_r8*ustar(i,lt) * (1._r8 + (300/(-xmol(i,lt)))**0.666_r8) - else - zovl = z(i)/xmol(i,lt) - zovl = min( 1._r8,zovl ) - psih = -5._r8 * zovl - vds = 2.e-3_r8*ustar(i,lt) - end if - dep_ra (i,lt,lchnk) = (vonkar - psih*cvar(i,lt))/(ustar(i,lt)*vonkar*cvar(i,lt)) - dep_rb (i,lt,lchnk) = (2._r8/(vonkar*ustar(i,lt))) * crb - rds(i,lt) = 1._r8/vds - end if - end do - end do - - !------------------------------------------------------------------------------------- - ! surface resistance : depends on both land type and species - ! land types are computed seperately, then resistance is computed as average of values - ! following wesely rc=(1/(rs+rm) + 1/rlu +1/(rdc+rcl) + 1/(rac+rgs))**-1 - ! - ! compute rsmx = 1/(rs+rm) : multiply by 3 if surface is wet - !------------------------------------------------------------------------------------- - species_loop1 : do ispec = 1,nTracersMax - if( has_dvel(ispec) ) then - m = map_dvel(ispec) - do lt = beglt,endlt - do i = 1,ncol - if( fr_lnduse(i,lt) ) then - sndx = index_season(i,lt) - if( ispec == o3_ndx .or. ispec == o3a_ndx .or. ispec == so2_ndx ) then - rmx = 0._r8 - else - rmx = 1._r8/(heff(i,m)/3000._r8 + 100._r8*foxd(m)) - end if - cts(i) = 1000._r8*exp( - tc(i) - 4._r8 ) ! correction for frost - rgsx(i,lt,ispec) = cts(i) + 1._r8/((heff(i,m)/(1.e5_r8*rgss(sndx,lt))) + (foxd(m)/rgso(sndx,lt))) - !------------------------------------------------------------------------------------- - ! special case for H2 and CO;; CH4 is set ot a fraction of dv(H2) - !------------------------------------------------------------------------------------- - if( ispec == h2_ndx .or. ispec == co_ndx .or. ispec == ch4_ndx ) then - if( ispec == co_ndx ) then - fact_h2 = 1.0_r8 - elseif ( ispec == h2_ndx ) then - fact_h2 = 0.5_r8 - elseif ( ispec == ch4_ndx ) then - fact_h2 = 50.0_r8 - end if - !------------------------------------------------------------------------------------- - ! no deposition on snow, ice, desert, and water - !------------------------------------------------------------------------------------- - if( lt == 1 .or. lt == 7 .or. lt == 8 .or. sndx == 4 ) then - rgsx(i,lt,ispec) = large_value - else - var_soilw = max( .1_r8,min( soilw(i),.3_r8 ) ) - if( lt == 3 ) then - var_soilw = log( var_soilw ) - end if - dv_soil_h2 = h2_c(lt) + var_soilw*(h2_b(lt) + var_soilw*h2_a(lt)) - if( dv_soil_h2 > 0._r8 ) then - rgsx(i,lt,ispec) = fact_h2/(dv_soil_h2*1.e-4_r8) - end if - end if - end if - if( lt == 7 ) then - rclx(i,lt,ispec) = large_value - rsmx(i,lt,ispec) = large_value - rlux(i,lt,ispec) = large_value - else - rs = ri(sndx,lt)*crs(i) - if ( has_dew(i) .or. has_rain(i) ) then - dewm = 3._r8 - else - dewm = 1._r8 - end if - rsmx(i,lt,ispec) = (dewm*rs*drat(m) + rmx) - !------------------------------------------------------------------------------------- - ! jfl : special case for PAN - !------------------------------------------------------------------------------------- - if( ispec == pan_ndx .or. ispec == xpan_ndx ) then - dv_pan = c0_pan(lt) * (1._r8 - exp( -k_pan(lt)*(dewm*rs*drat(m))*1.e-2_r8 )) - if( dv_pan > 0._r8 .and. sndx /= 4 ) then - rsmx(i,lt,ispec) = ( 1._r8/dv_pan ) - end if - end if - rclx(i,lt,ispec) = cts(i) + 1._r8/((heff(i,m)/(1.e5_r8*rcls(sndx,lt))) + (foxd(m)/rclo(sndx,lt))) - rlux(i,lt,ispec) = cts(i) + rlu(sndx,lt)/(1.e-5_r8*heff(i,m) + foxd(m)) - end if - end if - end do - end do - end if - end do species_loop1 - - do lt = beglt,endlt - if( lt /= 7 ) then - do i = 1,ncol - if( fr_lnduse(i,lt) ) then - sndx = index_season(i,lt) - !------------------------------------------------------------------------------------- - ! ... no effect if sfc_temp < O C - !------------------------------------------------------------------------------------- - if( sfc_temp(i) > tmelt ) then - if( has_dew(i) ) then - rlux_o3(i,lt) = 3000._r8*rlu(sndx,lt)/(1000._r8 + rlu(sndx,lt)) - if( o3_ndx > 0 ) then - rlux(i,lt,o3_ndx) = rlux_o3(i,lt) - endif - if( o3a_ndx > 0 ) then - rlux(i,lt,o3a_ndx) = rlux_o3(i,lt) - endif - end if - if( has_rain(i) ) then - ! rlux(i,lt,o3_ndx) = 1./(1.e-3 + (1./(3.*rlu(sndx,lt)))) - rlux_o3(i,lt) = 3000._r8*rlu(sndx,lt)/(1000._r8 + 3._r8*rlu(sndx,lt)) - if( o3_ndx > 0 ) then - rlux(i,lt,o3_ndx) = rlux_o3(i,lt) - endif - if( o3a_ndx > 0 ) then - rlux(i,lt,o3a_ndx) = rlux_o3(i,lt) - endif - end if - end if - - if ( o3_ndx > 0 ) then - rclx(i,lt,o3_ndx) = cts(i) + rclo(index_season(i,lt),lt) - rlux(i,lt,o3_ndx) = cts(i) + rlux(i,lt,o3_ndx) - end if - if ( o3a_ndx > 0 ) then - rclx(i,lt,o3a_ndx) = cts(i) + rclo(index_season(i,lt),lt) - rlux(i,lt,o3a_ndx) = cts(i) + rlux(i,lt,o3a_ndx) - end if - - end if - end do - end if - end do - - species_loop2 : do ispec = 1,nTracersMax - m = map_dvel(ispec) - if( has_dvel(ispec) ) then - if( ispec /= o3_ndx .and. ispec /= o3a_ndx .and. ispec /= so2_ndx ) then - do lt = beglt,endlt - if( lt /= 7 ) then - do i = 1,ncol - if( fr_lnduse(i,lt) ) then - !------------------------------------------------------------------------------------- - ! no effect if sfc_temp < O C - !------------------------------------------------------------------------------------- - if( sfc_temp(i) > tmelt ) then - if( has_dew(i) ) then - rlux(i,lt,ispec) = 1._r8/((1._r8/(3._r8*rlux(i,lt,ispec))) & - + 1.e-7_r8*heff(i,m) + foxd(m)/rlux_o3(i,lt)) - end if - end if - - end if - end do - end if - end do - else if( ispec == so2_ndx ) then - do lt = beglt,endlt - if( lt /= 7 ) then - do i = 1,ncol - if( fr_lnduse(i,lt) ) then - !------------------------------------------------------------------------------------- - ! no effect if sfc_temp < O C - !------------------------------------------------------------------------------------- - if( sfc_temp(i) > tmelt ) then - if( qs(i) <= spec_hum(i) ) then - rlux(i,lt,ispec) = 100._r8 - end if - if( has_rain(i) ) then - ! rlux(i,lt,ispec) = 1./(2.e-4 + (1./(3.*rlu(index_season(i,lt),lt)))) - rlux(i,lt,ispec) = 15._r8*rlu(index_season(i,lt),lt)/(5._r8 + 3.e-3_r8*rlu(index_season(i,lt),lt)) - end if - end if - rclx(i,lt,ispec) = cts(i) + rcls(index_season(i,lt),lt) - rlux(i,lt,ispec) = cts(i) + rlux(i,lt,ispec) - - end if - end do - end if - end do - do i = 1,ncol - if( fr_lnduse(i,1) .and. (has_dew(i) .or. has_rain(i)) ) then - rlux(i,1,ispec) = 50._r8 - end if - end do - end if - end if - end do species_loop2 - - !------------------------------------------------------------------------------------- - ! compute rc - !------------------------------------------------------------------------------------- - term(:ncol) = 1.e-2_r8 * pressure_10m(:ncol) / (r*tv(:ncol)) - species_loop3 : do ispec = 1,nTracersMax - if( has_dvel(ispec) ) then - wrk(:) = 0._r8 - lt_loop: do lt = beglt,endlt - do i = 1,ncol - if (fr_lnduse(i,lt)) then - resc(i) = 1._r8/( 1._r8/rsmx(i,lt,ispec) + 1._r8/rlux(i,lt,ispec) & - + 1._r8/(rdc(i) + rclx(i,lt,ispec)) & - + 1._r8/(rac(index_season(i,lt),lt) + rgsx(i,lt,ispec))) - - resc(i) = max( 10._r8,resc(i) ) - - lnd_frc(i) = lcl_frc_landuse(i,lt) - endif - enddo - !------------------------------------------------------------------------------------- - ! ... compute average deposition velocity - !------------------------------------------------------------------------------------- - select case( tracerNames(ispec) ) - case( 'SO2' ) - if( lt == 7 ) then - where( fr_lnduse(:ncol,lt) ) - ! assume no surface resistance for SO2 over water` - wrk(:) = wrk(:) + lnd_frc(:)/(dep_ra(:ncol,lt,lchnk) + dep_rb(:ncol,lt,lchnk)) - endwhere - else - where( fr_lnduse(:ncol,lt) ) - wrk(:) = wrk(:) + lnd_frc(:)/(dep_ra(:ncol,lt,lchnk) + dep_rb(:ncol,lt,lchnk) + resc(:)) - endwhere - end if - - ! JFL - increase in dry deposition of SO2 to improve bias over US/Europe - wrk(:) = wrk(:) * 2._r8 - - case( 'SO4' ) - where( fr_lnduse(:ncol,lt) ) - wrk(:) = wrk(:) + lnd_frc(:)/(dep_ra(:ncol,lt,lchnk) + rds(:,lt)) - endwhere - case( 'NH4', 'NH4NO3', 'XNH4NO3' ) - where( fr_lnduse(:ncol,lt) ) - wrk(:) = wrk(:) + lnd_frc(:)/(dep_ra(:ncol,lt,lchnk) + 0.5_r8*rds(:,lt)) - endwhere - - !------------------------------------------------------------------------------------- - ! ... special case for Pb (for consistency with offline code) - !------------------------------------------------------------------------------------- - case( 'Pb' ) - if( lt == 7 ) then - where( fr_lnduse(:ncol,lt) ) - wrk(:) = wrk(:) + lnd_frc(:) * 0.05e-2_r8 - endwhere - else - where( fr_lnduse(:ncol,lt) ) - wrk(:ncol) = wrk(:ncol) + lnd_frc(:ncol) * 0.2e-2_r8 - endwhere - end if - - !------------------------------------------------------------------------------------- - ! ... special case for carbon aerosols - !------------------------------------------------------------------------------------- - case( 'CB1', 'CB2', 'OC1', 'OC2', 'SOAM', 'SOAI', 'SOAT', 'SOAB','SOAX' ) - if ( drydep_method == DD_XLND ) then - where( fr_lnduse(:ncol,lt) ) - wrk(:ncol) = wrk(:ncol) + lnd_frc(:ncol) * 0.10e-2_r8 - endwhere - else - wrk(:ncol) = 0.10e-2_r8 - endif - - !------------------------------------------------------------------------------------- - ! deposition over ocean for HCN, CH3CN - ! velocity estimated from aircraft measurements (E.Apel, INTEX-B) - !------------------------------------------------------------------------------------- - case( 'HCN','CH3CN' ) - if( lt == 7 ) then ! over ocean only - where( fr_lnduse(:ncol,lt) .and. snow(:ncol) < 0.01_r8 ) - wrk(:ncol) = wrk(:ncol) + lnd_frc(:ncol) * 0.2e-2_r8 - endwhere - end if - case default - where( fr_lnduse(:ncol,lt) ) - wrk(:ncol) = wrk(:ncol) + lnd_frc(:ncol)/(dep_ra(:ncol,lt,lchnk) + dep_rb(:ncol,lt,lchnk) + resc(:ncol)) - endwhere - end select - end do lt_loop - dvel(:ncol,ispec) = wrk(:ncol) * scaling_to_cm_per_s - dflx(:ncol,ispec) = term(:ncol) * dvel(:ncol,ispec) * State_Chm%Species(1,:ncol,plev,ispec) - end if - - end do species_loop3 - - if ( beglt > 1 ) return - - !------------------------------------------------------------------------------------- - ! ... special adjustments - !------------------------------------------------------------------------------------- - if( mpan_ndx > 0 ) then - if( has_dvel(mpan_ndx) ) then - dvel(:ncol,mpan_ndx) = dvel(:ncol,mpan_ndx)/3._r8 - dflx(:ncol,mpan_ndx) = term(:ncol) * dvel(:ncol,mpan_ndx) * State_Chm%Species(1,:ncol,plev,mpan_ndx) - end if - end if - if( xmpan_ndx > 0 ) then - if( has_dvel(xmpan_ndx) ) then - dvel(:ncol,xmpan_ndx) = dvel(:ncol,xmpan_ndx)/3._r8 - dflx(:ncol,xmpan_ndx) = term(:ncol) * dvel(:ncol,xmpan_ndx) * State_Chm%Species(1,:ncol,plev,xmpan_ndx) - end if - end if - - ! HCOOH, use CH3COOH dep.vel - if( hcooh_ndx > 0) then - if( has_dvel(hcooh_ndx) ) then - dvel(:ncol,hcooh_ndx) = dvel(:ncol,ch3cooh_ndx) - dflx(:ncol,hcooh_ndx) = term(:ncol) * dvel(:ncol,hcooh_ndx) * State_Chm%Species(1,:ncol,plev,hcooh_ndx) - end if - end if -! -! SOG species -! - if( sogm_ndx > 0) then - if( has_dvel(sogm_ndx) ) then - dvel(:ncol,sogm_ndx) = dvel(:ncol,ch3cooh_ndx) - dflx(:ncol,sogm_ndx) = term(:ncol) * dvel(:ncol,sogm_ndx) * State_Chm%Species(1,:ncol,plev,sogm_ndx) - end if - end if - if( sogi_ndx > 0) then - if( has_dvel(sogi_ndx) ) then - dvel(:ncol,sogi_ndx) = dvel(:ncol,ch3cooh_ndx) - dflx(:ncol,sogi_ndx) = term(:ncol) * dvel(:ncol,sogi_ndx) * State_Chm%Species(1,:ncol,plev,sogi_ndx) - end if - end if - if( sogt_ndx > 0) then - if( has_dvel(sogt_ndx) ) then - dvel(:ncol,sogt_ndx) = dvel(:ncol,ch3cooh_ndx) - dflx(:ncol,sogt_ndx) = term(:ncol) * dvel(:ncol,sogt_ndx) * State_Chm%Species(1,:ncol,plev,sogt_ndx) - end if - end if - if( sogb_ndx > 0) then - if( has_dvel(sogb_ndx) ) then - dvel(:ncol,sogb_ndx) = dvel(:ncol,ch3cooh_ndx) - dflx(:ncol,sogb_ndx) = term(:ncol) * dvel(:ncol,sogb_ndx) * State_Chm%Species(1,:ncol,plev,sogb_ndx) - end if - end if - if( sogx_ndx > 0) then - if( has_dvel(sogx_ndx) ) then - dvel(:ncol,sogx_ndx) = dvel(:ncol,ch3cooh_ndx) - dflx(:ncol,sogx_ndx) = term(:ncol) * dvel(:ncol,sogx_ndx) * State_Chm%Species(1,:ncol,plev,sogx_ndx) - end if - end if -! - end subroutine drydep_xactive - - !------------------------------------------------------------------------------------- - !------------------------------------------------------------------------------------- - subroutine soilw_inti( ncfile, nlon_veg, nlat_veg, soilw_map ) - !------------------------------------------------------------------ - ! ... read primary soil moisture table - !------------------------------------------------------------------ - - use time_manager, only : get_calday - - implicit none - - !------------------------------------------------------------------ - ! ... dummy args - !------------------------------------------------------------------ - integer, intent(in) :: & - nlon_veg, & - nlat_veg - real(r8), pointer :: soilw_map(:,:,:) - character(len=*), intent(in) :: ncfile ! file name of netcdf file containing data - - !------------------------------------------------------------------ - ! ... local variables - !------------------------------------------------------------------ - integer :: gndx = 0 - integer :: nlat, & ! # of lats in soilw file - nlon ! # of lons in soilw file - integer :: i, ip, k, m - integer :: j, jl, ju - integer :: lev, day, ierr - type(file_desc_t) :: piofile - type(var_desc_t) :: vid - - integer :: dimid_lat, dimid_lon, dimid_time - integer :: dates(12) = (/ 116, 214, 316, 415, 516, 615, & - 716, 816, 915, 1016, 1115, 1216 /) - - character(len=shr_kind_cl) :: locfn - - !----------------------------------------------------------------------- - ! ... open netcdf file - !----------------------------------------------------------------------- - call getfil (ncfile, locfn, 0) - call cam_pio_openfile (piofile, trim(locfn), PIO_NOWRITE) - - !----------------------------------------------------------------------- - ! ... get longitudes - !----------------------------------------------------------------------- - ierr = pio_inq_dimid( piofile, 'lon', dimid_lon ) - ierr = pio_inq_dimlen( piofile, dimid_lon, nlon ) - if( nlon /= nlon_veg ) then - write(iulog,*) 'soilw_inti: soil and vegetation lons differ; ',nlon, nlon_veg - call endrun - end if - !----------------------------------------------------------------------- - ! ... get latitudes - !----------------------------------------------------------------------- - ierr = pio_inq_dimid( piofile, 'lat', dimid_lat ) - ierr = pio_inq_dimlen( piofile, dimid_lat, nlat ) - if( nlat /= nlat_veg ) then - write(iulog,*) 'soilw_inti: soil and vegetation lats differ; ',nlat, nlat_veg - call endrun - end if - !----------------------------------------------------------------------- - ! ... set times (days of year) - !----------------------------------------------------------------------- - ierr = pio_inq_dimid( piofile, 'time', dimid_time ) - ierr = pio_inq_dimlen( piofile, dimid_time, ndays ) - if( ndays /= 12 ) then - write(iulog,*) 'soilw_inti: dataset not a cyclical year' - call endrun - end if - allocate( days(ndays),stat=ierr ) - if( ierr /= 0 ) then - write(iulog,*) 'soilw_inti: days allocation error = ',ierr - call endrun - end if - do m = 1,min(12,ndays) - days(m) = get_calday( dates(m), 0 ) - end do - - !------------------------------------------------------------------ - ! ... allocate arrays - !------------------------------------------------------------------ - allocate( soilw_map(nlon,nlat,ndays), stat=ierr ) - if( ierr /= 0 ) then - write(iulog,*) 'soilw_inti: soilw_map allocation error = ',ierr - call endrun - end if - - !------------------------------------------------------------------ - ! ... read in the soil moisture - !------------------------------------------------------------------ - ierr = pio_inq_varid( piofile, 'SOILW', vid ) - ierr = pio_get_var( piofile, vid, soilw_map ) - !------------------------------------------------------------------ - ! ... close file - !------------------------------------------------------------------ - call cam_pio_closefile( piofile ) - - end subroutine soilw_inti - - !------------------------------------------------------------------------------------- - !------------------------------------------------------------------------------------- - subroutine chk_soilw( calday ) - !-------------------------------------------------------------------- - ! ... check timing for ub values - !-------------------------------------------------------------------- - - use mo_constants, only : dayspy - - implicit none - - !-------------------------------------------------------------------- - ! ... dummy args - !-------------------------------------------------------------------- - real(r8), intent(in) :: calday - - !-------------------------------------------------------------------- - ! ... local variables - !-------------------------------------------------------------------- - integer :: m, upper - real(r8) :: numer, denom - - !-------------------------------------------------------- - ! ... setup the time interpolation - !-------------------------------------------------------- - if( calday < days(1) ) then - next = 1 - last = ndays - else - if( days(ndays) < dayspy ) then - upper = ndays - else - upper = ndays - 1 - end if - do m = upper,1,-1 - if( calday >= days(m) ) then - exit - end if - end do - last = m - next = mod( m,ndays ) + 1 - end if - numer = calday - days(last) - denom = days(next) - days(last) - if( numer < 0._r8 ) then - numer = dayspy + numer - end if - if( denom < 0._r8 ) then - denom = dayspy + denom - end if - dels = max( min( 1._r8,numer/denom ),0._r8 ) - - end subroutine chk_soilw - - !------------------------------------------------------------------------------------- - !------------------------------------------------------------------------------------- - subroutine set_soilw( soilw, lchnk, calday ) - !-------------------------------------------------------------------- - ! ... set the soil moisture - !-------------------------------------------------------------------- - - implicit none - - !-------------------------------------------------------------------- - ! ... dummy args - !-------------------------------------------------------------------- - real(r8), intent(inout) :: soilw(pcols) - integer, intent(in) :: lchnk ! chunk indice - real(r8), intent(in) :: calday - - - integer :: i, ilon,ilat - - call chk_soilw( calday ) - - soilw(:) = soilw_3d(:,last,lchnk) + dels *( soilw_3d(:,next,lchnk) - soilw_3d(:,last,lchnk)) - - end subroutine set_soilw - - !------------------------------------------------------------------------------------- - !------------------------------------------------------------------------------------- - function has_drydep( name ) - - implicit none - - character(len=*), intent(in) :: name - - logical :: has_drydep - integer :: i - - has_drydep = .false. - - do i=1,nddvels - if ( trim(name) == trim(drydep_list(i)) ) then - has_drydep = .true. - exit - endif - enddo - - endfunction has_drydep - -end module mo_drydep diff --git a/src/chemistry/geoschem/mo_drydep.F90 b/src/chemistry/geoschem/mo_drydep.F90 new file mode 120000 index 0000000000..fcb098953c --- /dev/null +++ b/src/chemistry/geoschem/mo_drydep.F90 @@ -0,0 +1 @@ +../mozart/mo_drydep.F90 \ No newline at end of file diff --git a/src/chemistry/geoschem/mo_neu_wetdep.F90 b/src/chemistry/geoschem/mo_neu_wetdep.F90 index 49a9acb3a0..b70718015a 100644 --- a/src/chemistry/geoschem/mo_neu_wetdep.F90 +++ b/src/chemistry/geoschem/mo_neu_wetdep.F90 @@ -148,8 +148,14 @@ subroutine neu_wetdep_init 'IONITA', 'ISALA', 'ISALC', 'LVOCOA', 'MONITA', & 'MSA', 'NH4', 'NIT', 'NITS', 'PFE', & 'SALAAL', 'SALACL', 'SALCAL', 'SALCCL', 'SO4S', & - 'SOAGX', 'SOAIE' ) + 'SOAS', 'SOAGX', 'SOAIE', 'TSOA0', 'TSOA1', & + 'TSOA2', 'TSOA3', 'ASOAN', 'ASOA1', 'ASOA2', & + 'ASOA3' ) test_name = 'HNO3' + case( 'ASOG1', 'ASOG2', 'ASOG3' ) + test_name = 'ASOG' + case( 'TSOG0', 'TSOG1', 'TSOG2', 'TSOG3' ) + test_name = 'TSOG' end select ! do l = 1,n_species_table @@ -226,8 +232,8 @@ subroutine neu_wetdep_init call addfld ('DTWR_'//trim(gas_wetdep_list(m)),(/ 'lev' /), 'A','kg/kg/s','wet removal Neu scheme tendency') call addfld ('WD_'//trim(gas_wetdep_list(m)),horiz_only, 'A','kg/m2/s','vertical integrated wet deposition flux') call addfld ('HEFF_'//trim(gas_wetdep_list(m)),(/ 'lev' /), 'A','M/atm','Effective Henrys Law coeff.') - call add_default('DTWR_'//trim(gas_wetdep_list(m)), 2, ' ') - call add_default('WD_'//trim(gas_wetdep_list(m)), 2, ' ') + !call add_default('DTWR_'//trim(gas_wetdep_list(m)), 2, ' ') + !call add_default('WD_'//trim(gas_wetdep_list(m)), 2, ' ') !call add_default('HEFF_'//trim(gas_wetdep_list(m)), 2, ' ') if (history_chemistry) then call add_default('DTWR_'//trim(gas_wetdep_list(m)), 1, ' ') diff --git a/src/chemistry/geoschem/mo_sim_dat.F90 b/src/chemistry/geoschem/mo_sim_dat.F90 index 442e2fc4a0..46c344415b 100644 --- a/src/chemistry/geoschem/mo_sim_dat.F90 +++ b/src/chemistry/geoschem/mo_sim_dat.F90 @@ -40,22 +40,24 @@ subroutine set_sim_dat ! aerosols, as those will be constituents. MAM requires that there ! is a linear mapping between solsym and constituents - solsym(:318) = (/ 'ACET ','ACTA ','AERI ', & - 'ALD2 ','ALK4 ','ATOOH ', & - 'BCPI ','BCPO ','BENZ ', & - 'BR ','BR2 ','BRCL ', & - 'BRNO2 ','BRNO3 ','BRO ', & - 'BRSALA ','BRSALC ','C2H6 ', & - 'C3H8 ','CCL4 ','CFC11 ', & - 'CFC113 ','CFC114 ','CFC115 ', & - 'CFC12 ','CH2BR2 ','CH2CL2 ', & - 'CH2I2 ','CH2IBR ','CH2ICL ', & - 'CH2O ','CH3BR ','CH3CCL3 ', & - 'CH3CL ','CH3I ','CH4 ', & - 'CHBR3 ','CHCL3 ','CL ', & - 'CL2 ','CL2O2 ','CLNO2 ', & - 'CLNO3 ','CLO ','CLOO ', & - 'CLOCK ', & + solsym(:331) = (/ 'ACET ','ACTA ','AERI ', & + 'ALD2 ','ALK4 ','ASOA1 ', & + 'ASOA2 ','ASOA3 ','ASOAN ', & + 'ASOG1 ','ASOG2 ','ASOG3 ', & + 'ATOOH ','BCPI ','BCPO ', & + 'BENZ ','BR ','BR2 ', & + 'BRCL ','BRNO2 ','BRNO3 ', & + 'BRO ','BRSALA ','BRSALC ', & + 'C2H6 ','C3H8 ','CCL4 ', & + 'CFC11 ','CFC113 ','CFC114 ', & + 'CFC115 ','CFC12 ','CH2BR2 ', & + 'CH2CL2 ','CH2I2 ','CH2IBR ', & + 'CH2ICL ','CH2O ','CH3BR ', & + 'CH3CCL3 ','CH3CL ','CH3I ', & + 'CH4 ','CHBR3 ','CHCL3 ', & + 'CL ','CL2 ','CL2O2 ', & + 'CLNO2 ','CLNO3 ','CLO ', & + 'CLOO ','CLOCK ', & 'CO ','DMS ','DST1 ', & 'DST2 ','DST3 ','DST4 ', & 'EOH ','ETHLN ','ETNO3 ', & @@ -107,8 +109,10 @@ subroutine set_sim_dat 'SALAAL ','SALACL ','SALC ', & 'SALCAL ','SALCCL ','SO2 ', & 'SO4 ','SO4S ','SOAGX ', & - 'SOAIE ','SOAP ','SOAS ', & - 'TOLU ','XYLE ','bc_a1 ', & + 'SOAIE ','TOLU ','TSOA0 ', & + 'TSOA1 ','TSOA2 ','TSOA3 ', & + 'TSOG0 ','TSOG1 ','TSOG2 ', & + 'TSOG3 ','XYLE ','bc_a1 ', & 'bc_a4 ','dst_a1 ','dst_a2 ', & 'dst_a3 ','ncl_a1 ','ncl_a2 ', & 'ncl_a3 ','num_a1 ','num_a2 ', & @@ -154,81 +158,78 @@ subroutine set_sim_dat fix_mass(: 6) = (/ 0.00000000_r8, 28.0134800_r8, 31.9988000_r8, 2.020000_r8, 32.050000_r8, & 74.090000_r8 /) - adv_mass(:318) = (/ 58.090000_r8, 60.060000_r8, 126.900000_r8, 44.060000_r8, 58.120000_r8, & - 90.090000_r8, 12.010000_r8, 12.010000_r8, 78.120000_r8, 79.900000_r8, & - 159.800000_r8, 115.450000_r8, 125.910000_r8, 141.910000_r8, 95.900000_r8, & - 79.900000_r8, 79.900000_r8, 30.080000_r8, 44.110000_r8, 153.820000_r8, & - 137.370000_r8, 187.380000_r8, 170.920000_r8, 154.470000_r8, 120.910000_r8, & - 173.830000_r8, 84.930000_r8, 267.840000_r8, 220.840000_r8, 176.380000_r8, & - 30.030000_r8, 94.940000_r8, 133.350000_r8, 50.450000_r8, 141.940000_r8, & - 16.050000_r8, 252.730000_r8, 119.350000_r8, 35.450000_r8, 70.900000_r8, & - 102.910000_r8, 81.450000_r8, 97.450000_r8, 51.450000_r8, 67.450000_r8, & - 1.000000_r8, & - 28.010000_r8, 62.130000_r8, 29.000000_r8, 29.000000_r8, 29.000000_r8, & - 29.000000_r8, 46.080000_r8, 105.060000_r8, 91.080000_r8, 62.080000_r8, & - 60.060000_r8, 58.040000_r8, 165.360000_r8, 148.910000_r8, 259.820000_r8, & - 18.020000_r8, 34.020000_r8, 74.080000_r8, 80.910000_r8, 100.130000_r8, & - 152.930000_r8, 116.940000_r8, 100.500000_r8, 86.470000_r8, 36.450000_r8, & - 46.030000_r8, 127.910000_r8, 64.050000_r8, 102.100000_r8, 47.010000_r8, & - 63.010000_r8, 79.010000_r8, 96.910000_r8, 52.450000_r8, 143.890000_r8, & - 215.000000_r8, 116.130000_r8, 116.130000_r8, 116.130000_r8, 116.130000_r8, & - 76.060000_r8, 126.900000_r8, 253.800000_r8, 285.800000_r8, 301.800000_r8, & - 317.800000_r8, 206.900000_r8, 116.130000_r8, 162.450000_r8, 145.130000_r8, & - 150.150000_r8, 98.110000_r8, 148.130000_r8, 168.170000_r8, 150.150000_r8, & - 192.150000_r8, 106.140000_r8, 106.140000_r8, 106.140000_r8, 147.150000_r8, & - 147.150000_r8, 147.150000_r8, 147.150000_r8, 102.000000_r8, 156.910000_r8, & - 163.150000_r8, 163.150000_r8, 142.900000_r8, 14.010000_r8, 172.910000_r8, & - 188.910000_r8, 105.110000_r8, 126.900000_r8, 126.900000_r8, 68.130000_r8, & - 195.150000_r8, 197.170000_r8, 136.260000_r8, 154.190000_r8, 154.190000_r8, & - 70.100000_r8, 102.100000_r8, 76.060000_r8, 104.120000_r8, 86.100000_r8, & - 149.110000_r8, 149.110000_r8, 120.120000_r8, 72.110000_r8, 77.050000_r8, & - 72.070000_r8, 32.050000_r8, 14.010000_r8, 215.280000_r8, 215.280000_r8, & - 48.050000_r8, 147.100000_r8, 93.050000_r8, 96.100000_r8, 136.260000_r8, & - 136.260000_r8, 70.090000_r8, 105.130000_r8, 102.100000_r8, 102.100000_r8, & - 120.120000_r8, 149.120000_r8, 118.100000_r8, 44.020000_r8, 108.020000_r8, & - 17.040000_r8, 18.050000_r8, 62.010000_r8, 31.400000_r8, 30.010000_r8, & - 46.010000_r8, 62.010000_r8, 105.110000_r8, 48.000000_r8, 67.450000_r8, & - 12.010000_r8, 12.010000_r8, 60.070000_r8, 158.900000_r8, 121.060000_r8, & - 55.850000_r8, 186.280000_r8, 92.110000_r8, 135.080000_r8, 119.080000_r8, & - 42.090000_r8, 137.110000_r8, 88.070000_r8, 119.100000_r8, 90.140000_r8, & - 76.110000_r8, 76.110000_r8, 58.090000_r8, 118.150000_r8, 118.150000_r8, & - 118.150000_r8, 118.150000_r8, 90.090000_r8, 31.400000_r8, 31.400000_r8, & - 35.450000_r8, 31.400000_r8, 31.400000_r8, 35.450000_r8, 64.040000_r8, & - 96.060000_r8, 31.400000_r8, 58.040000_r8, 118.150000_r8, 150.000000_r8, & - 150.000000_r8, 92.150000_r8, 106.180000_r8, 12.011000_r8, 12.011000_r8, & - 135.064039_r8, 135.064039_r8, 135.064039_r8, 58.442468_r8, 58.442468_r8, & - 58.442468_r8, 1.007400_r8, 1.007400_r8, 1.007400_r8, 1.007400_r8, & - 12.011000_r8, 12.011000_r8, 115.107340_r8, 115.107340_r8, 115.107340_r8, & + adv_mass(:331) = (/ 58.090000_r8, 60.060000_r8, 126.900000_r8, 44.060000_r8, 58.120000_r8, & + 150.000000_r8, 150.000000_r8, 150.000000_r8, 150.000000_r8, 150.000000_r8, & + 150.00000_r8, 150.000000_r8, 90.0900000_r8, 12.010000_r8, 12.010000_r8, & + 78.120000_r8, 79.900000_r8, 159.800000_r8, 115.450000_r8, 125.910000_r8, & + 141.910000_r8, 95.900000_r8, 79.900000_r8, 79.900000_r8, 30.080000_r8, & + 44.110000_r8, 153.820000_r8, 137.370000_r8, 187.380000_r8, 170.920000_r8, & + 154.470000_r8, 120.910000_r8, 173.830000_r8, 84.930000_r8, 267.840000_r8, & + 220.840000_r8, 176.380000_r8, 30.030000_r8, 94.940000_r8, 133.350000_r8, & + 50.450000_r8, 141.940000_r8, 16.050000_r8, 252.730000_r8, 119.350000_r8, & + 35.450000_r8, 70.900000_r8, 102.910000_r8, 81.450000_r8, 97.450000_r8, & + 51.450000_r8, 67.450000_r8, 1.000000_r8, 28.010000_r8, 62.130000_r8, & + 29.000000_r8, 29.000000_r8, 29.000000_r8, 29.000000_r8, 46.080000_r8, & + 105.060000_r8, 91.080000_r8, 62.080000_r8, 60.060000_r8, 58.040000_r8, & + 165.360000_r8, 148.910000_r8, 259.820000_r8, 18.020000_r8, 34.020000_r8, & + 74.080000_r8, 80.910000_r8, 100.130000_r8, 152.930000_r8, 116.940000_r8, & + 100.500000_r8, 86.470000_r8, 36.450000_r8, 46.030000_r8, 127.910000_r8, & + 64.050000_r8, 102.100000_r8, 47.010000_r8, 63.010000_r8, 79.010000_r8, & + 96.910000_r8, 52.450000_r8, 143.890000_r8, 215.000000_r8, 116.130000_r8, & + 116.130000_r8, 116.130000_r8, 116.130000_r8, 76.060000_r8, 126.900000_r8, & + 253.800000_r8, 285.800000_r8, 301.800000_r8, 317.800000_r8, 206.900000_r8, & + 116.130000_r8, 162.450000_r8, 145.130000_r8, 150.150000_r8, 98.110000_r8, & + 148.130000_r8, 168.170000_r8, 150.150000_r8, 192.150000_r8, 106.140000_r8, & + 106.140000_r8, 106.140000_r8, 147.150000_r8, 147.150000_r8, 147.150000_r8, & + 147.150000_r8, 102.000000_r8, 156.910000_r8, 163.150000_r8, 163.150000_r8, & + 142.900000_r8, 14.010000_r8, 172.910000_r8, 188.910000_r8, 105.110000_r8, & + 126.900000_r8, 126.900000_r8, 68.130000_r8, 195.150000_r8, 197.170000_r8, & + 136.260000_r8, 154.190000_r8, 154.190000_r8, 70.100000_r8, 102.100000_r8, & + 76.060000_r8, 104.120000_r8, 86.100000_r8, 149.110000_r8, 149.110000_r8, & + 120.120000_r8, 72.110000_r8, 77.050000_r8, 72.070000_r8, 32.050000_r8, & + 14.010000_r8, 215.280000_r8, 215.280000_r8, 48.050000_r8, 147.100000_r8, & + 93.050000_r8, 96.100000_r8, 136.260000_r8, 136.260000_r8, 70.090000_r8, & + 105.130000_r8, 102.100000_r8, 102.100000_r8, 120.120000_r8, 149.120000_r8, & + 118.100000_r8, 44.020000_r8, 108.020000_r8, 17.040000_r8, 18.050000_r8, & + 62.010000_r8, 31.400000_r8, 30.010000_r8, 46.010000_r8, 62.010000_r8, & + 105.110000_r8, 48.000000_r8, 67.450000_r8, 12.010000_r8, 12.010000_r8, & + 60.070000_r8, 158.900000_r8, 121.060000_r8, 55.850000_r8, 186.280000_r8, & + 92.110000_r8, 135.080000_r8, 119.080000_r8, 42.090000_r8, 137.110000_r8, & + 88.070000_r8, 119.100000_r8, 90.140000_r8, 76.110000_r8, 76.110000_r8, & + 58.090000_r8, 118.150000_r8, 118.150000_r8, 118.150000_r8, 118.150000_r8, & + 90.090000_r8, 31.400000_r8, 31.400000_r8, 35.450000_r8, 31.400000_r8, & + 31.400000_r8, 35.450000_r8, 64.040000_r8, 96.060000_r8, 31.400000_r8, & + 58.040000_r8, 118.150000_r8, 92.150000_r8, 150.000000_r8, 150.000000_r8, & + 150.000000_r8, 150.000000_r8, 150.000000_r8, 150.000000_r8, 150.000000_r8, & + 150.000000_r8, 106.180000_r8, 12.011000_r8, 12.011000_r8, 135.064039_r8, & + 135.064039_r8, 135.064039_r8, 58.442468_r8, 58.442468_r8, 58.442468_r8, & + 1.007400_r8, 1.007400_r8, 1.007400_r8, 1.007400_r8, 12.011000_r8, & + 12.011000_r8, 115.107340_r8, 115.107340_r8, 115.107340_r8, 250.445000_r8, & 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, & + 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, 98.078400_r8, & 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, & - 98.078400_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, & - 250.445000_r8, 44.010000_r8, -1.000000_r8, -1.000000_r8, -1.000000_r8, & + 44.010000_r8, -1.000000_r8, -1.000000_r8, -1.000000_r8, -1.000000_r8, & + -1.000000_r8, -1.000000_r8, -1.000000_r8, -1.000000_r8, 96.060000_r8, & + 96.060000_r8, 96.060000_r8, 96.060000_r8, -1.000000_r8, -1.000000_r8, & -1.000000_r8, -1.000000_r8, -1.000000_r8, -1.000000_r8, -1.000000_r8, & - 96.060000_r8, 96.060000_r8, 96.060000_r8, 96.060000_r8, -1.000000_r8, & - -1.000000_r8, -1.000000_r8, -1.000000_r8, -1.000000_r8, -1.000000_r8, & - -1.000000_r8, 159.130000_r8, 173.160000_r8, 14.010000_r8, 187.190000_r8, & - 147.120000_r8, 147.120000_r8, 146.140000_r8, 103.110000_r8, 103.110000_r8, & - 241.140000_r8, 194.140000_r8, 196.160000_r8, 60.110000_r8, 196.160000_r8, & - 196.160000_r8, 196.160000_r8, 1.010000_r8, 167.160000_r8, 167.160000_r8, & - 167.160000_r8, 212.160000_r8, 149.140000_r8, 150.130000_r8, 136.090000_r8, & - 119.110000_r8, 119.110000_r8, 101.090000_r8, 91.100000_r8, 230.270000_r8, & - 230.270000_r8, 61.070000_r8, 212.160000_r8, 89.080000_r8, 185.270000_r8, & - 101.090000_r8, 149.140000_r8, 149.140000_r8, 60.060000_r8, 185.270000_r8, & - 196.160000_r8, 75.100000_r8, 117.140000_r8, 117.140000_r8, 162.140000_r8, & - 162.140000_r8, 180.100000_r8, 89.080000_r8, 61.070000_r8, 89.130000_r8, & - 75.100000_r8, 46.030000_r8, 75.050000_r8, 47.040000_r8, 16.000000_r8, & - 17.010000_r8, 33.010000_r8, 16.000000_r8, 2.020000_r8, 28.020000_r8, & - 32.000000_r8, 74.090000_r8 /) + 159.130000_r8, 173.160000_r8, 14.010000_r8, 187.190000_r8, 147.120000_r8, & + 147.120000_r8, 146.140000_r8, 103.110000_r8, 103.110000_r8, 241.140000_r8, & + 194.140000_r8, 196.160000_r8, 60.110000_r8, 196.160000_r8, 196.160000_r8, & + 196.160000_r8, 1.010000_r8, 167.160000_r8, 167.160000_r8, 167.160000_r8, & + 212.160000_r8, 149.140000_r8, 150.130000_r8, 136.090000_r8, 119.110000_r8, & + 119.110000_r8, 101.090000_r8, 91.100000_r8, 230.270000_r8, 230.270000_r8, & + 61.070000_r8, 212.160000_r8, 89.080000_r8, 185.270000_r8, 101.090000_r8, & + 149.140000_r8, 149.140000_r8, 60.060000_r8, 185.270000_r8, 196.160000_r8, & + 75.100000_r8, 117.140000_r8, 117.140000_r8, 162.140000_r8, 162.140000_r8, & + 180.100000_r8, 89.080000_r8, 61.070000_r8, 89.130000_r8, 75.100000_r8, & + 46.030000_r8, 75.050000_r8, 47.040000_r8, 16.000000_r8, 17.010000_r8, & + 33.010000_r8, 16.000000_r8, 2.020000_r8, 28.020000_r8, 32.000000_r8, & + 74.090000_r8 /) extfrc_lst(: 1) = (/ ' ' /) frc_from_dataset(: 1) = (/ .false. /) - !extfrc_lst(: 17) = (/ 'so4_a2 ','NO ','NO2 ','SO2 ','SVOC ', & - ! 'pom_a1 ','pom_a4 ','so4_a1 ','CO ','bc_a1 ', & - ! 'bc_a4 ','num_a1 ','num_a2 ','num_a4 ','OH ', & - ! 'N ','AOA_NH ' /) - ! crb_mass(:221) = (/ 60.055000_r8, 60.055000_r8, 12.011000_r8, 12.011000_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, & @@ -351,532 +352,6 @@ subroutine set_sim_dat ! 'PHENO2 ', 'PO2 ', 'RO2 ', 'TERP2O2 ', 'TERPO2 ', & ! 'TOLO2 ', 'XO2 ', 'XYLENO2 ', '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 ', 'jsoa1_a1 ', & - ! 'jsoa1_a2 ', 'jsoa2_a1 ', & - ! 'jsoa2_a2 ', 'jsoa3_a1 ', & - ! 'jsoa3_a2 ', 'jsoa4_a1 ', & - ! 'jsoa4_a2 ', 'jsoa5_a1 ', & - ! 'jsoa5_a2 ', '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 ' /) - ! rxt_tag_lst( 201: 400) = (/ '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 ', '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 ' /) - ! rxt_tag_lst( 401: 528) = (/ 'BENZOOH_OH ', 'BZALD_OH ', & - ! 'BZOO_HO2 ', 'BZOOH_OH ', & - ! 'BZOO_NO ', 'C6H5O2_HO2 ', & - ! 'C6H5O2_NO ', 'C6H5OOH_OH ', & - ! 'CRESOL_OH ', 'DICARBO2_HO2 ', & - ! '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 ', '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_SO2_OH ', & - ! 'usr_SO3_H2O ', 'DMS_NO3 ', & - ! 'DMS_OHa ', 'NH3_OH ', & - ! 'usr_DMS_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 ', & - ! 'BCARY_O3_vbs ', 'BCARY_OH_vbs ', & - ! 'BENZENE_OH_vbs ', 'ISOP_NO3_vbs ', & - ! 'ISOP_O3_vbs ', 'ISOP_OH_vbs ', & - ! 'IVOC_OH ', 'MTERP_NO3_vbs ', & - ! 'MTERP_O3_vbs ', 'MTERP_OH_vbs ', & - ! 'SVOC_OH ', 'TOLUENE_OH_vbs ', & - ! 'XYLENES_OH_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 /) - ! 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 ', ' ', ' ', ' ', & - ! ' ', ' ', ' ', ' ', & - ! ' ', ' ', ' ', ' ', & - ! ' ', ' ', ' ', ' ', & - ! ' ', ' ', ' ', ' ', & - ! ' ', ' ', ' ', ' ', & - ! ' ', ' ', ' ', ' ', & - ! ' ', ' ', ' ', ' ', & - ! ' ', ' ', ' ', ' ', & - ! ' ', ' ', ' ', ' ', & - ! ' ', 'jno2 ', 'jno2 ', 'jno2 ', & - ! 'jno2 ', 'jno2 ', 'jno2 ', 'jno2 ', & - ! 'jno2 ', 'jno2 ', 'jno2 ' /) - ! 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, 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, .0004_r8, .0004_r8, & - ! .0004_r8, .0004_r8, .0004_r8, .0004_r8, .0004_r8, & - ! .0004_r8, .0004_r8, .0004_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(:) = (/ 126, 129, 130, 131, 134, & - ! 137, 138, 139, 140, 143, & - ! 144, 145, 148, 150, 154, & - ! 155, 163, 164 /) - ! 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, 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_trop_strat_mam4_vbs/chem_mods.F90 b/src/chemistry/pp_trop_strat_mam4_vbs/chem_mods.F90 index 8050030043..b6cbc77dcc 100644 --- a/src/chemistry/pp_trop_strat_mam4_vbs/chem_mods.F90 +++ b/src/chemistry/pp_trop_strat_mam4_vbs/chem_mods.F90 @@ -14,7 +14,7 @@ module chem_mods relcnt = 0, & ! number of relationship species grpcnt = 0, & ! number of group members nzcnt = 2022, & ! number of non-zero matrix entries - extcnt = 17, & ! number of species with external forcing + extcnt = 25, & ! number of species with external forcing clscnt1 = 30, & ! number of species in explicit class clscnt2 = 0, & ! number of species in hov class clscnt3 = 0, & ! number of species in ebi class diff --git a/src/chemistry/pp_trop_strat_mam4_vbs/mo_sim_dat.F90 b/src/chemistry/pp_trop_strat_mam4_vbs/mo_sim_dat.F90 index b4acb1295a..5eec3adef2 100644 --- a/src/chemistry/pp_trop_strat_mam4_vbs/mo_sim_dat.F90 +++ b/src/chemistry/pp_trop_strat_mam4_vbs/mo_sim_dat.F90 @@ -242,15 +242,17 @@ subroutine set_sim_dat 1621,1672,1699,1734,1776,1837,1862,1893,1917,1996, & 2022 /) - extfrc_lst(: 17) = (/ 'so4_a2 ','NO ','NO2 ','SO2 ','SVOC ', & + extfrc_lst(: 25) = (/ 'so4_a2 ','NO ','NO2 ','SO2 ','SVOC ', & 'pom_a1 ','pom_a4 ','so4_a1 ','CO ','bc_a1 ', & - 'bc_a4 ','num_a1 ','num_a2 ','num_a4 ','OH ', & - 'N ','AOA_NH ' /) + 'bc_a4 ','num_a1 ','num_a2 ','num_a4 ','CH3COCH3 ', & + 'CH3CHO ','BIGALK ','C2H6 ','C3H8 ','CH2O ', & + 'C3H6 ','MACR ','OH ','N ','AOA_NH ' /) - frc_from_dataset(: 17) = (/ .true., .true., .true., .true., .true., & + frc_from_dataset(: 25) = (/ .true., .true., .true., .true., .true., & .true., .true., .true., .true., .true., & - .true., .true., .true., .true., .false., & - .false., .false. /) + .true., .true., .true., .true., .true., & + .true., .true., .true., .true., .true., & + .true., .true., .false., .false., .false. /) inv_lst(: 3) = (/ 'M ', 'N2 ', 'O2 ' /) diff --git a/src/chemistry/pp_trop_strat_mam4_vbsext/chem_mods.F90 b/src/chemistry/pp_trop_strat_mam4_vbsext/chem_mods.F90 index 9665256a26..02c648cbcb 100644 --- a/src/chemistry/pp_trop_strat_mam4_vbsext/chem_mods.F90 +++ b/src/chemistry/pp_trop_strat_mam4_vbsext/chem_mods.F90 @@ -14,7 +14,7 @@ module chem_mods relcnt = 0, & ! number of relationship species grpcnt = 0, & ! number of group members nzcnt = 2078, & ! number of non-zero matrix entries - extcnt = 17, & ! number of species with external forcing + extcnt = 25, & ! number of species with external forcing clscnt1 = 26, & ! number of species in explicit class clscnt2 = 0, & ! number of species in hov class clscnt3 = 0, & ! number of species in ebi class diff --git a/src/chemistry/pp_trop_strat_mam4_vbsext/mo_sim_dat.F90 b/src/chemistry/pp_trop_strat_mam4_vbsext/mo_sim_dat.F90 index ec5d8e28ed..6559e5596d 100644 --- a/src/chemistry/pp_trop_strat_mam4_vbsext/mo_sim_dat.F90 +++ b/src/chemistry/pp_trop_strat_mam4_vbsext/mo_sim_dat.F90 @@ -269,15 +269,17 @@ subroutine set_sim_dat 1395,1418,1513,1538,1698,1722,1764,1822,1873,1934, & 1959,1986,2017,2052,2078 /) - extfrc_lst(: 17) = (/ 'pombb1_a4 ','bc_a4 ','CO ','NO ','NO2 ', & + extfrc_lst(: 25) = (/ 'pombb1_a4 ','bc_a4 ','CO ','NO ','NO2 ', & 'num_a1 ','num_a2 ','num_a4 ','SO2 ','so4_a1 ', & 'so4_a2 ','SVOCbb ','SVOCff ','pomff1_a4 ','bc_a1 ', & - 'N ','OH ' /) + 'CH3COCH3 ','CH3CHO ','BIGALK ','C2H6 ','C3H8 ', & + 'CH2O ','C3H6 ','MACR ','N ','OH ' /) - frc_from_dataset(: 17) = (/ .true., .true., .true., .true., .true., & + frc_from_dataset(: 25) = (/ .true., .true., .true., .true., .true., & .true., .true., .true., .true., .true., & .true., .true., .true., .true., .true., & - .false., .false. /) + .true., .true., .true., .true., .true., & + .true., .true., .true., .false., .false. /) inv_lst(: 3) = (/ 'M ', 'O2 ', 'N2 ' /) From d8f37097fc799efe201d488dff14d0143601850d Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Tue, 7 Dec 2021 12:40:05 -0700 Subject: [PATCH 013/291] Fix: correct improper merge conflict handling introduced during rebase Signed-off-by: Lizzie Lundgren --- .../use_cases/2000_geoschem.xml | 8 +- src/chemistry/geoschem/chemistry.F90 | 434 +++++------------- 2 files changed, 118 insertions(+), 324 deletions(-) diff --git a/bld/namelist_files/use_cases/2000_geoschem.xml b/bld/namelist_files/use_cases/2000_geoschem.xml index 7b4aa03782..2b7264fc61 100644 --- a/bld/namelist_files/use_cases/2000_geoschem.xml +++ b/bld/namelist_files/use_cases/2000_geoschem.xml @@ -50,13 +50,13 @@ 2000 atm/waccm/lb/LBC_2000climo_CMIP6_0p5degLat_c180227.nc ->&gt; emissions timing &lt;/!</! + ->&gt; &amp;lt;ext_frc_type&amp;gt;'SERIAL'&amp;lt;/ext_frc_type&amp;gt; &lt;/!</! + 'CYCLICAL' 2000 ->&gt; History Files &lt;/!</! + 1,30,365,240,240,480,365,73,30 0,-24,-24,-3,-1,1,-24,-120,-240 @@ -93,7 +93,7 @@ - 'dst_a1','so4_a1','nh4_a1','pom_a1','pomff1_a1','pombb1_a1','soa_a1','bc_a1','ncl_a1','num_a1','so4_a2','nh4_a2','soa_a2','ncl_a2','dst_a2','num_a2','dst_a3','ncl_a3','so4_a3','pom_a3','bc_a3','num_a3','ncl_a4','so4_a4','pom_a4','pomff1_a4','pombb1_a4','bc_a4','nh4_a4','num_a4','dst_a5','so4_a5','nh4_a5','num_a5','ncl_a6','so4_a6','nh4_a6','num_a6','dst_a7','so4_a7','nh4_a7','num_a7','soa1_a1','soa1_a2','soa2_a1','soa2_a2','soa3_a1','soa3_a2','soa4_a1','soa4_a2','soa5_a1','soa5_a2','soaff1_a1','soaff2_a1','soaff3_a1','soaff4_a1','soaff5_a1','soabb1_a1','soabb2_a1','soabb3_a1','soabb4_a1','soabb5_a1','soabg1_a1','soabg2_a1','soabg3_a1','soabg4_a1','soabg5_a1','soaff1_a2','soaff2_a2','soaff3_a2','soaff4_a2','soaff5_a2','soabb1_a2','soabb2_a2','soabb3_a2','soabb4_a2','soabb5_a2','soabg1_a2','soabg2_a2','soabg3_a2','soabg4_a2','soabg5_a2' + 'dst_a1','so4_a1','nh4_a1','pom_a1','pomff1_a1','pombb1_a1','soa_a1','bc_a1','ncl_a1','num_a1','so4_a2','nh4_a2','soa_a2','ncl_a2','dst_a2','num_a2','dst_a3','ncl_a3','so4_a3','pom_a3','bc_a3','num_a3','ncl_a4','so4_a4','pom_a4','pomff1_a4','pombb1_a4','bc_a4','nh4_a4','num_a4','dst_a5','so4_a5','nh4_a5','num_a5','ncl_a6','so4_a6','nh4_a6','num_a6','dst_a7','so4_a7','nh4_a7','num_a7','soa1_a1','soa1_a2','soa2_a1','soa2_a2','soa3_a1','soa3_a2','soa4_a1','soa4_a2','soa5_a1','soa5_a2','soaff1_a1','soaff2_a1','soaff3_a1','soaff4_a1','soaff5_a1','soabb1_a1','soabb2_a1','soabb3_a1','soabb4_a1','soabb5_a1','soabg1_a1','soabg2_a1','soabg3_a1','soabg4_a1','soabg5_a1','soaff1_a2','soaff2_a2','soaff3_a2','soaff4_a2','soaff5_a2','soabb1_a2','soabb2_a2','soabb3_a2','soabb4_a2','soabb5_a2','soabg1_a2','soabg2_a2','soabg3_a2','soabg4_a2','soabg5_a2' diff --git a/src/chemistry/geoschem/chemistry.F90 b/src/chemistry/geoschem/chemistry.F90 index f1bff359d2..eda8b869a0 100644 --- a/src/chemistry/geoschem/chemistry.F90 +++ b/src/chemistry/geoschem/chemistry.F90 @@ -193,10 +193,9 @@ logical function chem_is (name) use mo_chem_utls, only : utls_chem_is - chem_is = .false. - IF ( to_upper(name) == 'GEOSCHEM' ) THEN - chem_is = .true. - ENDIF + character(len=*), intent(in) :: name + + chem_is = utls_chem_is(name) end function chem_is @@ -275,7 +274,6 @@ subroutine chem_register ! hplin 2020-05-16: Call set_sim_dat to populate chemistry constituent information ! from mo_sim_dat.F90 in other places. This is needed for HEMCO_CESM. CALL Set_sim_dat() - IF ( MasterProc ) Write(iulog,*) 'GCCALL after set_sim_dat' ! Prevent Reporting IO%amIRoot = .False. @@ -714,7 +712,9 @@ subroutine chem_readnl(nlfile) srf_emis_fixed_tod, & srf_emis_type - nIgnored = 0 + ! ghg chem + + namelist /chem_inparm/ bndtvg, h2orates, ghg_chem ALLOCATE(drySpc_ndx(nddvels), STAT=IERR) IF ( IERR .NE. 0 ) CALL ENDRUN('Failed to allocate drySpc_ndx') @@ -915,6 +915,7 @@ function chem_is_active() !----------------------------------------------------------------------- logical :: chem_is_active !----------------------------------------------------------------------- + chem_is_active = .true. end function chem_is_active @@ -1214,14 +1215,14 @@ subroutine chem_init(phys_state, pbuf2d) DO I = BEGCHUNK, ENDCHUNK - ! Initialize fields of the Grid State object - CALL Init_State_Grid( Input_Opt = Input_Opt, & - State_Grid = State_Grid(I), & - RC = RC ) + ! Initialize fields of the Grid State object + CALL Init_State_Grid( Input_Opt = Input_Opt, & + State_Grid = State_Grid(I), & + RC = RC ) IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Error encountered within call to "Init_State_Grid"!' - CALL Error_Stop( ErrMsg, ThisLoc ) + ErrMsg = 'Error encountered within call to "Init_State_Grid"!' + CALL Error_Stop( ErrMsg, ThisLoc ) ENDIF State_Grid(I)%NX = nX @@ -1229,14 +1230,13 @@ subroutine chem_init(phys_state, pbuf2d) State_Grid(I)%NZ = nZ ! Initialize GEOS-Chem horizontal grid structure - CALL GC_Init_Grid( am_I_Root = am_I_Root, & - Input_Opt = Input_Opt, & + CALL GC_Init_Grid( Input_Opt = Input_Opt, & State_Grid = State_Grid(I), & RC = RC ) IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Error encountered within call to "GC_Init_Grid"!' - CALL Error_Stop( ErrMsg, ThisLoc ) + ErrMsg = 'Error encountered within call to "GC_Init_Grid"!' + CALL Error_Stop( ErrMsg, ThisLoc ) ENDIF ! Define more variables for State_Grid @@ -1245,9 +1245,9 @@ subroutine chem_init(phys_state, pbuf2d) ! Set maximum number of levels in the chemistry grid IF ( Input_Opt%LUCX ) THEN - State_Grid(I)%MaxChemLev = State_Grid(I)%MaxStratLev + State_Grid(I)%MaxChemLev = State_Grid(I)%MaxStratLev ELSE - State_Grid(I)%MaxChemLev = State_Grid(I)%MaxTropLev + State_Grid(I)%MaxChemLev = State_Grid(I)%MaxTropLev ENDIF ENDDO @@ -1288,7 +1288,7 @@ subroutine chem_init(phys_state, pbuf2d) IF ( MasterProc ) THEN ! Read data in to Input_Opt%Linoz_TParm - CALL Linoz_Read( MasterProc, Input_Opt, RC ) + CALL Linoz_Read( Input_Opt, RC ) IF ( RC /= GC_SUCCESS ) THEN ErrMsg = 'Error encountered in "Linoz_Read"!' CALL Error_Stop( ErrMsg, ThisLoc ) @@ -1305,7 +1305,6 @@ subroutine chem_init(phys_state, pbuf2d) IF ( ALLOCATED( linozData ) ) DEALLOCATE(linozData) ENDIF - ! Note: The following calculations do not setup the gridcell areas. ! In any case, we will need to be constantly updating this grid ! to compensate for the "multiple chunks per processor" element @@ -1352,13 +1351,13 @@ subroutine chem_init(phys_state, pbuf2d) latEdgeArr(nX+1,J) = REAL((latVal) * PI_180, f4) ENDDO - CALL SetGridFromCtrEdges( am_I_Root = MasterProc, & + CALL SetGridFromCtrEdges( Input_Opt = Input_Opt, & State_Grid = State_Grid(L), & lonCtr = lonMidArr, & latCtr = latMidArr, & lonEdge = lonEdgeArr, & latEdge = latEdgeArr, & - RC = RC ) + RC = RC ) IF ( RC /= GC_SUCCESS ) THEN ErrMsg = 'Error encountered in "SetGridFromCtrEdges"!' @@ -1371,7 +1370,6 @@ subroutine chem_init(phys_state, pbuf2d) IF ( ALLOCATED( lonEdgeArr ) ) DEALLOCATE( lonEdgeArr ) IF ( ALLOCATED( latEdgeArr ) ) DEALLOCATE( latEdgeArr ) - ! Set the times held by "time_mod" CALL Accept_External_Date_Time( value_NYMDb = Input_Opt%NYMDb, & value_NHMSb = Input_Opt%NHMSb, & @@ -1380,6 +1378,7 @@ subroutine chem_init(phys_state, pbuf2d) value_NYMD = Input_Opt%NYMDb, & value_NHMS = Input_Opt%NHMSb, & RC = RC ) + IF ( RC /= GC_SUCCESS ) THEN ErrMsg = 'Error encountered in "Accept_External_Date_Time"!' CALL Error_Stop( ErrMsg, ThisLoc ) @@ -1423,7 +1422,7 @@ subroutine chem_init(phys_state, pbuf2d) ENDIF DO I = BEGCHUNK, ENDCHUNK - am_I_Root = (MasterProc .AND. (I == BEGCHUNK)) + Input_Opt%amIRoot = (MasterProc .AND. (I == BEGCHUNK)) CALL GC_Init_StateObj( Diag_List = Diag_List, & ! Diagnostic list obj TaggedDiag_List = TaggedDiag_List, & ! TaggedDiag list obj @@ -1560,8 +1559,8 @@ subroutine chem_init(phys_state, pbuf2d) Ap_CAM_Flip = 0.0e+0_fp Bp_CAM_Flip = 0.0e+0_fp DO I = 1, nZ+1 - Ap_CAM_Flip(I) = hyai(nZ+2-I) * ps0 * 0.01e+0_r8 - Bp_CAM_Flip(I) = hybi(nZ+2-I) + Ap_CAM_Flip(I) = hyai(nZ+2-I) * ps0 * 0.01e+0_r8 + Bp_CAM_Flip(I) = hybi(nZ+2-I) ENDDO !----------------------------------------------------------------- @@ -1591,56 +1590,26 @@ subroutine chem_init(phys_state, pbuf2d) IF ( ALLOCATED( Ap_CAM_Flip ) ) DEALLOCATE( Ap_CAM_Flip ) IF ( ALLOCATED( Bp_CAM_Flip ) ) DEALLOCATE( Bp_CAM_Flip ) - !! Initialize HEMCO? - !CALL Emissions_Init ( am_I_Root = MasterProc, & - ! Input_Opt = Input_Opt, & - ! State_Met = State_Met, & - ! State_Chm = State_Chm, & - ! State_Grid = State_Grid, & - ! State_Met = State_Met, & - ! RC = RC, & - ! HcoConfig = HcoConfig ) - ! - !IF ( RC /= GC_SUCCESS ) THEN - ! ErrMsg = 'Error encountered in "Emissions_Init"!' - ! CALL Error_Stop( ErrMsg, ThisLoc ) - !ENDIF - ! + ! Once the initial met fields have been read in, we need to find + ! the maximum PBL level for the non-local mixing algorithm. + CALL Max_PblHt_For_Vdiff( Input_Opt = Input_Opt, & + State_Grid = State_Grid(BEGCHUNK), & + State_Met = State_Met(BEGCHUNK), & + RC = RC ) -!#if ( ALLDDVEL_GEOSCHEM && LANDTYPE_HEMCO ) -! ! Populate the State_Met%LandTypeFrac field with data from HEMCO -! CALL Init_LandTypeFrac( am_I_Root = MasterProc, & -! Input_Opt = Input_Opt, & -! State_Met = State_Met(BEGCHUNK), & -! RC = RC ) -! -! IF ( RC /= GC_SUCCESS ) THEN -! ErrMsg = 'Error encountered in "Init_LandTypeFrac"!' -! CALL Error_Stop( ErrMsg, ThisLoc ) -! ENDIF -! -! ! Compute the Olson landmap fields of State_Met -! ! (e.g. State_Met%IREG, State_Met%ILAND, etc.) -! CALL Compute_Olson_Landmap( am_I_Root = MasterProc, & -! Input_Opt = Input_Opt, & -! State_Grid = State_Grid(BEGCHUNK), & -! State_Met = State_Met(BEGCHUNK), & -! RC = RC ) -! -! IF ( RC /= GC_SUCCESS ) THEN -! ErrMsg = 'Error encountered in "Compute_Olson_Landmap"!' -! CALL Error_Stop( ErrMsg, ThisLoc ) -! ENDIF -!#endif + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Max_PblHt_for_Vdiff"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF IF ( Input_Opt%Its_A_FullChem_Sim .OR. & Input_Opt%Its_An_Aerosol_Sim ) THEN - ! This also initializes Fast-JX - CALL Init_Chemistry( Input_Opt = Input_Opt, & - & State_Chm = State_Chm(BEGCHUNK), & - & State_Diag = State_Diag(BEGCHUNK), & - & State_Grid = State_Grid(BEGCHUNK), & - & RC = RC ) + ! This also initializes Fast-JX + CALL Init_Chemistry( Input_Opt = Input_Opt, & + State_Chm = State_Chm(BEGCHUNK), & + State_Diag = State_Diag(BEGCHUNK), & + State_Grid = State_Grid(BEGCHUNK), & + RC = RC ) IF ( RC /= GC_SUCCESS ) THEN ErrMsg = 'Error encountered in "Init_Chemistry"!' @@ -3101,47 +3070,6 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) ! Dimensions : nX, nY, nZ State_Met(LCHNK)%OPTD = State_Met(LCHNK)%TAUCLI + State_Met(LCHNK)%TAUCLW - ! Determine current date and time - CALL Get_Curr_Date( yr = currYr, & - mon = currMo, & - day = currDy, & - tod = currTOD ) - - ! For now, force year to be 2000 - currYr = 2000 - currYMD = (currYr*1000) + (currMo*100) + (currDy) - ! Deal with subdaily - currUTC = REAL(currTOD,f4)/3600.0e+0_f4 - currSc = 0 - currMn = 0 - currHr = 0 - DO WHILE (currTOD > 3600) - currTOD = currTOD - 3600 - currHr = currHr + 1 - ENDDO - DO WHILE (currTOD > 60) - currTOD = currTOD - 60 - currMn = currMn + 1 - ENDDO - currSc = currTOD - currHMS = (currHr*1000) + (currMn*100) + (currSc) - - IF ( firstDay ) THEN - newDay = .True. - newMonth = .True. - firstDay = .False. - ELSE IF ( currHMS < dT ) THEN - newDay = .True. - IF ( currDy == 1 ) THEN - newMonth = .True. - ELSE - newMonth = .False. - ENDIF - ELSE - newDay = .False. - newMonth = .False. - ENDIF - ! Pass time values obtained from the ESMF environment to GEOS-Chem CALL Accept_External_Date_Time( value_NYMD = currYMD, & value_NHMS = currHMS, & @@ -3635,130 +3563,53 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) CALL Error_Stop( ErrMsg, ThisLoc ) ENDIF -#if ( OCNDDVEL_GEOSCHEM ) - - DO N = 1, nddvels - - !! Print debug - !IF ( rootChunk ) THEN - ! IF ( N == 1 ) THEN - ! Write(iulog,*) "Number of GC dry deposition species = ", & - ! SIZE(State_Chm(LCHNK)%DryDepVel(:,:,:),3) - ! Write(iulog,*) "Number of CESM dry deposition species = ", & - ! nddvels - ! ENDIF - ! Write(iulog,*) "N = ", N - ! Write(iulog,*) "drySpc_ndx = ", drySpc_ndx(N) - ! Write(iulog,*) "GC index = ", map2GC_dryDep(N) - ! IF ( map2GC_dryDep(N) > 0 ) THEN - ! Write(iulog,*) "GC name = ", TRIM(DEPNAME(map2GC_dryDep(N))) - ! ENDIF - ! Write(iulog,*) "dry Species= ", TRIM(drydep_list(N)) - ! IF ( drySpc_ndx(N) > 0 ) THEN - ! Write(iulog,*) "tracerName = ", TRIM(tracerNames(drySpc_ndx(N))) - ! ENDIF - ! Write(iulog,*) "CLM-depVel = ", & - ! MAXVAL(cam_in%depvel(:nY,N)) * 1.0e-02_fp, " [m/s]" - ! IF ( map2GC_dryDep(N) > 0 ) THEN - ! Write(iulog,*) "GC-depVel = ", & - ! MAXVAL(State_Chm(LCHNK)%DryDepVel(1,:nY,map2GC_dryDep(N))), " [m/s]" - ! ENDIF - !ENDIF - - IF ( map2GC_dryDep(N) > 0 ) THEN - ! State_Chm%DryDepVel is in m/s - State_Chm(LCHNK)%DryDepVel(1,:nY,map2GC_dryDep(N)) = & - ! This first bit corresponds to the dry deposition - ! velocities over land as computed from CLM and - ! converted to m/s. This is scaled by the fraction - ! of land. - cam_in%depVel(:nY,N) * 1.0e-02_fp & - * MAX(0._fp, 1.0_fp - State_Met(LCHNK)%FROCEAN(1,:nY)) & - ! This second bit corresponds to the dry deposition - ! velocities over ocean and sea ice as computed from - ! GEOS-Chem. This is scaled by the fraction of ocean - ! and sea ice. - + State_Chm(LCHNK)%DryDepVel(1,:nY,map2GC_dryDep(N)) & - * State_Met(LCHNK)%FROCEAN(1,:nY) - ENDIF - ENDDO - -#endif - -#elif ( OCNDDVEL_MOZART ) - ! This routine updates the deposition velocities from CLM in the - ! pointer lnd(LCHNK)%dvel as long as drydep_method == DD_XLND is - ! True. - CALL drydep_update( State, cam_in ) - - windSpeed(:nY) = SQRT( state%U(:nY,nZ)*state%U(:nY,nZ) + & - state%V(:nY,nZ)*state%V(:nY,nZ) ) - potT(:nY) = state%t(:nY,nZ) * (1._fp + qH2O(:nY,nZ)) - - CALL get_lat_all_p( LCHNK, nY, latndx ) - CALL get_lon_all_p( LCHNK, nY, lonndx ) - - CALL drydep_fromlnd( ocnfrac = cam_in%ocnfrac(:), & - icefrac = cam_in%icefrac(:), & - ncdate = currYMD, & - sfc_temp = cam_in%TS(:), & - pressure_sfc = state%PS(:), & - wind_speed = windSpeed(:), & - spec_hum = qH2O(:,nZ), & - air_temp = state%t(:,nZ), & - pressure_10m = state%pmid(:,nZ), & - rain = State_Met(LCHNK)%PRECTOT(1,:), & - snow = cam_in%Snowhland(:), & - solar_flux = State_Met(LCHNK)%SWGDN(1,:), & - dvelocity = MOZART_depVel(:,:), & - dflx = MOZART_depFlx(:,:), & - State_Chm = State_Chm(LCHNK), & - tv = potT(:), & - soilw = -99._fp, & - rh = relHum(:,nZ), & - ncol = nY, & - lonndx = lonndx(:), & - latndx = latndx(:), & - lchnk = LCHNK ) - - DO N = 1, nddvels - - !! Print debug - !IF ( rootChunk ) THEN - ! IF ( N == 1 ) THEN - ! Write(iulog,*) "Number of GC dry deposition species = ", & - ! SIZE(State_Chm(LCHNK)%DryDepVel(:,:,:),3) - ! Write(iulog,*) "Number of CESM dry deposition species = ", & - ! nddvels - ! ENDIF - ! Write(iulog,*) "N = ", N - ! Write(iulog,*) "drySpc_ndx = ", drySpc_ndx(N) - ! Write(iulog,*) "GC index = ", map2GC_dryDep(N) - ! IF ( map2GC_dryDep(N) > 0 ) THEN - ! Write(iulog,*) "GC name = ", TRIM(DEPNAME(map2GC_dryDep(N))) - ! ENDIF - ! Write(iulog,*) "dry Species= ", TRIM(drydep_list(N)) - ! IF ( drySpc_ndx(N) > 0 ) THEN - ! Write(iulog,*) "tracerName = ", TRIM(tracerNames(drySpc_ndx(N))) - ! ENDIF - ! Write(iulog,*) "CLM-depVel = ", & - ! MAXVAL(cam_in%depvel(:nY,N)) * 1.0e-02_fp, " [m/s]", LCHNK - ! IF ( drySpc_ndx(N) > 0 ) THEN - ! Write(iulog,*) "Merged depVel = ", & - ! MAXVAL(MOZART_depVel(:nY,drySpc_ndx(N))) * 1.0e-02_fp, " [m/s]", LCHNK - ! ENDIF - !ENDIF - - IF ( ( map2GC_dryDep(N) > 0 ) .AND. ( drySpc_ndx(N) > 0 ) ) THEN - ! State_Chm%DryDepVel is in m/s - State_Chm(LCHNK)%DryDepVel(1,:nY,map2GC_dryDep(N)) = & - MOZART_depVel(:nY,drySpc_ndx(N)) * 1.0e-02_fp - ENDIF - - ENDDO - - !TMMF, Here set dry deposition velocities to zero if MAM performs its - !own deposition... + IF ( Input_Opt%ddVel_CLM ) THEN + DO N = 1, nddvels + + !! Print debug + !IF ( rootChunk ) THEN + ! IF ( N == 1 ) THEN + ! Write(iulog,*) "Number of GC dry deposition species = ", & + ! SIZE(State_Chm(LCHNK)%DryDepVel(:,:,:),3) + ! Write(iulog,*) "Number of CESM dry deposition species = ", & + ! nddvels + ! ENDIF + ! Write(iulog,*) "N = ", N + ! Write(iulog,*) "drySpc_ndx = ", drySpc_ndx(N) + ! Write(iulog,*) "GC index = ", map2GC_dryDep(N) + ! IF ( map2GC_dryDep(N) > 0 ) THEN + ! Write(iulog,*) "GC name = ", TRIM(DEPNAME(map2GC_dryDep(N))) + ! ENDIF + ! Write(iulog,*) "dry Species= ", TRIM(drydep_list(N)) + ! IF ( drySpc_ndx(N) > 0 ) THEN + ! Write(iulog,*) "tracerName = ", TRIM(tracerNames(drySpc_ndx(N))) + ! ENDIF + ! Write(iulog,*) "CLM-depVel = ", & + ! MAXVAL(cam_in%depvel(:nY,N)) * 1.0e-02_fp, " [m/s]" + ! IF ( map2GC_dryDep(N) > 0 ) THEN + ! Write(iulog,*) "GC-depVel = ", & + ! MAXVAL(State_Chm(LCHNK)%DryDepVel(1,:nY,map2GC_dryDep(N))), " [m/s]" + ! ENDIF + !ENDIF + + IF ( map2GC_dryDep(N) > 0 ) THEN + ! State_Chm%DryDepVel is in m/s + State_Chm(LCHNK)%DryDepVel(1,:nY,map2GC_dryDep(N)) = & + ! This first bit corresponds to the dry deposition + ! velocities over land as computed from CLM and + ! converted to m/s. This is scaled by the fraction + ! of land. + cam_in%depVel(:nY,N) * 1.0e-02_fp & + * MAX(0._fp, 1.0_fp - State_Met(LCHNK)%FROCEAN(1,:nY)) & + ! This second bit corresponds to the dry deposition + ! velocities over ocean and sea ice as computed from + ! GEOS-Chem. This is scaled by the fraction of ocean + ! and sea ice. + + State_Chm(LCHNK)%DryDepVel(1,:nY,map2GC_dryDep(N)) & + * State_Met(LCHNK)%FROCEAN(1,:nY) + ENDIF + ENDDO + ENDIF CALL Update_DryDepFreq( Input_Opt = Input_Opt, & State_Chm = State_Chm(LCHNK), & @@ -3769,36 +3620,6 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) ENDIF - !!=========================================================== - !! ***** E M I S S I O N S ***** - !! - !! NOTE: For a complete description of how emissions from - !! HEMCO are added into GEOS-Chem (and how they are mixed - !! into the boundary layer), please see the wiki page: - !! - !! http://wiki-geos-chem.org/Distributing_emissions_in_the_PBL - !!=========================================================== - ! - !! EMISSIONS_RUN will call HEMCO run phase 2. HEMCO run phase - !! only calculates emissions. All data has been read to disk - !! in phase 1 at the beginning of the time step. - !! (ckeller, 4/1/15) - !CALL Emissions_Run( Input_Opt = Input_Opt, & - ! State_Chm = State_Chmk(LCHNK), & - ! State_Diag = State_Diag(LCHNK), & - ! State_Grid = State_Grid(LCHNK), & - ! State_Met = State_Met(LCHNK), & - ! TimeForEmis = TimeForEmis, & - ! Phase = 2, & - ! RC = RC ) - ! - !! Trap potential errors - !IF ( RC /= GC_SUCCESS ) THEN - ! ErrMsg = - ! 'Error encountered in "Emissions_Run"! after drydep!' - ! CALL Error_Stop( ErrMsg, ThisLoc ) - !ENDIF - !=========================================================== ! ***** M I X E D L A Y E R M I X I N G ***** !=========================================================== @@ -3911,20 +3732,20 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) IF ( Input_Opt%Its_A_FullChem_Sim .OR. & Input_Opt%Its_An_Aerosol_Sim ) THEN - IF ( Input_Opt%LChem ) THEN - CALL Compute_Overhead_O3( Input_Opt = Input_Opt, & - State_Grid = State_Grid(LCHNK), & - State_Chm = State_Chm(LCHNK), & - DAY = currDy, & - USE_O3_FROM_MET = Input_Opt%Use_O3_From_Met, & - TO3 = State_Met(LCHNK)%TO3, & - RC = RC ) - - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Error encountered in "Compute_Overhead_O3"!' - CALL Error_Stop( ErrMsg, ThisLoc ) - ENDIF - ENDIF + IF ( Input_Opt%LChem ) THEN + CALL Compute_Overhead_O3( Input_Opt = Input_Opt, & + State_Grid = State_Grid(LCHNK), & + State_Chm = State_Chm(LCHNK), & + DAY = currDy, & + USE_O3_FROM_MET = Input_Opt%Use_O3_From_Met, & + TO3 = State_Met(LCHNK)%TO3, & + RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Compute_Overhead_O3"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + ENDIF ENDIF IF ( Input_Opt%Its_A_Fullchem_Sim .and. iH2O > 0 ) THEN @@ -4415,7 +4236,7 @@ subroutine chem_init_cnst(name, latvals, lonvals, mask, q) ! Will need a simple mapping structure as well as the CAM tracer registration ! routines. - INTEGER :: ILEV, NLEV, I + INTEGER :: ilev, nlev, M REAL(r8) :: QTemp, Min_MMR nlev = SIZE(q, 2) @@ -4518,10 +4339,10 @@ subroutine chem_final ! Loop over each chunk and cleanup the variables DO I = BEGCHUNK, ENDCHUNK - CALL Cleanup_State_Chm ( State_Chm(I), RC ) - CALL Cleanup_State_Diag( State_Diag(I), RC ) - CALL Cleanup_State_Grid( State_Grid(I), RC ) - CALL Cleanup_State_Met ( State_Met(I), RC ) + CALL Cleanup_State_Chm ( State_Chm(I), RC ) + CALL Cleanup_State_Diag( State_Diag(I), RC ) + CALL Cleanup_State_Grid( State_Grid(I), RC ) + CALL Cleanup_State_Met ( State_Met(I), RC ) ENDDO CALL Cleanup_Error @@ -4534,7 +4355,6 @@ subroutine chem_final IF ( ALLOCATED( slvd_Lst ) ) DEALLOCATE( slvd_Lst ) IF ( ALLOCATED( slvd_ref_MMR ) ) DEALLOCATE( slvd_ref_MMR ) - RETURN end subroutine chem_final @@ -4625,40 +4445,14 @@ subroutine chem_emissions( state, cam_in ) nY = state%NCOL rootChunk = ( MasterProc.and.(LCHNK.EQ.BEGCHUNK) ) - sflx(:,:) = 0.0e+0_r8 - - DO N = 1, nTracers - - fldname_ns = 'HCO_' // TRIM(tracerNames(N)) - tmpIdx = pbuf_get_index(fldname_ns, RC) - IF ( tmpIdx < 0 ) THEN - IF ( rootChunk ) Write(iulog,*) "chem_emissions hemco: Field not found ", TRIM(fldname_ns) - ELSE - ! This is already in chunk, retrieve it - pbuf_chnk => pbuf_get_chunk(hco_pbuf2d, LCHNK) - CALL pbuf_get_field(pbuf_chnk, tmpIdx, pbuf_ik) - - IF ( .NOT. ASSOCIATED(pbuf_ik) ) THEN ! Sanity check - CALL ENDRUN("chem_emissions: FATAL - tmpIdx > 0 but pbuf_ik not associated") - ENDIF - - ! For each column retrieve data from pbuf_ik(I,K) - sflx(1:ncol,N) = pbuf_ik(1:ncol,pver) ! Only surface emissions for now, - - ! Reset pointers - pbuf_ik => NULL() - pbuf_chnk => NULL() - - M = map2GCinv(N) - - IF ( M <= 0 ) CYCLE + !----------------------------------------------------------------------- + ! Reset surface fluxes + !----------------------------------------------------------------------- - cam_in%cflx(1:ncol,M) = sflx(1:ncol,N) - If ( MAXVAL(sflx(1:ncol,N)) > 0.0e+0_fp ) & - Write(iulog,*) "chem_emissions: debug added emiss for ", & - TRIM(cnst_name(M)), MAXVAL(sflx(1:ncol,N)), " from ", TRIM(fldname_ns), & - ". Total emission flux is: ", MAXVAL(cam_in%cflx(1:ncol,M)) - ENDIF + DO M = iFirstCnst, pcnst + !N = map2chm(M) + !IF ( N > 0 ) cam_in%cflx(1:nY,N) = 0.0e+0_r8 + cam_in%cflx(1:nY,M) = 0.0e+0_r8 ENDDO end subroutine chem_emissions From 62bb87d1c804ccf7bbca9cdd1104d679e48e0602 Mon Sep 17 00:00:00 2001 From: Thibaud Fritz Date: Thu, 9 Dec 2021 09:50:55 +0100 Subject: [PATCH 014/291] Feat: Return in sox_cldaero_mod if running with GEOS-Chem This prevents the code from double counting in-cloud sulfur oxidation Signed-off-by: Thibaud Fritz --- src/chemistry/modal_aero/sox_cldaero_mod.F90 | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/src/chemistry/modal_aero/sox_cldaero_mod.F90 b/src/chemistry/modal_aero/sox_cldaero_mod.F90 index bacf94246c..589c881279 100644 --- a/src/chemistry/modal_aero/sox_cldaero_mod.F90 +++ b/src/chemistry/modal_aero/sox_cldaero_mod.F90 @@ -7,6 +7,7 @@ module sox_cldaero_mod use cam_abortutils, only : endrun use ppgrid, only : pcols, pver use mo_chem_utls, only : get_spc_ndx + use mo_chem_utls, only: utls_chem_is use cldaero_mod, only : cldaero_conc_t, cldaero_allocate, cldaero_deallocate use modal_aero_data, only : ntot_amode, modeptr_accum, lptr_so4_cw_amode, lptr_msa_cw_amode use modal_aero_data, only : numptrcw_amode, lptr_nh4_cw_amode @@ -229,6 +230,12 @@ subroutine sox_cldaero_update( & dqdt_aqhprxn(:,:) = 0.0_r8 dqdt_aqo3rxn(:,:) = 0.0_r8 + ! Avoid double counting in-cloud sulfur oxidation when running with + ! GEOS-Chem (CESM2-GC). If running with CESM2-GC, sulfur oxidation + ! 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 ( utls_chem_is('GEOS-Chem') ) return + lev_loop: do k = 1,pver col_loop: do i = 1,ncol cloud: if (cldfrc(i,k) >= 1.0e-5_r8) then From 515ad9a80c75c863643ad0ca211ae287287f3ebb Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Mon, 13 Dec 2021 07:22:01 -0700 Subject: [PATCH 015/291] Fix: correct wrong indexes introduced by manual revert; rm GC wetscav Signed-off-by: Lizzie Lundgren --- src/chemistry/geoschem/gas_wetdep_opts.F90 | 3 +-- src/chemistry/pp_trop_strat_mam4_vbs/mo_sim_dat.F90 | 4 ++-- src/chemistry/pp_trop_strat_mam4_vbsext/mo_sim_dat.F90 | 4 ++-- 3 files changed, 5 insertions(+), 6 deletions(-) diff --git a/src/chemistry/geoschem/gas_wetdep_opts.F90 b/src/chemistry/geoschem/gas_wetdep_opts.F90 index 908e352239..614eb50727 100644 --- a/src/chemistry/geoschem/gas_wetdep_opts.F90 +++ b/src/chemistry/geoschem/gas_wetdep_opts.F90 @@ -69,9 +69,8 @@ subroutine gas_wetdep_readnl(nlfile) if (( gas_wetdep_cnt>0 ).and. & ( .not.(gas_wetdep_method=='MOZ' .or. & gas_wetdep_method=='NEU' .or. & - gas_wetdep_method=='GEOS-CHEM' .or. & gas_wetdep_method=='OFF') )) then - call endrun('gas_wetdep_readnl; gas_wetdep_method must be set to either MOZ, NEU or GEOS-CHEM') + call endrun('gas_wetdep_readnl; gas_wetdep_method must be set to either MOZ or NEU') endif end subroutine gas_wetdep_readnl diff --git a/src/chemistry/pp_trop_strat_mam4_vbs/mo_sim_dat.F90 b/src/chemistry/pp_trop_strat_mam4_vbs/mo_sim_dat.F90 index 8ed889ffe6..68d5d53160 100644 --- a/src/chemistry/pp_trop_strat_mam4_vbs/mo_sim_dat.F90 +++ b/src/chemistry/pp_trop_strat_mam4_vbs/mo_sim_dat.F90 @@ -246,12 +246,12 @@ subroutine set_sim_dat 1278,1291,1304,1327,1352,1507,1549,1640,1691,1716, & 1739,1845,1876,1900,1935,1993,2054,2080 /) - extfrc_lst(: 24) = (/ 'so4_a1 ','bc_a4 ','SVOC ','bc_a1 ','CO ', & + extfrc_lst(: 16) = (/ 'so4_a1 ','bc_a4 ','SVOC ','bc_a1 ','CO ', & 'NO ','NO2 ','num_a1 ','num_a2 ','num_a4 ', & 'pom_a1 ','pom_a4 ','so4_a2 ','SO2 ','AOA_NH ',& 'N ' /) - frc_from_dataset(: 24) = (/ .true., .true., .true., .true., .true., & + frc_from_dataset(: 16) = (/ .true., .true., .true., .true., .true., & .true., .true., .true., .true., .true., & .true., .true., .true., .true., .false., & .false. /) diff --git a/src/chemistry/pp_trop_strat_mam4_vbsext/mo_sim_dat.F90 b/src/chemistry/pp_trop_strat_mam4_vbsext/mo_sim_dat.F90 index b58866a13a..4afb77bfb4 100644 --- a/src/chemistry/pp_trop_strat_mam4_vbsext/mo_sim_dat.F90 +++ b/src/chemistry/pp_trop_strat_mam4_vbsext/mo_sim_dat.F90 @@ -269,12 +269,12 @@ subroutine set_sim_dat 1395,1418,1513,1538,1698,1722,1764,1822,1873,1934, & 1959,1986,2017,2052,2078 /) - extfrc_lst(: 26) = (/ 'bc_a1 ','bc_a4 ','CO ','NO ','NO2 ', & + extfrc_lst(: 18) = (/ 'bc_a1 ','bc_a4 ','CO ','NO ','NO2 ', & 'num_a1 ','num_a2 ','num_a4 ','SO2 ','so4_a1 ', & 'so4_a2 ','SVOCbb ','SVOCff ','pomff1_a4 ','pombb1_a4 ', & 'AOA_NH ','N ','OH ' /) - frc_from_dataset(: 26) = (/ .true., .true., .true., .true., .true., & + frc_from_dataset(: 18) = (/ .true., .true., .true., .true., .true., & .true., .true., .true., .true., .true., & .true., .true., .true., .true., .true., & .false., .false., .false. /) From 71fb83adfdb9be465f84a3b9661281a2f2e015c7 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Mon, 7 Feb 2022 08:58:18 -0700 Subject: [PATCH 016/291] Enable compilation in CESM 2.3 for non-GEOS-Chem case This commit includes: 1. Syntax bug fixes in perl file ChemNamelist.pm 2. Setting perl smartmatch to experimental in ChemNamelist.pm to avoid perl version dependent build error for use of '~~' (checks if item is in array) 3. Remove CAM imports lwtgcell, pwtgcell, and lai that are used for GEOS-Chem dry deposition velocity calculation. In a future update GEOS-Chem will no longer calculate dry deposition velocity when run in CESM so these imports are not needed. Signed-off-by: Lizzie Lundgren --- bld/perl5lib/Build/ChemNamelist.pm | 4 +++- src/control/camsrfexch.F90 | 31 +----------------------------- 2 files changed, 4 insertions(+), 31 deletions(-) diff --git a/bld/perl5lib/Build/ChemNamelist.pm b/bld/perl5lib/Build/ChemNamelist.pm index 5a9891faad..88d573afe1 100644 --- a/bld/perl5lib/Build/ChemNamelist.pm +++ b/bld/perl5lib/Build/ChemNamelist.pm @@ -1,5 +1,7 @@ package Build::ChemNamelist; +no if $] >= 5.017011, warnings => 'experimental::smartmatch'; + #------------------------------------------------------------------------------------- # generates species lists for chemistry namelist settings #------------------------------------------------------------------------------------- @@ -313,7 +315,7 @@ sub get_dep_list #------------------------------------------------------------------------------- sub filter_dep_list { - my ( $input_list, $print_lvl, @species_list_ref, $nottransported_list_ref ) = @_; + my ( $input_list, $print_lvl, $species_list_ref, $nottransported_list_ref ) = @_; if ($print_lvl>=2){ print "Filtering deposition species list \n"; } diff --git a/src/control/camsrfexch.F90 b/src/control/camsrfexch.F90 index c4fa59d797..f6dc1239fc 100644 --- a/src/control/camsrfexch.F90 +++ b/src/control/camsrfexch.F90 @@ -117,9 +117,6 @@ module camsrfexch real(r8), pointer, dimension(:) :: fv !friction velocity (m/s) (pcols) real(r8), pointer, dimension(:) :: soilw !volumetric soil water (m3/m3) real(r8), pointer, dimension(:,:) :: depvel ! deposition velocities - real(r8), pointer, dimension(:,:) :: lwtgcell ! landunit areas - real(r8), pointer, dimension(:,:) :: pwtgcell ! patch areas - real(r8), pointer, dimension(:,:) :: lai ! leaf area indices real(r8), pointer, dimension(:,:) :: dstflx ! dust fluxes real(r8), pointer, dimension(:,:) :: meganflx ! MEGAN fluxes real(r8), pointer, dimension(:,:) :: fireflx ! wild fire emissions @@ -135,7 +132,7 @@ subroutine hub2atm_alloc( cam_in ) ! Allocate space for the surface to atmosphere data type. And initialize ! the values. - use seq_drydep_mod, only: lnd_drydep, n_drydep, NLUse, NPatch + use seq_drydep_mod, only: lnd_drydep, n_drydep use shr_megan_mod, only: shr_megan_mechcomps_n use shr_fire_emis_mod,only: shr_fire_emis_mechcomps_n @@ -160,9 +157,6 @@ subroutine hub2atm_alloc( cam_in ) nullify(cam_in(c)%fv) nullify(cam_in(c)%soilw) nullify(cam_in(c)%depvel) - nullify(cam_in(c)%lwtgcell) - nullify(cam_in(c)%pwtgcell) - nullify(cam_in(c)%lai) nullify(cam_in(c)%dstflx) nullify(cam_in(c)%meganflx) nullify(cam_in(c)%fireflx) @@ -196,12 +190,6 @@ subroutine hub2atm_alloc( cam_in ) do c = begchunk,endchunk allocate (cam_in(c)%depvel(pcols,n_drydep), stat=ierror) if ( ierror /= 0 ) call endrun(sub//': allocation error depvel') - allocate (cam_in(c)%lwtgcell(pcols,NLUse), stat=ierror) - if ( ierror /= 0 ) call endrun(sub//': allocation error lwtgcell') - allocate (cam_in(c)%pwtgcell(pcols,NPatch), stat=ierror) - if ( ierror /= 0 ) call endrun(sub//': allocation error pwtgcell') - allocate (cam_in(c)%lai(pcols,NPatch), stat=ierror) - if ( ierror /= 0 ) call endrun(sub//': allocation error lai') end do endif @@ -258,11 +246,6 @@ subroutine hub2atm_alloc( cam_in ) if (lnd_drydep .and. n_drydep>0) then cam_in(c)%depvel (:,:) = 0._r8 endif - if (lnd_drydep) then - cam_in(c)%lwtgcell (:,:) = 0._r8 - cam_in(c)%pwtgcell (:,:) = 0._r8 - cam_in(c)%lai (:,:) = 0._r8 - endif if (active_Fall_flxfire .and. shr_fire_emis_mechcomps_n>0) then cam_in(c)%fireflx(:,:) = 0._r8 cam_in(c)%fireztop(:) = 0._r8 @@ -401,18 +384,6 @@ subroutine hub2atm_deallocate(cam_in) deallocate(cam_in(c)%depvel) nullify(cam_in(c)%depvel) end if - if(associated(cam_in(c)%lwtgcell)) then - deallocate(cam_in(c)%lwtgcell) - nullify(cam_in(c)%lwtgcell) - end if - if(associated(cam_in(c)%pwtgcell)) then - deallocate(cam_in(c)%pwtgcell) - nullify(cam_in(c)%pwtgcell) - end if - if(associated(cam_in(c)%lai)) then - deallocate(cam_in(c)%lai) - nullify(cam_in(c)%lai) - end if enddo From 9f80b02058fb11a4ddbd5379dc66a39909a51278 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Thu, 10 Feb 2022 12:50:27 -0700 Subject: [PATCH 017/291] Build fixes for CESM-GC within CESM: non-GEOS-Chem cases Signed-off-by: Lizzie Lundgren --- bld/config_files/definition.xml | 2 +- cime_config/buildcpp | 10 ---------- 2 files changed, 1 insertion(+), 11 deletions(-) diff --git a/bld/config_files/definition.xml b/bld/config_files/definition.xml index 08603ff741..a95c9d755e 100644 --- a/bld/config_files/definition.xml +++ b/bld/config_files/definition.xml @@ -98,7 +98,7 @@ meteor_smoke (Meteor Smoke), mixed_sulfate (Meteor Smoke and Sulfate), pmc (Pola 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). - + Chemistry package: trop_mam3 trop_mam4 trop_mam5 trop_mam7 trop_mozart trop_strat_mam4_ts2 trop_strat_mam4_vbs trop_strat_mam4_vbsext waccm_ma waccm_mad waccm_mad_mam4 waccm_ma_mam4 waccm_ma_sulfur waccm_sc waccm_sc_mam4 waccm_tsmlt_mam4 waccm_tsmlt_mam5 terminator GEOS-Chem none diff --git a/cime_config/buildcpp b/cime_config/buildcpp index d42f2ca70f..83b0548703 100644 --- a/cime_config/buildcpp +++ b/cime_config/buildcpp @@ -41,7 +41,6 @@ def buildcpp(case): nthrds_atm = case.get_value("NTHRDS_ATM") cam_config_opts = case.get_value("CAM_CONFIG_OPTS") comp_interface=case.get_value("COMP_INTERFACE") - clm_config_opts = case.get_value("CLM_CONFIG_OPTS") # added for CESM-GC # level information for CAM is part of the atm grid name - and must be stripped out nlev = '' @@ -118,15 +117,6 @@ def buildcpp(case): else: config_opts += ["-ocn", comp_ocn] - # Added for CESM-GC - if '-chem geoschem' in cam_config_opts: - if 'clm4_0' in clm_config_opts: - config_opts += ["-clm_vers", "CLM4.0"] - elif 'clm4_5' in clm_config_opts: - config_opts += ["-clm_vers", "CLM4.5"] - elif 'clm5_0' in clm_config_opts: - config_opts += ["-clm_vers", "CLM5.0"] - # Add user options. config_opts += cam_config_opts.split(" ") From 60e537a2ba8e358f7c4c7c78f73a2132528439de Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Wed, 16 Feb 2022 09:59:47 -0700 Subject: [PATCH 018/291] Update GEOS-Chem interface code for compatibility with CESM 2.3 Signed-off-by: Lizzie Lundgren --- src/chemistry/geoschem/cesmgc_emissions_mod.F90 | 8 ++++---- src/chemistry/geoschem/chemistry.F90 | 2 +- src/chemistry/geoschem/getLandTypes.F90 | 1 - 3 files changed, 5 insertions(+), 6 deletions(-) diff --git a/src/chemistry/geoschem/cesmgc_emissions_mod.F90 b/src/chemistry/geoschem/cesmgc_emissions_mod.F90 index 5489b0f043..f231d8dd8c 100644 --- a/src/chemistry/geoschem/cesmgc_emissions_mod.F90 +++ b/src/chemistry/geoschem/cesmgc_emissions_mod.F90 @@ -273,12 +273,12 @@ SUBROUTINE CESMGC_Emissions_Calc( state, hco_pbuf2d, State_Met, cam_in, eflx, iS USE STRING_UTILS, ONLY : to_upper USE PHYSCONSTANTS, ONLY : PI - ! Data from CLM - USE CAM_CPL_INDICES, ONLY : index_x2a_Fall_flxvoc - ! Lightning emissions USE MO_LIGHTNING, ONLY : prod_NO + ! MEGAN emissions + USE SRF_FIELD_CHECK, ONLY : active_Fall_flxvoc + ! Fire emissions USE FIRE_EMISSIONS, ONLY : fire_emissions_srf USE FIRE_EMISSIONS, ONLY : fire_emissions_vrt @@ -531,7 +531,7 @@ SUBROUTINE CESMGC_Emissions_Calc( state, hco_pbuf2d, State_Met, cam_in, eflx, iS ! MEGAN emissions ... !----------------------------------------------------------------------- - IF ( index_x2a_Fall_flxvoc > 0 .AND. shr_megan_mechcomps_n > 0 ) THEN + IF ( active_Fall_flxvoc > 0 .AND. shr_megan_mechcomps_n > 0 ) THEN ! set MEGAN fluxes DO N = 1, shr_megan_mechcomps_n DO J = 1, nY diff --git a/src/chemistry/geoschem/chemistry.F90 b/src/chemistry/geoschem/chemistry.F90 index eda8b869a0..f5ba122309 100644 --- a/src/chemistry/geoschem/chemistry.F90 +++ b/src/chemistry/geoschem/chemistry.F90 @@ -2528,7 +2528,7 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) ! Calculate RH (range 0-1, note still level 1 = TOA) relHum(:,:) = 0.0e+0_r8 - CALL QSat(state%t(:nY,:), state%pmid(:nY,:), satV, satQ) + CALL QSat(state%t(:nY,:), state%pmid(:nY,:), satV, satQ, state%NCOL,PVER) DO J = 1, nY DO L = 1, nZ relHum(J,L) = 0.622e+0_r8 * h2ovmr(J,L) / satQ(J,L) diff --git a/src/chemistry/geoschem/getLandTypes.F90 b/src/chemistry/geoschem/getLandTypes.F90 index 2a7ef31932..93e1030340 100644 --- a/src/chemistry/geoschem/getLandTypes.F90 +++ b/src/chemistry/geoschem/getLandTypes.F90 @@ -15,7 +15,6 @@ SUBROUTINE getLandTypes( cam_in, nY, State_Met ) ! USE camsrfexch, ONLY : cam_in_t USE State_Met_Mod, ONLY : MetState - USE seq_drydep_mod, ONLY : NPatch USE shr_kind_mod, ONLY : r8 => shr_kind_r8 USE PRECISION_MOD, ONLY : fp, f4 ! Flexible precision USE CMN_SIZE_Mod, ONLY : NSURFTYPE From a6c7cc649535968fbeee573d23e055c25d0918d2 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Fri, 4 Mar 2022 08:13:36 -0700 Subject: [PATCH 019/291] Fix bug in J-value diagnostic names for O3O1D Signed-off-by: Lizzie Lundgren --- bld/namelist_files/use_cases/hist_geoschem.xml | 2 +- bld/namelist_files/use_cases/sd_geoschem.xml | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/bld/namelist_files/use_cases/hist_geoschem.xml b/bld/namelist_files/use_cases/hist_geoschem.xml index 9eac1a5be6..6c20797422 100644 --- a/bld/namelist_files/use_cases/hist_geoschem.xml +++ b/bld/namelist_files/use_cases/hist_geoschem.xml @@ -129,7 +129,7 @@ 'MEG_MTPO', 'Dso4_a1CHM', 'Dso4_a2CHM', 'Dso4_a3CHM', 'DO3CHM', 'DCOCHM', 'DHNO3CHM', 'DH2O2CHM', 'DO3CHM', 'DCOCHM', 'AQ_SO2', 'GS_SO2', 'SO2_CLXF', 'MASS', 'ABSORB', - 'Jval_O3O1D', 'Jval_NO2', 'Jval_PAN', 'Jval_H2O2', 'Jval_Cl2O2', + 'JvalO3O1D', 'Jval_NO2', 'Jval_PAN', 'Jval_H2O2', 'Jval_Cl2O2', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a1', 'ncl_a2', 'ncl_a3', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa1_a1', 'soa2_a1', 'soa3_a1', 'soa4_a1', 'soa5_a1', 'soa1_a2', 'soa2_a2', 'soa3_a2', diff --git a/bld/namelist_files/use_cases/sd_geoschem.xml b/bld/namelist_files/use_cases/sd_geoschem.xml index e420cc20bb..ea50638364 100644 --- a/bld/namelist_files/use_cases/sd_geoschem.xml +++ b/bld/namelist_files/use_cases/sd_geoschem.xml @@ -154,7 +154,7 @@ 'MEG_MTPO', 'Dso4_a1CHM', 'Dso4_a2CHM', 'Dso4_a3CHM', 'DO3CHM', 'DCOCHM', 'DHNO3CHM', 'DH2O2CHM', 'DO3CHM', 'DCOCHM', 'AQ_SO2', 'GS_SO2', 'SO2_CLXF', 'MASS', 'ABSORB', - 'Jval_O3O1D', 'Jval_NO2', 'Jval_PAN', 'Jval_H2O2', 'Jval_Cl2O2', + 'JvalO3O1D', 'Jval_NO2', 'Jval_PAN', 'Jval_H2O2', 'Jval_Cl2O2', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a1', 'ncl_a2', 'ncl_a3', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa1_a1', 'soa2_a1', 'soa3_a1', 'soa4_a1', 'soa5_a1', 'soa1_a2', 'soa2_a2', 'soa3_a2', From 035f27cecca38c1e46487f2821b6dae55dd4b6cc Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Mon, 7 Mar 2022 09:38:02 -0700 Subject: [PATCH 020/291] Remove remaining references to compset FSPCAMM_GC Signed-off-by: Lizzie Lundgren --- cime_config/config_compsets.xml | 6 ------ 1 file changed, 6 deletions(-) diff --git a/cime_config/config_compsets.xml b/cime_config/config_compsets.xml index e05944f99a..c9a9511796 100644 --- a/cime_config/config_compsets.xml +++ b/cime_config/config_compsets.xml @@ -513,14 +513,8 @@ - - - FSPCAMM_GC - 2000_CAM%SPCAMMGC_CLM50%SP_CICE%PRES_DOCN%DOM_RTM_SGLC_SWAV - - FC2000climo_GC 2000_CAM60%GC_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV From a002aff2955bfd55f7bad9e5dcd2ddcbc87b0f3d Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Fri, 11 Mar 2022 08:35:53 -0700 Subject: [PATCH 021/291] GEOS-Chem driver routine updates for compatibility with GEOS-Chem 13.3.4 --- src/chemistry/geoschem/chemistry.F90 | 138 ++++++++++----------------- 1 file changed, 51 insertions(+), 87 deletions(-) diff --git a/src/chemistry/geoschem/chemistry.F90 b/src/chemistry/geoschem/chemistry.F90 index f5ba122309..20c2bb2abf 100644 --- a/src/chemistry/geoschem/chemistry.F90 +++ b/src/chemistry/geoschem/chemistry.F90 @@ -212,7 +212,6 @@ subroutine chem_register use State_Chm_Mod, only : Init_State_Chm, Cleanup_State_Chm use State_Chm_Mod, only : Ind_ use Input_Opt_Mod, only : Set_Input_Opt, Cleanup_Input_Opt - use CMN_SIZE_Mod, only : Init_CMN_SIZE use mo_sim_dat, only : set_sim_dat use mo_chem_utls, only : get_spc_ndx @@ -291,7 +290,6 @@ subroutine chem_register ! Options needed by Init_State_Chm IO%ITS_A_FULLCHEM_SIM = .True. IO%LLinoz = .True. - IO%LUCX = .True. IO%LPRT = .False. IO%N_Advect = nTracers DO I = 1, nTracers @@ -326,9 +324,6 @@ subroutine chem_register CALL Error_Stop( ErrMsg, ThisLoc ) ENDIF - CALL Init_CMN_SIZE( Input_Opt = IO, & - RC = RC ) - IF ( RC /= GC_SUCCESS ) THEN ErrMsg = 'Error encountered within call to "Init_CMN_SIZE"!' CALL Error_Stop( ErrMsg, ThisLoc ) @@ -1002,7 +997,7 @@ subroutine chem_init(phys_state, pbuf2d) use Pressure_Mod, only : Accept_External_ApBp use Chemistry_Mod, only : Init_Chemistry use Ucx_Mod, only : Init_Ucx - use Strat_chem_Mod, only : Init_Strat_Chem + use Linear_Chem_Mod, only : Init_Linear_Chem use isorropiaII_Mod, only : Init_IsorropiaII use Input_Mod, only : Read_Input_File use Input_Mod, only : Validate_Directories @@ -1207,11 +1202,7 @@ subroutine chem_init(phys_state, pbuf2d) ! Define more variables for maxGrid maxGrid%MaxTropLev = nTrop maxGrid%MaxStratLev = nStrat - IF ( Input_Opt%LUCX ) THEN - maxGrid%MaxChemLev = maxGrid%MaxStratLev - ELSE - maxGrid%MaxChemLev = maxGrid%MaxTropLev - ENDIF + maxGrid%MaxChemLev = maxGrid%MaxStratLev DO I = BEGCHUNK, ENDCHUNK @@ -1244,11 +1235,7 @@ subroutine chem_init(phys_state, pbuf2d) State_Grid(I)%MaxStratLev = nStrat ! Set maximum number of levels in the chemistry grid - IF ( Input_Opt%LUCX ) THEN - State_Grid(I)%MaxChemLev = State_Grid(I)%MaxStratLev - ELSE - State_Grid(I)%MaxChemLev = State_Grid(I)%MaxTropLev - ENDIF + State_Grid(I)%MaxChemLev = State_Grid(I)%MaxStratLev ENDDO @@ -1617,23 +1604,22 @@ subroutine chem_init(phys_state, pbuf2d) ENDIF ENDIF - IF ( Input_Opt%LChem .AND. & - Input_Opt%LUCX ) THEN + IF ( Input_Opt%LChem ) THEN CALL Init_UCX( Input_Opt = Input_Opt, & State_Chm = State_Chm(BEGCHUNK), & State_Diag = State_Diag(BEGCHUNK), & State_Grid = maxGrid ) ENDIF - IF ( Input_Opt%LSCHEM ) THEN - CALL Init_Strat_Chem( Input_Opt = Input_Opt, & - State_Chm = State_Chm(BEGCHUNK), & - State_Met = State_Met(BEGCHUNK), & - State_Grid = maxGrid, & - RC = RC ) + IF ( Input_Opt%Linear_Chem ) THEN + CALL Init_Linear_Chem( Input_Opt = Input_Opt, & + State_Chm = State_Chm(BEGCHUNK), & + State_Met = State_Met(BEGCHUNK), & + State_Grid = maxGrid, & + RC = RC ) IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Error encountered in "Init_Strat_Chem"!' + ErrMsg = 'Error encountered in "Init_Linear_Chem"!' CALL Error_Stop( ErrMsg, ThisLoc ) ENDIF ENDIF @@ -1877,13 +1863,13 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) use PBL_Mix_Mod, only : Compute_PBL_Height use UCX_Mod, only : Set_H2O_Trac use CMN_FJX_MOD, only : ZPJ - use FAST_JX_MOD, only : RXN_NO2, RXN_O3_1, RXN_O3_2a + use FAST_JX_MOD, only : RXN_NO2, RXN_O3_1 use State_Diag_Mod, only : get_TagInfo use Unitconv_Mod, only : Convert_Spc_Units use State_Chm_Mod, only : Ind_ - use Strat_Chem_Mod, only : Strat_TrID_GC, GC_Bry_TrID, NSCHEM - use Strat_Chem_Mod, only : BrPtrDay, BrPtrNight, PLVEC, STRAT_OH + use Linear_Chem_Mod, only : TrID_GC, GC_Bry_TrID, NSCHEM + use Linear_Chem_Mod, only : BrPtrDay, BrPtrNight, PLVEC, GMI_OH use CESMGC_Emissions_Mod,only : CESMGC_Emissions_Calc use CESMGC_Diag_Mod, only : CESMGC_Diag_Calc @@ -3178,15 +3164,14 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) ENDIF ! SDE 05/28/13: Set H2O to State_Chm tracer if relevant and, - ! if LUCX=T and LSETH2O=F and LACTIVEH2O=T, update specific humidity + ! if LSETH2O=F and LACTIVEH2O=T, update specific humidity ! in the stratosphere ! ! NOTE: Specific humidity may change in SET_H2O_TRAC and ! therefore this routine may call AIRQNT again to update ! air quantities and tracer concentrations (ewl, 10/28/15) IF ( Input_Opt%Its_A_Fullchem_Sim .and. iH2O > 0 ) THEN - CALL Set_H2O_Trac( SETSTRAT = ( ( .not. Input_Opt%LUCX ) & - .or. Input_Opt%LSETH2O ), & + CALL Set_H2O_Trac( SETSTRAT = Input_Opt%LSETH2O, & Input_Opt = Input_Opt, & State_Chm = State_Chm(LCHNK), & State_Grid = State_Grid(LCHNK), & @@ -3263,7 +3248,7 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) ! Dimensions : nX, nY State_Met(LCHNK)%TO3 (1,:nY) = O3col(:nY) - IF ( Input_Opt%LSCHEM .AND. & + IF ( Input_Opt%Linear_Chem .AND. & State_Grid(LCHNK)%MaxChemLev /= State_Grid(LCHNK)%nZ ) THEN IF ( iStep == 1 ) THEN ALLOCATE( BrPtrDay ( 6 ), STAT=IERR ) @@ -3320,7 +3305,7 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) DO N = 1,NSCHEM ! Get GEOS-Chem species index - M = Strat_TrID_GC(N) + M = TrID_GC(N) ! Skip if species is not defined IF ( M <= 0 ) CYCLE @@ -3333,11 +3318,7 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) ! --------------------------------------------------------------- ! Production rates [v/v/s] - IF ( Input_Opt%LUCX ) THEN - FieldName = 'GMI_PROD_'//TRIM(SpcName) - ELSE - FieldName = 'UCX_PROD_'//TRIM(SpcName) - ENDIF + FieldName = 'GMI_PROD_'//TRIM(SpcName) ALLOCATE( PLVEC(N)%PROD(1,PCOLS,nZ), STAT=IERR ) IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating PLVEC%PROD') @@ -3369,11 +3350,7 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) ENDIF ! Loss frequency [s-1] - IF ( Input_Opt%LUCX ) THEN - FieldName = 'GMI_LOSS_'//TRIM(SpcName) - ELSE - FieldName = 'UCX_LOSS_'//TRIM(SpcName) - ENDIF + FieldName = 'GMI_LOSS_'//TRIM(SpcName) ! Get pointer from HEMCO tmpIdx = pbuf_get_index(FieldName, RC) @@ -3401,19 +3378,19 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) ENDDO !N - ! Get pointer to STRAT_OH + ! Get pointer to GMI_OH - ALLOCATE( STRAT_OH(1,PCOLS,nZ), STAT=IERR ) - IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating STRAT_OH') + ALLOCATE( GMI_OH(1,PCOLS,nZ), STAT=IERR ) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating GMI_OH') tmpIdx = pbuf_get_index(FieldName, RC) IF ( tmpIdx < 0 .or. ( iStep == 1 ) ) THEN IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(FieldName) - STRAT_OH(1,:nY,nZ:1:-1) = 0.0e+0_f4 + GMI_OH(1,:nY,nZ:1:-1) = 0.0e+0_f4 ELSE pbuf_chnk => pbuf_get_chunk(hco_pbuf2d, LCHNK) CALL pbuf_get_field(pbuf_chnk, tmpIdx, pbuf_ik) - STRAT_OH(1,:nY,nZ:1:-1) = REAL(pbuf_ik(:nY,:nZ), f4) + GMI_OH(1,:nY,nZ:1:-1) = REAL(pbuf_ik(:nY,:nZ), f4) pbuf_chnk => NULL() pbuf_ik => NULL() ENDIF @@ -3749,7 +3726,7 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) ENDIF IF ( Input_Opt%Its_A_Fullchem_Sim .and. iH2O > 0 ) THEN - CALL Set_H2O_Trac( SETSTRAT = (.not. Input_Opt%LUCX), & + CALL Set_H2O_Trac( SETSTRAT = .False. , & Input_Opt = Input_Opt, & State_Chm = State_Chm(LCHNK), & State_Grid = State_Grid(LCHNK), & @@ -3853,13 +3830,8 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) pbuf_chnk => pbuf_get_chunk(hco_pbuf2d, LCHNK) CALL pbuf_get_field(pbuf_chnk, tmpIdx, pbuf_i) - IF ( Input_Opt%LUCX ) THEN - ! RXN_O3_1: O3 + hv --> O2 + O - pbuf_i(:nY) = ZPJ(1,RXN_O3_1,1,:nY) - ELSE - ! RXN_O3_2a: O3 + hv --> 2OH - pbuf_i(:nY) = ZPJ(1,RXN_O3_2a,1,:nY) - ENDIF + ! RXN_O3_1: O3 + hv --> O2 + O + pbuf_i(:nY) = ZPJ(1,RXN_O3_1,1,:nY) pbuf_chnk => NULL() pbuf_i => NULL() ENDIF @@ -4259,31 +4231,29 @@ end subroutine chem_init_cnst subroutine chem_final - use Input_Opt_Mod, only : Cleanup_Input_Opt - use State_Chm_Mod, only : Cleanup_State_Chm - use State_Diag_Mod, only : Cleanup_State_Diag - use State_Grid_Mod, only : Cleanup_State_Grid - use State_Met_Mod, only : Cleanup_State_Met - use Error_Mod, only : Cleanup_Error - - use FlexChem_Mod, only : Cleanup_FlexChem - use UCX_Mod, only : Cleanup_UCX - use Drydep_Mod, only : Cleanup_Drydep - use Carbon_Mod, only : Cleanup_Carbon - use Dust_Mod, only : Cleanup_Dust - use Seasalt_Mod, only : Cleanup_Seasalt - use Aerosol_Mod, only : Cleanup_Aerosol - use Sulfate_Mod, only : Cleanup_Sulfate - use Pressure_Mod, only : Cleanup_Pressure - use Strat_Chem_Mod, only : Cleanup_Strat_Chem - - use CMN_Size_Mod, only : Cleanup_CMN_Size - use CMN_FJX_Mod, only : Cleanup_CMN_FJX + use Input_Opt_Mod, only : Cleanup_Input_Opt + use State_Chm_Mod, only : Cleanup_State_Chm + use State_Diag_Mod, only : Cleanup_State_Diag + use State_Grid_Mod, only : Cleanup_State_Grid + use State_Met_Mod, only : Cleanup_State_Met + use Error_Mod, only : Cleanup_Error + use Fullchem_Mod, only : Cleanup_FullChem + use UCX_Mod, only : Cleanup_UCX + use Drydep_Mod, only : Cleanup_Drydep + use Carbon_Mod, only : Cleanup_Carbon + use Dust_Mod, only : Cleanup_Dust + use Seasalt_Mod, only : Cleanup_Seasalt + use Aerosol_Mod, only : Cleanup_Aerosol + use Sulfate_Mod, only : Cleanup_Sulfate + use Pressure_Mod, only : Cleanup_Pressure + use Linear_Chem_Mod, only : Cleanup_Linear_Chem + + use CMN_FJX_Mod, only : Cleanup_CMN_FJX #ifdef BPCH_DIAG - use CMN_O3_Mod, only : Cleanup_CMN_O3 + use CMN_O3_Mod, only : Cleanup_CMN_O3 ! Special: cleans up after NDXX_Setup - use Diag_Mod, only : Cleanup_Diag + use Diag_Mod, only : Cleanup_Diag #endif use CESMGC_Emissions_Mod, only: CESMGC_Emissions_Final @@ -4298,25 +4268,19 @@ subroutine chem_final CALL Cleanup_Carbon CALL Cleanup_Drydep CALL Cleanup_Dust - CALL Cleanup_FlexChem( RC ) + CALL Cleanup_FullChem( RC ) IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Error encountered in "Cleanup_FlexChem"!' + ErrMsg = 'Error encountered in "Cleanup_FullChem"!' CALL Error_Stop( ErrMsg, ThisLoc ) ENDIF CALL Cleanup_Pressure CALL Cleanup_Seasalt CALL Cleanup_Sulfate - CALL Cleanup_Strat_Chem + CALL Cleanup_Linear_Chem CALL CESMGC_Emissions_Final - CALL Cleanup_CMN_SIZE( RC ) - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Error encountered in "Cleanup_CMN_SIZE"!' - CALL Error_Stop( ErrMsg, ThisLoc ) - ENDIF - CALL Cleanup_CMN_FJX( RC ) IF ( RC /= GC_SUCCESS ) THEN ErrMsg = 'Error encountered in "Cleanup_CMN_FJX"!' From 6fd974497839ffee00064929dbbc0f06f6e2727d Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Thu, 31 Mar 2022 11:35:49 -0600 Subject: [PATCH 022/291] Modifications for new GEOS-Chem species (HMS) in version 13.3 - Added HMS to solsym array and increased length by 1 - Add HMS molecular wt to adv_mass array and increased length by 1 - Increased parameter nTracersMax by 1 - Increased bld/configure variables chem_nadv by 1 Signed-off-by: Lizzie Lundgren --- bld/configure | 2 +- src/chemistry/geoschem/chem_mods.F90 | 2 +- src/chemistry/geoschem/mo_sim_dat.F90 | 9 +++++---- 3 files changed, 7 insertions(+), 6 deletions(-) diff --git a/bld/configure b/bld/configure index ea0e9abd62..7191dbe272 100755 --- a/bld/configure +++ b/bld/configure @@ -1404,7 +1404,7 @@ if ($chem_pkg =~ '_mam3') { # TMMF - wedge in GEOS-Chem CPP definitions here if ($chem_pkg =~ 'geoschem') { $chem_cppdefs .= ' -DEXTERNAL_GRID -DEXTERNAL_FORCING -DLINUX_IFORT -DUSE_REAL8 -DMODEL_ -DMODEL_CESM'; - $chem_nadv = 251; + $chem_nadv = 252; if (defined $opts{'clm_vers'}) { if ($opts{'clm_vers'} =~ 'CLM4.0') { $chem_cppdefs .= ' -DCLM40' diff --git a/src/chemistry/geoschem/chem_mods.F90 b/src/chemistry/geoschem/chem_mods.F90 index 08733b6d85..b2f25b4e4d 100644 --- a/src/chemistry/geoschem/chem_mods.F90 +++ b/src/chemistry/geoschem/chem_mods.F90 @@ -7,7 +7,7 @@ module chem_mods implicit none save - INTEGER, PARAMETER :: nTracersMax = 251 ! Must be equal to chem_nadv + INTEGER, PARAMETER :: nTracersMax = 252 ! Must be equal to chem_nadv INTEGER :: nTracers CHARACTER(LEN=255) :: tracerNames(nTracersMax) CHARACTER(LEN=255) :: tracerLongNames(nTracersMax) diff --git a/src/chemistry/geoschem/mo_sim_dat.F90 b/src/chemistry/geoschem/mo_sim_dat.F90 index 46c344415b..82fedbda54 100644 --- a/src/chemistry/geoschem/mo_sim_dat.F90 +++ b/src/chemistry/geoschem/mo_sim_dat.F90 @@ -40,7 +40,8 @@ subroutine set_sim_dat ! aerosols, as those will be constituents. MAM requires that there ! is a linear mapping between solsym and constituents - solsym(:331) = (/ 'ACET ','ACTA ','AERI ', & + ! ewl notes: added HMS (for GEOS-Chem 13.3) + solsym(:332) = (/ 'ACET ','ACTA ','AERI ', & 'ALD2 ','ALK4 ','ASOA1 ', & 'ASOA2 ','ASOA3 ','ASOAN ', & 'ASOG1 ','ASOG2 ','ASOG3 ', & @@ -67,7 +68,7 @@ subroutine set_sim_dat 'HBR ','HC5A ','HCFC123 ', & 'HCFC141B ','HCFC142B ','HCFC22 ', & 'HCL ','HCOOH ','HI ', & - 'HMHP ','HMML ','HNO2 ', & + 'HMHP ','HMML ','HMS ', 'HNO2 ', & 'HNO3 ','HNO4 ','HOBR ', & 'HOCL ','HOI ','HONIT ', & 'HPALD1 ','HPALD2 ','HPALD3 ', & @@ -158,7 +159,7 @@ subroutine set_sim_dat fix_mass(: 6) = (/ 0.00000000_r8, 28.0134800_r8, 31.9988000_r8, 2.020000_r8, 32.050000_r8, & 74.090000_r8 /) - adv_mass(:331) = (/ 58.090000_r8, 60.060000_r8, 126.900000_r8, 44.060000_r8, 58.120000_r8, & + adv_mass(:332) = (/ 58.090000_r8, 60.060000_r8, 126.900000_r8, 44.060000_r8, 58.120000_r8, & 150.000000_r8, 150.000000_r8, 150.000000_r8, 150.000000_r8, 150.000000_r8, & 150.00000_r8, 150.000000_r8, 90.0900000_r8, 12.010000_r8, 12.010000_r8, & 78.120000_r8, 79.900000_r8, 159.800000_r8, 115.450000_r8, 125.910000_r8, & @@ -174,7 +175,7 @@ subroutine set_sim_dat 165.360000_r8, 148.910000_r8, 259.820000_r8, 18.020000_r8, 34.020000_r8, & 74.080000_r8, 80.910000_r8, 100.130000_r8, 152.930000_r8, 116.940000_r8, & 100.500000_r8, 86.470000_r8, 36.450000_r8, 46.030000_r8, 127.910000_r8, & - 64.050000_r8, 102.100000_r8, 47.010000_r8, 63.010000_r8, 79.010000_r8, & + 64.050000_r8, 102.100000_r8, 110.000000_r8, 47.010000_r8, 63.010000_r8, 79.010000_r8, & 96.910000_r8, 52.450000_r8, 143.890000_r8, 215.000000_r8, 116.130000_r8, & 116.130000_r8, 116.130000_r8, 116.130000_r8, 76.060000_r8, 126.900000_r8, & 253.800000_r8, 285.800000_r8, 301.800000_r8, 317.800000_r8, 206.900000_r8, & From 596c261d3375aa6d939475787462cff9bbc2c390 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Thu, 31 Mar 2022 11:36:28 -0600 Subject: [PATCH 023/291] Use ESCOMP/HEMCO_CESM rather than H. Lin's fork Signed-off-by: Lizzie Lundgren --- Externals_CAM.cfg | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Externals_CAM.cfg b/Externals_CAM.cfg index 5091e191c0..228425040b 100644 --- a/Externals_CAM.cfg +++ b/Externals_CAM.cfg @@ -72,8 +72,8 @@ required = True [hemco] local_path = src/hemco protocol = git -branch = development -repo_url = https://github.com/jimmielin/HEMCO_CESM.git +branch = master +repo_url = https://github.com/ESCOMP/HEMCO_CESM.git required = True externals = Externals_HCO.cfg From 425bb4996dd430f45343ced4222220509ac96f74 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Thu, 31 Mar 2022 11:40:53 -0600 Subject: [PATCH 024/291] Change GEOS-Chem branch name to diverge from version used in CESM-GC 2.1 CESM-GC using CESM 2.1 used GEOS-Chem 13.1. The GEOS-Chem version used in development for CESM 2.3 is 13.3. Signed-off-by: Lizzie Lundgren --- Externals_CAM.cfg | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Externals_CAM.cfg b/Externals_CAM.cfg index 228425040b..dbab4284ca 100644 --- a/Externals_CAM.cfg +++ b/Externals_CAM.cfg @@ -65,7 +65,7 @@ required = True [geoschem] local_path = src/chemistry/geoschem/geoschem_src protocol = git -branch = CESM +branch = feature/cesm_2.3 repo_url = https://github.com/CESM-GC/geos-chem required = True From eb70ed3a4e2e9b4deab0f4bbfc5beb33487269a2 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Thu, 31 Mar 2022 11:54:41 -0600 Subject: [PATCH 025/291] Set default namelist values for cam_physics_mesh in geos-chem use cases Signed-off-by: Lizzie Lundgren --- bld/namelist_files/use_cases/2000_geoschem.xml | 5 +++++ bld/namelist_files/use_cases/2010_geoschem.xml | 5 +++++ bld/namelist_files/use_cases/geoschem_baro_moist.xml | 5 +++++ bld/namelist_files/use_cases/hist_geoschem.xml | 5 +++++ bld/namelist_files/use_cases/sd_geoschem.xml | 5 +++++ 5 files changed, 25 insertions(+) diff --git a/bld/namelist_files/use_cases/2000_geoschem.xml b/bld/namelist_files/use_cases/2000_geoschem.xml index 2b7264fc61..5c8cb2a45e 100644 --- a/bld/namelist_files/use_cases/2000_geoschem.xml +++ b/bld/namelist_files/use_cases/2000_geoschem.xml @@ -9,6 +9,11 @@ /glade/p/univ/umit0034/Shared/GEOS-Chem/f.e20.FC2010.f19_f19.144.GC_vbsext.001.cam.i.0007-01-01-00000.nc + +/glade/p/cesmdata/cseg/inputdata/atm/cam/coords/fv0.9x1.25_esmf_141008.nc' + +/glade/p/cesmdata/cseg/inputdata/atm/cam/coords/fv1.9x2.5_esmf_141008.nc' + 'ISOP = isoprene', diff --git a/bld/namelist_files/use_cases/2010_geoschem.xml b/bld/namelist_files/use_cases/2010_geoschem.xml index 6d10dd02df..8d37e9c9b9 100644 --- a/bld/namelist_files/use_cases/2010_geoschem.xml +++ b/bld/namelist_files/use_cases/2010_geoschem.xml @@ -10,6 +10,11 @@ /glade/p/univ/umit0034/Shared/GEOS-Chem/f.e20.FC2010.f19_f19.144.GC_vbsext.001.cam.i.0007-01-01-00000.nc + +/glade/p/cesmdata/cseg/inputdata/atm/cam/coords/fv0.9x1.25_esmf_141008.nc' + +/glade/p/cesmdata/cseg/inputdata/atm/cam/coords/fv1.9x2.5_esmf_141008.nc' + 'ISOP = isoprene', diff --git a/bld/namelist_files/use_cases/geoschem_baro_moist.xml b/bld/namelist_files/use_cases/geoschem_baro_moist.xml index da938fe300..51c3427f82 100644 --- a/bld/namelist_files/use_cases/geoschem_baro_moist.xml +++ b/bld/namelist_files/use_cases/geoschem_baro_moist.xml @@ -7,6 +7,11 @@ .false. + +/glade/p/cesmdata/cseg/inputdata/atm/cam/coords/fv0.9x1.25_esmf_141008.nc' + +/glade/p/cesmdata/cseg/inputdata/atm/cam/coords/fv1.9x2.5_esmf_141008.nc' + 0,-6 diff --git a/bld/namelist_files/use_cases/hist_geoschem.xml b/bld/namelist_files/use_cases/hist_geoschem.xml index 6c20797422..5d446229f6 100644 --- a/bld/namelist_files/use_cases/hist_geoschem.xml +++ b/bld/namelist_files/use_cases/hist_geoschem.xml @@ -10,6 +10,11 @@ /glade/p/univ/umit0034/Shared/GEOS-Chem/f.e20.FC2010.f19_f19.144.GC_vbsext.001.cam.i.0007-01-01-00000.nc + +/glade/p/cesmdata/cseg/inputdata/atm/cam/coords/fv0.9x1.25_esmf_141008.nc' + +/glade/p/cesmdata/cseg/inputdata/atm/cam/coords/fv1.9x2.5_esmf_141008.nc' + 'ISOP = isoprene', diff --git a/bld/namelist_files/use_cases/sd_geoschem.xml b/bld/namelist_files/use_cases/sd_geoschem.xml index ea50638364..dd613f7619 100644 --- a/bld/namelist_files/use_cases/sd_geoschem.xml +++ b/bld/namelist_files/use_cases/sd_geoschem.xml @@ -14,6 +14,11 @@ /glade/p/univ/umit0034/Shared/GEOS-Chem/f.e20.FCSD.f19_f19_mg17.cesm2.1-exp002.001.cam.i.2005-01-01-00000_c180801.nc atm/cam/met/MERRA2/1.9x2.5/fv_1.9x2.5_nc3000_Nsw084_Nrs016_Co120_Fi001_ZR_GRNL_MERRA2_c190617.nc + +/glade/p/cesmdata/cseg/inputdata/atm/cam/coords/fv0.9x1.25_esmf_141008.nc' + +/glade/p/cesmdata/cseg/inputdata/atm/cam/coords/fv1.9x2.5_esmf_141008.nc' + 'ISOP = isoprene', From 1778e5d0cb4b7f9b1d317f4396be6db1daae9dec Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Wed, 27 Apr 2022 14:30:18 -0600 Subject: [PATCH 026/291] Bug fix: increase module parameter gas_pcnst by 1 to include HMS This is necessary after upgrading the GEOS-Chem version since HMS is a newly added advected gas species. Signed-off-by: Lizzie Lundgren --- src/chemistry/geoschem/chem_mods.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/chemistry/geoschem/chem_mods.F90 b/src/chemistry/geoschem/chem_mods.F90 index b2f25b4e4d..1c3ad941e3 100644 --- a/src/chemistry/geoschem/chem_mods.F90 +++ b/src/chemistry/geoschem/chem_mods.F90 @@ -61,7 +61,7 @@ module chem_mods rxntot = 212, & ! number of total reactions gascnt = 172, & ! number of gas phase reactions nabscol = 2, & ! number of absorbing column densities - gas_pcnst = 331, & ! number of "gas phase" species + gas_pcnst = 332, & ! number of "gas phase" species nfs = 6, & ! number of "fixed" species relcnt = 0, & ! number of relationship species grpcnt = 0, & ! number of group members From 0a782b962321c737660d07dec430207ff297fc41 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Fri, 24 Jun 2022 12:02:21 -0600 Subject: [PATCH 027/291] Modifications to turn off dry deposition and dependencies on CLM for land --- .../use_cases/hist_geoschem.xml | 7 + src/chemistry/geoschem/chemistry.F90 | 291 +++++++++--------- src/physics/cam/physpkg.F90 | 33 +- 3 files changed, 176 insertions(+), 155 deletions(-) diff --git a/bld/namelist_files/use_cases/hist_geoschem.xml b/bld/namelist_files/use_cases/hist_geoschem.xml index 5d446229f6..2c6e7842bb 100644 --- a/bld/namelist_files/use_cases/hist_geoschem.xml +++ b/bld/namelist_files/use_cases/hist_geoschem.xml @@ -79,6 +79,8 @@ 'AODDUST', 'AODDUST2', 'T', 'U', 'V', 'O3', 'OH', 'NO3', 'HO2', + + + + 'ACTA','ALD2','ASOG1','ASOG2','ASOG3','ATOOH','BR2','BRCL','CH2O','EOH','ETHLN','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HG2','HG2_ANT','HG2_ARC','HG2_ATL','HG2_BB','HG2_CAM','HG2_CAN','HG2_EAF','HG2_EAS','HG2_EEU','HG2_EUR','HG2_GEO','HG2_JPN','HG2_MDE','HG2_NAF','HG2_NAT','HG2_NPA','HG2_OCE','HG2_OCN','HG2_SAF','HG2_SAM','HG2_SAS','HG2_SAT','HG2_SEA','HG2_SO','HG2_SOV','HG2_STR','HG2_USA','HG2_WAF','HI','HMHP','HMML','HNO3','HOBR','HOCL','HOI','HONIT','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','ITCN','ITHN','LIMO','LVOC','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MEK','MGLY','MOH','MONITS','MONITU','MP','MPAN','MPN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','NH3','OPOG1','OPOG2','PAN','POG1','POG2','POPG_BAP','POPG_PHE','POPG_PYR','PP','PPN','PROPNN','PRPE','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2','TSOG0','TSOG1','TSOG2','TSOG3','AERI','ASOA1','ASOA2','ASOA3','ASOAN','BCPI','BCPO','BE10','BE10STRAT','BE7','BE7STRAT','BRSALA','BRSALC','DST1','DST2','DST3','DST4','DSTAL1','DSTAL2','DSTAL3','DSTAL4','HGP','HGP_ANT','HGP_ARC','HGP_ATL','HGP_BB','HGP_CAM','HGP_CAN','HGP_EAF','HGP_EAS','HGP_EEU','HGP_EUR','HGP_GEO','HGP_JPN','HGP_MDE','HGP_NAF','HGP_NAT','HGP_NPA','HGP_OCE','HGP_OCN','HGP_SAF','HGP_SAM','HGP_SAS','HGP_SAT','HGP_SEA','HGP_SO','HGP_SOV','HGP_STR','HGP_USA','HGP_WAF','INDIOL','IONITA','ISALA','ISALC','LVOCOA','MONITA','MOPI','MOPO','MSA','NH4','NIT','NITD1','NITD2','NITD3','NITD4','NITS','OCPI','OCPO','OPOA1','OPOA2','PB210','PB210STRAT','PFE','POA1','POA2','POPPBCPI_BAP','POPPBCPI_PHE','POPPBCPI_PYR','POPPBCPO_BAP','POPPBCPO_PHE','POPPBCPO_PYR','POPPOCPI_BAP','POPPOCPI_PHE','POPPOCPI_PYR','POPPOCPO_BAP','POPPOCPO_PHE','POPPOCPO_PYR','SALA','SALAAL','SALACL','SALC','SALCAL','SALCCL','SO4','SO4D1','SO4D2','SO4D3','SO4D4','SO4S','SOAGX','SOAIE','SOAS','TSOA0','TSOA1','TSOA2','TSOA3', diff --git a/src/chemistry/geoschem/chemistry.F90 b/src/chemistry/geoschem/chemistry.F90 index 20c2bb2abf..292724dc51 100644 --- a/src/chemistry/geoschem/chemistry.F90 +++ b/src/chemistry/geoschem/chemistry.F90 @@ -165,11 +165,12 @@ module chemistry CHARACTER(LEN=255) :: ThisLoc CHARACTER(LEN=255) :: ErrMsg - ! Filenames to compute dry deposition velocities similarly to MOZART - character(len=shr_kind_cl) :: clim_soilw_file = 'clim_soilw_file' - character(len=shr_kind_cl) :: depvel_file = '' - character(len=shr_kind_cl) :: depvel_lnd_file = 'depvel_lnd_file' - character(len=shr_kind_cl) :: season_wes_file = 'season_wes_file' +! ewl: comment out defining files used only for dry deposition +! ! Filenames to compute dry deposition velocities similarly to MOZART +! character(len=shr_kind_cl) :: clim_soilw_file = 'clim_soilw_file' +! character(len=shr_kind_cl) :: depvel_file = '' +! character(len=shr_kind_cl) :: depvel_lnd_file = 'depvel_lnd_file' +! character(len=shr_kind_cl) :: season_wes_file = 'season_wes_file' character(len=shr_kind_cl) :: srf_emis_specifier(pcnst) = '' character(len=shr_kind_cl) :: ext_frc_specifier(pcnst) = '' @@ -689,18 +690,16 @@ subroutine chem_readnl(nlfile) LOGICAL :: menuFound LOGICAL :: validSLS +! ewl: remove 4 entries from chem_inparm used for dry deposition: +! clim_soilw_file, depvel_file, depvel_lnd_file, season_wes_file ! The following files are required to compute land maps, required to perform ! aerosol dry deposition - namelist /chem_inparm/ clim_soilw_file, & - depvel_file, & - lght_no_prd_factor, & - depvel_lnd_file, & + namelist /chem_inparm/ lght_no_prd_factor, & ext_frc_specifier, & ext_frc_type, & ext_frc_cycle_yr, & ext_frc_fixed_ymd, & ext_frc_fixed_tod, & - season_wes_file, & srf_emis_specifier, & srf_emis_cycle_yr, & srf_emis_fixed_ymd, & @@ -868,14 +867,15 @@ subroutine chem_readnl(nlfile) ! Broadcast namelist variables +! ewl: remove broadcast of 4 files used for dry deposition only ! The following files are required to compute land maps, required to perform ! aerosol dry deposition - CALL MPIBCAST (depvel_lnd_file, LEN(depvel_lnd_file), MPICHAR, 0, MPICOM) - CALL MPIBCAST (clim_soilw_file, LEN(clim_soilw_file), MPICHAR, 0, MPICOM) - CALL MPIBCAST (season_wes_file, LEN(season_wes_file), MPICHAR, 0, MPICOM) +! CALL MPIBCAST (depvel_lnd_file, LEN(depvel_lnd_file), MPICHAR, 0, MPICOM) +! CALL MPIBCAST (clim_soilw_file, LEN(clim_soilw_file), MPICHAR, 0, MPICOM) +! CALL MPIBCAST (season_wes_file, LEN(season_wes_file), MPICHAR, 0, MPICOM) CALL MPIBCAST (lght_no_prd_factor, 1, MPIR8, 0, MPICOM) - CALL MPIBCAST (depvel_file, LEN(depvel_file), MPICHAR, 0, MPICOM) +! CALL MPIBCAST (depvel_file, LEN(depvel_file), MPICHAR, 0, MPICOM) CALL MPIBCAST (srf_emis_specifier, LEN(srf_emis_specifier(1))*pcnst, MPICHAR, 0, MPICOM) CALL MPIBCAST (srf_emis_type, LEN(srf_emis_type), MPICHAR, 0, MPICOM) CALL MPIBCAST (srf_emis_cycle_yr, 1, MPIINT, 0, MPICOM) @@ -1165,13 +1165,15 @@ subroutine chem_init(phys_state, pbuf2d) ! -> False (read monthly-mean albedo from HEMCO) Input_Opt%onlineAlbedo = .False. +! ewl: Change using online land types from true to false ! onlineLandTypes -> True (use CLM landtypes) ! -> False (read landtypes from HEMCO) - Input_Opt%onlineLandTypes = .True. + Input_Opt%onlineLandTypes = .False. +! ewl: Change using CLM dry dep velocities from false to true ! ddVel_CLM -> True (use CLM dry deposition velocities) ! -> False (let GEOS-Chem compute dry deposition velocities) - Input_Opt%ddVel_CLM = .False. + Input_Opt%ddVel_CLM = .True. ! applyQtend: apply tendencies of water vapor to specific humidity Input_Opt%applyQtend = .False. @@ -1495,16 +1497,17 @@ subroutine chem_init(phys_state, pbuf2d) ! Initialize aerosols CALL aero_model_init( pbuf2d ) - ! Initialize land maps for aerosol dry deposition - IF ( drydep_method == DD_XATM .OR. drydep_method == DD_XLND ) THEN - CALL drydep_inti( depvel_lnd_file, & - clim_soilw_file, & - season_wes_file ) - ELSE - IF ( masterProc ) Write(iulog,'(a,a)') ' drydep_method is set to: ', TRIM(drydep_method) - CALL ENDRUN('drydep_method must be DD_XLND or DD_XATM to compute land '// & - 'maps for aerosol dry deposition!') - ENDIF +! ewl: Comment out initializing land maps for aerosol dry deposition. +! ! Initialize land maps for aerosol dry deposition +! IF ( drydep_method == DD_XATM .OR. drydep_method == DD_XLND ) THEN +! CALL drydep_inti( depvel_lnd_file, & +! clim_soilw_file, & +! season_wes_file ) +! ELSE +! IF ( masterProc ) Write(iulog,'(a,a)') ' drydep_method is set to: ', TRIM(drydep_method) +! CALL ENDRUN('drydep_method must be DD_XLND or DD_XATM to compute land '// & +! 'maps for aerosol dry deposition!') +! ENDIF #endif IF ( gas_wetdep_method == 'NEU' ) THEN @@ -2625,73 +2628,78 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) State_Met(LCHNK)%EFLUX (1,:nY) = cam_in%Lhf(:nY) State_Met(LCHNK)%HFLUX (1,:nY) = cam_in%Shf(:nY) - ! Field : LandTypeFrac - ! Description: Olson fraction per type - ! Unit : - (between 0 and 1) - ! Dimensions : nX, nY, NSURFTYPE - ! Note : Index 1 is water - IF ( Input_Opt%onlineLandTypes ) THEN - ! Fill in water - State_Met(LCHNK)%LandTypeFrac(1,:nY,1) = cam_in%ocnFrac(:nY) & - + cam_in%iceFrac(:nY) - IF ( .NOT. Input_Opt%ddVel_CLM ) THEN - CALL getLandTypes( cam_in, & - nY, & - State_Met(LCHNK) ) - ENDIF - ELSE - DO N = 1, NSURFTYPE - Write(FieldName, '(a,i2.2)') 'HCO_LANDTYPE', N-1 - tmpIdx = pbuf_get_index(FieldName, rc) - IF ( tmpIdx < 0 .or. ( iStep == 1 ) ) THEN - IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(FieldName) - ELSE - CALL pbuf_get_field(pbuf, tmpIdx, pbuf_i) - DO J = 1, nY - State_Met(LCHNK)%LandTypeFrac(1,J,N) = pbuf_i(J) - ENDDO - pbuf_i => NULL() - ENDIF - - Write(FieldName, '(a,i2.2)') 'HCO_XLAI', N-1 - tmpIdx = pbuf_get_index(FieldName, rc) - IF ( tmpIdx < 0 .or. ( iStep == 1 ) ) THEN - IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(FieldName) - ELSE - CALL pbuf_get_field(pbuf, tmpIdx, pbuf_i) - DO J = 1, nY - State_Met(LCHNK)%XLAI_NATIVE(1,J,N) = pbuf_i(J) - ENDDO - pbuf_i => NULL() - ENDIF - ENDDO - ENDIF - - ! Field : FRCLND, FRLAND, FROCEAN, FRSEAICE, FRLAKE, FRLANDIC - ! Description: Olson land fraction - ! Fraction of land - ! Fraction of ocean - ! Fraction of sea ice - ! Fraction of lake - ! Fraction of land ice - ! Fraction of snow - ! Unit : - - ! Dimensions : nX, nY - State_Met(LCHNK)%FRCLND (1,:ny) = 1.e+0_fp - & - State_Met(LCHNK)%LandTypeFrac(1,:nY,1) ! Olson Land Fraction - State_Met(LCHNK)%FRLAND (1,:nY) = cam_in%landFrac(:nY) - State_Met(LCHNK)%FROCEAN (1,:nY) = cam_in%ocnFrac(:nY) + cam_in%iceFrac(:nY) - State_Met(LCHNK)%FRSEAICE (1,:nY) = cam_in%iceFrac(:nY) - IF ( Input_Opt%onlineLandTypes ) THEN - State_Met(LCHNK)%FRLAKE (1,:nY) = cam_in%lwtgcell(:,3) + & - cam_in%lwtgcell(:,4) - State_Met(LCHNK)%FRLANDIC (1,:nY) = cam_in%lwtgcell(:,2) - State_Met(LCHNK)%FRSNO (1,:nY) = 0.0e+0_fp - ELSE - State_Met(LCHNK)%FRLAKE (1,:nY) = 0.0e+0_fp - State_Met(LCHNK)%FRLANDIC (1,:nY) = 0.0e+0_fp - State_Met(LCHNK)%FRSNO (1,:nY) = 0.0e+0_fp - ENDIF +! ewl: Comment out setting State_Met fields LandTypeFrac and XLAI_NATIVE. Note +! that onlineLandTypes is now false. +! ! Field : LandTypeFrac +! ! Description: Olson fraction per type +! ! Unit : - (between 0 and 1) +! ! Dimensions : nX, nY, NSURFTYPE +! ! Note : Index 1 is water +! IF ( Input_Opt%onlineLandTypes ) THEN +! ! Fill in water +! State_Met(LCHNK)%LandTypeFrac(1,:nY,1) = cam_in%ocnFrac(:nY) & +! + cam_in%iceFrac(:nY) +! IF ( .NOT. Input_Opt%ddVel_CLM ) THEN +! CALL getLandTypes( cam_in, & +! nY, & +! State_Met(LCHNK) ) +! ENDIF +! ELSE +! DO N = 1, NSURFTYPE +! Write(FieldName, '(a,i2.2)') 'HCO_LANDTYPE', N-1 +! tmpIdx = pbuf_get_index(FieldName, rc) +! IF ( tmpIdx < 0 .or. ( iStep == 1 ) ) THEN +! IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(FieldName) +! ELSE +! CALL pbuf_get_field(pbuf, tmpIdx, pbuf_i) +! DO J = 1, nY +! State_Met(LCHNK)%LandTypeFrac(1,J,N) = pbuf_i(J) +! ENDDO +! pbuf_i => NULL() +! ENDIF +! +! Write(FieldName, '(a,i2.2)') 'HCO_XLAI', N-1 +! tmpIdx = pbuf_get_index(FieldName, rc) +! IF ( tmpIdx < 0 .or. ( iStep == 1 ) ) THEN +! IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(FieldName) +! ELSE +! CALL pbuf_get_field(pbuf, tmpIdx, pbuf_i) +! DO J = 1, nY +! State_Met(LCHNK)%XLAI_NATIVE(1,J,N) = pbuf_i(J) +! ENDDO +! pbuf_i => NULL() +! ENDIF +! ENDDO +! ENDIF + +! ewl: Comment out setting State_Met fields FR* for CLND, LAND, OCEAN, +! SEAICE, LAKE, and LANDIC. If not getting land type from CLM need to +! figure out how to set these. +! ! Field : FRCLND, FRLAND, FROCEAN, FRSEAICE, FRLAKE, FRLANDIC +! ! Description: Olson land fraction +! ! Fraction of land +! ! Fraction of ocean +! ! Fraction of sea ice +! ! Fraction of lake +! ! Fraction of land ice +! ! Fraction of snow +! ! Unit : - +! ! Dimensions : nX, nY +! State_Met(LCHNK)%FRCLND (1,:ny) = 1.e+0_fp - & +! State_Met(LCHNK)%LandTypeFrac(1,:nY,1) ! Olson Land Fraction +! State_Met(LCHNK)%FRLAND (1,:nY) = cam_in%landFrac(:nY) +! State_Met(LCHNK)%FROCEAN (1,:nY) = cam_in%ocnFrac(:nY) + cam_in%iceFrac(:nY) +! State_Met(LCHNK)%FRSEAICE (1,:nY) = cam_in%iceFrac(:nY) +! IF ( Input_Opt%onlineLandTypes ) THEN +! State_Met(LCHNK)%FRLAKE (1,:nY) = cam_in%lwtgcell(:,3) + & +! cam_in%lwtgcell(:,4) +! State_Met(LCHNK)%FRLANDIC (1,:nY) = cam_in%lwtgcell(:,2) +! State_Met(LCHNK)%FRSNO (1,:nY) = 0.0e+0_fp +! ELSE +! State_Met(LCHNK)%FRLAKE (1,:nY) = 0.0e+0_fp +! State_Met(LCHNK)%FRLANDIC (1,:nY) = 0.0e+0_fp +! State_Met(LCHNK)%FRSNO (1,:nY) = 0.0e+0_fp +! ENDIF ! Field : GWETROOT, GWETTOP ! Description: Root and top soil moisture @@ -3188,45 +3196,48 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) IF (Input_Opt%LSETH2O) Input_Opt%LSETH2O = .FALSE. ENDIF +! ewl: Turn off over-writing isLand, isWater, and isIce with CLM land imports, +! and set isSnow to if SNODP > 0.01 (removes dependency on CLM land) ! Do this after AirQnt, such that we overwrite GEOS-Chem isLand, isWater and ! isIce, which are based on albedo. Rather, we use CLM landFranc, ocnFrac ! and iceFrac. We also compute isSnow DO J = 1, nY - iMaxLoc = MAXLOC( (/ State_Met(LCHNK)%FRLAND(1,J) + & - State_Met(LCHNK)%FRLANDIC(1,J) + & - State_Met(LCHNK)%FRLAKE(1,J), & - State_Met(LCHNK)%FRSEAICE(1,J), & - State_Met(LCHNK)%FROCEAN(1,J) - & - State_Met(LCHNK)%FRSEAICE(1,J) /) ) - IF ( iMaxLoc(1) == 3 ) iMaxLoc(1) = 0 - ! reset ocean to 0 - - ! Field : LWI - ! Description: Land/water indices - ! Unit : - - ! Dimensions : nX, nY - State_Met(LCHNK)%LWI(1,J) = FLOAT( iMaxLoc(1) ) - - IF ( iMaxLoc(1) == 0 ) THEN - State_Met(LCHNK)%isLand(1,J) = .False. - State_Met(LCHNK)%isWater(1,J) = .True. - State_Met(LCHNK)%isIce(1,J) = .False. - ELSEIF ( iMaxLoc(1) == 1 ) THEN - State_Met(LCHNK)%isLand(1,J) = .True. - State_Met(LCHNK)%isWater(1,J) = .False. - State_Met(LCHNK)%isIce(1,J) = .False. - ELSEIF ( iMaxLoc(1) == 2 ) THEN - State_Met(LCHNK)%isLand(1,J) = .False. - State_Met(LCHNK)%isWater(1,J) = .False. - State_Met(LCHNK)%isIce(1,J) = .True. - ELSE - Write(iulog,*) " iMaxLoc gets value: ", iMaxLoc - ErrMsg = 'Failed to figure out land/water' - CALL Error_Stop( ErrMsg, ThisLoc ) - ENDIF - - State_Met(LCHNK)%isSnow(1,J) = ( State_Met(LCHNK)%FRSEAICE(1,J) > 0.0e+0_fp & - .or. State_Met(LCHNK)%SNODP(1,J) > 0.01 ) +! iMaxLoc = MAXLOC( (/ State_Met(LCHNK)%FRLAND(1,J) + & +! State_Met(LCHNK)%FRLANDIC(1,J) + & +! State_Met(LCHNK)%FRLAKE(1,J), & +! State_Met(LCHNK)%FRSEAICE(1,J), & +! State_Met(LCHNK)%FROCEAN(1,J) - & +! State_Met(LCHNK)%FRSEAICE(1,J) /) ) +! IF ( iMaxLoc(1) == 3 ) iMaxLoc(1) = 0 +! ! reset ocean to 0 +! +! ! Field : LWI +! ! Description: Land/water indices +! ! Unit : - +! ! Dimensions : nX, nY +! State_Met(LCHNK)%LWI(1,J) = FLOAT( iMaxLoc(1) ) +! +! IF ( iMaxLoc(1) == 0 ) THEN +! State_Met(LCHNK)%isLand(1,J) = .False. +! State_Met(LCHNK)%isWater(1,J) = .True. +! State_Met(LCHNK)%isIce(1,J) = .False. +! ELSEIF ( iMaxLoc(1) == 1 ) THEN +! State_Met(LCHNK)%isLand(1,J) = .True. +! State_Met(LCHNK)%isWater(1,J) = .False. +! State_Met(LCHNK)%isIce(1,J) = .False. +! ELSEIF ( iMaxLoc(1) == 2 ) THEN +! State_Met(LCHNK)%isLand(1,J) = .False. +! State_Met(LCHNK)%isWater(1,J) = .False. +! State_Met(LCHNK)%isIce(1,J) = .True. +! ELSE +! Write(iulog,*) " iMaxLoc gets value: ", iMaxLoc +! ErrMsg = 'Failed to figure out land/water' +! CALL Error_Stop( ErrMsg, ThisLoc ) +! ENDIF +! +! State_Met(LCHNK)%isSnow(1,J) = ( State_Met(LCHNK)%FRSEAICE(1,J) > 0.0e+0_fp & +! .or. State_Met(LCHNK)%SNODP(1,J) > 0.01 ) + State_Met(LCHNK)%isSnow(1,J) = ( State_Met(LCHNK)%SNODP(1,J) > 0.01 ) ENDDO @@ -3640,17 +3651,19 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) ! (stored as SurfaceFlux = -dflx) !----------------------------------------------------------------------- - DO ND = 1, State_Chm(BEGCHUNK)%nDryDep - ! Get the species ID from the drydep ID - N = State_Chm(BEGCHUNK)%Map_DryDep(ND) - IF ( N <= 0 ) CYCLE - - M = map2GCinv(N) - IF ( M <= 0 ) CYCLE - - cam_in%cflx(1:nY,M) = cam_in%cflx(1:nY,M) & - + State_Chm(LCHNK)%SurfaceFlux(1,1:nY,N) - ENDDO + IF ( Input_Opt%LDryD ) THEN + DO ND = 1, State_Chm(BEGCHUNK)%nDryDep + ! Get the species ID from the drydep ID + N = State_Chm(BEGCHUNK)%Map_DryDep(ND) + IF ( N <= 0 ) CYCLE + + M = map2GCinv(N) + IF ( M <= 0 ) CYCLE + + cam_in%cflx(1:nY,M) = cam_in%cflx(1:nY,M) & + + State_Chm(LCHNK)%SurfaceFlux(1,1:nY,N) + ENDDO + ENDIF !----------------------------------------------------------------------- ! Add non-surface emissions diff --git a/src/physics/cam/physpkg.F90 b/src/physics/cam/physpkg.F90 index 0db55d6e64..6c3fa00523 100644 --- a/src/physics/cam/physpkg.F90 +++ b/src/physics/cam/physpkg.F90 @@ -1649,22 +1649,23 @@ subroutine tphysac (ztodt, cam_in, & ! aerosol dry deposition processes call t_startf('aero_drydep') - if (trim(cam_take_snapshot_before) == "aero_model_drydep") then - call cam_snapshot_all_outfld_tphysac(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf,& - fh2o, surfric, obklen, flx_heat) - end if - - 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 physics_update(state, ptend, ztodt, tend) - - if (trim(cam_take_snapshot_after) == "aero_model_drydep") then - call cam_snapshot_all_outfld_tphysac(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf,& - fh2o, surfric, obklen, flx_heat) - end if +! ewl: turn off aerosol dry deposition +! if (trim(cam_take_snapshot_before) == "aero_model_drydep") then +! call cam_snapshot_all_outfld_tphysac(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf,& +! fh2o, surfric, obklen, flx_heat) +! end if +! +! 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 physics_update(state, ptend, ztodt, tend) +! +! if (trim(cam_take_snapshot_after) == "aero_model_drydep") then +! call cam_snapshot_all_outfld_tphysac(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf,& +! fh2o, surfric, obklen, flx_heat) +! end if call t_stopf('aero_drydep') From 97f4a30fac1cb4933c40016d5d81ae0e18b70bb3 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Fri, 24 Jun 2022 12:02:51 -0600 Subject: [PATCH 028/291] Kludge to get by missing Henry's Law coeffs for certain species --- src/chemistry/geoschem/mo_neu_wetdep.F90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/chemistry/geoschem/mo_neu_wetdep.F90 b/src/chemistry/geoschem/mo_neu_wetdep.F90 index b70718015a..809df9ad86 100644 --- a/src/chemistry/geoschem/mo_neu_wetdep.F90 +++ b/src/chemistry/geoschem/mo_neu_wetdep.F90 @@ -169,8 +169,10 @@ subroutine neu_wetdep_init end if end do if ( mapping_to_heff(m) == -99 ) then - if (masterproc) print *,'problem with mapping_to_heff of ',trim(test_name) -! call endrun() +! ewl: kludge until I add new species to species table in seq_drydep_mod.F90 +! if (masterproc) print *,'problem with mapping_to_heff of ',trim(test_name) +!! call endrun() + mapping_to_heff(m) = 1 end if ! ! special cases for NH3 and CO2 From e9b8b27b8d7eec853f9aae530415636ff53e3c80 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Fri, 24 Jun 2022 12:16:36 -0600 Subject: [PATCH 029/291] Configure compsets that use GEOS-Chem to also use HEMCO --- bld/namelist_files/use_cases/hist_geoschem.xml | 8 +++++--- cime_config/config_component.xml | 9 ++++----- 2 files changed, 9 insertions(+), 8 deletions(-) diff --git a/bld/namelist_files/use_cases/hist_geoschem.xml b/bld/namelist_files/use_cases/hist_geoschem.xml index 2c6e7842bb..7ef75a9eff 100644 --- a/bld/namelist_files/use_cases/hist_geoschem.xml +++ b/bld/namelist_files/use_cases/hist_geoschem.xml @@ -79,7 +79,7 @@ 'AODDUST', 'AODDUST2', 'T', 'U', 'V', 'O3', 'OH', 'NO3', 'HO2', - + +'' + +'' + 'ACTA','ALD2','ASOG1','ASOG2','ASOG3','ATOOH','BR2','BRCL','CH2O','EOH','ETHLN','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HG2','HG2_ANT','HG2_ARC','HG2_ATL','HG2_BB','HG2_CAM','HG2_CAN','HG2_EAF','HG2_EAS','HG2_EEU','HG2_EUR','HG2_GEO','HG2_JPN','HG2_MDE','HG2_NAF','HG2_NAT','HG2_NPA','HG2_OCE','HG2_OCN','HG2_SAF','HG2_SAM','HG2_SAS','HG2_SAT','HG2_SEA','HG2_SO','HG2_SOV','HG2_STR','HG2_USA','HG2_WAF','HI','HMHP','HMML','HNO3','HOBR','HOCL','HOI','HONIT','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','ITCN','ITHN','LIMO','LVOC','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MEK','MGLY','MOH','MONITS','MONITU','MP','MPAN','MPN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','NH3','OPOG1','OPOG2','PAN','POG1','POG2','POPG_BAP','POPG_PHE','POPG_PYR','PP','PPN','PROPNN','PRPE','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2','TSOG0','TSOG1','TSOG2','TSOG3','AERI','ASOA1','ASOA2','ASOA3','ASOAN','BCPI','BCPO','BE10','BE10STRAT','BE7','BE7STRAT','BRSALA','BRSALC','DST1','DST2','DST3','DST4','DSTAL1','DSTAL2','DSTAL3','DSTAL4','HGP','HGP_ANT','HGP_ARC','HGP_ATL','HGP_BB','HGP_CAM','HGP_CAN','HGP_EAF','HGP_EAS','HGP_EEU','HGP_EUR','HGP_GEO','HGP_JPN','HGP_MDE','HGP_NAF','HGP_NAT','HGP_NPA','HGP_OCE','HGP_OCN','HGP_SAF','HGP_SAM','HGP_SAS','HGP_SAT','HGP_SEA','HGP_SO','HGP_SOV','HGP_STR','HGP_USA','HGP_WAF','INDIOL','IONITA','ISALA','ISALC','LVOCOA','MONITA','MOPI','MOPO','MSA','NH4','NIT','NITD1','NITD2','NITD3','NITD4','NITS','OCPI','OCPO','OPOA1','OPOA2','PB210','PB210STRAT','PFE','POA1','POA2','POPPBCPI_BAP','POPPBCPI_PHE','POPPBCPI_PYR','POPPBCPO_BAP','POPPBCPO_PHE','POPPBCPO_PYR','POPPOCPI_BAP','POPPOCPI_PHE','POPPOCPI_PYR','POPPOCPO_BAP','POPPOCPO_PHE','POPPOCPO_PYR','SALA','SALAAL','SALACL','SALC','SALCAL','SALCCL','SO4','SO4D1','SO4D2','SO4D3','SO4D4','SO4S','SOAGX','SOAIE','SOAS','TSOA0','TSOA1','TSOA2','TSOA3', diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index 9a3ec114a0..6d95460f67 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -129,17 +129,18 @@ -phys cam_dev -chem trop_strat_mam4_vbs - -chem geoschem_mam4 + -chem geoschem_mam4 -hemco -chem trop_mam7 -chem trop_strat_mam4_vbsext -chem trop_strat_mam4_ts2 + -chem geoschem -hemco -clubb_sgs -dyn eul -scam -rad camrt -chem none -spcam_nx 32 -spcam_ny 1 -spcam_dx 4000 -spcam_dt 20 -phys spcam_sam1mom -rad camrt -chem none -spcam_nx 32 -spcam_ny 1 -spcam_dx 4000 -spcam_dt 20 -phys spcam_sam1mom -spcam_clubb_sgs -rad rrtmg -chem trop_mam3 -spcam_nx 32 -spcam_ny 1 -spcam_dx 4000 -spcam_dt 20 -phys spcam_m2005 - -rad rrtmg -chem geoschem_mam3 -spcam_nx 32 -spcam_ny 1 -spcam_dx 4000 -spcam_dt 20 -phys spcam_m2005 + -rad rrtmg -chem geoschem_mam3 -hemco -spcam_nx 32 -spcam_ny 1 -spcam_dx 4000 -spcam_dt 20 -phys spcam_m2005 -rad rrtmg -chem trop_mam3 -spcam_nx 32 -spcam_ny 1 -spcam_dx 4000 -spcam_dt 20 -phys spcam_m2005 -spcam_clubb_sgs -chem trop_mozart @@ -175,9 +176,7 @@ -phys adiabatic -phys tj2016 -analytic_ic -phys held_suarez -analytic_ic - -chem geoschem - -chem geoschem_mam4 - -phys held_suarez -chem geoschem -analytic_ic + -phys held_suarez -chem geoschem -hemco -analytic_ic -phys kessler -chem terminator -analytic_ic -nadv_tt=6 From ae59e64449a8797cf65a77f2b29908e7034055ed Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Wed, 29 Jun 2022 13:06:45 -0600 Subject: [PATCH 030/291] Added high-level log prints Signed-off-by: Lizzie Lundgren --- src/cpl/nuopc/atm_comp_nuopc.F90 | 18 ++++++++++++++++++ src/physics/cam/physpkg.F90 | 25 +++++++++++++++++++++++++ 2 files changed, 43 insertions(+) diff --git a/src/cpl/nuopc/atm_comp_nuopc.F90 b/src/cpl/nuopc/atm_comp_nuopc.F90 index 0a69dffe5d..9e62c6c77a 100644 --- a/src/cpl/nuopc/atm_comp_nuopc.F90 +++ b/src/cpl/nuopc/atm_comp_nuopc.F90 @@ -614,6 +614,8 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) stop_ymd=stop_ymd, stop_tod=stop_tod, curr_ymd=curr_ymd, curr_tod=curr_tod, & cam_out=cam_out, cam_in=cam_in) + if ( masterproc) print *, "ewl: in atm_comp_nuopc.F90: after cam_init" + if (mediator_present) then if (single_column) then @@ -735,6 +737,8 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) end if ! end of mediator_present if-block + if ( masterproc) print *, "ewl: in atm_comp_nuopc.F90: after mediator_present block" + call shr_file_setLogUnit (shrlogunit) #if (defined _MEMTRACE) @@ -750,6 +754,8 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) end if + if ( masterproc) print *, "ewl: in atm_comp_nuopc.F90: end of InitializeRealize" + end subroutine InitializeRealize !=============================================================================== @@ -997,6 +1003,8 @@ subroutine ModelAdvance(gcomp, rc) rc = ESMF_SUCCESS + if ( masterproc) print *, "ewl: At start of ModelAdvance" + !$ call omp_set_num_threads(nthrds) call shr_file_getLogUnit (shrlogunit) @@ -1096,14 +1104,20 @@ subroutine ModelAdvance(gcomp, rc) ! Run CAM (run2, run3, run4) + if ( masterproc) print *, "ewl: In ModelAdvance: before cam_run2" + call t_startf ('CAM_run2') call cam_run2( cam_out, cam_in ) call t_stopf ('CAM_run2') + if ( masterproc) print *, "ewl: In ModelAdvance: before cam_run3" + call t_startf ('CAM_run3') call cam_run3( cam_out ) call t_stopf ('CAM_run3') + if ( masterproc) print *, "ewl: In ModelAdvance: before cam_run4" + call t_startf ('CAM_run4') call cam_run4( cam_out, cam_in, rstwr, nlend, & yr_spec=yr_sync, mon_spec=mon_sync, day_spec=day_sync, sec_spec=tod_sync) @@ -1111,12 +1125,16 @@ subroutine ModelAdvance(gcomp, rc) ! Advance cam time step + if ( masterproc) print *, "ewl: In ModelAdvance: advancing timestep" + call t_startf ('CAM_adv_timestep') call advance_timestep() call t_stopf ('CAM_adv_timestep') ! Run cam radiation/clouds (run1) + if ( masterproc) print *, "ewl: In ModelAdvance: before cam_run1" + call t_startf ('CAM_run1') call cam_run1 ( cam_in, cam_out ) call t_stopf ('CAM_run1') diff --git a/src/physics/cam/physpkg.F90 b/src/physics/cam/physpkg.F90 index 6c3fa00523..e5116ff470 100644 --- a/src/physics/cam/physpkg.F90 +++ b/src/physics/cam/physpkg.F90 @@ -1557,14 +1557,19 @@ subroutine tphysac (ztodt, cam_in, & !=================================================== if (chem_is_active()) then + if (masterproc) print *, "ewl: cam/physpkg.F90: before chemistry" + if (trim(cam_take_snapshot_before) == "chem_timestep_tend") then call cam_snapshot_all_outfld_tphysac(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf,& fh2o, surfric, obklen, flx_heat) end if + if (masterproc) print *, "ewl: cam/physpkg.F90: before chem_timestep_tend" + call chem_timestep_tend(state, ptend, cam_in, cam_out, ztodt, & pbuf, fh2o=fh2o) + if (masterproc) print *, "ewl: cam/physpkg.F90: chem_timestep_tend complete" if ( (trim(cam_take_snapshot_after) == "chem_timestep_tend") .and. & (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then @@ -1587,6 +1592,8 @@ subroutine tphysac (ztodt, cam_in, & ! Call vertical diffusion code (pbl, free atmosphere and molecular) !=================================================== + if (masterproc) print *, "ewl: cam/physpkg.F90: before vertical diffusion" + call t_startf('vertical_diffusion_tend') if (trim(cam_take_snapshot_before) == "vertical_diffusion_section") then @@ -1600,6 +1607,9 @@ subroutine tphysac (ztodt, cam_in, & !------------------------------------------ ! Call major diffusion for extended model !------------------------------------------ + + if (masterproc) print *, "ewl: cam/physpkg.F90: before major diffusion" + if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then call waccmx_phys_mspd_tend (ztodt ,state ,ptend) endif @@ -1626,6 +1636,9 @@ subroutine tphysac (ztodt, cam_in, & !=================================================== ! Rayleigh friction calculation !=================================================== + + if (masterproc) print *, "ewl: cam/physpkg.F90: before rayleigh friction calculation" + call t_startf('rayleigh_friction') call rayleigh_friction_tend( ztodt, state, ptend) if ( ptend%lu ) then @@ -1649,6 +1662,8 @@ subroutine tphysac (ztodt, cam_in, & ! aerosol dry deposition processes call t_startf('aero_drydep') + if (masterproc) print *, "ewl: cam/physpkg.F90: before aerosol dry deposition processes...skipping!" + ! ewl: turn off aerosol dry deposition ! if (trim(cam_take_snapshot_before) == "aero_model_drydep") then ! call cam_snapshot_all_outfld_tphysac(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf,& @@ -1677,6 +1692,9 @@ subroutine tphysac (ztodt, cam_in, & ! that cam_out%xxxdryxxx fields have already been set for CAM aerosols and cam_out ! can be added to for CARMA aerosols. if (carma_do_aerosol) then + + if (masterproc) print *, "ewl: cam/physpkg.F90: before carma microphysics" + call t_startf('carma_timestep_tend') call carma_timestep_tend(state, cam_in, cam_out, ptend, ztodt, pbuf, obklen=obklen, ustar=surfric) call physics_update(state, ptend, ztodt, tend) @@ -1689,6 +1707,8 @@ subroutine tphysac (ztodt, cam_in, & !--------------------------------------------------------------------------------- ! ... enforce charge neutrality !--------------------------------------------------------------------------------- + if (masterproc) print *, "ewl: cam/physpkg.F90: before enforcing charge neutrality" + call charge_balance(state, pbuf) !=================================================== @@ -1696,6 +1716,8 @@ subroutine tphysac (ztodt, cam_in, & !=================================================== call t_startf('gw_tend') + if (masterproc) print *, "ewl: cam/physpkg.F90: before gravity wave drag" + if (trim(cam_take_snapshot_before) == "gw_tend") then call cam_snapshot_all_outfld_tphysac(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf,& fh2o, surfric, obklen, flx_heat) @@ -1781,6 +1803,9 @@ subroutine tphysac (ztodt, cam_in, & !---------------------------------------------------------------------------- ! Call ionosphere routines for extended model if mode is set to ionosphere !---------------------------------------------------------------------------- + + if (masterproc) print *, "ewl: cam/physpkg.F90: before ionosphere routines" + if( waccmx_is('ionosphere') ) then call waccmx_phys_ion_elec_temp_tend(state, ptend, pbuf, ztodt) endif From aae00e757b2a3bc00323d6e5b76b970735714b3d Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Thu, 30 Jun 2022 14:11:05 -0600 Subject: [PATCH 031/291] Use same RUN_STARTDATE for compset FCHIST_GC as used in FCHIST Signed-off-by: Lizzie Lundgren --- cime_config/config_compsets.xml | 1 + 1 file changed, 1 insertion(+) diff --git a/cime_config/config_compsets.xml b/cime_config/config_compsets.xml index c9a9511796..90f1596edd 100644 --- a/cime_config/config_compsets.xml +++ b/cime_config/config_compsets.xml @@ -548,6 +548,7 @@ 1980-01-01 1850-01-01 2010-01-01 + 2010-01-01 2013-01-01 1995-01-01 1995-01-01 From e27c049c54db0d6833b5035eaa3b87d00e2e77e3 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Thu, 30 Jun 2022 14:50:46 -0600 Subject: [PATCH 032/291] Revert hist_geoschem.xml to original; will adjust in user_nl_cam --- bld/namelist_files/use_cases/hist_geoschem.xml | 9 --------- 1 file changed, 9 deletions(-) diff --git a/bld/namelist_files/use_cases/hist_geoschem.xml b/bld/namelist_files/use_cases/hist_geoschem.xml index 7ef75a9eff..5d446229f6 100644 --- a/bld/namelist_files/use_cases/hist_geoschem.xml +++ b/bld/namelist_files/use_cases/hist_geoschem.xml @@ -79,8 +79,6 @@ 'AODDUST', 'AODDUST2', 'T', 'U', 'V', 'O3', 'OH', 'NO3', 'HO2', - - -'' - -'' - From 87e351129955e146c631f3579ab045f5de94cf05 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Thu, 30 Jun 2022 14:50:58 -0600 Subject: [PATCH 033/291] Remove compset that uses geoschem_mam3 Signed-off-by: Lizzie Lundgren --- cime_config/config_component.xml | 1 - 1 file changed, 1 deletion(-) diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index 6d95460f67..6be27aa18b 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -140,7 +140,6 @@ -rad camrt -chem none -spcam_nx 32 -spcam_ny 1 -spcam_dx 4000 -spcam_dt 20 -phys spcam_sam1mom -rad camrt -chem none -spcam_nx 32 -spcam_ny 1 -spcam_dx 4000 -spcam_dt 20 -phys spcam_sam1mom -spcam_clubb_sgs -rad rrtmg -chem trop_mam3 -spcam_nx 32 -spcam_ny 1 -spcam_dx 4000 -spcam_dt 20 -phys spcam_m2005 - -rad rrtmg -chem geoschem_mam3 -hemco -spcam_nx 32 -spcam_ny 1 -spcam_dx 4000 -spcam_dt 20 -phys spcam_m2005 -rad rrtmg -chem trop_mam3 -spcam_nx 32 -spcam_ny 1 -spcam_dx 4000 -spcam_dt 20 -phys spcam_m2005 -spcam_clubb_sgs -chem trop_mozart From 19832a954840caaf924015c5b620faaad06555be Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Thu, 14 Jul 2022 09:13:26 -0600 Subject: [PATCH 034/291] No diff updates to GEOS-Chem use cases to document diffs with non-GC Also deleted unused use case defined in geoschem_baro_moist.xml Signed-off-by: Lizzie Lundgren --- .../use_cases/2000_geoschem.xml | 42 +++++++++++++++---- .../use_cases/2010_geoschem.xml | 28 +++++++++++-- .../use_cases/hist_geoschem.xml | 15 ++++++- bld/namelist_files/use_cases/sd_geoschem.xml | 37 +++++++++------- 4 files changed, 92 insertions(+), 30 deletions(-) diff --git a/bld/namelist_files/use_cases/2000_geoschem.xml b/bld/namelist_files/use_cases/2000_geoschem.xml index 5c8cb2a45e..ab14bbedf2 100644 --- a/bld/namelist_files/use_cases/2000_geoschem.xml +++ b/bld/namelist_files/use_cases/2000_geoschem.xml @@ -1,7 +1,10 @@ - + + -00010101 + + + /glade/p/univ/umit0034/ExtData/CHEM_INPUTS/ @@ -37,13 +40,17 @@ 'MTPO = terpinene_g + terpinene_a + terpinolene + myrcene + ocimene_al + ocimene_t_b + ocimene_c_b + thujene_a + 2met_styrene + cymene_p + cymene_o + bornene + fenchene_a + camphene + phellandrene_a + phellandrene_b' - +'xactive_lnd' + + + +00010101 + + atm/cam/solar/SolarForcing1995-2005avg_c160929.nc 20000101 FIXED -'xactive_lnd' - .true. .true. @@ -55,12 +62,27 @@ 2000 atm/waccm/lb/LBC_2000climo_CMIP6_0p5degLat_c180227.nc - + + - -'CYCLICAL' + + + + + + + + +'CYCLICAL' 2000 + + + + + + + 1,30,365,240,240,480,365,73,30 @@ -77,14 +99,18 @@ .false. .false. + 'Q', 'U', 'V', 'OMEGA', 'T', 'PS', + 'O3', 'NO', 'NO2', 'CO', 'HNO3', 'CH4', 'NIT', 'NH4', 'NH3', 'SO4', 'SO2', 'OH', + + 'ACET','ACTA','ALD2','ASOG1','ASOG2','ASOG3','ATOOH','BR2','BRCL','BRNO3','CH2O','CL2','CLNO2','CLNO3','CLO','CLOO','EOH','ETHLN','ETNO3','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HG0','HG0_ANT','HG0_ARC','HG0_ATL','HG0_BB','HG0_CAM','HG0_CAN','HG0_EAF','HG0_EAS','HG0_EEU','HG0_EUR','HG0_GEO','HG0_JPN','HG0_MDE','HG0_NAF','HG0_NAT','HG0_NPA','HG0_OCE','HG0_OCN','HG0_SAF','HG0_SAM','HG0_SAS','HG0_SAT','HG0_SEA','HG0_SO','HG0_SOV','HG0_STR','HG0_USA','HG0_WAF','HG2','HG2_ANT','HG2_ARC','HG2_ATL','HG2_BB','HG2_CAM','HG2_CAN','HG2_EAF','HG2_EAS','HG2_EEU','HG2_EUR','HG2_GEO','HG2_JPN','HG2_MDE','HG2_NAF','HG2_NAT','HG2_NPA','HG2_OCE','HG2_OCN','HG2_SAF','HG2_SAM','HG2_SAS','HG2_SAT','HG2_SEA','HG2_SO','HG2_SOV','HG2_STR','HG2_USA','HG2_WAF','HI','HMHP','HMML','HNO3','HOBR','HOCL','HOI','HONIT','HPALD1','HPALD2','HPALD3','HPALD4','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDC','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','IPRNO3','ITCN','ITHN','LIMO','LVOC','MACR','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MENO3','MGLY','MOH','MONITS','MONITU','MPAN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','N2O5','NH3','NO2','NPRNO3','O3','O3AFBL','O3ASBL','O3ATBL','O3EUBL','O3INIT','O3MT','O3NABL','O3PCBL','O3ROW','O3STRAT','O3USA','O3UT','OPOG1','OPOG2','PAN','POG1','POG2','POPG_BAP','POPG_PHE','POPG_PYR','PP','PPN','PROPNN','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2','TSOG0','TSOG1','TSOG2','TSOG3','AERI','ASOA1','ASOA2','ASOA3','ASOAN','BCPI','BCPO','BE10','BE10STRAT','BE7','BE7STRAT','BRSALA','BRSALC','DST1','DST2','DST3','DST4','DSTAL1','DSTAL2','DSTAL3','DSTAL4','HGP','HGP_ANT','HGP_ARC','HGP_ATL','HGP_BB','HGP_CAM','HGP_CAN','HGP_EAF','HGP_EAS','HGP_EEU','HGP_EUR','HGP_GEO','HGP_JPN','HGP_MDE','HGP_NAF','HGP_NAT','HGP_NPA','HGP_OCE','HGP_OCN','HGP_SAF','HGP_SAM','HGP_SAS','HGP_SAT','HGP_SEA','HGP_SO','HGP_SOV','HGP_STR','HGP_USA','HGP_WAF','INDIOL','IONITA','ISALA','ISALC','LVOCOA','MONITA','MOPI','MOPO','MSA','NH4','NIT','NITD1','NITD2','NITD3','NITD4','NITS','OCPI','OCPO','OPOA1','OPOA2','PB210','PB210STRAT','PFE','POA1','POA2','POPPBCPI_BAP','POPPBCPI_PHE','POPPBCPI_PYR','POPPBCPO_BAP','POPPBCPO_PHE','POPPBCPO_PYR','POPPOCPI_BAP','POPPOCPI_PHE','POPPOCPI_PYR','POPPOCPO_BAP','POPPOCPO_PHE','POPPOCPO_PYR','SALA','SALAAL','SALACL','SALC','SALCAL','SALCCL','SO4','SO4D1','SO4D2','SO4D3','SO4D4','SO4S','SOAGX','SOAIE','SOAS','TSOA0','TSOA1','TSOA2','TSOA3', diff --git a/bld/namelist_files/use_cases/2010_geoschem.xml b/bld/namelist_files/use_cases/2010_geoschem.xml index 8d37e9c9b9..c9d50d8389 100644 --- a/bld/namelist_files/use_cases/2010_geoschem.xml +++ b/bld/namelist_files/use_cases/2010_geoschem.xml @@ -1,8 +1,8 @@ - + -00010101 + /glade/p/univ/umit0034/ExtData/CHEM_INPUTS/ @@ -38,13 +38,17 @@ 'MTPO = terpinene_g + terpinene_a + terpinolene + myrcene + ocimene_al + ocimene_t_b + ocimene_c_b + thujene_a + 2met_styrene + cymene_p + cymene_o + bornene + fenchene_a + camphene + phellandrene_a + phellandrene_b' +'xactive_lnd' + + + +00010101 + atm/cam/solar/SolarForcing2006-2014avg_c180917.nc 20100101 FIXED -'xactive_lnd' - .true. .true. @@ -56,6 +60,19 @@ 2010 atm/waccm/lb/LBC_2010climo_CMIP6_0p5degLat_c180227.nc + + + + + + + + + + + + + @@ -73,10 +90,13 @@ .false. .false. + 'Q', 'U', 'V', 'OMEGA', 'T', 'PS', + + 'ACET','ACTA','ALD2','ASOG1','ASOG2','ASOG3','ATOOH','BR2','BRCL','BRNO3','CH2O','CL2','CLNO2','CLNO3','CLO','CLOO','EOH','ETHLN','ETNO3','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HG0','HG0_ANT','HG0_ARC','HG0_ATL','HG0_BB','HG0_CAM','HG0_CAN','HG0_EAF','HG0_EAS','HG0_EEU','HG0_EUR','HG0_GEO','HG0_JPN','HG0_MDE','HG0_NAF','HG0_NAT','HG0_NPA','HG0_OCE','HG0_OCN','HG0_SAF','HG0_SAM','HG0_SAS','HG0_SAT','HG0_SEA','HG0_SO','HG0_SOV','HG0_STR','HG0_USA','HG0_WAF','HG2','HG2_ANT','HG2_ARC','HG2_ATL','HG2_BB','HG2_CAM','HG2_CAN','HG2_EAF','HG2_EAS','HG2_EEU','HG2_EUR','HG2_GEO','HG2_JPN','HG2_MDE','HG2_NAF','HG2_NAT','HG2_NPA','HG2_OCE','HG2_OCN','HG2_SAF','HG2_SAM','HG2_SAS','HG2_SAT','HG2_SEA','HG2_SO','HG2_SOV','HG2_STR','HG2_USA','HG2_WAF','HI','HMHP','HMML','HNO3','HOBR','HOCL','HOI','HONIT','HPALD1','HPALD2','HPALD3','HPALD4','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDC','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','IPRNO3','ITCN','ITHN','LIMO','LVOC','MACR','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MENO3','MGLY','MOH','MONITS','MONITU','MPAN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','N2O5','NH3','NO2','NPRNO3','O3','O3AFBL','O3ASBL','O3ATBL','O3EUBL','O3INIT','O3MT','O3NABL','O3PCBL','O3ROW','O3STRAT','O3USA','O3UT','OPOG1','OPOG2','PAN','POG1','POG2','POPG_BAP','POPG_PHE','POPG_PYR','PP','PPN','PROPNN','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2','TSOG0','TSOG1','TSOG2','TSOG3','AERI','ASOA1','ASOA2','ASOA3','ASOAN','BCPI','BCPO','BE10','BE10STRAT','BE7','BE7STRAT','BRSALA','BRSALC','DST1','DST2','DST3','DST4','DSTAL1','DSTAL2','DSTAL3','DSTAL4','HGP','HGP_ANT','HGP_ARC','HGP_ATL','HGP_BB','HGP_CAM','HGP_CAN','HGP_EAF','HGP_EAS','HGP_EEU','HGP_EUR','HGP_GEO','HGP_JPN','HGP_MDE','HGP_NAF','HGP_NAT','HGP_NPA','HGP_OCE','HGP_OCN','HGP_SAF','HGP_SAM','HGP_SAS','HGP_SAT','HGP_SEA','HGP_SO','HGP_SOV','HGP_STR','HGP_USA','HGP_WAF','INDIOL','IONITA','ISALA','ISALC','LVOCOA','MONITA','MOPI','MOPO','MSA','NH4','NIT','NITD1','NITD2','NITD3','NITD4','NITS','OCPI','OCPO','OPOA1','OPOA2','PB210','PB210STRAT','PFE','POA1','POA2','POPPBCPI_BAP','POPPBCPI_PHE','POPPBCPI_PYR','POPPBCPO_BAP','POPPBCPO_PHE','POPPBCPO_PYR','POPPOCPI_BAP','POPPOCPI_PHE','POPPOCPI_PYR','POPPOCPO_BAP','POPPOCPO_PHE','POPPOCPO_PYR','SALA','SALAAL','SALACL','SALC','SALCAL','SALCCL','SO4','SO4D1','SO4D2','SO4D3','SO4D4','SO4S','SOAGX','SOAIE','SOAS','TSOA0','TSOA1','TSOA2','TSOA3', diff --git a/bld/namelist_files/use_cases/hist_geoschem.xml b/bld/namelist_files/use_cases/hist_geoschem.xml index 5d446229f6..8737da0b6a 100644 --- a/bld/namelist_files/use_cases/hist_geoschem.xml +++ b/bld/namelist_files/use_cases/hist_geoschem.xml @@ -2,7 +2,9 @@ -00010101 + + + /glade/p/univ/umit0034/ExtData/CHEM_INPUTS/ @@ -12,7 +14,6 @@ /glade/p/cesmdata/cseg/inputdata/atm/cam/coords/fv0.9x1.25_esmf_141008.nc' - /glade/p/cesmdata/cseg/inputdata/atm/cam/coords/fv1.9x2.5_esmf_141008.nc' @@ -38,6 +39,10 @@ 'MTPO = terpinene_g + terpinene_a + terpinolene + myrcene + ocimene_al + ocimene_t_b + ocimene_c_b + thujene_a + 2met_styrene + cymene_p + cymene_o + bornene + fenchene_a + camphene + phellandrene_a + phellandrene_b' + + +00010101 + atm/cam/solar/SolarForcingCMIP6_18491230-23000102_c20200615.nc @@ -55,7 +60,10 @@ INTERP_MISSING_MONTHS + + + INTERP_MISSING_MONTHS 'noy', 'nhx' @@ -77,6 +85,7 @@ .false. + 'AODDUST', 'AODDUST2', 'T', 'U', 'V', 'O3', 'OH', 'NO3', 'HO2', 'LNO_COL_PROD', 'NO2_CLXF', 'SFNO', 'SFNH3', 'BRO', @@ -183,6 +192,8 @@ 'soa2_a2_CHML', 'soa3_a2_CHML', 'soa4_a2_CHML', 'soa5_a2_CHML', 'so4_a1_CHMP', 'so4_a2_CHMP', 'so4_a3_CHMP', 'H2SO4_sfnnuc1', 'num_a2_sfnnuc1', --> + + 'ACET','ACTA','ALD2','ASOG1','ASOG2','ASOG3','ATOOH','BR2','BRCL','BRNO3','CH2O','CL2','CLNO2','CLNO3','CLO','CLOO','EOH','ETHLN','ETNO3','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HG0','HG0_ANT','HG0_ARC','HG0_ATL','HG0_BB','HG0_CAM','HG0_CAN','HG0_EAF','HG0_EAS','HG0_EEU','HG0_EUR','HG0_GEO','HG0_JPN','HG0_MDE','HG0_NAF','HG0_NAT','HG0_NPA','HG0_OCE','HG0_OCN','HG0_SAF','HG0_SAM','HG0_SAS','HG0_SAT','HG0_SEA','HG0_SO','HG0_SOV','HG0_STR','HG0_USA','HG0_WAF','HG2','HG2_ANT','HG2_ARC','HG2_ATL','HG2_BB','HG2_CAM','HG2_CAN','HG2_EAF','HG2_EAS','HG2_EEU','HG2_EUR','HG2_GEO','HG2_JPN','HG2_MDE','HG2_NAF','HG2_NAT','HG2_NPA','HG2_OCE','HG2_OCN','HG2_SAF','HG2_SAM','HG2_SAS','HG2_SAT','HG2_SEA','HG2_SO','HG2_SOV','HG2_STR','HG2_USA','HG2_WAF','HI','HMHP','HMML','HNO3','HOBR','HOCL','HOI','HONIT','HPALD1','HPALD2','HPALD3','HPALD4','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDC','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','IPRNO3','ITCN','ITHN','LIMO','LVOC','MACR','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MENO3','MGLY','MOH','MONITS','MONITU','MPAN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','N2O5','NH3','NO2','NPRNO3','O3','O3AFBL','O3ASBL','O3ATBL','O3EUBL','O3INIT','O3MT','O3NABL','O3PCBL','O3ROW','O3STRAT','O3USA','O3UT','OPOG1','OPOG2','PAN','POG1','POG2','POPG_BAP','POPG_PHE','POPG_PYR','PP','PPN','PROPNN','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2','TSOG0','TSOG1','TSOG2','TSOG3','AERI','ASOA1','ASOA2','ASOA3','ASOAN','BCPI','BCPO','BE10','BE10STRAT','BE7','BE7STRAT','BRSALA','BRSALC','DST1','DST2','DST3','DST4','DSTAL1','DSTAL2','DSTAL3','DSTAL4','HGP','HGP_ANT','HGP_ARC','HGP_ATL','HGP_BB','HGP_CAM','HGP_CAN','HGP_EAF','HGP_EAS','HGP_EEU','HGP_EUR','HGP_GEO','HGP_JPN','HGP_MDE','HGP_NAF','HGP_NAT','HGP_NPA','HGP_OCE','HGP_OCN','HGP_SAF','HGP_SAM','HGP_SAS','HGP_SAT','HGP_SEA','HGP_SO','HGP_SOV','HGP_STR','HGP_USA','HGP_WAF','INDIOL','IONITA','ISALA','ISALC','LVOCOA','MONITA','MOPI','MOPO','MSA','NH4','NIT','NITD1','NITD2','NITD3','NITD4','NITS','OCPI','OCPO','OPOA1','OPOA2','PB210','PB210STRAT','PFE','POA1','POA2','POPPBCPI_BAP','POPPBCPI_PHE','POPPBCPI_PYR','POPPBCPO_BAP','POPPBCPO_PHE','POPPBCPO_PYR','POPPOCPI_BAP','POPPOCPI_PHE','POPPOCPI_PYR','POPPOCPO_BAP','POPPOCPO_PHE','POPPOCPO_PYR','SALA','SALAAL','SALACL','SALC','SALCAL','SALCCL','SO4','SO4D1','SO4D2','SO4D3','SO4D4','SO4S','SOAGX','SOAIE','SOAS','TSOA0','TSOA1','TSOA2','TSOA3', diff --git a/bld/namelist_files/use_cases/sd_geoschem.xml b/bld/namelist_files/use_cases/sd_geoschem.xml index dd613f7619..49dbbf3f3b 100644 --- a/bld/namelist_files/use_cases/sd_geoschem.xml +++ b/bld/namelist_files/use_cases/sd_geoschem.xml @@ -2,21 +2,20 @@ -20050101 + + + /glade/p/univ/umit0034/ExtData/CHEM_INPUTS/ -atm/cam/met/MERRA2/0.5x0.63/fv_0.47x0.63_nc3000_Co030_Fi001_PF_nullRR_Nsw021_MERRA2_c180612.nc +/glade/p/univ/umit0034/Shared/GEOS-Chem/f.e20.FCSD.f19_f19_mg17.cesm2.1-exp002.001.cam.i.2005-01-01-00000_c180801.nc +atm/cam/met/MERRA2/1.9x2.5/fv_1.9x2.5_nc3000_Nsw084_Nrs016_Co120_Fi001_ZR_GRNL_MERRA2_c190617.nc /glade/p/univ/umit0034/Shared/GEOS-Chem/f.e20.FCSD.f09_f09_mg17.cesm2.1-exp002.001.cam.i.2005-01-01-00000_c180801.nc atm/cam/met/MERRA2/0.9x1.25/fv_0.9x1.25_nc3000_Nsw042_Nrs008_Co060_Fi001_ZR_sgh30_24km_GRNL_MERRA2_c171218.nc -/glade/p/univ/umit0034/Shared/GEOS-Chem/f.e20.FCSD.f19_f19_mg17.cesm2.1-exp002.001.cam.i.2005-01-01-00000_c180801.nc -atm/cam/met/MERRA2/1.9x2.5/fv_1.9x2.5_nc3000_Nsw084_Nrs016_Co120_Fi001_ZR_GRNL_MERRA2_c190617.nc - - + /glade/p/cesmdata/cseg/inputdata/atm/cam/coords/fv0.9x1.25_esmf_141008.nc' - /glade/p/cesmdata/cseg/inputdata/atm/cam/coords/fv1.9x2.5_esmf_141008.nc' @@ -42,9 +41,14 @@ 'MTPO = terpinene_g + terpinene_a + terpinolene + myrcene + ocimene_al + ocimene_t_b + ocimene_c_b + thujene_a + 2met_styrene + cymene_p + cymene_o + bornene + fenchene_a + camphene + phellandrene_a + phellandrene_b' + + +20050101 + 50. .true. + 2005/MERRA2_1.9x2.5_20050101.nc atm/cam/met/MERRA2/1.9x2.5 atm/cam/met/MERRA2/1.9x2.5/filenames_list_c20210302 @@ -57,14 +61,6 @@ atm/cam/met/MERRA2/0.5x0.63 atm/cam/met/MERRA2/0.5x0.63/filenames_list_c180612 -2005/MERRA2_0.9x1.25_20050101.nc -atm/cam/met/MERRA2/0.9x1.25 -atm/cam/met/MERRA2/0.9x1.25/filenames_1975-2017_c190125.txt - -2010/MERRA2_0.5x0.63_20100101.nc -atm/cam/met/MERRA2/0.5x0.63 -atm/cam/met/MERRA2/0.5x0.63/filenames_list_c180612 - atm/cam/solar/SolarForcingNRLSSI2_daily_s18820101_e20171231_c191122.nc SERIAL @@ -80,11 +76,16 @@ atm/waccm/lb/LBC_1750-2014_CMIP6_0p5degLat_c170126.nc - INTERP_MISSING_MONTHS + + + INTERP_MISSING_MONTHS + + + 1,30,365,240,240,480,365,73,30 @@ -102,6 +103,7 @@ .false. + 'AODDUST', 'AODDUST2', 'T', 'U', 'V', 'O3', 'OH', 'NO3', 'HO2', 'LNO_COL_PROD', 'NO2_CLXF', 'SFNO', 'SFNH3', 'BRO', @@ -203,6 +205,9 @@ 'BURDENSEASALTdn','BURDENBCdn', 'PM25' + + + 'ACET','ACTA','ALD2','ASOG1','ASOG2','ASOG3','ATOOH','BR2','BRCL','BRNO3','CH2O','CL2','CLNO2','CLNO3','CLO','CLOO','EOH','ETHLN','ETNO3','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HG0','HG0_ANT','HG0_ARC','HG0_ATL','HG0_BB','HG0_CAM','HG0_CAN','HG0_EAF','HG0_EAS','HG0_EEU','HG0_EUR','HG0_GEO','HG0_JPN','HG0_MDE','HG0_NAF','HG0_NAT','HG0_NPA','HG0_OCE','HG0_OCN','HG0_SAF','HG0_SAM','HG0_SAS','HG0_SAT','HG0_SEA','HG0_SO','HG0_SOV','HG0_STR','HG0_USA','HG0_WAF','HG2','HG2_ANT','HG2_ARC','HG2_ATL','HG2_BB','HG2_CAM','HG2_CAN','HG2_EAF','HG2_EAS','HG2_EEU','HG2_EUR','HG2_GEO','HG2_JPN','HG2_MDE','HG2_NAF','HG2_NAT','HG2_NPA','HG2_OCE','HG2_OCN','HG2_SAF','HG2_SAM','HG2_SAS','HG2_SAT','HG2_SEA','HG2_SO','HG2_SOV','HG2_STR','HG2_USA','HG2_WAF','HI','HMHP','HMML','HNO3','HOBR','HOCL','HOI','HONIT','HPALD1','HPALD2','HPALD3','HPALD4','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDC','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','IPRNO3','ITCN','ITHN','LIMO','LVOC','MACR','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MENO3','MGLY','MOH','MONITS','MONITU','MPAN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','N2O5','NH3','NO2','NPRNO3','O3','O3AFBL','O3ASBL','O3ATBL','O3EUBL','O3INIT','O3MT','O3NABL','O3PCBL','O3ROW','O3STRAT','O3USA','O3UT','OPOG1','OPOG2','PAN','POG1','POG2','POPG_BAP','POPG_PHE','POPG_PYR','PP','PPN','PROPNN','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2','TSOG0','TSOG1','TSOG2','TSOG3','AERI','ASOA1','ASOA2','ASOA3','ASOAN','BCPI','BCPO','BE10','BE10STRAT','BE7','BE7STRAT','BRSALA','BRSALC','DST1','DST2','DST3','DST4','DSTAL1','DSTAL2','DSTAL3','DSTAL4','HGP','HGP_ANT','HGP_ARC','HGP_ATL','HGP_BB','HGP_CAM','HGP_CAN','HGP_EAF','HGP_EAS','HGP_EEU','HGP_EUR','HGP_GEO','HGP_JPN','HGP_MDE','HGP_NAF','HGP_NAT','HGP_NPA','HGP_OCE','HGP_OCN','HGP_SAF','HGP_SAM','HGP_SAS','HGP_SAT','HGP_SEA','HGP_SO','HGP_SOV','HGP_STR','HGP_USA','HGP_WAF','INDIOL','IONITA','ISALA','ISALC','LVOCOA','MONITA','MOPI','MOPO','MSA','NH4','NIT','NITD1','NITD2','NITD3','NITD4','NITS','OCPI','OCPO','OPOA1','OPOA2','PB210','PB210STRAT','PFE','POA1','POA2','POPPBCPI_BAP','POPPBCPI_PHE','POPPBCPI_PYR','POPPBCPO_BAP','POPPBCPO_PHE','POPPBCPO_PYR','POPPOCPI_BAP','POPPOCPI_PHE','POPPOCPI_PYR','POPPOCPO_BAP','POPPOCPO_PHE','POPPOCPO_PYR','SALA','SALAAL','SALACL','SALC','SALCAL','SALCCL','SO4','SO4D1','SO4D2','SO4D3','SO4D4','SO4S','SOAGX','SOAIE','SOAS','TSOA0','TSOA1','TSOA2','TSOA3', From e6dd893c9d28618cf8a208c24f65605b42d0fe9e Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Tue, 19 Jul 2022 10:42:57 -0600 Subject: [PATCH 035/291] Clean up GEOS-Chem compset namelists -Move megan_specifier definition for GEOS-Chem in use_cases files to bld/build-namelist given chem=geoschem -Move cam_physics_mesh definitions used by HEMCO from use_cases files to namelist_defaults_cam.xml -Remove drydep_method, ext_frc_*, and srf_emis_* parameters from GEOS-Chem use case files -Delete namelist file (geoschem_baro_moist.xml) for unused GEOS-Chem compset -Set default RUN_STARTDATE for the GEOS-Chem climo compsets in config_compsets.xml -Remove ext_frc_* and srf_emis_* variables from geoschem/chemistry.F90 since not used -Fix incorrect comment in mo_chem_utls.F90 Signed-off-by: Lizzie Lundgren --- bld/build-namelist | 50 ++++++++++--- bld/namelist_files/namelist_defaults_cam.xml | 4 + .../use_cases/2000_geoschem.xml | 45 ------------ .../use_cases/2010_geoschem.xml | 40 ---------- .../use_cases/geoschem_baro_moist.xml | 27 ------- .../use_cases/hist_geoschem.xml | 38 +--------- bld/namelist_files/use_cases/sd_geoschem.xml | 35 --------- cime_config/config_compsets.xml | 2 + src/chemistry/geoschem/chemistry.F90 | 73 ++++++++++--------- src/chemistry/geoschem/mo_chem_utls.F90 | 2 +- 10 files changed, 86 insertions(+), 230 deletions(-) delete mode 100644 bld/namelist_files/use_cases/geoschem_baro_moist.xml diff --git a/bld/build-namelist b/bld/build-namelist index 2b647218fc..b993ae2bd9 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -2326,10 +2326,12 @@ if (($chem =~ /_mam4/ or $chem =~ /_mam5/) and ($phys =~ /cam6/ or $phys =~ /cam $first = 0; } } - add_default($nl, 'srf_emis_specifier', 'val'=>$val); - unless (defined $nl->get_value('srf_emis_type')) { - add_default($nl, 'srf_emis_type', 'val'=>'CYCLICAL'); - add_default($nl, 'srf_emis_cycle_yr', 'val'=>2000); + if ($chem !~ /geoschem/) { + add_default($nl, 'srf_emis_specifier', 'val'=>$val); + unless (defined $nl->get_value('srf_emis_type')) { + add_default($nl, 'srf_emis_type', 'val'=>'CYCLICAL'); + add_default($nl, 'srf_emis_cycle_yr', 'val'=>2000); + } } # Vertical emission datasets: @@ -2390,14 +2392,16 @@ if (($chem =~ /_mam4/ or $chem =~ /_mam5/) and ($phys =~ /cam6/ or $phys =~ /cam $first = 0; } } - add_default($nl, 'ext_frc_specifier', 'val'=>$val); - unless (defined $nl->get_value('ext_frc_type')) { - add_default($nl, 'ext_frc_type', 'val'=>"'CYCLICAL'"); - add_default($nl, 'ext_frc_cycle_yr', 'val'=>2000); + if ($chem !~ /geoschem/) { + add_default($nl, 'ext_frc_specifier', 'val'=>$val); + unless (defined $nl->get_value('ext_frc_type')) { + add_default($nl, 'ext_frc_type', 'val'=>"'CYCLICAL'"); + add_default($nl, 'ext_frc_cycle_yr', 'val'=>2000); + } } # MEGAN emissions - if ($chem =~ /trop_strat_mam4_vbsext/ or $chem =~ /waccm_tsmlt/ or $chem =~ /geoschem/) { + if ($chem =~ /trop_strat_mam4_vbsext/ 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 " @@ -2423,6 +2427,30 @@ 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 =~ /geoschem/) { + my $val = "'ISOP = isoprene'," + . "'MOH = methanol'," + . "'EOH = ethanol'," + . "'CH2O = formaldehyde'," + . "'ALD2 = acetaldehyde'," + . "'ACTA = acetic_acid'," + . "'ACET = acetone'," + . "'HCOOH = formic_acid'," + . "'HCN = hydrogen_cyanide'," + . "'CO = carbon_monoxide'," + . "'C2H6 = ethane'," + . "'C2H4 = ethene'," + . "'C3H8 = propane'," + . "'ALK4 = pentane + hexane + heptane + tricyclene'," + . "'PRPE = propene + butene'," + . "'TOLU = toluene'," + . "'LIMO = limonene'," + . "'MTPA = pinene_a + pinene_b + sabinene + carene_3'," + . "'MTPO = terpinene_g + terpinene_a + terpinolene + myrcene + ocimene_al + ocimene_t_b + ocimene_c_b + thujene_a + 2met_styrene + cymene_p + cymene_o + bornene + fenchene_a + camphene + phellandrene_a + phellandrene_b'"; + add_default($nl, 'megan_specifier', 'val'=>$val); + add_default($nl, 'megan_factors_file'); + add_default($nl, 'megan_mapped_emisfctrs', 'val'=>'.false.'); + } if ($chem =~ /trop_strat_mam4_vbs/ ) { my $val = "'ISOP = isoprene'," . "'MTERP = carene_3 + pinene_a + thujene_a + bornene + terpineol_4 + terpineol_a + terpinyl_ACT_a " @@ -2818,6 +2846,10 @@ else { # HEMCO $nl->set_variable_value('hemco_nl', 'hemco_config_File', "'HEMCO_Config.rc'"); +my $hco = $cfg->get('hemco'); +if ( $hco eq '1' ) { + add_default($nl, 'cam_physics_mesh'); +} # Physics options diff --git a/bld/namelist_files/namelist_defaults_cam.xml b/bld/namelist_files/namelist_defaults_cam.xml index cb49caf9c4..ebee401afb 100644 --- a/bld/namelist_files/namelist_defaults_cam.xml +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -767,6 +767,8 @@ atm/cam/coords/ne16np4_esmf_c210305.nc atm/cam/coords/ne30np4_esmf_c210305.nc atm/cam/coords/ne30pg3_esmf_20200428.nc +atm/cam/coords/fv0.9x1.25_esmf_141008.nc' +atm/cam/coords/fv1.9x2.5_esmf_141008.nc' 1.00D0 @@ -3183,4 +3185,6 @@ atm/cam/ocnfrac/domain.aqua.fv1.9x2.5.nc + + diff --git a/bld/namelist_files/use_cases/2000_geoschem.xml b/bld/namelist_files/use_cases/2000_geoschem.xml index ab14bbedf2..c20a3c66fc 100644 --- a/bld/namelist_files/use_cases/2000_geoschem.xml +++ b/bld/namelist_files/use_cases/2000_geoschem.xml @@ -12,36 +12,6 @@ /glade/p/univ/umit0034/Shared/GEOS-Chem/f.e20.FC2010.f19_f19.144.GC_vbsext.001.cam.i.0007-01-01-00000.nc - -/glade/p/cesmdata/cseg/inputdata/atm/cam/coords/fv0.9x1.25_esmf_141008.nc' - -/glade/p/cesmdata/cseg/inputdata/atm/cam/coords/fv1.9x2.5_esmf_141008.nc' - - - - 'ISOP = isoprene', - 'MOH = methanol', - 'EOH = ethanol', - 'CH2O = formaldehyde', - 'ALD2 = acetaldehyde', - 'ACTA = acetic_acid', - 'ACET = acetone', - 'HCOOH = formic_acid', - 'HCN = hydrogen_cyanide', - 'CO = carbon_monoxide', - 'C2H6 = ethane', - 'C2H4 = ethene', - 'C3H8 = propane', - 'ALK4 = pentane + hexane + heptane + tricyclene', - 'PRPE = propene + butene', - 'TOLU = toluene', - 'LIMO = limonene', - 'MTPA = pinene_a + pinene_b + sabinene + carene_3', - 'MTPO = terpinene_g + terpinene_a + terpinolene + myrcene + ocimene_al + ocimene_t_b + ocimene_c_b + thujene_a + 2met_styrene + cymene_p + cymene_o + bornene + fenchene_a + camphene + phellandrene_a + phellandrene_b' - - -'xactive_lnd' - 00010101 @@ -65,21 +35,6 @@ - - - - - - - - - -'CYCLICAL' -2000 - - - - diff --git a/bld/namelist_files/use_cases/2010_geoschem.xml b/bld/namelist_files/use_cases/2010_geoschem.xml index c9d50d8389..ece3001986 100644 --- a/bld/namelist_files/use_cases/2010_geoschem.xml +++ b/bld/namelist_files/use_cases/2010_geoschem.xml @@ -10,36 +10,6 @@ /glade/p/univ/umit0034/Shared/GEOS-Chem/f.e20.FC2010.f19_f19.144.GC_vbsext.001.cam.i.0007-01-01-00000.nc - -/glade/p/cesmdata/cseg/inputdata/atm/cam/coords/fv0.9x1.25_esmf_141008.nc' - -/glade/p/cesmdata/cseg/inputdata/atm/cam/coords/fv1.9x2.5_esmf_141008.nc' - - - - 'ISOP = isoprene', - 'MOH = methanol', - 'EOH = ethanol', - 'CH2O = formaldehyde', - 'ALD2 = acetaldehyde', - 'ACTA = acetic_acid', - 'ACET = acetone', - 'HCOOH = formic_acid', - 'HCN = hydrogen_cyanide', - 'CO = carbon_monoxide', - 'C2H6 = ethane', - 'C2H4 = ethene', - 'C3H8 = propane', - 'ALK4 = pentane + hexane + heptane + tricyclene', - 'PRPE = propene + butene', - 'TOLU = toluene', - 'LIMO = limonene', - 'MTPA = pinene_a + pinene_b + sabinene + carene_3', - 'MTPO = terpinene_g + terpinene_a + terpinolene + myrcene + ocimene_al + ocimene_t_b + ocimene_c_b + thujene_a + 2met_styrene + cymene_p + cymene_o + bornene + fenchene_a + camphene + phellandrene_a + phellandrene_b' - - -'xactive_lnd' - 00010101 @@ -62,16 +32,6 @@ - - - - - - - - - - diff --git a/bld/namelist_files/use_cases/geoschem_baro_moist.xml b/bld/namelist_files/use_cases/geoschem_baro_moist.xml deleted file mode 100644 index 51c3427f82..0000000000 --- a/bld/namelist_files/use_cases/geoschem_baro_moist.xml +++ /dev/null @@ -1,27 +0,0 @@ - - - - - 10101 - - -.false. - - -/glade/p/cesmdata/cseg/inputdata/atm/cam/coords/fv0.9x1.25_esmf_141008.nc' - -/glade/p/cesmdata/cseg/inputdata/atm/cam/coords/fv1.9x2.5_esmf_141008.nc' - - -0,-6 - - 'U:I','V:I','T:I' - -'baroclinic_wave' - - diff --git a/bld/namelist_files/use_cases/hist_geoschem.xml b/bld/namelist_files/use_cases/hist_geoschem.xml index 8737da0b6a..35f09e0474 100644 --- a/bld/namelist_files/use_cases/hist_geoschem.xml +++ b/bld/namelist_files/use_cases/hist_geoschem.xml @@ -12,33 +12,6 @@ /glade/p/univ/umit0034/Shared/GEOS-Chem/f.e20.FC2010.f19_f19.144.GC_vbsext.001.cam.i.0007-01-01-00000.nc - -/glade/p/cesmdata/cseg/inputdata/atm/cam/coords/fv0.9x1.25_esmf_141008.nc' -/glade/p/cesmdata/cseg/inputdata/atm/cam/coords/fv1.9x2.5_esmf_141008.nc' - - - - 'ISOP = isoprene', - 'MOH = methanol', - 'EOH = ethanol', - 'CH2O = formaldehyde', - 'ALD2 = acetaldehyde', - 'ACTA = acetic_acid', - 'ACET = acetone', - 'HCOOH = formic_acid', - 'HCN = hydrogen_cyanide', - 'CO = carbon_monoxide', - 'C2H6 = ethane', - 'C2H4 = ethene', - 'C3H8 = propane', - 'ALK4 = pentane + hexane + heptane + tricyclene', - 'PRPE = propene + butene', - 'TOLU = toluene', - 'LIMO = limonene', - 'MTPA = pinene_a + pinene_b + sabinene + carene_3', - 'MTPO = terpinene_g + terpinene_a + terpinolene + myrcene + ocimene_al + ocimene_t_b + ocimene_c_b + thujene_a + 2met_styrene + cymene_p + cymene_o + bornene + fenchene_a + camphene + phellandrene_a + phellandrene_b' - - 00010101 @@ -55,16 +28,7 @@ SERIAL atm/waccm/lb/LBC_1750-2014_CMIP6_0p5degLat_c170126.nc - SERIAL - - - -INTERP_MISSING_MONTHS - - - - -INTERP_MISSING_MONTHS +SERIAL 'noy', 'nhx' diff --git a/bld/namelist_files/use_cases/sd_geoschem.xml b/bld/namelist_files/use_cases/sd_geoschem.xml index 49dbbf3f3b..01e51032e4 100644 --- a/bld/namelist_files/use_cases/sd_geoschem.xml +++ b/bld/namelist_files/use_cases/sd_geoschem.xml @@ -14,33 +14,6 @@ /glade/p/univ/umit0034/Shared/GEOS-Chem/f.e20.FCSD.f09_f09_mg17.cesm2.1-exp002.001.cam.i.2005-01-01-00000_c180801.nc atm/cam/met/MERRA2/0.9x1.25/fv_0.9x1.25_nc3000_Nsw042_Nrs008_Co060_Fi001_ZR_sgh30_24km_GRNL_MERRA2_c171218.nc - -/glade/p/cesmdata/cseg/inputdata/atm/cam/coords/fv0.9x1.25_esmf_141008.nc' -/glade/p/cesmdata/cseg/inputdata/atm/cam/coords/fv1.9x2.5_esmf_141008.nc' - - - - 'ISOP = isoprene', - 'MOH = methanol', - 'EOH = ethanol', - 'CH2O = formaldehyde', - 'ALD2 = acetaldehyde', - 'ACTA = acetic_acid', - 'ACET = acetone', - 'HCOOH = formic_acid', - 'HCN = hydrogen_cyanide', - 'CO = carbon_monoxide', - 'C2H6 = ethane', - 'C2H4 = ethene', - 'C3H8 = propane', - 'ALK4 = pentane + hexane + heptane + tricyclene', - 'PRPE = propene + butene', - 'TOLU = toluene', - 'LIMO = limonene', - 'MTPA = pinene_a + pinene_b + sabinene + carene_3', - 'MTPO = terpinene_g + terpinene_a + terpinolene + myrcene + ocimene_al + ocimene_t_b + ocimene_c_b + thujene_a + 2met_styrene + cymene_p + cymene_o + bornene + fenchene_a + camphene + phellandrene_a + phellandrene_b' - - 20050101 @@ -75,14 +48,6 @@ SERIAL atm/waccm/lb/LBC_1750-2014_CMIP6_0p5degLat_c170126.nc - -INTERP_MISSING_MONTHS - - - - -INTERP_MISSING_MONTHS - diff --git a/cime_config/config_compsets.xml b/cime_config/config_compsets.xml index 90f1596edd..0670ca8725 100644 --- a/cime_config/config_compsets.xml +++ b/cime_config/config_compsets.xml @@ -557,6 +557,8 @@ 2010-01-01 1980-01-01 2000-01-01 + 2000-01-01 + 2010-01-01 2004-01-01 1950-01-01 diff --git a/src/chemistry/geoschem/chemistry.F90 b/src/chemistry/geoschem/chemistry.F90 index 292724dc51..9dec917b96 100644 --- a/src/chemistry/geoschem/chemistry.F90 +++ b/src/chemistry/geoschem/chemistry.F90 @@ -171,19 +171,19 @@ module chemistry ! character(len=shr_kind_cl) :: depvel_file = '' ! character(len=shr_kind_cl) :: depvel_lnd_file = 'depvel_lnd_file' ! character(len=shr_kind_cl) :: season_wes_file = 'season_wes_file' - - character(len=shr_kind_cl) :: srf_emis_specifier(pcnst) = '' - character(len=shr_kind_cl) :: ext_frc_specifier(pcnst) = '' - - character(len=24) :: srf_emis_type = 'CYCLICAL' ! 'CYCLICAL' | 'SERIAL' | 'INTERP_MISSING_MONTHS' - integer :: srf_emis_cycle_yr = 0 - integer :: srf_emis_fixed_ymd = 0 - integer :: srf_emis_fixed_tod = 0 - - character(len=24) :: ext_frc_type = 'CYCLICAL' ! 'CYCLICAL' | 'SERIAL' | 'INTERP_MISSING_MONTHS' - integer :: ext_frc_cycle_yr = 0 - integer :: ext_frc_fixed_ymd = 0 - integer :: ext_frc_fixed_tod = 0 +! +! character(len=shr_kind_cl) :: srf_emis_specifier(pcnst) = '' +! character(len=shr_kind_cl) :: ext_frc_specifier(pcnst) = '' +! +! character(len=24) :: srf_emis_type = 'CYCLICAL' ! 'CYCLICAL' | 'SERIAL' | 'INTERP_MISSING_MONTHS' +! integer :: srf_emis_cycle_yr = 0 +! integer :: srf_emis_fixed_ymd = 0 +! integer :: srf_emis_fixed_tod = 0 +! +! character(len=24) :: ext_frc_type = 'CYCLICAL' ! 'CYCLICAL' | 'SERIAL' | 'INTERP_MISSING_MONTHS' +! integer :: ext_frc_cycle_yr = 0 +! integer :: ext_frc_fixed_ymd = 0 +! integer :: ext_frc_fixed_tod = 0 !================================================================================================ @@ -691,20 +691,21 @@ subroutine chem_readnl(nlfile) LOGICAL :: validSLS ! ewl: remove 4 entries from chem_inparm used for dry deposition: -! clim_soilw_file, depvel_file, depvel_lnd_file, season_wes_file +! clim_soilw_file, depvel_file, depvel_lnd_file, season_wes_file; +! remove ext_frc_ and srf_emis_ ones too. ! The following files are required to compute land maps, required to perform ! aerosol dry deposition - namelist /chem_inparm/ lght_no_prd_factor, & - ext_frc_specifier, & - ext_frc_type, & - ext_frc_cycle_yr, & - ext_frc_fixed_ymd, & - ext_frc_fixed_tod, & - srf_emis_specifier, & - srf_emis_cycle_yr, & - srf_emis_fixed_ymd, & - srf_emis_fixed_tod, & - srf_emis_type + namelist /chem_inparm/ lght_no_prd_factor +! ext_frc_specifier, & +! ext_frc_type, & +! ext_frc_cycle_yr, & +! ext_frc_fixed_ymd, & +! ext_frc_fixed_tod, & +! srf_emis_specifier, & +! srf_emis_cycle_yr, & +! srf_emis_fixed_ymd, & +! srf_emis_fixed_tod, & +! srf_emis_type ! ghg chem @@ -867,7 +868,7 @@ subroutine chem_readnl(nlfile) ! Broadcast namelist variables -! ewl: remove broadcast of 4 files used for dry deposition only +! ewl: remove broadcast of 4 files used for dry deposition only; srf_emis and ext_frc too. ! The following files are required to compute land maps, required to perform ! aerosol dry deposition ! CALL MPIBCAST (depvel_lnd_file, LEN(depvel_lnd_file), MPICHAR, 0, MPICOM) @@ -876,16 +877,16 @@ subroutine chem_readnl(nlfile) CALL MPIBCAST (lght_no_prd_factor, 1, MPIR8, 0, MPICOM) ! CALL MPIBCAST (depvel_file, LEN(depvel_file), MPICHAR, 0, MPICOM) - CALL MPIBCAST (srf_emis_specifier, LEN(srf_emis_specifier(1))*pcnst, MPICHAR, 0, MPICOM) - CALL MPIBCAST (srf_emis_type, LEN(srf_emis_type), MPICHAR, 0, MPICOM) - CALL MPIBCAST (srf_emis_cycle_yr, 1, MPIINT, 0, MPICOM) - CALL MPIBCAST (srf_emis_fixed_ymd, 1, MPIINT, 0, MPICOM) - CALL MPIBCAST (srf_emis_fixed_tod, 1, MPIINT, 0, MPICOM) - CALL MPIBCAST (ext_frc_specifier, LEN(ext_frc_specifier(1))*pcnst, MPICHAR, 0, MPICOM) - CALL MPIBCAST (ext_frc_type, LEN(ext_frc_type), MPICHAR, 0, MPICOM) - CALL MPIBCAST (ext_frc_cycle_yr, 1, MPIINT, 0, MPICOM) - CALL MPIBCAST (ext_frc_fixed_ymd, 1, MPIINT, 0, MPICOM) - CALL MPIBCAST (ext_frc_fixed_tod, 1, MPIINT, 0, MPICOM) +! CALL MPIBCAST (srf_emis_specifier, LEN(srf_emis_specifier(1))*pcnst, MPICHAR, 0, MPICOM) +! CALL MPIBCAST (srf_emis_type, LEN(srf_emis_type), MPICHAR, 0, MPICOM) +! CALL MPIBCAST (srf_emis_cycle_yr, 1, MPIINT, 0, MPICOM) +! CALL MPIBCAST (srf_emis_fixed_ymd, 1, MPIINT, 0, MPICOM) +! CALL MPIBCAST (srf_emis_fixed_tod, 1, MPIINT, 0, MPICOM) +! CALL MPIBCAST (ext_frc_specifier, LEN(ext_frc_specifier(1))*pcnst, MPICHAR, 0, MPICOM) +! CALL MPIBCAST (ext_frc_type, LEN(ext_frc_type), MPICHAR, 0, MPICOM) +! CALL MPIBCAST (ext_frc_cycle_yr, 1, MPIINT, 0, MPICOM) +! CALL MPIBCAST (ext_frc_fixed_ymd, 1, MPIINT, 0, MPICOM) +! CALL MPIBCAST (ext_frc_fixed_tod, 1, MPIINT, 0, MPICOM) CALL MPIBCAST (ghg_chem, 1, MPILOG, 0, MPICOM) CALL MPIBCAST (bndtvg, LEN(bndtvg), MPICHAR, 0, MPICOM) diff --git a/src/chemistry/geoschem/mo_chem_utls.F90 b/src/chemistry/geoschem/mo_chem_utls.F90 index 43e2d7317e..aba6436b56 100644 --- a/src/chemistry/geoschem/mo_chem_utls.F90 +++ b/src/chemistry/geoschem/mo_chem_utls.F90 @@ -46,7 +46,7 @@ end function get_spc_ndx integer function get_inv_ndx( invariant ) !----------------------------------------------------------------------- - ! ... return overall external frcing index associated with spc_name + ! ... return overall invariant index associated with spc_name !----------------------------------------------------------------------- use chem_mods, only : nfs, inv_lst From 849edd7eecfcdb8e31ef66c563b1f40e05eb4f64 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Thu, 21 Jul 2022 10:51:45 -0600 Subject: [PATCH 036/291] Move GEOS-Chem deposition lists to common file with namelist defaults This update also slims down the dry deposition lists to not include aerosols or unused species (new lists submitted by Haipeng Lin). Signed-off-by: Lizzie Lundgren --- bld/namelist_files/namelist_defaults_cam.xml | 23 +++++++++++++++++++ .../use_cases/2000_geoschem.xml | 18 --------------- .../use_cases/2010_geoschem.xml | 18 --------------- .../use_cases/hist_geoschem.xml | 18 --------------- bld/namelist_files/use_cases/sd_geoschem.xml | 19 --------------- 5 files changed, 23 insertions(+), 73 deletions(-) diff --git a/bld/namelist_files/namelist_defaults_cam.xml b/bld/namelist_files/namelist_defaults_cam.xml index ebee401afb..fb80654cb9 100644 --- a/bld/namelist_files/namelist_defaults_cam.xml +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -3186,5 +3186,28 @@ atm/cam/ocnfrac/domain.aqua.fv1.9x2.5.nc + + + + + + +'ACET','ACTA','ALD2','AROMP4','AROMP5','ATOOH','BALD','BENZP','BR2','BRCL','BRNO3','BZCO3H','BZPAN','CH2O','CL2','CLNO2','CLNO3','CLO','CLOO','CSL','EOH','ETHLN','ETHN','ETHP','ETNO3','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HI','HMHP','HMML','HMS','HNO3','HOBR','HOCL','HOI','HONIT','HPALD1','HPALD2','HPALD3','HPALD4','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDC','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','IPRNO3','ITCN','ITHN','LIMO','LVOC','LVOCOA','MACR','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MCT','MENO3','MGLY','MOH','MONITS','MONITU','MPAN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','N2O5','NH3','NO2','NPHEN','NPRNO3','O3','PAN','PHEN','PP','PPN','PROPNN','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2' + + + + +'ACTA','ALD2','AROMP4','AROMP5','ATOOH','BALD','BENZP','BR2','BRCL','BZCO3H','BZPAN','CH2O','CSL','EOH','ETHLN','ETHN','ETHP','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HI','HMHP','HMML','HMS','HNO3','HOBR','HOCL','HOI','HONIT','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','ITCN','ITHN','LIMO','LVOC','LVOCOA','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MCT','MEK','MGLY','MOH','MONITS','MONITU','MP','MPAN','MPN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','NH3','NPHEN','PAN','PHEN','PP','PPN','PROPNN','PRPE','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2' + + + + +'dst_a1','so4_a1','nh4_a1','pom_a1','pomff1_a1','pombb1_a1','soa_a1','bc_a1','ncl_a1','num_a1','so4_a2','nh4_a2','soa_a2','ncl_a2','dst_a2','num_a2','dst_a3','ncl_a3','so4_a3','pom_a3','bc_a3','num_a3','ncl_a4','so4_a4','pom_a4','pomff1_a4','pombb1_a4','bc_a4','nh4_a4','num_a4','dst_a5','so4_a5','nh4_a5','num_a5','ncl_a6','so4_a6','nh4_a6','num_a6','dst_a7','so4_a7','nh4_a7','num_a7','soa1_a1','soa1_a2','soa2_a1','soa2_a2','soa3_a1','soa3_a2','soa4_a1','soa4_a2','soa5_a1','soa5_a2','soaff1_a1','soaff2_a1','soaff3_a1','soaff4_a1','soaff5_a1','soabb1_a1','soabb2_a1','soabb3_a1','soabb4_a1','soabb5_a1','soabg1_a1','soabg2_a1','soabg3_a1','soabg4_a1','soabg5_a1','soaff1_a2','soaff2_a2','soaff3_a2','soaff4_a2','soaff5_a2','soabb1_a2','soabb2_a2','soabb3_a2','soabb4_a2','soabb5_a2','soabg1_a2','soabg2_a2','soabg3_a2','soabg4_a2','soabg5_a2' + + + + +'dst_a1','so4_a1','nh4_a1','pom_a1','pomff1_a1','pombb1_a1','soa_a1','bc_a1','ncl_a1','num_a1','so4_a2','nh4_a2','soa_a2','ncl_a2','dst_a2','num_a2','dst_a3','ncl_a3','so4_a3','pom_a3','bc_a3','num_a3','ncl_a4','so4_a4','pom_a4','pomff1_a4','pombb1_a4','bc_a4','nh4_a4','num_a4','dst_a5','so4_a5','nh4_a5','num_a5','ncl_a6','so4_a6','nh4_a6','num_a6','dst_a7','so4_a7','nh4_a7','num_a7','soa1_a1','soa1_a2','soa2_a1','soa2_a2','soa3_a1','soa3_a2','soa4_a1','soa4_a2','soa5_a1','soa5_a2','soaff1_a1','soaff2_a1','soaff3_a1','soaff4_a1','soaff5_a1','soabb1_a1','soabb2_a1','soabb3_a1','soabb4_a1','soabb5_a1','soabg1_a1','soabg2_a1','soabg3_a1','soabg4_a1','soabg5_a1','soaff1_a2','soaff2_a2','soaff3_a2','soaff4_a2','soaff5_a2','soabb1_a2','soabb2_a2','soabb3_a2','soabb4_a2','soabb5_a2','soabg1_a2','soabg2_a2','soabg3_a2','soabg4_a2','soabg5_a2' + diff --git a/bld/namelist_files/use_cases/2000_geoschem.xml b/bld/namelist_files/use_cases/2000_geoschem.xml index c20a3c66fc..b2c980ddd3 100644 --- a/bld/namelist_files/use_cases/2000_geoschem.xml +++ b/bld/namelist_files/use_cases/2000_geoschem.xml @@ -64,22 +64,4 @@ 'O3', 'NO', 'NO2', 'CO', 'HNO3', 'CH4', 'NIT', 'NH4', 'NH3', 'SO4', 'SO2', 'OH', - - - - 'ACET','ACTA','ALD2','ASOG1','ASOG2','ASOG3','ATOOH','BR2','BRCL','BRNO3','CH2O','CL2','CLNO2','CLNO3','CLO','CLOO','EOH','ETHLN','ETNO3','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HG0','HG0_ANT','HG0_ARC','HG0_ATL','HG0_BB','HG0_CAM','HG0_CAN','HG0_EAF','HG0_EAS','HG0_EEU','HG0_EUR','HG0_GEO','HG0_JPN','HG0_MDE','HG0_NAF','HG0_NAT','HG0_NPA','HG0_OCE','HG0_OCN','HG0_SAF','HG0_SAM','HG0_SAS','HG0_SAT','HG0_SEA','HG0_SO','HG0_SOV','HG0_STR','HG0_USA','HG0_WAF','HG2','HG2_ANT','HG2_ARC','HG2_ATL','HG2_BB','HG2_CAM','HG2_CAN','HG2_EAF','HG2_EAS','HG2_EEU','HG2_EUR','HG2_GEO','HG2_JPN','HG2_MDE','HG2_NAF','HG2_NAT','HG2_NPA','HG2_OCE','HG2_OCN','HG2_SAF','HG2_SAM','HG2_SAS','HG2_SAT','HG2_SEA','HG2_SO','HG2_SOV','HG2_STR','HG2_USA','HG2_WAF','HI','HMHP','HMML','HNO3','HOBR','HOCL','HOI','HONIT','HPALD1','HPALD2','HPALD3','HPALD4','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDC','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','IPRNO3','ITCN','ITHN','LIMO','LVOC','MACR','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MENO3','MGLY','MOH','MONITS','MONITU','MPAN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','N2O5','NH3','NO2','NPRNO3','O3','O3AFBL','O3ASBL','O3ATBL','O3EUBL','O3INIT','O3MT','O3NABL','O3PCBL','O3ROW','O3STRAT','O3USA','O3UT','OPOG1','OPOG2','PAN','POG1','POG2','POPG_BAP','POPG_PHE','POPG_PYR','PP','PPN','PROPNN','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2','TSOG0','TSOG1','TSOG2','TSOG3','AERI','ASOA1','ASOA2','ASOA3','ASOAN','BCPI','BCPO','BE10','BE10STRAT','BE7','BE7STRAT','BRSALA','BRSALC','DST1','DST2','DST3','DST4','DSTAL1','DSTAL2','DSTAL3','DSTAL4','HGP','HGP_ANT','HGP_ARC','HGP_ATL','HGP_BB','HGP_CAM','HGP_CAN','HGP_EAF','HGP_EAS','HGP_EEU','HGP_EUR','HGP_GEO','HGP_JPN','HGP_MDE','HGP_NAF','HGP_NAT','HGP_NPA','HGP_OCE','HGP_OCN','HGP_SAF','HGP_SAM','HGP_SAS','HGP_SAT','HGP_SEA','HGP_SO','HGP_SOV','HGP_STR','HGP_USA','HGP_WAF','INDIOL','IONITA','ISALA','ISALC','LVOCOA','MONITA','MOPI','MOPO','MSA','NH4','NIT','NITD1','NITD2','NITD3','NITD4','NITS','OCPI','OCPO','OPOA1','OPOA2','PB210','PB210STRAT','PFE','POA1','POA2','POPPBCPI_BAP','POPPBCPI_PHE','POPPBCPI_PYR','POPPBCPO_BAP','POPPBCPO_PHE','POPPBCPO_PYR','POPPOCPI_BAP','POPPOCPI_PHE','POPPOCPI_PYR','POPPOCPO_BAP','POPPOCPO_PHE','POPPOCPO_PYR','SALA','SALAAL','SALACL','SALC','SALCAL','SALCCL','SO4','SO4D1','SO4D2','SO4D3','SO4D4','SO4S','SOAGX','SOAIE','SOAS','TSOA0','TSOA1','TSOA2','TSOA3', - - - - 'dst_a1','so4_a1','nh4_a1','pom_a1','pomff1_a1','pombb1_a1','soa_a1','bc_a1','ncl_a1','num_a1','so4_a2','nh4_a2','soa_a2','ncl_a2','dst_a2','num_a2','dst_a3','ncl_a3','so4_a3','pom_a3','bc_a3','num_a3','ncl_a4','so4_a4','pom_a4','pomff1_a4','pombb1_a4','bc_a4','nh4_a4','num_a4','dst_a5','so4_a5','nh4_a5','num_a5','ncl_a6','so4_a6','nh4_a6','num_a6','dst_a7','so4_a7','nh4_a7','num_a7','soa1_a1','soa1_a2','soa2_a1','soa2_a2','soa3_a1','soa3_a2','soa4_a1','soa4_a2','soa5_a1','soa5_a2','soaff1_a1','soaff2_a1','soaff3_a1','soaff4_a1','soaff5_a1','soabb1_a1','soabb2_a1','soabb3_a1','soabb4_a1','soabb5_a1','soabg1_a1','soabg2_a1','soabg3_a1','soabg4_a1','soabg5_a1','soaff1_a2','soaff2_a2','soaff3_a2','soaff4_a2','soaff5_a2','soabb1_a2','soabb2_a2','soabb3_a2','soabb4_a2','soabb5_a2','soabg1_a2','soabg2_a2','soabg3_a2','soabg4_a2','soabg5_a2' - - - - 'ACTA','ALD2','ASOG1','ASOG2','ASOG3','ATOOH','BR2','BRCL','CH2O','EOH','ETHLN','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HG2','HG2_ANT','HG2_ARC','HG2_ATL','HG2_BB','HG2_CAM','HG2_CAN','HG2_EAF','HG2_EAS','HG2_EEU','HG2_EUR','HG2_GEO','HG2_JPN','HG2_MDE','HG2_NAF','HG2_NAT','HG2_NPA','HG2_OCE','HG2_OCN','HG2_SAF','HG2_SAM','HG2_SAS','HG2_SAT','HG2_SEA','HG2_SO','HG2_SOV','HG2_STR','HG2_USA','HG2_WAF','HI','HMHP','HMML','HNO3','HOBR','HOCL','HOI','HONIT','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','ITCN','ITHN','LIMO','LVOC','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MEK','MGLY','MOH','MONITS','MONITU','MP','MPAN','MPN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','NH3','OPOG1','OPOG2','PAN','POG1','POG2','POPG_BAP','POPG_PHE','POPG_PYR','PP','PPN','PROPNN','PRPE','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2','TSOG0','TSOG1','TSOG2','TSOG3','AERI','ASOA1','ASOA2','ASOA3','ASOAN','BCPI','BCPO','BE10','BE10STRAT','BE7','BE7STRAT','BRSALA','BRSALC','DST1','DST2','DST3','DST4','DSTAL1','DSTAL2','DSTAL3','DSTAL4','HGP','HGP_ANT','HGP_ARC','HGP_ATL','HGP_BB','HGP_CAM','HGP_CAN','HGP_EAF','HGP_EAS','HGP_EEU','HGP_EUR','HGP_GEO','HGP_JPN','HGP_MDE','HGP_NAF','HGP_NAT','HGP_NPA','HGP_OCE','HGP_OCN','HGP_SAF','HGP_SAM','HGP_SAS','HGP_SAT','HGP_SEA','HGP_SO','HGP_SOV','HGP_STR','HGP_USA','HGP_WAF','INDIOL','IONITA','ISALA','ISALC','LVOCOA','MONITA','MOPI','MOPO','MSA','NH4','NIT','NITD1','NITD2','NITD3','NITD4','NITS','OCPI','OCPO','OPOA1','OPOA2','PB210','PB210STRAT','PFE','POA1','POA2','POPPBCPI_BAP','POPPBCPI_PHE','POPPBCPI_PYR','POPPBCPO_BAP','POPPBCPO_PHE','POPPBCPO_PYR','POPPOCPI_BAP','POPPOCPI_PHE','POPPOCPI_PYR','POPPOCPO_BAP','POPPOCPO_PHE','POPPOCPO_PYR','SALA','SALAAL','SALACL','SALC','SALCAL','SALCCL','SO4','SO4D1','SO4D2','SO4D3','SO4D4','SO4S','SOAGX','SOAIE','SOAS','TSOA0','TSOA1','TSOA2','TSOA3', - - - - 'dst_a1','so4_a1','nh4_a1','pom_a1','pomff1_a1','pombb1_a1','soa_a1','bc_a1','ncl_a1','num_a1','so4_a2','nh4_a2','soa_a2','ncl_a2','dst_a2','num_a2','dst_a3','ncl_a3','so4_a3','pom_a3','bc_a3','num_a3','ncl_a4','so4_a4','pom_a4','pomff1_a4','pombb1_a4','bc_a4','nh4_a4','num_a4','dst_a5','so4_a5','nh4_a5','num_a5','ncl_a6','so4_a6','nh4_a6','num_a6','dst_a7','so4_a7','nh4_a7','num_a7','soa1_a1','soa1_a2','soa2_a1','soa2_a2','soa3_a1','soa3_a2','soa4_a1','soa4_a2','soa5_a1','soa5_a2','soaff1_a1','soaff2_a1','soaff3_a1','soaff4_a1','soaff5_a1','soabb1_a1','soabb2_a1','soabb3_a1','soabb4_a1','soabb5_a1','soabg1_a1','soabg2_a1','soabg3_a1','soabg4_a1','soabg5_a1','soaff1_a2','soaff2_a2','soaff3_a2','soaff4_a2','soaff5_a2','soabb1_a2','soabb2_a2','soabb3_a2','soabb4_a2','soabb5_a2','soabg1_a2','soabg2_a2','soabg3_a2','soabg4_a2','soabg5_a2' - - diff --git a/bld/namelist_files/use_cases/2010_geoschem.xml b/bld/namelist_files/use_cases/2010_geoschem.xml index ece3001986..4ac969a9aa 100644 --- a/bld/namelist_files/use_cases/2010_geoschem.xml +++ b/bld/namelist_files/use_cases/2010_geoschem.xml @@ -55,22 +55,4 @@ 'Q', 'U', 'V', 'OMEGA', 'T', 'PS', - - - - 'ACET','ACTA','ALD2','ASOG1','ASOG2','ASOG3','ATOOH','BR2','BRCL','BRNO3','CH2O','CL2','CLNO2','CLNO3','CLO','CLOO','EOH','ETHLN','ETNO3','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HG0','HG0_ANT','HG0_ARC','HG0_ATL','HG0_BB','HG0_CAM','HG0_CAN','HG0_EAF','HG0_EAS','HG0_EEU','HG0_EUR','HG0_GEO','HG0_JPN','HG0_MDE','HG0_NAF','HG0_NAT','HG0_NPA','HG0_OCE','HG0_OCN','HG0_SAF','HG0_SAM','HG0_SAS','HG0_SAT','HG0_SEA','HG0_SO','HG0_SOV','HG0_STR','HG0_USA','HG0_WAF','HG2','HG2_ANT','HG2_ARC','HG2_ATL','HG2_BB','HG2_CAM','HG2_CAN','HG2_EAF','HG2_EAS','HG2_EEU','HG2_EUR','HG2_GEO','HG2_JPN','HG2_MDE','HG2_NAF','HG2_NAT','HG2_NPA','HG2_OCE','HG2_OCN','HG2_SAF','HG2_SAM','HG2_SAS','HG2_SAT','HG2_SEA','HG2_SO','HG2_SOV','HG2_STR','HG2_USA','HG2_WAF','HI','HMHP','HMML','HNO3','HOBR','HOCL','HOI','HONIT','HPALD1','HPALD2','HPALD3','HPALD4','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDC','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','IPRNO3','ITCN','ITHN','LIMO','LVOC','MACR','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MENO3','MGLY','MOH','MONITS','MONITU','MPAN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','N2O5','NH3','NO2','NPRNO3','O3','O3AFBL','O3ASBL','O3ATBL','O3EUBL','O3INIT','O3MT','O3NABL','O3PCBL','O3ROW','O3STRAT','O3USA','O3UT','OPOG1','OPOG2','PAN','POG1','POG2','POPG_BAP','POPG_PHE','POPG_PYR','PP','PPN','PROPNN','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2','TSOG0','TSOG1','TSOG2','TSOG3','AERI','ASOA1','ASOA2','ASOA3','ASOAN','BCPI','BCPO','BE10','BE10STRAT','BE7','BE7STRAT','BRSALA','BRSALC','DST1','DST2','DST3','DST4','DSTAL1','DSTAL2','DSTAL3','DSTAL4','HGP','HGP_ANT','HGP_ARC','HGP_ATL','HGP_BB','HGP_CAM','HGP_CAN','HGP_EAF','HGP_EAS','HGP_EEU','HGP_EUR','HGP_GEO','HGP_JPN','HGP_MDE','HGP_NAF','HGP_NAT','HGP_NPA','HGP_OCE','HGP_OCN','HGP_SAF','HGP_SAM','HGP_SAS','HGP_SAT','HGP_SEA','HGP_SO','HGP_SOV','HGP_STR','HGP_USA','HGP_WAF','INDIOL','IONITA','ISALA','ISALC','LVOCOA','MONITA','MOPI','MOPO','MSA','NH4','NIT','NITD1','NITD2','NITD3','NITD4','NITS','OCPI','OCPO','OPOA1','OPOA2','PB210','PB210STRAT','PFE','POA1','POA2','POPPBCPI_BAP','POPPBCPI_PHE','POPPBCPI_PYR','POPPBCPO_BAP','POPPBCPO_PHE','POPPBCPO_PYR','POPPOCPI_BAP','POPPOCPI_PHE','POPPOCPI_PYR','POPPOCPO_BAP','POPPOCPO_PHE','POPPOCPO_PYR','SALA','SALAAL','SALACL','SALC','SALCAL','SALCCL','SO4','SO4D1','SO4D2','SO4D3','SO4D4','SO4S','SOAGX','SOAIE','SOAS','TSOA0','TSOA1','TSOA2','TSOA3', - - - - 'dst_a1','so4_a1','nh4_a1','pom_a1','pomff1_a1','pombb1_a1','soa_a1','bc_a1','ncl_a1','num_a1','so4_a2','nh4_a2','soa_a2','ncl_a2','dst_a2','num_a2','dst_a3','ncl_a3','so4_a3','pom_a3','bc_a3','num_a3','ncl_a4','so4_a4','pom_a4','pomff1_a4','pombb1_a4','bc_a4','nh4_a4','num_a4','dst_a5','so4_a5','nh4_a5','num_a5','ncl_a6','so4_a6','nh4_a6','num_a6','dst_a7','so4_a7','nh4_a7','num_a7','soa1_a1','soa1_a2','soa2_a1','soa2_a2','soa3_a1','soa3_a2','soa4_a1','soa4_a2','soa5_a1','soa5_a2','soaff1_a1','soaff2_a1','soaff3_a1','soaff4_a1','soaff5_a1','soabb1_a1','soabb2_a1','soabb3_a1','soabb4_a1','soabb5_a1','soabg1_a1','soabg2_a1','soabg3_a1','soabg4_a1','soabg5_a1','soaff1_a2','soaff2_a2','soaff3_a2','soaff4_a2','soaff5_a2','soabb1_a2','soabb2_a2','soabb3_a2','soabb4_a2','soabb5_a2','soabg1_a2','soabg2_a2','soabg3_a2','soabg4_a2','soabg5_a2' - - - - 'ACTA','ALD2','ASOG1','ASOG2','ASOG3','ATOOH','BR2','BRCL','CH2O','EOH','ETHLN','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HG2','HG2_ANT','HG2_ARC','HG2_ATL','HG2_BB','HG2_CAM','HG2_CAN','HG2_EAF','HG2_EAS','HG2_EEU','HG2_EUR','HG2_GEO','HG2_JPN','HG2_MDE','HG2_NAF','HG2_NAT','HG2_NPA','HG2_OCE','HG2_OCN','HG2_SAF','HG2_SAM','HG2_SAS','HG2_SAT','HG2_SEA','HG2_SO','HG2_SOV','HG2_STR','HG2_USA','HG2_WAF','HI','HMHP','HMML','HNO3','HOBR','HOCL','HOI','HONIT','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','ITCN','ITHN','LIMO','LVOC','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MEK','MGLY','MOH','MONITS','MONITU','MP','MPAN','MPN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','NH3','OPOG1','OPOG2','PAN','POG1','POG2','POPG_BAP','POPG_PHE','POPG_PYR','PP','PPN','PROPNN','PRPE','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2','TSOG0','TSOG1','TSOG2','TSOG3','AERI','ASOA1','ASOA2','ASOA3','ASOAN','BCPI','BCPO','BE10','BE10STRAT','BE7','BE7STRAT','BRSALA','BRSALC','DST1','DST2','DST3','DST4','DSTAL1','DSTAL2','DSTAL3','DSTAL4','HGP','HGP_ANT','HGP_ARC','HGP_ATL','HGP_BB','HGP_CAM','HGP_CAN','HGP_EAF','HGP_EAS','HGP_EEU','HGP_EUR','HGP_GEO','HGP_JPN','HGP_MDE','HGP_NAF','HGP_NAT','HGP_NPA','HGP_OCE','HGP_OCN','HGP_SAF','HGP_SAM','HGP_SAS','HGP_SAT','HGP_SEA','HGP_SO','HGP_SOV','HGP_STR','HGP_USA','HGP_WAF','INDIOL','IONITA','ISALA','ISALC','LVOCOA','MONITA','MOPI','MOPO','MSA','NH4','NIT','NITD1','NITD2','NITD3','NITD4','NITS','OCPI','OCPO','OPOA1','OPOA2','PB210','PB210STRAT','PFE','POA1','POA2','POPPBCPI_BAP','POPPBCPI_PHE','POPPBCPI_PYR','POPPBCPO_BAP','POPPBCPO_PHE','POPPBCPO_PYR','POPPOCPI_BAP','POPPOCPI_PHE','POPPOCPI_PYR','POPPOCPO_BAP','POPPOCPO_PHE','POPPOCPO_PYR','SALA','SALAAL','SALACL','SALC','SALCAL','SALCCL','SO4','SO4D1','SO4D2','SO4D3','SO4D4','SO4S','SOAGX','SOAIE','SOAS','TSOA0','TSOA1','TSOA2','TSOA3', - - - - 'dst_a1','so4_a1','nh4_a1','pom_a1','pomff1_a1','pombb1_a1','soa_a1','bc_a1','ncl_a1','num_a1','so4_a2','nh4_a2','soa_a2','ncl_a2','dst_a2','num_a2','dst_a3','ncl_a3','so4_a3','pom_a3','bc_a3','num_a3','ncl_a4','so4_a4','pom_a4','pomff1_a4','pombb1_a4','bc_a4','nh4_a4','num_a4','dst_a5','so4_a5','nh4_a5','num_a5','ncl_a6','so4_a6','nh4_a6','num_a6','dst_a7','so4_a7','nh4_a7','num_a7','soa1_a1','soa1_a2','soa2_a1','soa2_a2','soa3_a1','soa3_a2','soa4_a1','soa4_a2','soa5_a1','soa5_a2','soaff1_a1','soaff2_a1','soaff3_a1','soaff4_a1','soaff5_a1','soabb1_a1','soabb2_a1','soabb3_a1','soabb4_a1','soabb5_a1','soabg1_a1','soabg2_a1','soabg3_a1','soabg4_a1','soabg5_a1','soaff1_a2','soaff2_a2','soaff3_a2','soaff4_a2','soaff5_a2','soabb1_a2','soabb2_a2','soabb3_a2','soabb4_a2','soabb5_a2','soabg1_a2','soabg2_a2','soabg3_a2','soabg4_a2','soabg5_a2' - - diff --git a/bld/namelist_files/use_cases/hist_geoschem.xml b/bld/namelist_files/use_cases/hist_geoschem.xml index 35f09e0474..60068f00d4 100644 --- a/bld/namelist_files/use_cases/hist_geoschem.xml +++ b/bld/namelist_files/use_cases/hist_geoschem.xml @@ -156,22 +156,4 @@ 'soa2_a2_CHML', 'soa3_a2_CHML', 'soa4_a2_CHML', 'soa5_a2_CHML', 'so4_a1_CHMP', 'so4_a2_CHMP', 'so4_a3_CHMP', 'H2SO4_sfnnuc1', 'num_a2_sfnnuc1', --> - - - - 'ACET','ACTA','ALD2','ASOG1','ASOG2','ASOG3','ATOOH','BR2','BRCL','BRNO3','CH2O','CL2','CLNO2','CLNO3','CLO','CLOO','EOH','ETHLN','ETNO3','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HG0','HG0_ANT','HG0_ARC','HG0_ATL','HG0_BB','HG0_CAM','HG0_CAN','HG0_EAF','HG0_EAS','HG0_EEU','HG0_EUR','HG0_GEO','HG0_JPN','HG0_MDE','HG0_NAF','HG0_NAT','HG0_NPA','HG0_OCE','HG0_OCN','HG0_SAF','HG0_SAM','HG0_SAS','HG0_SAT','HG0_SEA','HG0_SO','HG0_SOV','HG0_STR','HG0_USA','HG0_WAF','HG2','HG2_ANT','HG2_ARC','HG2_ATL','HG2_BB','HG2_CAM','HG2_CAN','HG2_EAF','HG2_EAS','HG2_EEU','HG2_EUR','HG2_GEO','HG2_JPN','HG2_MDE','HG2_NAF','HG2_NAT','HG2_NPA','HG2_OCE','HG2_OCN','HG2_SAF','HG2_SAM','HG2_SAS','HG2_SAT','HG2_SEA','HG2_SO','HG2_SOV','HG2_STR','HG2_USA','HG2_WAF','HI','HMHP','HMML','HNO3','HOBR','HOCL','HOI','HONIT','HPALD1','HPALD2','HPALD3','HPALD4','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDC','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','IPRNO3','ITCN','ITHN','LIMO','LVOC','MACR','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MENO3','MGLY','MOH','MONITS','MONITU','MPAN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','N2O5','NH3','NO2','NPRNO3','O3','O3AFBL','O3ASBL','O3ATBL','O3EUBL','O3INIT','O3MT','O3NABL','O3PCBL','O3ROW','O3STRAT','O3USA','O3UT','OPOG1','OPOG2','PAN','POG1','POG2','POPG_BAP','POPG_PHE','POPG_PYR','PP','PPN','PROPNN','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2','TSOG0','TSOG1','TSOG2','TSOG3','AERI','ASOA1','ASOA2','ASOA3','ASOAN','BCPI','BCPO','BE10','BE10STRAT','BE7','BE7STRAT','BRSALA','BRSALC','DST1','DST2','DST3','DST4','DSTAL1','DSTAL2','DSTAL3','DSTAL4','HGP','HGP_ANT','HGP_ARC','HGP_ATL','HGP_BB','HGP_CAM','HGP_CAN','HGP_EAF','HGP_EAS','HGP_EEU','HGP_EUR','HGP_GEO','HGP_JPN','HGP_MDE','HGP_NAF','HGP_NAT','HGP_NPA','HGP_OCE','HGP_OCN','HGP_SAF','HGP_SAM','HGP_SAS','HGP_SAT','HGP_SEA','HGP_SO','HGP_SOV','HGP_STR','HGP_USA','HGP_WAF','INDIOL','IONITA','ISALA','ISALC','LVOCOA','MONITA','MOPI','MOPO','MSA','NH4','NIT','NITD1','NITD2','NITD3','NITD4','NITS','OCPI','OCPO','OPOA1','OPOA2','PB210','PB210STRAT','PFE','POA1','POA2','POPPBCPI_BAP','POPPBCPI_PHE','POPPBCPI_PYR','POPPBCPO_BAP','POPPBCPO_PHE','POPPBCPO_PYR','POPPOCPI_BAP','POPPOCPI_PHE','POPPOCPI_PYR','POPPOCPO_BAP','POPPOCPO_PHE','POPPOCPO_PYR','SALA','SALAAL','SALACL','SALC','SALCAL','SALCCL','SO4','SO4D1','SO4D2','SO4D3','SO4D4','SO4S','SOAGX','SOAIE','SOAS','TSOA0','TSOA1','TSOA2','TSOA3', - - - - 'dst_a1','so4_a1','nh4_a1','pom_a1','pomff1_a1','pombb1_a1','soa_a1','bc_a1','ncl_a1','num_a1','so4_a2','nh4_a2','soa_a2','ncl_a2','dst_a2','num_a2','dst_a3','ncl_a3','so4_a3','pom_a3','bc_a3','num_a3','ncl_a4','so4_a4','pom_a4','pomff1_a4','pombb1_a4','bc_a4','nh4_a4','num_a4','dst_a5','so4_a5','nh4_a5','num_a5','ncl_a6','so4_a6','nh4_a6','num_a6','dst_a7','so4_a7','nh4_a7','num_a7','soa1_a1','soa1_a2','soa2_a1','soa2_a2','soa3_a1','soa3_a2','soa4_a1','soa4_a2','soa5_a1','soa5_a2','soaff1_a1','soaff2_a1','soaff3_a1','soaff4_a1','soaff5_a1','soabb1_a1','soabb2_a1','soabb3_a1','soabb4_a1','soabb5_a1','soabg1_a1','soabg2_a1','soabg3_a1','soabg4_a1','soabg5_a1','soaff1_a2','soaff2_a2','soaff3_a2','soaff4_a2','soaff5_a2','soabb1_a2','soabb2_a2','soabb3_a2','soabb4_a2','soabb5_a2','soabg1_a2','soabg2_a2','soabg3_a2','soabg4_a2','soabg5_a2' - - - - 'ACTA','ALD2','ASOG1','ASOG2','ASOG3','ATOOH','BR2','BRCL','CH2O','EOH','ETHLN','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HG2','HG2_ANT','HG2_ARC','HG2_ATL','HG2_BB','HG2_CAM','HG2_CAN','HG2_EAF','HG2_EAS','HG2_EEU','HG2_EUR','HG2_GEO','HG2_JPN','HG2_MDE','HG2_NAF','HG2_NAT','HG2_NPA','HG2_OCE','HG2_OCN','HG2_SAF','HG2_SAM','HG2_SAS','HG2_SAT','HG2_SEA','HG2_SO','HG2_SOV','HG2_STR','HG2_USA','HG2_WAF','HI','HMHP','HMML','HNO3','HOBR','HOCL','HOI','HONIT','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','ITCN','ITHN','LIMO','LVOC','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MEK','MGLY','MOH','MONITS','MONITU','MP','MPAN','MPN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','NH3','OPOG1','OPOG2','PAN','POG1','POG2','POPG_BAP','POPG_PHE','POPG_PYR','PP','PPN','PROPNN','PRPE','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2','TSOG0','TSOG1','TSOG2','TSOG3','AERI','ASOA1','ASOA2','ASOA3','ASOAN','BCPI','BCPO','BE10','BE10STRAT','BE7','BE7STRAT','BRSALA','BRSALC','DST1','DST2','DST3','DST4','DSTAL1','DSTAL2','DSTAL3','DSTAL4','HGP','HGP_ANT','HGP_ARC','HGP_ATL','HGP_BB','HGP_CAM','HGP_CAN','HGP_EAF','HGP_EAS','HGP_EEU','HGP_EUR','HGP_GEO','HGP_JPN','HGP_MDE','HGP_NAF','HGP_NAT','HGP_NPA','HGP_OCE','HGP_OCN','HGP_SAF','HGP_SAM','HGP_SAS','HGP_SAT','HGP_SEA','HGP_SO','HGP_SOV','HGP_STR','HGP_USA','HGP_WAF','INDIOL','IONITA','ISALA','ISALC','LVOCOA','MONITA','MOPI','MOPO','MSA','NH4','NIT','NITD1','NITD2','NITD3','NITD4','NITS','OCPI','OCPO','OPOA1','OPOA2','PB210','PB210STRAT','PFE','POA1','POA2','POPPBCPI_BAP','POPPBCPI_PHE','POPPBCPI_PYR','POPPBCPO_BAP','POPPBCPO_PHE','POPPBCPO_PYR','POPPOCPI_BAP','POPPOCPI_PHE','POPPOCPI_PYR','POPPOCPO_BAP','POPPOCPO_PHE','POPPOCPO_PYR','SALA','SALAAL','SALACL','SALC','SALCAL','SALCCL','SO4','SO4D1','SO4D2','SO4D3','SO4D4','SO4S','SOAGX','SOAIE','SOAS','TSOA0','TSOA1','TSOA2','TSOA3', - - - - 'dst_a1','so4_a1','nh4_a1','pom_a1','pomff1_a1','pombb1_a1','soa_a1','bc_a1','ncl_a1','num_a1','so4_a2','nh4_a2','soa_a2','ncl_a2','dst_a2','num_a2','dst_a3','ncl_a3','so4_a3','pom_a3','bc_a3','num_a3','ncl_a4','so4_a4','pom_a4','pomff1_a4','pombb1_a4','bc_a4','nh4_a4','num_a4','dst_a5','so4_a5','nh4_a5','num_a5','ncl_a6','so4_a6','nh4_a6','num_a6','dst_a7','so4_a7','nh4_a7','num_a7','soa1_a1','soa1_a2','soa2_a1','soa2_a2','soa3_a1','soa3_a2','soa4_a1','soa4_a2','soa5_a1','soa5_a2','soaff1_a1','soaff2_a1','soaff3_a1','soaff4_a1','soaff5_a1','soabb1_a1','soabb2_a1','soabb3_a1','soabb4_a1','soabb5_a1','soabg1_a1','soabg2_a1','soabg3_a1','soabg4_a1','soabg5_a1','soaff1_a2','soaff2_a2','soaff3_a2','soaff4_a2','soaff5_a2','soabb1_a2','soabb2_a2','soabb3_a2','soabb4_a2','soabb5_a2','soabg1_a2','soabg2_a2','soabg3_a2','soabg4_a2','soabg5_a2' - - diff --git a/bld/namelist_files/use_cases/sd_geoschem.xml b/bld/namelist_files/use_cases/sd_geoschem.xml index 01e51032e4..fbeaa8cc0b 100644 --- a/bld/namelist_files/use_cases/sd_geoschem.xml +++ b/bld/namelist_files/use_cases/sd_geoschem.xml @@ -170,23 +170,4 @@ 'BURDENSEASALTdn','BURDENBCdn', 'PM25' - - - - - 'ACET','ACTA','ALD2','ASOG1','ASOG2','ASOG3','ATOOH','BR2','BRCL','BRNO3','CH2O','CL2','CLNO2','CLNO3','CLO','CLOO','EOH','ETHLN','ETNO3','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HG0','HG0_ANT','HG0_ARC','HG0_ATL','HG0_BB','HG0_CAM','HG0_CAN','HG0_EAF','HG0_EAS','HG0_EEU','HG0_EUR','HG0_GEO','HG0_JPN','HG0_MDE','HG0_NAF','HG0_NAT','HG0_NPA','HG0_OCE','HG0_OCN','HG0_SAF','HG0_SAM','HG0_SAS','HG0_SAT','HG0_SEA','HG0_SO','HG0_SOV','HG0_STR','HG0_USA','HG0_WAF','HG2','HG2_ANT','HG2_ARC','HG2_ATL','HG2_BB','HG2_CAM','HG2_CAN','HG2_EAF','HG2_EAS','HG2_EEU','HG2_EUR','HG2_GEO','HG2_JPN','HG2_MDE','HG2_NAF','HG2_NAT','HG2_NPA','HG2_OCE','HG2_OCN','HG2_SAF','HG2_SAM','HG2_SAS','HG2_SAT','HG2_SEA','HG2_SO','HG2_SOV','HG2_STR','HG2_USA','HG2_WAF','HI','HMHP','HMML','HNO3','HOBR','HOCL','HOI','HONIT','HPALD1','HPALD2','HPALD3','HPALD4','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDC','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','IPRNO3','ITCN','ITHN','LIMO','LVOC','MACR','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MENO3','MGLY','MOH','MONITS','MONITU','MPAN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','N2O5','NH3','NO2','NPRNO3','O3','O3AFBL','O3ASBL','O3ATBL','O3EUBL','O3INIT','O3MT','O3NABL','O3PCBL','O3ROW','O3STRAT','O3USA','O3UT','OPOG1','OPOG2','PAN','POG1','POG2','POPG_BAP','POPG_PHE','POPG_PYR','PP','PPN','PROPNN','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2','TSOG0','TSOG1','TSOG2','TSOG3','AERI','ASOA1','ASOA2','ASOA3','ASOAN','BCPI','BCPO','BE10','BE10STRAT','BE7','BE7STRAT','BRSALA','BRSALC','DST1','DST2','DST3','DST4','DSTAL1','DSTAL2','DSTAL3','DSTAL4','HGP','HGP_ANT','HGP_ARC','HGP_ATL','HGP_BB','HGP_CAM','HGP_CAN','HGP_EAF','HGP_EAS','HGP_EEU','HGP_EUR','HGP_GEO','HGP_JPN','HGP_MDE','HGP_NAF','HGP_NAT','HGP_NPA','HGP_OCE','HGP_OCN','HGP_SAF','HGP_SAM','HGP_SAS','HGP_SAT','HGP_SEA','HGP_SO','HGP_SOV','HGP_STR','HGP_USA','HGP_WAF','INDIOL','IONITA','ISALA','ISALC','LVOCOA','MONITA','MOPI','MOPO','MSA','NH4','NIT','NITD1','NITD2','NITD3','NITD4','NITS','OCPI','OCPO','OPOA1','OPOA2','PB210','PB210STRAT','PFE','POA1','POA2','POPPBCPI_BAP','POPPBCPI_PHE','POPPBCPI_PYR','POPPBCPO_BAP','POPPBCPO_PHE','POPPBCPO_PYR','POPPOCPI_BAP','POPPOCPI_PHE','POPPOCPI_PYR','POPPOCPO_BAP','POPPOCPO_PHE','POPPOCPO_PYR','SALA','SALAAL','SALACL','SALC','SALCAL','SALCCL','SO4','SO4D1','SO4D2','SO4D3','SO4D4','SO4S','SOAGX','SOAIE','SOAS','TSOA0','TSOA1','TSOA2','TSOA3', - - - - 'dst_a1','so4_a1','nh4_a1','pom_a1','pomff1_a1','pombb1_a1','soa_a1','bc_a1','ncl_a1','num_a1','so4_a2','nh4_a2','soa_a2','ncl_a2','dst_a2','num_a2','dst_a3','ncl_a3','so4_a3','pom_a3','bc_a3','num_a3','ncl_a4','so4_a4','pom_a4','pomff1_a4','pombb1_a4','bc_a4','nh4_a4','num_a4','dst_a5','so4_a5','nh4_a5','num_a5','ncl_a6','so4_a6','nh4_a6','num_a6','dst_a7','so4_a7','nh4_a7','num_a7','soa1_a1','soa1_a2','soa2_a1','soa2_a2','soa3_a1','soa3_a2','soa4_a1','soa4_a2','soa5_a1','soa5_a2','soaff1_a1','soaff2_a1','soaff3_a1','soaff4_a1','soaff5_a1','soabb1_a1','soabb2_a1','soabb3_a1','soabb4_a1','soabb5_a1','soabg1_a1','soabg2_a1','soabg3_a1','soabg4_a1','soabg5_a1','soaff1_a2','soaff2_a2','soaff3_a2','soaff4_a2','soaff5_a2','soabb1_a2','soabb2_a2','soabb3_a2','soabb4_a2','soabb5_a2','soabg1_a2','soabg2_a2','soabg3_a2','soabg4_a2','soabg5_a2' - - - - 'ACTA','ALD2','ASOG1','ASOG2','ASOG3','ATOOH','BR2','BRCL','CH2O','EOH','ETHLN','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HG2','HG2_ANT','HG2_ARC','HG2_ATL','HG2_BB','HG2_CAM','HG2_CAN','HG2_EAF','HG2_EAS','HG2_EEU','HG2_EUR','HG2_GEO','HG2_JPN','HG2_MDE','HG2_NAF','HG2_NAT','HG2_NPA','HG2_OCE','HG2_OCN','HG2_SAF','HG2_SAM','HG2_SAS','HG2_SAT','HG2_SEA','HG2_SO','HG2_SOV','HG2_STR','HG2_USA','HG2_WAF','HI','HMHP','HMML','HNO3','HOBR','HOCL','HOI','HONIT','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','ITCN','ITHN','LIMO','LVOC','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MEK','MGLY','MOH','MONITS','MONITU','MP','MPAN','MPN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','NH3','OPOG1','OPOG2','PAN','POG1','POG2','POPG_BAP','POPG_PHE','POPG_PYR','PP','PPN','PROPNN','PRPE','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2','TSOG0','TSOG1','TSOG2','TSOG3','AERI','ASOA1','ASOA2','ASOA3','ASOAN','BCPI','BCPO','BE10','BE10STRAT','BE7','BE7STRAT','BRSALA','BRSALC','DST1','DST2','DST3','DST4','DSTAL1','DSTAL2','DSTAL3','DSTAL4','HGP','HGP_ANT','HGP_ARC','HGP_ATL','HGP_BB','HGP_CAM','HGP_CAN','HGP_EAF','HGP_EAS','HGP_EEU','HGP_EUR','HGP_GEO','HGP_JPN','HGP_MDE','HGP_NAF','HGP_NAT','HGP_NPA','HGP_OCE','HGP_OCN','HGP_SAF','HGP_SAM','HGP_SAS','HGP_SAT','HGP_SEA','HGP_SO','HGP_SOV','HGP_STR','HGP_USA','HGP_WAF','INDIOL','IONITA','ISALA','ISALC','LVOCOA','MONITA','MOPI','MOPO','MSA','NH4','NIT','NITD1','NITD2','NITD3','NITD4','NITS','OCPI','OCPO','OPOA1','OPOA2','PB210','PB210STRAT','PFE','POA1','POA2','POPPBCPI_BAP','POPPBCPI_PHE','POPPBCPI_PYR','POPPBCPO_BAP','POPPBCPO_PHE','POPPBCPO_PYR','POPPOCPI_BAP','POPPOCPI_PHE','POPPOCPI_PYR','POPPOCPO_BAP','POPPOCPO_PHE','POPPOCPO_PYR','SALA','SALAAL','SALACL','SALC','SALCAL','SALCCL','SO4','SO4D1','SO4D2','SO4D3','SO4D4','SO4S','SOAGX','SOAIE','SOAS','TSOA0','TSOA1','TSOA2','TSOA3', - - - - 'dst_a1','so4_a1','nh4_a1','pom_a1','pomff1_a1','pombb1_a1','soa_a1','bc_a1','ncl_a1','num_a1','so4_a2','nh4_a2','soa_a2','ncl_a2','dst_a2','num_a2','dst_a3','ncl_a3','so4_a3','pom_a3','bc_a3','num_a3','ncl_a4','so4_a4','pom_a4','pomff1_a4','pombb1_a4','bc_a4','nh4_a4','num_a4','dst_a5','so4_a5','nh4_a5','num_a5','ncl_a6','so4_a6','nh4_a6','num_a6','dst_a7','so4_a7','nh4_a7','num_a7','soa1_a1','soa1_a2','soa2_a1','soa2_a2','soa3_a1','soa3_a2','soa4_a1','soa4_a2','soa5_a1','soa5_a2','soaff1_a1','soaff2_a1','soaff3_a1','soaff4_a1','soaff5_a1','soabb1_a1','soabb2_a1','soabb3_a1','soabb4_a1','soabb5_a1','soabg1_a1','soabg2_a1','soabg3_a1','soabg4_a1','soabg5_a1','soaff1_a2','soaff2_a2','soaff3_a2','soaff4_a2','soaff5_a2','soabb1_a2','soabb2_a2','soabb3_a2','soabb4_a2','soabb5_a2','soabg1_a2','soabg2_a2','soabg3_a2','soabg4_a2','soabg5_a2' - - From 9ab1b89fa008c2954d30792ace3b95c9106bfb73 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Thu, 4 Aug 2022 09:14:30 -0600 Subject: [PATCH 037/291] Updates to Neu wet dep in GEOS-Chem for Henry's Law coeffs from netcdf Signed-off-by: Lizzie Lundgren --- src/chemistry/geoschem/mo_neu_wetdep.F90 | 203 +++++++++++------------ 1 file changed, 101 insertions(+), 102 deletions(-) diff --git a/src/chemistry/geoschem/mo_neu_wetdep.F90 b/src/chemistry/geoschem/mo_neu_wetdep.F90 index 809df9ad86..4f3f2fc040 100644 --- a/src/chemistry/geoschem/mo_neu_wetdep.F90 +++ b/src/chemistry/geoschem/mo_neu_wetdep.F90 @@ -12,7 +12,7 @@ module mo_neu_wetdep use constituents, only : pcnst use spmd_utils, only : masterproc use cam_abortutils, only : endrun - use seq_drydep_mod, only : n_species_table, species_name_table, dheff + use shr_drydep_mod, only : n_species_table, species_name_table, dheff use gas_wetdep_opts, only : gas_wetdep_method, gas_wetdep_list, gas_wetdep_cnt ! implicit none @@ -83,80 +83,84 @@ subroutine neu_wetdep_init test_name = gas_wetdep_list(m) if ( debug ) print '(i4,a)',m,trim(test_name) ! -! mapping based on the MOZART4 wet removal subroutine; -! this might need to be redone (JFL: Sep 2010) -! - select case( trim(test_name) ) -! -! CCMI: added SO2t and NH_50W -! - case( 'HYAC', 'CH3COOH' , 'HCOOH', 'EOOH', 'IEPOX' ) - test_name = 'CH2O' - case ( 'SOGB','SOGI','SOGM','SOGT','SOGX' ) - test_name = 'H2O2' - case ( 'SO2t' ) - test_name = 'SO2' - case ( 'CLONO2','BRONO2','HCL','HOCL','HOBR','HBR', 'Pb', 'MACROOH', 'ISOPOOH', 'XOOH', 'H2SO4', 'HF', 'COF2', 'COFCL') - test_name = 'HNO3' - case ( 'NH_50W', 'NDEP', 'NHDEP', 'NH4NO3' ) - test_name = 'HNO3' - case ( 'ALKOOH', 'MEKOOH', 'TOLOOH' ) - test_name = 'CH3OOH' - case( 'PHENOOH', 'BENZOOH', 'C6H5OOH', 'BZOOH', 'XYLOLOOH', 'XYLENOOH', 'HPALD' ) - test_name = 'CH3OOH' - case( 'TERPOOH', 'TERP2OOH', 'MBOOOH' ) - test_name = 'HNO3' - case( 'TERPROD1', 'TERPROD2' ) - test_name = 'CH2O' - case( 'HMPROP' ) - test_name = 'GLYALD' - case( 'NOA', 'ALKNIT', 'ISOPNITA', 'ISOPNITB', 'HONITR', 'ISOPNOOH' ) - test_name = 'H2O2' - case( 'NC4CHO', 'NC4CH2OH', 'TERPNIT', 'NTERPOOH' ) - test_name = 'H2O2' - case( 'SOAGbb0' ) ! Henry's Law coeff. added for VBS SOA's, biomass burning is the same as fossil fuels - test_name = 'SOAGff0' - case( 'SOAGbb1' ) - test_name = 'SOAGff1' - case( 'SOAGbb2' ) - test_name = 'SOAGff2' - case( 'SOAGbb3' ) - test_name = 'SOAGff3' - case( 'SOAGbb4' ) - test_name = 'SOAGff4' - case( 'H2O2' ) - test_name = 'GC_H2O2' - case( 'HCHO' ) - test_name = 'GC_CH2O' - case( 'CH2O' ) - test_name = 'GC_CH2O' - case( 'NO2' ) - test_name = 'GC_NO2' - !case( 'HNO3' ) - ! test_name = 'GC_HNO3' - case( 'NH3' ) - test_name = 'GC_NH3' - case( 'N2O5' ) - test_name = 'GC_N2O5' - case( 'PAN' ) - test_name = 'GC_PAN' - !case( 'SO2' ) - ! test_name = 'GC_SO2' - ! Now list all non-MAM GEOS-Chem aerosols. These will be scavenged similarly - ! to HNO3 - case( 'AERI', 'BRSALA', 'BRSALC', 'INDIOL', & - 'IONITA', 'ISALA', 'ISALC', 'LVOCOA', 'MONITA', & - 'MSA', 'NH4', 'NIT', 'NITS', 'PFE', & - 'SALAAL', 'SALACL', 'SALCAL', 'SALCCL', 'SO4S', & - 'SOAS', 'SOAGX', 'SOAIE', 'TSOA0', 'TSOA1', & - 'TSOA2', 'TSOA3', 'ASOAN', 'ASOA1', 'ASOA2', & - 'ASOA3' ) - test_name = 'HNO3' - case( 'ASOG1', 'ASOG2', 'ASOG3' ) - test_name = 'ASOG' - case( 'TSOG0', 'TSOG1', 'TSOG2', 'TSOG3' ) - test_name = 'TSOG' - end select +! ewl: this mapping can be replaced by including Henry's Law etc for all species, which makes usage of +! the parameters more transparent. I will comment out.... +!!!! +!!!! mapping based on the MOZART4 wet removal subroutine; +!!!! this might need to be redone (JFL: Sep 2010) +!!!! +!!! select case( trim(test_name) ) +!!!! +!!!! CCMI: added SO2t and NH_50W +!!!! +!!! case( 'HYAC', 'CH3COOH' , 'HCOOH', 'EOOH', 'IEPOX' ) +!!! test_name = 'CH2O' +!!! case ( 'SOGB','SOGI','SOGM','SOGT','SOGX' ) +!!! test_name = 'H2O2' +!!! case ( 'SO2t' ) +!!! test_name = 'SO2' +!!! case ( 'CLONO2','BRONO2','HCL','HOCL','HOBR','HBR', 'Pb', 'MACROOH', 'ISOPOOH', 'XOOH', 'H2SO4', 'HF', 'COF2', 'COFCL') +!!! test_name = 'HNO3' +!!! case ( 'NH_50W', 'NDEP', 'NHDEP', 'NH4NO3' ) +!!! test_name = 'HNO3' +!!! case ( 'ALKOOH', 'MEKOOH', 'TOLOOH' ) +!!! test_name = 'CH3OOH' +!!! case( 'PHENOOH', 'BENZOOH', 'C6H5OOH', 'BZOOH', 'XYLOLOOH', 'XYLENOOH', 'HPALD' ) +!!! test_name = 'CH3OOH' +!!! case( 'TERPOOH', 'TERP2OOH', 'MBOOOH' ) +!!! test_name = 'HNO3' +!!! case( 'TERPROD1', 'TERPROD2' ) +!!! test_name = 'CH2O' +!!! case( 'HMPROP' ) +!!! test_name = 'GLYALD' +!!! case( 'NOA', 'ALKNIT', 'ISOPNITA', 'ISOPNITB', 'HONITR', 'ISOPNOOH' ) +!!! test_name = 'H2O2' +!!! case( 'NC4CHO', 'NC4CH2OH', 'TERPNIT', 'NTERPOOH' ) +!!! test_name = 'H2O2' +!!! case( 'SOAGbb0' ) ! Henry's Law coeff. added for VBS SOA's, biomass burning is the same as fossil fuels +!!! test_name = 'SOAGff0' +!!! case( 'SOAGbb1' ) +!!! test_name = 'SOAGff1' +!!! case( 'SOAGbb2' ) +!!! test_name = 'SOAGff2' +!!! case( 'SOAGbb3' ) +!!! test_name = 'SOAGff3' +!!! case( 'SOAGbb4' ) +!!! test_name = 'SOAGff4' +!!! case( 'H2O2' ) +!!! test_name = 'GC_H2O2' +!!! case( 'HCHO' ) +!!! test_name = 'GC_CH2O' +!!! case( 'CH2O' ) +!!! test_name = 'GC_CH2O' +!!! case( 'NO2' ) +!!! test_name = 'GC_NO2' +!!! !case( 'HNO3' ) +!!! ! test_name = 'GC_HNO3' +!!! case( 'NH3' ) +!!! test_name = 'GC_NH3' +!!! case( 'N2O5' ) +!!! test_name = 'GC_N2O5' +!!! case( 'PAN' ) +!!! test_name = 'GC_PAN' +!!! !case( 'SO2' ) +!!! ! test_name = 'GC_SO2' +!!! ! Now list all non-MAM GEOS-Chem aerosols. These will be scavenged similarly +!!! ! to HNO3 +!!! case( 'AERI', 'BRSALA', 'BRSALC', 'INDIOL', & +!!! 'IONITA', 'ISALA', 'ISALC', 'LVOCOA', 'MONITA', & +!!! 'MSA', 'NH4', 'NIT', 'NITS', 'PFE', & +!!! 'SALAAL', 'SALACL', 'SALCAL', 'SALCCL', 'SO4S', & +!!! 'SOAS', 'SOAGX', 'SOAIE', 'TSOA0', 'TSOA1', & +!!! 'TSOA2', 'TSOA3', 'ASOAN', 'ASOA1', 'ASOA2', & +!!! 'ASOA3' ) +!!! test_name = 'HNO3' +!!! case( 'ASOG1', 'ASOG2', 'ASOG3' ) +!!! test_name = 'ASOG' +!!! case( 'TSOG0', 'TSOG1', 'TSOG2', 'TSOG3' ) +!!! test_name = 'TSOG' +!!! end select +! ! do l = 1,n_species_table ! @@ -169,10 +173,8 @@ subroutine neu_wetdep_init end if end do if ( mapping_to_heff(m) == -99 ) then -! ewl: kludge until I add new species to species table in seq_drydep_mod.F90 -! if (masterproc) print *,'problem with mapping_to_heff of ',trim(test_name) -!! call endrun() - mapping_to_heff(m) = 1 + print '(a,a)','neu_wetdep_init: ERROR: Ending run because mapping to species heff not found for ',trim(test_name) + call endrun() end if ! ! special cases for NH3 and CO2 @@ -204,7 +206,7 @@ subroutine neu_wetdep_init call cnst_get_ind(gas_wetdep_list(m), mapping_to_mmr(m), abort=.false. ) if ( debug ) print '(a,i4)','mapping_to_mmr ',mapping_to_mmr(m) if ( mapping_to_mmr(m) <= 0 ) then - print *,'problem with mapping_to_mmr of ',gas_wetdep_list(m) + print *,'neu_wetdep_init: problem with mapping_to_mmr of ',gas_wetdep_list(m) call endrun('problem with mapping_to_mmr of '//trim(gas_wetdep_list(m))) end if end do @@ -263,10 +265,10 @@ end subroutine neu_wetdep_init subroutine neu_wetdep_tend(lchnk,ncol,mmr,pmid,pdel,zint,tfld,delt, & prain, nevapr, cld, cmfdqr, wd_tend, wd_tend_int) ! - use ppgrid, only : pcols, pver -!!DEK + use ppgrid, only : pcols, pver use phys_grid, only : get_area_all_p, get_rlat_all_p use shr_const_mod, only : SHR_CONST_REARTH,SHR_CONST_G + use shr_const_mod, only : pi => shr_const_pi use cam_history, only : outfld ! implicit none @@ -288,7 +290,7 @@ subroutine neu_wetdep_tend(lchnk,ncol,mmr,pmid,pdel,zint,tfld,delt, & ! ! local arrays and variables ! - integer :: i,k,l,kk,m,id + integer :: i,k,l,kk,m real(r8), parameter :: rearth = SHR_CONST_REARTH ! radius earth (m) real(r8), parameter :: gravit = SHR_CONST_G ! m/s^2 real(r8), dimension(ncol) :: area, wk_out @@ -310,14 +312,13 @@ subroutine neu_wetdep_tend(lchnk,ncol,mmr,pmid,pdel,zint,tfld,delt, & real(r8), parameter :: ph_inv = 1._r8/ph real(r8) :: e298, dhr real(r8), dimension(ncol) :: dk1s,dk2s,wrk -!!DEK - real(r8) :: pi real(r8) :: lats(pcols) + + real(r8), parameter :: rad2deg = 180._r8/pi + ! ! from cam/src/physics/cam/stratiform.F90 ! -!!DEK - pi = 4._r8*atan(1.0_r8) if (.not.do_neu_wetdep) return ! @@ -381,7 +382,6 @@ subroutine neu_wetdep_tend(lchnk,ncol,mmr,pmid,pdel,zint,tfld,delt, & end do ! ! compute effective Henry's law coefficients -! code taken from models/drv/shr/seq_drydep_mod.F90 ! heff = 0._r8 do k=1,pver @@ -393,14 +393,13 @@ subroutine neu_wetdep_tend(lchnk,ncol,mmr,pmid,pdel,zint,tfld,delt, & do m=1,gas_wetdep_cnt ! l = mapping_to_heff(m) - id = 6*(l - 1) - e298 = dheff(id+1) - dhr = dheff(id+2) + e298 = dheff(1,l) + dhr = dheff(2,l) heff(:,k,m) = e298*exp( dhr*wrk(:) ) test_flag = -99 - if( dheff(id+3) /= 0._r8 .and. dheff(id+5) == 0._r8 ) then - e298 = dheff(id+3) - dhr = dheff(id+4) + if( dheff(3,l) /= 0._r8 .and. dheff(5,l) == 0._r8 ) then + e298 = dheff(3,l) + dhr = dheff(4,l) dk1s(:) = e298*exp( dhr*wrk(:) ) where( heff(:,k,m) /= 0._r8 ) heff(:,k,m) = heff(:,k,m)*(1._r8 + dk1s(:)*ph_inv) @@ -410,15 +409,15 @@ subroutine neu_wetdep_tend(lchnk,ncol,mmr,pmid,pdel,zint,tfld,delt, & endwhere end if ! - if (k.eq.1 .and. maxval(test_flag) > 0 .and. debug ) print '(a,i4)','heff for m=',m + if (k.eq.1 .and. maxval(test_flag) > 0 .and. debug .and. masterproc) print '(a,i4)','neu_wetdep_tend: heff for m=',m ! - if( dheff(id+5) /= 0._r8 ) then + if( dheff(5,l) /= 0._r8 ) then if( nh3_ndx > 0 .or. co2_ndx > 0 ) then - e298 = dheff(id+3) - dhr = dheff(id+4) + e298 = dheff(3,l) + dhr = dheff(4,l) dk1s(:) = e298*exp( dhr*wrk(:) ) - e298 = dheff(id+5) - dhr = dheff(id+6) + e298 = dheff(5,l) + dhr = dheff(6,l) dk2s(:) = e298*exp( dhr*wrk(:) ) if( m == co2_ndx ) then heff(:,k,m) = heff(:,k,m)*(1._r8 + dk1s(:)*ph_inv)*(1._r8 + dk2s(:)*ph_inv) @@ -473,11 +472,11 @@ subroutine neu_wetdep_tend(lchnk,ncol,mmr,pmid,pdel,zint,tfld,delt, & dtwr(1:ncol,:,:) = wd_mmr(1:ncol,:,:) - dtwr(1:ncol,:,:) dtwr(1:ncol,:,:) = dtwr(1:ncol,:,:) / delt -!!DEK polarward of 60S, 60N and <200hPa set to zero! +! polarward of 60S, 60N and <200hPa set to zero! call get_rlat_all_p(lchnk, pcols, lats ) do k = 1, pver do i= 1, ncol - if ( abs( lats(i)*180._r8/pi ) > 60._r8 ) then + if ( abs( lats(i)*rad2deg ) > 60._r8 ) then if ( pmid(i,k) < 20000._r8) then dtwr(i,k,:) = 0._r8 endif From 4fa1cf41517aad55d0e5438a7a051294ea08e6be Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Thu, 4 Aug 2022 09:15:53 -0600 Subject: [PATCH 038/291] Update Neu wet dep debug prints in GEOS-Chem Debug prints are now only done by the master processor. The debug logical is still manually set in mo_neu_wetdep.F90. It is false by default. Signed-off-by: Lizzie Lundgren --- src/chemistry/geoschem/mo_neu_wetdep.F90 | 81 +++++++++++++----------- 1 file changed, 45 insertions(+), 36 deletions(-) diff --git a/src/chemistry/geoschem/mo_neu_wetdep.F90 b/src/chemistry/geoschem/mo_neu_wetdep.F90 index 4f3f2fc040..b7eab09b23 100644 --- a/src/chemistry/geoschem/mo_neu_wetdep.F90 +++ b/src/chemistry/geoschem/mo_neu_wetdep.F90 @@ -73,15 +73,15 @@ subroutine neu_wetdep_init ! ! find mapping to heff table ! - if ( debug ) then - print '(a,i4)','gas_wetdep_cnt=',gas_wetdep_cnt - print '(a,i4)','n_species_table=',n_species_table + if ( debug .and. masterproc ) then + print '(a,i4)','neu_wetdep_init: gas_wetdep_cnt=',gas_wetdep_cnt + print '(a,i4)','neu_wetdep_init: n_species_table=',n_species_table end if mapping_to_heff = -99 do m=1,gas_wetdep_cnt ! test_name = gas_wetdep_list(m) - if ( debug ) print '(i4,a)',m,trim(test_name) + if ( debug .and. masterproc ) print '(a,i4,a)','neu_wetdep_init: gas_wetdep_list species ',m,trim(test_name) ! ! ewl: this mapping can be replaced by including Henry's Law etc for all species, which makes usage of ! the parameters more transparent. I will comment out.... @@ -161,14 +161,12 @@ subroutine neu_wetdep_init !!! test_name = 'TSOG' !!! end select ! + if ( debug .and. masterproc ) print '(a,i4,a)','neu_wetdep_init: using name for mapping: ',m,trim(test_name) ! do l = 1,n_species_table -! -! if ( debug ) print '(i4,a)',l,trim(species_name_table(l)) -! if( trim(test_name) == trim( species_name_table(l) ) ) then mapping_to_heff(m) = l - if ( debug ) print '(a,a,i4)','mapping to heff of ',trim(species_name_table(l)),l + if ( debug .and. masterproc ) print '(a,a,i4)','neu_wetdep_init: found mapping to heff of ',trim(species_name_table(l)),l exit end if end do @@ -193,18 +191,18 @@ subroutine neu_wetdep_init if (any ( mapping_to_heff(:) == -99 )) call endrun('mo_neu_wet->depwetdep_init: unmapped species error' ) ! - if ( debug ) then - print '(a,i4)','co2_ndx',co2_ndx - print '(a,i4)','nh3_ndx',nh3_ndx + if ( debug .and. masterproc ) then + print '(a,i4)','neu_wetdep_init: co2_ndx',co2_ndx + print '(a,i4)','neu_wetdep_init: nh3_ndx',nh3_ndx end if ! ! find mapping to species ! mapping_to_mmr = -99 do m=1,gas_wetdep_cnt - if ( debug ) print '(i4,a)',m,trim(gas_wetdep_list(m)) + if ( debug .and. masterproc ) print '(a,i4,a)','neu_wetdep_init: ',m,trim(gas_wetdep_list(m)) call cnst_get_ind(gas_wetdep_list(m), mapping_to_mmr(m), abort=.false. ) - if ( debug ) print '(a,i4)','mapping_to_mmr ',mapping_to_mmr(m) + if ( debug .and. masterproc) print '(a,i4)','neu_wetdep_init: mapping_to_mmr ',mapping_to_mmr(m) if ( mapping_to_mmr(m) <= 0 ) then print *,'neu_wetdep_init: problem with mapping_to_mmr of ',gas_wetdep_list(m) call endrun('problem with mapping_to_mmr of '//trim(gas_wetdep_list(m))) @@ -216,7 +214,7 @@ subroutine neu_wetdep_init do m=1,gas_wetdep_cnt ! mol_weight(m) = cnst_mw(mapping_to_mmr(m)) - if ( debug ) print '(i4,a,f8.4)',m,' mol_weight ',mol_weight(m) + if ( debug .and. masterproc ) print '(a,i4,a,f8.4)','neu_wetdep_init: ',m,' mol_weight ',mol_weight(m) ice_uptake(m) = .false. if ( trim(gas_wetdep_list(m)) == 'HNO3' ) then ice_uptake(m) = .true. @@ -433,13 +431,24 @@ subroutine neu_wetdep_tend(lchnk,ncol,mmr,pmid,pdel,zint,tfld,delt, & end do end do ! - if ( debug ) then - print '(a,50f8.2)','tckaqb ',tckaqb - print '(a,50e12.4)','heff ',heff(1,1,:) - print '(a,50i4)' ,'ice_uptake ',ice_uptake - print '(a,50f8.2)','mol_weight ',mol_weight(:) - print '(a,50f8.2)','temp ',temp(1,:) - print '(a,50f8.2)','p ',p (1,:) + if ( debug .and. masterproc ) then + print '(a)','neu_wetdep_tend: ' + do m=1,gas_wetdep_cnt + print '(a,a)','wetdep species name: ',trim(gas_wetdep_list(m)) + l = mapping_to_heff(m) + print '(a,50e12.4)','dheff(1,l): ', dheff(1,l) + print '(a,50e12.4)','dheff(1,l): ', dheff(2,l) + print '(a,50e12.4)','dheff(1,l): ', dheff(3,l) + print '(a,50e12.4)','dheff(1,l): ', dheff(4,l) + print '(a,50e12.4)','dheff(1,l): ', dheff(5,l) + print '(a,50e12.4)','dheff(1,l): ', dheff(6,l) + print '(a,50f8.2)','tckaqb ',tckaqb(m) + print '(a,50e12.4)','heff ',heff(1,1,m) + print '(a,50i4)' ,'ice_uptake ',ice_uptake(m) + print '(a,50f8.2)','mol_weight ',mol_weight(m) + print '(a,50f8.2)','temp ',temp(1,m) + print '(a,50f8.2)','p ',p (1,m) + enddo end if ! ! call J. Neu's subroutine @@ -503,7 +512,7 @@ subroutine neu_wetdep_tend(lchnk,ncol,mmr,pmid,pdel,zint,tfld,delt, & ! ! to be used in mo_chm_diags to compute wet_deposition_NOy_as_N and wet_deposition_NHx_as_N (units: kg/m2/s) ! - if ( debug) print *,'mo_neu ',mapping_to_mmr(m),(wk_out(1:ncol)) + if ( debug .and. masterproc ) print *,'neu_wetdep_tend: ',mapping_to_mmr(m),(wk_out(1:ncol)) wd_tend_int(1:ncol,mapping_to_mmr(m)) = wk_out(1:ncol) ! end do @@ -625,7 +634,7 @@ subroutine WASHO(LPAR,NTRACE,DTSCAV,QTTJFL,QM,POFL,DELZ, & ! integer :: LWASHTYP,LICETYP ! - if ( debug ) then + if ( debug .and. masterproc ) then print '(a,50f8.2)','tckaqb ',tckaqb print '(a,50e12.4)','hstar ',hstar(1,:) print '(a,50i4)' ,'ice_uptake ',TCNION @@ -767,7 +776,7 @@ subroutine WASHO(LPAR,NTRACE,DTSCAV,QTTJFL,QM,POFL,DELZ, & !----------------------------------------------------------------------- FAX = max( zero,FAMA*(one - evaprate(l)) ) RAX = RAMA !kg/m2/s - if ( debug ) then + if ( debug .and. masterproc ) then if( (l == 3 .or. l == 2) ) then write(*,*) 'washout: l,rls,fax = ',l,rls(l),fax endif @@ -804,7 +813,7 @@ subroutine WASHO(LPAR,NTRACE,DTSCAV,QTTJFL,QM,POFL,DELZ, & endif RNEW = RLSOG(L) - (RAX*FAX + RCA*FCA) !GBA*CF rnew_wrk(l) = rnew_tst - if ( debug ) then + if ( debug .and. masterproc ) then if( is_hno3 .and. l == kdiag-1 ) then write(*,*) ' ' write(*,*) 'washout: rls,rax,fax,rca,fca' @@ -928,7 +937,7 @@ subroutine WASHO(LPAR,NTRACE,DTSCAV,QTTJFL,QM,POFL,DELZ, & WEMP = (CLWX*QM(L))/(GAREA*CFXX(L)*DELZ(L)) !kg/m3 REMP = RPRECIP/((RHORAIN/1.e3_r8)) !mm/s local DNEW = DEMPIRICAL( WEMP, REMP ) - if ( debug ) then + if ( debug .and. masterproc ) then if( is_hno3 .and. l >= 15 ) then write(*,*) ' ' write(*,*) 'washout: wemp,remp.dnew @ l = ',l @@ -959,7 +968,7 @@ subroutine WASHO(LPAR,NTRACE,DTSCAV,QTTJFL,QM,POFL,DELZ, & DEMP = zero DCXA = zero endif - if ( debug ) then + if ( debug .and. masterproc ) then if( is_hno3 .and. l >= 15 ) then write(*,*) ' ' write(*,*) 'washout: rca,rcxa,deltarime,dor,rprecip,dnew @ l = ',l @@ -994,7 +1003,7 @@ subroutine WASHO(LPAR,NTRACE,DTSCAV,QTTJFL,QM,POFL,DELZ, & QTRAINCXA = zero QTRAINCXB = zero endif - if( debug .and. is_hno3 .and. l == kdiag ) then + if( debug .and. masterproc .and. is_hno3 .and. l == kdiag ) then write(*,*) ' ' write(*,*) 'washout: Ice Scavenging' write(*,*) 'washout: qtraincxa, qtraincxb, fcxa, fcxb, qt_rain, cfxx(l), wrk @ level = ',l @@ -1021,7 +1030,7 @@ subroutine WASHO(LPAR,NTRACE,DTSCAV,QTTJFL,QM,POFL,DELZ, & HSTAR(L,N), TEM(L), POFL(L), & QM(L), QTCXA, QTDISRIME ) QTDISSTAR = (QTDISRIME*QTCXA)/(QTDISRIME + QTCXA) - if ( debug ) then + if ( debug .and. masterproc ) then if( is_hno3 .and. l >= 15 ) then write(*,*) ' ' write(*,*) 'washout: fcxa,dca,rca,qtdisstar @ l = ',l @@ -1099,7 +1108,7 @@ subroutine WASHO(LPAR,NTRACE,DTSCAV,QTTJFL,QM,POFL,DELZ, & WRK = QTRAIN/CFXX(L) QTRAINCXA = FCXA*WRK QTRAINCXB = FCXB*WRK - if( debug .and. is_hno3 .and. l == kdiag ) then + if( debug .and. masterproc .and. is_hno3 .and. l == kdiag ) then write(*,*) ' ' write(*,*) 'washout: Rain Scavenging' write(*,*) 'washout: qtraincxa, qtraincxb, fcxa, fcxb, qt_rain, cfxx(l), wrk @ level = ',l @@ -1221,7 +1230,7 @@ subroutine WASHO(LPAR,NTRACE,DTSCAV,QTTJFL,QM,POFL,DELZ, & QTEVAPAXP = min( QTTOPAA,QTTOPAA - (RAMPCT*(QTTOPAA-QTEVAPAXP)) ) FAX = FAXADJ RAX = RAXADJ - if ( debug ) then + if ( debug .and. masterproc ) then if( (l == 3 .or. l == 2) ) then write(*,*) 'washout: l,fcxa,fax = ',l,fcxa,fax endif @@ -1375,7 +1384,7 @@ subroutine WASHO(LPAR,NTRACE,DTSCAV,QTTJFL,QM,POFL,DELZ, & else CFXX(LM1) = CFR(LM1) endif - if( is_hno3 .and. lm1 == kdiag .and. debug ) then + if( is_hno3 .and. lm1 == kdiag .and. debug .and. masterproc ) then write(*,*) ' ' write(*,*) 'washout: rls,garea,rcxa,fcxa,rcxb,fcxb,rax,fax' write(*,'(1p,8g15.7)') rls(lm1),garea,rcxa,fcxa,rcxb,fcxb,rax,fax @@ -1422,7 +1431,7 @@ subroutine WASHO(LPAR,NTRACE,DTSCAV,QTTJFL,QM,POFL,DELZ, & ! Maintain cloud core by reducing NC and AM area going into cloud below !----------------------------------------------------------------------- RCA = (RCXA*FCXA*CLOLDPCT + RCXB*FCXB*CLNEWPCT + RAX*FAX*AMCLPCT)/FCA - if ( debug ) then + if ( debug .and. masterproc ) then if( is_hno3 ) then write(*,*) ' ' write(*,*) 'washout: rcxa,fcxa,cloldpctrca,rca,fca,dcxa @ l = ',l @@ -1531,13 +1540,13 @@ subroutine WASHO(LPAR,NTRACE,DTSCAV,QTTJFL,QM,POFL,DELZ, & frc(l,2) = qtnetlcxb frc(l,3) = qtnetlax endif - if( debug .and. is_hno3 .and. l == kdiag ) then + if( debug .and. masterproc .and. is_hno3 .and. l == kdiag ) then write(*,*) ' ' write(*,*) 'washout: qtraincxa, qtraincxb, qtrimecxa @ level = ',l write(*,'(1p,3g15.7)') qtraincxa, qtraincxb, qtrimecxa write(*,*) ' ' endif - if ( debug ) then + if ( debug .and. masterproc ) then if( (l == 3 .or. l == 2) ) then write(*,*) 'washout: hno3, hno3, qtnetlca,b, qtnetlax @ level = ',l write(*,'(1p,5g15.7)') qttnew(l), qtt(l), qtnetlcxa, qtnetlcxb, qtnetlax @@ -1552,7 +1561,7 @@ subroutine WASHO(LPAR,NTRACE,DTSCAV,QTTJFL,QM,POFL,DELZ, & QTTOPAA = QTTOPAAX end do level_loop - if ( debug ) then + if ( debug .and. masterproc) then if( is_hno3 ) then write(*,*) ' ' write(*,*) 'washout: clwx_wrk' From 9fed226d09da69abec0d9183554a07d5738b0567 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Thu, 4 Aug 2022 09:21:39 -0600 Subject: [PATCH 039/291] Preliminary updates for GEOS-Chem 14.0 Signed-off-by: Lizzie Lundgren --- bld/configure | 2 +- bld/namelist_files/namelist_defaults_cam.xml | 1 + cime_config/buildnml | 14 +- src/chemistry/geoschem/cesmgc_diag_mod.F90 | 46 +++--- src/chemistry/geoschem/chem_mods.F90 | 2 +- src/chemistry/geoschem/chemistry.F90 | 149 ++++++++++--------- src/chemistry/geoschem/mo_sim_dat.F90 | 53 ++++--- 7 files changed, 141 insertions(+), 126 deletions(-) diff --git a/bld/configure b/bld/configure index 5324dbd63a..b5604f3860 100755 --- a/bld/configure +++ b/bld/configure @@ -1404,7 +1404,7 @@ if ($chem_pkg =~ '_mam3') { # TMMF - wedge in GEOS-Chem CPP definitions here if ($chem_pkg =~ 'geoschem') { $chem_cppdefs .= ' -DEXTERNAL_GRID -DEXTERNAL_FORCING -DLINUX_IFORT -DUSE_REAL8 -DMODEL_ -DMODEL_CESM'; - $chem_nadv = 252; + $chem_nadv = 266; if (defined $opts{'clm_vers'}) { if ($opts{'clm_vers'} =~ 'CLM4.0') { $chem_cppdefs .= ' -DCLM40' diff --git a/bld/namelist_files/namelist_defaults_cam.xml b/bld/namelist_files/namelist_defaults_cam.xml index 19a8a6f13d..dc8b169857 100644 --- a/bld/namelist_files/namelist_defaults_cam.xml +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -3237,6 +3237,7 @@ + atm/cam/chem/trop_mozart/dvel/dep_data_c201019.nc +/glade/u/home/elundgren/drydep_henrys_law_nc/dep_data_file_geoschem.nc atm/waccm/phot/effxstex.txt @@ -3233,13 +3234,13 @@ -'ACET','ACTA','ALD2','AROMP4','AROMP5','ATOOH','BALD','BENZP','BR2','BRCL','BRNO3','BZCO3H','BZPAN','CH2O','CL2','CLNO2','CLNO3','CLO','CLOO','CSL','EOH','ETHLN','ETHN','ETHP','ETNO3','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HI','HMHP','HMML','HMS','HNO3','HOBR','HOCL','HOI','HONIT','HPALD1','HPALD2','HPALD3','HPALD4','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDC','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','IPRNO3','ITCN','ITHN','LIMO','LVOC','LVOCOA','MACR','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MCT','MENO3','MGLY','MOH','MONITS','MONITU','MPAN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','N2O5','NH3','NO2','NPHEN','NPRNO3','O3','PAN','PHEN','PP','PPN','PROPNN','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2' +'ACET','ACTA','ALD2','AROMP4','AROMP5','ATOOH','BALD','BENZP','BR2','BRCL','BRNO3','BZCO3H','BZPAN','CH2O','CL2','CLNO2','CLNO3','CLO','CLOO','CSL','EOH','ETHLN','ETHN','ETHP','ETNO3','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HI','HMHP','HMML','HNO3','HOBR','HOCL','HOI','HONIT','HPALD1','HPALD2','HPALD3','HPALD4','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDC','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','IPRNO3','ITCN','ITHN','LIMO','LVOC','MACR','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MCT','MENO3','MGLY','MOH','MONITS','MONITU','MPAN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','N2O5','NH3','NO2','NPHEN','NPRNO3','O3','PAN','PHEN','PP','PPN','PROPNN','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2' diff --git a/src/chemistry/geoschem/chemistry.F90 b/src/chemistry/geoschem/chemistry.F90 index e00c569961..7ced1d5107 100644 --- a/src/chemistry/geoschem/chemistry.F90 +++ b/src/chemistry/geoschem/chemistry.F90 @@ -11,7 +11,7 @@ module chemistry use constituents, only : pcnst, cnst_add, cnst_get_ind use constituents, only : cnst_name use shr_const_mod, only : molw_dryair=>SHR_CONST_MWDAIR - use seq_drydep_mod, only : nddvels => n_drydep, drydep_list + use shr_drydep_mod, only : nddvels => n_drydep, drydep_list use spmd_utils, only : MasterProc, myCPU=>Iam, nCPUs=>npes use cam_logfile, only : iulog use string_utils, only : to_upper @@ -164,11 +164,11 @@ module chemistry CHARACTER(LEN=255) :: ThisLoc CHARACTER(LEN=255) :: ErrMsg -! ewl: comment out defining files used only for dry deposition +! ewl: comment out certain files used only for dry deposition ! ! Filenames to compute dry deposition velocities similarly to MOZART ! character(len=shr_kind_cl) :: clim_soilw_file = 'clim_soilw_file' ! character(len=shr_kind_cl) :: depvel_file = '' -! character(len=shr_kind_cl) :: depvel_lnd_file = 'depvel_lnd_file' + character(len=shr_kind_cl) :: depvel_lnd_file = 'depvel_lnd_file' ! character(len=shr_kind_cl) :: season_wes_file = 'season_wes_file' ! ! character(len=shr_kind_cl) :: srf_emis_specifier(pcnst) = '' @@ -696,12 +696,14 @@ subroutine chem_readnl(nlfile) ! Assume a successful return until otherwise RC = GC_SUCCESS -! ewl: remove 4 entries from chem_inparm used for dry deposition: -! clim_soilw_file, depvel_file, depvel_lnd_file, season_wes_file; -! remove ext_frc_ and srf_emis_ ones too. +! ewl: remove several entries from chem_inparm used for dry deposition: +! clim_soilw_file, depvel_file, season_wes_file; ! The following files are required to compute land maps, required to perform ! aerosol dry deposition - namelist /chem_inparm/ lght_no_prd_factor +!ewl: need to play around with need to include these (ext_* and srf_*) for drydep + namelist /chem_inparm/ lght_no_prd_factor, & + depvel_lnd_file +!, & ! ext_frc_specifier, & ! ext_frc_type, & ! ext_frc_cycle_yr, & @@ -885,7 +887,7 @@ subroutine chem_readnl(nlfile) ! ewl: remove broadcast of 4 files used for dry deposition only; srf_emis and ext_frc too. ! The following files are required to compute land maps, required to perform ! aerosol dry deposition -! CALL MPIBCAST (depvel_lnd_file, LEN(depvel_lnd_file), MPICHAR, 0, MPICOM) + CALL MPIBCAST (depvel_lnd_file, LEN(depvel_lnd_file), MPICHAR, 0, MPICOM) ! CALL MPIBCAST (clim_soilw_file, LEN(clim_soilw_file), MPICHAR, 0, MPICOM) ! CALL MPIBCAST (season_wes_file, LEN(season_wes_file), MPICHAR, 0, MPICOM) @@ -980,8 +982,6 @@ subroutine chem_init(phys_state, pbuf2d) use Phys_Grid, only : get_Area_All_p use hycoef, only : ps0, hyai, hybi, hyam -!ewl: comment out below following fvitt updates -! use seq_drydep_mod, only : drydep_method, DD_XLND, DD_XATM use gas_wetdep_opts, only : gas_wetdep_method use mo_neu_wetdep, only : neu_wetdep_init @@ -1513,17 +1513,8 @@ subroutine chem_init(phys_state, pbuf2d) ! Initialize aerosols CALL aero_model_init( pbuf2d ) -! ewl: Comment out initializing land maps for aerosol dry deposition. -! ! Initialize land maps for aerosol dry deposition -! IF ( drydep_method == DD_XATM .OR. drydep_method == DD_XLND ) THEN -! CALL drydep_inti( depvel_lnd_file, & -! clim_soilw_file, & -! season_wes_file ) -! ELSE -! IF ( masterProc ) Write(iulog,'(a,a)') ' drydep_method is set to: ', TRIM(drydep_method) -! CALL ENDRUN('drydep_method must be DD_XLND or DD_XATM to compute land '// & -! 'maps for aerosol dry deposition!') -! ENDIF + ! Initialize drydep + CALL drydep_inti( depvel_lnd_file) #endif IF ( gas_wetdep_method == 'NEU' ) THEN From e565c302bcb875b737d41ea33084f28755797b83 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Tue, 13 Sep 2022 14:13:42 -0600 Subject: [PATCH 043/291] Change geoschem .exclude file to use relative paths to files Previously file only contained filenames. This update should be used with CIME updates submitted in: ESMCI/cime#4180 ESMCI/cime#4302 Signed-off-by: Lizzie Lundgren --- src/chemistry/geoschem/.exclude | 40 ++++++++++++++++----------------- 1 file changed, 20 insertions(+), 20 deletions(-) diff --git a/src/chemistry/geoschem/.exclude b/src/chemistry/geoschem/.exclude index b8418763c5..3629106b6e 100644 --- a/src/chemistry/geoschem/.exclude +++ b/src/chemistry/geoschem/.exclude @@ -1,20 +1,20 @@ -regrid_a2a_mod.F90 -transport_mod.F90 -tpcore_window_mod.F90 -tpcore_fvdas_mod.F90 -flexgrid_read_mod.F90 -get_met_mod.F90 -planeflight_mod.F90 -diag1.F90 -diag03_mod.F90 -diag3.F90 -diag51_mod.F90 -diag51b_mod.F90 -diag53_mod.F90 -emissions_mod.F90 -gamap_mod.F90 -gosat_ch4_mod.F90 -tccon_ch4_mod.F90 -initialize.F90 -cleanup.F90 -main.F90 +geoschem_src/GeosCore/regrid_a2a_mod.F90 +geoschem_src/GeosCore/transport_mod.F90 +geoschem_src/GeosCore/tpcore_window_mod.F90 +geoschem_src/GeosCore/tpcore_fvdas_mod.F90 +geoschem_src/GeosCore/flexgrid_read_mod.F90 +geoschem_src/GeosCore/get_met_mod.F90 +geoschem_src/GeosCore/planeflight_mod.F90 +geoschem_src/GeosCore/diag1.F90 +geoschem_src/GeosCore/diag03_mod.F90 +geoschem_src/GeosCore/diag3.F90 +geoschem_src/GeosCore/diag51_mod.F90 +geoschem_src/GeosCore/diag51b_mod.F90 +geoschem_src/GeosCore/diag53_mod.F90 +geoschem_src/GeosCore/emissions_mod.F90 +geoschem_src/GeosCore/gamap_mod.F90 +geoschem_src/GeosCore/gosat_ch4_mod.F90 +geoschem_src/GeosCore/tccon_ch4_mod.F90 +geoschem_src/GeosCore/initialize.F90 +geoschem_src/GeosCore/cleanup.F90 +geoschem_src/Interfaces/GC-Classic/main.F90 From 03f75fdc3aeecaf12342e27972750c5c0003c0d4 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Tue, 13 Sep 2022 14:15:09 -0600 Subject: [PATCH 044/291] Clean up new debug print code in physpkg.F90 Local debug option can be enabled in the source code to print messages before and after chem_timestep_tend and aero_model_drydep are called. Prints are off by default. Signed-off-by: Lizzie Lundgren --- src/physics/cam/physpkg.F90 | 61 +++++++++++++++---------------------- 1 file changed, 24 insertions(+), 37 deletions(-) diff --git a/src/physics/cam/physpkg.F90 b/src/physics/cam/physpkg.F90 index 21a3fa6b94..0434870e8f 100644 --- a/src/physics/cam/physpkg.F90 +++ b/src/physics/cam/physpkg.F90 @@ -1410,6 +1410,7 @@ subroutine tphysac (ztodt, cam_in, & integer :: ixq logical :: labort ! abort flag + logical :: debug ! enable status prints real(r8) tvm(pcols,pver) ! virtual temperature real(r8) prect(pcols) ! total precipitation @@ -1445,6 +1446,8 @@ subroutine tphysac (ztodt, cam_in, & nstep = get_nstep() call cnst_get_ind('Q', ixq) + debug = .false. + ! Adjust the surface fluxes to reduce instabilities in near sfc layer if (phys_do_flux_avg()) then call flux_avg_run(state, cam_in, pbuf, nstep, ztodt) @@ -1563,19 +1566,15 @@ subroutine tphysac (ztodt, cam_in, & !=================================================== if (chem_is_active()) then - if (masterproc) print *, "ewl: cam/physpkg.F90: before chemistry" - if (trim(cam_take_snapshot_before) == "chem_timestep_tend") then call cam_snapshot_all_outfld_tphysac(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf,& fh2o, surfric, obklen, flx_heat) end if - if (masterproc) print *, "ewl: cam/physpkg.F90: before chem_timestep_tend" - + if (debug .and. masterproc) print *, "cam/physpkg.F90: calling chem_timestep_tend" call chem_timestep_tend(state, ptend, cam_in, cam_out, ztodt, & pbuf, fh2o=fh2o) - - if (masterproc) print *, "ewl: cam/physpkg.F90: chem_timestep_tend complete" + if (debug .and. masterproc) print *, "cam/physpkg.F90: chem_timestep_tend complete" if ( (trim(cam_take_snapshot_after) == "chem_timestep_tend") .and. & (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then @@ -1598,8 +1597,6 @@ subroutine tphysac (ztodt, cam_in, & ! Call vertical diffusion code (pbl, free atmosphere and molecular) !=================================================== - if (masterproc) print *, "ewl: cam/physpkg.F90: before vertical diffusion" - call t_startf('vertical_diffusion_tend') if (trim(cam_take_snapshot_before) == "vertical_diffusion_section") then @@ -1614,8 +1611,6 @@ subroutine tphysac (ztodt, cam_in, & ! Call major diffusion for extended model !------------------------------------------ - if (masterproc) print *, "ewl: cam/physpkg.F90: before major diffusion" - if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then call waccmx_phys_mspd_tend (ztodt ,state ,ptend) endif @@ -1643,8 +1638,6 @@ subroutine tphysac (ztodt, cam_in, & ! Rayleigh friction calculation !=================================================== - if (masterproc) print *, "ewl: cam/physpkg.F90: before rayleigh friction calculation" - call t_startf('rayleigh_friction') call rayleigh_friction_tend( ztodt, state, ptend) if ( ptend%lu ) then @@ -1668,25 +1661,26 @@ subroutine tphysac (ztodt, cam_in, & ! aerosol dry deposition processes call t_startf('aero_drydep') - if (masterproc) print *, "ewl: cam/physpkg.F90: before aerosol dry deposition processes...skipping!" + if (trim(cam_take_snapshot_before) == "aero_model_drydep") then + call cam_snapshot_all_outfld_tphysac(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf,& + fh2o, surfric, obklen, flx_heat) + end if -! ewl: turn off aerosol dry deposition -! if (trim(cam_take_snapshot_before) == "aero_model_drydep") then -! call cam_snapshot_all_outfld_tphysac(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf,& -! fh2o, surfric, obklen, flx_heat) -! end if -! -! 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 physics_update(state, ptend, ztodt, tend) -! -! if (trim(cam_take_snapshot_after) == "aero_model_drydep") then -! call cam_snapshot_all_outfld_tphysac(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf,& -! fh2o, surfric, obklen, flx_heat) -! end if + if (debug .and. masterproc) print *, "cam/physpkg.F90: calling aero_model_drydep" + + 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 physics_update(state, ptend, ztodt, tend) + + if (debug .and. masterproc) print *, "cam/physpkg.F90: aero_model_drydep complete" + + if (trim(cam_take_snapshot_after) == "aero_model_drydep") then + call cam_snapshot_all_outfld_tphysac(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf,& + fh2o, surfric, obklen, flx_heat) + end if call t_stopf('aero_drydep') @@ -1699,8 +1693,6 @@ subroutine tphysac (ztodt, cam_in, & ! can be added to for CARMA aerosols. if (carma_do_aerosol) then - if (masterproc) print *, "ewl: cam/physpkg.F90: before carma microphysics" - call t_startf('carma_timestep_tend') call carma_timestep_tend(state, cam_in, cam_out, ptend, ztodt, pbuf, obklen=obklen, ustar=surfric) call physics_update(state, ptend, ztodt, tend) @@ -1713,7 +1705,6 @@ subroutine tphysac (ztodt, cam_in, & !--------------------------------------------------------------------------------- ! ... enforce charge neutrality !--------------------------------------------------------------------------------- - if (masterproc) print *, "ewl: cam/physpkg.F90: before enforcing charge neutrality" call charge_balance(state, pbuf) @@ -1722,8 +1713,6 @@ subroutine tphysac (ztodt, cam_in, & !=================================================== call t_startf('gw_tend') - if (masterproc) print *, "ewl: cam/physpkg.F90: before gravity wave drag" - if (trim(cam_take_snapshot_before) == "gw_tend") then call cam_snapshot_all_outfld_tphysac(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf,& fh2o, surfric, obklen, flx_heat) @@ -1810,8 +1799,6 @@ subroutine tphysac (ztodt, cam_in, & ! Call ionosphere routines for extended model if mode is set to ionosphere !---------------------------------------------------------------------------- - if (masterproc) print *, "ewl: cam/physpkg.F90: before ionosphere routines" - if( waccmx_is('ionosphere') ) then call waccmx_phys_ion_elec_temp_tend(state, ptend, pbuf, ztodt) endif From e8b0747d5027b3549be5bcd2a5e59dfd8427dea5 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Tue, 13 Sep 2022 14:16:27 -0600 Subject: [PATCH 045/291] Expand error prints in constituents module for clarify Signed-off-by: Lizzie Lundgren --- src/physics/cam/constituents.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/physics/cam/constituents.F90 b/src/physics/cam/constituents.F90 index 528f254497..a9eb721dc1 100644 --- a/src/physics/cam/constituents.F90 +++ b/src/physics/cam/constituents.F90 @@ -174,7 +174,7 @@ subroutine cnst_add (name, mwc, cpc, qminc, & padv = padv+1 ind = padv if (padv > pcnst) then - write(errmsg, *) sub//': FATAL: advected tracer index greater than pcnst=', pcnst + write(errmsg, *) sub//': FATAL: advected tracer (', trim(name), ') index for greater than pcnst=', pcnst call endrun(errmsg) end if @@ -380,7 +380,7 @@ subroutine cnst_get_ind (name, ind, abort) if (present(abort)) abort_on_error = abort if (abort_on_error) then - write(iulog, *) sub//': FATAL: name:', name, ' not found in list:', cnst_name(:) + write(iulog, *) sub//': FATAL: name:', name, ' not found in constituent list: ', cnst_name(:) call endrun(sub//': FATAL: name not found') end if From a11b7e867fb9d208b1f2061a55a7444faab7b150 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Tue, 13 Sep 2022 14:24:36 -0600 Subject: [PATCH 046/291] Remove online land type option when using GEOS-Chem and use Olson/XLAI Dry deposition in GEOS-Chem now uses a combination of CLM dry deposition velocities and GEOS-Chem computed velocities which is determined by presence of ocean (100% CLM velocities if no ocean, 100% GEOS-Chem velocities if all ocean, and a scaled value of the two if in between). This update also uncomments several code that set State_Met fields, and the logicals for CLM drydep vel and online land type is removed (the former is effectively now always true and the latter is always false). Signed-off-by: Lizzie Lundgren --- src/chemistry/geoschem/chemistry.F90 | 318 ++++++++++++--------------- 1 file changed, 137 insertions(+), 181 deletions(-) diff --git a/src/chemistry/geoschem/chemistry.F90 b/src/chemistry/geoschem/chemistry.F90 index 7ced1d5107..a464440428 100644 --- a/src/chemistry/geoschem/chemistry.F90 +++ b/src/chemistry/geoschem/chemistry.F90 @@ -1181,16 +1181,6 @@ subroutine chem_init(phys_state, pbuf2d) ! -> False (read monthly-mean albedo from HEMCO) Input_Opt%onlineAlbedo = .False. -! ewl: Change using online land types from true to false - ! onlineLandTypes -> True (use CLM landtypes) - ! -> False (read landtypes from HEMCO) - Input_Opt%onlineLandTypes = .False. - -! ewl: Change using CLM dry dep velocities from false to true - ! ddVel_CLM -> True (use CLM dry deposition velocities) - ! -> False (let GEOS-Chem compute dry deposition velocities) - Input_Opt%ddVel_CLM = .True. - ! applyQtend: apply tendencies of water vapor to specific humidity Input_Opt%applyQtend = .False. @@ -2638,78 +2628,55 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) State_Met(LCHNK)%EFLUX (1,:nY) = cam_in%Lhf(:nY) State_Met(LCHNK)%HFLUX (1,:nY) = cam_in%Shf(:nY) -! ewl: Comment out setting State_Met fields LandTypeFrac and XLAI_NATIVE. Note -! that onlineLandTypes is now false. -! ! Field : LandTypeFrac -! ! Description: Olson fraction per type -! ! Unit : - (between 0 and 1) -! ! Dimensions : nX, nY, NSURFTYPE -! ! Note : Index 1 is water -! IF ( Input_Opt%onlineLandTypes ) THEN -! ! Fill in water -! State_Met(LCHNK)%LandTypeFrac(1,:nY,1) = cam_in%ocnFrac(:nY) & -! + cam_in%iceFrac(:nY) -! IF ( .NOT. Input_Opt%ddVel_CLM ) THEN -! CALL getLandTypes( cam_in, & -! nY, & -! State_Met(LCHNK) ) -! ENDIF -! ELSE -! DO N = 1, NSURFTYPE -! Write(FieldName, '(a,i2.2)') 'HCO_LANDTYPE', N-1 -! tmpIdx = pbuf_get_index(FieldName, rc) -! IF ( tmpIdx < 0 .or. ( iStep == 1 ) ) THEN -! IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(FieldName) -! ELSE -! CALL pbuf_get_field(pbuf, tmpIdx, pbuf_i) -! DO J = 1, nY -! State_Met(LCHNK)%LandTypeFrac(1,J,N) = pbuf_i(J) -! ENDDO -! pbuf_i => NULL() -! ENDIF -! -! Write(FieldName, '(a,i2.2)') 'HCO_XLAI', N-1 -! tmpIdx = pbuf_get_index(FieldName, rc) -! IF ( tmpIdx < 0 .or. ( iStep == 1 ) ) THEN -! IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(FieldName) -! ELSE -! CALL pbuf_get_field(pbuf, tmpIdx, pbuf_i) -! DO J = 1, nY -! State_Met(LCHNK)%XLAI_NATIVE(1,J,N) = pbuf_i(J) -! ENDDO -! pbuf_i => NULL() -! ENDIF -! ENDDO -! ENDIF - -! ewl: Comment out setting State_Met fields FR* for CLND, LAND, OCEAN, -! SEAICE, LAKE, and LANDIC. If not getting land type from CLM need to -! figure out how to set these. -! ! Field : FRCLND, FRLAND, FROCEAN, FRSEAICE, FRLAKE, FRLANDIC -! ! Description: Olson land fraction -! ! Fraction of land -! ! Fraction of ocean -! ! Fraction of sea ice -! ! Fraction of lake -! ! Fraction of land ice -! ! Fraction of snow -! ! Unit : - -! ! Dimensions : nX, nY -! State_Met(LCHNK)%FRCLND (1,:ny) = 1.e+0_fp - & -! State_Met(LCHNK)%LandTypeFrac(1,:nY,1) ! Olson Land Fraction -! State_Met(LCHNK)%FRLAND (1,:nY) = cam_in%landFrac(:nY) -! State_Met(LCHNK)%FROCEAN (1,:nY) = cam_in%ocnFrac(:nY) + cam_in%iceFrac(:nY) -! State_Met(LCHNK)%FRSEAICE (1,:nY) = cam_in%iceFrac(:nY) -! IF ( Input_Opt%onlineLandTypes ) THEN -! State_Met(LCHNK)%FRLAKE (1,:nY) = cam_in%lwtgcell(:,3) + & -! cam_in%lwtgcell(:,4) -! State_Met(LCHNK)%FRLANDIC (1,:nY) = cam_in%lwtgcell(:,2) -! State_Met(LCHNK)%FRSNO (1,:nY) = 0.0e+0_fp -! ELSE -! State_Met(LCHNK)%FRLAKE (1,:nY) = 0.0e+0_fp -! State_Met(LCHNK)%FRLANDIC (1,:nY) = 0.0e+0_fp -! State_Met(LCHNK)%FRSNO (1,:nY) = 0.0e+0_fp -! ENDIF + ! Field : LandTypeFrac + ! Description: Olson fraction per type + ! Unit : - (between 0 and 1) + ! Dimensions : nX, nY, NSURFTYPE + ! Note : Index 1 is water + DO N = 1, NSURFTYPE + Write(FieldName, '(a,i2.2)') 'HCO_LANDTYPE', N-1 + tmpIdx = pbuf_get_index(FieldName, rc) + IF ( tmpIdx < 0 .or. ( iStep == 1 ) ) THEN + IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(FieldName) + ELSE + CALL pbuf_get_field(pbuf, tmpIdx, pbuf_i) + DO J = 1, nY + State_Met(LCHNK)%LandTypeFrac(1,J,N) = pbuf_i(J) + ENDDO + pbuf_i => NULL() + ENDIF + + Write(FieldName, '(a,i2.2)') 'HCO_XLAI', N-1 + tmpIdx = pbuf_get_index(FieldName, rc) + IF ( tmpIdx < 0 .or. ( iStep == 1 ) ) THEN + IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(FieldName) + ELSE + CALL pbuf_get_field(pbuf, tmpIdx, pbuf_i) + DO J = 1, nY + State_Met(LCHNK)%XLAI_NATIVE(1,J,N) = pbuf_i(J) + ENDDO + pbuf_i => NULL() + ENDIF + ENDDO + + ! Field : FRCLND, FRLAND, FROCEAN, FRSEAICE, FRLAKE, FRLANDIC + ! Description: Olson land fraction + ! Fraction of land + ! Fraction of ocean + ! Fraction of sea ice + ! Fraction of lake + ! Fraction of land ice + ! Fraction of snow + ! Unit : - + ! Dimensions : nX, nY + State_Met(LCHNK)%FRCLND (1,:ny) = 1.e+0_fp - & + State_Met(LCHNK)%LandTypeFrac(1,:nY,1) ! Olson Land Fraction + State_Met(LCHNK)%FRLAND (1,:nY) = cam_in%landFrac(:nY) + State_Met(LCHNK)%FROCEAN (1,:nY) = cam_in%ocnFrac(:nY) + cam_in%iceFrac(:nY) + State_Met(LCHNK)%FRSEAICE (1,:nY) = cam_in%iceFrac(:nY) + State_Met(LCHNK)%FRLAKE (1,:nY) = 0.0e+0_fp + State_Met(LCHNK)%FRLANDIC (1,:nY) = 0.0e+0_fp + State_Met(LCHNK)%FRSNO (1,:nY) = 0.0e+0_fp ! Field : GWETROOT, GWETTOP ! Description: Root and top soil moisture @@ -3206,48 +3173,46 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) IF (Input_Opt%LSETH2O) Input_Opt%LSETH2O = .FALSE. ENDIF -! ewl: Turn off over-writing isLand, isWater, and isIce with CLM land imports, -! and set isSnow to if SNODP > 0.01 (removes dependency on CLM land) ! Do this after AirQnt, such that we overwrite GEOS-Chem isLand, isWater and ! isIce, which are based on albedo. Rather, we use CLM landFranc, ocnFrac ! and iceFrac. We also compute isSnow DO J = 1, nY -! iMaxLoc = MAXLOC( (/ State_Met(LCHNK)%FRLAND(1,J) + & -! State_Met(LCHNK)%FRLANDIC(1,J) + & -! State_Met(LCHNK)%FRLAKE(1,J), & -! State_Met(LCHNK)%FRSEAICE(1,J), & -! State_Met(LCHNK)%FROCEAN(1,J) - & -! State_Met(LCHNK)%FRSEAICE(1,J) /) ) -! IF ( iMaxLoc(1) == 3 ) iMaxLoc(1) = 0 -! ! reset ocean to 0 -! -! ! Field : LWI -! ! Description: Land/water indices -! ! Unit : - -! ! Dimensions : nX, nY -! State_Met(LCHNK)%LWI(1,J) = FLOAT( iMaxLoc(1) ) -! -! IF ( iMaxLoc(1) == 0 ) THEN -! State_Met(LCHNK)%isLand(1,J) = .False. -! State_Met(LCHNK)%isWater(1,J) = .True. -! State_Met(LCHNK)%isIce(1,J) = .False. -! ELSEIF ( iMaxLoc(1) == 1 ) THEN -! State_Met(LCHNK)%isLand(1,J) = .True. -! State_Met(LCHNK)%isWater(1,J) = .False. -! State_Met(LCHNK)%isIce(1,J) = .False. -! ELSEIF ( iMaxLoc(1) == 2 ) THEN -! State_Met(LCHNK)%isLand(1,J) = .False. -! State_Met(LCHNK)%isWater(1,J) = .False. -! State_Met(LCHNK)%isIce(1,J) = .True. -! ELSE -! Write(iulog,*) " iMaxLoc gets value: ", iMaxLoc -! ErrMsg = 'Failed to figure out land/water' -! CALL Error_Stop( ErrMsg, ThisLoc ) -! ENDIF -! -! State_Met(LCHNK)%isSnow(1,J) = ( State_Met(LCHNK)%FRSEAICE(1,J) > 0.0e+0_fp & -! .or. State_Met(LCHNK)%SNODP(1,J) > 0.01 ) - State_Met(LCHNK)%isSnow(1,J) = ( State_Met(LCHNK)%SNODP(1,J) > 0.01 ) + iMaxLoc = MAXLOC( (/ State_Met(LCHNK)%FRLAND(1,J) + & + State_Met(LCHNK)%FRLANDIC(1,J) + & + State_Met(LCHNK)%FRLAKE(1,J), & + State_Met(LCHNK)%FRSEAICE(1,J), & + State_Met(LCHNK)%FROCEAN(1,J) - & + State_Met(LCHNK)%FRSEAICE(1,J) /) ) + IF ( iMaxLoc(1) == 3 ) iMaxLoc(1) = 0 + ! reset ocean to 0 + + ! Field : LWI + ! Description: Land/water indices + ! Unit : - + ! Dimensions : nX, nY + State_Met(LCHNK)%LWI(1,J) = FLOAT( iMaxLoc(1) ) + + IF ( iMaxLoc(1) == 0 ) THEN + State_Met(LCHNK)%isLand(1,J) = .False. + State_Met(LCHNK)%isWater(1,J) = .True. + State_Met(LCHNK)%isIce(1,J) = .False. + ELSEIF ( iMaxLoc(1) == 1 ) THEN + State_Met(LCHNK)%isLand(1,J) = .True. + State_Met(LCHNK)%isWater(1,J) = .False. + State_Met(LCHNK)%isIce(1,J) = .False. + ELSEIF ( iMaxLoc(1) == 2 ) THEN + State_Met(LCHNK)%isLand(1,J) = .False. + State_Met(LCHNK)%isWater(1,J) = .False. + State_Met(LCHNK)%isIce(1,J) = .True. + ELSE + Write(iulog,*) " iMaxLoc gets value: ", iMaxLoc + ErrMsg = 'Failed to figure out land/water' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + State_Met(LCHNK)%isSnow(1,J) = & + ( State_Met(LCHNK)%FRSEAICE(1,J) > 0.0e+0_fp & + .or. State_Met(LCHNK)%SNODP(1,J) > 0.01 ) ENDDO @@ -3492,22 +3457,15 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) !================================================================== ! Compute dry deposition velocities ! - ! CLM computes dry deposition velocities over land. - ! We need to merge the land component passed through cam_in and - ! the ocn/ice dry deposition velocities. - ! - ! If using the CLM velocities, then use GEOS-Chem's dry deposition - ! module to compute velocities and then scale them with the ocean - ! fraction (Input_Opt%ddVel_CLM) - ! - ! A second option would be to let GEOS-Chem compute dry deposition - ! velocity, thus overwriting the input from CLM + ! CLM computes dry deposition velocities but only for gas-phase + ! species and only over land. We therefore need to both pass the + ! the CLM dry deposition velocities as well as compute them using + ! the GEOS-Chem dry deposition module. If using the CLM velocities, + ! then scale them with the ocean fraction; otherwise use GEOS-Chem + ! computed velocities. ! ! drydep_method must be set to DD_XLND. ! - ! The GEOS-Chem option (.not. Input_Opt%ddVel_CLM) option coupled - ! with Input_Opt%onlineLandTypes requires that CLM passes land - ! type information (land type and leaf area index). !================================================================== ! ! State_Chm expects dry deposition velocities in m/s, whereas @@ -3515,7 +3473,7 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) ! ! For now, dry deposition velocities are only computed for gases ! (which is what CLM deals with). Dry deposition for aerosols is - ! work in progress. + ! work in progress. <-- ewl...is this still true??? ! ! Thibaud M. Fritz - 27 Feb 2020 !================================================================== @@ -3561,53 +3519,51 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) CALL Error_Stop( ErrMsg, ThisLoc ) ENDIF - IF ( Input_Opt%ddVel_CLM ) THEN - DO N = 1, nddvels - - !! Print debug - !IF ( rootChunk ) THEN - ! IF ( N == 1 ) THEN - ! Write(iulog,*) "Number of GC dry deposition species = ", & - ! SIZE(State_Chm(LCHNK)%DryDepVel(:,:,:),3) - ! Write(iulog,*) "Number of CESM dry deposition species = ", & - ! nddvels - ! ENDIF - ! Write(iulog,*) "N = ", N - ! Write(iulog,*) "drySpc_ndx = ", drySpc_ndx(N) - ! Write(iulog,*) "GC index = ", map2GC_dryDep(N) - ! IF ( map2GC_dryDep(N) > 0 ) THEN - ! Write(iulog,*) "GC name = ", TRIM(DEPNAME(map2GC_dryDep(N))) - ! ENDIF - ! Write(iulog,*) "dry Species= ", TRIM(drydep_list(N)) - ! IF ( drySpc_ndx(N) > 0 ) THEN - ! Write(iulog,*) "tracerName = ", TRIM(tracerNames(drySpc_ndx(N))) - ! ENDIF - ! Write(iulog,*) "CLM-depVel = ", & - ! MAXVAL(cam_in%depvel(:nY,N)) * 1.0e-02_fp, " [m/s]" - ! IF ( map2GC_dryDep(N) > 0 ) THEN - ! Write(iulog,*) "GC-depVel = ", & - ! MAXVAL(State_Chm(LCHNK)%DryDepVel(1,:nY,map2GC_dryDep(N))), " [m/s]" - ! ENDIF - !ENDIF - - IF ( map2GC_dryDep(N) > 0 ) THEN - ! State_Chm%DryDepVel is in m/s - State_Chm(LCHNK)%DryDepVel(1,:nY,map2GC_dryDep(N)) = & - ! This first bit corresponds to the dry deposition - ! velocities over land as computed from CLM and - ! converted to m/s. This is scaled by the fraction - ! of land. - cam_in%depVel(:nY,N) * 1.0e-02_fp & - * MAX(0._fp, 1.0_fp - State_Met(LCHNK)%FROCEAN(1,:nY)) & - ! This second bit corresponds to the dry deposition - ! velocities over ocean and sea ice as computed from - ! GEOS-Chem. This is scaled by the fraction of ocean - ! and sea ice. - + State_Chm(LCHNK)%DryDepVel(1,:nY,map2GC_dryDep(N)) & - * State_Met(LCHNK)%FROCEAN(1,:nY) - ENDIF - ENDDO - ENDIF + DO N = 1, nddvels + + !! Print debug + !IF ( rootChunk ) THEN + ! IF ( N == 1 ) THEN + ! Write(iulog,*) "Number of GC dry deposition species = ", & + ! SIZE(State_Chm(LCHNK)%DryDepVel(:,:,:),3) + ! Write(iulog,*) "Number of CESM dry deposition species = ", & + ! nddvels + ! ENDIF + ! Write(iulog,*) "N = ", N + ! Write(iulog,*) "drySpc_ndx = ", drySpc_ndx(N) + ! Write(iulog,*) "GC index = ", map2GC_dryDep(N) + ! IF ( map2GC_dryDep(N) > 0 ) THEN + ! Write(iulog,*) "GC name = ", TRIM(DEPNAME(map2GC_dryDep(N))) + ! ENDIF + ! Write(iulog,*) "dry Species= ", TRIM(drydep_list(N)) + ! IF ( drySpc_ndx(N) > 0 ) THEN + ! Write(iulog,*) "tracerName = ", TRIM(tracerNames(drySpc_ndx(N))) + ! ENDIF + ! Write(iulog,*) "CLM-depVel = ", & + ! MAXVAL(cam_in%depvel(:nY,N)) * 1.0e-02_fp, " [m/s]" + ! IF ( map2GC_dryDep(N) > 0 ) THEN + ! Write(iulog,*) "GC-depVel = ", & + ! MAXVAL(State_Chm(LCHNK)%DryDepVel(1,:nY,map2GC_dryDep(N))), " [m/s]" + ! ENDIF + !ENDIF + + IF ( map2GC_dryDep(N) > 0 ) THEN + ! State_Chm%DryDepVel is in m/s + State_Chm(LCHNK)%DryDepVel(1,:nY,map2GC_dryDep(N)) = & + ! This first bit corresponds to the dry deposition + ! velocities over land as computed from CLM and + ! converted to m/s. This is scaled by the fraction + ! of land. + cam_in%depVel(:nY,N) * 1.0e-02_fp & + * MAX(0._fp, 1.0_fp - State_Met(LCHNK)%FROCEAN(1,:nY)) & + ! This second bit corresponds to the dry deposition + ! velocities over ocean and sea ice as computed from + ! GEOS-Chem. This is scaled by the fraction of ocean + ! and sea ice. + + State_Chm(LCHNK)%DryDepVel(1,:nY,map2GC_dryDep(N)) & + * State_Met(LCHNK)%FROCEAN(1,:nY) + ENDIF + ENDDO CALL Update_DryDepFreq( Input_Opt = Input_Opt, & State_Chm = State_Chm(LCHNK), & From 3a27896fcc5da4ce0e9d361d98ce20ecc637a95c Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Fri, 16 Sep 2022 13:40:42 -0600 Subject: [PATCH 047/291] Update GEOS-Chem chemistry log messages for clarity Signed-off-by: Lizzie Lundgren --- src/chemistry/geoschem/chemistry.F90 | 42 ++++++++++++++++++++++++---- 1 file changed, 36 insertions(+), 6 deletions(-) diff --git a/src/chemistry/geoschem/chemistry.F90 b/src/chemistry/geoschem/chemistry.F90 index a464440428..efc8bd6c20 100644 --- a/src/chemistry/geoschem/chemistry.F90 +++ b/src/chemistry/geoschem/chemistry.F90 @@ -34,6 +34,9 @@ module chemistry use chem_mods, only : nSlvd, slvd_Lst, slvd_ref_MMR + !-------------------------------------------------------------------- + ! CAM modules + !-------------------------------------------------------------------- ! Exit routine in CAM use cam_abortutils, only : endrun @@ -263,6 +266,8 @@ subroutine chem_register ! Initialize pointer ThisSpc => NULL() + if (debug .and. masterproc) write(iulog,'(a)') 'chem_register: registering advected constituents for GEOS-Chem chemistry' + ! SDE 2018-05-02: This seems to get called before anything else ! that includes CHEM_INIT ! At this point, mozart calls SET_SIM_DAT, which is specified by each @@ -501,16 +506,21 @@ subroutine chem_register ! More information: ! http://www.cesm.ucar.edu/models/atm-cam/docs/phys-interface/node5.html + if (debug .and. masterproc) write(iulog,'(a,i4,a)') 'chem_register: looping over gas_pcnst (length', gas_pcnst, ') to map solsym onto GEOS-Chem species' + DO N = 1, gas_pcnst ! Map solsym onto GEOS-Chem species map2chm(N) = Ind_(TRIM(solsym(N))) IF ( map2chm(N) < 0 ) THEN - ! This is not a GEOS-Chem species and we thus map on constituents + ! This is not a GEOS-Chem species and we thus map to constituents list. ! Most likely, these will be MAM aerosols ! We store the index as the opposite to not confuse with GEOS-Chem ! indices. CALL cnst_get_ind(TRIM(solsym(N)), I, abort=.True.) map2chm(N) = -I + if (debug .and. masterproc) write(iulog,'(a,a,a,I4,a,I4)') ' -> solsym species ', trim(solsym(N)), ' (index ', N, ') is not a GEOS-Chem species. Mapping to negative constituent index: ', map2chm(N) + ELSE + if (debug .and. masterproc) write(iulog,'(a,a,a,I4,a,I4)') ' -> solsym species ', trim(solsym(N)), ' (index ', N, ') mapped to GEOS-Chem species ', map2chm(N) ENDIF ENDDO ! Get constituent index of specific humidity @@ -524,13 +534,17 @@ subroutine chem_register nIgnored = 0 + if (debug .and. masterproc) write(iulog,'(a,i4,a)') 'chem_register: looping over gas dry deposition list with ', nddvels, ' species' + DO N = 1, nddvels ! The species names need to be convert to upper case as, ! for instance, BR2 != Br2 drySpc_ndx(N) = get_spc_ndx( to_upper(drydep_list(N)) ) - IF ( MasterProc .AND. ( drySpc_ndx(N) < 0 ) ) THEN + if (debug .and. masterproc) write(iulog,'(a,a,a,i4,a,i4)') ' -> species ', trim(drydep_list(N)), ' in dry deposition list at index ', N, ' maps to species in solsym at index ', drySpc_ndx(N) + + IF ( MasterProc .and. ( drySpc_ndx(N) < 0 ) ) THEN Write(iulog,'(a,a)') ' ## Ignoring dry deposition of ', & TRIM(drydep_list(N)) nIgnored = nIgnored + 1 @@ -626,7 +640,7 @@ subroutine chem_register !============================================================== IF ( MasterProc ) THEN - Write(iulog,'(/, a)') '### Summary of GEOS-Chem species: ' + Write(iulog,'(/, a)') '### Summary of GEOS-Chem species (end of chem_register): ' Write(iulog,'( a)') REPEAT( '-', 50 ) Write(iulog,'( a)') '+ List of advected species: ' Write(iulog,100) 'ID', 'Tracer', ''!'Dry deposition (T/F)' @@ -661,6 +675,7 @@ subroutine chem_register call pbuf_add_field('HCO_IN_JNO2', 'global', dtype_r8, (/pcols/), tmpIdx) call pbuf_add_field('HCO_IN_JOH', 'global', dtype_r8, (/pcols/), tmpIdx) + if (debug .and. masterproc) write(iulog,'(a)') 'chem_register: advected constituent registration for GEOS-Chem chemistry complete ' end subroutine chem_register @@ -719,6 +734,8 @@ subroutine chem_readnl(nlfile) namelist /chem_inparm/ bndtvg, h2orates, ghg_chem + if (debug .and. masterproc) write(iulog,'(a)') 'chem_readnl: reading namelists for GEOS-Chem chemistry' + ALLOCATE(drySpc_ndx(nddvels), STAT=IERR) IF ( IERR .NE. 0 ) CALL ENDRUN('Failed to allocate drySpc_ndx') @@ -800,6 +817,8 @@ subroutine chem_readnl(nlfile) IF ( INDEX( LINE, 'transported_species' ) > 0 ) EXIT ENDDO + if (debug .and. masterproc) write(iulog,'(a)') 'chem_readnl: reading advected species list from geoschem_config.yml' + ! Read in all advected species names and add them to tracer names list nTracers = 0 DO WHILE ( LEN_TRIM( line ) > 0 ) @@ -823,6 +842,7 @@ subroutine chem_readnl(nlfile) nTracers = nTracers + 1 tracerNames(nTracers) = TRIM(substrs(1)) + write(iulog,'(a,i4,a,a)') ' ', nTracers, ' ', TRIM(substrs(1)) ENDIF ENDDO CLOSE(unitn) @@ -842,6 +862,9 @@ subroutine chem_readnl(nlfile) CALL ENDRUN('chem_readnl: too many species - increase nSlsmax') ENDIF + if (debug .and. masterproc) write(iulog,'(a)') 'chem_readnl: getting non-advected (short-lived) species list from KPP' + if (debug .and. masterproc) write(iulog,'(a)') 'NOTE: does not include CO2 even if CO2 is not advected' + nSls = 0 DO I = 1, nSpec ! Get the name of the species from KPP @@ -853,6 +876,7 @@ subroutine chem_readnl(nlfile) ! Genuine new short-lived species nSls = nSls + 1 slsNames(nSls) = TRIM(line) + write(iulog,'(a,i4,a,a)') ' ', nSls, ' ', TRIM(slsNames(nSls)) ENDIF ENDDO @@ -919,6 +943,8 @@ subroutine chem_readnl(nlfile) slvd_Lst(I) = TRIM(slsNames(I)) ENDDO + if (debug .and. masterproc) write(iulog,'(a)') 'chem_readnl: reading GEOS-Chem chemistry namelists complete' + end subroutine chem_readnl !================================================================================================ @@ -1083,6 +1109,8 @@ subroutine chem_init(phys_state, pbuf2d) ! Initialize pointers SpcInfo => NULL() + if (debug .and. masterproc) write(iulog,'(a)') 'chem_init: initializing GEOS-Chem chemistry' + ! LCHNK: which chunks we have on this process LCHNK = phys_state%LCHNK ! NCOL: number of atmospheric columns for each chunk @@ -1689,6 +1717,8 @@ subroutine chem_init(phys_state, pbuf2d) ! Cleanup Call Cleanup_State_Grid( maxGrid, RC ) + if (debug .and. masterproc) write(iulog,'(a)') 'chem_init: GEOS-Chem chemistry initialization complete' + end subroutine chem_init !=============================================================================== @@ -4313,7 +4343,7 @@ subroutine chem_init_restart(File) TYPE(file_desc_t) :: File - IF (MasterProc) WRITE(iulog,'(a)') 'GCCALL CHEM_INIT_RESTART' + WRITE(iulog,'(a)') 'chem_init_restart: init restarts for tracer sources and offline fields' ! ! data for offline tracers @@ -4336,7 +4366,7 @@ subroutine chem_write_restart( File ) TYPE(file_desc_t) :: File - IF ( MasterProc ) WRITE(iulog,'(a)') 'GCCALL CHEM_WRITE_RESTART' + WRITE(iulog,'(a)') 'chem_write_restart: writing restarts for tracer sources and offline fields' ! ! data for offline tracers ! @@ -4357,7 +4387,7 @@ subroutine chem_read_restart( File ) TYPE(file_desc_t) :: File - IF ( MasterProc ) WRITE(iulog,'(a)') 'GCCALL CHEM_READ_RESTART' + WRITE(iulog,'(a)') 'GCCALL CHEM_READ_RESTART' ! ! data for offline tracers ! From d9d9f67b5b1ba49404bfeb73926dbb32e4503a9b Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Fri, 16 Sep 2022 13:50:26 -0600 Subject: [PATCH 048/291] Remove unused code from GEOS-Chem chemistry.F90 file Signed-off-by: Lizzie Lundgren --- src/chemistry/geoschem/chemistry.F90 | 57 +--------------------------- 1 file changed, 2 insertions(+), 55 deletions(-) diff --git a/src/chemistry/geoschem/chemistry.F90 b/src/chemistry/geoschem/chemistry.F90 index efc8bd6c20..9a552861ee 100644 --- a/src/chemistry/geoschem/chemistry.F90 +++ b/src/chemistry/geoschem/chemistry.F90 @@ -167,26 +167,8 @@ module chemistry CHARACTER(LEN=255) :: ThisLoc CHARACTER(LEN=255) :: ErrMsg -! ewl: comment out certain files used only for dry deposition -! ! Filenames to compute dry deposition velocities similarly to MOZART -! character(len=shr_kind_cl) :: clim_soilw_file = 'clim_soilw_file' -! character(len=shr_kind_cl) :: depvel_file = '' + ! For dry deposition character(len=shr_kind_cl) :: depvel_lnd_file = 'depvel_lnd_file' -! character(len=shr_kind_cl) :: season_wes_file = 'season_wes_file' -! -! character(len=shr_kind_cl) :: srf_emis_specifier(pcnst) = '' -! character(len=shr_kind_cl) :: ext_frc_specifier(pcnst) = '' -! -! character(len=24) :: srf_emis_type = 'CYCLICAL' ! 'CYCLICAL' | 'SERIAL' | 'INTERP_MISSING_MONTHS' -! integer :: srf_emis_cycle_yr = 0 -! integer :: srf_emis_fixed_ymd = 0 -! integer :: srf_emis_fixed_tod = 0 -! -! character(len=24) :: ext_frc_type = 'CYCLICAL' ! 'CYCLICAL' | 'SERIAL' | 'INTERP_MISSING_MONTHS' -! integer :: ext_frc_cycle_yr = 0 -! integer :: ext_frc_fixed_ymd = 0 -! integer :: ext_frc_fixed_tod = 0 - !================================================================================================ contains @@ -711,24 +693,8 @@ subroutine chem_readnl(nlfile) ! Assume a successful return until otherwise RC = GC_SUCCESS -! ewl: remove several entries from chem_inparm used for dry deposition: -! clim_soilw_file, depvel_file, season_wes_file; - ! The following files are required to compute land maps, required to perform - ! aerosol dry deposition -!ewl: need to play around with need to include these (ext_* and srf_*) for drydep namelist /chem_inparm/ lght_no_prd_factor, & depvel_lnd_file -!, & -! ext_frc_specifier, & -! ext_frc_type, & -! ext_frc_cycle_yr, & -! ext_frc_fixed_ymd, & -! ext_frc_fixed_tod, & -! srf_emis_specifier, & -! srf_emis_cycle_yr, & -! srf_emis_fixed_ymd, & -! srf_emis_fixed_tod, & -! srf_emis_type ! ghg chem @@ -907,27 +873,8 @@ subroutine chem_readnl(nlfile) CALL MPIBCAST ( slsNames, LEN(slsNames(1))*nSlsMax, MPICHAR, 0, MPICOM ) ! Broadcast namelist variables - -! ewl: remove broadcast of 4 files used for dry deposition only; srf_emis and ext_frc too. - ! The following files are required to compute land maps, required to perform - ! aerosol dry deposition CALL MPIBCAST (depvel_lnd_file, LEN(depvel_lnd_file), MPICHAR, 0, MPICOM) -! CALL MPIBCAST (clim_soilw_file, LEN(clim_soilw_file), MPICHAR, 0, MPICOM) -! CALL MPIBCAST (season_wes_file, LEN(season_wes_file), MPICHAR, 0, MPICOM) - CALL MPIBCAST (lght_no_prd_factor, 1, MPIR8, 0, MPICOM) -! CALL MPIBCAST (depvel_file, LEN(depvel_file), MPICHAR, 0, MPICOM) -! CALL MPIBCAST (srf_emis_specifier, LEN(srf_emis_specifier(1))*pcnst, MPICHAR, 0, MPICOM) -! CALL MPIBCAST (srf_emis_type, LEN(srf_emis_type), MPICHAR, 0, MPICOM) -! CALL MPIBCAST (srf_emis_cycle_yr, 1, MPIINT, 0, MPICOM) -! CALL MPIBCAST (srf_emis_fixed_ymd, 1, MPIINT, 0, MPICOM) -! CALL MPIBCAST (srf_emis_fixed_tod, 1, MPIINT, 0, MPICOM) -! CALL MPIBCAST (ext_frc_specifier, LEN(ext_frc_specifier(1))*pcnst, MPICHAR, 0, MPICOM) -! CALL MPIBCAST (ext_frc_type, LEN(ext_frc_type), MPICHAR, 0, MPICOM) -! CALL MPIBCAST (ext_frc_cycle_yr, 1, MPIINT, 0, MPICOM) -! CALL MPIBCAST (ext_frc_fixed_ymd, 1, MPIINT, 0, MPICOM) -! CALL MPIBCAST (ext_frc_fixed_tod, 1, MPIINT, 0, MPICOM) - CALL MPIBCAST (ghg_chem, 1, MPILOG, 0, MPICOM) CALL MPIBCAST (bndtvg, LEN(bndtvg), MPICHAR, 0, MPICOM) CALL MPIBCAST (h2orates, LEN(h2orates), MPICHAR, 0, MPICOM) @@ -3503,7 +3450,7 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) ! ! For now, dry deposition velocities are only computed for gases ! (which is what CLM deals with). Dry deposition for aerosols is - ! work in progress. <-- ewl...is this still true??? + ! work in progress. ! ! Thibaud M. Fritz - 27 Feb 2020 !================================================================== From 5ddd22e02bade976bf5ba61332a48765a4561f5f Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Wed, 21 Sep 2022 11:31:59 -0600 Subject: [PATCH 049/291] Externals update to use latest GEOS-Chem, HEMCO_CESM, and HEMCO These will need to change again before merge because GEOS-Chem 14.0.0 and HEMCO 3.5.0 are not yet released, and I am now using my fork of HEMCO_CESM with modifications needed to link to and build latest HEMCO as is. Signed-off-by: Lizzie Lundgren --- Externals_CAM.cfg | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/Externals_CAM.cfg b/Externals_CAM.cfg index 03a22f2349..29f5521914 100644 --- a/Externals_CAM.cfg +++ b/Externals_CAM.cfg @@ -70,17 +70,17 @@ hash = ff76a231 required = True [geoschem] -local_path = src/chemistry/geoschem/geoschem_src +tag = 14.0.0-alpha.9 protocol = git -branch = feature/cesm_2.3 -repo_url = https://github.com/CESM-GC/geos-chem +repo_url = https://github.com/geoschem/geos-chem.git +local_path = src/chemistry/geoschem/geoschem_src required = True [hemco] -local_path = src/hemco +branch = feature/hemco_3.5.0 protocol = git -branch = master -repo_url = https://github.com/ESCOMP/HEMCO_CESM.git +repo_url = https://github.com/lizziel/HEMCO_CESM.git +local_path = src/hemco required = True externals = Externals_HCO.cfg From fd67bd8ed57b679873d58574586375afd1f373f2 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Wed, 21 Sep 2022 12:35:34 -0600 Subject: [PATCH 050/291] Temporarily put wetdep and drydep lists in namelist file per GEOS-Chem case This is until there is a better way to handle the wetdep and drydep lists for GEOS-Chem cases Signed-off-by: Lizzie Lundgren --- bld/namelist_files/namelist_defaults_cam.xml | 26 ------------------- .../use_cases/2000_geoschem.xml | 20 ++++++++++++++ .../use_cases/2010_geoschem.xml | 20 ++++++++++++++ .../use_cases/hist_geoschem.xml | 20 ++++++++++++++ bld/namelist_files/use_cases/sd_geoschem.xml | 19 ++++++++++++++ 5 files changed, 79 insertions(+), 26 deletions(-) diff --git a/bld/namelist_files/namelist_defaults_cam.xml b/bld/namelist_files/namelist_defaults_cam.xml index 98fbcb1153..c2d4ec6345 100644 --- a/bld/namelist_files/namelist_defaults_cam.xml +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -3227,30 +3227,4 @@ atm/cam/ocnfrac/domain.aqua.fv1.9x2.5.nc - - - - - - - -'ACET','ACTA','ALD2','AROMP4','AROMP5','ATOOH','BALD','BENZP','BR2','BRCL','BRNO3','BZCO3H','BZPAN','CH2O','CL2','CLNO2','CLNO3','CLO','CLOO','CSL','EOH','ETHLN','ETHN','ETHP','ETNO3','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HI','HMHP','HMML','HNO3','HOBR','HOCL','HOI','HONIT','HPALD1','HPALD2','HPALD3','HPALD4','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDC','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','IPRNO3','ITCN','ITHN','LIMO','LVOC','MACR','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MCT','MENO3','MGLY','MOH','MONITS','MONITU','MPAN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','N2O5','NH3','NO2','NPHEN','NPRNO3','O3','PAN','PHEN','PP','PPN','PROPNN','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2' - - - - - -'dst_a1','so4_a1','nh4_a1','pom_a1','pomff1_a1','pombb1_a1','soa_a1','bc_a1','ncl_a1','num_a1','so4_a2','nh4_a2','soa_a2','ncl_a2','dst_a2','num_a2','dst_a3','ncl_a3','so4_a3','pom_a3','bc_a3','num_a3','ncl_a4','so4_a4','pom_a4','pomff1_a4','pombb1_a4','bc_a4','nh4_a4','num_a4','dst_a5','so4_a5','nh4_a5','num_a5','ncl_a6','so4_a6','nh4_a6','num_a6','dst_a7','so4_a7','nh4_a7','num_a7','soa1_a1','soa1_a2','soa2_a1','soa2_a2','soa3_a1','soa3_a2','soa4_a1','soa4_a2','soa5_a1','soa5_a2','soaff1_a1','soaff2_a1','soaff3_a1','soaff4_a1','soaff5_a1','soabb1_a1','soabb2_a1','soabb3_a1','soabb4_a1','soabb5_a1','soabg1_a1','soabg2_a1','soabg3_a1','soabg4_a1','soabg5_a1','soaff1_a2','soaff2_a2','soaff3_a2','soaff4_a2','soaff5_a2','soabb1_a2','soabb2_a2','soabb3_a2','soabb4_a2','soabb5_a2','soabg1_a2','soabg2_a2','soabg3_a2','soabg4_a2','soabg5_a2' - - - - -'dst_a1','so4_a1','nh4_a1','pom_a1','pomff1_a1','pombb1_a1','soa_a1','bc_a1','ncl_a1','num_a1','so4_a2','nh4_a2','soa_a2','ncl_a2','dst_a2','num_a2','dst_a3','ncl_a3','so4_a3','pom_a3','bc_a3','num_a3','ncl_a4','so4_a4','pom_a4','pomff1_a4','pombb1_a4','bc_a4','nh4_a4','num_a4','dst_a5','so4_a5','nh4_a5','num_a5','ncl_a6','so4_a6','nh4_a6','num_a6','dst_a7','so4_a7','nh4_a7','num_a7','soa1_a1','soa1_a2','soa2_a1','soa2_a2','soa3_a1','soa3_a2','soa4_a1','soa4_a2','soa5_a1','soa5_a2','soaff1_a1','soaff2_a1','soaff3_a1','soaff4_a1','soaff5_a1','soabb1_a1','soabb2_a1','soabb3_a1','soabb4_a1','soabb5_a1','soabg1_a1','soabg2_a1','soabg3_a1','soabg4_a1','soabg5_a1','soaff1_a2','soaff2_a2','soaff3_a2','soaff4_a2','soaff5_a2','soabb1_a2','soabb2_a2','soabb3_a2','soabb4_a2','soabb5_a2','soabg1_a2','soabg2_a2','soabg3_a2','soabg4_a2','soabg5_a2' - - diff --git a/bld/namelist_files/use_cases/2000_geoschem.xml b/bld/namelist_files/use_cases/2000_geoschem.xml index b2c980ddd3..cd26058362 100644 --- a/bld/namelist_files/use_cases/2000_geoschem.xml +++ b/bld/namelist_files/use_cases/2000_geoschem.xml @@ -38,6 +38,26 @@ + + + +'ACET','ACTA','ALD2','AROMP4','AROMP5','ATOOH','BALD','BENZP','BR2','BRCL','BRNO3','BZCO3H','BZPAN','CH2O','CL2','CLNO2','CLNO3','CLO','CLOO','CSL','EOH','ETHLN','ETHN','ETHP','ETNO3','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HI','HMHP','HMML','HNO3','HOBR','HOCL','HOI','HONIT','HPALD1','HPALD2','HPALD3','HPALD4','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDC','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','IPRNO3','ITCN','ITHN','LIMO','LVOC','MACR','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MCT','MENO3','MGLY','MOH','MONITS','MONITU','MPAN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','N2O5','NH3','NO2','NPHEN','NPRNO3','O3','PAN','PHEN','PP','PPN','PROPNN','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2' + + + + +'ACTA','ALD2','AROMP4','AROMP5','ATOOH','BALD','BENZP','BR2','BRCL','BZCO3H','BZPAN','CH2O','CSL','EOH','ETHLN','ETHN','ETHP','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HI','HMHP','HMML','HNO3','HOBR','HOCL','HOI','HONIT','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','ITCN','ITHN','LIMO','LVOC','LVOCOA','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MCT','MEK','MGLY','MOH','MONITS','MONITU','MP','MPAN','MPN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','NH3','NPHEN','PAN','PHEN','PP','PPN','PROPNN','PRPE','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2' + + + +'dst_a1','so4_a1','nh4_a1','pom_a1','pomff1_a1','pombb1_a1','soa_a1','bc_a1','ncl_a1','num_a1','so4_a2','nh4_a2','soa_a2','ncl_a2','dst_a2','num_a2','dst_a3','ncl_a3','so4_a3','pom_a3','bc_a3','num_a3','ncl_a4','so4_a4','pom_a4','pomff1_a4','pombb1_a4','bc_a4','nh4_a4','num_a4','dst_a5','so4_a5','nh4_a5','num_a5','ncl_a6','so4_a6','nh4_a6','num_a6','dst_a7','so4_a7','nh4_a7','num_a7','soa1_a1','soa1_a2','soa2_a1','soa2_a2','soa3_a1','soa3_a2','soa4_a1','soa4_a2','soa5_a1','soa5_a2','soaff1_a1','soaff2_a1','soaff3_a1','soaff4_a1','soaff5_a1','soabb1_a1','soabb2_a1','soabb3_a1','soabb4_a1','soabb5_a1','soabg1_a1','soabg2_a1','soabg3_a1','soabg4_a1','soabg5_a1','soaff1_a2','soaff2_a2','soaff3_a2','soaff4_a2','soaff5_a2','soabb1_a2','soabb2_a2','soabb3_a2','soabb4_a2','soabb5_a2','soabg1_a2','soabg2_a2','soabg3_a2','soabg4_a2','soabg5_a2' + + + +'dst_a1','so4_a1','nh4_a1','pom_a1','pomff1_a1','pombb1_a1','soa_a1','bc_a1','ncl_a1','num_a1','so4_a2','nh4_a2','soa_a2','ncl_a2','dst_a2','num_a2','dst_a3','ncl_a3','so4_a3','pom_a3','bc_a3','num_a3','ncl_a4','so4_a4','pom_a4','pomff1_a4','pombb1_a4','bc_a4','nh4_a4','num_a4','dst_a5','so4_a5','nh4_a5','num_a5','ncl_a6','so4_a6','nh4_a6','num_a6','dst_a7','so4_a7','nh4_a7','num_a7','soa1_a1','soa1_a2','soa2_a1','soa2_a2','soa3_a1','soa3_a2','soa4_a1','soa4_a2','soa5_a1','soa5_a2','soaff1_a1','soaff2_a1','soaff3_a1','soaff4_a1','soaff5_a1','soabb1_a1','soabb2_a1','soabb3_a1','soabb4_a1','soabb5_a1','soabg1_a1','soabg2_a1','soabg3_a1','soabg4_a1','soabg5_a1','soaff1_a2','soaff2_a2','soaff3_a2','soaff4_a2','soaff5_a2','soabb1_a2','soabb2_a2','soabb3_a2','soabb4_a2','soabb5_a2','soabg1_a2','soabg2_a2','soabg3_a2','soabg4_a2','soabg5_a2' + + + 1,30,365,240,240,480,365,73,30 diff --git a/bld/namelist_files/use_cases/2010_geoschem.xml b/bld/namelist_files/use_cases/2010_geoschem.xml index 4ac969a9aa..9af5dad132 100644 --- a/bld/namelist_files/use_cases/2010_geoschem.xml +++ b/bld/namelist_files/use_cases/2010_geoschem.xml @@ -34,6 +34,26 @@ + + + +'ACET','ACTA','ALD2','AROMP4','AROMP5','ATOOH','BALD','BENZP','BR2','BRCL','BRNO3','BZCO3H','BZPAN','CH2O','CL2','CLNO2','CLNO3','CLO','CLOO','CSL','EOH','ETHLN','ETHN','ETHP','ETNO3','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HI','HMHP','HMML','HNO3','HOBR','HOCL','HOI','HONIT','HPALD1','HPALD2','HPALD3','HPALD4','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDC','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','IPRNO3','ITCN','ITHN','LIMO','LVOC','MACR','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MCT','MENO3','MGLY','MOH','MONITS','MONITU','MPAN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','N2O5','NH3','NO2','NPHEN','NPRNO3','O3','PAN','PHEN','PP','PPN','PROPNN','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2' + + + + +'ACTA','ALD2','AROMP4','AROMP5','ATOOH','BALD','BENZP','BR2','BRCL','BZCO3H','BZPAN','CH2O','CSL','EOH','ETHLN','ETHN','ETHP','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HI','HMHP','HMML','HNO3','HOBR','HOCL','HOI','HONIT','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','ITCN','ITHN','LIMO','LVOC','LVOCOA','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MCT','MEK','MGLY','MOH','MONITS','MONITU','MP','MPAN','MPN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','NH3','NPHEN','PAN','PHEN','PP','PPN','PROPNN','PRPE','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2' + + + +'dst_a1','so4_a1','nh4_a1','pom_a1','pomff1_a1','pombb1_a1','soa_a1','bc_a1','ncl_a1','num_a1','so4_a2','nh4_a2','soa_a2','ncl_a2','dst_a2','num_a2','dst_a3','ncl_a3','so4_a3','pom_a3','bc_a3','num_a3','ncl_a4','so4_a4','pom_a4','pomff1_a4','pombb1_a4','bc_a4','nh4_a4','num_a4','dst_a5','so4_a5','nh4_a5','num_a5','ncl_a6','so4_a6','nh4_a6','num_a6','dst_a7','so4_a7','nh4_a7','num_a7','soa1_a1','soa1_a2','soa2_a1','soa2_a2','soa3_a1','soa3_a2','soa4_a1','soa4_a2','soa5_a1','soa5_a2','soaff1_a1','soaff2_a1','soaff3_a1','soaff4_a1','soaff5_a1','soabb1_a1','soabb2_a1','soabb3_a1','soabb4_a1','soabb5_a1','soabg1_a1','soabg2_a1','soabg3_a1','soabg4_a1','soabg5_a1','soaff1_a2','soaff2_a2','soaff3_a2','soaff4_a2','soaff5_a2','soabb1_a2','soabb2_a2','soabb3_a2','soabb4_a2','soabb5_a2','soabg1_a2','soabg2_a2','soabg3_a2','soabg4_a2','soabg5_a2' + + + +'dst_a1','so4_a1','nh4_a1','pom_a1','pomff1_a1','pombb1_a1','soa_a1','bc_a1','ncl_a1','num_a1','so4_a2','nh4_a2','soa_a2','ncl_a2','dst_a2','num_a2','dst_a3','ncl_a3','so4_a3','pom_a3','bc_a3','num_a3','ncl_a4','so4_a4','pom_a4','pomff1_a4','pombb1_a4','bc_a4','nh4_a4','num_a4','dst_a5','so4_a5','nh4_a5','num_a5','ncl_a6','so4_a6','nh4_a6','num_a6','dst_a7','so4_a7','nh4_a7','num_a7','soa1_a1','soa1_a2','soa2_a1','soa2_a2','soa3_a1','soa3_a2','soa4_a1','soa4_a2','soa5_a1','soa5_a2','soaff1_a1','soaff2_a1','soaff3_a1','soaff4_a1','soaff5_a1','soabb1_a1','soabb2_a1','soabb3_a1','soabb4_a1','soabb5_a1','soabg1_a1','soabg2_a1','soabg3_a1','soabg4_a1','soabg5_a1','soaff1_a2','soaff2_a2','soaff3_a2','soaff4_a2','soaff5_a2','soabb1_a2','soabb2_a2','soabb3_a2','soabb4_a2','soabb5_a2','soabg1_a2','soabg2_a2','soabg3_a2','soabg4_a2','soabg5_a2' + + + 1,30,365,240,240,480,365,73,30 diff --git a/bld/namelist_files/use_cases/hist_geoschem.xml b/bld/namelist_files/use_cases/hist_geoschem.xml index 60068f00d4..2214ef4e15 100644 --- a/bld/namelist_files/use_cases/hist_geoschem.xml +++ b/bld/namelist_files/use_cases/hist_geoschem.xml @@ -32,6 +32,26 @@ 'noy', 'nhx' + + + +'ACET','ACTA','ALD2','AROMP4','AROMP5','ATOOH','BALD','BENZP','BR2','BRCL','BRNO3','BZCO3H','BZPAN','CH2O','CL2','CLNO2','CLNO3','CLO','CLOO','CSL','EOH','ETHLN','ETHN','ETHP','ETNO3','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HI','HMHP','HMML','HNO3','HOBR','HOCL','HOI','HONIT','HPALD1','HPALD2','HPALD3','HPALD4','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDC','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','IPRNO3','ITCN','ITHN','LIMO','LVOC','LVOCOA','MACR','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MCT','MENO3','MGLY','MOH','MONITS','MONITU','MPAN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','N2O5','NH3','NO2','NPHEN','NPRNO3','O3','PAN','PHEN','PP','PPN','PROPNN','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2' + + + + +'ACTA','ALD2','AROMP4','AROMP5','ATOOH','BALD','BENZP','BR2','BRCL','BZCO3H','BZPAN','CH2O','CSL','EOH','ETHLN','ETHN','ETHP','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HI','HMHP','HMML','HNO3','HOBR','HOCL','HOI','HONIT','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','ITCN','ITHN','LIMO','LVOC','LVOCOA','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MCT','MEK','MGLY','MOH','MONITS','MONITU','MP','MPAN','MPN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','NH3','NPHEN','PAN','PHEN','PP','PPN','PROPNN','PRPE','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2' + + + +'dst_a1','so4_a1','nh4_a1','pom_a1','pomff1_a1','pombb1_a1','soa_a1','bc_a1','ncl_a1','num_a1','so4_a2','nh4_a2','soa_a2','ncl_a2','dst_a2','num_a2','dst_a3','ncl_a3','so4_a3','pom_a3','bc_a3','num_a3','ncl_a4','so4_a4','pom_a4','pomff1_a4','pombb1_a4','bc_a4','nh4_a4','num_a4','dst_a5','so4_a5','nh4_a5','num_a5','ncl_a6','so4_a6','nh4_a6','num_a6','dst_a7','so4_a7','nh4_a7','num_a7','soa1_a1','soa1_a2','soa2_a1','soa2_a2','soa3_a1','soa3_a2','soa4_a1','soa4_a2','soa5_a1','soa5_a2','soaff1_a1','soaff2_a1','soaff3_a1','soaff4_a1','soaff5_a1','soabb1_a1','soabb2_a1','soabb3_a1','soabb4_a1','soabb5_a1','soabg1_a1','soabg2_a1','soabg3_a1','soabg4_a1','soabg5_a1','soaff1_a2','soaff2_a2','soaff3_a2','soaff4_a2','soaff5_a2','soabb1_a2','soabb2_a2','soabb3_a2','soabb4_a2','soabb5_a2','soabg1_a2','soabg2_a2','soabg3_a2','soabg4_a2','soabg5_a2' + + + +'dst_a1','so4_a1','nh4_a1','pom_a1','pomff1_a1','pombb1_a1','soa_a1','bc_a1','ncl_a1','num_a1','so4_a2','nh4_a2','soa_a2','ncl_a2','dst_a2','num_a2','dst_a3','ncl_a3','so4_a3','pom_a3','bc_a3','num_a3','ncl_a4','so4_a4','pom_a4','pomff1_a4','pombb1_a4','bc_a4','nh4_a4','num_a4','dst_a5','so4_a5','nh4_a5','num_a5','ncl_a6','so4_a6','nh4_a6','num_a6','dst_a7','so4_a7','nh4_a7','num_a7','soa1_a1','soa1_a2','soa2_a1','soa2_a2','soa3_a1','soa3_a2','soa4_a1','soa4_a2','soa5_a1','soa5_a2','soaff1_a1','soaff2_a1','soaff3_a1','soaff4_a1','soaff5_a1','soabb1_a1','soabb2_a1','soabb3_a1','soabb4_a1','soabb5_a1','soabg1_a1','soabg2_a1','soabg3_a1','soabg4_a1','soabg5_a1','soaff1_a2','soaff2_a2','soaff3_a2','soaff4_a2','soaff5_a2','soabb1_a2','soabb2_a2','soabb3_a2','soabb4_a2','soabb5_a2','soabg1_a2','soabg2_a2','soabg3_a2','soabg4_a2','soabg5_a2' + + + 1,30,365,240,240,480,365,73,30 diff --git a/bld/namelist_files/use_cases/sd_geoschem.xml b/bld/namelist_files/use_cases/sd_geoschem.xml index fbeaa8cc0b..6852f2a1a0 100644 --- a/bld/namelist_files/use_cases/sd_geoschem.xml +++ b/bld/namelist_files/use_cases/sd_geoschem.xml @@ -51,6 +51,25 @@ + + + +'ACET','ACTA','ALD2','AROMP4','AROMP5','ATOOH','BALD','BENZP','BR2','BRCL','BRNO3','BZCO3H','BZPAN','CH2O','CL2','CLNO2','CLNO3','CLO','CLOO','CSL','EOH','ETHLN','ETHN','ETHP','ETNO3','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HI','HMHP','HMML','HNO3','HOBR','HOCL','HOI','HONIT','HPALD1','HPALD2','HPALD3','HPALD4','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDC','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','IPRNO3','ITCN','ITHN','LIMO','LVOC','MACR','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MCT','MENO3','MGLY','MOH','MONITS','MONITU','MPAN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','N2O5','NH3','NO2','NPHEN','NPRNO3','O3','PAN','PHEN','PP','PPN','PROPNN','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2' + + + + +'ACTA','ALD2','AROMP4','AROMP5','ATOOH','BALD','BENZP','BR2','BRCL','BZCO3H','BZPAN','CH2O','CSL','EOH','ETHLN','ETHN','ETHP','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HI','HMHP','HMML','HNO3','HOBR','HOCL','HOI','HONIT','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','ITCN','ITHN','LIMO','LVOC','LVOCOA','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MCT','MEK','MGLY','MOH','MONITS','MONITU','MP','MPAN','MPN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','NH3','NPHEN','PAN','PHEN','PP','PPN','PROPNN','PRPE','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2' + + + +'dst_a1','so4_a1','nh4_a1','pom_a1','pomff1_a1','pombb1_a1','soa_a1','bc_a1','ncl_a1','num_a1','so4_a2','nh4_a2','soa_a2','ncl_a2','dst_a2','num_a2','dst_a3','ncl_a3','so4_a3','pom_a3','bc_a3','num_a3','ncl_a4','so4_a4','pom_a4','pomff1_a4','pombb1_a4','bc_a4','nh4_a4','num_a4','dst_a5','so4_a5','nh4_a5','num_a5','ncl_a6','so4_a6','nh4_a6','num_a6','dst_a7','so4_a7','nh4_a7','num_a7','soa1_a1','soa1_a2','soa2_a1','soa2_a2','soa3_a1','soa3_a2','soa4_a1','soa4_a2','soa5_a1','soa5_a2','soaff1_a1','soaff2_a1','soaff3_a1','soaff4_a1','soaff5_a1','soabb1_a1','soabb2_a1','soabb3_a1','soabb4_a1','soabb5_a1','soabg1_a1','soabg2_a1','soabg3_a1','soabg4_a1','soabg5_a1','soaff1_a2','soaff2_a2','soaff3_a2','soaff4_a2','soaff5_a2','soabb1_a2','soabb2_a2','soabb3_a2','soabb4_a2','soabb5_a2','soabg1_a2','soabg2_a2','soabg3_a2','soabg4_a2','soabg5_a2' + + + +'dst_a1','so4_a1','nh4_a1','pom_a1','pomff1_a1','pombb1_a1','soa_a1','bc_a1','ncl_a1','num_a1','so4_a2','nh4_a2','soa_a2','ncl_a2','dst_a2','num_a2','dst_a3','ncl_a3','so4_a3','pom_a3','bc_a3','num_a3','ncl_a4','so4_a4','pom_a4','pomff1_a4','pombb1_a4','bc_a4','nh4_a4','num_a4','dst_a5','so4_a5','nh4_a5','num_a5','ncl_a6','so4_a6','nh4_a6','num_a6','dst_a7','so4_a7','nh4_a7','num_a7','soa1_a1','soa1_a2','soa2_a1','soa2_a2','soa3_a1','soa3_a2','soa4_a1','soa4_a2','soa5_a1','soa5_a2','soaff1_a1','soaff2_a1','soaff3_a1','soaff4_a1','soaff5_a1','soabb1_a1','soabb2_a1','soabb3_a1','soabb4_a1','soabb5_a1','soabg1_a1','soabg2_a1','soabg3_a1','soabg4_a1','soabg5_a1','soaff1_a2','soaff2_a2','soaff3_a2','soaff4_a2','soaff5_a2','soabb1_a2','soabb2_a2','soabb3_a2','soabb4_a2','soabb5_a2','soabg1_a2','soabg2_a2','soabg3_a2','soabg4_a2','soabg5_a2' + + 1,30,365,240,240,480,365,73,30 From bfd2a090261eadb3cfc71a36d233a3108e228361 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Wed, 21 Sep 2022 14:05:28 -0600 Subject: [PATCH 051/291] Add deposition coefficient data file to GEOS-Chem use case files Eventually this will go higher up in the cam bld directory since the same file is used for all GEOS-Chem cases. Signed-off-by: Lizzie Lundgren --- bld/namelist_files/use_cases/2000_geoschem.xml | 2 ++ bld/namelist_files/use_cases/2010_geoschem.xml | 2 ++ bld/namelist_files/use_cases/hist_geoschem.xml | 2 ++ bld/namelist_files/use_cases/sd_geoschem.xml | 2 ++ 4 files changed, 8 insertions(+) diff --git a/bld/namelist_files/use_cases/2000_geoschem.xml b/bld/namelist_files/use_cases/2000_geoschem.xml index cd26058362..670cff6809 100644 --- a/bld/namelist_files/use_cases/2000_geoschem.xml +++ b/bld/namelist_files/use_cases/2000_geoschem.xml @@ -12,6 +12,8 @@ /glade/p/univ/umit0034/Shared/GEOS-Chem/f.e20.FC2010.f19_f19.144.GC_vbsext.001.cam.i.0007-01-01-00000.nc +/glade/u/home/elundgren/drydep_henrys_law_nc/dep_data_file_geoschem.nc + 00010101 diff --git a/bld/namelist_files/use_cases/2010_geoschem.xml b/bld/namelist_files/use_cases/2010_geoschem.xml index 9af5dad132..847a245a70 100644 --- a/bld/namelist_files/use_cases/2010_geoschem.xml +++ b/bld/namelist_files/use_cases/2010_geoschem.xml @@ -10,6 +10,8 @@ /glade/p/univ/umit0034/Shared/GEOS-Chem/f.e20.FC2010.f19_f19.144.GC_vbsext.001.cam.i.0007-01-01-00000.nc +/glade/u/home/elundgren/drydep_henrys_law_nc/dep_data_file_geoschem.nc + 00010101 diff --git a/bld/namelist_files/use_cases/hist_geoschem.xml b/bld/namelist_files/use_cases/hist_geoschem.xml index 2214ef4e15..6e0c1cee83 100644 --- a/bld/namelist_files/use_cases/hist_geoschem.xml +++ b/bld/namelist_files/use_cases/hist_geoschem.xml @@ -12,6 +12,8 @@ /glade/p/univ/umit0034/Shared/GEOS-Chem/f.e20.FC2010.f19_f19.144.GC_vbsext.001.cam.i.0007-01-01-00000.nc +/glade/u/home/elundgren/drydep_henrys_law_nc/dep_data_file_geoschem.nc + 00010101 diff --git a/bld/namelist_files/use_cases/sd_geoschem.xml b/bld/namelist_files/use_cases/sd_geoschem.xml index 6852f2a1a0..3f86e29f1b 100644 --- a/bld/namelist_files/use_cases/sd_geoschem.xml +++ b/bld/namelist_files/use_cases/sd_geoschem.xml @@ -14,6 +14,8 @@ /glade/p/univ/umit0034/Shared/GEOS-Chem/f.e20.FCSD.f09_f09_mg17.cesm2.1-exp002.001.cam.i.2005-01-01-00000_c180801.nc atm/cam/met/MERRA2/0.9x1.25/fv_0.9x1.25_nc3000_Nsw042_Nrs008_Co060_Fi001_ZR_sgh30_24km_GRNL_MERRA2_c171218.nc +/glade/u/home/elundgren/drydep_henrys_law_nc/dep_data_file_geoschem.nc + 20050101 From 5da5680d321a0692f11928e50d658f177d2bd745 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Wed, 21 Sep 2022 14:06:01 -0600 Subject: [PATCH 052/291] Minor edit to Neu wet deposition debug code when using GEOS-Chem Signed-off-by: Lizzie Lundgren --- src/chemistry/geoschem/mo_neu_wetdep.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/chemistry/geoschem/mo_neu_wetdep.F90 b/src/chemistry/geoschem/mo_neu_wetdep.F90 index b7eab09b23..a168010729 100644 --- a/src/chemistry/geoschem/mo_neu_wetdep.F90 +++ b/src/chemistry/geoschem/mo_neu_wetdep.F90 @@ -81,7 +81,7 @@ subroutine neu_wetdep_init do m=1,gas_wetdep_cnt ! test_name = gas_wetdep_list(m) - if ( debug .and. masterproc ) print '(a,i4,a)','neu_wetdep_init: gas_wetdep_list species ',m,trim(test_name) + if ( debug .and. masterproc ) print '(a,i4,a,a)','neu_wetdep_init: gas_wetdep_list species ',m,' ',trim(test_name) ! ! ewl: this mapping can be replaced by including Henry's Law etc for all species, which makes usage of ! the parameters more transparent. I will comment out.... From 33de60e26fb35f932a783746d54695c1328bd453 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Fri, 23 Sep 2022 10:27:42 -0600 Subject: [PATCH 053/291] Add non-advected GEOS-Chem species OH and HO2 to solsym for diagnostics Signed-off-by: Lizzie Lundgren --- bld/configure | 2 +- src/chemistry/geoschem/chem_mods.F90 | 4 ++-- src/chemistry/geoschem/mo_sim_dat.F90 | 22 +++++++++++++--------- 3 files changed, 16 insertions(+), 12 deletions(-) diff --git a/bld/configure b/bld/configure index 69aeb1edbe..0bbcc8ff50 100755 --- a/bld/configure +++ b/bld/configure @@ -1404,7 +1404,7 @@ if ($chem_pkg =~ '_mam3') { # TMMF - wedge in GEOS-Chem CPP definitions here if ($chem_pkg =~ 'geoschem') { $chem_cppdefs .= ' -DEXTERNAL_GRID -DEXTERNAL_FORCING -DLINUX_IFORT -DUSE_REAL8 -DMODEL_ -DMODEL_CESM'; - $chem_nadv = 267; # includes GC advected species (233), CO2 (1), and MAM aerosols (33) + $chem_nadv = 269; # includes GC advected species (233), CO2 (1), and MAM aerosols (33) if (defined $opts{'clm_vers'}) { if ($opts{'clm_vers'} =~ 'CLM4.0') { $chem_cppdefs .= ' -DCLM40' diff --git a/src/chemistry/geoschem/chem_mods.F90 b/src/chemistry/geoschem/chem_mods.F90 index d44f3da459..4c336a5b29 100644 --- a/src/chemistry/geoschem/chem_mods.F90 +++ b/src/chemistry/geoschem/chem_mods.F90 @@ -7,7 +7,7 @@ module chem_mods implicit none save - INTEGER, PARAMETER :: nTracersMax = 267 ! Must be equal to chem_nadv + INTEGER, PARAMETER :: nTracersMax = 269 ! Must be equal to chem_nadv INTEGER :: nTracers CHARACTER(LEN=255) :: tracerNames(nTracersMax) CHARACTER(LEN=255) :: tracerLongNames(nTracersMax) @@ -61,7 +61,7 @@ module chem_mods rxntot = 212, & ! number of total reactions gascnt = 172, & ! number of gas phase reactions nabscol = 2, & ! number of absorbing column densities - gas_pcnst = 267, & ! number of "gas phase" species (same as solsym length) + gas_pcnst = 269, & ! number of "gas phase" species (same as solsym length) ! Includes GC advected species (233), MAM aerosols (33), ! and CO2 (1) nfs = 6, & ! number of "fixed" species diff --git a/src/chemistry/geoschem/mo_sim_dat.F90 b/src/chemistry/geoschem/mo_sim_dat.F90 index 25fc5207aa..5bd6d5a199 100644 --- a/src/chemistry/geoschem/mo_sim_dat.F90 +++ b/src/chemistry/geoschem/mo_sim_dat.F90 @@ -43,14 +43,17 @@ subroutine set_sim_dat ! ewl notes: added HMS (for GEOS-Chem 13.3) ! added AONITA, AROMP4, AROMP5, BALD, BENZP, BZCO3H, ! BZPAN, C2H2, C2H4, CSL, ETHN, ETHP, MCT, NPHEN, PHEN for 14.0 - ! Removed non-advected GEOS-Chem species (except CO2) for 14.0 + ! Removed non-advected GEOS-Chem species for 14.0, except CO2 + ! which is a constituent, as well as OH and HO2 for diagnostic + ! output. ! - ! Currently include GC advected species (233), MAM aerosols (33), and CO2 (1) + ! Currently include GC advected species (233), MAM aerosols (33), CO2 (1), + ! and OH and HO2 (2). ! If changed, update to match solsym length: - ! 1. cam/bld/configure variable $chem_adv + ! 1. cam/bld/configure variable $chem_nadv ! 2. cam/src/chemistry/geoschem/chem_mods.F90 vars gas_pcnst and nTracersMax - ! Alse update adv_mass to store MWs for species in solsym (ewl, 8/8/22) - solsym(:267) = (/ 'ACET ', & + ! Also update adv_mass to store MWs for species in solsym (ewl, 8/8/22) + solsym(:269) = (/ 'ACET ', & 'ACTA ','AERI ', & 'ALD2 ','ALK4 ','ASOA1 ', & 'ASOA2 ','ASOA3 ','ASOAN ', & @@ -143,8 +146,9 @@ subroutine set_sim_dat 'soa3_a2 ','soa4_a1 ','soa4_a2 ', & 'soa5_a1 ','soa5_a2 ','H2SO4 ', & 'SOAG0 ','SOAG1 ','SOAG2 ', & - 'SOAG3 ','SOAG4 ','CO2 ' /) -!non-advected GEOS-Chem species in 14.0: + 'SOAG3 ','SOAG4 ','CO2 ', & + 'HO2 ','OH ' /) +!non-advected GEOS-Chem species in 14.0 (beware this includes OH and HO2 already listed above) ! 'LBRO2H ','LBRO2N ','LISOPOH ', & ! 'LISOPNO3 ','LTRO2H ','LTRO2N ', & ! 'LXRO2H ','LXRO2N ','SO4H1 ', & @@ -179,7 +183,7 @@ subroutine set_sim_dat fix_mass(: 6) = (/ 0.00000000_r8, 28.0134800_r8, 31.9988000_r8, 2.020000_r8, 32.050000_r8, & 74.090000_r8 /) - adv_mass(:267) = (/ 58.090000_r8, 60.060000_r8, 126.900000_r8, 44.060000_r8, 58.120000_r8, & + adv_mass(:269) = (/ 58.090000_r8, 60.060000_r8, 126.900000_r8, 44.060000_r8, 58.120000_r8, & 150.000000_r8, 150.000000_r8, 150.000000_r8, 150.000000_r8, 150.000000_r8, & 150.00000_r8, 150.000000_r8, 189.12_r8, 68.08_r8, 98.10_r8, & 90.0900000_r8, 106.12_r8, 12.010000_r8, 12.010000_r8, & @@ -231,7 +235,7 @@ subroutine set_sim_dat 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, & 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, 98.078400_r8, & 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, & - 44.010000_r8 /) + 44.010000_r8, 33.0100000_r8, 17.0100000_r8 /) extfrc_lst(: 1) = (/ ' ' /) From 06985e5ee4397e921fcad583046c07e81f319ade Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Fri, 23 Sep 2022 11:56:39 -0600 Subject: [PATCH 054/291] Change default FCSD_GC year from 2005 to 2015 Signed-off-by: Lizzie Lundgren --- bld/namelist_files/use_cases/sd_geoschem.xml | 7 ++++--- cime_config/config_compsets.xml | 1 + 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/bld/namelist_files/use_cases/sd_geoschem.xml b/bld/namelist_files/use_cases/sd_geoschem.xml index 3f86e29f1b..a398cc0a5e 100644 --- a/bld/namelist_files/use_cases/sd_geoschem.xml +++ b/bld/namelist_files/use_cases/sd_geoschem.xml @@ -17,18 +17,19 @@ /glade/u/home/elundgren/drydep_henrys_law_nc/dep_data_file_geoschem.nc + -20050101 +20150101 50. .true. -2005/MERRA2_1.9x2.5_20050101.nc +2015/MERRA2_1.9x2.5_20150101.nc atm/cam/met/MERRA2/1.9x2.5 atm/cam/met/MERRA2/1.9x2.5/filenames_list_c20210302 -2005/MERRA2_0.9x1.25_20050101.nc +2015/MERRA2_0.9x1.25_20150101.nc atm/cam/met/MERRA2/0.9x1.25 atm/cam/met/MERRA2/0.9x1.25/filenames_1975-2017_c190125.txt diff --git a/cime_config/config_compsets.xml b/cime_config/config_compsets.xml index 8fa40e5f9d..c6c943604a 100644 --- a/cime_config/config_compsets.xml +++ b/cime_config/config_compsets.xml @@ -558,6 +558,7 @@ 1995-01-01 2005-01-01 2005-01-01 + 2015-01-01 2010-01-01 1980-01-01 2000-01-01 From 822cd06727acfcfc8e79b1e2528aa554cbee1974 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Tue, 27 Sep 2022 13:40:08 -0600 Subject: [PATCH 055/291] Fix parameters incremented for non-advected species added to solysm Only gas_pcnst should be incremented when adding non-advected species to solsym. Signed-off-by: Lizzie Lundgren --- bld/configure | 2 +- src/chemistry/geoschem/chem_mods.F90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/bld/configure b/bld/configure index 0bbcc8ff50..69aeb1edbe 100755 --- a/bld/configure +++ b/bld/configure @@ -1404,7 +1404,7 @@ if ($chem_pkg =~ '_mam3') { # TMMF - wedge in GEOS-Chem CPP definitions here if ($chem_pkg =~ 'geoschem') { $chem_cppdefs .= ' -DEXTERNAL_GRID -DEXTERNAL_FORCING -DLINUX_IFORT -DUSE_REAL8 -DMODEL_ -DMODEL_CESM'; - $chem_nadv = 269; # includes GC advected species (233), CO2 (1), and MAM aerosols (33) + $chem_nadv = 267; # includes GC advected species (233), CO2 (1), and MAM aerosols (33) if (defined $opts{'clm_vers'}) { if ($opts{'clm_vers'} =~ 'CLM4.0') { $chem_cppdefs .= ' -DCLM40' diff --git a/src/chemistry/geoschem/chem_mods.F90 b/src/chemistry/geoschem/chem_mods.F90 index 4c336a5b29..fd7249ddd2 100644 --- a/src/chemistry/geoschem/chem_mods.F90 +++ b/src/chemistry/geoschem/chem_mods.F90 @@ -7,7 +7,7 @@ module chem_mods implicit none save - INTEGER, PARAMETER :: nTracersMax = 269 ! Must be equal to chem_nadv + INTEGER, PARAMETER :: nTracersMax = 267 ! Must be equal to chem_nadv INTEGER :: nTracers CHARACTER(LEN=255) :: tracerNames(nTracersMax) CHARACTER(LEN=255) :: tracerLongNames(nTracersMax) From 805659715e1d158374aa9ebd65fdc675529cdc7d Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Tue, 27 Sep 2022 13:53:23 -0600 Subject: [PATCH 056/291] Change Default FCHIST_GC run startdate year from 2010 t0 2015 This avoids an error retrieving CEDS emissions for which 2010 is not available. This update also include a minor comment change in chem_mods. Signed-off-by: Lizzie Lundgren --- cime_config/config_compsets.xml | 2 +- src/chemistry/geoschem/chem_mods.F90 | 3 ++- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/cime_config/config_compsets.xml b/cime_config/config_compsets.xml index c6c943604a..93bb88ec3b 100644 --- a/cime_config/config_compsets.xml +++ b/cime_config/config_compsets.xml @@ -552,7 +552,7 @@ 1980-01-01 1850-01-01 2010-01-01 - 2010-01-01 + 2015-01-01 2013-01-01 1995-01-01 1995-01-01 diff --git a/src/chemistry/geoschem/chem_mods.F90 b/src/chemistry/geoschem/chem_mods.F90 index fd7249ddd2..03c0805ffc 100644 --- a/src/chemistry/geoschem/chem_mods.F90 +++ b/src/chemistry/geoschem/chem_mods.F90 @@ -63,7 +63,8 @@ module chem_mods nabscol = 2, & ! number of absorbing column densities gas_pcnst = 269, & ! number of "gas phase" species (same as solsym length) ! Includes GC advected species (233), MAM aerosols (33), - ! and CO2 (1) + ! and CO2 (1), as well as any non-advected species added + ! to solsym and mo_sim_dat.F90. nfs = 6, & ! number of "fixed" species relcnt = 0, & ! number of relationship species grpcnt = 0, & ! number of group members From a89b9cb3a13597bb66dad50bbd08d4f3d2870bb2 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Thu, 29 Sep 2022 14:30:46 -0600 Subject: [PATCH 057/291] Add friction velocity as a nuopc import in CAM Ustar is used in GEOS-Chem dry deposition over ocean Signed-off-by: Lizzie Lundgren --- src/cpl/nuopc/atm_import_export.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/src/cpl/nuopc/atm_import_export.F90 b/src/cpl/nuopc/atm_import_export.F90 index 11e4eb6772..bdce379f69 100644 --- a/src/cpl/nuopc/atm_import_export.F90 +++ b/src/cpl/nuopc/atm_import_export.F90 @@ -225,6 +225,7 @@ subroutine advertise_fields(gcomp, flds_scalar_name, rc) call fldlist_add(fldsToAtm_num, fldsToAtm, 'Si_snowh' ) call fldlist_add(fldsToAtm_num, fldsToAtm, 'So_ssq' ) call fldlist_add(fldsToAtm_num, fldsToAtm, 'So_re' ) + call fldlist_add(fldsToAtm_num, fldsToAtm, 'So_ustar' ) call fldlist_add(fldsToAtm_num, fldsToAtm, 'Sx_u10' ) call fldlist_add(fldsToAtm_num, fldsToAtm, 'Faxx_taux' ) call fldlist_add(fldsToAtm_num, fldsToAtm, 'Faxx_tauy' ) From c8dd834f68542d46cf64c8fb3dba9920f30c57b9 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Mon, 31 Oct 2022 13:41:09 -0600 Subject: [PATCH 058/291] Add hemco_grid_xdim, hemco_grid_ydim namelist variables to configure HEMCO grid. --- bld/namelist_files/namelist_defaults_cam.xml | 12 ++++++++++++ bld/namelist_files/namelist_definition.xml | 12 ++++++++++++ 2 files changed, 24 insertions(+) diff --git a/bld/namelist_files/namelist_defaults_cam.xml b/bld/namelist_files/namelist_defaults_cam.xml index c2d4ec6345..6be1e5df3d 100644 --- a/bld/namelist_files/namelist_defaults_cam.xml +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -3227,4 +3227,16 @@ atm/cam/ocnfrac/domain.aqua.fv1.9x2.5.nc + +HEMCO_Config.rc + +288 +201 + +288 +201 + +144 +91 + diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index fa38d85c54..8c08feee05 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -4887,6 +4887,18 @@ Full pathname to HEMCO_Config.rc, which prescribes emission inventories Default: set by build-namelist. + +Number of x-dimensions in HEMCO internal grid. +Default: set by build-namelist. + + + +Number of y-dimensions in HEMCO internal grid. +Default: set by build-namelist. + + Date: Mon, 31 Oct 2022 13:50:27 -0600 Subject: [PATCH 059/291] Update HEMCO tag to hemco-cesm1_0_hemco3_5_0 --- Externals_CAM.cfg | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Externals_CAM.cfg b/Externals_CAM.cfg index 29f5521914..43066f7169 100644 --- a/Externals_CAM.cfg +++ b/Externals_CAM.cfg @@ -77,9 +77,9 @@ local_path = src/chemistry/geoschem/geoschem_src required = True [hemco] -branch = feature/hemco_3.5.0 +tag = hemco-cesm1_0_hemco_3_5_0 protocol = git -repo_url = https://github.com/lizziel/HEMCO_CESM.git +repo_url = https://github.com/ESCOMP/HEMCO_CESM.git local_path = src/hemco required = True externals = Externals_HCO.cfg From aefa2ef854d657f77a3585e4ce2ffc12525663fe Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Mon, 31 Oct 2022 15:06:08 -0600 Subject: [PATCH 060/291] Experimental first version of New History Diagnostics --- cime_config/config_compsets.xml | 5 + src/chemistry/geoschem/cesmgc_history_mod.F90 | 1212 +++++++++++++++++ src/chemistry/geoschem/chemistry.F90 | 43 + 3 files changed, 1260 insertions(+) create mode 100644 src/chemistry/geoschem/cesmgc_history_mod.F90 diff --git a/cime_config/config_compsets.xml b/cime_config/config_compsets.xml index 93bb88ec3b..6206142da2 100644 --- a/cime_config/config_compsets.xml +++ b/cime_config/config_compsets.xml @@ -539,6 +539,11 @@ HIST_CAM60%GC%SDYN_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV + + FCnudged_GC + HIST_CAM60%GC%NUDG_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV + + diff --git a/src/chemistry/geoschem/cesmgc_history_mod.F90 b/src/chemistry/geoschem/cesmgc_history_mod.F90 new file mode 100644 index 0000000000..88f8d2d25b --- /dev/null +++ b/src/chemistry/geoschem/cesmgc_history_mod.F90 @@ -0,0 +1,1212 @@ +#define ASSERT_(cond,msg) if(.not.cond) then; print *, "assertion error: ", Iam, __LINE__; call endrun("assertion error - look above - in cesmgc_history_mod.F90"); endif +#define _Iam_(name) character(len=255) :: Iam=name +#define __Iam__(name) integer :: STATUS; _Iam_(name) +! Above are compatibility shorthands to avoid excessive divergence from +! MAPL-based code. (hplin, 10/19/22) +!------------------------------------------------------------------------------ +! GEOS-Chem Global Chemical Transport Model ! +!------------------------------------------------------------------------------ +!BOP +! +! !MODULE: cesmgc_history_mod.F90 +! +! !DESCRIPTION: Module CESMGC\_History\_Mod interfaces between the CAM history +! component, the HISTORY.rc configuration file, and the GEOS-Chem State registry. +! This module is based off GCHP\_HistoryExports\_Mod originally developed by +! Lizzie Lundgren for GCHP. +!\\ +!\\ +! !INTERFACE: +! +MODULE CESMGC_History_Mod +! +! !USES: +! + USE DiagList_Mod + USE TaggedDiagList_Mod + USE ErrCode_Mod + USE Precision_Mod + + USE cam_abortutils, only : endrun + + IMPLICIT NONE + PRIVATE +! +! !PUBLIC MEMBER FUNCTIONS: +! + PUBLIC :: HistoryExports_SetServices + PUBLIC :: HistoryExports_SetDataPointers + PUBLIC :: CopyGCStates2Exports + PUBLIC :: Destroy_HistoryConfig +! +! !PRIVATE: +! + PRIVATE :: Init_HistoryConfig + PRIVATE :: Init_HistoryExport + PRIVATE :: Init_HistoryExportsList + PRIVATE :: Append_HistoryExportsList + PRIVATE :: Check_HistoryExportsList + PRIVATE :: Print_HistoryExportsList + ! +! !PUBLIC TYPES +! + ! History Configuration Object + TYPE, PUBLIC :: HistoryConfigObj + + CHARACTER(LEN=255) :: ROOT ! TODO: needed? + CHARACTER(LEN=255) :: ConfigFileName + LOGICAL :: ConfigFileRead + TYPE(HistoryExportsListObj), POINTER :: HistoryExportsList + TYPE(DgnList) :: DiagList + TYPE(TaggedDgnList) :: TaggedDiagList + + END TYPE HistoryConfigObj +! +! !PRIVATE TYPES +! + ! History Exports Linked List + TYPE :: HistoryExportsListObj + + TYPE(HistoryExportObj), POINTER :: head + INTEGER :: numExports + + END TYPE HistoryExportsListObj + + ! History Export Object + TYPE :: HistoryExportObj + + CHARACTER(LEN=255) :: name + CHARACTER(LEN=255) :: metadataID + CHARACTER(LEN=255) :: registryID + CHARACTER(LEN=255) :: long_name + CHARACTER(LEN=255) :: units + INTEGER :: vloc + INTEGER :: rank + INTEGER :: type + LOGICAL :: isMet + LOGICAL :: isChem + LOGICAL :: isDiag + TYPE(HistoryExportObj), POINTER :: next + + ! Pointers to ESMF Export and GEOS-Chem State + ! TODO: for now, include all possible data types in the registry. + REAL, POINTER :: ExportData2d(:,:) + REAL, POINTER :: ExportData3d(:,:,:) + REAL(fp), POINTER :: GCStateData0d + REAL(fp), POINTER :: GCStateData1d(:) + REAL(fp), POINTER :: GCStateData2d(:,:) + REAL(fp), POINTER :: GCStateData3d(:,:,:) + REAL(f4), POINTER :: GCStateData0d_4 + REAL(f4), POINTER :: GCStateData1d_4(:) + REAL(f4), POINTER :: GCStateData2d_4(:,:) + REAL(f4), POINTER :: GCStateData3d_4(:,:,:) + REAL(f8), POINTER :: GCStateData0d_8 + REAL(f8), POINTER :: GCStateData1d_8(:) + REAL(f8), POINTER :: GCStateData2d_8(:,:) + REAL(f8), POINTER :: GCStateData3d_8(:,:,:) + INTEGER, POINTER :: GCStateData0d_I + INTEGER, POINTER :: GCStateData1d_I(:) + INTEGER, POINTER :: GCStateData2d_I(:,:) + INTEGER, POINTER :: GCStateData3d_I(:,:,:) + + END TYPE HistoryExportObj +! +! !REVISION HISTORY: +! 01 Sep 2017 - E. Lundgren - Initial version +! 19 Oct 2022 - H.P. Lin - Adapted for CESM +! See https://github.com/geoschem/geos-chem for history +!EOP +!------------------------------------------------------------------------------ +!BOC + +CONTAINS +!------------------------------------------------------------------------------ +! GEOS-Chem Global Chemical Transport Model ! +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: Init_HistoryConfig +! +! !DESCRIPTION: +!\\ +!\\ +! !INTERFACE: +! + SUBROUTINE Init_HistoryConfig ( am_I_Root, HistoryConfig, configFile, RC ) +! +! !USES: +! +! +! !INPUT PARAMETERS: +! + LOGICAL, INTENT(IN) :: am_I_Root + CHARACTER(LEN=*), INTENT(IN) :: configFile +! +! !OUTPUT PARAMETERS: +! + TYPE(HistoryConfigObj), POINTER :: HistoryConfig + INTEGER, INTENT(OUT) :: RC +! +! !REVISION HISTORY: +! 01 Sep 2017 - E. Lundgren - Initial version +! See https://github.com/geoschem/geos-chem for history +!EOP +!------------------------------------------------------------------------------ +!BOC + __Iam__('Init_HistoryConfig (cesmgc_history_mod.F90)') + RC = GC_SUCCESS + ALLOCATE(HistoryConfig) + HistoryConfig%ROOT = '' + HistoryConfig%ConfigFileName = TRIM(configFile) + HistoryConfig%ConfigFileRead = .FALSE. + + CALL Init_DiagList( am_I_Root, configFile, HistoryConfig%DiagList, RC ) + IF ( RC == GC_FAILURE ) THEN + _ASSERT(.FALSE., 'informative message here') + RETURN + ENDIF + ! Optional debugging + CALL Print_DiagList( am_I_Root, HistoryConfig%DiagList, RC ) + + CALL Init_TaggedDiagList( am_I_Root, HistoryConfig%DiagList, & + HistoryConfig%TaggedDiagList, RC ) + IF ( RC == GC_FAILURE ) THEN + _ASSERT(.FALSE., 'informative message here') + RETURN + ENDIF + ! Optional debugging + CALL Print_TaggedDiagList( am_I_Root, HistoryConfig%TaggedDiagList, RC ) + + + CALL Init_HistoryExportsList( am_I_Root, HistoryConfig, RC ) + IF ( RC == GC_FAILURE ) THEN + _ASSERT(.FALSE., 'informative message here') + RETURN + ENDIF + + ! Optional debugging + CALL Print_HistoryExportsList( am_I_Root, HistoryConfig, RC ) + + END SUBROUTINE Init_HistoryConfig +!EOC +!------------------------------------------------------------------------------ +! GEOS-Chem Global Chemical Transport Model ! +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: Init_HistoryExportsList +! +! !DESCRIPTION: +!\\ +!\\ +! !INTERFACE: +! + SUBROUTINE Init_HistoryExportsList ( am_I_Root, HistoryConfig, RC ) +! +! !USES: +! + USE State_Chm_Mod, ONLY: Get_Metadata_State_Chm + USE State_Diag_Mod, ONLY: Get_Metadata_State_Diag + USE State_Met_Mod, ONLY: Get_Metadata_State_Met +! +! !INPUT PARAMETERS: +! + LOGICAL, INTENT(IN) :: am_I_Root +! +! !INPUT/OUTPUT PARAMETERS: +! + TYPE(HistoryConfigObj), POINTER :: HistoryConfig +! +! !OUTPUT PARAMETERS: +! + INTEGER, INTENT(OUT) :: RC +! +! !REVISION HISTORY: +! 01 Sep 2017 - E. Lundgren - initial version +! See https://github.com/geoschem/geos-chem for history +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: +! + INTEGER :: N, rank, vloc, type + CHARACTER(LEN=255) :: ErrMsg, desc, units, tag + LOGICAL :: isMet, isChem, isDiag, found + TYPE(HistoryExportObj), POINTER :: NewHistExp + TYPE(DgnItem), POINTER :: current + + ! ================================================================ + ! Init_HistoryExportsList begins here + ! ================================================================ + __Iam__('Init_HistoryExportsList (cesmgc_history_mod.F90)') + RC = GC_SUCCESS + + ! Init + NewHistExp => NULL() + + ! Create HistoryExportsList object + ALLOCATE(HistoryConfig%HistoryExportsList) + HistoryConfig%HistoryExportsList%numExports = 0 + HistoryConfig%HistoryExportsList%head => NULL() + + ! Loop over entries in DiagList + current => HistoryConfig%DiagList%head + DO WHILE ( ASSOCIATED( current ) ) + + ! Skip diagnostics handled by HEMCO, non-standard for GEOS, + ! or species in the GCHP/GEOS internal state. + ! See diaglist_mod.F90 for criteria for assigning diagnostic state. + IF ( INDEX( current%state, 'HEMCO' ) == 1 .OR. & + INDEX( current%state, 'GEOS' ) == 1 .OR. & + INDEX( current%state, 'INTERNAL' ) == 1 ) THEN + current => current%next + CYCLE + ENDIF + + ! Check history exports list to see if already added (unless wildcard) + IF ( .NOT. current%isWildcard ) THEN + CALL Check_HistoryExportsList( am_I_Root, current%name, & + HistoryConfig%HistoryExportsList, & + found, RC ) + IF ( found ) THEN + current => current%next + CYCLE + ENDIF + ENDIF + + ! Get metadata using metadataID and state + ! If isTagged, then append to description + ! If isWildcard, shouldn't get here + ! The name of the export is simply name + Found = .TRUE. + isMet = .FALSE. + isChem = .FALSE. + isDiag = .FALSE. + IF ( TRIM(current%state) == 'MET' ) THEN + isMet = .TRUE. + CALL Get_Metadata_State_Met( am_I_Root, current%metadataID, & + Found, RC, desc=desc, units=units, & + rank=rank, type=type, vloc=vloc ) + ! TODO: need to add found to outputs of get_metadata_state_met + ELSEIF ( TRIM(current%state) == 'CHEM' ) THEN + isCHEM = .TRUE. + CALL Get_Metadata_State_Chm( am_I_Root, current%metadataID, & + Found, RC, desc=desc, units=units, & + rank=rank, type=type, vloc=vloc ) + ELSEIF ( TRIM(current%state) == 'DIAG' ) THEN + isDIAG = .TRUE. + CALL Get_Metadata_State_Diag( am_I_Root, current%metadataID, & + Found, RC, desc=desc, units=units, & + rank=rank, srcType=type, vloc=vloc ) + ELSE + RC = GC_FAILURE + ErrMsg = "Unknown state of item " // TRIM(current%name) // & + " in DiagList: " // TRIM(current%state) + EXIT + ENDIF + + IF ( .NOT. Found ) THEN + RC = GC_FAILURE + ErrMsg = "Metadata not found for " // TRIM(current%name) // & + " in state " // TRIM(current%state) + EXIT + ENDIF + + ! If wildcard is present + IF ( current%isWildcard ) THEN + ! Do nothing. This should never happen at this point since + ! Init_DiagList will exit with an error if wildcard is + ! encountered in HISTORY.rc while compiling with ESMF_. + + ! When it comes time to implement, create exports in a loop, + ! either for all species or for advected species only. Include + ! a check that the export was not already created. Loop over + ! AdvNames if wildcard is ADV. Loop over SpecNames for all other + ! cases, passing not found = OK so that not all are necessarily + ! output. Later on, after species database is initialized, exports + ! for only species in the specific wildcard will be associated + ! with data and thus included in the output file. + + ! If the meantime, skip wildcards if it gets here. + current => current%next + CYCLE + ENDIF + + ! If this item is for a specific tag, append description. + ! This will need revisiting since there may be tag-dependent + ! strings to append to long names + IF ( current%isTagged ) THEN + desc = TRIM(desc) // " for " // TRIM(current%tag) + ENDIF + + ! Create a new HistoryExportObj object + CALL Init_HistoryExport( am_I_Root, NewHistExp, & + name=current%name, & + metadataID=current%metadataID, & + registryID=current%registryID, & + long_name=desc, & + units=units, & + vloc=vloc, & + rank=rank, & + type=type, & + isMet=isMet, & + isChem=isChem, & + isDiag=isDiag, & + RC=RC ) + IF ( RC == GC_FAILURE ) THEN + RC = GC_FAILURE + ErrMsg = "History export init fail for " // TRIM(current%name) + EXIT + ENDIF + + ! Add new HistoryExportObj to linked list + CALL Append_HistoryExportsList( am_I_Root, NewHistExp, & + HistoryConfig, RC ) + IF ( RC == GC_FAILURE ) THEN + RC = GC_FAILURE + ErrMsg = "History export append fail for " // TRIM(current%name) + EXIT + ENDIF + + ! Set up for next item in DiagList + current => current%next + + ENDDO + current => NULL() + + IF ( RC == GC_SUCCESS ) THEN + HistoryConfig%ConfigFileRead = .TRUE. + ELSE + CALL GC_ERROR( ErrMsg, RC, Iam ) + _ASSERT(.FALSE., 'informative message here') + RETURN + ENDIF + + END SUBROUTINE Init_HistoryExportsList +!EOC +!------------------------------------------------------------------------------ +! GEOS-Chem Global Chemical Transport Model ! +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: Init_HistoryExport +! +! !DESCRIPTION: +!\\ +!\\ +! !INTERFACE: +! + SUBROUTINE Init_HistoryExport ( am_I_Root, NewHistExp, name, & + metadataID, registryID, long_name, & + units, vloc, rank, & + type, isMet, isChem, & + isDiag, RC ) +! +! !INPUT PARAMETERS: +! + LOGICAL, INTENT(IN) :: am_I_Root +! +! !OUTPUT PARAMETERS: +! + TYPE(HistoryExportObj), POINTER :: NewHistExp + CHARACTER(LEN=*), OPTIONAL :: name + CHARACTER(LEN=*), OPTIONAL :: metadataID + CHARACTER(LEN=*), OPTIONAL :: registryID + CHARACTER(LEN=*), OPTIONAL :: long_name + CHARACTER(LEN=*), OPTIONAL :: units + INTEGER, OPTIONAL :: vloc + INTEGER, OPTIONAL :: rank + INTEGER, OPTIONAL :: type + LOGICAL, OPTIONAL :: isMet + LOGICAL, OPTIONAL :: isChem + LOGICAL, OPTIONAL :: isDiag + INTEGER, OPTIONAL :: RC +! +! !REVISION HISTORY: +! 01 Sep 2017 - E. Lundgren - Initial version +! See https://github.com/geoschem/geos-chem for history +!EOP +!------------------------------------------------------------------------------ +!BOC + __Iam__('Init_HistoryExport (cesmgc_history_mod.F90)') + RC = GC_SUCCESS + ALLOCATE(NewHistExp) + + IF ( PRESENT( name ) ) THEN + NewHistExp%name = TRIM(name) + ELSE + NewHistExp%name = '' + ENDIF + + IF ( PRESENT( metaDataId ) ) THEN + NewHistExp%metadataID = TRIM(metadataID) + ELSE + NewHistExp%metadataID = '' + ENDIF + + IF ( PRESENT( registryId ) ) THEN + NewHistExp%registryID = TRIM(registryID) + ELSE + NewHistExp%registryId = '' + ENDIF + + IF ( PRESENT( long_name ) ) THEN + NewHistExp%long_name = TRIM(long_name) + ELSE + NewHistExp%long_name = '' + ENDIF + + IF ( PRESENT( units ) ) THEN + NewHistExp%units = TRIM(units) + ELSE + NewHistExp%units = '' + ENDIF + + IF ( PRESENT( vloc ) ) THEN + NewHistExp%vloc = vloc + ELSE + NewHistExp%vloc = -1 + ENDIF + + IF ( PRESENT( rank ) ) THEN + NewHistExp%rank = rank + ELSE + NewHistExp%rank = -1 + ENDIF + + IF ( PRESENT( type ) ) THEN + NewHistExp%type = type + ELSE + NewHistExp%type = -1 + ENDIF + + IF ( PRESENT( isMet ) ) THEN + NewHistExp%isMet = isMet + ELSE + NewHistExp%isMet = .FALSE. + ENDIF + + IF ( PRESENT( isChem ) ) THEN + NewHistExp%isChem = isChem + ELSE + NewHistExp%isChem = .FALSE. + ENDIF + + IF ( PRESENT( isDiag ) ) THEN + NewHistExp%isDiag = isDiag + ELSE + NewHistExp%isDiag = .FALSE. + ENDIF + + NewHistExp%next => NULL() + NewHistExp%ExportData2d => NULL() + NewHistExp%ExportData3d => NULL() + NewHistExp%GCStateData0d => NULL() + NewHistExp%GCStateData1d => NULL() + NewHistExp%GCStateData2d => NULL() + NewHistExp%GCStateData3d => NULL() + NewHistExp%GCStateData0d_4 => NULL() + NewHistExp%GCStateData1d_4 => NULL() + NewHistExp%GCStateData2d_4 => NULL() + NewHistExp%GCStateData3d_4 => NULL() + NewHistExp%GCStateData0d_8 => NULL() + NewHistExp%GCStateData1d_8 => NULL() + NewHistExp%GCStateData2d_8 => NULL() + NewHistExp%GCStateData3d_8 => NULL() + NewHistExp%GCStateData0d_I => NULL() + NewHistExp%GCStateData1d_I => NULL() + NewHistExp%GCStateData2d_I => NULL() + NewHistExp%GCStateData3d_I => NULL() + + END SUBROUTINE Init_HistoryExport +!EOC +!------------------------------------------------------------------------------ +! GEOS-Chem Global Chemical Transport Model ! +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: Append_HistoryExportsList +! +! !DESCRIPTION: +!\\ +!\\ +! !INTERFACE: +! + SUBROUTINE Append_HistoryExportsList ( am_I_Root, HistoryExport, & + HistoryConfig, RC ) +! +! !USES: +! +! +! !INPUT PARAMETERS: +! + LOGICAL, INTENT(IN) :: am_I_Root + TYPE(HistoryExportObj), POINTER :: HistoryExport +! +! !INPUT/OUTPUT PARAMETERS: +! + TYPE(HistoryConfigObj), POINTER :: HistoryConfig +! +! !OUTPUT PARAMETERS: +! + INTEGER, INTENT(OUT) :: RC +! +! !REVISION HISTORY: +! 01 Sep 2017 - E. Lundgren - initial version +! See https://github.com/geoschem/geos-chem for history +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: +! + TYPE(HistoryExportObj), POINTER :: NewHistExp + + ! ================================================================ + ! Append_HistoryExportsList begins here + ! ================================================================ + __Iam__('Append_HistoryExportsList (cesmgc_history_mod.F90)') + RC = GC_SUCCESS + + ! Add new object to the beginning of the linked list + HistoryExport%next => HistoryConfig%HistoryExportsList%head + HistoryConfig%HistoryExportsList%head => HistoryExport + + ! Update # of list items + HistoryConfig%HistoryExportsList%numExports = & + HistoryConfig%HistoryExportsList%numExports + 1 + + END SUBROUTINE Append_HistoryExportsList +!EOC +!------------------------------------------------------------------------------ +! GEOS-Chem Global Chemical Transport Model ! +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: Check_HistoryExportsList +! +! !DESCRIPTION: +!\\ +!\\ +! !INTERFACE: +! + SUBROUTINE Check_HistoryExportsList ( am_I_Root, name, & + ExportsList, found, RC ) +! +! !INPUT PARAMETERS: +! + LOGICAL, INTENT(IN) :: am_I_Root + CHARACTER(LEN=*), INTENT(IN) :: name + TYPE(HistoryExportsListObj), POINTER :: ExportsList +! +! !OUTPUT PARAMETERS: +! + LOGICAL, INTENT(OUT) :: found + INTEGER, INTENT(OUT) :: RC +! +! !REVISION HISTORY: +! 12 Sep 2017 - E. Lundgren - Initial version +! See https://github.com/geoschem/geos-chem for history +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: +! + TYPE(HistoryExportObj), POINTER :: current + + __Iam__('Check_HistoryExportsList (cesmgc_history_mod.F90)') + RC = GC_SUCCESS + + ! Assume not found + found = .False. + + current => ExportsList%head + DO WHILE ( ASSOCIATED( current ) ) + IF ( current%name == name ) THEN + found = .TRUE. + RETURN + ENDIF + current => current%next + ENDDO + current => NULL() + + END SUBROUTINE Check_HistoryExportsList +!EOC +!------------------------------------------------------------------------------ +! GEOS-Chem Global Chemical Transport Model ! +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: HistoryExports_SetServices +! +! !DESCRIPTION: +!\\ +!\\ +! !INTERFACE: +! + SUBROUTINE HistoryExports_SetServices( am_I_Root, config_file, & + HistoryConfig, RC ) +! +! !USES: +! + USE cam_history, only: addfld, add_default, horiz_only + USE Registry_Params_Mod +! +! !INPUT PARAMETERS: +! + LOGICAL, INTENT(IN) :: am_I_Root + CHARACTER(LEN=*), INTENT(IN) :: config_file +! +! !INPUT AND OUTPUT PARAMETERS: +! + +! +! !OUTPUT PARAMETERS: +! + TYPE(HistoryConfigObj), POINTER :: HistoryConfig ! History config object + INTEGER, INTENT(OUT) :: RC +! +! !REMARKS: +! ! +! !REVISION HISTORY: +! 01 Sep 2017 - E. Lundgren - Initial version +! See https://github.com/geoschem/geos-chem for history +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: +! + CHARACTER(LEN=255) :: ErrMsg + TYPE(HistoryExportObj), POINTER :: current + + ! ================================================================ + ! HistoryExports_SetServices begins here + ! ================================================================ + + ! For MAPL/ESMF error handling (defines Iam and STATUS) + __Iam__('HistoryExports_SetServices (cesmgc_history_mod.F90)') + RC = GC_SUCCESS + + ! Create a config object if it does not already exist + IF ( .NOT. ASSOCIATED(HistoryConfig) ) THEN + CALL Init_HistoryConfig( am_I_Root, HistoryConfig, config_file, RC ) + IF ( RC == GC_FAILURE ) THEN + _ASSERT(.FALSE., 'informative message here') + RETURN + ENDIF + ENDIF + + ! Loop over the History Exports list to add one export per item + IF ( am_I_Root ) THEN + WRITE(6,*) " " + WRITE(6,*) "Adding history variables to CAM History State:" + ENDIF + current => HistoryConfig%HistoryExportsList%head + DO WHILE ( ASSOCIATED( current ) ) + IF ( am_I_Root ) PRINT *, "adding export: ", TRIM(current%name) + ! Create an export for this item + IF ( current%rank == 3 ) THEN + IF ( current%vloc == VLocationCenter ) THEN + CALL addfld(trim(current%name), & + (/'lev'/), & + 'I', & + trim(current%units), & + trim(current%long_name) ) + IF ( RC == GC_FAILURE ) THEN + ErrMsg = "Problem adding 3D export for " // TRIM(current%name) + EXIT + ENDIF + ELSEIF ( current%vloc == VLocationEdge ) THEN + CALL addfld(trim(current%name), & + (/'ilev'/), & + 'I', & + trim(current%units), & + trim(current%long_name) ) + ELSE + IF ( am_I_Root ) THEN + PRINT *, "Unknown vertical location for ", & + TRIM(current%name) + ENDIF + ENDIF + ELSEIF ( current%rank == 2 ) THEN + CALL addfld(trim(current%name), & + horiz_only, & + 'I', & + trim(current%units), & + trim(current%long_name) ) + IF ( RC == GC_FAILURE ) THEN + ErrMsg = "Problem adding 2D export for " // TRIM(current%name) + EXIT + ENDIF + ELSE + RC = GC_FAILURE + ErrMsg = "Problem adding export for " // TRIM(current%name) // & + ". Rank is only implemented for 2 or 3!" + EXIT + ENDIF + + current => current%next + ENDDO + current => NULL() + + IF ( RC == GC_FAILURE ) THEN + CALL GC_ERROR( ErrMsg, RC, Iam ) + _ASSERT(.FALSE., 'informative message here') + RETURN + ENDIF + + END SUBROUTINE HistoryExports_SetServices +!EOC +!------------------------------------------------------------------------------ +! GEOS-Chem Global Chemical Transport Model ! +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: CopyGCStates2Exports +! +! !DESCRIPTION: +!\\ +!\\ +! !INTERFACE: +! + SUBROUTINE CopyGCStates2Exports( am_I_Root, Input_Opt, State_Grid, HistoryConfig, LCHNK, RC ) +! +! !USES: +! + USE HCO_Interface_GC_Mod, ONLY : HCOI_GC_WriteDiagn + USE Input_Opt_Mod, ONLY : OptInput + USE State_Grid_Mod, ONLY : GrdState +! +! !INPUT PARAMETERS: +! + LOGICAL, INTENT(IN) :: am_I_Root + TYPE(OptInput), INTENT(IN) :: Input_Opt + TYPE(GrdState), INTENT(IN) :: State_Grid + INTEGER, INTENT(IN) :: LCHNK ! Chunk number for CESM +! +! !INPUT AND OUTPUT PARAMETERS: +! + TYPE(HistoryConfigObj), POINTER :: HistoryConfig ! History config object +! +! !OUTPUT PARAMETERS: +! + INTEGER, INTENT(OUT) :: RC +! +! !REMARKS: +! ! +! !REVISION HISTORY: +! 01 Sep 2017 - E. Lundgren - Initial version +! See https://github.com/geoschem/geos-chem for history +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: +! + INTEGER :: LMAX + CHARACTER(LEN=255) :: ErrMsg + TYPE(HistoryExportObj), POINTER :: current + + ! ================================================================ + ! CopyGCStates2Exports begins here + ! ================================================================ + __Iam__('CopyGCStates2Exports (cesmgc_history_mod.F90)') + RC = GC_SUCCESS + + ! Loop over the History Exports list + current => HistoryConfig%HistoryExportsList%head + DO WHILE ( ASSOCIATED( current ) ) + + ! if (MAPL_Am_I_Root()) THEN + ! print *, ' Copying ' // TRIM(current%name) + ! endif + IF ( current%rank == 2 ) THEN + IF ( ASSOCIATED( current%GCStateData2d ) ) THEN + current%ExportData2d(:,1:State_Grid%NY) = current%GCStateData2d(:,1:State_Grid%NY) + ELSE IF ( ASSOCIATED( current%GCStateData2d_4 ) ) THEN + current%ExportData2d(:,1:State_Grid%NY) = current%GCStateData2d_4(:,1:State_Grid%NY) + ELSE IF ( ASSOCIATED( current%GCStateData2d_8 ) ) THEN + current%ExportData2d(:,1:State_Grid%NY) = current%GCStateData2d_8(:,1:State_Grid%NY) + ELSE IF ( ASSOCIATED( current%GCStateData2d_I ) ) THEN + ! Convert integer to float (integers not allowed in MAPL exports) + current%ExportData2d(:,1:State_Grid%NY) = FLOAT(current%GCStateData2d_I(:,1:State_Grid%NY)) + ELSE + RC = GC_FAILURE + ErrMsg = "No GC 2D pointer found for " // TRIM(current%name) + EXIT + ENDIF + + ! Now call outfld to output for this chunk + call outfld(trim(current%name), & + current%ExportData2d(1, 1:State_Grid%NY), & ! Chunk width always 1 + State_Grid%NY, & + LCHNK ) + ELSEIF ( current%rank == 3 ) THEN + IF ( ASSOCIATED( current%GCStateData3d ) ) THEN + current%ExportData3d(:,1:State_Grid%NY,:) = current%GCStateData3d(:,1:State_Grid%NY,:) + ELSE IF ( ASSOCIATED( current%GCStateData3d_4 ) ) THEN + current%ExportData3d(:,1:State_Grid%NY,:) = current%GCStateData3d_4(:,1:State_Grid%NY,:) + ELSE IF ( ASSOCIATED( current%GCStateData3d_8 ) ) THEN + current%ExportData3d(:,1:State_Grid%NY,:) = current%GCStateData3d_8(:,1:State_Grid%NY,:) + ELSE IF ( ASSOCIATED( current%GCStateData3d_I ) ) THEN + current%ExportData3d(:,1:State_Grid%NY,:) = FLOAT(current%GCStateData3d_I(:,1:State_Grid%NY,:)) + ELSE + RC = GC_FAILURE + ErrMsg = "No GC 3D pointer found for " // TRIM(current%name) + EXIT + ENDIF +#if defined( MODEL_GEOS ) || defined( MODEL_CESM ) + ! If using GEOS-5, flip the data vertically to match model + ! convention + ! Also do this in CESM. (hplin, 10/31/22) + LMAX = SIZE(current%ExportData3d, 3) + current%ExportData3d(:,:,1:LMAX) = & + current%ExportData3d(:,:,LMAX:1:-1) +#endif + + ! Now call outfld to output for this chunk + call outfld(trim(current%name), & + current%ExportData3d(1, 1:State_Grid%NY, :), & ! Chunk width always 1. TOA is 1 + State_Grid%NY, & + LCHNK ) + ENDIF + + current => current%next + ENDDO + current => NULL() + + ! Error handling + IF ( RC == GC_FAILURE ) THEN + CALL GC_ERROR( ErrMsg, RC, Iam ) + _ASSERT(.FALSE., 'informative message here') + RETURN + ENDIF + END SUBROUTINE CopyGCStates2Exports +!EOC +!------------------------------------------------------------------------------ +! GEOS-Chem Global Chemical Transport Model ! +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: Print_HistoryExportsList +! +! !DESCRIPTION: +!\\ +!\\ +! !INTERFACE: +! + SUBROUTINE Print_HistoryExportsList( am_I_Root, HistoryConfig, RC ) +! +! !USES: +! +! +! !INPUT PARAMETERS: +! + LOGICAL, INTENT(IN) :: am_I_Root +! +! !INPUT AND OUTPUT PARAMETERS: +! + TYPE(HistoryConfigObj), POINTER :: HistoryConfig ! History config object +! +! !OUTPUT PARAMETERS: +! + INTEGER, INTENT(OUT) :: RC +! +! !REMARKS: +! ! +! !REVISION HISTORY: +! 01 Sep 2017 - E. Lundgren - Initial version +! See https://github.com/geoschem/geos-chem for history +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: +! + TYPE(HistoryExportObj), POINTER :: current + + ! ================================================================ + ! Print_HistoryExportsList begins here + ! ================================================================ + __Iam__('Print_HistoryExportsList (cesmgc_history_mod.F90)') + RC = GC_SUCCESS + + ! Loop over the History Exports list + current => HistoryConfig%HistoryExportsList%head + IF ( am_I_Root ) PRINT *, '===========================' + IF ( am_I_Root ) PRINT *, 'History Exports List:' + IF ( am_I_Root ) PRINT *, ' ' + DO WHILE ( ASSOCIATED( current ) ) + IF ( am_I_Root ) THEN + PRINT *, "Name: ", TRIM(current%name) + PRINT *, " MetadataID: ", TRIM(current%metadataID) + PRINT *, " RegistryID: ", TRIM(current%registryID) + PRINT *, " Long name: ", TRIM(current%long_name) + PRINT *, " Units: ", TRIM(current%units) + PRINT *, " Vert loc: ", current%vloc + PRINT *, " Rank: ", current%rank + PRINT *, " Type: ", current%type + PRINT *, " isMet: ", current%isMet + PRINT *, " isChem: ", current%isChem + PRINT *, " isDiag: ", current%isDiag + IF ( ASSOCIATED( current%ExportData2d )) + PRINT *, " E2D dim'l: ", size(current%ExportData2d) + ENDIF + IF ( ASSOCIATED( current%ExportData3d )) + PRINT *, " E3D dim'l: ", size(current%ExportData3d) + ENDIF + PRINT *, " " + ENDIF + current => current%next + ENDDO + IF ( am_I_Root ) PRINT *, '===========================' + current => NULL() + + END SUBROUTINE Print_HistoryExportsList +!EOC +!------------------------------------------------------------------------------ +! GEOS-Chem Global Chemical Transport Model ! +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: HistoryExports_SetDataPointers +! +! !DESCRIPTION: +!\\ +!\\ +! !INTERFACE: +! + SUBROUTINE HistoryExports_SetDataPointers( am_I_Root, & + HistoryConfig, State_Chm, & + State_Grid, & + State_Diag, State_Met, & + RC ) +! +! !USES: +! + USE Registry_Mod, ONLY : Registry_Lookup + USE State_Grid_Mod, ONLY : GrdState + USE State_Chm_Mod, ONLY : ChmState + USE State_Diag_Mod, ONLY : DgnState + USE State_Met_Mod, ONLY : MetState +! +! !INPUT PARAMETERS: +! + LOGICAL, INTENT(IN) :: am_I_Root +! +! !INPUT AND OUTPUT PARAMETERS: +! + TYPE(HistoryConfigObj), POINTER :: HistoryConfig ! History config obj + TYPE(GrdState), INTENT(INOUT) :: State_Grid ! Grid State obj + TYPE(ChmState), INTENT(INOUT) :: State_Chm ! Chemistry State obj + TYPE(MetState), INTENT(INOUT) :: State_Met ! Meteorology State obj + TYPE(DgnState), INTENT(INOUT) :: State_Diag ! Diagnostics State obj +! +! !OUTPUT PARAMETERS: +! + INTEGER, INTENT(OUT) :: RC +! +! !REMARKS: +! ! +! !REVISION HISTORY: +! 01 Sep 2017 - E. Lundgren - Initial version +! See https://github.com/geoschem/geos-chem for history +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: +! + CHARACTER(LEN=255) :: ErrMsg + TYPE(HistoryExportObj), POINTER :: current + + ! ================================================================ + ! HistoryExports_SetDataPointers begins here + ! ================================================================ + __Iam__('HistoryExports_SetDataPointers') + RC = GC_SUCCESS + + IF ( am_I_Root ) THEN + WRITE(6,*) " " + WRITE(6,*) "Setting history variable pointers to GC and Export States" + ENDIF + + ! Loop over the History Exports list + current => HistoryConfig%HistoryExportsList%head + DO WHILE ( ASSOCIATED( current ) ) + + ! Get pointer to GC state data + !IF ( am_I_Root ) WRITE(6,*) current%name + IF ( current%isMET ) THEN + CALL Registry_Lookup( am_I_Root = am_I_Root, & + Registry = State_Met%Registry, & + RegDict = State_Met%RegDict, & + State = State_Met%State, & + Variable = current%registryID, & + Ptr2d_4 = current%GCStateData2d_4, & + Ptr2d_8 = current%GCStateData2d_8, & + Ptr2d_I = current%GCStateData2d_I, & + Ptr3d_4 = current%GCStateData3d_4, & + Ptr3d_8 = current%GCStateData3d_8, & + Ptr3d_I = current%GCStateData3d_I, & + RC = RC ) + ELSEIF ( current%isChem ) THEN + CALL Registry_Lookup( am_I_Root = am_I_Root, & + Registry = State_Chm%Registry, & + RegDict = State_Chm%RegDict, & + State = State_Chm%State, & + Variable = current%registryID, & + Ptr2d_4 = current%GCStateData2d_4, & + Ptr2d_8 = current%GCStateData2d_8, & + Ptr2d_I = current%GCStateData2d_I, & + Ptr3d_4 = current%GCStateData3d_4, & + Ptr3d_8 = current%GCStateData3d_8, & + Ptr3d_I = current%GCStateData3d_I, & + RC = RC ) + ELSEIF ( current%isDiag ) THEN + CALL Registry_Lookup( am_I_Root = am_I_Root, & + Registry = State_Diag%Registry, & + RegDict = State_Diag%RegDict, & + State = State_Diag%State, & + Variable = current%registryID, & + Ptr2d_4 = current%GCStateData2d_4, & + Ptr2d_8 = current%GCStateData2d_8, & + Ptr2d_I = current%GCStateData2d_I, & + Ptr3d_4 = current%GCStateData3d_4, & + Ptr3d_8 = current%GCStateData3d_8, & + Ptr3d_I = current%GCStateData3d_I, & + RC = RC ) + ENDIF + IF ( RC == GC_FAILURE ) THEN + ErrMsg = "Registry pointer not found for " // TRIM(current%name) // & + ". Check that the tag (e.g. species) is valid " // & + "for this diagnostic." + EXIT + ENDIF + + ! For CESM export, outfld accepts the data pointer directly but it + ! has to be in r8. Thus, allocate a r8 data type in exportData2d or + ! ExportData3d so that the rest of the code can be reused, then + ! update pointer data can just call outfld additionally. There is, + ! however, a memory hit from this. Revisit later. (hplin, 10/31/22) + ! + ! As a side note, in CESM-GC, State_Grid%NX is always 1 since the data + ! is chunkized. Only the State_Grid%NY matters here. + ! + ! Because NY could vary across chunk sizes, allocate one extra column + ! but only read up to the actual :State_Grid%NY. This allows for different + ! instances of GEOS-Chem to share the same ExportData allocation in separate + ! calls to the pointer update subroutine. + IF ( current%rank == 2 ) THEN + IF ( .not. ASSOCIATED(current%ExportData2d) ) THEN + ALLOCATE(current%ExportData2d(State_Grid%NX, State_Grid%NY+1), stat=RC) + ENDIF + ELSEIF ( current%rank == 3 ) THEN + IF ( .not. ASSOCIATED(current%ExportData3d) ) THEN + IF ( current%vloc == VLocationCenter ) THEN + ALLOCATE(current%ExportData2d(State_Grid%NX, State_Grid%NY+1, State_Grid%NZ ), stat=RC) + ELSEIF ( current%vloc == VLocationEdge ) THEN + ALLOCATE(current%ExportData2d(State_Grid%NX, State_Grid%NY+1, State_Grid%NZ+1), stat=RC) + ENDIF + ENDIF + + !! debugging + !IF ( Am_I_Root) THEN + ! WRITE(6,*) TRIM(current%name) + !ENDIF + + current => current%next + ENDDO + current => NULL() + + IF ( RC == GC_FAILURE ) THEN + CALL GC_ERROR( ErrMsg, RC, Iam ) + _ASSERT(.FALSE., 'informative message here') + RETURN + ENDIF + + END SUBROUTINE HistoryExports_SetDataPointers +!EOC +!------------------------------------------------------------------------------ +! GEOS-Chem Global Chemical Transport Model ! +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: Destroy_HistoryConfig +! +! !DESCRIPTION: Subroutine Destroy_HistoryConfig deallocates a HistoryConfig +! object and all of its member objects including the linked list of +! HistoryExport objects. +!\\ +!\\ +! !INTERFACE: +! + SUBROUTINE Destroy_HistoryConfig ( am_I_Root, HistoryConfig, RC ) +! +! !INPUT PARAMETERS: +! + LOGICAL, INTENT(IN) :: am_I_Root ! root CPU? + TYPE(HistoryConfigObj), POINTER :: HistoryConfig +! +! !INPUT/OUTPUT PARAMETERS: +! + INTEGER, INTENT(INOUT) :: RC ! Success? +! +! !REVISION HISTORY: +! 01 Sep 2017 - E. Lundgren - Initial version +! See https://github.com/geoschem/geos-chem for history +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: +! + TYPE(HistoryExportObj), POINTER :: current + TYPE(HistoryExportObj), POINTER :: next + + ! ================================================================ + ! Destroy_HistoryConfig begins here + ! ================================================================ + __Iam__('Destroy_HistoryConfig (cesmgc_history_mod.F90)') + + current => NULL() + next => NULL() + + ! Destroy each item in the linked list of HistoryExport objects + current => HistoryConfig%HistoryExportsList%head + IF ( ASSOCIATED( current ) ) next => current%next + DO WHILE ( ASSOCIATED( current ) ) + ! Clean up the temporary array used for exports as well + IF ( ASSOCIATED( current%ExportData2d ) ) THEN + DEALLOCATE ( current%ExportData2d, stat=RC ) + ENDIF + + IF ( ASSOCIATED( current%ExportData3d ) ) THEN + DEALLOCATE ( current%ExportData3d, stat=RC ) + ENDIF + + DEALLOCATE( current, STAT=RC ) + _ASSERT( RC == GC_SUCCESS, 'informative message here' ) + IF ( .NOT. ASSOCIATED ( next ) ) EXIT + current => next + next => current%next + ENDDO + + ! Deallocate the HistoryExportsList object + DEALLOCATE( HistoryConfig%HistoryExportsList, STAT=RC ) + _ASSERT( RC == GC_SUCCESS, 'informative message here' ) + + ! Deallocate the HistoryConfig object + DEALLOCATE( HistoryConfig, STAT=RC ) + _ASSERT( RC == GC_SUCCESS, 'informative message here' ) + + ! Final cleanup + current => NULL() + next => NULL() + + END SUBROUTINE Destroy_HistoryConfig +!EOC +END MODULE CESMGC_History_Mod \ No newline at end of file diff --git a/src/chemistry/geoschem/chemistry.F90 b/src/chemistry/geoschem/chemistry.F90 index 9a552861ee..08ddc61030 100644 --- a/src/chemistry/geoschem/chemistry.F90 +++ b/src/chemistry/geoschem/chemistry.F90 @@ -34,6 +34,11 @@ module chemistry use chem_mods, only : nSlvd, slvd_Lst, slvd_ref_MMR + !-------------------------------------------------------------------- + ! GEOS-Chem History exports module + !-------------------------------------------------------------------- + use CESMGC_History_Mod + !-------------------------------------------------------------------- ! CAM modules !-------------------------------------------------------------------- @@ -110,6 +115,8 @@ module chemistry TYPE(DgnList ) :: Diag_List ! Diagnostics list object TYPE(TaggedDgnList ) :: TaggedDiag_List ! Tagged diagnostics list object + TYPE(HistoryConfigObj), POINTER :: HistoryConfig ! HistoryConfig object for History diagn. + type(physics_buffer_desc), pointer :: hco_pbuf2d(:,:) ! Pointer to 2D pbuf ! Mimic code in sfcvmr_mod.F90 @@ -1391,6 +1398,21 @@ subroutine chem_init(phys_state, pbuf2d) CALL Print_TaggedDiagList( Input_Opt%amIRoot, TaggedDiag_List, RC ) ENDIF + ! There are actually two copies of the history configuration, one is contained + ! within HistoryConfig to mimic the properties of GCHP. + ! + ! The above original implementation is similar to GC-Classic and WRF-GC + ! (hplin, 10/31/22) + CALL HistoryExports_SetServices(am_I_Root = masterproc, & + config_file = historyConfigFile, & + HistoryConfig = HistoryConfig, & + RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "HistoryExports_SetServices"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + DO I = BEGCHUNK, ENDCHUNK Input_Opt%amIRoot = (MasterProc .AND. (I == BEGCHUNK)) @@ -2020,6 +2042,7 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) INTEGER :: IERR INTEGER, SAVE :: iStep = 0 + LOGICAL, SAVE :: FIRST = .TRUE. LOGICAL :: rootChunk LOGICAL :: lastChunk INTEGER :: RC @@ -4116,6 +4139,23 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) mmr_tend = mmr_tend, & LCHNK = LCHNK ) + ! Compute new GEOS-Chem diagnostics into CESM History (hplin, 10/31/22) + IF ( FIRST ) THEN + CALL HistoryExports_SetDataPointers(rootChunk, & + HistoryConfig, State_Chm(LCHNK), & + State_Grid(LCHNK), & + State_Diag(LCHNK), State_Met(LCHNK), & + RC) + FIRST = .false. + ENDIF + + CALL CopyGCStates2Exports( am_I_Root = rootChunk, & + Input_Opt = Input_Opt, & + State_Grid = State_Grid(LCHNK), & + HistoryConfig = HistoryConfig, & + LCHNK = LCHNK, & + RC = RC ) + IF ( ghg_chem ) THEN ptend%lq(1) = .True. CALL outfld( 'CT_H2O_GHG', ptend%q(:,:,1), PCOLS, LCHNK ) @@ -4217,6 +4257,9 @@ subroutine chem_final ! Local variables INTEGER :: I, RC + ! Destroy the history interface between GC States and CAM exports + CALL Destroy_HistoryConfig(masterproc, HistoryConfig, RC) + ! Finalize GEOS-Chem CALL Cleanup_UCX From 5cac78c863c812a393b15749ea8e4eff66b42698 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Tue, 1 Nov 2022 10:58:59 -0600 Subject: [PATCH 061/291] Disable legacy Jval_ approach; new history diags with debug (wip) --- src/chemistry/geoschem/cesmgc_diag_mod.F90 | 129 +++++++++--------- src/chemistry/geoschem/cesmgc_history_mod.F90 | 26 ++-- 2 files changed, 84 insertions(+), 71 deletions(-) diff --git a/src/chemistry/geoschem/cesmgc_diag_mod.F90 b/src/chemistry/geoschem/cesmgc_diag_mod.F90 index 0a9201cb83..1bcd7f6d04 100644 --- a/src/chemistry/geoschem/cesmgc_diag_mod.F90 +++ b/src/chemistry/geoschem/cesmgc_diag_mod.F90 @@ -452,33 +452,34 @@ SUBROUTINE CESMGC_Diag_Init( Input_Opt, State_Chm, State_Met ) CALL Error_Stop( ErrMsg, ThisLoc ) ENDIF - DO M = 1, nPhotol - CALL get_TagInfo( Input_Opt = Input_Opt, & - tagID = 'PHO', & - State_Chm = State_Chm, & - Found = Found, & - RC = RC, & - N = M, & - tagName = tagName ) - - ! Trap potential errors - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Abnormal exit from routine "Get_TagInfo"!' - CALL Error_Stop( ErrMsg, ThisLoc ) - ENDIF - - SpcName = 'Jval_' // TRIM( tagName ) - CALL Addfld( TRIM(SpcName), (/ 'lev' /), 'A', '1/s', & - TRIM(tagName) // ' photolysis rate' ) - ENDDO - ! Add JvalO3O1D and JvalO3O3P - SpcName = 'JvalO3O1D' - CALL Addfld( TRIM(SpcName), (/ 'lev' /), 'A', '1/s', & - 'O3 -> O1D photolysis rate' ) - - SpcName = 'JvalO3O3P' - CALL Addfld( TRIM(SpcName), (/ 'lev' /), 'A', '1/s', & - 'O3 -> O3P photolysis rate' ) + ! Remove as superceded + ! DO M = 1, nPhotol + ! CALL get_TagInfo( Input_Opt = Input_Opt, & + ! tagID = 'PHO', & + ! State_Chm = State_Chm, & + ! Found = Found, & + ! RC = RC, & + ! N = M, & + ! tagName = tagName ) + + ! ! Trap potential errors + ! IF ( RC /= GC_SUCCESS ) THEN + ! ErrMsg = 'Abnormal exit from routine "Get_TagInfo"!' + ! CALL Error_Stop( ErrMsg, ThisLoc ) + ! ENDIF + + ! SpcName = 'Jval_' // TRIM( tagName ) + ! CALL Addfld( TRIM(SpcName), (/ 'lev' /), 'A', '1/s', & + ! TRIM(tagName) // ' photolysis rate' ) + ! ENDDO + ! ! Add JvalO3O1D and JvalO3O3P + ! SpcName = 'JvalO3O1D' + ! CALL Addfld( TRIM(SpcName), (/ 'lev' /), 'A', '1/s', & + ! 'O3 -> O1D photolysis rate' ) + + ! SpcName = 'JvalO3O3P' + ! CALL Addfld( TRIM(SpcName), (/ 'lev' /), 'A', '1/s', & + ! 'O3 -> O3P photolysis rate' ) ! ========================================== ! Now add fields corresponding to State_Met @@ -1482,42 +1483,44 @@ SUBROUTINE CESMGC_Diag_Calc( Input_Opt, State_Chm, State_Diag, & ! Diagnose photolysis rates ! =============================================== - IF ( ASSOCIATED(State_Diag%Jval) ) THEN - DO M = 1, nPhotol - CALL get_TagInfo( Input_Opt = Input_Opt, & - tagID = 'PHO', & - State_Chm = State_Chm, & - Found = Found, & - RC = RC, & - N = M, & - tagName = tagName ) - - ! Trap potential errors - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Abnormal exit from routine "Get_TagInfo"!' - CALL Error_Stop( ErrMsg, ThisLoc ) - ENDIF - - SpcName = 'Jval_' // TRIM( tagName ) - IF ( .NOT. hist_fld_active(TRIM(SpcName)) ) CYCLE - outTmp(:nY,:nZ) = REAL(State_Diag%Jval(1,:nY,nZ:1:-1,M),r8) - CALL OutFld( TRIM(SpcName), outTmp(:nY,:), nY, LCHNK ) - ENDDO - ENDIF - IF ( ASSOCIATED(State_Diag%JvalO3O1D) ) THEN - SpcName = 'JvalO3O1D' - IF ( hist_fld_active(TRIM(SpcName)) ) THEN - outTmp(:nY,:nZ) = REAL(State_Diag%JvalO3O1D(1,:nY,nZ:1:-1),r8) - CALL OutFld( TRIM(SpcName), outTmp(:nY,:), nY, LCHNK ) - ENDIF - ENDIF - IF ( ASSOCIATED(State_Diag%JvalO3O3P) ) THEN - SpcName = 'JvalO3O3P' - IF ( hist_fld_active(TRIM(SpcName)) ) THEN - outTmp(:nY,:nZ) = REAL(State_Diag%JvalO3O3P(1,:nY,nZ:1:-1),r8) - CALL OutFld( TRIM(SpcName), outTmp(:nY,:), nY, LCHNK ) - ENDIF - ENDIF + ! Disable as superceded by cesmgc_history_mod.F90 (hplin, 10/31/22) + + ! IF ( ASSOCIATED(State_Diag%Jval) ) THEN + ! DO M = 1, nPhotol + ! CALL get_TagInfo( Input_Opt = Input_Opt, & + ! tagID = 'PHO', & + ! State_Chm = State_Chm, & + ! Found = Found, & + ! RC = RC, & + ! N = M, & + ! tagName = tagName ) + + ! ! Trap potential errors + ! IF ( RC /= GC_SUCCESS ) THEN + ! ErrMsg = 'Abnormal exit from routine "Get_TagInfo"!' + ! CALL Error_Stop( ErrMsg, ThisLoc ) + ! ENDIF + + ! SpcName = 'Jval_' // TRIM( tagName ) + ! IF ( .NOT. hist_fld_active(TRIM(SpcName)) ) CYCLE + ! outTmp(:nY,:nZ) = REAL(State_Diag%Jval(1,:nY,nZ:1:-1,M),r8) + ! CALL OutFld( TRIM(SpcName), outTmp(:nY,:), nY, LCHNK ) + ! ENDDO + ! ENDIF + ! IF ( ASSOCIATED(State_Diag%JvalO3O1D) ) THEN + ! SpcName = 'JvalO3O1D' + ! IF ( hist_fld_active(TRIM(SpcName)) ) THEN + ! outTmp(:nY,:nZ) = REAL(State_Diag%JvalO3O1D(1,:nY,nZ:1:-1),r8) + ! CALL OutFld( TRIM(SpcName), outTmp(:nY,:), nY, LCHNK ) + ! ENDIF + ! ENDIF + ! IF ( ASSOCIATED(State_Diag%JvalO3O3P) ) THEN + ! SpcName = 'JvalO3O3P' + ! IF ( hist_fld_active(TRIM(SpcName)) ) THEN + ! outTmp(:nY,:nZ) = REAL(State_Diag%JvalO3O3P(1,:nY,nZ:1:-1),r8) + ! CALL OutFld( TRIM(SpcName), outTmp(:nY,:), nY, LCHNK ) + ! ENDIF + ! ENDIF ! =============================================== ! Diagnose fields corresponding to State_Met diff --git a/src/chemistry/geoschem/cesmgc_history_mod.F90 b/src/chemistry/geoschem/cesmgc_history_mod.F90 index 88f8d2d25b..0af0d1b830 100644 --- a/src/chemistry/geoschem/cesmgc_history_mod.F90 +++ b/src/chemistry/geoschem/cesmgc_history_mod.F90 @@ -1,4 +1,4 @@ -#define ASSERT_(cond,msg) if(.not.cond) then; print *, "assertion error: ", Iam, __LINE__; call endrun("assertion error - look above - in cesmgc_history_mod.F90"); endif +#define _ASSERT(cond,msg) if(.not.cond) then; print *, "assertion error: ", Iam, __LINE__; call endrun("assertion error - look above - in cesmgc_history_mod.F90"); endif #define _Iam_(name) character(len=255) :: Iam=name #define __Iam__(name) integer :: STATUS; _Iam_(name) ! Above are compatibility shorthands to avoid excessive divergence from @@ -90,8 +90,8 @@ MODULE CESMGC_History_Mod ! Pointers to ESMF Export and GEOS-Chem State ! TODO: for now, include all possible data types in the registry. - REAL, POINTER :: ExportData2d(:,:) - REAL, POINTER :: ExportData3d(:,:,:) + REAL(f8), POINTER :: ExportData2d(:,:) + REAL(f8), POINTER :: ExportData3d(:,:,:) REAL(fp), POINTER :: GCStateData0d REAL(fp), POINTER :: GCStateData1d(:) REAL(fp), POINTER :: GCStateData2d(:,:) @@ -185,7 +185,7 @@ SUBROUTINE Init_HistoryConfig ( am_I_Root, HistoryConfig, configFile, RC ) ENDIF ! Optional debugging - CALL Print_HistoryExportsList( am_I_Root, HistoryConfig, RC ) + ! CALL Print_HistoryExportsList( am_I_Root, HistoryConfig, RC ) END SUBROUTINE Init_HistoryConfig !EOC @@ -779,6 +779,8 @@ SUBROUTINE CopyGCStates2Exports( am_I_Root, Input_Opt, State_Grid, HistoryConfig USE HCO_Interface_GC_Mod, ONLY : HCOI_GC_WriteDiagn USE Input_Opt_Mod, ONLY : OptInput USE State_Grid_Mod, ONLY : GrdState + + USE cam_history, ONLY : outfld ! ! !INPUT PARAMETERS: ! @@ -820,6 +822,8 @@ SUBROUTINE CopyGCStates2Exports( am_I_Root, Input_Opt, State_Grid, HistoryConfig current => HistoryConfig%HistoryExportsList%head DO WHILE ( ASSOCIATED( current ) ) + write(6,*) "copying", current%name, current%rank + ! if (MAPL_Am_I_Root()) THEN ! print *, ' Copying ' // TRIM(current%name) ! endif @@ -952,10 +956,10 @@ SUBROUTINE Print_HistoryExportsList( am_I_Root, HistoryConfig, RC ) PRINT *, " isMet: ", current%isMet PRINT *, " isChem: ", current%isChem PRINT *, " isDiag: ", current%isDiag - IF ( ASSOCIATED( current%ExportData2d )) + IF ( ASSOCIATED( current%ExportData2d )) THEN PRINT *, " E2D dim'l: ", size(current%ExportData2d) ENDIF - IF ( ASSOCIATED( current%ExportData3d )) + IF ( ASSOCIATED( current%ExportData3d )) THEN PRINT *, " E3D dim'l: ", size(current%ExportData3d) ENDIF PRINT *, " " @@ -992,6 +996,7 @@ SUBROUTINE HistoryExports_SetDataPointers( am_I_Root, & USE State_Chm_Mod, ONLY : ChmState USE State_Diag_Mod, ONLY : DgnState USE State_Met_Mod, ONLY : MetState + USE Registry_Params_Mod ! ! !INPUT PARAMETERS: ! @@ -1107,10 +1112,11 @@ SUBROUTINE HistoryExports_SetDataPointers( am_I_Root, & ELSEIF ( current%rank == 3 ) THEN IF ( .not. ASSOCIATED(current%ExportData3d) ) THEN IF ( current%vloc == VLocationCenter ) THEN - ALLOCATE(current%ExportData2d(State_Grid%NX, State_Grid%NY+1, State_Grid%NZ ), stat=RC) + ALLOCATE(current%ExportData3d(State_Grid%NX, State_Grid%NY+1, State_Grid%NZ ), stat=RC) ELSEIF ( current%vloc == VLocationEdge ) THEN - ALLOCATE(current%ExportData2d(State_Grid%NX, State_Grid%NY+1, State_Grid%NZ+1), stat=RC) + ALLOCATE(current%ExportData3d(State_Grid%NX, State_Grid%NY+1, State_Grid%NZ+1), stat=RC) ENDIF + ENDIF ENDIF !! debugging @@ -1122,6 +1128,10 @@ SUBROUTINE HistoryExports_SetDataPointers( am_I_Root, & ENDDO current => NULL() + ! Optional debugging + WRITE(6,*) "hplin debug: after HistoryExports_SetDataPointers" + CALL Print_HistoryExportsList( am_I_Root, HistoryConfig, RC ) + IF ( RC == GC_FAILURE ) THEN CALL GC_ERROR( ErrMsg, RC, Iam ) _ASSERT(.FALSE., 'informative message here') From 3f0e7253f7110fdf5f574f77912966a72826386d Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Tue, 1 Nov 2022 13:03:42 -0600 Subject: [PATCH 062/291] Fix diagnostic chunk bug; now functional --- src/chemistry/geoschem/cesmgc_history_mod.F90 | 18 ++++++++++++---- src/chemistry/geoschem/chemistry.F90 | 21 ++++++++++++------- 2 files changed, 27 insertions(+), 12 deletions(-) diff --git a/src/chemistry/geoschem/cesmgc_history_mod.F90 b/src/chemistry/geoschem/cesmgc_history_mod.F90 index 0af0d1b830..bd147c82a6 100644 --- a/src/chemistry/geoschem/cesmgc_history_mod.F90 +++ b/src/chemistry/geoschem/cesmgc_history_mod.F90 @@ -780,7 +780,7 @@ SUBROUTINE CopyGCStates2Exports( am_I_Root, Input_Opt, State_Grid, HistoryConfig USE Input_Opt_Mod, ONLY : OptInput USE State_Grid_Mod, ONLY : GrdState - USE cam_history, ONLY : outfld + USE cam_history, ONLY : hist_fld_active, outfld ! ! !INPUT PARAMETERS: ! @@ -821,10 +821,13 @@ SUBROUTINE CopyGCStates2Exports( am_I_Root, Input_Opt, State_Grid, HistoryConfig ! Loop over the History Exports list current => HistoryConfig%HistoryExportsList%head DO WHILE ( ASSOCIATED( current ) ) + ! Skip if not active + if(.not. hist_fld_active(trim(current%name))) then + current => current%next + cycle + endif - write(6,*) "copying", current%name, current%rank - - ! if (MAPL_Am_I_Root()) THEN + ! if (am_I_Root) THEN ! print *, ' Copying ' // TRIM(current%name) ! endif IF ( current%rank == 2 ) THEN @@ -997,6 +1000,8 @@ SUBROUTINE HistoryExports_SetDataPointers( am_I_Root, & USE State_Diag_Mod, ONLY : DgnState USE State_Met_Mod, ONLY : MetState USE Registry_Params_Mod + + use cam_history, only: hist_fld_active ! ! !INPUT PARAMETERS: ! @@ -1042,6 +1047,11 @@ SUBROUTINE HistoryExports_SetDataPointers( am_I_Root, & ! Loop over the History Exports list current => HistoryConfig%HistoryExportsList%head DO WHILE ( ASSOCIATED( current ) ) + ! Skip if not active + if(.not. hist_fld_active(trim(current%name))) then + current => current%next + cycle + endif ! Get pointer to GC state data !IF ( am_I_Root ) WRITE(6,*) current%name diff --git a/src/chemistry/geoschem/chemistry.F90 b/src/chemistry/geoschem/chemistry.F90 index 08ddc61030..384ba73d0e 100644 --- a/src/chemistry/geoschem/chemistry.F90 +++ b/src/chemistry/geoschem/chemistry.F90 @@ -4140,14 +4140,16 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) LCHNK = LCHNK ) ! Compute new GEOS-Chem diagnostics into CESM History (hplin, 10/31/22) - IF ( FIRST ) THEN - CALL HistoryExports_SetDataPointers(rootChunk, & - HistoryConfig, State_Chm(LCHNK), & - State_Grid(LCHNK), & - State_Diag(LCHNK), State_Met(LCHNK), & - RC) - FIRST = .false. - ENDIF + ! Note that the containers (data pointers) actually need to be updated every time step, + ! because the State_Chm(LCHNK) target changes. There is some registry lookup overhead + ! but mitigated by a check to the history field activeness. (hplin, 11/1/22) + ! + ! An alternative is to have multiple HistoryConfig... will make alternative implementation + CALL HistoryExports_SetDataPointers(rootChunk, & + HistoryConfig, State_Chm(LCHNK), & + State_Grid(LCHNK), & + State_Diag(LCHNK), State_Met(LCHNK), & + RC) CALL CopyGCStates2Exports( am_I_Root = rootChunk, & Input_Opt = Input_Opt, & @@ -4188,6 +4190,9 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) IF ( rootChunk ) WRITE(iulog,*) ' GEOS-Chem Chemistry step ', iStep, ' completed' IF ( lastChunk ) WRITE(iulog,*) ' Chemistry completed on all chunks completed of MasterProc' + IF ( FIRST ) THEN + FIRST = .false. + ENDIF end subroutine chem_timestep_tend From 23a2ca72261c9ff60c347464bfb896ceea59f8f2 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Thu, 3 Nov 2022 11:44:15 -0600 Subject: [PATCH 063/291] Update HEMCO external to 3.5.1 --- Externals_CAM.cfg | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Externals_CAM.cfg b/Externals_CAM.cfg index 43066f7169..0ef34d69c8 100644 --- a/Externals_CAM.cfg +++ b/Externals_CAM.cfg @@ -77,7 +77,7 @@ local_path = src/chemistry/geoschem/geoschem_src required = True [hemco] -tag = hemco-cesm1_0_hemco_3_5_0 +tag = hemco-cesm1_0_hemco_3_5_1 protocol = git repo_url = https://github.com/ESCOMP/HEMCO_CESM.git local_path = src/hemco From 73b1cc2638559fb019c5a5e8d54ef507b2d61453 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Thu, 3 Nov 2022 11:49:15 -0600 Subject: [PATCH 064/291] Add FCnudged_GC component set based on FCnudged. --- cime_config/config_compsets.xml | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/cime_config/config_compsets.xml b/cime_config/config_compsets.xml index 93bb88ec3b..6206142da2 100644 --- a/cime_config/config_compsets.xml +++ b/cime_config/config_compsets.xml @@ -539,6 +539,11 @@ HIST_CAM60%GC%SDYN_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV + + FCnudged_GC + HIST_CAM60%GC%NUDG_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV + + From babae9fd0e7c28f763afd9a006fecb705193a452 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Thu, 3 Nov 2022 13:03:39 -0600 Subject: [PATCH 065/291] Add hist_geoschem_nudged.xml configuration for FCnudged_GC --- .../use_cases/hist_geoschem_nudged.xml | 236 ++++++++++++++++++ cime_config/config_component.xml | 1 + 2 files changed, 237 insertions(+) create mode 100644 bld/namelist_files/use_cases/hist_geoschem_nudged.xml diff --git a/bld/namelist_files/use_cases/hist_geoschem_nudged.xml b/bld/namelist_files/use_cases/hist_geoschem_nudged.xml new file mode 100644 index 0000000000..1bf8d90874 --- /dev/null +++ b/bld/namelist_files/use_cases/hist_geoschem_nudged.xml @@ -0,0 +1,236 @@ + + + + + + + + +/glade/p/univ/umit0034/ExtData/CHEM_INPUTS/ + +/glade/p/univ/umit0034/Shared/GEOS-Chem/f.e20.FC2010.f09_f09.144.GC_vbsext.001.cam.i.0007-01-01-00000.nc + +/glade/p/univ/umit0034/Shared/GEOS-Chem/f.e20.FC2010.f19_f19.144.GC_vbsext.001.cam.i.0007-01-01-00000.nc + +/glade/u/home/elundgren/drydep_henrys_law_nc/dep_data_file_geoschem.nc + + + +00010101 + + +atm/cam/solar/SolarForcingCMIP6_18491230-23000102_c20200615.nc + + +.true. +.true. +.false. +0.25D0 + +SERIAL +atm/waccm/lb/LBC_1750-2014_CMIP6_0p5degLat_c170126.nc + +SERIAL + +'noy', 'nhx' + + + +.true. +'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_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 +4 +8 + +48 +384 +1 +0.06 +1 +0.06 +1 +0.06 +0 +0.00 +0 +0.00 +2010 +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. + + + + +'ACET','ACTA','ALD2','AROMP4','AROMP5','ATOOH','BALD','BENZP','BR2','BRCL','BRNO3','BZCO3H','BZPAN','CH2O','CL2','CLNO2','CLNO3','CLO','CLOO','CSL','EOH','ETHLN','ETHN','ETHP','ETNO3','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HI','HMHP','HMML','HNO3','HOBR','HOCL','HOI','HONIT','HPALD1','HPALD2','HPALD3','HPALD4','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDC','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','IPRNO3','ITCN','ITHN','LIMO','LVOC','LVOCOA','MACR','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MCT','MENO3','MGLY','MOH','MONITS','MONITU','MPAN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','N2O5','NH3','NO2','NPHEN','NPRNO3','O3','PAN','PHEN','PP','PPN','PROPNN','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2' + + + + +'ACTA','ALD2','AROMP4','AROMP5','ATOOH','BALD','BENZP','BR2','BRCL','BZCO3H','BZPAN','CH2O','CSL','EOH','ETHLN','ETHN','ETHP','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HI','HMHP','HMML','HNO3','HOBR','HOCL','HOI','HONIT','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','ITCN','ITHN','LIMO','LVOC','LVOCOA','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MCT','MEK','MGLY','MOH','MONITS','MONITU','MP','MPAN','MPN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','NH3','NPHEN','PAN','PHEN','PP','PPN','PROPNN','PRPE','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2' + + + +'dst_a1','so4_a1','nh4_a1','pom_a1','pomff1_a1','pombb1_a1','soa_a1','bc_a1','ncl_a1','num_a1','so4_a2','nh4_a2','soa_a2','ncl_a2','dst_a2','num_a2','dst_a3','ncl_a3','so4_a3','pom_a3','bc_a3','num_a3','ncl_a4','so4_a4','pom_a4','pomff1_a4','pombb1_a4','bc_a4','nh4_a4','num_a4','dst_a5','so4_a5','nh4_a5','num_a5','ncl_a6','so4_a6','nh4_a6','num_a6','dst_a7','so4_a7','nh4_a7','num_a7','soa1_a1','soa1_a2','soa2_a1','soa2_a2','soa3_a1','soa3_a2','soa4_a1','soa4_a2','soa5_a1','soa5_a2','soaff1_a1','soaff2_a1','soaff3_a1','soaff4_a1','soaff5_a1','soabb1_a1','soabb2_a1','soabb3_a1','soabb4_a1','soabb5_a1','soabg1_a1','soabg2_a1','soabg3_a1','soabg4_a1','soabg5_a1','soaff1_a2','soaff2_a2','soaff3_a2','soaff4_a2','soaff5_a2','soabb1_a2','soabb2_a2','soabb3_a2','soabb4_a2','soabb5_a2','soabg1_a2','soabg2_a2','soabg3_a2','soabg4_a2','soabg5_a2' + + + +'dst_a1','so4_a1','nh4_a1','pom_a1','pomff1_a1','pombb1_a1','soa_a1','bc_a1','ncl_a1','num_a1','so4_a2','nh4_a2','soa_a2','ncl_a2','dst_a2','num_a2','dst_a3','ncl_a3','so4_a3','pom_a3','bc_a3','num_a3','ncl_a4','so4_a4','pom_a4','pomff1_a4','pombb1_a4','bc_a4','nh4_a4','num_a4','dst_a5','so4_a5','nh4_a5','num_a5','ncl_a6','so4_a6','nh4_a6','num_a6','dst_a7','so4_a7','nh4_a7','num_a7','soa1_a1','soa1_a2','soa2_a1','soa2_a2','soa3_a1','soa3_a2','soa4_a1','soa4_a2','soa5_a1','soa5_a2','soaff1_a1','soaff2_a1','soaff3_a1','soaff4_a1','soaff5_a1','soabb1_a1','soabb2_a1','soabb3_a1','soabb4_a1','soabb5_a1','soabg1_a1','soabg2_a1','soabg3_a1','soabg4_a1','soabg5_a1','soaff1_a2','soaff2_a2','soaff3_a2','soaff4_a2','soaff5_a2','soabb1_a2','soabb2_a2','soabb3_a2','soabb4_a2','soabb5_a2','soabg1_a2','soabg2_a2','soabg3_a2','soabg4_a2','soabg5_a2' + + + + + + 1,30,365,240,240,480,365,73,30 + 0,-24,-24,-3,-1,1,-24,-120,-240 +'A','A','A','A','A','A','A','A','I' + +.true. +.false. +.false. +.false. +.false. +.false. +.false. +.false. +.false. + + + + + 'AODDUST', 'AODDUST2', 'T', 'U', 'V', 'O3', 'OH', 'NO3', 'HO2', + 'LNO_COL_PROD', 'NO2_CLXF', 'SFNO', 'SFNH3', 'BRO', + 'CH3CL', 'CLO', 'CO2', 'HCL', 'HO2', 'HOCL', 'PHIS', 'Z3', + 'BENZ', 'C2H6', 'C3H8', 'CCL4', 'CFC11', 'CFC113', 'CFC12', + 'CH2O', 'CH3BR', 'CH3CCL3', 'ALD2', 'CH3CL', 'ACET', 'MOH', 'CH4', + 'CO', 'H2O2', 'HCFC22', 'HNO3', 'ISOP', 'MTPA', 'N2O', 'O3', + 'PAN', 'SO2', 'OH', 'ALK4', 'PRPE', 'BR', 'BRCL', 'BRO', 'BRNO3', + 'EOH', 'ETP', 'PRPE', 'RA3P', 'CCL4', 'H1211', 'H1301', + 'CFC11', 'CFC113', 'CFC114', 'CFC115', 'CFC12', 'CH2BR2', 'CH2O', + 'CH3BR', 'CH3CCL3', 'ALD2', 'CH3CL', 'MGLY', 'ACTA', 'MAP', 'MP', + 'CH4', 'CHBR3', 'CL', 'CL2', 'CL2O2', 'CLO', 'CLNO3', 'CO', + 'CO2', 'DMS', 'GLYC', 'GLYX', + 'H', 'H2', 'H2402', 'H2O2', 'HBR', 'HCFC141B', 'HCFC142B', 'HCFC22', + 'HCL', 'HNO3', 'HNO4', 'HOBR', 'HOCL', 'HONIT', 'HPALD1', 'HPALD2', 'HPALD3', + 'HPALD4', 'HAC', 'HC5A', 'IEPOXA', 'IEPOXB', 'IEPOXD', 'ISOP', 'IHN1', 'IHN2', 'IHN3', + 'IHN4', 'INO2B', 'INO2D', 'INPB', 'INPD', 'RIPA', 'RIPB', 'RIPC', 'RIPD', + 'MACR', 'MVKHP', 'MEK', 'MCRDH', 'MPAN', 'MVK', 'N', 'N2O', 'N2O5', 'ICN', + 'NH3', 'NH4', 'NO', 'NO2', 'NO3', 'PROPNN', 'OLND', 'OLNN', 'O', 'OCLO', + 'OCS', 'PAN', 'SO2', 'SO4', 'TOLU', 'XYLE', + 'R4O2', 'BRO2', 'ETO2', 'A3O2', 'MCO3', 'MO2', 'HO2', 'O1D', 'OH', + 'TSOA0', 'TSOA1', 'TSOA2', 'TSOA3', 'ASOAN', 'ASOA1', 'ASOA2', 'ASOA3', + 'SOAIE', 'SOAGX', + 'H2O', 'SAD_PSC', 'SAD_SULFC', 'SAD_TROP', 'SAD_AERO', 'REFF_AERO', + 'PDELDRY', 'RAD_PSC', 'RAD_SULFC', + 'HNO3_GAS', 'HNO3_STS', 'HNO3_NAT', 'NOX', 'NOY', 'CLOX', 'CLOY', + 'BROX', 'BROY', 'TCLY', 'TOTH', 'MASS', 'TBRY', 'HCL_GAS', + 'HCL_GAS', 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'ABSORB', + 'AODVISdn', 'AODdnMODE1', 'AODVISstdn', 'AODNIRstdn', + 'AODUVstdn', 'AODdnMODE2', 'AODdnMODE3', 'AODdnDUST1', 'AODdnDUST2', + 'AODdnDUST3', 'AODVISstdn', 'AODUVstdn', 'AODNIRstdn', + 'AODNIRstdn', 'AODVISdn', 'AODUVdn', 'EXTINCTdn', 'EXTxASYMdn', + 'EXTINCTNIRdn', 'EXTINCTUVdn', + 'WD_EOH', 'WD_ETP', 'WD_RA3P', 'WD_CH2O', 'WD_ALD2', + 'WD_MGLY', 'WD_ACTA', 'WD_MAP', 'WD_MOH', 'WD_MP', + 'WD_GLYC', 'WD_H2O2', 'WD_SO4', 'WD_HBR', 'WD_HCL', + 'WD_HNO3', 'WD_HOBR', 'WD_HOCL', 'WD_HONIT', 'WD_HAC', 'WD_IEPOXA', + 'WD_IEPOXB', 'WD_IEPOXD', 'WD_MVK', 'WD_NH3', 'WD_NH4', 'WD_SO2', + 'DF_EOH', 'DF_ETP', 'DF_RA3P', 'DF_CH2O', 'DF_ALD2', 'DF_ACET', + 'DF_MGLY', 'DF_ACTA', 'DF_MAP', 'DF_MOH', 'DF_MP', 'DF_CO', + 'DF_GLYC', 'DF_H2O2', 'DF_SO4', 'DF_HNO3', 'DF_HNO4', + 'DF_HONIT', 'DF_HPALD1', 'DF_HPALD2', 'DF_HPALD3', 'DF_HPALD4', + 'DF_HAC', 'DF_IEPOXA', 'DF_IEPOXB', 'DF_IEPOXD', + 'DF_MPAN', 'DF_NH3', 'DF_NH4', 'DF_NO', + 'DF_NO2', 'DF_O3', 'DF_PAN', 'DF_SO2', + 'SO2_CLXF', 'SO2_XFRC', + 'CO_CLXF', 'NO2_CLXF', 'LNO_PROD', 'LNO_COL_PROD', + 'SFEOH', 'SFALD2', 'SFMEK', 'SFCH2O', 'SFC2H6', 'SFC3H8', + 'SFALK4', 'SFPRPE', 'SFBENZ', 'SFTOLU', 'SFXYLE', + 'SFNO', 'SFACTA', 'SFDMS', 'SFMEK', 'SFSO2', 'SFNH3', + 'SFISOP', 'SFMTPA', 'SFMOH', 'SFACET', 'SFCO', + 'MEG_ISOP', 'MEG_MOH', 'MEG_EOH', 'MEG_CH2O', 'MEG_ALD2', 'MEG_ACTA', + 'MEG_ACET', 'MEG_HCOOH', 'MEG_HCN', 'MEG_CO', 'MEG_C2H6', 'MEG_C2H4', + 'MEG_C3H8', 'MEG_ALK4', 'MEG_PRPE', 'MEG_TOLU', 'MEG_LIMO', 'MEG_MTPA', + 'MEG_MTPO', 'Dso4_a1CHM', 'Dso4_a2CHM', 'Dso4_a3CHM', 'DO3CHM', 'DCOCHM', + 'DHNO3CHM', 'DH2O2CHM', 'DO3CHM', 'DCOCHM', 'AQ_SO2', 'GS_SO2', 'SO2_CLXF', + 'MASS', 'ABSORB', + 'JvalO3O1D', 'Jval_NO2', 'Jval_PAN', 'Jval_H2O2', 'Jval_Cl2O2', + 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a1', + 'ncl_a2', 'ncl_a3', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', + 'soa1_a1', 'soa2_a1', 'soa3_a1', 'soa4_a1', 'soa5_a1', 'soa1_a2', 'soa2_a2', 'soa3_a2', + 'soa4_a2', 'soa5_a2', 'bc_c1', 'bc_c4', 'dst_c1', 'dst_c2', 'dst_c3', 'ncl_c1', 'ncl_c1', + 'ncl_c2', 'ncl_c3', 'pom_c1', 'pom_c4', 'so4_c1', 'so4_c2', 'so4_c3', 'soa1_c1', 'soa2_c1', + 'soa3_c1', 'soa4_c1', 'soa5_c1', 'soa1_c2', 'soa2_c2', 'soa3_c2', 'soa4_c2', 'soa5_c2', + 'bc_a1SFWET', 'num_a1','num_a2','num_a3','num_a4','num_c1','num_c2','num_c3','num_c4', + 'bc_a1SFWET', 'bc_a4SFWET', 'dst_a1SFWET', 'dst_a2SFWET', 'dst_a3SFWET', 'ncl_a1SFWET', + 'ncl_a2SFWET', 'ncl_a3SFWET', 'pom_a1SFWET', 'pom_a4SFWET', + 'so4_a1SFWET', 'so4_a2SFWET', 'so4_a3SFWET', 'soa1_a1SFWET', 'soa1_a2SFWET', + 'soa2_a1SFWET', 'soa2_a2SFWET', 'soa3_a1SFWET', 'soa3_a2SFWET', + 'soa4_a1SFWET', 'soa4_a2SFWET', 'soa5_a1SFWET', 'soa5_a2SFWET', 'bc_c1SFWET', + 'bc_c4SFWET', 'dst_c1SFWET', 'dst_c2SFWET', 'dst_c3SFWET', + 'ncl_c1SFWET', 'ncl_c2SFWET', 'ncl_c3SFWET', 'pom_c1SFWET', 'pom_c4SFWET', + 'so4_c1SFWET', 'so4_c2SFWET', 'so4_c3SFWET', 'soa1_c1SFWET', + 'soa1_c2SFWET', 'soa2_c1SFWET', 'soa2_c2SFWET', 'soa3_c1SFWET', 'soa3_c2SFWET', + 'soa4_c1SFWET', 'soa4_c2SFWET', 'soa5_c1SFWET', 'soa5_c2SFWET', + 'bc_a1DDF', 'bc_a4DDF', 'dst_a1DDF', 'dst_a2DDF', 'dst_a3DDF', 'ncl_a1DDF', + 'ncl_a2DDF', 'ncl_a3DDF', 'pom_a1DDF', + 'pom_a4DDF', 'so4_a1DDF', 'so4_a2DDF', 'so4_a3DDF', 'soa1_a1DDF', + 'soa1_a2DDF', 'soa2_a1DDF', 'soa2_a2DDF', 'soa3_a1DDF', + 'soa3_a2DDF', 'soa4_a1DDF', 'soa4_a2DDF', 'soa5_a1DDF', 'soa5_a2DDF', + 'bc_c1DDF', 'bc_c4DDF', 'dst_c1DDF', 'dst_c2DDF', + 'dst_c3DDF', 'ncl_c1DDF', 'ncl_c2DDF', 'ncl_c3DDF', 'pom_c1DDF', + 'pom_c4DDF', 'so4_c1DDF', 'so4_c2DDF', 'so4_c3DDF', + 'soa1_c1DDF', 'soa1_c2DDF', 'soa2_c1DDF', 'soa2_c2DDF', 'soa3_c1DDF', + 'soa3_c2DDF', 'soa4_c1DDF', 'soa4_c2DDF', 'soa5_c1DDF', + 'soa5_c2DDF', 'num_a1DDF', 'num_a2DDF', 'num_a3DDF', 'num_a4DDF', + 'num_c1DDF', 'num_c2DDF', 'num_c3DDF', 'num_c4DDF', + 'bc_a4_CLXF', 'pom_a4_CLXF', 'so4_a1_CLXF', 'so4_a2_CLXF', + 'num_a1_CLXF', 'num_a2_CLXF', 'SFbc_a4', 'SFpom_a4', 'SFso4_a1', + 'SFso4_a2', 'SFnum_a1', 'SFnum_a2', 'SFnum_a3', 'so4_a1_sfgaex1', + 'so4_a2_sfgaex1', 'so4_a3_sfgaex1', 'soa1_a1_sfgaex1', 'soa1_a2_sfgaex1', + 'soa2_a1_sfgaex1', 'soa2_a2_sfgaex1', 'soa3_a1_sfgaex1', 'soa3_a2_sfgaex1', + 'soa4_a1_sfgaex1', 'soa4_a2_sfgaex1', 'soa5_a1_sfgaex1', 'soa5_a2_sfgaex1', + 'so4_a2_sfnnuc1', 'so4_c1AQH2SO4', 'so4_c2AQH2SO4', 'so4_c3AQH2SO4', + 'so4_c1AQSO4', 'so4_c2AQSO4', 'so4_c3AQSO4', 'SFdst_a1', 'SFdst_a2', 'SFdst_a3', + 'SFncl_a1', 'SFncl_a2', 'SFncl_a3', + 'TMOCS', 'TMSO2', 'TMso4_a1', 'TMso4_a2', 'TMso4_a3', + 'BURDENDUSTdn', 'BURDENPOMdn', 'BURDENSO4dn', 'BURDENSOAdn', + 'BURDENSEASALTdn','BURDENBCdn', 'PM25' + + + + + diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index 6be27aa18b..bb78e132ee 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -262,6 +262,7 @@ hist_trop_strat_vbsext_cam6 hist_trop_strat_vbsfire_cam6 hist_geoschem + hist_geoschem_nudged waccmx_ma_hist_cam6 1850-PD_cam5 From f19429eac49a3c7810725b15e9bc1f7137f20fab Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Thu, 3 Nov 2022 13:06:50 -0600 Subject: [PATCH 066/291] Remove config_compsets.xml change that does not belong to this branch and was added in error --- cime_config/config_compsets.xml | 5 ----- 1 file changed, 5 deletions(-) diff --git a/cime_config/config_compsets.xml b/cime_config/config_compsets.xml index 6206142da2..93bb88ec3b 100644 --- a/cime_config/config_compsets.xml +++ b/cime_config/config_compsets.xml @@ -539,11 +539,6 @@ HIST_CAM60%GC%SDYN_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV - - FCnudged_GC - HIST_CAM60%GC%NUDG_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV - - From dca0f5ea099e8ad36758bdeafe72fc66e0c40f43 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Thu, 3 Nov 2022 13:07:38 -0600 Subject: [PATCH 067/291] Expand CAM history field name maximum to 32 chars --- src/control/cam_history_support.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/control/cam_history_support.F90 b/src/control/cam_history_support.F90 index 1ec5cc2e1c..6df7d906b2 100644 --- a/src/control/cam_history_support.F90 +++ b/src/control/cam_history_support.F90 @@ -25,7 +25,7 @@ module cam_history_support integer, parameter, public :: max_string_len = shr_kind_cxx integer, parameter, public :: max_chars = shr_kind_cl ! max chars for char variables - integer, parameter, public :: fieldname_len = 24 ! max chars for field name + integer, parameter, public :: fieldname_len = 32 ! max chars for field name integer, parameter, public :: fieldname_suffix_len = 3 ! length of field name suffix ("&IC") integer, parameter, public :: fieldname_lenp2 = fieldname_len + 2 ! allow for extra characters ! max_fieldname_len = max chars for field name (including suffix) From c74560a8d8003fd4d95ba06546ac20ab2287b6e9 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Thu, 3 Nov 2022 15:04:35 -0600 Subject: [PATCH 068/291] Fix bug that was forcing HEMCO_Config.rc as hemco_config_file --- bld/build-namelist | 1 - 1 file changed, 1 deletion(-) diff --git a/bld/build-namelist b/bld/build-namelist index 472514e9ea..c93581b002 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -2841,7 +2841,6 @@ else { } # HEMCO -$nl->set_variable_value('hemco_nl', 'hemco_config_File', "'HEMCO_Config.rc'"); my $hco = $cfg->get('hemco'); if ( $hco eq '1' ) { add_default($nl, 'cam_physics_mesh'); From ea168b0858509fd41f70c9417ba3168156304732 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Thu, 3 Nov 2022 17:34:48 -0400 Subject: [PATCH 069/291] Fix typo in HEMCO-CESM tag Signed-off-by: Lizzie Lundgren --- Externals_CAM.cfg | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Externals_CAM.cfg b/Externals_CAM.cfg index 0ef34d69c8..bb476b1c7d 100644 --- a/Externals_CAM.cfg +++ b/Externals_CAM.cfg @@ -77,7 +77,7 @@ local_path = src/chemistry/geoschem/geoschem_src required = True [hemco] -tag = hemco-cesm1_0_hemco_3_5_1 +tag = hemco-cesm1_0_hemco3_5_1 protocol = git repo_url = https://github.com/ESCOMP/HEMCO_CESM.git local_path = src/hemco From 0af7d6649f0efb177c79719dd58ee6fadeb00ead Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Fri, 4 Nov 2022 15:44:27 -0600 Subject: [PATCH 070/291] Remove debugging routines --- src/chemistry/geoschem/cesmgc_history_mod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/chemistry/geoschem/cesmgc_history_mod.F90 b/src/chemistry/geoschem/cesmgc_history_mod.F90 index bd147c82a6..dcc89b128e 100644 --- a/src/chemistry/geoschem/cesmgc_history_mod.F90 +++ b/src/chemistry/geoschem/cesmgc_history_mod.F90 @@ -1139,8 +1139,8 @@ SUBROUTINE HistoryExports_SetDataPointers( am_I_Root, & current => NULL() ! Optional debugging - WRITE(6,*) "hplin debug: after HistoryExports_SetDataPointers" - CALL Print_HistoryExportsList( am_I_Root, HistoryConfig, RC ) + !WRITE(6,*) "hplin debug: after HistoryExports_SetDataPointers" + !CALL Print_HistoryExportsList( am_I_Root, HistoryConfig, RC ) IF ( RC == GC_FAILURE ) THEN CALL GC_ERROR( ErrMsg, RC, Iam ) From 17b61802c74dc492378b377a7e1a0a97f862cd8a Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Wed, 9 Nov 2022 12:57:07 -0700 Subject: [PATCH 071/291] Fix HEMCO namelist bugs Signed-off-by: Lizzie Lundgren --- bld/build-namelist | 3 +++ bld/namelist_files/namelist_definition.xml | 2 +- 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/bld/build-namelist b/bld/build-namelist index c93581b002..98957459bd 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -2844,6 +2844,9 @@ else { my $hco = $cfg->get('hemco'); if ( $hco eq '1' ) { add_default($nl, 'cam_physics_mesh'); + add_default($nl, 'hemco_config_file'); + add_default($nl, 'hemco_grid_xdim'); + add_default($nl, 'hemco_grid_ydim'); } # Physics options diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index 8c08feee05..96d81e703f 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -4881,7 +4881,7 @@ Default: set by build-namelist. - Full pathname to HEMCO_Config.rc, which prescribes emission inventories Default: set by build-namelist. From 13607ad53295974392e98ed9d3e6422489a02819 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Wed, 9 Nov 2022 13:35:42 -0700 Subject: [PATCH 072/291] Upgrade GEOS-Chem to version 14.0.1 Signed-off-by: Lizzie Lundgren hemco --- Externals_CAM.cfg | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Externals_CAM.cfg b/Externals_CAM.cfg index bb476b1c7d..f02dc79ee4 100644 --- a/Externals_CAM.cfg +++ b/Externals_CAM.cfg @@ -70,7 +70,7 @@ hash = ff76a231 required = True [geoschem] -tag = 14.0.0-alpha.9 +tag = 14.0.1 protocol = git repo_url = https://github.com/geoschem/geos-chem.git local_path = src/chemistry/geoschem/geoschem_src From dc68379b20ee8749127cd1545d5f04f2c68114d5 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Mon, 14 Nov 2022 12:59:58 -0700 Subject: [PATCH 073/291] Fix MEGAN emissions in CESM-GC - active_fall_flxvoc is a logical and not integer --- src/chemistry/geoschem/cesmgc_emissions_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/chemistry/geoschem/cesmgc_emissions_mod.F90 b/src/chemistry/geoschem/cesmgc_emissions_mod.F90 index f231d8dd8c..3b4eaf35ad 100644 --- a/src/chemistry/geoschem/cesmgc_emissions_mod.F90 +++ b/src/chemistry/geoschem/cesmgc_emissions_mod.F90 @@ -531,7 +531,7 @@ SUBROUTINE CESMGC_Emissions_Calc( state, hco_pbuf2d, State_Met, cam_in, eflx, iS ! MEGAN emissions ... !----------------------------------------------------------------------- - IF ( active_Fall_flxvoc > 0 .AND. shr_megan_mechcomps_n > 0 ) THEN + IF ( active_Fall_flxvoc .AND. shr_megan_mechcomps_n > 0 ) THEN ! set MEGAN fluxes DO N = 1, shr_megan_mechcomps_n DO J = 1, nY From 224faaff2e434cba8c4d85dc4f0f84df1122f26b Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Mon, 14 Nov 2022 16:20:38 -0700 Subject: [PATCH 074/291] Add comments on xml source --- bld/namelist_files/use_cases/hist_geoschem_nudged.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/bld/namelist_files/use_cases/hist_geoschem_nudged.xml b/bld/namelist_files/use_cases/hist_geoschem_nudged.xml index 1bf8d90874..d5ab458374 100644 --- a/bld/namelist_files/use_cases/hist_geoschem_nudged.xml +++ b/bld/namelist_files/use_cases/hist_geoschem_nudged.xml @@ -2,7 +2,7 @@ - + @@ -14,7 +14,7 @@ /glade/u/home/elundgren/drydep_henrys_law_nc/dep_data_file_geoschem.nc - + 00010101 From 07d197ce55dc1f8a974486e2db4dc391fced1de4 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Wed, 16 Nov 2022 13:48:34 -0700 Subject: [PATCH 075/291] Update comments; remove more debug routines --- src/chemistry/geoschem/cesmgc_history_mod.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/chemistry/geoschem/cesmgc_history_mod.F90 b/src/chemistry/geoschem/cesmgc_history_mod.F90 index dcc89b128e..866003b976 100644 --- a/src/chemistry/geoschem/cesmgc_history_mod.F90 +++ b/src/chemistry/geoschem/cesmgc_history_mod.F90 @@ -88,7 +88,7 @@ MODULE CESMGC_History_Mod LOGICAL :: isDiag TYPE(HistoryExportObj), POINTER :: next - ! Pointers to ESMF Export and GEOS-Chem State + ! Pointers to temporaries for CAM Export and GEOS-Chem State ! TODO: for now, include all possible data types in the registry. REAL(f8), POINTER :: ExportData2d(:,:) REAL(f8), POINTER :: ExportData3d(:,:,:) @@ -166,7 +166,7 @@ SUBROUTINE Init_HistoryConfig ( am_I_Root, HistoryConfig, configFile, RC ) RETURN ENDIF ! Optional debugging - CALL Print_DiagList( am_I_Root, HistoryConfig%DiagList, RC ) + ! CALL Print_DiagList( am_I_Root, HistoryConfig%DiagList, RC ) CALL Init_TaggedDiagList( am_I_Root, HistoryConfig%DiagList, & HistoryConfig%TaggedDiagList, RC ) @@ -175,7 +175,7 @@ SUBROUTINE Init_HistoryConfig ( am_I_Root, HistoryConfig, configFile, RC ) RETURN ENDIF ! Optional debugging - CALL Print_TaggedDiagList( am_I_Root, HistoryConfig%TaggedDiagList, RC ) + ! CALL Print_TaggedDiagList( am_I_Root, HistoryConfig%TaggedDiagList, RC ) CALL Init_HistoryExportsList( am_I_Root, HistoryConfig, RC ) From a0742f43bc9db3de5bee67ae5fa7c078a78bd6fc Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Wed, 16 Nov 2022 18:41:36 -0700 Subject: [PATCH 076/291] Remove array temporary allocations; now use one outTmp_3D and outTmp_2D for 3D and 2D data. --- src/chemistry/geoschem/cesmgc_history_mod.F90 | 77 +++++-------------- 1 file changed, 18 insertions(+), 59 deletions(-) diff --git a/src/chemistry/geoschem/cesmgc_history_mod.F90 b/src/chemistry/geoschem/cesmgc_history_mod.F90 index 866003b976..e71cd4f893 100644 --- a/src/chemistry/geoschem/cesmgc_history_mod.F90 +++ b/src/chemistry/geoschem/cesmgc_history_mod.F90 @@ -90,8 +90,6 @@ MODULE CESMGC_History_Mod ! Pointers to temporaries for CAM Export and GEOS-Chem State ! TODO: for now, include all possible data types in the registry. - REAL(f8), POINTER :: ExportData2d(:,:) - REAL(f8), POINTER :: ExportData3d(:,:,:) REAL(fp), POINTER :: GCStateData0d REAL(fp), POINTER :: GCStateData1d(:) REAL(fp), POINTER :: GCStateData2d(:,:) @@ -500,8 +498,6 @@ SUBROUTINE Init_HistoryExport ( am_I_Root, NewHistExp, name, & ENDIF NewHistExp%next => NULL() - NewHistExp%ExportData2d => NULL() - NewHistExp%ExportData3d => NULL() NewHistExp%GCStateData0d => NULL() NewHistExp%GCStateData1d => NULL() NewHistExp%GCStateData2d => NULL() @@ -781,6 +777,7 @@ SUBROUTINE CopyGCStates2Exports( am_I_Root, Input_Opt, State_Grid, HistoryConfig USE State_Grid_Mod, ONLY : GrdState USE cam_history, ONLY : hist_fld_active, outfld + USE SHR_KIND_MOD, ONLY : shr_kind_r8 ! ! !INPUT PARAMETERS: ! @@ -812,6 +809,11 @@ SUBROUTINE CopyGCStates2Exports( am_I_Root, Input_Opt, State_Grid, HistoryConfig CHARACTER(LEN=255) :: ErrMsg TYPE(HistoryExportObj), POINTER :: current + ! Temporaries for CAM exports. + ! Note that in CESM, State_Grid%NX is always length 1. (hplin, 11/16/22) + REAL(shr_kind_r8) :: outTmp_3D(State_Grid%NY, State_Grid%NZ) + REAL(shr_kind_r8) :: outTmp_2D(State_Grid%NY) + ! ================================================================ ! CopyGCStates2Exports begins here ! ================================================================ @@ -832,14 +834,14 @@ SUBROUTINE CopyGCStates2Exports( am_I_Root, Input_Opt, State_Grid, HistoryConfig ! endif IF ( current%rank == 2 ) THEN IF ( ASSOCIATED( current%GCStateData2d ) ) THEN - current%ExportData2d(:,1:State_Grid%NY) = current%GCStateData2d(:,1:State_Grid%NY) + outTmp_2D(1:State_Grid%NY) = current%GCStateData2d(1,1:State_Grid%NY) ELSE IF ( ASSOCIATED( current%GCStateData2d_4 ) ) THEN - current%ExportData2d(:,1:State_Grid%NY) = current%GCStateData2d_4(:,1:State_Grid%NY) + outTmp_2D(1:State_Grid%NY) = current%GCStateData2d_4(1,1:State_Grid%NY) ELSE IF ( ASSOCIATED( current%GCStateData2d_8 ) ) THEN - current%ExportData2d(:,1:State_Grid%NY) = current%GCStateData2d_8(:,1:State_Grid%NY) + outTmp_2D(1:State_Grid%NY) = current%GCStateData2d_8(1,1:State_Grid%NY) ELSE IF ( ASSOCIATED( current%GCStateData2d_I ) ) THEN ! Convert integer to float (integers not allowed in MAPL exports) - current%ExportData2d(:,1:State_Grid%NY) = FLOAT(current%GCStateData2d_I(:,1:State_Grid%NY)) + outTmp_2D(1:State_Grid%NY) = FLOAT(current%GCStateData2d_I(1,1:State_Grid%NY)) ELSE RC = GC_FAILURE ErrMsg = "No GC 2D pointer found for " // TRIM(current%name) @@ -848,18 +850,18 @@ SUBROUTINE CopyGCStates2Exports( am_I_Root, Input_Opt, State_Grid, HistoryConfig ! Now call outfld to output for this chunk call outfld(trim(current%name), & - current%ExportData2d(1, 1:State_Grid%NY), & ! Chunk width always 1 + outTmp_2D, & ! Chunk width always 1 State_Grid%NY, & LCHNK ) ELSEIF ( current%rank == 3 ) THEN IF ( ASSOCIATED( current%GCStateData3d ) ) THEN - current%ExportData3d(:,1:State_Grid%NY,:) = current%GCStateData3d(:,1:State_Grid%NY,:) + outTmp_3D(1:State_Grid%NY, :) = current%GCStateData3d(1,1:State_Grid%NY,:) ELSE IF ( ASSOCIATED( current%GCStateData3d_4 ) ) THEN - current%ExportData3d(:,1:State_Grid%NY,:) = current%GCStateData3d_4(:,1:State_Grid%NY,:) + outTmp_3D(1:State_Grid%NY, :) = current%GCStateData3d_4(1,1:State_Grid%NY,:) ELSE IF ( ASSOCIATED( current%GCStateData3d_8 ) ) THEN - current%ExportData3d(:,1:State_Grid%NY,:) = current%GCStateData3d_8(:,1:State_Grid%NY,:) + outTmp_3D(1:State_Grid%NY, :) = current%GCStateData3d_8(1,1:State_Grid%NY,:) ELSE IF ( ASSOCIATED( current%GCStateData3d_I ) ) THEN - current%ExportData3d(:,1:State_Grid%NY,:) = FLOAT(current%GCStateData3d_I(:,1:State_Grid%NY,:)) + outTmp_3D(1:State_Grid%NY, :) = FLOAT(current%GCStateData3d_I(1,1:State_Grid%NY,:)) ELSE RC = GC_FAILURE ErrMsg = "No GC 3D pointer found for " // TRIM(current%name) @@ -869,14 +871,13 @@ SUBROUTINE CopyGCStates2Exports( am_I_Root, Input_Opt, State_Grid, HistoryConfig ! If using GEOS-5, flip the data vertically to match model ! convention ! Also do this in CESM. (hplin, 10/31/22) - LMAX = SIZE(current%ExportData3d, 3) - current%ExportData3d(:,:,1:LMAX) = & - current%ExportData3d(:,:,LMAX:1:-1) + LMAX = SIZE(outTmp_3D, 2) + outTmp_3D(:,1:LMAX) = outTmp_3D(:,LMAX:1:-1) #endif ! Now call outfld to output for this chunk call outfld(trim(current%name), & - current%ExportData3d(1, 1:State_Grid%NY, :), & ! Chunk width always 1. TOA is 1 + outTmp_3D, & ! Chunk width always 1. TOA is 1 State_Grid%NY, & LCHNK ) ENDIF @@ -959,12 +960,6 @@ SUBROUTINE Print_HistoryExportsList( am_I_Root, HistoryConfig, RC ) PRINT *, " isMet: ", current%isMet PRINT *, " isChem: ", current%isChem PRINT *, " isDiag: ", current%isDiag - IF ( ASSOCIATED( current%ExportData2d )) THEN - PRINT *, " E2D dim'l: ", size(current%ExportData2d) - ENDIF - IF ( ASSOCIATED( current%ExportData3d )) THEN - PRINT *, " E3D dim'l: ", size(current%ExportData3d) - ENDIF PRINT *, " " ENDIF current => current%next @@ -1102,33 +1097,6 @@ SUBROUTINE HistoryExports_SetDataPointers( am_I_Root, & EXIT ENDIF - ! For CESM export, outfld accepts the data pointer directly but it - ! has to be in r8. Thus, allocate a r8 data type in exportData2d or - ! ExportData3d so that the rest of the code can be reused, then - ! update pointer data can just call outfld additionally. There is, - ! however, a memory hit from this. Revisit later. (hplin, 10/31/22) - ! - ! As a side note, in CESM-GC, State_Grid%NX is always 1 since the data - ! is chunkized. Only the State_Grid%NY matters here. - ! - ! Because NY could vary across chunk sizes, allocate one extra column - ! but only read up to the actual :State_Grid%NY. This allows for different - ! instances of GEOS-Chem to share the same ExportData allocation in separate - ! calls to the pointer update subroutine. - IF ( current%rank == 2 ) THEN - IF ( .not. ASSOCIATED(current%ExportData2d) ) THEN - ALLOCATE(current%ExportData2d(State_Grid%NX, State_Grid%NY+1), stat=RC) - ENDIF - ELSEIF ( current%rank == 3 ) THEN - IF ( .not. ASSOCIATED(current%ExportData3d) ) THEN - IF ( current%vloc == VLocationCenter ) THEN - ALLOCATE(current%ExportData3d(State_Grid%NX, State_Grid%NY+1, State_Grid%NZ ), stat=RC) - ELSEIF ( current%vloc == VLocationEdge ) THEN - ALLOCATE(current%ExportData3d(State_Grid%NX, State_Grid%NY+1, State_Grid%NZ+1), stat=RC) - ENDIF - ENDIF - ENDIF - !! debugging !IF ( Am_I_Root) THEN ! WRITE(6,*) TRIM(current%name) @@ -1199,15 +1167,6 @@ SUBROUTINE Destroy_HistoryConfig ( am_I_Root, HistoryConfig, RC ) current => HistoryConfig%HistoryExportsList%head IF ( ASSOCIATED( current ) ) next => current%next DO WHILE ( ASSOCIATED( current ) ) - ! Clean up the temporary array used for exports as well - IF ( ASSOCIATED( current%ExportData2d ) ) THEN - DEALLOCATE ( current%ExportData2d, stat=RC ) - ENDIF - - IF ( ASSOCIATED( current%ExportData3d ) ) THEN - DEALLOCATE ( current%ExportData3d, stat=RC ) - ENDIF - DEALLOCATE( current, STAT=RC ) _ASSERT( RC == GC_SUCCESS, 'informative message here' ) IF ( .NOT. ASSOCIATED ( next ) ) EXIT From cbe679e2de8a2a0c7195f50b9f0560210bd68395 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Thu, 17 Nov 2022 10:16:47 -0700 Subject: [PATCH 077/291] Remove unnecessary legacy code in cesmgc_diag_mod.F90 --- src/chemistry/geoschem/cesmgc_diag_mod.F90 | 185 --------------------- 1 file changed, 185 deletions(-) diff --git a/src/chemistry/geoschem/cesmgc_diag_mod.F90 b/src/chemistry/geoschem/cesmgc_diag_mod.F90 index 1bcd7f6d04..300402f518 100644 --- a/src/chemistry/geoschem/cesmgc_diag_mod.F90 +++ b/src/chemistry/geoschem/cesmgc_diag_mod.F90 @@ -40,7 +40,6 @@ MODULE CESMGC_Diag_Mod PUBLIC :: CESMGC_Diag_Calc PUBLIC :: wetdep_name, wtrate_name - INTEGER :: nPhotol ! Number of diagnosed photolytic reactions CHARACTER(LEN=fieldname_len) :: srcnam(gas_pcnst) ! Names of source/sink tendencies CHARACTER(LEN=fieldname_len) :: wetdep_name(gas_pcnst) ! Wet deposition tendencies CHARACTER(LEN=fieldname_len) :: wtrate_name(gas_pcnst) ! Column tendencies for wet dep @@ -438,85 +437,6 @@ SUBROUTINE CESMGC_Diag_Init( Input_Opt, State_Chm, State_Met ) CALL Add_Default ('CT_H2O' , history_budget_histfile_num, ' ') ENDIF - CALL get_TagInfo( Input_Opt = Input_Opt, & - tagID = 'PHO', & - State_Chm = State_Chm, & - Found = Found, & - RC = RC, & - nTags = nPhotol ) - - ! Trap potential errors - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Abnormal exit from routine "Get_TagInfo", could not ' // & - ' get nTags!' - CALL Error_Stop( ErrMsg, ThisLoc ) - ENDIF - - ! Remove as superceded - ! DO M = 1, nPhotol - ! CALL get_TagInfo( Input_Opt = Input_Opt, & - ! tagID = 'PHO', & - ! State_Chm = State_Chm, & - ! Found = Found, & - ! RC = RC, & - ! N = M, & - ! tagName = tagName ) - - ! ! Trap potential errors - ! IF ( RC /= GC_SUCCESS ) THEN - ! ErrMsg = 'Abnormal exit from routine "Get_TagInfo"!' - ! CALL Error_Stop( ErrMsg, ThisLoc ) - ! ENDIF - - ! SpcName = 'Jval_' // TRIM( tagName ) - ! CALL Addfld( TRIM(SpcName), (/ 'lev' /), 'A', '1/s', & - ! TRIM(tagName) // ' photolysis rate' ) - ! ENDDO - ! ! Add JvalO3O1D and JvalO3O3P - ! SpcName = 'JvalO3O1D' - ! CALL Addfld( TRIM(SpcName), (/ 'lev' /), 'A', '1/s', & - ! 'O3 -> O1D photolysis rate' ) - - ! SpcName = 'JvalO3O3P' - ! CALL Addfld( TRIM(SpcName), (/ 'lev' /), 'A', '1/s', & - ! 'O3 -> O3P photolysis rate' ) - - ! ========================================== - ! Now add fields corresponding to State_Met - ! ========================================== - - ! Copied from Headers/registry_mod.F90 - ! Point to the head node of the Registry - Current => State_Met%Registry - - ! As long as the current node isn't NULL - DO WHILE( ASSOCIATED( Current ) ) - - ! Get the REGISTRY ITEM belonging to this node of the Registry - Item => Current%Item - - ! Only print on the root CPU - IF ( ASSOCIATED( Item ) ) THEN - - !IF (( TRIM(Item%FullName(1:8)) /= 'MET_XLAI' ) .AND. & - ! ( TRIM(Item%FullName(1:8)) /= 'MET_IUSE' ) .AND. & - ! ( TRIM(Item%FullName(1:9)) /= 'MET_ILAND' )) THEN - ! IF ( TRIM(Item%DimNames) == 'xy' ) THEN - ! CALL Addfld( TRIM( Item%FullName ), horiz_only, 'A', & - ! TRIM( Item%Units ), TRIM( Item%Description ) ) - ! ELSE - ! CALL Addfld( TRIM( Item%FullName ), (/ 'lev' /), 'A', & - ! TRIM( Item%Units ), TRIM( Item%Description ) ) - ! ENDIF - !ENDIF - - ENDIF - - ! Point to next node of the Registry - Current => Current%Next - - ENDDO - ! Chemical tendencies DO N = 1, gas_pcnst M = map2chm(N) @@ -987,8 +907,6 @@ SUBROUTINE CESMGC_Diag_Calc( Input_Opt, State_Chm, State_Diag, & INTEGER :: I, J, L, M, N, ND, SM INTEGER :: idx INTEGER :: RC - INTEGER :: Source_KindVal ! KIND value of data - INTEGER :: Output_KindVal ! KIND value for output INTEGER :: Rank ! Size of data INTEGER :: nY, nZ @@ -1479,113 +1397,10 @@ SUBROUTINE CESMGC_Diag_Calc( Input_Opt, State_Chm, State_Diag, & CALL OutFld( TRIM(SpcName), outTmp(:nY,:), nY, LCHNK ) ENDDO - ! =============================================== - ! Diagnose photolysis rates - ! =============================================== - - ! Disable as superceded by cesmgc_history_mod.F90 (hplin, 10/31/22) - - ! IF ( ASSOCIATED(State_Diag%Jval) ) THEN - ! DO M = 1, nPhotol - ! CALL get_TagInfo( Input_Opt = Input_Opt, & - ! tagID = 'PHO', & - ! State_Chm = State_Chm, & - ! Found = Found, & - ! RC = RC, & - ! N = M, & - ! tagName = tagName ) - - ! ! Trap potential errors - ! IF ( RC /= GC_SUCCESS ) THEN - ! ErrMsg = 'Abnormal exit from routine "Get_TagInfo"!' - ! CALL Error_Stop( ErrMsg, ThisLoc ) - ! ENDIF - - ! SpcName = 'Jval_' // TRIM( tagName ) - ! IF ( .NOT. hist_fld_active(TRIM(SpcName)) ) CYCLE - ! outTmp(:nY,:nZ) = REAL(State_Diag%Jval(1,:nY,nZ:1:-1,M),r8) - ! CALL OutFld( TRIM(SpcName), outTmp(:nY,:), nY, LCHNK ) - ! ENDDO - ! ENDIF - ! IF ( ASSOCIATED(State_Diag%JvalO3O1D) ) THEN - ! SpcName = 'JvalO3O1D' - ! IF ( hist_fld_active(TRIM(SpcName)) ) THEN - ! outTmp(:nY,:nZ) = REAL(State_Diag%JvalO3O1D(1,:nY,nZ:1:-1),r8) - ! CALL OutFld( TRIM(SpcName), outTmp(:nY,:), nY, LCHNK ) - ! ENDIF - ! ENDIF - ! IF ( ASSOCIATED(State_Diag%JvalO3O3P) ) THEN - ! SpcName = 'JvalO3O3P' - ! IF ( hist_fld_active(TRIM(SpcName)) ) THEN - ! outTmp(:nY,:nZ) = REAL(State_Diag%JvalO3O3P(1,:nY,nZ:1:-1),r8) - ! CALL OutFld( TRIM(SpcName), outTmp(:nY,:), nY, LCHNK ) - ! ENDIF - ! ENDIF - ! =============================================== ! Diagnose fields corresponding to State_Met ! =============================================== - ! Copied from Headers/registry_mod.F90 - ! Point to the head node of the Registry - Current => State_Met%Registry - - Source_KindVal = KINDVAL_F8 - Output_KindVal = KINDVAL_F8 - - ! As long as the current node isn't NULL - DO WHILE( ASSOCIATED( Current ) ) - - ! Get the REGISTRY ITEM belonging to this node of the Registry - Item => Current%Item - - ! Only print on the root CPU - IF ( ASSOCIATED( Item ) ) THEN - - SpcName = TRIM(Item%FullName) - IF (( TRIM(Item%FullName(1:8)) /= 'MET_XLAI' ) .AND. & - ( TRIM(Item%FullName(1:8)) /= 'MET_IUSE' ) .AND. & - ( TRIM(Item%FullName(1:9)) /= 'MET_ILAND' )) THEN - CALL Registry_Lookup( am_I_Root = Input_Opt%amIRoot, & - Registry = State_Met%Registry, & - RegDict = State_Met%RegDict, & - State = State_Met%State, & - Variable = Item%FullName, & - Source_KindVal = Source_KindVal, & - Output_KindVal = Output_KindVal, & - Rank = Rank, & - OnLevelEdges = OnLevelEdges, & - Ptr0d_8 = Ptr0d_8, & - Ptr1d_8 = Ptr1d_8, & - Ptr2d_8 = Ptr2d_8, & - Ptr3d_8 = Ptr3d_8, & - RC = RC ) - - !IF ( hist_fld_active(TRIM(SpcName)) ) THEN - ! IF ( Source_KindVal /= KINDVAL_I4 ) THEN - ! IF ( Rank == 2 ) THEN - ! outTmp(:nY,nZ) = REAL(Ptr2d_8(1,:nY),r8) - ! CALL Outfld( TRIM( Item%FullName ), outTmp(:nY,nZ), nY, LCHNK ) - ! ELSEIF ( Rank == 3 ) THEN - ! ! For now, treat variables defined on level edges by ignoring top - ! ! most layer - ! outTmp(:nY,:nZ) = REAL(Ptr3d_8(1,:nY,nZ:1:-1),r8) - ! CALL Outfld( TRIM( Item%FullName ), outTmp(:nY,:), nY, LCHNK ) - ! ELSE - ! IF ( rootChunk ) Write(iulog,*) " Item ", TRIM(Item%FullName), & - ! " is of rank ", Rank, " and will not be diagnosed!" - ! ENDIF - ! ENDIF - !ENDIF - ENDIF - - ENDIF - - ! Point to next node of the Registry - Current => Current%Next - - ENDDO - SpcName = 'SZA' IF ( hist_fld_active(TRIM(SpcName)) ) THEN outTmp(:nY,1) = ACOS(MIN(MAX(State_Met%SUNCOS(1,:nY),-1._r8),1._r8))/pi*180.e+0_r8 From 0c6204e1fe72a6df112b86a31be365d7e9524d22 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Thu, 17 Nov 2022 10:17:49 -0700 Subject: [PATCH 078/291] Update comments; remove extraneous GC_FAILURE call to address review comments --- src/chemistry/geoschem/cesmgc_history_mod.F90 | 14 +++++++------- src/chemistry/geoschem/chemistry.F90 | 6 +++--- 2 files changed, 10 insertions(+), 10 deletions(-) diff --git a/src/chemistry/geoschem/cesmgc_history_mod.F90 b/src/chemistry/geoschem/cesmgc_history_mod.F90 index e71cd4f893..5e221cdafb 100644 --- a/src/chemistry/geoschem/cesmgc_history_mod.F90 +++ b/src/chemistry/geoschem/cesmgc_history_mod.F90 @@ -110,7 +110,7 @@ MODULE CESMGC_History_Mod END TYPE HistoryExportObj ! ! !REVISION HISTORY: -! 01 Sep 2017 - E. Lundgren - Initial version +! 01 Sep 2017 - E. Lundgren - Initial version for GCHP/GEOS ! 19 Oct 2022 - H.P. Lin - Adapted for CESM ! See https://github.com/geoschem/geos-chem for history !EOP @@ -353,7 +353,6 @@ SUBROUTINE Init_HistoryExportsList ( am_I_Root, HistoryConfig, RC ) isDiag=isDiag, & RC=RC ) IF ( RC == GC_FAILURE ) THEN - RC = GC_FAILURE ErrMsg = "History export init fail for " // TRIM(current%name) EXIT ENDIF @@ -362,7 +361,6 @@ SUBROUTINE Init_HistoryExportsList ( am_I_Root, HistoryConfig, RC ) CALL Append_HistoryExportsList( am_I_Root, NewHistExp, & HistoryConfig, RC ) IF ( RC == GC_FAILURE ) THEN - RC = GC_FAILURE ErrMsg = "History export append fail for " // TRIM(current%name) EXIT ENDIF @@ -667,7 +665,8 @@ SUBROUTINE HistoryExports_SetServices( am_I_Root, config_file, & ! !REMARKS: ! ! ! !REVISION HISTORY: -! 01 Sep 2017 - E. Lundgren - Initial version +! 01 Sep 2017 - E. Lundgren - Initial version for GCHP/GEOS +! 19 Oct 2022 - H.P. Lin - Adapted for CESM ! See https://github.com/geoschem/geos-chem for history !EOP !------------------------------------------------------------------------------ @@ -682,7 +681,7 @@ SUBROUTINE HistoryExports_SetServices( am_I_Root, config_file, & ! HistoryExports_SetServices begins here ! ================================================================ - ! For MAPL/ESMF error handling (defines Iam and STATUS) + ! For error handling (defines Iam and STATUS) __Iam__('HistoryExports_SetServices (cesmgc_history_mod.F90)') RC = GC_SUCCESS @@ -797,7 +796,8 @@ SUBROUTINE CopyGCStates2Exports( am_I_Root, Input_Opt, State_Grid, HistoryConfig ! !REMARKS: ! ! ! !REVISION HISTORY: -! 01 Sep 2017 - E. Lundgren - Initial version +! 01 Sep 2017 - E. Lundgren - Initial version for GCHP/GEOS +! 19 Oct 2022 - H.P. Lin - Adapted for CESM ! See https://github.com/geoschem/geos-chem for history !EOP !------------------------------------------------------------------------------ @@ -867,7 +867,7 @@ SUBROUTINE CopyGCStates2Exports( am_I_Root, Input_Opt, State_Grid, HistoryConfig ErrMsg = "No GC 3D pointer found for " // TRIM(current%name) EXIT ENDIF -#if defined( MODEL_GEOS ) || defined( MODEL_CESM ) +#if defined( MODEL_CESM ) ! If using GEOS-5, flip the data vertically to match model ! convention ! Also do this in CESM. (hplin, 10/31/22) diff --git a/src/chemistry/geoschem/chemistry.F90 b/src/chemistry/geoschem/chemistry.F90 index 384ba73d0e..48699a0590 100644 --- a/src/chemistry/geoschem/chemistry.F90 +++ b/src/chemistry/geoschem/chemistry.F90 @@ -1401,7 +1401,9 @@ subroutine chem_init(phys_state, pbuf2d) ! There are actually two copies of the history configuration, one is contained ! within HistoryConfig to mimic the properties of GCHP. ! - ! The above original implementation is similar to GC-Classic and WRF-GC + ! The above original implementation is similar to GC-Classic and WRF-GC, + ! and is used by cesmgc_diag_mod for lookups for certain diagnostic + ! fields for compatibility with CAM-chem outputs. ! (hplin, 10/31/22) CALL HistoryExports_SetServices(am_I_Root = masterproc, & config_file = historyConfigFile, & @@ -4143,8 +4145,6 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) ! Note that the containers (data pointers) actually need to be updated every time step, ! because the State_Chm(LCHNK) target changes. There is some registry lookup overhead ! but mitigated by a check to the history field activeness. (hplin, 11/1/22) - ! - ! An alternative is to have multiple HistoryConfig... will make alternative implementation CALL HistoryExports_SetDataPointers(rootChunk, & HistoryConfig, State_Chm(LCHNK), & State_Grid(LCHNK), & From 76bd32aa35dc0ead94b841cc3bf985b5bd206486 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Thu, 15 Dec 2022 10:14:08 -0700 Subject: [PATCH 079/291] Change CMEPS and coupler remotes from fvitt to ESCOMP github Francis Vitt's updates required for GEOS-Chem are now merged into the main development branches and therefore his GitHub branches do not need to be used. Signed-off-by: Lizzie Lundgren --- Externals.cfg | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/Externals.cfg b/Externals.cfg index eed5b04ee6..d807ba80e7 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -21,9 +21,9 @@ externals = Externals.cfg required = True [cmeps] -tag = cmeps0.13.70 +tag = cmeps0.13.71 protocol = git -repo_url = https://github.com/fvitt/CMEPS.git +repo_url = https://github.com/ESCOMP/CMEPS.git local_path = components/cmeps required = True @@ -38,7 +38,7 @@ required = True [cpl7] tag = cpl7.0.14 protocol = git -repo_url = https://github.com/fvitt/CESM_CPL7andDataComps +repo_url = https://github.com/ESCOMP/CESM_CPL7andDataComps local_path = components/cpl7 required = True From a20ed2df3ac978f6891ea744299262fc9b06c92f Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Wed, 21 Dec 2022 13:47:37 -0700 Subject: [PATCH 080/291] Reduce GEOS-Chem dir mozart files; build mozart and pp_none if geos-chem This update required modifications to mozart/mo_chem_utls.F90 to allow optional argument for comparing upper-case letters in function get_spc_ndx. Signed-off-by: Lizzie Lundgren --- bld/configure | 4 + src/chemistry/geoschem/cesmgc_diag_mod.F90 | 93 +- src/chemistry/geoschem/charge_neutrality.F90 | 176 --- src/chemistry/geoschem/chemistry.F90 | 35 +- src/chemistry/geoschem/clybry_fam.F90 | 180 --- src/chemistry/geoschem/epp_ionization.F90 | 508 ------- src/chemistry/geoschem/fire_emissions.F90 | 1 - src/chemistry/geoschem/gas_wetdep_opts.F90 | 78 -- src/chemistry/geoschem/mo_apex.F90 | 314 ----- src/chemistry/geoschem/mo_chem_utls.F90 | 180 --- src/chemistry/geoschem/mo_drydep.F90 | 1 - .../geoschem/mo_gas_phase_chemdr.F90 | 1180 ----------------- src/chemistry/geoschem/mo_ghg_chem.F90 | 1 - src/chemistry/geoschem/mo_lightning.F90 | 1 - src/chemistry/geoschem/mo_mean_mass.F90 | 1 - src/chemistry/geoschem/mo_setinv.F90 | 1 - src/chemistry/geoschem/mo_tracname.F90 | 14 - src/chemistry/geoschem/rate_diags.F90 | 177 --- src/chemistry/geoschem/tracer_cnst.F90 | 1 - src/chemistry/geoschem/tracer_srcs.F90 | 1 - src/chemistry/geoschem/upper_bc.F90 | 243 ---- .../modal_aero/modal_aero_gasaerexch.F90 | 5 +- src/chemistry/modal_aero/sox_cldaero_mod.F90 | 7 +- src/chemistry/mozart/mo_chem_utls.F90 | 20 +- 24 files changed, 93 insertions(+), 3129 deletions(-) delete mode 100644 src/chemistry/geoschem/charge_neutrality.F90 delete mode 100644 src/chemistry/geoschem/clybry_fam.F90 delete mode 100644 src/chemistry/geoschem/epp_ionization.F90 delete mode 120000 src/chemistry/geoschem/fire_emissions.F90 delete mode 100644 src/chemistry/geoschem/gas_wetdep_opts.F90 delete mode 100644 src/chemistry/geoschem/mo_apex.F90 delete mode 100644 src/chemistry/geoschem/mo_chem_utls.F90 delete mode 120000 src/chemistry/geoschem/mo_drydep.F90 delete mode 100644 src/chemistry/geoschem/mo_gas_phase_chemdr.F90 delete mode 120000 src/chemistry/geoschem/mo_ghg_chem.F90 delete mode 120000 src/chemistry/geoschem/mo_lightning.F90 delete mode 120000 src/chemistry/geoschem/mo_mean_mass.F90 delete mode 120000 src/chemistry/geoschem/mo_setinv.F90 delete mode 100644 src/chemistry/geoschem/mo_tracname.F90 delete mode 100644 src/chemistry/geoschem/rate_diags.F90 delete mode 120000 src/chemistry/geoschem/tracer_cnst.F90 delete mode 120000 src/chemistry/geoschem/tracer_srcs.F90 delete mode 100644 src/chemistry/geoschem/upper_bc.F90 diff --git a/bld/configure b/bld/configure index fe4c2dfb20..70ffe02a83 100755 --- a/bld/configure +++ b/bld/configure @@ -2187,6 +2187,10 @@ sub write_filepath print $fh "$camsrcdir/src/chemistry/modal_aero\n"; print $fh "$camsrcdir/src/chemistry/aerosol\n"; } + # Also build Mozart for dependencies elsewhere in CESM + # Some modules ignored since also in GEOS-Chem + print $fh "$camsrcdir/src/chemistry/pp_none\n"; + print $fh "$camsrcdir/src/chemistry/mozart\n"; } } diff --git a/src/chemistry/geoschem/cesmgc_diag_mod.F90 b/src/chemistry/geoschem/cesmgc_diag_mod.F90 index 300402f518..b689ef3bb5 100644 --- a/src/chemistry/geoschem/cesmgc_diag_mod.F90 +++ b/src/chemistry/geoschem/cesmgc_diag_mod.F90 @@ -191,6 +191,7 @@ SUBROUTINE CESMGC_Diag_Init( Input_Opt, State_Chm, State_Met ) ! Logical LOGICAL :: Found + LOGICAL :: compare_uppercase ! Compare upper-case names LOGICAL :: history_aerosol ! Output the MAM aerosol ! tendencies LOGICAL :: history_chemistry @@ -239,51 +240,53 @@ SUBROUTINE CESMGC_Diag_Init( Input_Opt, State_Chm, State_Met ) history_scwaccm_forcing_out = history_scwaccm_forcing, & history_dust_out = history_dust ) - id_no3 = get_spc_ndx( 'NO3' ) - id_o3 = get_spc_ndx( 'O3' ) - id_oh = get_spc_ndx( 'OH' ) - id_ho2 = get_spc_ndx( 'HO2' ) - id_so4_a1 = get_spc_ndx( 'so4_a1' ) - id_so4_a2 = get_spc_ndx( 'so4_a2' ) - id_so4_a3 = get_spc_ndx( 'so4_a3' ) - id_num_a2 = get_spc_ndx( 'num_a2' ) - id_num_a3 = get_spc_ndx( 'num_a3' ) - id_dst_a3 = get_spc_ndx( 'dst_a3' ) - id_ncl_a3 = get_spc_ndx( 'ncl_a3' ) - id_co2 = get_spc_ndx( 'CO2' ) - id_no = get_spc_ndx( 'NO' ) - id_h = get_spc_ndx( 'H' ) - id_o = get_spc_ndx( 'O' ) - id_o2 = get_spc_ndx( 'O2' ) - id_ch4 = get_spc_ndx( 'CH4' ) - id_h2o = get_spc_ndx( 'H2O' ) - id_n2o = get_spc_ndx( 'N2O' ) - id_cfc11 = get_spc_ndx( 'CFC11' ) - id_cfc12 = get_spc_ndx( 'CFC12' ) - - id_bry = get_spc_ndx( 'BRY' ) - id_cly = get_spc_ndx( 'CLY' ) - - id_dst01 = get_spc_ndx( 'DST01' ) - id_dst02 = get_spc_ndx( 'DST02' ) - id_dst03 = get_spc_ndx( 'DST03' ) - id_dst04 = get_spc_ndx( 'DST04' ) - id_sslt01 = get_spc_ndx( 'SSLT01' ) - id_sslt02 = get_spc_ndx( 'SSLT02' ) - id_sslt03 = get_spc_ndx( 'SSLT03' ) - id_sslt04 = get_spc_ndx( 'SSLT04' ) - id_soa = get_spc_ndx( 'SOA' ) - id_so4 = get_spc_ndx( 'SO4' ); id_so4 = -1 ! Don't pick up GEOS-Chem's SO4! - id_oc1 = get_spc_ndx( 'OC1' ) - id_oc2 = get_spc_ndx( 'OC2' ) - id_cb1 = get_spc_ndx( 'CB1' ) - id_cb2 = get_spc_ndx( 'CB2' ) - id_nh4no3 = get_spc_ndx( 'NH4NO3' ) - id_soam = get_spc_ndx( 'SOAM' ) - id_soai = get_spc_ndx( 'SOAI' ) - id_soat = get_spc_ndx( 'SOAT' ) - id_soab = get_spc_ndx( 'SOAB' ) - id_soax = get_spc_ndx( 'SOAX' ) + compare_uppercase = .true. + + id_no3 = get_spc_ndx( 'NO3', compare_uppercase ) + id_o3 = get_spc_ndx( 'O3', compare_uppercase ) + id_oh = get_spc_ndx( 'OH', compare_uppercase ) + id_ho2 = get_spc_ndx( 'HO2', compare_uppercase ) + id_so4_a1 = get_spc_ndx( 'so4_a1', compare_uppercase ) + id_so4_a2 = get_spc_ndx( 'so4_a2', compare_uppercase ) + id_so4_a3 = get_spc_ndx( 'so4_a3', compare_uppercase ) + id_num_a2 = get_spc_ndx( 'num_a2', compare_uppercase ) + id_num_a3 = get_spc_ndx( 'num_a3', compare_uppercase ) + id_dst_a3 = get_spc_ndx( 'dst_a3', compare_uppercase ) + id_ncl_a3 = get_spc_ndx( 'ncl_a3', compare_uppercase ) + id_co2 = get_spc_ndx( 'CO2', compare_uppercase ) + id_no = get_spc_ndx( 'NO', compare_uppercase ) + id_h = get_spc_ndx( 'H', compare_uppercase ) + id_o = get_spc_ndx( 'O', compare_uppercase ) + id_o2 = get_spc_ndx( 'O2', compare_uppercase ) + id_ch4 = get_spc_ndx( 'CH4', compare_uppercase ) + id_h2o = get_spc_ndx( 'H2O', compare_uppercase ) + id_n2o = get_spc_ndx( 'N2O', compare_uppercase ) + id_cfc11 = get_spc_ndx( 'CFC11', compare_uppercase ) + id_cfc12 = get_spc_ndx( 'CFC12', compare_uppercase ) + + id_bry = get_spc_ndx( 'BRY', compare_uppercase ) + id_cly = get_spc_ndx( 'CLY', compare_uppercase ) + + id_dst01 = get_spc_ndx( 'DST01', compare_uppercase ) + id_dst02 = get_spc_ndx( 'DST02', compare_uppercase ) + id_dst03 = get_spc_ndx( 'DST03', compare_uppercase ) + id_dst04 = get_spc_ndx( 'DST04', compare_uppercase ) + id_sslt01 = get_spc_ndx( 'SSLT01', compare_uppercase ) + id_sslt02 = get_spc_ndx( 'SSLT02', compare_uppercase ) + id_sslt03 = get_spc_ndx( 'SSLT03', compare_uppercase ) + id_sslt04 = get_spc_ndx( 'SSLT04', compare_uppercase ) + id_soa = get_spc_ndx( 'SOA', compare_uppercase ) + id_so4 = get_spc_ndx( 'SO4', compare_uppercase ); id_so4 = -1 ! Don't pick up GEOS-Chem's SO4! + id_oc1 = get_spc_ndx( 'OC1', compare_uppercase ) + id_oc2 = get_spc_ndx( 'OC2', compare_uppercase ) + id_cb1 = get_spc_ndx( 'CB1', compare_uppercase ) + id_cb2 = get_spc_ndx( 'CB2', compare_uppercase ) + id_nh4no3 = get_spc_ndx( 'NH4NO3', compare_uppercase ) + id_soam = get_spc_ndx( 'SOAM', compare_uppercase ) + id_soai = get_spc_ndx( 'SOAI', compare_uppercase ) + id_soat = get_spc_ndx( 'SOAT', compare_uppercase ) + id_soab = get_spc_ndx( 'SOAB', compare_uppercase ) + id_soax = get_spc_ndx( 'SOAX', compare_uppercase ) bulkaero_species(:) = -1 bulkaero_species(1:20) = (/ id_dst01, id_dst02, id_dst03, id_dst04, & diff --git a/src/chemistry/geoschem/charge_neutrality.F90 b/src/chemistry/geoschem/charge_neutrality.F90 deleted file mode 100644 index 92ec519000..0000000000 --- a/src/chemistry/geoschem/charge_neutrality.F90 +++ /dev/null @@ -1,176 +0,0 @@ -module charge_neutrality - - use shr_kind_mod, only : r8 => shr_kind_r8 - use ppgrid, only : pcols, pver - !use mo_chem_utls, only : get_spc_ndx - - implicit none - - private - public :: charge_balance - - interface charge_balance - module procedure charge_fix_vmr - module procedure charge_fix_mmr ! for fixing charge balance after vertical diffusion - end interface - - !integer, parameter :: pos_ion_n = 22 - !character(len=16), parameter :: pos_ion_names(pos_ion_n) = (/ & - ! 'Np ','N2p ','Op ','O2p ','NOp ', & - ! 'O4p ','O2p_H2O ','Hp_H2O ','Hp_2H2O ','Hp_3H2O ', & - ! 'Hp_4H2O ','Hp_5H2O ','H3Op_OH ','Hp_3N1 ','Hp_4N1 ', & - ! 'NOp_H2O ','NOp_2H2O ','NOp_3H2O ','NOp_CO2 ','NOp_N2 ', & - ! 'Op2P ','Op2D ' /) - - !integer, parameter :: neg_ion_n = 21 - !character(len=16), parameter :: neg_ion_names(neg_ion_n) = (/ & - ! 'Om ','O2m ','O3m ','O4m ','OHm ', & - ! 'CO3m ','CO4m ','NO2m ','NO3m ','HCO3m ', & - ! 'CLm ','CLOm ','CLm_H2O ','CLm_HCL ','CO3m_H2O ', & - ! 'NO3m_H2O ','CO3m2H2O ','NO2m_H2O ','NO3m2H2O ','NO3mHNO3 ', & - ! 'NO3m_HCL ' /) - -contains - - !----------------------------------------------------------------------- - ! ... force ion/electron balance - !----------------------------------------------------------------------- - subroutine charge_fix_vmr( ncol, vmr ) - - !----------------------------------------------------------------------- - ! ... dummy arguments - !----------------------------------------------------------------------- - integer, intent(in) :: ncol - real(r8), intent(inout) :: vmr(:,:,:) ! concentration - - !----------------------------------------------------------------------- - ! ... local variables - !----------------------------------------------------------------------- - integer :: i, n - integer :: elec_ndx - real(r8) :: wrk(ncol,pver) - - !elec_ndx = get_spc_ndx('e') - - !!-------------------------------------------------------------------- - !! If electrons are in the chemistry add up charges to get electrons - !!-------------------------------------------------------------------- - !if( elec_ndx > 0 ) then - ! wrk(:,:) = 0._r8 - - ! do i = 1,pos_ion_n - ! n = get_spc_ndx(pos_ion_names(i)) - ! if (n>0) then - ! wrk(:ncol,:) = wrk(:ncol,:) + vmr(:ncol,:,n) - ! endif - ! enddo - ! do i = 1,neg_ion_n - ! n = get_spc_ndx(neg_ion_names(i)) - ! if (n>0) then - ! wrk(:ncol,:) = wrk(:ncol,:) - vmr(:ncol,:,n) - ! endif - ! enddo - - ! where ( wrk(:,:)<0._r8 ) - ! wrk(:,:)=0._r8 - ! end where - - ! vmr(:ncol,:,elec_ndx) = wrk(:ncol,:) - - !end if - - end subroutine charge_fix_vmr - - !----------------------------------------------------------------------- - ! ... force ion/electron balance - !----------------------------------------------------------------------- - subroutine charge_fix_mmr(state, pbuf) - - use constituents, only : cnst_get_ind - use physconst, only : mbarv ! Constituent dependent mbar - use short_lived_species, only : slvd_index,slvd_pbf_ndx => pbf_idx ! Routines to access short lived species in pbuf - use chem_mods, only : adv_mass - use physics_buffer, only : pbuf_get_field,physics_buffer_desc ! Needed to get variables from physics buffer - use physics_types, only : physics_state - - !----------------------------------------------------------------------- - ! ... dummy arguments - !----------------------------------------------------------------------- - type(physics_state), intent(inout), target :: state - type(physics_buffer_desc), pointer :: pbuf(:) ! physics buffer - - !----------------------------------------------------------------------- - ! ... local variables - !----------------------------------------------------------------------- - !integer :: i, n, ns, nc - !integer :: elec_ndx - !integer :: lchnk !Chunk number from state structure - !integer :: ncol !Number of columns in this chunk from state structure - - !real(r8), dimension(:,:,:), pointer :: q ! model mass mixing ratios - !real(r8), dimension(:,:), pointer :: qs ! Pointer to access fields in pbuf - - !character(len=16) :: name - !real(r8) :: vmr(state%ncol,pver) - !real(r8) :: wrk(state%ncol,pver) - - !!----------------------------------------------------------------------- - !elec_ndx = get_spc_ndx('e') - - !!-------------------------------------------------------------------- - !! If electrons are simulated enforce charge neutrality ... - !!-------------------------------------------------------------------- - !if( elec_ndx > 0 ) then - ! lchnk = state%lchnk - ! ncol = state%ncol - ! q => state%q - ! wrk(:,:) = 0._r8 - - ! do i = 1,pos_ion_n+neg_ion_n - ! if (i .le. pos_ion_n) then - ! name = pos_ion_names(i) - ! else - ! name = neg_ion_names(i-pos_ion_n) - ! endif - ! n = get_spc_ndx(name) - - ! if (n>0) then - ! call cnst_get_ind( name, nc, abort=.false. ) - ! if (nc>0) then - ! vmr(:ncol,:) = mbarv(:ncol,:,lchnk) * q(:ncol,:,nc) / adv_mass(n) - ! else - ! ! not transported - ! ns = slvd_index( name ) - ! if (ns>0) then - ! call pbuf_get_field(pbuf, slvd_pbf_ndx, qs, start=(/1,1,ns/), kount=(/pcols,pver,1/) ) - ! vmr(:ncol,:) = mbarv(:ncol,:,lchnk) * qs(:ncol,:) / adv_mass(n) - ! endif - ! endif - ! if (i .le. pos_ion_n) then - ! wrk(:ncol,:) = wrk(:ncol,:) + vmr(:ncol,:) - ! else - ! wrk(:ncol,:) = wrk(:ncol,:) - vmr(:ncol,:) - ! endif - ! end if - ! end do - - ! where ( wrk(:,:)<0._r8 ) - ! wrk(:,:)=0._r8 - ! end where - - ! call cnst_get_ind( 'e', nc, abort=.false. ) - - ! if (nc>0) then - ! q(:ncol,:,nc) = adv_mass(elec_ndx) * wrk(:ncol,:) / mbarv(:ncol,:,lchnk) - ! else - ! ! not transported - ! ns = slvd_index( 'e' ) - ! call pbuf_get_field(pbuf, slvd_pbf_ndx, qs, start=(/1,1,ns/), kount=(/pcols,pver,1/) ) - ! qs(:ncol,:) = adv_mass(elec_ndx) * wrk(:ncol,:) / mbarv(:ncol,:,lchnk) - ! endif - - !endif - - end subroutine charge_fix_mmr - -end module charge_neutrality diff --git a/src/chemistry/geoschem/chemistry.F90 b/src/chemistry/geoschem/chemistry.F90 index 48699a0590..46dcf32309 100644 --- a/src/chemistry/geoschem/chemistry.F90 +++ b/src/chemistry/geoschem/chemistry.F90 @@ -181,13 +181,16 @@ module chemistry contains !================================================================================================ - logical function chem_is (name) + function chem_is (name) result (chem_name_is) - use mo_chem_utls, only : utls_chem_is + use string_utils, only : to_lower character(len=*), intent(in) :: name - chem_is = utls_chem_is(name) + logical :: chem_name_is + + chem_name_is = (( to_lower(name) == 'geoschem' ) .or. & + ( to_lower(name) == 'geos-chem' )) end function chem_is @@ -467,7 +470,7 @@ subroutine chem_register map2GCinv(M) = N ENDIF ! Map constituent onto chemically-active species (aka as indexed in solsym) - M = get_spc_ndx(TRIM(trueName)) + M = get_spc_ndx(TRIM(trueName), compare_uppercase=.true.) IF ( M > 0 ) THEN mapCnst(N) = M ENDIF @@ -529,7 +532,7 @@ subroutine chem_register ! The species names need to be convert to upper case as, ! for instance, BR2 != Br2 - drySpc_ndx(N) = get_spc_ndx( to_upper(drydep_list(N)) ) + drySpc_ndx(N) = get_spc_ndx( to_upper(drydep_list(N)), compare_uppercase=.true. ) if (debug .and. masterproc) write(iulog,'(a,a,a,i4,a,i4)') ' -> species ', trim(drydep_list(N)), ' in dry deposition list at index ', N, ' maps to species in solsym at index ', drySpc_ndx(N) @@ -1643,8 +1646,8 @@ subroutine chem_init(phys_state, pbuf2d) ! Free pointer SpcInfo => NULL() - l_H2SO4 = get_spc_ndx('H2SO4') - l_SO4 = get_spc_ndx('SO4') + l_H2SO4 = get_spc_ndx('H2SO4', compare_uppercase=.true.) + l_SO4 = get_spc_ndx('SO4', compare_uppercase=.true.) ! Get indices for physical fields in physics buffer NDX_PBLH = pbuf_get_index('pblh' ) @@ -3893,10 +3896,10 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) speciesName_2 = 'ASOAN' speciesName_2 = 'SOAIE' speciesName_2 = 'SOAGX' - K1 = get_spc_ndx(TRIM(speciesName_1)) - K2 = get_spc_ndx(TRIM(speciesName_2)) - K3 = get_spc_ndx(TRIM(speciesName_3)) - K4 = get_spc_ndx(TRIM(speciesName_4)) + K1 = get_spc_ndx(TRIM(speciesName_1), compare_uppercase=.true.) + K2 = get_spc_ndx(TRIM(speciesName_2), compare_uppercase=.true.) + K3 = get_spc_ndx(TRIM(speciesName_3), compare_uppercase=.true.) + K4 = get_spc_ndx(TRIM(speciesName_4), compare_uppercase=.true.) bulkMass(:nY,:nZ) = 0.0e+00_r8 DO iBin = 1, 2 DO M = 1, ntot_amode @@ -3930,8 +3933,8 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) speciesName_1 = 'TSOA3' speciesName_2 = 'ASOA3' ENDIF - K1 = get_spc_ndx(TRIM(speciesName_1)) - K2 = get_spc_ndx(TRIM(speciesName_2)) + K1 = get_spc_ndx(TRIM(speciesName_1), compare_uppercase=.true. ) + K2 = get_spc_ndx(TRIM(speciesName_2), compare_uppercase=.true. ) bulkMass(:nY,:nZ) = 0.0e+00_r8 DO M = 1, ntot_amode N = lptr2_soa_a_amode(M,iBin) @@ -3952,7 +3955,7 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) ! Now deal with gaseous SOA species ! Deal with lowest two volatility bins speciesName_1 = 'TSOG0' - K1 = get_spc_ndx(TRIM(speciesName_1)) + K1 = get_spc_ndx(TRIM(speciesName_1), compare_uppercase=.true.) N = lptr2_soa_g_amode(1) P = mapCnst(N) vmr1(:nY,:nZ,P) = vmr0(:nY,:nZ,P) / (vmr0(:nY,:nZ,P) + vmr0(:nY,:nZ,mapCnst(lptr2_soa_g_amode(2)))) & @@ -3976,8 +3979,8 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) speciesName_1 = 'TSOG3' speciesName_2 = 'ASOG3' ENDIF - K1 = get_spc_ndx(TRIM(speciesName_1)) - K2 = get_spc_ndx(TRIM(speciesName_2)) + K1 = get_spc_ndx(TRIM(speciesName_1), compare_uppercase=.true.) + K2 = get_spc_ndx(TRIM(speciesName_2), compare_uppercase=.true.) IF ( P > 0 .AND. K1 > 0 .AND. K2 > 0 ) vmr1(:nY,:nZ,P) = vmr1(:nY,:nZ,K1) + vmr1(:nY,:nZ,K2) ENDDO diff --git a/src/chemistry/geoschem/clybry_fam.F90 b/src/chemistry/geoschem/clybry_fam.F90 deleted file mode 100644 index d53a32fdf0..0000000000 --- a/src/chemistry/geoschem/clybry_fam.F90 +++ /dev/null @@ -1,180 +0,0 @@ -!----------------------------------------------------------------------- -! -! Manages the adjustment of ClOy and BrOy family components in response -! to conservation issues resulting from advection. -! -! Created by: Francis Vitt -! Date: 21 May 2008 -! Modified by Stacy Walters -! Date: 13 August 2008 -!----------------------------------------------------------------------- - -module clybry_fam - - use shr_kind_mod, only : r8 => shr_kind_r8 - use ppgrid, only : pcols, pver - use chem_mods, only : gas_pcnst, adv_mass - use constituents, only : pcnst - use short_lived_species,only: set_short_lived_species,get_short_lived_species - - implicit none - - save - - private - public :: clybry_fam_set - public :: clybry_fam_adj - public :: clybry_fam_init - - integer :: id_cly,id_bry - - integer :: id_cl,id_clo,id_hocl,id_cl2,id_cl2o2,id_oclo,id_hcl,id_clono2 - integer :: id_br,id_bro,id_hbr,id_brono2,id_brcl,id_hobr - - logical :: has_clybry - -contains - - !------------------------------------------ - !------------------------------------------ - subroutine clybry_fam_init - - !use mo_chem_utls, only : get_spc_ndx - implicit none - - integer :: ids(16) - - !id_cly = get_spc_ndx('CLY') - !id_bry = get_spc_ndx('BRY') - - !id_cl = get_spc_ndx('CL') - !id_clo = get_spc_ndx('CLO') - !id_hocl = get_spc_ndx('HOCL') - !id_cl2 = get_spc_ndx('CL2') - !id_cl2o2 = get_spc_ndx('CL2O2') - !id_oclo = get_spc_ndx('OCLO') - !id_hcl = get_spc_ndx('HCL') - !id_clono2 = get_spc_ndx('CLONO2') - - !id_br = get_spc_ndx('BR') - !id_bro = get_spc_ndx('BRO') - !id_hbr = get_spc_ndx('HBR') - !id_brono2 = get_spc_ndx('BRONO2') - !id_brcl = get_spc_ndx('BRCL') - !id_hobr = get_spc_ndx('HOBR') - - !ids = (/ id_cly,id_bry, & - ! id_cl,id_clo,id_hocl,id_cl2,id_cl2o2,id_oclo,id_hcl,id_clono2, & - ! id_br,id_bro,id_hbr,id_brono2,id_brcl,id_hobr /) - - !has_clybry = all( ids(:) > 0 ) - - endsubroutine clybry_fam_init - -!-------------------------------------------------------------- -! set the ClOy and BrOy mass mixing ratios -! - this is call before advection -!-------------------------------------------------------------- - subroutine clybry_fam_set( ncol, lchnk, map2chm, q, pbuf ) - - use time_manager, only : get_nstep - use physics_buffer, only : physics_buffer_desc - - implicit none - -!-------------------------------------------------------------- -! ... dummy arguments -!-------------------------------------------------------------- - integer, intent(in) :: ncol, lchnk - integer, intent(in) :: map2chm(pcnst) - real(r8), intent(inout) :: q(pcols,pver,pcnst) - type(physics_buffer_desc), pointer :: pbuf(:) - - !real(r8) :: wrk(ncol,pver,2) - !real(r8) :: mmr(pcols,pver,gas_pcnst) - !integer :: n, m - - if (.not. has_clybry) return - - end subroutine clybry_fam_set - -!-------------------------------------------------------------- -! adjust the ClOy and BrOy individual family members -! - this is call after advection -!-------------------------------------------------------------- - subroutine clybry_fam_adj( ncol, lchnk, map2chm, q, pbuf ) - - use time_manager, only : is_first_step - use physics_buffer, only : physics_buffer_desc - - implicit none - -!-------------------------------------------------------------- -! ... dummy arguments -!-------------------------------------------------------------- - integer, intent(in) :: ncol, lchnk - integer, intent(in) :: map2chm(pcnst) - real(r8), intent(inout) :: q(pcols,pver,pcnst) - type(physics_buffer_desc), pointer :: pbuf(:) - - end subroutine clybry_fam_adj - -!-------------------------------------------------------------- -! private methods -!-------------------------------------------------------------- - -!-------------------------------------------------------------- -! compute the mass mixing retio of ClOy -!-------------------------------------------------------------- - function cloy( q, pcols, ncol ) - -!-------------------------------------------------------------- -! ... dummy arguments -!-------------------------------------------------------------- - integer, intent(in) :: pcols - integer, intent(in) :: ncol - real(r8), intent(in) :: q(pcols,pver,gas_pcnst) - -!-------------------------------------------------------------- -! ... function declaration -!-------------------------------------------------------------- - real(r8) :: cloy(ncol,pver) - -!-------------------------------------------------------------- -! ... local variables -!-------------------------------------------------------------- - real(r8) :: wrk(ncol) - integer :: k - - cloy = 0._r8 - - end function cloy - -!-------------------------------------------------------------- -! compute the mass mixing retio of BrOy -!-------------------------------------------------------------- - function broy( q, pcols, ncol ) - -!-------------------------------------------------------------- -! ... dummy arguments -!-------------------------------------------------------------- - integer, intent(in) :: pcols - integer, intent(in) :: ncol - real(r8), intent(in) :: q(pcols,pver,gas_pcnst) - -!-------------------------------------------------------------- -! ... function declaration -!-------------------------------------------------------------- - real(r8) :: broy(ncol,pver) - -!-------------------------------------------------------------- -! ... local variables -!-------------------------------------------------------------- - real(r8) :: wrk(ncol) - integer :: k - - broy = 0._r8 - - end function broy - -end module clybry_fam diff --git a/src/chemistry/geoschem/epp_ionization.F90 b/src/chemistry/geoschem/epp_ionization.F90 deleted file mode 100644 index 98276cd5f3..0000000000 --- a/src/chemistry/geoschem/epp_ionization.F90 +++ /dev/null @@ -1,508 +0,0 @@ -!------------------------------------------------------------------------------- -! Energetic Particle Precipitation (EPP) forcings module -! Manages ionization of the atmosphere due to energetic particles, which consists of -! solar protons events (SPE), galactic cosmic rays(GCR), medium energy electrons (MEE) -!------------------------------------------------------------------------------- -module epp_ionization - use shr_kind_mod, only : r8 => shr_kind_r8, cs => shr_kind_cs, cl=> shr_kind_cl - use spmd_utils, only : masterproc - use cam_abortutils, only : endrun - use cam_logfile, only : iulog - use phys_grid, only : pcols, pver, begchunk, endchunk, get_ncols_p - use pio, only : var_desc_t, file_desc_t - use pio, only : pio_get_var, pio_inq_varid, pio_get_att - use pio, only : pio_inq_varndims, pio_inq_vardimid, pio_inq_dimname, pio_inq_dimlen - use pio, only : PIO_NOWRITE - use cam_pio_utils, only : cam_pio_openfile - use ioFileMod, only : getfil - use input_data_utils, only : time_coordinate - - implicit none - private - - public :: epp_ionization_readnl ! read namelist variables - public :: epp_ionization_init ! initialization - public :: epp_ionization_adv ! read and time/space interpolate the data - public :: epp_ionization_ionpairs! ion pairs production rates - public :: epp_ionization_setmag ! update geomagnetic coordinates mapping - public :: epp_ionization_active - - character(len=cl) :: epp_all_filepath = 'NONE' - character(len=cs) :: epp_all_varname = 'epp_ion_rates' - character(len=cl) :: epp_mee_filepath = 'NONE' - character(len=cs) :: epp_mee_varname = 'iprm' - character(len=cl) :: epp_spe_filepath = 'NONE' - character(len=cs) :: epp_spe_varname = 'iprp' - character(len=cl) :: epp_gcr_filepath = 'NONE' - character(len=cs) :: epp_gcr_varname = 'iprg' - - logical, protected :: epp_ionization_active = .false. - - type input_obj_t - type(file_desc_t) :: fid - type(var_desc_t) :: vid - character(len=32) :: units - integer :: nlevs = 0 - integer :: nglats = 0 - real(r8), allocatable :: press(:) - real(r8), allocatable :: glats(:) - real(r8), allocatable :: gwght(:,:) ! (pcol, begchunk:endchunk) - integer, allocatable :: glatn(:,:) ! (pcol, begchunk:endchunk) - real(r8), allocatable :: indata(:,:,:,:) ! (pcol,nlevs,begchunk:endchunk,2) inputs at indexm and indexp - type(time_coordinate) :: time_coord - endtype input_obj_t - - type(input_obj_t), pointer :: epp_in => null() - type(input_obj_t), pointer :: spe_in => null() - type(input_obj_t), pointer :: mee_in => null() - type(input_obj_t), pointer :: gcr_in => null() - -contains - - !----------------------------------------------------------------------------- - !----------------------------------------------------------------------------- - subroutine epp_ionization_readnl(nlfile) - - use namelist_utils, only: find_group_name - use units, only: getunit, freeunit - use spmd_utils, only: mpicom, mpi_character, masterprocid - - character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input - - !! Local variables - !integer :: unitn, ierr - !character(len=*), parameter :: subname = 'epp_ionization_readnl' - - !namelist /epp_ionization_nl/ epp_all_filepath, epp_all_varname, & - ! epp_mee_filepath, epp_mee_varname, epp_spe_filepath, epp_spe_varname, epp_gcr_filepath, epp_gcr_varname - - !! Read namelist - !if (masterproc) then - ! unitn = getunit() - ! open( unitn, file=trim(nlfile), status='old' ) - ! call find_group_name(unitn, 'epp_ionization_nl', status=ierr) - ! if (ierr == 0) then - ! read(unitn, epp_ionization_nl, iostat=ierr) - ! if (ierr /= 0) then - ! call endrun(subname // ':: ERROR reading namelist') - ! end if - ! end if - ! close(unitn) - ! call freeunit(unitn) - !end if - - !! Broadcast namelist variables - !call mpi_bcast(epp_all_filepath, len(epp_all_filepath), mpi_character, masterprocid, mpicom, ierr) - !call mpi_bcast(epp_mee_filepath, len(epp_mee_filepath), mpi_character, masterprocid, mpicom, ierr) - !call mpi_bcast(epp_spe_filepath, len(epp_spe_filepath), mpi_character, masterprocid, mpicom, ierr) - !call mpi_bcast(epp_gcr_filepath, len(epp_gcr_filepath), mpi_character, masterprocid, mpicom, ierr) - - !call mpi_bcast(epp_all_varname, len(epp_all_varname), mpi_character, masterprocid, mpicom, ierr) - !call mpi_bcast(epp_mee_varname, len(epp_mee_varname), mpi_character, masterprocid, mpicom, ierr) - !call mpi_bcast(epp_spe_varname, len(epp_spe_varname), mpi_character, masterprocid, mpicom, ierr) - !call mpi_bcast(epp_gcr_varname, len(epp_gcr_varname), mpi_character, masterprocid, mpicom, ierr) - - !epp_ionization_active = epp_all_filepath /= 'NONE' - !epp_ionization_active = epp_mee_filepath /= 'NONE' .or. epp_ionization_active - !epp_ionization_active = epp_spe_filepath /= 'NONE' .or. epp_ionization_active - !epp_ionization_active = epp_gcr_filepath /= 'NONE' .or. epp_ionization_active - - !if ( epp_ionization_active .and. masterproc ) then - ! write(iulog,*) subname//':: epp_all_filepath = '//trim(epp_all_filepath) - ! write(iulog,*) subname//':: epp_mee_filepath = '//trim(epp_mee_filepath) - ! write(iulog,*) subname//':: epp_spe_filepath = '//trim(epp_spe_filepath) - ! write(iulog,*) subname//':: epp_gcr_filepath = '//trim(epp_gcr_filepath) - !endif - - end subroutine epp_ionization_readnl - - !----------------------------------------------------------------------------- - !----------------------------------------------------------------------------- - subroutine epp_ionization_init() - !use cam_history, only : addfld - - !character(len=32) :: fldunits - !fldunits = '' - ! - !if (epp_all_filepath /= 'NONE') then - ! epp_in => create_input_obj(epp_all_filepath,epp_all_varname) - ! fldunits = trim(epp_in%units) - !else - ! if (epp_mee_filepath /= 'NONE') then - ! mee_in => create_input_obj(epp_mee_filepath,epp_mee_varname) - ! fldunits = trim(mee_in%units) - ! endif - ! if (epp_spe_filepath /= 'NONE') then - ! spe_in => create_input_obj(epp_spe_filepath,epp_spe_varname) - ! fldunits = trim(spe_in%units) - ! endif - ! if (epp_gcr_filepath /= 'NONE') then - ! gcr_in => create_input_obj(epp_gcr_filepath,epp_gcr_varname) - ! fldunits = trim(gcr_in%units) - ! endif - !endif - !call addfld( 'EPPions', (/ 'lev' /), 'A', fldunits, 'EPP ionization data' ) - - end subroutine epp_ionization_init - - !----------------------------------------------------------------------------- - !----------------------------------------------------------------------------- - subroutine epp_ionization_setmag( maglat ) - real(r8), intent(in) :: maglat(pcols,begchunk:endchunk) - - if (.not.epp_ionization_active) return - - !if ( associated(epp_in) ) then - ! call set_wghts(maglat,epp_in) - !else - ! if ( associated(mee_in) ) then - ! call set_wghts(maglat,mee_in) - ! endif - ! if ( associated(spe_in) ) then - ! call set_wghts(maglat,spe_in) - ! endif - ! if ( associated(gcr_in) ) then - ! call set_wghts(maglat,gcr_in) - ! endif - !endif - - end subroutine epp_ionization_setmag - - !----------------------------------------------------------------------------- - !----------------------------------------------------------------------------- - subroutine epp_ionization_adv - - if (.not.epp_ionization_active) return - - !if ( associated(epp_in) ) then - ! call update_input(epp_in) - !else - ! if ( associated(spe_in) ) then - ! call update_input(spe_in) - ! endif - ! if ( associated(gcr_in) ) then - ! call update_input(gcr_in) - ! endif - ! if ( associated(mee_in) ) then - ! call update_input(mee_in) - ! endif - !endif - - end subroutine epp_ionization_adv - - !----------------------------------------------------------------------------- - !----------------------------------------------------------------------------- - subroutine epp_ionization_ionpairs( ncol, lchnk, pmid, temp, ionpairs ) - - integer, intent(in) :: ncol, lchnk - real(r8), intent(in) :: pmid(:,:), temp(:,:) - real(r8), intent(out) :: ionpairs(:,:) ! ion pair production rate - - ionpairs = 0._r8 - if (.not.epp_ionization_active) return - - !if ( associated(epp_in) ) then - ! ionpairs(:ncol,:) = ionpairs(:ncol,:) + interp_ionpairs( ncol, lchnk, pmid, temp, epp_in ) - !else - ! if ( associated(spe_in) ) then - ! ionpairs(:ncol,:) = ionpairs(:ncol,:) + interp_ionpairs( ncol, lchnk, pmid, temp, spe_in ) - ! endif - ! if ( associated(gcr_in) ) then - ! ionpairs(:ncol,:) = ionpairs(:ncol,:) + interp_ionpairs( ncol, lchnk, pmid, temp, gcr_in ) - ! endif - ! if ( associated(mee_in) ) then - ! ionpairs(:ncol,:) = ionpairs(:ncol,:) + interp_ionpairs( ncol, lchnk, pmid, temp, mee_in ) - ! endif - !endif - - end subroutine epp_ionization_ionpairs - - ! private methods - !----------------------------------------------------------------------------- - !----------------------------------------------------------------------------- - subroutine update_input( input ) - type(input_obj_t), pointer :: input - - if ( input%time_coord%read_more() ) then - call input%time_coord%advance() - call read_next_data( input ) - else - call input%time_coord%advance() - endif - - end subroutine update_input - - !----------------------------------------------------------------------------- - !----------------------------------------------------------------------------- - subroutine read_next_data( input ) - type(input_obj_t), pointer :: input - - !! read data corresponding surrounding time indices - !if ( input%nglats > 0 ) then - ! call read_2d_profile( input ) - !else - ! call read_1d_profile( input ) - !endif - - end subroutine read_next_data - - !----------------------------------------------------------------------------- - !----------------------------------------------------------------------------- - function interp_ionpairs( ncol, lchnk, pmid, temp, input ) result( ionpairs ) - use interpolate_data, only : lininterp - use physconst, only : rairv - use cam_history, only : outfld - - integer, intent(in) :: ncol, lchnk - real(r8), intent(in) :: pmid(:,:) ! Pa - real(r8), intent(in) :: temp(:,:) ! K - type(input_obj_t), pointer :: input - real(r8) :: ionpairs(ncol,pver) - - real(r8) :: fctr1, fctr2 - real(r8) :: wrk(ncol,input%nlevs) - real(r8) :: ions_diags(ncol,pver) ! for diagnostics - integer :: i - - !if (input%time_coord%time_interp) then - ! ! time interpolate - ! fctr1 = input%time_coord%wghts(1) - ! fctr2 = input%time_coord%wghts(2) - ! wrk(:ncol,:) = fctr1*input%indata(:ncol,:,lchnk,1) + fctr2*input%indata(:ncol,:,lchnk,2) - !else - ! wrk(:ncol,:) = input%indata(:ncol,:,lchnk,1) - !endif - - !! vertical interpolate ... - !! interpolate to model levels - !do i = 1,ncol - - ! ! interpolate over log pressure - ! call lininterp( wrk(i,:input%nlevs), log(input%press(:input%nlevs)*1.e2_r8), input%nlevs, & - ! ionpairs(i,:pver), log(pmid(i,:pver)), pver ) - ! ions_diags(i,:pver) = ionpairs(i,:pver) - ! - ! if ( index(trim(input%units), 'g^-1') > 0 ) then - ! ! convert to ionpairs/cm3/sec - ! ionpairs(i,:pver) = ionpairs(i,:pver) *(1.e-3_r8*pmid(i,:pver)/(rairv(i,:pver,lchnk)*temp(i,:pver))) - ! endif - !enddo - - !call outfld( 'EPPions', ions_diags(:ncol,:), ncol, lchnk ) - - end function interp_ionpairs - - !----------------------------------------------------------------------------- - ! read 2D profile (geomag-lat vs press) and transfer to geographic grid - !----------------------------------------------------------------------------- - subroutine read_2d_profile( input ) - - type(input_obj_t), pointer :: input - - ! local vars - real(r8) :: wrk2d( input%nglats, input%nlevs, 2 ) - integer :: t, c, i, ntimes, ncols, ierr - real(r8) :: wght1, wght2 - integer :: gndx1, gndx2 - integer :: cnt(3), strt(3) - - !if (input%time_coord%time_interp) then - ! ntimes = 2 - !else - ! ntimes = 1 - !endif - - !cnt(1) = input%nglats - !cnt(2) = input%nlevs - !cnt(3) = ntimes - - !strt(:) = 1 - !strt(3) = input%time_coord%indxs(1) - - !ierr = pio_get_var( input%fid, input%vid, strt, cnt, wrk2d ) - - !do t = 1,ntimes - ! do c=begchunk,endchunk - ! ncols = get_ncols_p(c) - ! do i = 1,ncols - ! gndx1 = input%glatn(i,c) - ! if (gndx1>0) then - ! wght1 = input%gwght(i,c) - ! gndx2 = gndx1+1 - ! if (gndx2.le.input%nglats) then - ! wght2 = 1._r8-wght1 - ! input%indata(i,:,c,t) = wght1*wrk2d(gndx1,:,t) & - ! + wght2*wrk2d(gndx2,:,t) - ! else - ! input%indata(i,:,c,t) = wght1*wrk2d(gndx1,:,t) - ! endif - ! else - ! input%indata(i,:,c,t) = 0._r8 - ! endif - ! end do - ! end do - !end do - - end subroutine read_2d_profile - - !----------------------------------------------------------------------------- - ! read 1D vertical profile and transfer to geographic grid poleward of 60 degrees geomag-lat - !----------------------------------------------------------------------------- - subroutine read_1d_profile( input ) - - type(input_obj_t), pointer :: input - - ! local vars - real(r8) :: wrk( input%nlevs, 2 ) - integer :: t, c, i, ntimes, ncols, ierr - integer :: cnt(2), strt(2) - - !if (input%time_coord%time_interp) then - ! ntimes = 2 - !else - ! ntimes = 1 - !endif - - !cnt(1) = input%nlevs - !cnt(2) = ntimes - - !strt(:) = 1 - !strt(2) = input%time_coord%indxs(1) - - !ierr = pio_get_var( input%fid, input%vid, strt, cnt, wrk ) - - !do t = 1,ntimes - ! do c=begchunk,endchunk - ! ncols = get_ncols_p(c) - ! do i = 1,ncols - ! input%indata(i,:,c,t) = input%gwght(i,c)*wrk(:,t) - ! end do - ! end do - !end do - - end subroutine read_1d_profile - - !----------------------------------------------------------------------------- - !----------------------------------------------------------------------------- - function create_input_obj( path, varname ) result(in_obj) - use infnan, only : nan, assignment(=) - - character(*), intent(in) :: path - character(*), intent(in) :: varname - type(input_obj_t), pointer :: in_obj - - character(len=cl) :: filen - character(len=cl) :: data_units - character(len=cs) :: dimname - integer :: i, ierr - integer, allocatable :: dimids(:) - integer :: pres_did, pres_vid, glat_did, glat_vid, ndims - - if (path .eq. 'NONE') return - - !allocate(in_obj) - - !call in_obj%time_coord%initialize( path ) - - !call getfil( path, filen, 0 ) - !call cam_pio_openfile( in_obj%fid, filen, PIO_NOWRITE ) - - !ierr = pio_inq_varid( in_obj%fid, varname, in_obj%vid ) - - !ierr = pio_get_att( in_obj%fid, in_obj%vid, 'units', data_units) - !in_obj%units = trim(data_units(1:32)) - - !ierr = pio_inq_varndims( in_obj%fid, in_obj%vid, ndims ) - !allocate( dimids(ndims) ) - - !ierr = pio_inq_vardimid( in_obj%fid, in_obj%vid, dimids) - !pres_did = -1 - !glat_did = -1 - !do i = 1,ndims - ! ierr = pio_inq_dimname( in_obj%fid, dimids(i), dimname ) - ! select case( trim(dimname(1:4)) ) - ! case ( 'pres', 'lev', 'plev' ) - ! pres_did = dimids(i) - ! ierr = pio_inq_varid( in_obj%fid, dimname, pres_vid) - ! case ( 'glat' ) - ! glat_did = dimids(i) - ! ierr = pio_inq_varid( in_obj%fid, dimname, glat_vid) - ! case default - ! end select - !end do - - !deallocate( dimids ) - - !if (pres_did>0) then - ! ierr = pio_inq_dimlen( in_obj%fid, pres_did, in_obj%nlevs ) - ! allocate( in_obj%press(in_obj%nlevs) ) - ! ierr = pio_get_var( in_obj%fid, pres_vid, in_obj%press ) - !endif - !if (glat_did>0) then - ! ierr = pio_inq_dimlen( in_obj%fid, glat_did, in_obj%nglats ) - ! allocate( in_obj%glats(in_obj%nglats) ) - ! ierr = pio_get_var( in_obj%fid, glat_vid, in_obj%glats ) - ! allocate( in_obj%glatn(pcols,begchunk:endchunk) ) - !endif - ! - !allocate( in_obj%gwght(pcols,begchunk:endchunk) ) - - !if (in_obj%time_coord%time_interp) then - ! allocate( in_obj%indata(pcols,in_obj%nlevs,begchunk:endchunk,2) ) - !else - ! allocate( in_obj%indata(pcols,in_obj%nlevs,begchunk:endchunk,1) ) - !endif - !in_obj%indata = nan - - end function create_input_obj - - !----------------------------------------------------------------------- - !----------------------------------------------------------------------- - subroutine set_wghts( maglat, input ) - - real(r8), intent(in) :: maglat(pcols,begchunk:endchunk) - type(input_obj_t), pointer :: input - - integer :: i, c, ncols, imag - - !if (input%nglats>1) then ! read in general EPP 2D ionpairs production rates - ! do c = begchunk,endchunk - ! ncols = get_ncols_p(c) - ! col_loop: do i = 1,ncols - ! if ( maglat(i,c) .lt. input%glats(1) ) then - ! input%glatn(i,c) = 1 - ! input%gwght(i,c) = 1._r8 - ! elseif ( maglat(i,c) .gt. input%glats(input%nglats) ) then - ! input%glatn(i,c) = input%nglats - ! input%gwght(i,c) = 1._r8 - ! else - ! mag_loop: do imag = 1,input%nglats-1 - ! if ( maglat(i,c) .ge. input%glats(imag) .and. & - ! maglat(i,c) .lt. input%glats(imag+1) ) then - ! input%gwght(i,c) = (input%glats(imag+1)-maglat(i,c) ) & - ! / (input%glats(imag+1)-input%glats(imag)) - ! input%glatn(i,c) = imag - ! exit mag_loop - ! endif - ! enddo mag_loop - ! endif - ! enddo col_loop - ! enddo - !else ! read in 1D SPE ionpairs profile ... - ! do c = begchunk,endchunk - ! ncols = get_ncols_p(c) - ! do i = 1,ncols - ! if ( abs(maglat(i,c)) .ge. 60._r8 ) then ! poleward of 60 degrees - ! input%gwght(i,c) = 1._r8 - ! else - ! input%gwght(i,c) = 0._r8 - ! endif - ! enddo - ! enddo - !endif - - !call read_next_data( input ) ! update the inputs when wghts are updated - - end subroutine set_wghts - -end module epp_ionization diff --git a/src/chemistry/geoschem/fire_emissions.F90 b/src/chemistry/geoschem/fire_emissions.F90 deleted file mode 120000 index 7b9f50ff22..0000000000 --- a/src/chemistry/geoschem/fire_emissions.F90 +++ /dev/null @@ -1 +0,0 @@ -../mozart/fire_emissions.F90 \ No newline at end of file diff --git a/src/chemistry/geoschem/gas_wetdep_opts.F90 b/src/chemistry/geoschem/gas_wetdep_opts.F90 deleted file mode 100644 index 614eb50727..0000000000 --- a/src/chemistry/geoschem/gas_wetdep_opts.F90 +++ /dev/null @@ -1,78 +0,0 @@ -!----------------------------------------------------------------------- -! Reads namelist options for gas-phase wet deposition -! -! Created by Francis Vitt -- 22 Apr 2011 -!----------------------------------------------------------------------- -module gas_wetdep_opts - - use constituents, only : pcnst - use cam_logfile, only : iulog - use constituents, only : pcnst - use spmd_utils, only : masterproc - use cam_abortutils, only : endrun - - implicit none - - character(len=16), protected :: gas_wetdep_list(pcnst) = ' ' - character(len=9), protected :: gas_wetdep_method = 'MOZ' - integer, protected :: gas_wetdep_cnt = 0 - -contains - - !----------------------------------------------------------------------- - !----------------------------------------------------------------------- - - subroutine gas_wetdep_readnl(nlfile) - - use cam_abortutils, only: endrun - use namelist_utils, only: find_group_name - use units, only: getunit, freeunit -#ifdef SPMD - use mpishorthand, only: mpichar, mpicom -#endif - - implicit none - - character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input - - integer :: unitn, i, ierr - - namelist /wetdep_inparm/ gas_wetdep_list - namelist /wetdep_inparm/ gas_wetdep_method - - if (masterproc) then - unitn = getunit() - open( unitn, file=trim(nlfile), status='old' ) - call find_group_name(unitn, 'wetdep_inparm', status=ierr) - if (ierr == 0) then - read(unitn, wetdep_inparm, iostat=ierr) - if (ierr /= 0) then - call endrun('mo_neu_wetdep->wetdep_readnl: ERROR reading wetdep_inparm namelist') - end if - end if - close(unitn) - call freeunit(unitn) - end if - -#ifdef SPMD - call mpibcast (gas_wetdep_list, len(gas_wetdep_list(1))*pcnst, mpichar, 0, mpicom) - call mpibcast (gas_wetdep_method, len(gas_wetdep_method), mpichar, 0, mpicom) -#endif - - gas_wetdep_cnt = 0 - do i = 1,pcnst - if ( len_trim(gas_wetdep_list(i)) > 0 ) then - gas_wetdep_cnt = gas_wetdep_cnt + 1 - endif - enddo - - if (( gas_wetdep_cnt>0 ).and. & - ( .not.(gas_wetdep_method=='MOZ' .or. & - gas_wetdep_method=='NEU' .or. & - gas_wetdep_method=='OFF') )) then - call endrun('gas_wetdep_readnl; gas_wetdep_method must be set to either MOZ or NEU') - endif - - end subroutine gas_wetdep_readnl - -end module gas_wetdep_opts diff --git a/src/chemistry/geoschem/mo_apex.F90 b/src/chemistry/geoschem/mo_apex.F90 deleted file mode 100644 index 0737f7e278..0000000000 --- a/src/chemistry/geoschem/mo_apex.F90 +++ /dev/null @@ -1,314 +0,0 @@ -module mo_apex - -!------------------------------------------------------------------------------- -! Purpose: -! -! Calculate apex coordinates and magnetic field magnitudes -! at global geographic grid for year of current model run. -! -! Method: -! -! The magnetic field parameters output by this module are time and height -! independent. They are chunked for waccm physics, i.e., allocated as -! (pcols,begchunk:endchunk) -! Interface sub apexmag is called once per run from sub inti. -! Sub apexmag may be called for years 1900 through 2005. -! This module is dependent on routines in apex_subs.F (modified IGRF model). -! Apex_subs has several authors, but has been modified and maintained -! in recent years by Roy Barnes (bozo@ucar.edu). -! Subs apxmka and apxmall are called with the current lat x lon grid -! resolution. -! -! Author: Ben Foster, foster@ucar.edu (Nov, 2003) -!------------------------------------------------------------------------------- - - use shr_kind_mod, only: r8 => shr_kind_r8 - use ppgrid, only: pcols, begchunk, endchunk ! physics grid - use cam_abortutils, only: endrun - use cam_logfile, only: iulog - use spmd_utils, only: masterproc - !use apex, only: apex_mka, apex_mall, apex_dypol, apex_set_igrf - !use apex, only: apex_beg_yr, apex_end_yr - implicit none - - private - public :: mo_apex_readnl - public :: mo_apex_init - public :: mo_apex_init1 - public :: alatm, alonm, bnorth, beast, bdown, bmag - public :: d1vec, d2vec, colatp, elonp - public :: maglon0 ! geographic longitude at the equator where geomagnetic longitude is zero (radians) - - ! year to initialize apex - real(r8), public, protected :: geomag_year = -1._r8 - logical, public, protected :: geomag_year_updated = .true. - - integer :: fixed_geomag_year = -1 - -!------------------------------------------------------------------------------- -! Magnetic field output arrays, chunked for physics: -! (these are allocated (pcols,begchunk:endchunk) by sub allocate_arrays) -!------------------------------------------------------------------------------- - real(r8), protected, allocatable, dimension(:,:) :: & ! (pcols,begchunk:endchunk) - alatm, & ! apex mag latitude at each geographic grid point (radians) - alonm, & ! apex mag longitude at each geographic grid point (radians) - bnorth, & ! northward component of magnetic field - beast, & ! eastward component of magnetic field - bdown, & ! downward component of magnetic field - bmag ! magnitude of magnetic field - real(r8), protected, allocatable, dimension(:,:,:) :: & ! (3,pcols,begchunk:endchunk) - d1vec, & ! base vectors more-or-less magnetic eastward direction - d2vec ! base vectors more-or-less magnetic downward/equatorward direction - real(r8), protected :: & - colatp, & ! geocentric colatitude of geomagnetic dipole north pole (deg) - elonp ! East longitude of geomagnetic dipole north pole (deg) - - real(r8), protected :: maglon0 - - character(len=256) :: igrf_geomag_coefs_file = 'igrf_geomag_coefs_file' - -contains - -!====================================================================== -!====================================================================== -subroutine mo_apex_readnl(nlfile) - - use namelist_utils, only : find_group_name - use units, only : getunit, freeunit - 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 = 'mo_apex_readnl' - - !namelist /geomag_nl/ fixed_geomag_year, igrf_geomag_coefs_file - - !! Read namelist - !if (masterproc) then - ! unitn = getunit() - ! open( unitn, file=trim(nlfile), status='old' ) - ! call find_group_name(unitn, 'geomag_nl', status=ierr) - ! if (ierr == 0) then - ! read(unitn, geomag_nl, iostat=ierr) - ! if (ierr /= 0) then - ! call endrun(subname // ':: ERROR reading namelist') - ! end if - ! end if - ! close(unitn) - ! call freeunit(unitn) - !end if - - !! Broadcast namelist variables - !call mpi_bcast(fixed_geomag_year, 1, mpi_integer, masterprocid, mpicom, ierr) - !call mpi_bcast(igrf_geomag_coefs_file, len(igrf_geomag_coefs_file), mpi_character, masterprocid, mpicom, ierr) - -end subroutine mo_apex_readnl - -!====================================================================== -!====================================================================== -subroutine mo_apex_init1() - use time_manager, only: get_curr_date - use dyn_grid, only: get_horiz_grid_dim_d - - -end subroutine mo_apex_init1 - -!====================================================================== -!====================================================================== -subroutine mo_apex_init(phys_state) -!------------------------------------------------------------------------------- -! Driver for apex code to calculate apex magnetic coordinates at -! current geographic spatial resolution for given year. This calls -! routines in apex_subs.F. -! -! This is called once per run from sub inti. -!------------------------------------------------------------------------------- - - use physconst,only : pi - use physics_types, only: physics_state - !use epp_ionization,only: epp_ionization_setmag - - ! Input/output arguments - type(physics_state), intent(in), dimension(begchunk:endchunk) :: phys_state - -!!------------------------------------------------------------------------------- -!! Local variables -!!------------------------------------------------------------------------------- -! real(r8), parameter :: re = 6.378165e8_r8 ! earth radius (cm) -! real(r8), parameter :: h0 = 9.0e6_r8 ! base height (90 km) -! real(r8), parameter :: hs = 1.3e7_r8 -! real(r8), parameter :: eps = 1.e-6_r8 ! epsilon -! real(r8), parameter :: cm2km = 1.e-5_r8 -! -! integer :: c, i, ist ! indices -! integer :: ncol -! -! real(r8) :: alt, hr, alon, alat, & ! apxmall args -! vmp, w, d, be3, sim, xlatqd, f, si, collat, collon -! -!!------------------------------------------------------------------------------- -!! Non-scalar arguments returned by APXMALL: -!!------------------------------------------------------------------------------- -! real(r8) :: bhat(3) -! real(r8) :: d3(3) -! real(r8) :: e1(3), e2(3), e3(3) -! real(r8) :: f1(2), f2(2) -! -! real(r8) :: bg(3), d1g(3), d2g(3), bmg -! -! real(r8) :: rdum -! -! real(r8) :: maglat(pcols,begchunk:endchunk) -! -! real(r8), parameter :: rtd = 180._r8/pi ! radians to degrees -! real(r8), parameter :: dtr = pi/180._r8 ! degrees to radians -! -! call mo_apex_init1() -! if ((.not.geomag_year_updated) .and. (allocated(alatm))) return -! -!!------------------------------------------------------------------------------- -!! Allocate output arrays -!!------------------------------------------------------------------------------- -! call allocate_arrays() -! -! alt = hs*cm2km ! altitude for apxmall (km) -! hr = alt ! reference altitude (km) -! -!!------------------------------------------------------------------------------ -!! Apex coords alon, alat are returned for each geographic grid point: -!! first form global arrays -!!------------------------------------------------------------------------------ -! do c = begchunk, endchunk -! ncol = phys_state(c)%ncol -! do i = 1,ncol -! collat = phys_state(c)%lat(i)*rtd ! latitude of current column (deg) -! collon = phys_state(c)%lon(i)*rtd ! latitude of current column (deg) -! if ( collon < -180._r8 ) collon = collon+360._r8 -! if ( collon > 180._r8 ) collon = collon-360._r8 -! call apex_mall( & -! collat, collon, alt, hr, & ! Inputs -! bg, bhat, bmag(i,c), si, & ! Mag Fld -! alon, alat, & ! Apex lon,lat output -! vmp, w, d, be3, sim, d1vec(:,i,c), d2vec(:,i,c), d3, e1, e2, e3, & ! Mod Apex -! xlatqd, f, f1, f2, ist ) ! Qsi-Dpl -! if( ist /= 0 ) then -! write(iulog,"(/,'>>> mo_apex_init: Error from apxmall: ist=',i4)") ist -! call endrun('mo_apex_init: Error from apxmall') -! end if -! beast (i,c) = bg(1) -! bnorth(i,c) = bg(2) -! bdown (i,c) = -bg(3) -! alonm (i,c) = alon*dtr ! mag lons (radians) -! alatm (i,c) = alat*dtr ! mag lats (radians) -! maglat(i,c) = alat ! mag lats (degrees) -! enddo -! enddo -! -! ! find geograghic latitude ( maglon0 ) where the geomagnetic latitude is zero at the equator -! ! by first extracting the geographic coordinates at zero degrees longitude ... -! collat = 0._r8 -! collon = 0._r8 -! call apex_mall( & -! collat, collon, alt, hr, & ! Inputs -! bg, bhat, bmg, si, & ! Mag Fld -! alon, alat, & ! Apex lon,lat output -! vmp, w, d, be3, sim, d1g, d2g, d3, e1, e2, e3, & ! Mod Apex -! xlatqd, f, f1, f2, ist ) ! Qsi-Dpl -! -! if( ist /= 0 ) then -! write(iulog,"(/,'>>> mo_apex_init: Error from apxmall: ist=',i4)") ist -! call endrun('mo_apex_init: Error from apxmall') -! end if -! -! maglon0 = -alon*dtr ! (radians) geograghic latitude where the geomagnetic latitude is zero -! ! where longitude ranges from -180E to 180E -! -! call apex_dypol( colatp, elonp, rdum ) ! get geomagnetic dipole north pole -! -! if (masterproc) then -! write(iulog, "('mo_apex_init: colatp,elonp ', 2f12.6)") colatp, elonp -! write(iulog, "('mo_apex_init: Calculated apex magnetic coordinates for year AD ',f8.2)") geomag_year -! endif -! -! call epp_ionization_setmag(maglat) - -end subroutine mo_apex_init - -subroutine allocate_arrays -!!------------------------------------------------------------------------------ -!! Allocate module output arrays for chunked physics grid. -!!------------------------------------------------------------------------------ -! -!!------------------------------------------------------------------------------ -!! local variables -!!------------------------------------------------------------------------------ -! integer :: istat ! status of allocate statements -! -! if (.not.allocated(alatm)) then -! allocate(alatm(pcols,begchunk:endchunk),stat=istat) -! if (istat /= 0) then -! write(iulog,"('>>> allocate_arrays: allocate of alatm failed: istat=',i5)") istat -! call endrun -! end if -! end if -! -! if (.not.allocated(alonm)) then -! allocate(alonm(pcols,begchunk:endchunk),stat=istat) -! if (istat /= 0) then -! write(iulog,"('>>> allocate_arrays: allocate of alonm failed: istat=',i5)") istat -! call endrun -! end if -! end if -! -! if (.not.allocated(bnorth)) then -! allocate(bnorth(pcols,begchunk:endchunk),stat=istat) -! if (istat /= 0) then -! write(iulog,"('>>> allocate_arrays: allocate of bnorth failed: istat=',i5)") istat -! call endrun -! end if -! end if -! -! if (.not.allocated(beast)) then -! allocate(beast(pcols,begchunk:endchunk),stat=istat) -! if (istat /= 0) then -! write(iulog,"('>>> allocate_arrays: allocate of beast failed: istat=',i5)") istat -! call endrun -! end if -! end if -! -! if (.not.allocated(bdown)) then -! allocate(bdown(pcols,begchunk:endchunk),stat=istat) -! if (istat /= 0) then -! write(iulog,"('>>> allocate_arrays: allocate of bdown failed: istat=',i5)") istat -! call endrun -! end if -! end if -! -! if (.not.allocated(bmag)) then -! allocate(bmag(pcols,begchunk:endchunk),stat=istat) -! if (istat /= 0) then -! write(iulog,"('>>> allocate_arrays: allocate of bmag failed: istat=',i5)") istat -! call endrun -! end if -! end if -! if (.not.allocated(d1vec)) then -! allocate(d1vec(3,pcols,begchunk:endchunk),stat=istat) -! if (istat /= 0) then -! write(iulog,"('>>> allocate_arrays: allocate of d1vec failed: istat=',i5)") istat -! call endrun -! endif -! endif -! -! if (.not.allocated(d2vec)) then -! allocate(d2vec(3,pcols,begchunk:endchunk),stat=istat) -! if (istat /= 0) then -! write(iulog,"('>>> allocate_arrays: allocate of d2vec failed: istat=',i5)") istat -! call endrun -! endif -! endif -! -end subroutine allocate_arrays - -end module mo_apex diff --git a/src/chemistry/geoschem/mo_chem_utls.F90 b/src/chemistry/geoschem/mo_chem_utls.F90 deleted file mode 100644 index aba6436b56..0000000000 --- a/src/chemistry/geoschem/mo_chem_utls.F90 +++ /dev/null @@ -1,180 +0,0 @@ - -module mo_chem_utls - - private - public :: get_spc_ndx - public :: get_inv_ndx - public :: get_extfrc_ndx - public :: get_rxt_ndx - public :: utls_chem_is - !, get_het_ndx - - save - -contains - - integer function get_spc_ndx( spc_name ) - !----------------------------------------------------------------------- - ! ... return overall species index associated with spc_name - !----------------------------------------------------------------------- - - use chem_mods, only : gas_pcnst - use mo_tracname, only : tracnam => solsym - use string_utils, only : to_upper - - implicit none - - !----------------------------------------------------------------------- - ! ... dummy arguments - !----------------------------------------------------------------------- - character(len=*), intent(in) :: spc_name - - !----------------------------------------------------------------------- - ! ... local variables - !----------------------------------------------------------------------- - integer :: m - - get_spc_ndx = -1 - do m = 1, gas_pcnst - if( trim( to_upper( spc_name ) ) == trim( to_upper( tracnam(m) ) ) ) then - get_spc_ndx = m - exit - end if - end do - - end function get_spc_ndx - - integer function get_inv_ndx( invariant ) - !----------------------------------------------------------------------- - ! ... return overall invariant index associated with spc_name - !----------------------------------------------------------------------- - - use chem_mods, only : nfs, inv_lst - - implicit none - - !----------------------------------------------------------------------- - ! ... dummy arguments - !----------------------------------------------------------------------- - character(len=*), intent(in) :: invariant - - !----------------------------------------------------------------------- - ! ... local variables - !----------------------------------------------------------------------- - integer :: m - - get_inv_ndx = -1 - do m = 1,nfs - if( trim( invariant ) == trim( inv_lst(m) ) ) then - get_inv_ndx = m - exit - end if - end do - - end function get_inv_ndx - - logical function utls_chem_is (name) result(chem_is) - use string_utils, only : to_lower - - character(len=*), intent(in) :: name - chem_is = .false. - if (( to_lower(name) == 'geoschem' ) .or. & - ( to_lower(name) == 'geos-chem' )) then - chem_is = .true. - endif - - end function utls_chem_is -! -! integer function get_het_ndx( het_name ) -! !----------------------------------------------------------------------- -! ! ... return overall het process index associated with spc_name -! !----------------------------------------------------------------------- -! -! use gas_wetdep_opts,only : gas_wetdep_method, gas_wetdep_list, gas_wetdep_cnt -! -! implicit none -! -! !----------------------------------------------------------------------- -! ! ... dummy arguments -! !----------------------------------------------------------------------- -! character(len=*), intent(in) :: het_name -! -! !----------------------------------------------------------------------- -! ! ... local variables -! !----------------------------------------------------------------------- -! integer :: m -! -! get_het_ndx=-1 -! -! do m=1,gas_wetdep_cnt -! -! if( trim( het_name ) == trim( gas_wetdep_list(m) ) ) then -! get_het_ndx = get_spc_ndx( gas_wetdep_list(m) ) -! return -! endif -! -! enddo -! -! end function get_het_ndx -! - integer function get_extfrc_ndx( frc_name ) - !----------------------------------------------------------------------- - ! ... return overall external frcing index associated with spc_name - !----------------------------------------------------------------------- - - use chem_mods, only : extcnt, extfrc_lst - - implicit none - - !----------------------------------------------------------------------- - ! ... dummy arguments - !----------------------------------------------------------------------- - character(len=*), intent(in) :: frc_name - - !----------------------------------------------------------------------- - ! ... local variables - !----------------------------------------------------------------------- - integer :: m - - get_extfrc_ndx = -1 - if( extcnt > 0 ) then - do m = 1,max(1,extcnt) - if( trim( frc_name ) == trim( extfrc_lst(m) ) ) then - get_extfrc_ndx = m - exit - end if - end do - end if - - end function get_extfrc_ndx - - integer function get_rxt_ndx( rxt_tag ) - !----------------------------------------------------------------------- - ! ... return overall external frcing index associated with spc_name - !----------------------------------------------------------------------- - - use chem_mods, only : rxt_tag_cnt, rxt_tag_lst, rxt_tag_map - - implicit none - - !----------------------------------------------------------------------- - ! ... dummy arguments - !----------------------------------------------------------------------- - character(len=*), intent(in) :: rxt_tag - - !----------------------------------------------------------------------- - ! ... local variables - !----------------------------------------------------------------------- - integer :: m - - get_rxt_ndx = -1 - do m = 1,rxt_tag_cnt - if( trim( rxt_tag ) == trim( rxt_tag_lst(m) ) ) then - get_rxt_ndx = rxt_tag_map(m) - exit - end if - end do - - end function get_rxt_ndx - -end module mo_chem_utls diff --git a/src/chemistry/geoschem/mo_drydep.F90 b/src/chemistry/geoschem/mo_drydep.F90 deleted file mode 120000 index fcb098953c..0000000000 --- a/src/chemistry/geoschem/mo_drydep.F90 +++ /dev/null @@ -1 +0,0 @@ -../mozart/mo_drydep.F90 \ No newline at end of file diff --git a/src/chemistry/geoschem/mo_gas_phase_chemdr.F90 b/src/chemistry/geoschem/mo_gas_phase_chemdr.F90 deleted file mode 100644 index a881683024..0000000000 --- a/src/chemistry/geoschem/mo_gas_phase_chemdr.F90 +++ /dev/null @@ -1,1180 +0,0 @@ -module mo_gas_phase_chemdr - - use shr_kind_mod, only : r8 => shr_kind_r8 - use shr_const_mod, only : pi => shr_const_pi - use constituents, only : pcnst - use cam_history, only : fieldname_len - use chem_mods, only : phtcnt, rxntot, gas_pcnst - use chem_mods, only : rxt_tag_cnt, rxt_tag_lst, rxt_tag_map, extcnt, num_rnts - !use dust_model, only : dust_names, ndust => dust_nbin - use ppgrid, only : pcols, pver - use phys_control, only : phys_getopts - use carma_flags_mod, only : carma_hetchem_feedback - use chem_prod_loss_diags, only: chem_prod_loss_diags_init, chem_prod_loss_diags_out - - implicit none - save - - private - public :: gas_phase_chemdr, gas_phase_chemdr_inti - public :: map2chm - - integer :: map2chm(pcnst) = 0 ! index map to/from chemistry/constituents list - - integer :: synoz_ndx, so4_ndx, h2o_ndx, o2_ndx, o_ndx, hno3_ndx, hcl_ndx, dst_ndx, cldice_ndx, snow_ndx - integer :: o3_ndx, o3s_ndx - integer :: het1_ndx - integer :: ndx_cldfr, ndx_cmfdqr, ndx_nevapr, ndx_cldtop, ndx_prain - integer :: ndx_h2so4 -! -! CCMI -! - integer :: st80_25_ndx - integer :: st80_25_tau_ndx - integer :: aoa_nh_ndx - integer :: aoa_nh_ext_ndx - integer :: nh_5_ndx - integer :: nh_50_ndx - integer :: nh_50w_ndx - integer :: sad_pbf_ndx - integer :: cb1_ndx,cb2_ndx,oc1_ndx,oc2_ndx,dst1_ndx,dst2_ndx,sslt1_ndx,sslt2_ndx - integer :: soa_ndx,soai_ndx,soam_ndx,soat_ndx,soab_ndx,soax_ndx - - character(len=fieldname_len),dimension(rxt_tag_cnt) :: tag_names - character(len=fieldname_len),dimension(extcnt) :: extfrc_name - - logical :: pm25_srf_diag - logical :: pm25_srf_diag_soa - - logical :: convproc_do_aer - integer :: ele_temp_ndx, ion_temp_ndx - -contains - - subroutine gas_phase_chemdr_inti() - - !use mo_chem_utls, only : get_spc_ndx, get_extfrc_ndx, get_rxt_ndx - use cam_history, only : addfld,add_default,horiz_only - !use mo_chm_diags, only : chm_diags_inti - use constituents, only : cnst_get_ind - use physics_buffer, only : pbuf_get_index - use rate_diags, only : rate_diags_init - use cam_abortutils, only : endrun - - implicit none - - character(len=3) :: string - integer :: n, m, err, ii - logical :: history_cesm_forcing - character(len=16) :: unitstr - !----------------------------------------------------------------------- - logical :: history_scwaccm_forcing - - call phys_getopts( history_scwaccm_forcing_out = history_scwaccm_forcing ) - - call phys_getopts( convproc_do_aer_out = convproc_do_aer, history_cesm_forcing_out=history_cesm_forcing ) - - !ndx_h2so4 = get_spc_ndx('H2SO4') -! -! CCMI -! - !st80_25_ndx = get_spc_ndx ('ST80_25') - !st80_25_tau_ndx = get_rxt_ndx ('ST80_25_tau') - !aoa_nh_ndx = get_spc_ndx ('AOA_NH') - !aoa_nh_ext_ndx = get_extfrc_ndx('AOA_NH') - !nh_5_ndx = get_spc_ndx('NH_5') - !nh_50_ndx = get_spc_ndx('NH_50') - !nh_50w_ndx = get_spc_ndx('NH_50W') -! - !cb1_ndx = get_spc_ndx('CB1') - !cb2_ndx = get_spc_ndx('CB2') - !oc1_ndx = get_spc_ndx('OC1') - !oc2_ndx = get_spc_ndx('OC2') - !dst1_ndx = get_spc_ndx('DST01') - !dst2_ndx = get_spc_ndx('DST02') - !sslt1_ndx = get_spc_ndx('SSLT01') - !sslt2_ndx = get_spc_ndx('SSLT02') - !soa_ndx = get_spc_ndx('SOA') - !soam_ndx = get_spc_ndx('SOAM') - !soai_ndx = get_spc_ndx('SOAI') - !soat_ndx = get_spc_ndx('SOAT') - !soab_ndx = get_spc_ndx('SOAB') - !soax_ndx = get_spc_ndx('SOAX') - - !pm25_srf_diag = cb1_ndx>0 .and. cb2_ndx>0 .and. oc1_ndx>0 .and. oc2_ndx>0 & - ! .and. dst1_ndx>0 .and. dst2_ndx>0 .and. sslt1_ndx>0 .and. sslt2_ndx>0 & - ! .and. soa_ndx>0 - - !pm25_srf_diag_soa = cb1_ndx>0 .and. cb2_ndx>0 .and. oc1_ndx>0 .and. oc2_ndx>0 & - ! .and. dst1_ndx>0 .and. dst2_ndx>0 .and. sslt1_ndx>0 .and. sslt2_ndx>0 & - ! .and. soam_ndx>0 .and. soai_ndx>0 .and. soat_ndx>0 .and. soab_ndx>0 .and. soax_ndx>0 - ! - !if ( pm25_srf_diag .or. pm25_srf_diag_soa) then - ! call addfld('PM25_SRF',horiz_only,'I','kg/kg','bottom layer PM2.5 mixing ratio' ) - !endif - !call addfld('U_SRF',horiz_only,'I','m/s','bottom layer wind velocity' ) - !call addfld('V_SRF',horiz_only,'I','m/s','bottom layer wind velocity' ) - !call addfld('Q_SRF',horiz_only,'I','kg/kg','bottom layer specific humidity' ) -! - !het1_ndx= get_rxt_ndx('het1') - !o3_ndx = get_spc_ndx('O3') - !o3s_ndx = get_spc_ndx('O3S') - !o_ndx = get_spc_ndx('O') - !o2_ndx = get_spc_ndx('O2') - !so4_ndx = get_spc_ndx('SO4') - !h2o_ndx = get_spc_ndx('H2O') - !hno3_ndx = get_spc_ndx('HNO3') - !hcl_ndx = get_spc_ndx('HCL') - !dst_ndx = get_spc_ndx( dust_names(1) ) - !synoz_ndx = get_extfrc_ndx( 'SYNOZ' ) - !call cnst_get_ind( 'CLDICE', cldice_ndx ) - !call cnst_get_ind( 'SNOWQM', snow_ndx, abort=.false. ) - - - !do m = 1,extcnt - ! WRITE(UNIT=string, FMT='(I2.2)') m - ! extfrc_name(m) = 'extfrc_'// trim(string) - ! call addfld( extfrc_name(m), (/ 'lev' /), 'I', ' ', 'ext frcing' ) - !end do - - !do n = 1,rxt_tag_cnt - ! tag_names(n) = trim(rxt_tag_lst(n)) - ! if (n<=phtcnt) then - ! call addfld( tag_names(n), (/ 'lev' /), 'I', '/s', 'photolysis rate constant' ) - ! else - ! ii = n-phtcnt - ! select case(num_rnts(ii)) - ! case(1) - ! unitstr='/s' - ! case(2) - ! unitstr='cm3/molecules/s' - ! case(3) - ! unitstr='cm6/molecules2/s' - ! case default - ! call endrun('gas_phase_chemdr_inti: invalid value in num_rnts used to set units in reaction rate constant') - ! end select - ! call addfld( tag_names(n), (/ 'lev' /), 'I', unitstr, 'reaction rate constant' ) - ! endif - ! if (history_scwaccm_forcing) then - ! select case (trim(tag_names(n))) - ! case ('jh2o_a', 'jh2o_b', 'jh2o_c' ) - ! call add_default( tag_names(n), 1, ' ') - ! end select - ! endif - !enddo - - !call addfld( 'DTCBS', horiz_only, 'I', ' ','photolysis diagnostic black carbon OD' ) - !call addfld( 'DTOCS', horiz_only, 'I', ' ','photolysis diagnostic organic carbon OD' ) - !call addfld( 'DTSO4', horiz_only, 'I', ' ','photolysis diagnostic SO4 OD' ) - !call addfld( 'DTSOA', horiz_only, 'I', ' ','photolysis diagnostic SOA OD' ) - !call addfld( 'DTANT', horiz_only, 'I', ' ','photolysis diagnostic NH4SO4 OD' ) - !call addfld( 'DTSAL', horiz_only, 'I', ' ','photolysis diagnostic salt OD' ) - !call addfld( 'DTDUST', horiz_only, 'I', ' ','photolysis diagnostic dust OD' ) - !call addfld( 'DTTOTAL', horiz_only, 'I', ' ','photolysis diagnostic total aerosol OD' ) - !call addfld( 'FRACDAY', horiz_only, 'I', ' ','photolysis diagnostic fraction of day' ) - - !call addfld( 'QDSAD', (/ 'lev' /), 'I', '/s', 'water vapor sad delta' ) - !call addfld( 'SAD_STRAT', (/ 'lev' /), 'I', 'cm2/cm3', 'stratospheric aerosol SAD' ) - !call addfld( 'SAD_SULFC', (/ 'lev' /), 'I', 'cm2/cm3', 'chemical sulfate aerosol SAD' ) - !call addfld( 'SAD_SAGE', (/ 'lev' /), 'I', 'cm2/cm3', 'SAGE sulfate aerosol SAD' ) - !call addfld( 'SAD_LNAT', (/ 'lev' /), 'I', 'cm2/cm3', 'large-mode NAT aerosol SAD' ) - !call addfld( 'SAD_ICE', (/ 'lev' /), 'I', 'cm2/cm3', 'water-ice aerosol SAD' ) - !call addfld( 'RAD_SULFC', (/ 'lev' /), 'I', 'cm', 'chemical sad sulfate' ) - !call addfld( 'RAD_LNAT', (/ 'lev' /), 'I', 'cm', 'large nat radius' ) - !call addfld( 'RAD_ICE', (/ 'lev' /), 'I', 'cm', 'sad ice' ) - !call addfld( 'SAD_TROP', (/ 'lev' /), 'I', 'cm2/cm3', 'tropospheric aerosol SAD' ) - !call addfld( 'SAD_AERO', (/ 'lev' /), 'I', 'cm2/cm3', 'aerosol surface area density' ) - !if (history_cesm_forcing) then - ! call add_default ('SAD_AERO',8,' ') - !endif - !call addfld( 'REFF_AERO', (/ 'lev' /), 'I', 'cm', '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') - !call addfld( 'HNO3_TOTAL', (/ 'lev' /), 'I', 'mol/mol', 'total HNO3' ) - !call addfld( 'HNO3_STS', (/ 'lev' /), 'I', 'mol/mol', 'STS condensed HNO3' ) - !call addfld( 'HNO3_NAT', (/ 'lev' /), 'I', 'mol/mol', 'NAT condensed HNO3' ) - !call addfld( 'HNO3_GAS', (/ 'lev' /), 'I', 'mol/mol', 'gas-phase hno3' ) - !call addfld( 'H2O_GAS', (/ 'lev' /), 'I', 'mol/mol', 'gas-phase h2o' ) - !call addfld( 'HCL_TOTAL', (/ 'lev' /), 'I', 'mol/mol', 'total hcl' ) - !call addfld( 'HCL_GAS', (/ 'lev' /), 'I', 'mol/mol', 'gas-phase hcl' ) - !call addfld( 'HCL_STS', (/ 'lev' /), 'I', 'mol/mol', 'STS condensed HCL' ) - - !if (het1_ndx>0) then - ! call addfld( 'het1_total', (/ 'lev' /), 'I', '/s', 'total N2O5 + H2O het rate constant' ) - !endif - !call addfld( 'SZA', horiz_only, 'I', 'degrees', 'solar zenith angle' ) - - !call chm_diags_inti() - !call rate_diags_init() - -!----------------------------------------------------------------------- -! get pbuf indicies -!----------------------------------------------------------------------- - !ndx_cldfr = pbuf_get_index('CLD') - !ndx_cmfdqr = pbuf_get_index('RPRDTOT') - !ndx_nevapr = pbuf_get_index('NEVAPR') - !ndx_prain = pbuf_get_index('PRAIN') - !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 - - !! diagnostics for stratospheric heterogeneous reactions - !call addfld( 'GAMMA_HET1', (/ 'lev' /), 'I', '1', 'Reaction Probability' ) - !call addfld( 'GAMMA_HET2', (/ 'lev' /), 'I', '1', 'Reaction Probability' ) - !call addfld( 'GAMMA_HET3', (/ 'lev' /), 'I', '1', 'Reaction Probability' ) - !call addfld( 'GAMMA_HET4', (/ 'lev' /), 'I', '1', 'Reaction Probability' ) - !call addfld( 'GAMMA_HET5', (/ 'lev' /), 'I', '1', 'Reaction Probability' ) - !call addfld( 'GAMMA_HET6', (/ 'lev' /), 'I', '1', 'Reaction Probability' ) - !call addfld( 'WTPER', (/ 'lev' /), 'I', '%', 'H2SO4 Weight Percent' ) - - !call chem_prod_loss_diags_init - - end subroutine gas_phase_chemdr_inti - - -!----------------------------------------------------------------------- -!----------------------------------------------------------------------- - subroutine gas_phase_chemdr(lchnk, ncol, imozart, q, & - phis, zm, zi, calday, & - tfld, pmid, pdel, pint, & - cldw, troplev, troplevchem, & - ncldwtr, ufld, vfld, & - delt, ps, xactive_prates, & - fsds, ts, asdir, ocnfrac, icefrac, & - precc, precl, snowhland, ghg_chem, latmapback, & - drydepflx, wetdepflx, cflx, fire_sflx, fire_ztop, nhx_nitrogen_flx, noy_nitrogen_flx, qtend, pbuf) - - !----------------------------------------------------------------------- - ! ... Chem_solver advances the volumetric mixing ratio - ! forward one time step via a combination of explicit, - ! ebi, hov, fully implicit, and/or rodas algorithms. - !----------------------------------------------------------------------- - - use chem_mods, only : nabscol, nfs, indexm, clscnt4 - use physconst, only : rga - !use mo_photo, only : set_ub_col, setcol, table_photo, xactive_photo - !use mo_exp_sol, only : exp_sol - !use mo_imp_sol, only : imp_sol - !use mo_setrxt, only : setrxt - !use mo_adjrxt, only : adjrxt - !use mo_phtadj, only : phtadj - !use llnl_O1D_to_2OH_adj,only : O1D_to_2OH_adj - !use mo_usrrxt, only : usrrxt - !use mo_setinv, only : setinv - !use mo_negtrc, only : negtrc - !use mo_sulf, only : sulf_interp - !use mo_setext, only : setext - !use fire_emissions, only : fire_emissions_vrt - !use mo_sethet, only : sethet - !use mo_drydep, only : drydep, set_soilw - !use seq_drydep_mod, only : DD_XLND, DD_XATM, DD_TABL, drydep_method - !use mo_fstrat, only : set_fstrat_vals, set_fstrat_h2o - !use noy_ubc, only : noy_ubc_set - !use mo_flbc, only : flbc_set - !use phys_grid, only : get_rlat_all_p, get_rlon_all_p, get_lat_all_p, get_lon_all_p - !use mo_mean_mass, only : set_mean_mass - !use cam_history, only : outfld - !use wv_saturation, only : qsat - !use constituents, only : cnst_mw - !use mo_drydep, only : has_drydep - !use time_manager, only : get_ref_date - !use mo_ghg_chem, only : ghg_chem_set_rates, ghg_chem_set_flbc - !use mo_sad, only : sad_strat_calc - !use charge_neutrality, only : charge_balance - !use mo_strato_rates, only : ratecon_sfstrat - !use mo_aero_settling, only : strat_aer_settling - !use shr_orb_mod, only : shr_orb_decl - !use cam_control_mod, only : lambm0, eccen, mvelpp, obliqr - !use mo_strato_rates, only : has_strato_chem - !use short_lived_species,only: set_short_lived_species,get_short_lived_species - !use mo_chm_diags, only : chm_diags, het_diags - !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 infnan, only : nan, assignment(=) - !use rate_diags, only : rate_diags_calc - !use mo_mass_xforms, only : mmr2vmr, vmr2mmr, h2o_to_vmr, mmr2vmri - !use orbit, only : zenith -! -! LINOZ -! - !use lin_strat_chem, only : do_lin_strat_chem, lin_strat_chem_solve - !use linoz_data, only : has_linoz_data -! -! for aqueous chemistry and aerosol growth -! - !use aero_model, only : aero_model_gasaerexch - - !use aero_model, only : aero_model_strat_surfarea - - implicit none - - !----------------------------------------------------------------------- - ! ... Dummy arguments - !----------------------------------------------------------------------- - integer, intent(in) :: lchnk ! chunk index - integer, intent(in) :: ncol ! number columns in chunk - integer, intent(in) :: imozart ! gas phase start index in q - real(r8), intent(in) :: delt ! timestep (s) - real(r8), intent(in) :: calday ! day of year - real(r8), intent(in) :: ps(pcols) ! surface pressure - real(r8), intent(in) :: phis(pcols) ! surface geopotential - real(r8),target,intent(in) :: tfld(pcols,pver) ! midpoint temperature (K) - real(r8), intent(in) :: pmid(pcols,pver) ! midpoint pressures (Pa) - real(r8), intent(in) :: pdel(pcols,pver) ! pressure delta about midpoints (Pa) - real(r8), intent(in) :: ufld(pcols,pver) ! zonal velocity (m/s) - real(r8), intent(in) :: vfld(pcols,pver) ! meridional velocity (m/s) - real(r8), intent(in) :: cldw(pcols,pver) ! cloud water (kg/kg) - real(r8), intent(in) :: ncldwtr(pcols,pver) ! droplet number concentration (#/kg) - real(r8), intent(in) :: zm(pcols,pver) ! midpoint geopotential height above the surface (m) - real(r8), intent(in) :: zi(pcols,pver+1) ! interface geopotential height above the surface (m) - real(r8), intent(in) :: pint(pcols,pver+1) ! interface pressures (Pa) - real(r8), intent(in) :: q(pcols,pver,pcnst) ! species concentrations (kg/kg) - real(r8),pointer, intent(in) :: fire_sflx(:,:) ! fire emssions surface flux (kg/m^2/s) - real(r8),pointer, intent(in) :: fire_ztop(:) ! top of vertical distribution of fire emssions (m) - logical, intent(in) :: xactive_prates - real(r8), intent(in) :: fsds(pcols) ! longwave down at sfc - real(r8), intent(in) :: icefrac(pcols) ! sea-ice areal fraction - real(r8), intent(in) :: ocnfrac(pcols) ! ocean areal fraction - real(r8), intent(in) :: asdir(pcols) ! albedo: shortwave, direct - real(r8), intent(in) :: ts(pcols) ! sfc temp (merged w/ocean if coupled) - real(r8), intent(in) :: precc(pcols) ! - real(r8), intent(in) :: precl(pcols) ! - real(r8), intent(in) :: snowhland(pcols) ! - logical, intent(in) :: ghg_chem - integer, intent(in) :: latmapback(pcols) - integer, intent(in) :: troplev(pcols) ! trop/strat separation vertical index - integer, intent(in) :: troplevchem(pcols) ! trop/strat chemistry separation vertical index - real(r8), intent(inout) :: qtend(pcols,pver,pcnst) ! species tendencies (kg/kg/s) - real(r8), intent(inout) :: cflx(pcols,pcnst) ! constituent surface flux (kg/m^2/s) - real(r8), intent(out) :: drydepflx(pcols,pcnst) ! dry deposition flux (kg/m^2/s) - real(r8), intent(in) :: wetdepflx(pcols,pcnst) ! wet deposition flux (kg/m^2/s) - real(r8), intent(out) :: nhx_nitrogen_flx(pcols) - real(r8), intent(out) :: noy_nitrogen_flx(pcols) - - type(physics_buffer_desc), pointer :: pbuf(:) - - !!----------------------------------------------------------------------- - !! ... Local variables - !!----------------------------------------------------------------------- - !real(r8), parameter :: m2km = 1.e-3_r8 - !real(r8), parameter :: Pa2mb = 1.e-2_r8 - - !real(r8), pointer :: prain(:,:) - !real(r8), pointer :: nevapr(:,:) - !real(r8), pointer :: cmfdqr(:,:) - !real(r8), pointer :: cldfr(:,:) - !real(r8), pointer :: cldtop(:) - - !integer :: i, k, m, n - !integer :: tim_ndx - !real(r8) :: delt_inverse - !real(r8) :: esfact - !integer :: latndx(pcols) ! chunk lat indicies - !integer :: lonndx(pcols) ! chunk lon indicies - !real(r8) :: invariants(ncol,pver,nfs) - !real(r8) :: col_dens(ncol,pver,max(1,nabscol)) ! column densities (molecules/cm^2) - !real(r8) :: col_delta(ncol,0:pver,max(1,nabscol)) ! layer column densities (molecules/cm^2) - !real(r8) :: extfrc(ncol,pver,max(1,extcnt)) - !real(r8) :: vmr(ncol,pver,gas_pcnst) ! xported species (vmr) - !real(r8) :: reaction_rates(ncol,pver,max(1,rxntot)) ! reaction rates - !real(r8) :: depvel(ncol,gas_pcnst) ! dry deposition velocity (cm/s) - !real(r8) :: het_rates(ncol,pver,max(1,gas_pcnst)) ! washout rate (1/s) - !real(r8), dimension(ncol,pver) :: & - ! h2ovmr, & ! water vapor volume mixing ratio - ! mbar, & ! mean wet atmospheric mass ( amu ) - ! zmid, & ! midpoint geopotential in km - ! zmidr, & ! midpoint geopotential in km realitive to surf - ! sulfate, & ! trop sulfate aerosols - ! pmb ! pressure at midpoints ( hPa ) - !real(r8), dimension(ncol,pver) :: & - ! cwat, & ! cloud water mass mixing ratio (kg/kg) - ! wrk - !real(r8), dimension(ncol,pver+1) :: & - ! zintr ! interface geopotential in km realitive to surf - !real(r8), dimension(ncol,pver+1) :: & - ! zint ! interface geopotential in km - !real(r8), dimension(ncol) :: & - ! zen_angle, & ! solar zenith angles - ! zsurf, & ! surface height (m) - ! rlats, rlons ! chunk latitudes and longitudes (radians) - !real(r8) :: sza(ncol) ! solar zenith angles (degrees) - !real(r8), parameter :: rad2deg = 180._r8/pi ! radians to degrees conversion factor - !real(r8) :: relhum(ncol,pver) ! relative humidity - !real(r8) :: satv(ncol,pver) ! wrk array for relative humidity - !real(r8) :: satq(ncol,pver) ! wrk array for relative humidity - - !integer :: j - !integer :: ltrop_sol(pcols) ! tropopause vertical index used in chem solvers - !real(r8), pointer :: strato_sad(:,:) ! stratospheric sad (1/cm) - - !real(r8) :: sad_trop(pcols,pver) ! total tropospheric sad (cm^2/cm^3) - !real(r8) :: reff(pcols,pver) ! aerosol effective radius (cm) - !real(r8) :: reff_strat(pcols,pver) ! stratospheric aerosol effective radius (cm) - - !real(r8) :: tvs(pcols) - !integer :: ncdate,yr,mon,day,sec - !real(r8) :: wind_speed(pcols) ! surface wind speed (m/s) - !logical, parameter :: dyn_soilw = .false. - !logical :: table_soilw - !real(r8) :: soilw(pcols) - !real(r8) :: prect(pcols) - !real(r8) :: sflx(pcols,gas_pcnst) - !real(r8) :: wetdepflx_diag(pcols,gas_pcnst) - !real(r8) :: dust_vmr(ncol,pver,ndust) - !real(r8) :: dt_diag(pcols,8) ! od diagnostics - !real(r8) :: fracday(pcols) ! fraction of day - !real(r8) :: o2mmr(ncol,pver) ! o2 concentration (kg/kg) - !real(r8) :: ommr(ncol,pver) ! o concentration (kg/kg) - !real(r8) :: mmr(pcols,pver,gas_pcnst) ! chem working concentrations (kg/kg) - !real(r8) :: mmr_new(pcols,pver,gas_pcnst) ! chem working concentrations (kg/kg) - !real(r8) :: hno3_gas(ncol,pver) ! hno3 gas phase concentration (mol/mol) - !real(r8) :: hno3_cond(ncol,pver,2) ! hno3 condensed phase concentration (mol/mol) - !real(r8) :: hcl_gas(ncol,pver) ! hcl gas phase concentration (mol/mol) - !real(r8) :: hcl_cond(ncol,pver) ! hcl condensed phase concentration (mol/mol) - !real(r8) :: h2o_gas(ncol,pver) ! h2o gas phase concentration (mol/mol) - !real(r8) :: h2o_cond(ncol,pver) ! h2o condensed phase concentration (mol/mol) - !real(r8) :: cldice(pcols,pver) ! cloud water "ice" (kg/kg) - !real(r8) :: radius_strat(ncol,pver,3) ! radius of sulfate, nat, & ice ( cm ) - !real(r8) :: sad_strat(ncol,pver,3) ! surf area density of sulfate, nat, & ice ( cm^2/cm^3 ) - !real(r8) :: mmr_tend(pcols,pver,gas_pcnst) ! chemistry species tendencies (kg/kg/s) - !real(r8) :: qh2o(pcols,pver) ! specific humidity (kg/kg) - !real(r8) :: delta - - ! !for aerosol formation.... - !real(r8) :: del_h2so4_gasprod(ncol,pver) - !real(r8) :: vmr0(ncol,pver,gas_pcnst) - -! -! CCMI -! - !real(r8) :: xlat - !real(r8) :: pm25(ncol) - - !real(r8) :: dlats(ncol) - - !real(r8), dimension(ncol,pver) :: & ! aerosol reaction diagnostics - ! gprob_n2o5, & - ! gprob_cnt_hcl, & - ! gprob_cnt_h2o, & - ! gprob_bnt_h2o, & - ! gprob_hocl_hcl, & - ! gprob_hobr_hcl, & - ! wtper - - !real(r8), pointer :: ele_temp_fld(:,:) ! electron temperature pointer - !real(r8), pointer :: ion_temp_fld(:,:) ! ion temperature pointer - !real(r8) :: prod_out(ncol,pver,max(1,clscnt4)) - !real(r8) :: loss_out(ncol,pver,max(1,clscnt4)) - - !if ( ele_temp_ndx>0 .and. ion_temp_ndx>0 ) then - ! call pbuf_get_field(pbuf, ele_temp_ndx, ele_temp_fld) - ! call pbuf_get_field(pbuf, ion_temp_ndx, ion_temp_fld) - !else - ! ele_temp_fld => tfld - ! ion_temp_fld => tfld - !endif - - !! initialize to NaN to hopefully catch user defined rxts that go unset - !reaction_rates(:,:,:) = nan - - !Dummy output - qtend = 0.0e+0_r8 - cflx = 0.0e+0_r8 - drydepflx = 0.0e+0_r8 - - !delt_inverse = 1._r8 / delt - !!----------------------------------------------------------------------- - !! ... Get chunck latitudes and longitudes - !!----------------------------------------------------------------------- - !call get_lat_all_p( lchnk, ncol, latndx ) - !call get_lon_all_p( lchnk, ncol, lonndx ) - !call get_rlat_all_p( lchnk, ncol, rlats ) - !call get_rlon_all_p( lchnk, ncol, rlons ) - !tim_ndx = pbuf_old_tim_idx() - !call pbuf_get_field(pbuf, ndx_prain, prain, start=(/1,1/), kount=(/ncol,pver/)) - !call pbuf_get_field(pbuf, ndx_cldfr, cldfr, start=(/1,1,tim_ndx/), kount=(/ncol,pver,1/) ) - !call pbuf_get_field(pbuf, ndx_cmfdqr, cmfdqr, start=(/1,1/), kount=(/ncol,pver/)) - !call pbuf_get_field(pbuf, ndx_nevapr, nevapr, start=(/1,1/), kount=(/ncol,pver/)) - !call pbuf_get_field(pbuf, ndx_cldtop, cldtop ) - - !reff_strat(:,:) = 0._r8 - - !dlats(:) = rlats(:)*rad2deg ! convert to degrees - - !!----------------------------------------------------------------------- - !! ... Calculate cosine of zenith angle - !! then cast back to angle (radians) - !!----------------------------------------------------------------------- - !call zenith( calday, rlats, rlons, zen_angle, ncol ) - !zen_angle(:) = acos( zen_angle(:) ) - - !sza(:) = zen_angle(:) * rad2deg - !call outfld( 'SZA', sza, ncol, lchnk ) - - !!----------------------------------------------------------------------- - !! ... Xform geopotential height from m to km - !! and pressure from Pa to mb - !!----------------------------------------------------------------------- - !zsurf(:ncol) = rga * phis(:ncol) - !do k = 1,pver - ! zintr(:ncol,k) = m2km * zi(:ncol,k) - ! zmidr(:ncol,k) = m2km * zm(:ncol,k) - ! zmid(:ncol,k) = m2km * (zm(:ncol,k) + zsurf(:ncol)) - ! zint(:ncol,k) = m2km * (zi(:ncol,k) + zsurf(:ncol)) - ! pmb(:ncol,k) = Pa2mb * pmid(:ncol,k) - !end do - !zint(:ncol,pver+1) = m2km * (zi(:ncol,pver+1) + zsurf(:ncol)) - !zintr(:ncol,pver+1)= m2km * zi(:ncol,pver+1) - - !!----------------------------------------------------------------------- - !! ... map incoming concentrations to working array - !!----------------------------------------------------------------------- - !do m = 1,pcnst - ! n = map2chm(m) - ! if( n > 0 ) then - ! mmr(:ncol,:,n) = q(:ncol,:,m) - ! end if - !end do - - !call get_short_lived_species( mmr, lchnk, ncol, pbuf ) - - !!----------------------------------------------------------------------- - !! ... Set atmosphere mean mass - !!----------------------------------------------------------------------- - !call set_mean_mass( ncol, mmr, mbar ) - - !!----------------------------------------------------------------------- - !! ... Xform from mmr to vmr - !!----------------------------------------------------------------------- - !call mmr2vmr( mmr(:ncol,:,:), vmr(:ncol,:,:), mbar(:ncol,:), ncol ) - -! -! CCMI -! -! reset STE tracer to specific vmr of 200 ppbv -! - !if ( st80_25_ndx > 0 ) then - ! where ( pmid(:ncol,:) < 80.e+2_r8 ) - ! vmr(:ncol,:,st80_25_ndx) = 200.e-9_r8 - ! end where - !end if -! -! reset AOA_NH, NH_5, NH_50, NH_50W surface mixing ratios between 30N and 50N -! - !if ( aoa_nh_ndx>0 ) then - ! do j=1,ncol - ! xlat = dlats(j) - ! if ( xlat >= 30._r8 .and. xlat <= 50._r8 ) then - ! vmr(j,pver,aoa_nh_ndx) = 0._r8 - ! end if - ! end do - !end if - !if ( nh_5_ndx>0 ) then - ! do j=1,ncol - ! xlat = dlats(j) - ! if ( xlat >= 30._r8 .and. xlat <= 50._r8 ) then - ! vmr(j,pver,nh_5_ndx) = 100.e-9_r8 - ! end if - ! end do - !end if - !if ( nh_50_ndx>0 ) then - ! do j=1,ncol - ! xlat = dlats(j) - ! if ( xlat >= 30._r8 .and. xlat <= 50._r8 ) then - ! vmr(j,pver,nh_50_ndx) = 100.e-9_r8 - ! end if - ! end do - !end if - !if ( nh_50w_ndx>0 ) then - ! do j=1,ncol - ! xlat = dlats(j) - ! if ( xlat >= 30._r8 .and. xlat <= 50._r8 ) then - ! vmr(j,pver,nh_50w_ndx) = 100.e-9_r8 - ! end if - ! end do - !end if - - !if (h2o_ndx>0) then - ! !----------------------------------------------------------------------- - ! ! ... store water vapor in wrk variable - ! !----------------------------------------------------------------------- - ! qh2o(:ncol,:) = mmr(:ncol,:,h2o_ndx) - ! h2ovmr(:ncol,:) = vmr(:ncol,:,h2o_ndx) - !else - ! qh2o(:ncol,:) = q(:ncol,:,1) - ! !----------------------------------------------------------------------- - ! ! ... Xform water vapor from mmr to vmr and set upper bndy values - ! !----------------------------------------------------------------------- - ! call h2o_to_vmr( q(:ncol,:,1), h2ovmr(:ncol,:), mbar(:ncol,:), ncol ) - - ! call set_fstrat_h2o( h2ovmr, pmid, troplev, calday, ncol, lchnk ) - - !endif - - !!----------------------------------------------------------------------- - !! ... force ion/electron balance - !!----------------------------------------------------------------------- - !call charge_balance( ncol, vmr ) - - !!----------------------------------------------------------------------- - !! ... Set the "invariants" - !!----------------------------------------------------------------------- - !call setinv( invariants, tfld, h2ovmr, vmr, pmid, ncol, lchnk, pbuf ) - - !!----------------------------------------------------------------------- - !! ... stratosphere aerosol surface area - !!----------------------------------------------------------------------- - !if (sad_pbf_ndx>0) then - ! call pbuf_get_field(pbuf, sad_pbf_ndx, strato_sad) - !else - ! allocate(strato_sad(pcols,pver)) - ! 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 ) - - !endif - - !stratochem: if ( has_strato_chem ) then - ! !----------------------------------------------------------------------- - ! ! ... initialize condensed and gas phases; all hno3 to gas - ! !----------------------------------------------------------------------- - ! hcl_cond(:,:) = 0.0_r8 - ! hcl_gas (:,:) = 0.0_r8 - ! do k = 1,pver - ! hno3_gas(:,k) = vmr(:,k,hno3_ndx) - ! h2o_gas(:,k) = h2ovmr(:,k) - ! hcl_gas(:,k) = vmr(:,k,hcl_ndx) - ! wrk(:,k) = h2ovmr(:,k) - ! if (snow_ndx>0) then - ! cldice(:ncol,k) = q(:ncol,k,cldice_ndx) + q(:ncol,k,snow_ndx) - ! else - ! cldice(:ncol,k) = q(:ncol,k,cldice_ndx) - ! endif - ! end do - ! do m = 1,2 - ! do k = 1,pver - ! hno3_cond(:,k,m) = 0._r8 - ! end do - ! end do - - ! call mmr2vmri( cldice(:ncol,:), h2o_cond(:ncol,:), mbar(:ncol,:), cnst_mw(cldice_ndx), ncol ) - - ! !----------------------------------------------------------------------- - ! ! ... call SAD routine - ! !----------------------------------------------------------------------- - ! call sad_strat_calc( lchnk, invariants(:ncol,:,indexm), pmb, tfld, hno3_gas, & - ! hno3_cond, h2o_gas, h2o_cond, hcl_gas, hcl_cond, strato_sad(:ncol,:), radius_strat, & - ! sad_strat, ncol, pbuf ) - -! ! NOTE: output of total HNO3 is before vmr is set to gas-phase. - ! call outfld( 'HNO3_TOTAL', vmr(:ncol,:,hno3_ndx), ncol ,lchnk ) - - - ! do k = 1,pver - ! vmr(:,k,hno3_ndx) = hno3_gas(:,k) - ! h2ovmr(:,k) = h2o_gas(:,k) - ! vmr(:,k,h2o_ndx) = h2o_gas(:,k) - ! wrk(:,k) = (h2ovmr(:,k) - wrk(:,k))*delt_inverse - ! end do - - ! call outfld( 'QDSAD', wrk(:,:), ncol, lchnk ) -! - ! call outfld( 'SAD_STRAT', strato_sad(:ncol,:), ncol, lchnk ) - ! call outfld( 'SAD_SULFC', sad_strat(:,:,1), ncol, lchnk ) - ! call outfld( 'SAD_LNAT', sad_strat(:,:,2), ncol, lchnk ) - ! call outfld( 'SAD_ICE', sad_strat(:,:,3), ncol, lchnk ) -! - ! call outfld( 'RAD_SULFC', radius_strat(:,:,1), ncol, lchnk ) - ! call outfld( 'RAD_LNAT', radius_strat(:,:,2), ncol, lchnk ) - ! call outfld( 'RAD_ICE', radius_strat(:,:,3), ncol, lchnk ) -! - ! call outfld( 'HNO3_GAS', vmr(:ncol,:,hno3_ndx), ncol, lchnk ) - ! call outfld( 'HNO3_STS', hno3_cond(:,:,1), ncol, lchnk ) - ! call outfld( 'HNO3_NAT', hno3_cond(:,:,2), ncol, lchnk ) -! - ! call outfld( 'HCL_TOTAL', vmr(:ncol,:,hcl_ndx), ncol, lchnk ) - ! call outfld( 'HCL_GAS', hcl_gas (:,:), ncol ,lchnk ) - ! call outfld( 'HCL_STS', hcl_cond(:,:), ncol ,lchnk ) - - ! !----------------------------------------------------------------------- - ! ! ... call aerosol reaction rates - ! !----------------------------------------------------------------------- - ! call ratecon_sfstrat( ncol, invariants(:,:,indexm), pmid, tfld, & - ! radius_strat(:,:,1), sad_strat(:,:,1), sad_strat(:,:,2), & - ! sad_strat(:,:,3), h2ovmr, vmr, reaction_rates, & - ! gprob_n2o5, gprob_cnt_hcl, gprob_cnt_h2o, gprob_bnt_h2o, & - ! gprob_hocl_hcl, gprob_hobr_hcl, wtper ) - - ! call outfld( 'GAMMA_HET1', gprob_n2o5 (:ncol,:), ncol, lchnk ) - ! call outfld( 'GAMMA_HET2', gprob_cnt_h2o (:ncol,:), ncol, lchnk ) - ! call outfld( 'GAMMA_HET3', gprob_bnt_h2o (:ncol,:), ncol, lchnk ) - ! call outfld( 'GAMMA_HET4', gprob_cnt_hcl (:ncol,:), ncol, lchnk ) - ! call outfld( 'GAMMA_HET5', gprob_hocl_hcl(:ncol,:), ncol, lchnk ) - ! call outfld( 'GAMMA_HET6', gprob_hobr_hcl(:ncol,:), ncol, lchnk ) - ! call outfld( 'WTPER', wtper (:ncol,:), ncol, lchnk ) - - !endif stratochem - -! ! NOTE: For gas-phase solver only. -! ! ratecon_sfstrat needs total hcl. - !if (hcl_ndx>0) then - ! vmr(:,:,hcl_ndx) = hcl_gas(:,:) - !endif - - !!----------------------------------------------------------------------- - !! ... Set the column densities at the upper boundary - !!----------------------------------------------------------------------- - !call set_ub_col( col_delta, vmr, invariants, pint(:,1), pdel, ncol, lchnk) - - !!----------------------------------------------------------------------- - !! ... Set rates for "tabular" and user specified reactions - !!----------------------------------------------------------------------- - !call setrxt( reaction_rates, tfld, invariants(1,1,indexm), ncol ) - ! - !sulfate(:,:) = 0._r8 - !if ( .not. carma_hetchem_feedback ) then - ! if( so4_ndx < 1 ) then ! get offline so4 field if not prognostic - ! call sulf_interp( ncol, lchnk, sulfate ) - ! else - ! sulfate(:,:) = vmr(:,:,so4_ndx) - ! endif - !endif - ! - !!----------------------------------------------------------------- - !! ... zero out sulfate above tropopause - !!----------------------------------------------------------------- - !do k = 1, pver - ! do i = 1, ncol - ! if (k < troplevchem(i)) then - ! sulfate(i,k) = 0.0_r8 - ! end if - ! end do - !end do - - !call outfld( 'SULF_TROP', sulfate(:ncol,:), ncol, lchnk ) - - !!----------------------------------------------------------------- - !! ... compute the relative humidity - !!----------------------------------------------------------------- - !call qsat(tfld(:ncol,:), pmid(:ncol,:), satv, satq) - - !do k = 1,pver - ! relhum(:,k) = .622_r8 * h2ovmr(:,k) / satq(:,k) - ! relhum(:,k) = max( 0._r8,min( 1._r8,relhum(:,k) ) ) - !end do - ! - !cwat(:ncol,:pver) = cldw(:ncol,:pver) - - !call usrrxt( 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 ) - - !call outfld( 'SAD_TROP', sad_trop(:ncol,:), ncol, lchnk ) - - !! Add trop/strat components of SAD for output - !sad_trop(:ncol,:)=sad_trop(:ncol,:)+strato_sad(:ncol,:) - !call outfld( 'SAD_AERO', sad_trop(:ncol,:), ncol, lchnk ) - - !! Add trop/strat components of effective radius for output - !reff(:ncol,:)=reff(:ncol,:)+reff_strat(:ncol,:) - !call outfld( 'REFF_AERO', reff(:ncol,:), ncol, lchnk ) - - !if (het1_ndx>0) then - ! call outfld( 'het1_total', reaction_rates(:,:,het1_ndx), ncol, lchnk ) - !endif - - !if (ghg_chem) then - ! call ghg_chem_set_rates( reaction_rates, latmapback, zen_angle, ncol, lchnk ) - !endif - - !do i = phtcnt+1,rxt_tag_cnt - ! call outfld( tag_names(i), reaction_rates(:ncol,:,rxt_tag_map(i)), ncol, lchnk ) - !enddo - - !call adjrxt( reaction_rates, invariants, invariants(1,1,indexm), ncol,pver ) - - !!----------------------------------------------------------------------- - !! ... Compute the photolysis rates at time = t(n+1) - !!----------------------------------------------------------------------- - !!----------------------------------------------------------------------- - !! ... Set the column densities - !!----------------------------------------------------------------------- - !call setcol( col_delta, col_dens, vmr, pdel, ncol ) - - !!----------------------------------------------------------------------- - !! ... Calculate the photodissociation rates - !!----------------------------------------------------------------------- - - !esfact = 1._r8 - !call shr_orb_decl( calday, eccen, mvelpp, lambm0, obliqr , & - ! delta, esfact ) - - - !if ( xactive_prates ) then - ! if ( dst_ndx > 0 ) then - ! dust_vmr(:ncol,:,1:ndust) = vmr(:ncol,:,dst_ndx:dst_ndx+ndust-1) - ! else - ! dust_vmr(:ncol,:,:) = 0._r8 - ! endif - - ! !----------------------------------------------------------------- - ! ! ... compute the photolysis rates - ! !----------------------------------------------------------------- - ! call xactive_photo( reaction_rates, vmr, tfld, cwat, cldfr, & - ! pmid, zmidr, col_dens, zen_angle, asdir, & - ! invariants(1,1,indexm), ps, ts, & - ! esfact, relhum, dust_vmr, dt_diag, fracday, ncol, lchnk ) - - ! call outfld('DTCBS', dt_diag(:ncol,1), ncol, lchnk ) - ! call outfld('DTOCS', dt_diag(:ncol,2), ncol, lchnk ) - ! call outfld('DTSO4', dt_diag(:ncol,3), ncol, lchnk ) - ! call outfld('DTANT', dt_diag(:ncol,4), ncol, lchnk ) - ! call outfld('DTSAL', dt_diag(:ncol,5), ncol, lchnk ) - ! call outfld('DTDUST', dt_diag(:ncol,6), ncol, lchnk ) - ! call outfld('DTSOA', dt_diag(:ncol,7), ncol, lchnk ) - ! call outfld('DTTOTAL', dt_diag(:ncol,8), ncol, lchnk ) - ! call outfld('FRACDAY', fracday(:ncol), ncol, lchnk ) - - !else - ! !----------------------------------------------------------------- - ! ! ... lookup the photolysis rates from table - ! !----------------------------------------------------------------- - ! call table_photo( reaction_rates, pmid, pdel, tfld, zmid, zint, & - ! col_dens, zen_angle, asdir, cwat, cldfr, & - ! esfact, vmr, invariants, ncol, lchnk, pbuf ) - !endif - - !do i = 1,phtcnt - ! call outfld( tag_names(i), reaction_rates(:ncol,:,rxt_tag_map(i)), ncol, lchnk ) - !enddo - - !!----------------------------------------------------------------------- - !! ... Adjust the photodissociation rates - !!----------------------------------------------------------------------- - !call O1D_to_2OH_adj( reaction_rates, invariants, invariants(:,:,indexm), ncol, tfld ) - !call phtadj( reaction_rates, invariants, invariants(:,:,indexm), ncol,pver ) - - !!----------------------------------------------------------------------- - !! ... Compute the extraneous frcing at time = t(n+1) - !!----------------------------------------------------------------------- - !if ( o2_ndx > 0 .and. o_ndx > 0 ) then - ! do k = 1,pver - ! o2mmr(:ncol,k) = mmr(:ncol,k,o2_ndx) - ! ommr(:ncol,k) = mmr(:ncol,k,o_ndx) - ! end do - !endif - !call setext( extfrc, zint, zintr, cldtop, & - ! zmid, lchnk, tfld, o2mmr, ommr, & - ! pmid, mbar, rlats, calday, ncol, rlons, pbuf ) - !! include forcings from fire emissions ... - !call fire_emissions_vrt( ncol, lchnk, zint, fire_sflx, fire_ztop, extfrc ) - - !do m = 1,extcnt - ! if( m /= synoz_ndx .and. m /= aoa_nh_ext_ndx ) then - ! do k = 1,pver - ! extfrc(:ncol,k,m) = extfrc(:ncol,k,m) / invariants(:ncol,k,indexm) - ! end do - ! endif - ! call outfld( extfrc_name(m), extfrc(:ncol,:,m), ncol, lchnk ) - !end do - - !!----------------------------------------------------------------------- - !! ... Form the washout rates - !!----------------------------------------------------------------------- - !if ( gas_wetdep_method=='MOZ' ) then - ! call sethet( het_rates, pmid, zmid, phis, tfld, & - ! cmfdqr, prain, nevapr, delt, invariants(:,:,indexm), & - ! vmr, ncol, lchnk ) - ! if (.not. convproc_do_aer) then - ! call het_diags( het_rates(:ncol,:,:), mmr(:ncol,:,:), pdel(:ncol,:), lchnk, ncol ) - ! endif - !else - ! het_rates = 0._r8 - !end if -! -! CCMI -! -! set loss to below the tropopause only -! - !if ( st80_25_tau_ndx > 0 ) then - ! do i = 1,ncol - ! reaction_rates(i,1:troplev(i),st80_25_tau_ndx) = 0._r8 - ! enddo - !end if - - !if ( has_linoz_data ) then - ! ltrop_sol(:ncol) = troplev(:ncol) - !else - ! ltrop_sol(:ncol) = 0 ! apply solver to all levels - !endif - - !! save h2so4 before gas phase chem (for later new particle nucleation) - !if (ndx_h2so4 > 0) then - ! del_h2so4_gasprod(1:ncol,:) = vmr(1:ncol,:,ndx_h2so4) - !else - ! del_h2so4_gasprod(:,:) = 0.0_r8 - !endif - - !vmr0(:ncol,:,:) = vmr(:ncol,:,:) ! mixing ratios before chemistry changes - - !!======================================================================= - !! ... Call the class solution algorithms - !!======================================================================= - !!----------------------------------------------------------------------- - !! ... Solve for "Explicit" species - !!----------------------------------------------------------------------- - !call exp_sol( vmr, reaction_rates, het_rates, extfrc, delt, invariants(1,1,indexm), ncol, lchnk, ltrop_sol ) - - !!----------------------------------------------------------------------- - !! ... Solve for "Implicit" species - !!----------------------------------------------------------------------- - !if ( has_strato_chem ) wrk(:,:) = vmr(:,:,h2o_ndx) - !call t_startf('imp_sol') - !! - !call imp_sol( vmr, reaction_rates, het_rates, extfrc, delt, & - ! ncol,pver, lchnk, prod_out, loss_out ) - - !call t_stopf('imp_sol') - - !call chem_prod_loss_diags_out( ncol, lchnk, vmr, reaction_rates, prod_out, loss_out, invariants(:ncol,:,indexm) ) - !if( h2o_ndx>0) call outfld( 'H2O_GAS', vmr(1,1,h2o_ndx), ncol ,lchnk ) - - !! reset O3S to O3 in the stratosphere ... - !if ( o3_ndx > 0 .and. o3s_ndx > 0 ) then - ! do i = 1,ncol - ! vmr(i,1:troplev(i),o3s_ndx) = vmr(i,1:troplev(i),o3_ndx) - ! end do - !end if - - !if (convproc_do_aer) then - ! call vmr2mmr( vmr(:ncol,:,:), mmr_new(:ncol,:,:), mbar(:ncol,:), ncol ) - ! ! mmr_new = average of mmr values before and after imp_sol - ! mmr_new(:ncol,:,:) = 0.5_r8*( mmr(:ncol,:,:) + mmr_new(:ncol,:,:) ) - ! call het_diags( het_rates(:ncol,:,:), mmr_new(:ncol,:,:), pdel(:ncol,:), lchnk, ncol ) - !endif - - !! save h2so4 change by gas phase chem (for later new particle nucleation) - !if (ndx_h2so4 > 0) then - ! del_h2so4_gasprod(1:ncol,:) = vmr(1:ncol,:,ndx_h2so4) - del_h2so4_gasprod(1:ncol,:) - !endif - -! -! Aerosol processes ... -! - - !call aero_model_gasaerexch( imozart-1, ncol, lchnk, troplevchem, delt, reaction_rates, & - ! tfld, pmid, pdel, mbar, relhum, & - ! zm, qh2o, cwat, cldfr, ncldwtr, & - ! invariants(:,:,indexm), invariants, del_h2so4_gasprod, & - ! vmr0, vmr, pbuf ) - - !if ( has_strato_chem ) then - - ! wrk(:ncol,:) = (vmr(:ncol,:,h2o_ndx) - wrk(:ncol,:))*delt_inverse - ! call outfld( 'QDCHEM', wrk(:ncol,:), ncol, lchnk ) - ! call outfld( 'HNO3_GAS', vmr(:ncol,:,hno3_ndx), ncol ,lchnk ) - - ! !----------------------------------------------------------------------- - ! ! ... aerosol settling - ! ! first settle hno3(2) using radius ice - ! ! secnd settle hno3(3) using radius large nat - ! !----------------------------------------------------------------------- - ! wrk(:,:) = vmr(:,:,h2o_ndx) -#ifdef ALT_SETTL - ! where( h2o_cond(:,:) > 0._r8 ) - ! settl_rad(:,:) = radius_strat(:,:,3) - ! elsewhere - ! settl_rad(:,:) = 0._r8 - ! endwhere - ! call strat_aer_settling( invariants(1,1,indexm), pmid, delt, zmid, tfld, & - ! hno3_cond(1,1,2), settl_rad, ncol, lchnk, 1 ) - - ! where( h2o_cond(:,:) == 0._r8 ) - ! settl_rad(:,:) = radius_strat(:,:,2) - ! elsewhere - ! settl_rad(:,:) = 0._r8 - ! endwhere - ! call strat_aer_settling( invariants(1,1,indexm), pmid, delt, zmid, tfld, & - ! hno3_cond(1,1,2), settl_rad, ncol, lchnk, 2 ) -#else - ! call strat_aer_settling( invariants(1,1,indexm), pmid, delt, zmid, tfld, & - ! hno3_cond(1,1,2), radius_strat(1,1,2), ncol, lchnk, 2 ) -#endif - - !----------------------------------------------------------------------- - ! ... reform total hno3 and hcl = gas + all condensed - !----------------------------------------------------------------------- -! NOTE: vmr for hcl and hno3 is gas-phase at this point. -! hno3_cond(:,k,1) = STS; hno3_cond(:,k,2) = NAT - - ! do k = 1,pver - ! vmr(:,k,hno3_ndx) = vmr(:,k,hno3_ndx) + hno3_cond(:,k,1) & - ! + hno3_cond(:,k,2) - ! vmr(:,k,hcl_ndx) = vmr(:,k,hcl_ndx) + hcl_cond(:,k) - ! - ! end do - - ! wrk(:,:) = (vmr(:,:,h2o_ndx) - wrk(:,:))*delt_inverse - ! call outfld( 'QDSETT', wrk(:,:), ncol, lchnk ) - - !endif - -! -! LINOZ -! - !if ( do_lin_strat_chem ) then - ! call lin_strat_chem_solve( ncol, lchnk, vmr(:,:,o3_ndx), col_dens(:,:,1), tfld, zen_angle, pmid, delt, rlats, troplev ) - !end if - - !!----------------------------------------------------------------------- - !! ... Check for negative values and reset to zero - !!----------------------------------------------------------------------- - !call negtrc( 'After chemistry ', vmr, ncol ) - - !!----------------------------------------------------------------------- - !! ... Set upper boundary mmr values - !!----------------------------------------------------------------------- - !call set_fstrat_vals( vmr, pmid, pint, troplev, calday, ncol,lchnk ) - - !!----------------------------------------------------------------------- - !! ... Set fixed lower boundary mmr values - !!----------------------------------------------------------------------- - !call flbc_set( vmr, ncol, lchnk, map2chm ) - - !!----------------------------------------------------------------------- - !! set NOy UBC - !!----------------------------------------------------------------------- - !call noy_ubc_set( lchnk, ncol, vmr ) - - !if ( ghg_chem ) then - ! call ghg_chem_set_flbc( vmr, ncol ) - !endif - - !!----------------------------------------------------------------------- - !! force ion/electron balance -- ext forcings likely do not conserve charge - !!----------------------------------------------------------------------- - !call charge_balance( ncol, vmr ) - - !!----------------------------------------------------------------------- - !! ... Xform from vmr to mmr - !!----------------------------------------------------------------------- - !call vmr2mmr( vmr(:ncol,:,:), mmr_tend(:ncol,:,:), mbar(:ncol,:), ncol ) - - !call set_short_lived_species( mmr_tend, lchnk, ncol, pbuf ) - - !!----------------------------------------------------------------------- - !! ... Form the tendencies - !!----------------------------------------------------------------------- - !do m = 1,gas_pcnst - ! mmr_new(:ncol,:,m) = mmr_tend(:ncol,:,m) - ! mmr_tend(:ncol,:,m) = (mmr_tend(:ncol,:,m) - mmr(:ncol,:,m))*delt_inverse - !enddo - - !do m = 1,pcnst - ! n = map2chm(m) - ! if( n > 0 ) then - ! qtend(:ncol,:,m) = qtend(:ncol,:,m) + mmr_tend(:ncol,:,n) - ! end if - !end do - - !tvs(:ncol) = tfld(:ncol,pver) * (1._r8 + qh2o(:ncol,pver)) - - !sflx(:,:) = 0._r8 - !call get_ref_date(yr, mon, day, sec) - !ncdate = yr*10000 + mon*100 + day - !wind_speed(:ncol) = sqrt( ufld(:ncol,pver)*ufld(:ncol,pver) + vfld(:ncol,pver)*vfld(:ncol,pver) ) - !prect(:ncol) = precc(:ncol) + precl(:ncol) - - !if ( drydep_method == DD_XLND ) then - ! soilw = -99 - ! call drydep( ocnfrac, icefrac, ncdate, ts, ps, & - ! wind_speed, qh2o(:,pver), tfld(:,pver), pmid(:,pver), prect, & - ! snowhland, fsds, depvel, sflx, mmr, & - ! tvs, soilw, relhum(:,pver:pver), ncol, lonndx, latndx, lchnk ) - !else if ( drydep_method == DD_XATM ) then - ! table_soilw = has_drydep( 'H2' ) .or. has_drydep( 'CO' ) - ! if( .not. dyn_soilw .and. table_soilw ) then - ! call set_soilw( soilw, lchnk, calday ) - ! end if - ! call drydep( ncdate, ts, ps, & - ! wind_speed, qh2o(:,pver), tfld(:,pver), pmid(:,pver), prect, & - ! snowhland, fsds, depvel, sflx, mmr, & - ! tvs, soilw, relhum(:,pver:pver), ncol, lonndx, latndx, lchnk ) - !else if ( drydep_method == DD_TABL ) then - ! call drydep( calday, ts, zen_angle, & - ! depvel, sflx, mmr, pmid(:,pver), & - ! tvs, ncol, icefrac, ocnfrac, lchnk ) - !endif - - !drydepflx(:,:) = 0._r8 - !do m = 1,pcnst - ! n = map2chm( m ) - ! if ( n > 0 ) then - ! cflx(:ncol,m) = cflx(:ncol,m) - sflx(:ncol,n) - ! drydepflx(:ncol,m) = sflx(:ncol,n) - ! wetdepflx_diag(:ncol,n) = wetdepflx(:ncol,m) - ! endif - !end do - - !call chm_diags( lchnk, ncol, vmr(:ncol,:,:), mmr_new(:ncol,:,:), & - ! reaction_rates(:ncol,:,:), invariants(:ncol,:,:), depvel(:ncol,:), sflx(:ncol,:), & - ! mmr_tend(:ncol,:,:), pdel(:ncol,:), pmid(:ncol,:), troplev(:ncol), wetdepflx_diag(:ncol,:), & - ! nhx_nitrogen_flx(:ncol), noy_nitrogen_flx(:ncol) ) - - !call rate_diags_calc( reaction_rates(:,:,:), vmr(:,:,:), invariants(:,:,indexm), ncol, lchnk ) -! -! jfl -! -! surface vmr -! - !if ( pm25_srf_diag ) then - ! pm25(:ncol) = mmr_new(:ncol,pver,cb1_ndx) & - ! + mmr_new(:ncol,pver,cb2_ndx) & - ! + mmr_new(:ncol,pver,oc1_ndx) & - ! + mmr_new(:ncol,pver,oc2_ndx) & - ! + mmr_new(:ncol,pver,dst1_ndx) & - ! + mmr_new(:ncol,pver,dst2_ndx) & - ! + mmr_new(:ncol,pver,sslt1_ndx) & - ! + mmr_new(:ncol,pver,sslt2_ndx) & - ! + mmr_new(:ncol,pver,soa_ndx) & - ! + mmr_new(:ncol,pver,so4_ndx) - ! call outfld('PM25_SRF',pm25(:ncol) , ncol, lchnk ) - !endif - !if ( pm25_srf_diag_soa ) then - ! pm25(:ncol) = mmr_new(:ncol,pver,cb1_ndx) & - ! + mmr_new(:ncol,pver,cb2_ndx) & - ! + mmr_new(:ncol,pver,oc1_ndx) & - ! + mmr_new(:ncol,pver,oc2_ndx) & - ! + mmr_new(:ncol,pver,dst1_ndx) & - ! + mmr_new(:ncol,pver,dst2_ndx) & - ! + mmr_new(:ncol,pver,sslt1_ndx) & - ! + mmr_new(:ncol,pver,sslt2_ndx) & - ! + mmr_new(:ncol,pver,soam_ndx) & - ! + mmr_new(:ncol,pver,soai_ndx) & - ! + mmr_new(:ncol,pver,soat_ndx) & - ! + mmr_new(:ncol,pver,soab_ndx) & - ! + mmr_new(:ncol,pver,soax_ndx) & - ! + mmr_new(:ncol,pver,so4_ndx) - ! call outfld('PM25_SRF',pm25(:ncol) , ncol, lchnk ) - !endif -! -! - !call outfld('Q_SRF',qh2o(:ncol,pver) , ncol, lchnk ) - !call outfld('U_SRF',ufld(:ncol,pver) , ncol, lchnk ) - !call outfld('V_SRF',vfld(:ncol,pver) , ncol, lchnk ) - -! - !if (.not.sad_pbf_ndx>0) then - ! deallocate(strato_sad) - !endif - - end subroutine gas_phase_chemdr - -end module mo_gas_phase_chemdr diff --git a/src/chemistry/geoschem/mo_ghg_chem.F90 b/src/chemistry/geoschem/mo_ghg_chem.F90 deleted file mode 120000 index f8a8b4ba4c..0000000000 --- a/src/chemistry/geoschem/mo_ghg_chem.F90 +++ /dev/null @@ -1 +0,0 @@ -../mozart/mo_ghg_chem.F90 \ No newline at end of file diff --git a/src/chemistry/geoschem/mo_lightning.F90 b/src/chemistry/geoschem/mo_lightning.F90 deleted file mode 120000 index 8b731ae98f..0000000000 --- a/src/chemistry/geoschem/mo_lightning.F90 +++ /dev/null @@ -1 +0,0 @@ -../mozart/mo_lightning.F90 \ No newline at end of file diff --git a/src/chemistry/geoschem/mo_mean_mass.F90 b/src/chemistry/geoschem/mo_mean_mass.F90 deleted file mode 120000 index e4231e65f7..0000000000 --- a/src/chemistry/geoschem/mo_mean_mass.F90 +++ /dev/null @@ -1 +0,0 @@ -../mozart/mo_mean_mass.F90 \ No newline at end of file diff --git a/src/chemistry/geoschem/mo_setinv.F90 b/src/chemistry/geoschem/mo_setinv.F90 deleted file mode 120000 index eeca85151d..0000000000 --- a/src/chemistry/geoschem/mo_setinv.F90 +++ /dev/null @@ -1 +0,0 @@ -../mozart/mo_setinv.F90 \ No newline at end of file diff --git a/src/chemistry/geoschem/mo_tracname.F90 b/src/chemistry/geoschem/mo_tracname.F90 deleted file mode 100644 index 8e8a80b9a3..0000000000 --- a/src/chemistry/geoschem/mo_tracname.F90 +++ /dev/null @@ -1,14 +0,0 @@ - - module mo_tracname -!----------------------------------------------------------- -! ... List of advected and non-advected trace species, and -! surface fluxes for the advected species. -!----------------------------------------------------------- - - use chem_mods, only : gas_pcnst - - implicit none - - character(len=16) :: solsym(gas_pcnst) ! species names - - end module mo_tracname diff --git a/src/chemistry/geoschem/rate_diags.F90 b/src/chemistry/geoschem/rate_diags.F90 deleted file mode 100644 index 40b5fa6dde..0000000000 --- a/src/chemistry/geoschem/rate_diags.F90 +++ /dev/null @@ -1,177 +0,0 @@ -!-------------------------------------------------------------------------------- -! Manages writing reaction rates to history -!-------------------------------------------------------------------------------- -module rate_diags - - use shr_kind_mod, only : r8 => shr_kind_r8 - use shr_kind_mod, only : CL => SHR_KIND_CL - use cam_history, only : fieldname_len - use cam_history, only : addfld, add_default - use cam_history, only : outfld - use chem_mods, only : rxt_tag_cnt, rxt_tag_lst, rxt_tag_map - use ppgrid, only : pver - use spmd_utils, only : masterproc - use cam_abortutils, only : endrun -! use sums_utils, only : sums_grp_t, parse_sums - - implicit none - private - public :: rate_diags_init - public :: rate_diags_calc - public :: rate_diags_readnl - - character(len=fieldname_len) :: rate_names(rxt_tag_cnt) - -! integer :: ngrps = 0 -! type(sums_grp_t), allocatable :: grps(:) - - integer, parameter :: maxlines = 200 - character(len=CL), allocatable :: rxn_rate_sums(:) - -contains - -!------------------------------------------------------------------- -!------------------------------------------------------------------- - subroutine rate_diags_readnl(nlfile) - - use namelist_utils, only: find_group_name - use units, only: getunit, freeunit - use spmd_utils, only: mpicom, mpi_character, masterprocid - - ! args - character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input - - ! Local variables - integer :: unitn, ierr - - namelist /rxn_rate_diags_nl/ rxn_rate_sums - - allocate( rxn_rate_sums( maxlines ) ) - rxn_rate_sums(:) = ' ' - - !! Read namelist - !if (masterproc) then - ! unitn = getunit() - ! open( unitn, file=trim(nlfile), status='old' ) - ! call find_group_name(unitn, 'rxn_rate_diags_nl', status=ierr) - ! if (ierr == 0) then - ! read(unitn, rxn_rate_diags_nl, iostat=ierr) - ! if (ierr /= 0) then - ! call endrun('rate_diags_readnl:: ERROR reading namelist') - ! end if - ! end if - ! close(unitn) - ! call freeunit(unitn) - !end if - - ! Broadcast namelist variables - call mpi_bcast(rxn_rate_sums,len(rxn_rate_sums(1))*maxlines, mpi_character, masterprocid, mpicom, ierr) - - end subroutine rate_diags_readnl -!-------------------------------------------------------------------------------- -!-------------------------------------------------------------------------------- - subroutine rate_diags_init - use phys_control, only : phys_getopts - - integer :: i, len, pos - character(len=64) :: name - logical :: history_scwaccm_forcing - - call phys_getopts( history_scwaccm_forcing_out = history_scwaccm_forcing ) - - !do i = 1,rxt_tag_cnt - ! pos = 0 - ! pos = index(rxt_tag_lst(i),'tag_') - ! if (pos <= 0) pos = index(rxt_tag_lst(i),'usr_') - ! if (pos <= 0) pos = index(rxt_tag_lst(i),'cph_') - ! if (pos <= 0) pos = index(rxt_tag_lst(i),'ion_') - ! if (pos>0) then - ! name = 'r_'//trim(rxt_tag_lst(i)(5:)) - ! else - ! name = 'r_'//trim(rxt_tag_lst(i)(1:)) - ! endif - ! len = min(fieldname_len,len_trim(name)) - ! rate_names(i) = trim(name(1:len)) - ! call addfld(rate_names(i), (/ 'lev' /),'A', 'molecules/cm3/sec','reaction rate') - ! if (history_scwaccm_forcing .and. rate_names(i) == 'r_O1D_H2O') then - ! call add_default( rate_names(i), 1, ' ') - ! endif - !enddo - - !! parse the terms of the summations - !call parse_sums(rxn_rate_sums, ngrps, grps) - !deallocate( rxn_rate_sums ) - - !do i = 1, ngrps - ! call addfld( grps(i)%name, (/ 'lev' /),'A', 'molecules/cm3/sec','reaction rate group') - !enddo - - end subroutine rate_diags_init - -!-------------------------------------------------------------------------------- -!-------------------------------------------------------------------------------- - subroutine rate_diags_calc( rxt_rates, vmr, m, ncol, lchnk ) - - !use mo_rxt_rates_conv, only: set_rates - - real(r8), intent(inout) :: rxt_rates(:,:,:) ! 'molec/cm3/sec' - real(r8), intent(in) :: vmr(:,:,:) - real(r8), intent(in) :: m(:,:) ! air density (molecules/cm3) - integer, intent(in) :: ncol, lchnk - - !integer :: i, j, ndx - !real(r8) :: group_rate(ncol,pver) - - rxt_rates(:,:,:) = 0.0e+0_r8 - - !call set_rates( rxt_rates, vmr, ncol ) - - !! output individual tagged rates - !do i = 1, rxt_tag_cnt - ! ! convert from vmr/sec to molecules/cm3/sec - ! rxt_rates(:ncol,:,rxt_tag_map(i)) = rxt_rates(:ncol,:,rxt_tag_map(i)) * m(:ncol,:) - ! call outfld( rate_names(i), rxt_rates(:ncol,:,rxt_tag_map(i)), ncol, lchnk ) - !enddo - - !! output rate groups ( or families ) - !do i = 1, ngrps - ! group_rate(:,:) = 0._r8 - ! do j = 1, grps(i)%nmembers - ! ndx = lookup_tag_ndx(grps(i)%term(j)) - ! group_rate(:ncol,:) = group_rate(:ncol,:) + grps(i)%multipler(j)*rxt_rates(:ncol,:,ndx) - ! enddo - ! call outfld( grps(i)%name, group_rate(:ncol,:), ncol, lchnk ) - !end do - - end subroutine rate_diags_calc - -!------------------------------------------------------------------- -! Private routines : -!------------------------------------------------------------------- -!------------------------------------------------------------------- - -!------------------------------------------------------------------- -! finds the index corresponging to a given reacton name -!------------------------------------------------------------------- - function lookup_tag_ndx( name ) result( ndx ) - character(len=*) :: name - integer :: ndx - - integer :: i - - ndx = -1 - - !findloop: do i = 1,rxt_tag_cnt - ! if (trim(name) .eq. trim(rate_names(i)(3:))) then - ! ndx = i - ! return - ! endif - !end do findloop - - !if (ndx<0) then - ! call endrun('rate_diags: not able to find rxn tag name: '//trim(name)) - !endif - - end function lookup_tag_ndx - -end module rate_diags diff --git a/src/chemistry/geoschem/tracer_cnst.F90 b/src/chemistry/geoschem/tracer_cnst.F90 deleted file mode 120000 index be79edec09..0000000000 --- a/src/chemistry/geoschem/tracer_cnst.F90 +++ /dev/null @@ -1 +0,0 @@ -../mozart/tracer_cnst.F90 \ No newline at end of file diff --git a/src/chemistry/geoschem/tracer_srcs.F90 b/src/chemistry/geoschem/tracer_srcs.F90 deleted file mode 120000 index 136404bf05..0000000000 --- a/src/chemistry/geoschem/tracer_srcs.F90 +++ /dev/null @@ -1 +0,0 @@ -../mozart/tracer_srcs.F90 \ No newline at end of file diff --git a/src/chemistry/geoschem/upper_bc.F90 b/src/chemistry/geoschem/upper_bc.F90 deleted file mode 100644 index 61f4dab886..0000000000 --- a/src/chemistry/geoschem/upper_bc.F90 +++ /dev/null @@ -1,243 +0,0 @@ - -module upper_bc - -!--------------------------------------------------------------------------------- -! Module to compute the upper boundary condition for temperature (dry static energy) -! and trace gases. Uses the MSIS model, and SNOE and TIME GCM data. -! -! original code by Stacy Walters -! adapted by B. A. Boville -!--------------------------------------------------------------------------------- - - use shr_kind_mod, only: r8 => shr_kind_r8 - use shr_const_mod,only: grav => shr_const_g, & ! gravitational constant (m/s^2) - kboltz => shr_const_boltz, & ! Boltzmann constant - pi => shr_const_pi, & ! pi - rEarth => shr_const_rearth ! Earth radius - use ppgrid, only: pcols, pver, pverp - use constituents, only: pcnst - use cam_logfile, only: iulog - use spmd_utils, only: masterproc - use ref_pres, only: ptop_ref - - implicit none - private - save -! -! Public interfaces -! - public :: ubc_defaultopts ! set default values of namelist variables - public :: ubc_setopts ! get namelist input - public :: ubc_init ! global initialization - public :: ubc_timestep_init ! time step initialization - public :: ubc_get_vals ! get ubc values for this step - -! Namelist variables - character(len=256) :: snoe_ubc_file = ' ' - real(r8) :: t_pert_ubc = 0._r8 - real(r8) :: no_xfac_ubc = 1._r8 - - character(len=256) :: tgcm_ubc_file = ' ' - integer :: tgcm_ubc_cycle_yr = 0 - integer :: tgcm_ubc_fixed_ymd = 0 - integer :: tgcm_ubc_fixed_tod = 0 - integer :: f_ndx, hf_ndx - character(len=32) :: tgcm_ubc_data_type = 'CYCLICAL' - - logical :: apply_upper_bc = .true. - -!================================================================================================ -contains -!================================================================================================ - -subroutine ubc_defaultopts(tgcm_ubc_file_out, tgcm_ubc_data_type_out, tgcm_ubc_cycle_yr_out, tgcm_ubc_fixed_ymd_out, & - tgcm_ubc_fixed_tod_out, snoe_ubc_file_out, t_pert_ubc_out, no_xfac_ubc_out) -!----------------------------------------------------------------------- -! Purpose: Return default runtime options -!----------------------------------------------------------------------- - - real(r8), intent(out), optional :: t_pert_ubc_out - real(r8), intent(out), optional :: no_xfac_ubc_out - character(len=*), intent(out), optional :: tgcm_ubc_file_out - character(len=*), intent(out), optional :: snoe_ubc_file_out - integer , intent(out), optional :: tgcm_ubc_cycle_yr_out - integer , intent(out), optional :: tgcm_ubc_fixed_ymd_out - integer , intent(out), optional :: tgcm_ubc_fixed_tod_out - character(len=*), intent(out), optional :: tgcm_ubc_data_type_out - -!----------------------------------------------------------------------- - - if ( present(tgcm_ubc_file_out) ) then - tgcm_ubc_file_out = tgcm_ubc_file - endif - if ( present(tgcm_ubc_data_type_out) ) then - tgcm_ubc_data_type_out = tgcm_ubc_data_type - endif - if ( present(tgcm_ubc_cycle_yr_out) ) then - tgcm_ubc_cycle_yr_out = tgcm_ubc_cycle_yr - endif - if ( present(tgcm_ubc_fixed_ymd_out) ) then - tgcm_ubc_fixed_ymd_out = tgcm_ubc_fixed_ymd - endif - if ( present(tgcm_ubc_fixed_tod_out) ) then - tgcm_ubc_fixed_tod_out = tgcm_ubc_fixed_tod - endif - if ( present(snoe_ubc_file_out) ) then - snoe_ubc_file_out = snoe_ubc_file - endif - if ( present(t_pert_ubc_out) ) then - t_pert_ubc_out = t_pert_ubc - endif - if ( present(no_xfac_ubc_out) ) then - no_xfac_ubc_out = no_xfac_ubc - endif - -end subroutine ubc_defaultopts - -!================================================================================================ - -subroutine ubc_setopts(tgcm_ubc_file_in, tgcm_ubc_data_type_in, tgcm_ubc_cycle_yr_in, tgcm_ubc_fixed_ymd_in, & - tgcm_ubc_fixed_tod_in, snoe_ubc_file_in, t_pert_ubc_in, no_xfac_ubc_in) -!----------------------------------------------------------------------- -! Purpose: Set runtime options -!----------------------------------------------------------------------- - - use cam_abortutils, only : endrun - - real(r8), intent(in), optional :: t_pert_ubc_in - real(r8), intent(in), optional :: no_xfac_ubc_in - character(len=*), intent(in), optional :: tgcm_ubc_file_in - character(len=*), intent(in), optional :: snoe_ubc_file_in - integer , intent(in), optional :: tgcm_ubc_cycle_yr_in - integer , intent(in), optional :: tgcm_ubc_fixed_ymd_in - integer , intent(in), optional :: tgcm_ubc_fixed_tod_in - character(len=*), intent(in), optional :: tgcm_ubc_data_type_in - -!----------------------------------------------------------------------- - - if ( present(tgcm_ubc_file_in) ) then - tgcm_ubc_file = tgcm_ubc_file_in - endif - if ( present(tgcm_ubc_data_type_in) ) then - tgcm_ubc_data_type = tgcm_ubc_data_type_in - endif - if ( present(tgcm_ubc_cycle_yr_in) ) then - tgcm_ubc_cycle_yr = tgcm_ubc_cycle_yr_in - endif - if ( present(tgcm_ubc_fixed_ymd_in) ) then - tgcm_ubc_fixed_ymd = tgcm_ubc_fixed_ymd_in - endif - if ( present(tgcm_ubc_fixed_tod_in) ) then - tgcm_ubc_fixed_tod = tgcm_ubc_fixed_tod_in - endif - if ( present(snoe_ubc_file_in) ) then - snoe_ubc_file = snoe_ubc_file_in - endif - if ( present(t_pert_ubc_in) ) then - t_pert_ubc = t_pert_ubc_in - endif - if ( present(no_xfac_ubc_in) ) then - no_xfac_ubc = no_xfac_ubc_in - if( no_xfac_ubc < 0._r8 ) then - write(iulog,*) 'ubc_setopts: no_xfac_ubc = ',no_xfac_ubc,' must be >= 0' - call endrun - end if - endif - -end subroutine ubc_setopts - -!=============================================================================== - - subroutine ubc_init() -!----------------------------------------------------------------------- -! Initialization of time independent fields for the upper boundary condition -! Calls initialization routine for MSIS, TGCM and SNOE -!----------------------------------------------------------------------- - - ! Assume we are running in a simulation with ptop >= 1 Pa - apply_upper_bc = .false. - - if (.not.apply_upper_bc) return - - end subroutine ubc_init - -!=============================================================================== - - subroutine ubc_timestep_init(pbuf2d, state) -!----------------------------------------------------------------------- -! timestep dependent setting -!----------------------------------------------------------------------- - - use solar_parms_data, only: kp=>solar_parms_kp, ap=>solar_parms_ap, f107=>solar_parms_f107 - use solar_parms_data, only: f107a=>solar_parms_f107a, f107p=>solar_parms_f107p - use physics_types, only: physics_state - use ppgrid, only: begchunk, endchunk - use physics_buffer, only: physics_buffer_desc - - type(physics_state), intent(in) :: state(begchunk:endchunk) - type(physics_buffer_desc), pointer :: pbuf2d(:,:) - - if (.not.apply_upper_bc) return - - end subroutine ubc_timestep_init - -!=============================================================================== - - subroutine ubc_get_vals (lchnk, ncol, pint, zi, t, q, omega, phis, & - msis_temp, ubc_mmr, ubc_flux) - -!----------------------------------------------------------------------- -! interface routine for vertical diffusion and pbl scheme -!----------------------------------------------------------------------- - use cam_abortutils, only: endrun - use physconst, only: avogad, rairv, mbarv, rga ! Avogadro, gas constant, mean mass, universal gas constant - use phys_control, only: waccmx_is - use constituents, only: cnst_get_ind, cnst_mw, cnst_fixed_ubc ! Needed for ubc_flux - -!------------------------------Arguments-------------------------------- - integer, intent(in) :: lchnk ! chunk identifier - integer, intent(in) :: ncol ! number of atmospheric columns - real(r8), intent(in) :: pint(pcols,pverp) ! interface pressures - real(r8), intent(in) :: zi(pcols,pverp) ! interface geoptl height above sfc - real(r8), intent(in) :: t(pcols,pver) ! midpoint temperature - real(r8), intent(in),target :: q(pcols,pver,pcnst) ! contituent mixing ratios (kg/kg) - real(r8), intent(in) :: omega(pcols,pver) ! Vertical pressure velocity (Pa/s) - real(r8), intent(in) :: phis(pcols) ! Surface geopotential (m2/s2) - - real(r8), intent(out) :: msis_temp(pcols) ! upper bndy temperature (K) - real(r8), intent(out) :: ubc_mmr(pcols,pcnst) ! upper bndy mixing ratios (kg/kg) - real(r8), intent(out) :: ubc_flux(pcols,pcnst) ! upper bndy flux (kg/s/m^2) - -!---------------------------Local storage------------------------------- - integer :: m ! constituent index - integer :: ierr ! error flag for allocates - integer :: indx_H ! cnst index for H - integer :: indx_HE ! cnst index for He - integer :: iCol ! column loop counter - - real(r8), parameter :: m2km = 1.e-3_r8 ! meter to km - real(r8) :: rho_top(pcols) ! density at top interface - real(r8) :: z_top(pcols) ! height of top interface (km) - - real(r8), parameter :: hfluxlimitfac = 0.72_r8 ! Hydrogen upper boundary flux limiting factor - - real(r8) :: nmbartop ! Top level density (rho) - real(r8) :: zkt ! Factor for H Jean's escape flux calculation - real(r8) :: nDensHETop ! Helium number density (kg/m3) - real(r8) :: pScaleHeight ! Scale height (m) - real(r8) :: wN2 ! Neutral vertical velocity second level (m/s) - real(r8) :: wN3 ! Neutral vertical velocity at third level (m/s) - real(r8) :: wNTop ! Neutral vertical velocity at top level (m/s) - - real(r8), pointer :: qh_top(:) ! Top level hydrogen mixing ratio (kg/kg) -!----------------------------------------------------------------------- - - ubc_mmr(:,:) = 0._r8 - ubc_flux(:,:) = 0._r8 - msis_temp(:) = 0._r8 - - if (.not. apply_upper_bc) return - - end subroutine ubc_get_vals - -end module upper_bc diff --git a/src/chemistry/modal_aero/modal_aero_gasaerexch.F90 b/src/chemistry/modal_aero/modal_aero_gasaerexch.F90 index 503853defd..31e6170a2d 100644 --- a/src/chemistry/modal_aero/modal_aero_gasaerexch.F90 +++ b/src/chemistry/modal_aero/modal_aero_gasaerexch.F90 @@ -108,8 +108,7 @@ subroutine modal_aero_gasaerexch_sub( & use physconst, only: gravit, mwdry, rair use cam_abortutils, only: endrun use spmd_utils, only: iam, masterproc -use mo_chem_utls, only: utls_chem_is - +use phys_control, only: cam_chempkg_is implicit none @@ -264,7 +263,7 @@ subroutine modal_aero_gasaerexch_sub( & ! set gas species indices call cnst_get_ind( 'H2SO4', l_so4g, .false. ) call cnst_get_ind( 'NH3', l_nh4g, .false. ) - if ( .not. utls_chem_is('GEOS-Chem') ) then + if ( .not. cam_chempkg_is('geoschem_mam4') ) then call cnst_get_ind( 'MSA', l_msag, .false. ) else l_msag = 0 diff --git a/src/chemistry/modal_aero/sox_cldaero_mod.F90 b/src/chemistry/modal_aero/sox_cldaero_mod.F90 index 589c881279..2500aa37e5 100644 --- a/src/chemistry/modal_aero/sox_cldaero_mod.F90 +++ b/src/chemistry/modal_aero/sox_cldaero_mod.F90 @@ -7,14 +7,13 @@ module sox_cldaero_mod use cam_abortutils, only : endrun use ppgrid, only : pcols, pver use mo_chem_utls, only : get_spc_ndx - use mo_chem_utls, only: utls_chem_is use cldaero_mod, only : cldaero_conc_t, cldaero_allocate, cldaero_deallocate use modal_aero_data, only : ntot_amode, modeptr_accum, lptr_so4_cw_amode, lptr_msa_cw_amode use modal_aero_data, only : numptrcw_amode, lptr_nh4_cw_amode use modal_aero_data, only : cnst_name_cw, specmw_so4_amode use chem_mods, only : adv_mass use physconst, only : gravit - use phys_control, only : phys_getopts + use phys_control, only : phys_getopts, cam_chempkg_is use cldaero_mod, only : cldaero_uptakerate use chem_mods, only : gas_pcnst @@ -231,10 +230,10 @@ subroutine sox_cldaero_update( & dqdt_aqo3rxn(:,:) = 0.0_r8 ! Avoid double counting in-cloud sulfur oxidation when running with - ! GEOS-Chem (CESM2-GC). If running with CESM2-GC, sulfur oxidation + ! GEOS-Chem. If running with GEOS-Chem then sulfur oxidation ! 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 ( utls_chem_is('GEOS-Chem') ) return + if ( cam_chempkg_is('geoschem_mam4') ) return lev_loop: do k = 1,pver col_loop: do i = 1,ncol diff --git a/src/chemistry/mozart/mo_chem_utls.F90 b/src/chemistry/mozart/mo_chem_utls.F90 index 6d47ed3a0a..992e0789e7 100644 --- a/src/chemistry/mozart/mo_chem_utls.F90 +++ b/src/chemistry/mozart/mo_chem_utls.F90 @@ -9,29 +9,43 @@ module mo_chem_utls contains - integer function get_spc_ndx( spc_name ) + integer function get_spc_ndx( spc_name, compare_uppercase ) !----------------------------------------------------------------------- ! ... return overall species index associated with spc_name !----------------------------------------------------------------------- use chem_mods, only : gas_pcnst use mo_tracname, only : tracnam => solsym + use string_utils, only : to_upper implicit none !----------------------------------------------------------------------- ! ... dummy arguments !----------------------------------------------------------------------- - character(len=*), intent(in) :: spc_name + character(len=*), intent(in) :: spc_name + logical, intent(in), optional :: compare_uppercase !----------------------------------------------------------------------- ! ... local variables !----------------------------------------------------------------------- integer :: m + logical :: convert_to_upper + logical :: match + + convert_to_upper = .false. + if ( present( compare_uppercase ) ) then + convert_to_upper = compare_uppercase + endif get_spc_ndx = -1 do m = 1,gas_pcnst - if( trim( spc_name ) == trim( tracnam(m) ) ) then + if ( .not. convert_to_upper ) then + match = trim( spc_name ) == trim( tracnam(m) ) + else + match = trim( to_upper( spc_name ) ) == trim( to_upper( tracnam(m) ) ) + endif + if( match ) then get_spc_ndx = m exit end if From 9c5f0b4c8261eada8270a1af9e193609d42cf605 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Wed, 4 Jan 2023 12:40:05 -0700 Subject: [PATCH 081/291] Removed unused file geoschem/getLandTypes.F90 Signed-off-by: Lizzie Lundgren --- src/chemistry/geoschem/getLandTypes.F90 | 549 ------------------------ 1 file changed, 549 deletions(-) delete mode 100644 src/chemistry/geoschem/getLandTypes.F90 diff --git a/src/chemistry/geoschem/getLandTypes.F90 b/src/chemistry/geoschem/getLandTypes.F90 deleted file mode 100644 index 93e1030340..0000000000 --- a/src/chemistry/geoschem/getLandTypes.F90 +++ /dev/null @@ -1,549 +0,0 @@ -!------------------------------------------------------------------------------ -!BOP -! -! !ROUTINE: getLandTypes.F90 -! -! !DESCRIPTION: Subroutine getLandTypes converts the land types and leaf -! area indices from the land model to the LandTypeFrac and XLAI_NATIVE -! arrays in GEOS-Chem. -! -! !INTERFACE: -! - SUBROUTINE getLandTypes( cam_in, nY, State_Met ) -! -! !USES: -! - USE camsrfexch, ONLY : cam_in_t - USE State_Met_Mod, ONLY : MetState - USE shr_kind_mod, ONLY : r8 => shr_kind_r8 - USE PRECISION_MOD, ONLY : fp, f4 ! Flexible precision - USE CMN_SIZE_Mod, ONLY : NSURFTYPE - USE cam_abortutils, ONLY : endrun - - IMPLICIT NONE -! -! !INPUT PARAMETERS: -! - TYPE(cam_in_t), INTENT(IN ) :: cam_in ! CAM - INTEGER, INTENT(IN ) :: nY ! Number of grid cells on chunk -! -! !INPUT/OUTPUT PARAMETERS: -! - TYPE(MetState), INTENT(INOUT) :: State_Met -! -! !REVISION HISTORY: -! 8 May 2020 - Thibaud M. Fritz - Initial version -!EOP -!------------------------------------------------------------------------------ -!BOC -! -! !LOCAL VARIABLES: -! - INTEGER :: J, T - REAL(r8) :: waterFrac, landFrac - -#if defined( CLM40 ) - - ! Mapping for CLM4.0 - ! -----------------------------------|-------------------------------------- - ! Olson land type | CLM land type - ! -----------------------------------|-------------------------------------- - ! Inland/sea water (ID = 1) | Ocean fraction - ! | Deeplake & Shallowlake (LUID =3/4) - ! Urban (ID = 2) | Urban - Not Applied (LUID = 6) - ! Low Sparse Grassland (ID = 3) | - ! Coniferous Forest (ID = 4) | - ! Deciduous Conifer Forest (ID = 5) | Needleleaf Deciduous Bor. (PAID = 3) - ! Deciduous Broadleaf For. (ID = 6) | - ! Evergreen Broadleaf For. (ID = 7) | Broadleaf Evergreen Temp. (PAID = 5) - ! Tall Grasses and Shrubs (ID = 8) | - ! Bare Desert (ID = 9) | Not veg. \ Ice (PAID = 0\LUID = 2) - ! Upland Tundra (ID = 10) | Broadleaf Deciduous Bore. (PAID = 11) - ! Irrigated Grassland (ID = 11) | - ! Semi Desert (ID = 12) | - ! Glacier ice (ID = 13) | Land ice (LUID = 2) - ! Wooded Wet Swamp (ID = 14) | - ! - (ID = 15) | - ! - (ID = 16) | - ! Shrub Evergreen (ID = 17) | Broadleaf Evergreen Shru. (PAID = 9) - ! - (ID = 18) | - ! Shrub Deciduous (ID = 19) | - ! Evergreen Forest and Fi. (ID = 20) | - ! Cool Rain Forest (ID = 21) | - ! Conifer Boreal Forest (ID = 22) | Needleleaf Evergreen Bor. (PAID = 2) - ! Cool Conifer Forest (ID = 23) | - ! Cool Mixed Forest (ID = 24) | Broadleaf Deciduous Bore. (PAID = 8) - ! Mixed Forest (ID = 25) | - ! Cool Broadleaf Forest (ID = 26) | Broadleaf Deciduous Temp. (PAID = 7) - ! Deciduous Broadleaf For. (ID = 27) | - ! Conifer Forest (ID = 28) | Needleleaf Evergreen Tem. (PAID = 1) - ! Montane Tropical Forests (ID = 29) | - ! Seasonal Tropical Fores. (ID = 30) | - ! Cool Crops and Towns (ID = 31) | Winter Temp. Cereal (PAID = 19) - ! Crops and Town (ID = 32) | C3 Crop (PAID = 15) - ! | C3 Irrigated (PAID = 16) - ! | Spring Temp. Cereal (PAID = 18) - ! Dry Tropical Woods (ID = 33) | - ! Tropical Rainforest (ID = 34) | Broadleaf Evergreen Trop. (PAID = 4) - ! Tropical Degraded Forest (ID = 35) | - ! Corn and Beans Cropland (ID = 36) | Corn (PAID = 17) - ! | Soybean (PAID = 20) - ! Rice Paddy and Field (ID = 37) | - ! Hot Irrigated Cropland (ID = 38) | - ! Cool Irrigated Cropland (ID = 39) | - ! - (ID = 40) | - ! Cool Grasses and Shrubs (ID = 41) | - ! Hot and Mild Grasses and (ID = 42) | C3 Non-Arctic Grass (PAID = 13) - ! Cold Grassland (ID = 43) | C3 Arctic Grass (PAID = 12) - ! Savanna (Woods) (ID = 44) | Broadleaf Deciduous Trop. (PAID = 6) - ! | C4 Grass (PAID = 14) - ! Mire, Bog, Fen (ID = 45) | Wetland - Not Applied (LUID = 5) - ! Marsh Wetland (ID = 46) | - ! Mediterranean Scrub (ID = 47) | - ! Dry Woody Scrub (ID = 48) | Broadleaf Deciduous Temp. (PAID = 10) - ! - (ID = 49) | - ! - (ID = 50) | - ! - (ID = 51) | - ! Semi Desert Shrubs (ID = 52) | - ! Semi Desert Sage (ID = 53) | - ! Barren Tundra (ID = 54) | - ! Cool Southern Hemisphere (ID = 55) | - ! Cool Fields and Woods (ID = 56) | - ! Forest and Field (ID = 57) | - ! Cool Forest and Field (ID = 58) | - ! Fields and Woody Savanna (ID = 59) | - ! Succulent and Thorn Scr. (ID = 60) | - ! Small Leaf Mixed Woods (ID = 61) | - ! Deciduous and Mixed Bor. (ID = 62) | - ! Narrow Conifers (ID = 63) | - ! Wooded Tundra (ID = 64) | - ! Heath Scrub (ID = 65) | - ! - (ID = 66) | - ! - (ID = 67) | - ! - (ID = 68) | - ! - (ID = 69) | - ! Polar and Alpine Desert (ID = 70) | - ! - (ID = 71) | - ! - (ID = 72) | - ! Mangrove (ID = 73) | - - !================================================================== - ! The urban and wetland land unit types seem to be already - ! accounted for in patches, as it introduces total land fractions - ! (summed over all types) greater than 100%. - ! Thibaud M. Fritz - 06 May 2020 - !================================================================== - - DO J = 1, nY - waterFrac = cam_in%ocnFrac(J) + cam_in%iceFrac(J) & - + cam_in%lwtgcell(J,3) + cam_in%lwtgcell(J,4) - landFrac = 1.0e+0_fp - waterFrac - - ! Initialize fraction land for this grid cell - State_Met%LandTypeFrac(1,J, 1) = waterFrac - !State_Met%LandTypeFrac(1,J, 2) = cam_in%lwtgcell(J, 6) - State_Met%LandTypeFrac(1,J, 5) = cam_in%pwtgcell(J, 4) - State_Met%LandTypeFrac(1,J, 7) = cam_in%pwtgcell(J, 6) - State_Met%LandTypeFrac(1,J, 9) = cam_in%pwtgcell(J, 1) & - - cam_in%lwtgcell(J, 2) - State_Met%LandTypeFrac(1,J,10) = cam_in%pwtgcell(J,12) - State_Met%LandTypeFrac(1,J,13) = cam_in%lwtgcell(J, 2) - State_Met%LandTypeFrac(1,J,17) = cam_in%pwtgcell(J,10) - State_Met%LandTypeFrac(1,J,22) = cam_in%pwtgcell(J, 3) - State_Met%LandTypeFrac(1,J,24) = cam_in%pwtgcell(J, 9) - State_Met%LandTypeFrac(1,J,26) = cam_in%pwtgcell(J, 8) - State_Met%LandTypeFrac(1,J,28) = cam_in%pwtgcell(J, 2) - State_Met%LandTypeFrac(1,J,31) = cam_in%pwtgcell(J,20) - State_Met%LandTypeFrac(1,J,32) = cam_in%pwtgcell(J,16) & - + cam_in%pwtgcell(J,17) & - + cam_in%pwtgcell(J,19) - State_Met%LandTypeFrac(1,J,34) = cam_in%pwtgcell(J, 5) - State_Met%LandTypeFrac(1,J,36) = cam_in%pwtgcell(J,18) & - + cam_in%pwtgcell(J,21) - State_Met%LandTypeFrac(1,J,42) = cam_in%pwtgcell(J,14) - State_Met%LandTypeFrac(1,J,43) = cam_in%pwtgcell(J,13) - State_Met%LandTypeFrac(1,J,44) = cam_in%pwtgcell(J, 7) & - + cam_in%pwtgcell(J,15) - !State_Met%LandTypeFrac(1,J,45) = cam_in%lwtgcell(J, 5) - State_Met%LandTypeFrac(1,J,48) = cam_in%pwtgcell(J,11) - - State_Met%XLAI_NATIVE(1,J, 5) = cam_in%lai(J, 4) - State_Met%XLAI_NATIVE(1,J, 7) = cam_in%lai(J, 6) - State_Met%XLAI_NATIVE(1,J,10) = cam_in%lai(J,12) - State_Met%XLAI_NATIVE(1,J,17) = cam_in%lai(J,10) - State_Met%XLAI_NATIVE(1,J,22) = cam_in%lai(J, 3) - State_Met%XLAI_NATIVE(1,J,24) = cam_in%lai(J, 9) - State_Met%XLAI_NATIVE(1,J,26) = cam_in%lai(J, 8) - State_Met%XLAI_NATIVE(1,J,28) = cam_in%lai(J, 2) - State_Met%XLAI_NATIVE(1,J,31) = cam_in%lai(J,20) - State_Met%XLAI_NATIVE(1,J,32) = cam_in%lai(J,16) & - + cam_in%lai(J,17) & - + cam_in%lai(J,19) - State_Met%XLAI_NATIVE(1,J,34) = cam_in%lai(J, 5) - State_Met%XLAI_NATIVE(1,J,36) = cam_in%lai(J,18) & - + cam_in%lai(J,21) - State_Met%XLAI_NATIVE(1,J,42) = cam_in%lai(J,14) - State_Met%XLAI_NATIVE(1,J,43) = cam_in%lai(J,13) - State_Met%XLAI_NATIVE(1,J,44) = cam_in%lai(J, 7) & - + cam_in%lai(J,15) - State_Met%XLAI_NATIVE(1,J,48) = cam_in%lai(J,11) - - DO T = 2, NSURFTYPE - State_Met%LandTypeFrac(1,J,T) = & - State_Met%LandTypeFrac(1,J,T) * landFrac - - State_Met%XLAI_NATIVE(1,J,T) = & - State_Met%XLAI_NATIVE(1,J,T) * landFrac - - ! Make sure that the land type fractions do not exceed 1 - IF ( State_Met%LandTypeFrac(1,J,T) > 1.0e+0_fp ) THEN - State_Met%LandTypeFrac(1,J,T) = 1.0e+0_fp - ELSEIF ( State_Met%LandTypeFrac(1,J,T) < 0.0e+0_fp ) THEN - State_Met%LandTypeFrac(1,J,T) = 0.0e+0_fp - ENDIF - ENDDO - - ENDDO - -#elif defined( CLM45 ) || defined( CLM50 ) - - ! Mapping for CLM4.5/CLM5.0 - ! -----------------------------------|-------------------------------------- - ! Olson land type | CLM land type - ! -----------------------------------|-------------------------------------- - ! Inland/sea water (ID = 1) | Ocean fraction - ! | Deeplake (LUID = 5) - ! Urban (ID = 2) | Urban - Not Applied (LUID =7-9) - ! Low Sparse Grassland (ID = 3) | - ! Coniferous Forest (ID = 4) | - ! Deciduous Conifer Forest (ID = 5) | Needleleaf Deciduous Bor. (PAID = 3) - ! Deciduous Broadleaf For. (ID = 6) | - ! Evergreen Broadleaf For. (ID = 7) | Broadleaf Evergreen Temp. (PAID = 5) - ! Tall Grasses and Shrubs (ID = 8) | - ! Bare Desert (ID = 9) | Not veg. \ Ice (PAID = 0\LUID = 4) - ! Upland Tundra (ID = 10) | Broadleaf Deciduous Bore. (PAID = 11) - ! Irrigated Grassland (ID = 11) | - ! Semi Desert (ID = 12) | - ! Glacier ice (ID = 13) | Land ice (LUID = 4) - ! Wooded Wet Swamp (ID = 14) | - ! - (ID = 15) | - ! - (ID = 16) | - ! Shrub Evergreen (ID = 17) | Broadleaf Evergreen Shru. (PAID = 9) - ! - (ID = 18) | - ! Shrub Deciduous (ID = 19) | - ! Evergreen Forest and Fi. (ID = 20) | - ! Cool Rain Forest (ID = 21) | - ! Conifer Boreal Forest (ID = 22) | Needleleaf Evergreen Bor. (PAID = 2) - ! Cool Conifer Forest (ID = 23) | - ! Cool Mixed Forest (ID = 24) | Broadleaf Deciduous Bore. (PAID = 8) - ! Mixed Forest (ID = 25) | - ! Cool Broadleaf Forest (ID = 26) | Broadleaf Deciduous Temp. (PAID = 7) - ! Deciduous Broadleaf For. (ID = 27) | - ! Conifer Forest (ID = 28) | Needleleaf Evergreen Tem. (PAID = 1) - ! Montane Tropical Forests (ID = 29) | - ! Seasonal Tropical Fores. (ID = 30) | - ! Cool Crops and Towns (ID = 31) | - ! Crops and Town (ID = 32) | C3 Crop (PAID = 15) - ! | C3 Irrigated (PAID = 16) - ! Dry Tropical Woods (ID = 33) | - ! Tropical Rainforest (ID = 34) | Broadleaf Evergreen Trop. (PAID = 4) - ! Tropical Degraded Forest (ID = 35) | - ! Corn and Beans Cropland (ID = 36) | Corn (PAID = 17) - ! | Irrigated Temperate Corn (PAID = 18) - ! | Spring Wheat (PAID = 19) - ! | Irrigated Spring Wheat (PAID = 20) - ! | Winter Wheat (PAID = 21) - ! | Irrigated Winter Wheat (PAID = 22) - ! | Temperated Soybean (PAID = 23) - ! | Irrigated Temperate Soyb. (PAID = 24) - ! | Barley (PAID = 25) - ! | Irrigated Barley (PAID = 26) - ! | Winter Barley (PAID = 27) - ! | Irrigated Winter Barley (PAID = 28) - ! | Rye (PAID = 29) - ! | Irrigated Rye (PAID = 30) - ! | Winter Rye (PAID = 31) - ! | Irrigated Winter Rye (PAID = 32) - ! | Cassava (PAID = 33) - ! | Irrigated Cassava (PAID = 34) - ! | Citrus (PAID = 35) - ! | Irrigated Citrus (PAID = 36) - ! | Cocoa (PAID = 37) - ! | Irrigated Cocoa (PAID = 38) - ! | Coffee (PAID = 39) - ! | Irrigated Coffee (PAID = 40) - ! | Cotton (PAID = 41) - ! | Irrigated Cotton (PAID = 42) - ! | Datepalm (PAID = 43) - ! | Irrigated Datepalm (PAID = 44) - ! | Foddergrass (PAID = 45) - ! | Irrigated Foddergrass (PAID = 46) - ! | Grapes (PAID = 47) - ! | Irrigated Grapes (PAID = 48) - ! | Groundnuts (PAID = 49) - ! | Irrigated Groundnuts (PAID = 50) - ! | Millet (PAID = 51) - ! | Irrigated Millet (PAID = 52) - ! | Oilpalm (PAID = 53) - ! | Irrigated Oilpalm (PAID = 54) - ! | Potatoes (PAID = 55) - ! | Irrigated Potatoes (PAID = 56) - ! | Pulses (PAID = 57) - ! | Irrigated Pulses (PAID = 58) - ! | Rapeseed (PAID = 59) - ! | Irrigated Rapeseed (PAID = 60) - ! | Rice (PAID = 61) - ! | Irrigated Rice (PAID = 62) - ! | Sorghum (PAID = 63) - ! | Irrigated Sorghum (PAID = 64) - ! | Sugarbeet (PAID = 65) - ! | Irrigated Sugarbeet (PAID = 66) - ! | Sugarcane (PAID = 67) - ! | Irrigated Sugarcane (PAID = 68) - ! | Sunflower (PAID = 69) - ! | Irrigated Sunflower (PAID = 70) - ! | Miscanthus (PAID = 71) - ! | Irrigated Miscanthus (PAID = 72) - ! | Switchgrass (PAID = 73) - ! | Irrigated Switchgrass (PAID = 74) - ! | Tropical Corn (PAID = 75) - ! | Irrigated Tropical Corn (PAID = 76) - ! | Tropical Soybean (PAID = 77) - ! | Irrigated Tropical Soybe. (PAID = 78) - ! Rice Paddy and Field (ID = 37) | - ! Hot Irrigated Cropland (ID = 38) | - ! Cool Irrigated Cropland (ID = 39) | - ! - (ID = 40) | - ! Cool Grasses and Shrubs (ID = 41) | - ! Hot and Mild Grasses and (ID = 42) | C3 Non-Arctic Grass (PAID = 13) - ! Cold Grassland (ID = 43) | C3 Arctic Grass (PAID = 12) - ! Savanna (Woods) (ID = 44) | Broadleaf Deciduous Trop. (PAID = 6) - ! | C4 Grass (PAID = 14) - ! Mire, Bog, Fen (ID = 45) | Wetland - Not Applied (LUID = 6) - ! Marsh Wetland (ID = 46) | - ! Mediterranean Scrub (ID = 47) | - ! Dry Woody Scrub (ID = 48) | Broadleaf Deciduous Temp. (PAID = 10) - ! - (ID = 49) | - ! - (ID = 50) | - ! - (ID = 51) | - ! Semi Desert Shrubs (ID = 52) | - ! Semi Desert Sage (ID = 53) | - ! Barren Tundra (ID = 54) | - ! Cool Southern Hemisphere (ID = 55) | - ! Cool Fields and Woods (ID = 56) | - ! Forest and Field (ID = 57) | - ! Cool Forest and Field (ID = 58) | - ! Fields and Woody Savanna (ID = 59) | - ! Succulent and Thorn Scr. (ID = 60) | - ! Small Leaf Mixed Woods (ID = 61) | - ! Deciduous and Mixed Bor. (ID = 62) | - ! Narrow Conifers (ID = 63) | - ! Wooded Tundra (ID = 64) | - ! Heath Scrub (ID = 65) | - ! - (ID = 66) | - ! - (ID = 67) | - ! - (ID = 68) | - ! - (ID = 69) | - ! Polar and Alpine Desert (ID = 70) | - ! - (ID = 71) | - ! - (ID = 72) | - ! Mangrove (ID = 73) | - - State_Met%LandTypeFrac(:,:,:) = 0.0e+0_fp - State_Met%XLAI_NATIVE(:,:,:) = 0.0e+0_fp - - DO J = 1, nY - waterFrac = cam_in%ocnFrac(J) + cam_in%iceFrac(J) & - + cam_in%lwtgcell(J,5) - landFrac = 1.0e+0_fp - waterFrac - - ! Initialize fraction land for this grid cell - State_Met%LandTypeFrac(1,J, 1) = waterFrac - !State_Met%LandTypeFrac(1,J, 2) = cam_in%lwtgcell(J, 7) & - ! + cam_in%lwtgcell(J, 8) & - ! + cam_in%lwtgcell(J, 9) - State_Met%LandTypeFrac(1,J, 5) = cam_in%pwtgcell(J, 4) - State_Met%LandTypeFrac(1,J, 7) = cam_in%pwtgcell(J, 6) - State_Met%LandTypeFrac(1,J, 9) = cam_in%pwtgcell(J, 1) & - * ( 1.0e+0_fp - cam_in%lwtgcell(J, 4) ) - State_Met%LandTypeFrac(1,J,10) = cam_in%pwtgcell(J,12) - State_Met%LandTypeFrac(1,J,13) = cam_in%lwtgcell(J, 4) - State_Met%LandTypeFrac(1,J,17) = cam_in%pwtgcell(J,10) - State_Met%LandTypeFrac(1,J,22) = cam_in%pwtgcell(J, 3) - State_Met%LandTypeFrac(1,J,24) = cam_in%pwtgcell(J, 9) - State_Met%LandTypeFrac(1,J,26) = cam_in%pwtgcell(J, 8) - State_Met%LandTypeFrac(1,J,28) = cam_in%pwtgcell(J, 2) - State_Met%LandTypeFrac(1,J,32) = cam_in%pwtgcell(J,16) & - + cam_in%pwtgcell(J,17) - State_Met%LandTypeFrac(1,J,34) = cam_in%pwtgcell(J, 5) - State_Met%LandTypeFrac(1,J,36) = cam_in%pwtgcell(J,18) & - + cam_in%pwtgcell(J,19) & - + cam_in%pwtgcell(J,20) & - + cam_in%pwtgcell(J,21) & - + cam_in%pwtgcell(J,22) & - + cam_in%pwtgcell(J,23) & - + cam_in%pwtgcell(J,24) & - + cam_in%pwtgcell(J,25) & - + cam_in%pwtgcell(J,26) & - + cam_in%pwtgcell(J,27) & - + cam_in%pwtgcell(J,28) & - + cam_in%pwtgcell(J,29) & - + cam_in%pwtgcell(J,30) & - + cam_in%pwtgcell(J,31) & - + cam_in%pwtgcell(J,32) & - + cam_in%pwtgcell(J,33) & - + cam_in%pwtgcell(J,34) & - + cam_in%pwtgcell(J,35) & - + cam_in%pwtgcell(J,36) & - + cam_in%pwtgcell(J,37) & - + cam_in%pwtgcell(J,38) & - + cam_in%pwtgcell(J,39) & - + cam_in%pwtgcell(J,40) & - + cam_in%pwtgcell(J,41) & - + cam_in%pwtgcell(J,42) & - + cam_in%pwtgcell(J,43) & - + cam_in%pwtgcell(J,44) & - + cam_in%pwtgcell(J,45) & - + cam_in%pwtgcell(J,46) & - + cam_in%pwtgcell(J,47) & - + cam_in%pwtgcell(J,48) & - + cam_in%pwtgcell(J,49) & - + cam_in%pwtgcell(J,50) & - + cam_in%pwtgcell(J,51) & - + cam_in%pwtgcell(J,52) & - + cam_in%pwtgcell(J,53) & - + cam_in%pwtgcell(J,54) & - + cam_in%pwtgcell(J,55) & - + cam_in%pwtgcell(J,56) & - + cam_in%pwtgcell(J,57) & - + cam_in%pwtgcell(J,58) & - + cam_in%pwtgcell(J,59) & - + cam_in%pwtgcell(J,60) & - + cam_in%pwtgcell(J,61) & - + cam_in%pwtgcell(J,62) & - + cam_in%pwtgcell(J,63) & - + cam_in%pwtgcell(J,64) & - + cam_in%pwtgcell(J,65) & - + cam_in%pwtgcell(J,66) & - + cam_in%pwtgcell(J,67) & - + cam_in%pwtgcell(J,68) & - + cam_in%pwtgcell(J,69) & - + cam_in%pwtgcell(J,70) & - + cam_in%pwtgcell(J,71) & - + cam_in%pwtgcell(J,72) & - + cam_in%pwtgcell(J,73) & - + cam_in%pwtgcell(J,74) & - + cam_in%pwtgcell(J,75) & - + cam_in%pwtgcell(J,76) & - + cam_in%pwtgcell(J,77) & - + cam_in%pwtgcell(J,78) & - + cam_in%pwtgcell(J,79) - State_Met%LandTypeFrac(1,J,42) = cam_in%pwtgcell(J,14) - State_Met%LandTypeFrac(1,J,43) = cam_in%pwtgcell(J,13) - State_Met%LandTypeFrac(1,J,44) = cam_in%pwtgcell(J, 7) & - + cam_in%pwtgcell(J,15) - !State_Met%LandTypeFrac(1,J,45) = cam_in%lwtgcell(J, 6) - State_Met%LandTypeFrac(1,J,48) = cam_in%pwtgcell(J,11) - - State_Met%XLAI_NATIVE(1,J, 5) = cam_in%lai(J, 4) - State_Met%XLAI_NATIVE(1,J, 7) = cam_in%lai(J, 6) - State_Met%XLAI_NATIVE(1,J,10) = cam_in%lai(J,12) - State_Met%XLAI_NATIVE(1,J,17) = cam_in%lai(J,10) - State_Met%XLAI_NATIVE(1,J,22) = cam_in%lai(J, 3) - State_Met%XLAI_NATIVE(1,J,24) = cam_in%lai(J, 9) - State_Met%XLAI_NATIVE(1,J,26) = cam_in%lai(J, 8) - State_Met%XLAI_NATIVE(1,J,28) = cam_in%lai(J, 2) - State_Met%XLAI_NATIVE(1,J,32) = cam_in%lai(J,16) & - + cam_in%lai(J,17) - State_Met%XLAI_NATIVE(1,J,34) = cam_in%lai(J, 5) - State_Met%XLAI_NATIVE(1,J,36) = cam_in%lai(J,18) & - + cam_in%lai(J,19) & - + cam_in%lai(J,20) & - + cam_in%lai(J,21) & - + cam_in%lai(J,22) & - + cam_in%lai(J,23) & - + cam_in%lai(J,24) & - + cam_in%lai(J,25) & - + cam_in%lai(J,26) & - + cam_in%lai(J,27) & - + cam_in%lai(J,28) & - + cam_in%lai(J,29) & - + cam_in%lai(J,30) & - + cam_in%lai(J,31) & - + cam_in%lai(J,32) & - + cam_in%lai(J,33) & - + cam_in%lai(J,34) & - + cam_in%lai(J,35) & - + cam_in%lai(J,36) & - + cam_in%lai(J,37) & - + cam_in%lai(J,38) & - + cam_in%lai(J,39) & - + cam_in%lai(J,40) & - + cam_in%lai(J,41) & - + cam_in%lai(J,42) & - + cam_in%lai(J,43) & - + cam_in%lai(J,44) & - + cam_in%lai(J,45) & - + cam_in%lai(J,46) & - + cam_in%lai(J,47) & - + cam_in%lai(J,48) & - + cam_in%lai(J,49) & - + cam_in%lai(J,50) & - + cam_in%lai(J,51) & - + cam_in%lai(J,52) & - + cam_in%lai(J,53) & - + cam_in%lai(J,54) & - + cam_in%lai(J,55) & - + cam_in%lai(J,56) & - + cam_in%lai(J,57) & - + cam_in%lai(J,58) & - + cam_in%lai(J,59) & - + cam_in%lai(J,60) & - + cam_in%lai(J,61) & - + cam_in%lai(J,62) & - + cam_in%lai(J,63) & - + cam_in%lai(J,64) & - + cam_in%lai(J,65) & - + cam_in%lai(J,66) & - + cam_in%lai(J,67) & - + cam_in%lai(J,68) & - + cam_in%lai(J,69) & - + cam_in%lai(J,70) & - + cam_in%lai(J,71) & - + cam_in%lai(J,72) & - + cam_in%lai(J,73) & - + cam_in%lai(J,74) & - + cam_in%lai(J,75) & - + cam_in%lai(J,76) & - + cam_in%lai(J,77) & - + cam_in%lai(J,78) & - + cam_in%lai(J,79) - State_Met%XLAI_NATIVE(1,J,42) = cam_in%lai(J,14) - State_Met%XLAI_NATIVE(1,J,43) = cam_in%lai(J,13) - State_Met%XLAI_NATIVE(1,J,44) = cam_in%lai(J, 7) & - + cam_in%lai(J,15) - State_Met%XLAI_NATIVE(1,J,48) = cam_in%lai(J,11) - - DO T = 2, NSURFTYPE - State_Met%LandTypeFrac(1,J,T) = & - State_Met%LandTypeFrac(1,J,T) * landFrac - - State_Met%XLAI_NATIVE(1,J,T) = & - State_Met%XLAI_NATIVE(1,J,T) * landFrac - - ! Make sure that the land type fractions do not exceed 1 - IF ( State_Met%LandTypeFrac(1,J,T) > 1.0e+0_fp ) THEN - State_Met%LandTypeFrac(1,J,T) = 1.0e+0_fp - ELSEIF ( State_Met%LandTypeFrac(1,J,T) < 0.0e+0_fp ) THEN - State_Met%LandTypeFrac(1,J,T) = 0.0e+0_fp - ENDIF - ENDDO - - ENDDO - -#else - CALL endrun('Cannot figure out which version of CLM') -#endif - - END SUBROUTINE getLandTypes -!EOC From 0458ae6f8a45caad2edef034a742ef90893b0fae Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Wed, 4 Jan 2023 12:41:26 -0700 Subject: [PATCH 082/291] Modify mozart module mo_neu_wetdep for use when GEOS-Chem chemistry enabled Signed-off-by: Lizzie Lundgren --- src/chemistry/geoschem/mo_neu_wetdep.F90 | 1815 ---------------------- src/chemistry/mozart/mo_neu_wetdep.F90 | 6 +- 2 files changed, 5 insertions(+), 1816 deletions(-) delete mode 100644 src/chemistry/geoschem/mo_neu_wetdep.F90 diff --git a/src/chemistry/geoschem/mo_neu_wetdep.F90 b/src/chemistry/geoschem/mo_neu_wetdep.F90 deleted file mode 100644 index a168010729..0000000000 --- a/src/chemistry/geoschem/mo_neu_wetdep.F90 +++ /dev/null @@ -1,1815 +0,0 @@ -! -! code written by J.-F. Lamarque, S. Walters and F. Vitt -! based on the original code from J. Neu developed for UC Irvine -! model -! -! LKE 2/23/2018 - correct setting flag for mass-limited (HNO3,etc.) vs Henry's Law washout -! -module mo_neu_wetdep -! - use shr_kind_mod, only : r8 => shr_kind_r8 - use cam_logfile, only : iulog - use constituents, only : pcnst - use spmd_utils, only : masterproc - use cam_abortutils, only : endrun - use shr_drydep_mod, only : n_species_table, species_name_table, dheff - use gas_wetdep_opts, only : gas_wetdep_method, gas_wetdep_list, gas_wetdep_cnt -! - implicit none -! - private - public :: neu_wetdep_init - public :: neu_wetdep_tend -! - save -! - integer, allocatable, dimension(:) :: mapping_to_heff,mapping_to_mmr - real(r8),allocatable, dimension(:) :: mol_weight - logical ,allocatable, dimension(:) :: ice_uptake - integer :: index_cldice,index_cldliq,nh3_ndx,co2_ndx - logical :: debug = .false. - integer :: hno3_ndx = 0 - integer :: h2o2_ndx = 0 -! -! diagnostics -! - logical :: do_diag = .false. - integer, parameter :: kdiag = 18 -! - real(r8), parameter :: zero = 0._r8 - real(r8), parameter :: one = 1._r8 -! - logical :: do_neu_wetdep -! - real(r8), parameter :: TICE=263._r8 - -contains - -!----------------------------------------------------------------------- -!----------------------------------------------------------------------- -! -subroutine neu_wetdep_init -! - use constituents, only : cnst_get_ind,cnst_mw - use cam_history, only : addfld, add_default, horiz_only - use phys_control, only : phys_getopts -! - integer :: m,l - character*20 :: test_name - - logical :: history_chemistry - - call phys_getopts(history_chemistry_out=history_chemistry) - - do_neu_wetdep = gas_wetdep_method == 'NEU' .and. gas_wetdep_cnt>0 - - if (.not.do_neu_wetdep) return - - allocate( mapping_to_heff(gas_wetdep_cnt) ) - allocate( mapping_to_mmr(gas_wetdep_cnt) ) - allocate( ice_uptake(gas_wetdep_cnt) ) - allocate( mol_weight(gas_wetdep_cnt) ) - -! -! find mapping to heff table -! - if ( debug .and. masterproc ) then - print '(a,i4)','neu_wetdep_init: gas_wetdep_cnt=',gas_wetdep_cnt - print '(a,i4)','neu_wetdep_init: n_species_table=',n_species_table - end if - mapping_to_heff = -99 - do m=1,gas_wetdep_cnt -! - test_name = gas_wetdep_list(m) - if ( debug .and. masterproc ) print '(a,i4,a,a)','neu_wetdep_init: gas_wetdep_list species ',m,' ',trim(test_name) -! -! ewl: this mapping can be replaced by including Henry's Law etc for all species, which makes usage of -! the parameters more transparent. I will comment out.... -!!!! -!!!! mapping based on the MOZART4 wet removal subroutine; -!!!! this might need to be redone (JFL: Sep 2010) -!!!! -!!! select case( trim(test_name) ) -!!!! -!!!! CCMI: added SO2t and NH_50W -!!!! -!!! case( 'HYAC', 'CH3COOH' , 'HCOOH', 'EOOH', 'IEPOX' ) -!!! test_name = 'CH2O' -!!! case ( 'SOGB','SOGI','SOGM','SOGT','SOGX' ) -!!! test_name = 'H2O2' -!!! case ( 'SO2t' ) -!!! test_name = 'SO2' -!!! case ( 'CLONO2','BRONO2','HCL','HOCL','HOBR','HBR', 'Pb', 'MACROOH', 'ISOPOOH', 'XOOH', 'H2SO4', 'HF', 'COF2', 'COFCL') -!!! test_name = 'HNO3' -!!! case ( 'NH_50W', 'NDEP', 'NHDEP', 'NH4NO3' ) -!!! test_name = 'HNO3' -!!! case ( 'ALKOOH', 'MEKOOH', 'TOLOOH' ) -!!! test_name = 'CH3OOH' -!!! case( 'PHENOOH', 'BENZOOH', 'C6H5OOH', 'BZOOH', 'XYLOLOOH', 'XYLENOOH', 'HPALD' ) -!!! test_name = 'CH3OOH' -!!! case( 'TERPOOH', 'TERP2OOH', 'MBOOOH' ) -!!! test_name = 'HNO3' -!!! case( 'TERPROD1', 'TERPROD2' ) -!!! test_name = 'CH2O' -!!! case( 'HMPROP' ) -!!! test_name = 'GLYALD' -!!! case( 'NOA', 'ALKNIT', 'ISOPNITA', 'ISOPNITB', 'HONITR', 'ISOPNOOH' ) -!!! test_name = 'H2O2' -!!! case( 'NC4CHO', 'NC4CH2OH', 'TERPNIT', 'NTERPOOH' ) -!!! test_name = 'H2O2' -!!! case( 'SOAGbb0' ) ! Henry's Law coeff. added for VBS SOA's, biomass burning is the same as fossil fuels -!!! test_name = 'SOAGff0' -!!! case( 'SOAGbb1' ) -!!! test_name = 'SOAGff1' -!!! case( 'SOAGbb2' ) -!!! test_name = 'SOAGff2' -!!! case( 'SOAGbb3' ) -!!! test_name = 'SOAGff3' -!!! case( 'SOAGbb4' ) -!!! test_name = 'SOAGff4' -!!! case( 'H2O2' ) -!!! test_name = 'GC_H2O2' -!!! case( 'HCHO' ) -!!! test_name = 'GC_CH2O' -!!! case( 'CH2O' ) -!!! test_name = 'GC_CH2O' -!!! case( 'NO2' ) -!!! test_name = 'GC_NO2' -!!! !case( 'HNO3' ) -!!! ! test_name = 'GC_HNO3' -!!! case( 'NH3' ) -!!! test_name = 'GC_NH3' -!!! case( 'N2O5' ) -!!! test_name = 'GC_N2O5' -!!! case( 'PAN' ) -!!! test_name = 'GC_PAN' -!!! !case( 'SO2' ) -!!! ! test_name = 'GC_SO2' -!!! ! Now list all non-MAM GEOS-Chem aerosols. These will be scavenged similarly -!!! ! to HNO3 -!!! case( 'AERI', 'BRSALA', 'BRSALC', 'INDIOL', & -!!! 'IONITA', 'ISALA', 'ISALC', 'LVOCOA', 'MONITA', & -!!! 'MSA', 'NH4', 'NIT', 'NITS', 'PFE', & -!!! 'SALAAL', 'SALACL', 'SALCAL', 'SALCCL', 'SO4S', & -!!! 'SOAS', 'SOAGX', 'SOAIE', 'TSOA0', 'TSOA1', & -!!! 'TSOA2', 'TSOA3', 'ASOAN', 'ASOA1', 'ASOA2', & -!!! 'ASOA3' ) -!!! test_name = 'HNO3' -!!! case( 'ASOG1', 'ASOG2', 'ASOG3' ) -!!! test_name = 'ASOG' -!!! case( 'TSOG0', 'TSOG1', 'TSOG2', 'TSOG3' ) -!!! test_name = 'TSOG' -!!! end select -! - if ( debug .and. masterproc ) print '(a,i4,a)','neu_wetdep_init: using name for mapping: ',m,trim(test_name) -! - do l = 1,n_species_table - if( trim(test_name) == trim( species_name_table(l) ) ) then - mapping_to_heff(m) = l - if ( debug .and. masterproc ) print '(a,a,i4)','neu_wetdep_init: found mapping to heff of ',trim(species_name_table(l)),l - exit - end if - end do - if ( mapping_to_heff(m) == -99 ) then - print '(a,a)','neu_wetdep_init: ERROR: Ending run because mapping to species heff not found for ',trim(test_name) - call endrun() - end if -! -! special cases for NH3 and CO2 -! - if ( trim(test_name) == 'NH3' ) then - nh3_ndx = m - end if - if ( trim(test_name) == 'CO2' ) then - co2_ndx = m - end if - if ( trim(gas_wetdep_list(m)) == 'HNO3' ) then - hno3_ndx = m - end if -! - end do - - if (any ( mapping_to_heff(:) == -99 )) call endrun('mo_neu_wet->depwetdep_init: unmapped species error' ) -! - if ( debug .and. masterproc ) then - print '(a,i4)','neu_wetdep_init: co2_ndx',co2_ndx - print '(a,i4)','neu_wetdep_init: nh3_ndx',nh3_ndx - end if -! -! find mapping to species -! - mapping_to_mmr = -99 - do m=1,gas_wetdep_cnt - if ( debug .and. masterproc ) print '(a,i4,a)','neu_wetdep_init: ',m,trim(gas_wetdep_list(m)) - call cnst_get_ind(gas_wetdep_list(m), mapping_to_mmr(m), abort=.false. ) - if ( debug .and. masterproc) print '(a,i4)','neu_wetdep_init: mapping_to_mmr ',mapping_to_mmr(m) - if ( mapping_to_mmr(m) <= 0 ) then - print *,'neu_wetdep_init: problem with mapping_to_mmr of ',gas_wetdep_list(m) - call endrun('problem with mapping_to_mmr of '//trim(gas_wetdep_list(m))) - end if - end do -! -! define species-dependent arrays -! - do m=1,gas_wetdep_cnt -! - mol_weight(m) = cnst_mw(mapping_to_mmr(m)) - if ( debug .and. masterproc ) print '(a,i4,a,f8.4)','neu_wetdep_init: ',m,' mol_weight ',mol_weight(m) - ice_uptake(m) = .false. - if ( trim(gas_wetdep_list(m)) == 'HNO3' ) then - ice_uptake(m) = .true. - end if -! -! - end do -! -! indices for cloud quantities -! - call cnst_get_ind( 'CLDICE', index_cldice ) - call cnst_get_ind( 'CLDLIQ', index_cldliq ) -! -! define output -! - do m=1,gas_wetdep_cnt - call addfld ('DTWR_'//trim(gas_wetdep_list(m)),(/ 'lev' /), 'A','kg/kg/s','wet removal Neu scheme tendency') - call addfld ('WD_'//trim(gas_wetdep_list(m)),horiz_only, 'A','kg/m2/s','vertical integrated wet deposition flux') - call addfld ('HEFF_'//trim(gas_wetdep_list(m)),(/ 'lev' /), 'A','M/atm','Effective Henrys Law coeff.') - !call add_default('DTWR_'//trim(gas_wetdep_list(m)), 2, ' ') - !call add_default('WD_'//trim(gas_wetdep_list(m)), 2, ' ') - !call add_default('HEFF_'//trim(gas_wetdep_list(m)), 2, ' ') - if (history_chemistry) then - call add_default('DTWR_'//trim(gas_wetdep_list(m)), 1, ' ') - call add_default('WD_'//trim(gas_wetdep_list(m)), 1, ' ') - end if - end do -! - if ( do_diag ) then - call addfld ('QT_RAIN_HNO3',(/ 'lev' /), 'A','mol/mol/s','wet removal Neu scheme rain tendency') - call addfld ('QT_RIME_HNO3',(/ 'lev' /), 'A','mol/mol/s','wet removal Neu scheme rain tendency') - call addfld ('QT_WASH_HNO3',(/ 'lev' /), 'A','mol/mol/s','wet removal Neu scheme rain tendency') - call addfld ('QT_EVAP_HNO3',(/ 'lev' /), 'A','mol/mol/s','wet removal Neu scheme rain tendency') - if (history_chemistry) then - call add_default('QT_RAIN_HNO3',1,' ') - call add_default('QT_RIME_HNO3',1,' ') - call add_default('QT_WASH_HNO3',1,' ') - call add_default('QT_EVAP_HNO3',1,' ') - end if - end if -! - return -! -end subroutine neu_wetdep_init -! -subroutine neu_wetdep_tend(lchnk,ncol,mmr,pmid,pdel,zint,tfld,delt, & - prain, nevapr, cld, cmfdqr, wd_tend, wd_tend_int) -! - use ppgrid, only : pcols, pver - use phys_grid, only : get_area_all_p, get_rlat_all_p - use shr_const_mod, only : SHR_CONST_REARTH,SHR_CONST_G - use shr_const_mod, only : pi => shr_const_pi - use cam_history, only : outfld -! - implicit none -! - integer, intent(in) :: lchnk,ncol - real(r8), intent(in) :: mmr(pcols,pver,pcnst) ! mass mixing ratio (kg/kg) - real(r8), intent(in) :: pmid(pcols,pver) ! midpoint pressures (Pa) - real(r8), intent(in) :: pdel(pcols,pver) ! pressure delta about midpoints (Pa) - real(r8), intent(in) :: zint(pcols,pver+1) ! interface geopotential height above the surface (m) - real(r8), intent(in) :: tfld(pcols,pver) ! midpoint temperature (K) - real(r8), intent(in) :: delt ! timestep (s) -! - real(r8), intent(in) :: prain(ncol, pver) - real(r8), intent(in) :: nevapr(ncol, pver) - real(r8), intent(in) :: cld(ncol, pver) - real(r8), intent(in) :: cmfdqr(ncol, pver) - real(r8), intent(inout) :: wd_tend(pcols,pver,pcnst) - real(r8), intent(inout) :: wd_tend_int(pcols,pcnst) -! -! local arrays and variables -! - integer :: i,k,l,kk,m - real(r8), parameter :: rearth = SHR_CONST_REARTH ! radius earth (m) - real(r8), parameter :: gravit = SHR_CONST_G ! m/s^2 - real(r8), dimension(ncol) :: area, wk_out - real(r8), dimension(ncol,pver) :: cldice,cldliq,cldfrc,totprec,totevap,delz,delp,p - real(r8), dimension(ncol,pver) :: rls,evaprate,mass_in_layer,temp - real(r8), dimension(ncol,pver,gas_wetdep_cnt) :: trc_mass,heff,dtwr - real(r8), dimension(ncol,pver,gas_wetdep_cnt) :: wd_mmr - logical , dimension(gas_wetdep_cnt) :: tckaqb - integer , dimension(ncol) :: test_flag -! -! arrays for HNO3 diagnostics -! - real(r8), dimension(ncol,pver) :: qt_rain,qt_rime,qt_wash,qt_evap -! -! for Henry's law calculations -! - real(r8), parameter :: t0 = 298._r8 - real(r8), parameter :: ph = 1.e-5_r8 - real(r8), parameter :: ph_inv = 1._r8/ph - real(r8) :: e298, dhr - real(r8), dimension(ncol) :: dk1s,dk2s,wrk - real(r8) :: lats(pcols) - - real(r8), parameter :: rad2deg = 180._r8/pi - -! -! from cam/src/physics/cam/stratiform.F90 -! - - if (.not.do_neu_wetdep) return -! -! don't do anything if there are no species to be removed -! - if ( gas_wetdep_cnt == 0 ) return -! -! reset output variables -! - wd_tend_int = 0._r8 -! -! get area (in radians square) -! - call get_area_all_p(lchnk, ncol, area) - area = area * rearth**2 ! in m^2 -! -! reverse order along the vertical before calling -! J. Neu's wet removal subroutine -! - do k=1,pver - kk = pver - k + 1 - do i=1,ncol -! - mass_in_layer(i,k) = area(i) * pdel(i,kk)/gravit ! kg -! - cldice (i,k) = mmr(i,kk,index_cldice) ! kg/kg - cldliq (i,k) = mmr(i,kk,index_cldliq) ! kg/kg - cldfrc (i,k) = cld(i,kk) ! unitless -! - totprec(i,k) = (prain(i,kk)+cmfdqr(i,kk)) & - * mass_in_layer(i,k) ! kg/s - totevap(i,k) = nevapr(i,kk) * mass_in_layer(i,k) ! kg/s -! - delz(i,k) = zint(i,kk) - zint(i,kk+1) ! in m -! - temp(i,k) = tfld(i,kk) -! -! convert tracer mass to kg to kg/kg -! - trc_mass(i,k,:) = mmr(i,kk,mapping_to_mmr(:)) * mass_in_layer(i,k) -! - delp(i,k) = pdel(i,kk) * 0.01_r8 ! in hPa - p (i,k) = pmid(i,kk) * 0.01_r8 ! in hPa -! - end do - end do -! -! define array for tendency calculation (on model grid) -! - dtwr(1:ncol,:,:) = mmr(1:ncol,:,mapping_to_mmr(:)) -! -! compute 1) integrated precipitation flux across the interfaces (rls) -! 2) evaporation rate -! - rls (:,pver) = 0._r8 - evaprate (:,pver) = 0._r8 - do k=pver-1,1,-1 - rls (:,k) = max(0._r8,totprec(:,k)-totevap(:,k)+rls(:,k+1)) - !evaprate(:,k) = min(1._r8,totevap(:,k)/(rls(:,k+1)+totprec(:,k)+1.e-36_r8)) - evaprate(:,k) = min(1._r8,totevap(:,k)/(rls(:,k+1)+1.e-36_r8)) - end do -! -! compute effective Henry's law coefficients -! - heff = 0._r8 - do k=1,pver -! - kk = pver - k + 1 -! - wrk(:) = (t0-tfld(1:ncol,kk))/(t0*tfld(1:ncol,kk)) -! - do m=1,gas_wetdep_cnt -! - l = mapping_to_heff(m) - e298 = dheff(1,l) - dhr = dheff(2,l) - heff(:,k,m) = e298*exp( dhr*wrk(:) ) - test_flag = -99 - if( dheff(3,l) /= 0._r8 .and. dheff(5,l) == 0._r8 ) then - e298 = dheff(3,l) - dhr = dheff(4,l) - dk1s(:) = e298*exp( dhr*wrk(:) ) - where( heff(:,k,m) /= 0._r8 ) - heff(:,k,m) = heff(:,k,m)*(1._r8 + dk1s(:)*ph_inv) - elsewhere - test_flag = 1 - heff(:,k,m) = dk1s(:)*ph_inv - endwhere - end if -! - if (k.eq.1 .and. maxval(test_flag) > 0 .and. debug .and. masterproc) print '(a,i4)','neu_wetdep_tend: heff for m=',m -! - if( dheff(5,l) /= 0._r8 ) then - if( nh3_ndx > 0 .or. co2_ndx > 0 ) then - e298 = dheff(3,l) - dhr = dheff(4,l) - dk1s(:) = e298*exp( dhr*wrk(:) ) - e298 = dheff(5,l) - dhr = dheff(6,l) - dk2s(:) = e298*exp( dhr*wrk(:) ) - if( m == co2_ndx ) then - heff(:,k,m) = heff(:,k,m)*(1._r8 + dk1s(:)*ph_inv)*(1._r8 + dk2s(:)*ph_inv) - else if( m == nh3_ndx ) then - heff(:,k,m) = heff(:,k,m)*(1._r8 + dk1s(:)*ph/dk2s(:)) - else - write(iulog,*) 'error in assigning henrys law coefficients' - write(iulog,*) 'species ',m - end if - end if - end if -! - end do - end do -! - if ( debug .and. masterproc ) then - print '(a)','neu_wetdep_tend: ' - do m=1,gas_wetdep_cnt - print '(a,a)','wetdep species name: ',trim(gas_wetdep_list(m)) - l = mapping_to_heff(m) - print '(a,50e12.4)','dheff(1,l): ', dheff(1,l) - print '(a,50e12.4)','dheff(1,l): ', dheff(2,l) - print '(a,50e12.4)','dheff(1,l): ', dheff(3,l) - print '(a,50e12.4)','dheff(1,l): ', dheff(4,l) - print '(a,50e12.4)','dheff(1,l): ', dheff(5,l) - print '(a,50e12.4)','dheff(1,l): ', dheff(6,l) - print '(a,50f8.2)','tckaqb ',tckaqb(m) - print '(a,50e12.4)','heff ',heff(1,1,m) - print '(a,50i4)' ,'ice_uptake ',ice_uptake(m) - print '(a,50f8.2)','mol_weight ',mol_weight(m) - print '(a,50f8.2)','temp ',temp(1,m) - print '(a,50f8.2)','p ',p (1,m) - enddo - end if -! -! call J. Neu's subroutine -! - do i=1,ncol -! - call washo(pver,gas_wetdep_cnt,delt,trc_mass(i,:,:),mass_in_layer(i,:),p(i,:),delz(i,:) & - ,rls(i,:),cldliq(i,:),cldice(i,:),cldfrc(i,:),temp(i,:),evaprate(i,:) & - ,area(i),heff(i,:,:),mol_weight(:),tckaqb(:),ice_uptake(:) & - ,qt_rain(i,:),qt_rime(i,:),qt_wash(i,:),qt_evap(i,:) ) -! - end do -! -! compute tendencies and convert back to mmr -! on original vertical grid -! - do k=1,pver - kk = pver - k + 1 - do i=1,ncol -! -! convert tracer mass from kg -! - wd_mmr(i,kk,:) = trc_mass(i,k,:) / mass_in_layer(i,k) -! - end do - end do -! -! tendency calculation (on model grid) -! - dtwr(1:ncol,:,:) = wd_mmr(1:ncol,:,:) - dtwr(1:ncol,:,:) - dtwr(1:ncol,:,:) = dtwr(1:ncol,:,:) / delt - -! polarward of 60S, 60N and <200hPa set to zero! - call get_rlat_all_p(lchnk, pcols, lats ) - do k = 1, pver - do i= 1, ncol - if ( abs( lats(i)*rad2deg ) > 60._r8 ) then - if ( pmid(i,k) < 20000._r8) then - dtwr(i,k,:) = 0._r8 - endif - endif - end do - end do -! -! output tendencies -! - do m=1,gas_wetdep_cnt - wd_tend(1:ncol,:,mapping_to_mmr(m)) = wd_tend(1:ncol,:,mapping_to_mmr(m)) + dtwr(1:ncol,:,m) - call outfld( 'DTWR_'//trim(gas_wetdep_list(m)),dtwr(:,:,m),ncol,lchnk ) - - call outfld( 'HEFF_'//trim(gas_wetdep_list(m)),heff(:,pver:1:-1,m),ncol,lchnk ) -! -! vertical integrated wet deposition rate [kg/m2/s] -! - wk_out = 0._r8 - do k=1,pver - kk = pver - k + 1 - wk_out(1:ncol) = wk_out(1:ncol) + (dtwr(1:ncol,k,m) * mass_in_layer(1:ncol,kk)/area(1:ncol)) - end do - call outfld( 'WD_'//trim(gas_wetdep_list(m)),wk_out,ncol,lchnk ) -! -! to be used in mo_chm_diags to compute wet_deposition_NOy_as_N and wet_deposition_NHx_as_N (units: kg/m2/s) -! - if ( debug .and. masterproc ) print *,'neu_wetdep_tend: ',mapping_to_mmr(m),(wk_out(1:ncol)) - wd_tend_int(1:ncol,mapping_to_mmr(m)) = wk_out(1:ncol) -! - end do -! - if ( do_diag ) then - call outfld('QT_RAIN_HNO3', qt_rain, ncol, lchnk ) - call outfld('QT_RIME_HNO3', qt_rime, ncol, lchnk ) - call outfld('QT_WASH_HNO3', qt_wash, ncol, lchnk ) - call outfld('QT_EVAP_HNO3', qt_evap, ncol, lchnk ) - end if -! - return -end subroutine neu_wetdep_tend - -!----------------------------------------------------------------------- -! -! Original code from Jessica Neu -! Updated by S. Walters and J.-F. Lamarque (March-April 2011) -! -!----------------------------------------------------------------------- - - subroutine WASHO(LPAR,NTRACE,DTSCAV,QTTJFL,QM,POFL,DELZ, & - RLS,CLWC,CIWC,CFR,TEM,EVAPRATE,GAREA,HSTAR,TCMASS,TCKAQB, & - TCNION, qt_rain, qt_rime, qt_wash, qt_evap) -! - implicit none - -!----------------------------------------------------------------------- -!---p-conde 5.4 (2007) -----called from main----- -!---called from pmain to calculate rainout and washout of tracers -!---revised by JNEU 8/2007 -!--- -!-LAER has been removed - no scavenging for aerosols -!-LAER could be used as LWASHTYP -!---WILL THIS WORK FOR T42->T21??????????? -!----------------------------------------------------------------------- - - integer LPAR, NTRACE - real(r8), intent(inout) :: QTTJFL(LPAR,NTRACE) - real(r8), intent(in) :: DTSCAV, QM(LPAR),POFL(LPAR),DELZ(LPAR),GAREA - real(r8), intent(in) :: RLS(LPAR),CLWC(LPAR),CIWC(LPAR),CFR(LPAR),TEM(LPAR), & - EVAPRATE(LPAR) - real(r8), intent(in) :: HSTAR(LPAR,NTRACE),TCMASS(NTRACE) - logical , intent(in) :: TCKAQB(NTRACE),TCNION(NTRACE) -! - real(r8), intent(inout) :: qt_rain(lpar) - real(r8), intent(inout) :: qt_rime(lpar) - real(r8), intent(inout) :: qt_wash(lpar) - real(r8), intent(inout) :: qt_evap(lpar) -! - integer I,J,L,N,LE, LM1 - real(r8), dimension(LPAR) :: CFXX - real(r8), dimension(LPAR) :: QTT, QTTNEW - - real(r8) WRK, RNEW_TST - real(r8) CLWX - real(r8) RNEW,RPRECIP,DELTARIMEMASS,DELTARIME,RAMPCT - real(r8) MASSLOSS - real(r8) DOR,DNEW,DEMP,COLEFFSNOW,RHOSNOW - real(r8) WEMP,REMP,RRAIN,RWASH - real(r8) QTPRECIP,QTRAIN,QTCXA,QTAX,QTOC - - real(r8) FAMA,RAMA,DAMA,FCA,RCA,DCA - real(r8) FAX,RAX,DAX,FCXA,RCXA,DCXA,FCXB,RCXB,DCXB - real(r8) RAXADJ,FAXADJ,RAXADJF - real(r8) QTDISCF,QTDISRIME,QTDISCXA - real(r8) QTEVAPAXP,QTEVAPAXW,QTEVAPAX - real(r8) QTWASHAX - real(r8) QTEVAPCXAP,QTEVAPCXAW,QTEVAPCXA - real(r8) QTWASHCXA,QTRIMECXA - real(r8) QTRAINCXA,QTRAINCXB - real(r8) QTTOPCA,QTTOPAA,QTTOPCAX,QTTOPAAX - - real(r8) AMPCT,AMCLPCT,CLNEWPCT,CLNEWAMPCT,CLOLDPCT,CLOLDAMPCT - real(r8) RAXLOC,RCXALOC,RCXBLOC,RCALOC,RAMALOC,RCXPCT - - real(r8) QTNETLCXA,QTNETLCXB,QTNETLAX,QTNETL - real(r8) QTDISSTAR - - - real(r8), parameter :: CFMIN=0.1_r8 - real(r8), parameter :: CWMIN=1.0e-5_r8 - real(r8), parameter :: DMIN=1.0e-1_r8 !mm - real(r8), parameter :: VOLPOW=1._r8/3._r8 - real(r8), parameter :: RHORAIN=1.0e3_r8 !kg/m3 - real(r8), parameter :: RHOSNOWFIX=1.0e2_r8 !kg/m3 - real(r8), parameter :: COLEFFRAIN=0.7_r8 - real(r8), parameter :: TMIX=258._r8 - real(r8), parameter :: TFROZ=240._r8 - real(r8), parameter :: COLEFFAER=0.05_r8 -! -! additional work arrays and diagnostics -! - real(r8) :: rls_wrk(lpar) - real(r8) :: rnew_wrk(lpar) - real(r8) :: rca_wrk(lpar) - real(r8) :: fca_wrk(lpar) - real(r8) :: rcxa_wrk(lpar) - real(r8) :: fcxa_wrk(lpar) - real(r8) :: rcxb_wrk(lpar) - real(r8) :: fcxb_wrk(lpar) - real(r8) :: rax_wrk(lpar,2) - real(r8) :: fax_wrk(lpar,2) - real(r8) :: rama_wrk(lpar) - real(r8) :: fama_wrk(lpar) - real(r8) :: deltarime_wrk(lpar) - real(r8) :: clwx_wrk(lpar) - real(r8) :: frc(lpar,3) - real(r8) :: rlsog(lpar) -! - logical :: is_hno3 - logical :: rls_flag(lpar) - logical :: rnew_flag(lpar) - logical :: cf_trigger(lpar) - logical :: freezing(lpar) -! - real(r8), parameter :: four = 4._r8 - real(r8), parameter :: adj_factor = one + 10._r8*epsilon( one ) -! - integer :: LWASHTYP,LICETYP -! - if ( debug .and. masterproc ) then - print '(a,50f8.2)','tckaqb ',tckaqb - print '(a,50e12.4)','hstar ',hstar(1,:) - print '(a,50i4)' ,'ice_uptake ',TCNION - print '(a,50f8.2)','mol_weight ',TCMASS(:) - print '(a,50f8.2)','temp ',tem(:) - print '(a,50f8.2)','p ',pofl(:) - end if - -!----------------------------------------------------------------------- - LE = LPAR-1 -! - rls_flag(1:le) = rls(1:le) > zero - freezing(1:le) = tem(1:le) < tice - rlsog(1:le) = rls(1:le)/garea -! -species_loop : & - do N = 1,NTRACE - QTT(:lpar) = QTTJFL(:lpar,N) - QTTNEW(:lpar) = QTTJFL(:lpar,N) - is_hno3 = n == hno3_ndx - if( is_hno3 ) then - qt_rain(:lpar) = zero - qt_rime(:lpar) = zero - qt_wash(:lpar) = zero - qt_evap(:lpar) = zero - rca_wrk(:lpar) = zero - fca_wrk(:lpar) = zero - rcxa_wrk(:lpar) = zero - fcxa_wrk(:lpar) = zero - rcxb_wrk(:lpar) = zero - fcxb_wrk(:lpar) = zero - rls_wrk(:lpar) = zero - rnew_wrk(:lpar) = zero - cf_trigger(:lpar) = .false. - clwx_wrk(:lpar) = -9999._r8 - deltarime_wrk(:lpar) = -9999._r8 - rax_wrk(:lpar,:) = zero - fax_wrk(:lpar,:) = zero - endif - -!----------------------------------------------------------------------- -! check whether soluble in ice -!----------------------------------------------------------------------- - if( TCNION(N) ) then - LICETYP = 1 - else - LICETYP = 2 - end if - -!----------------------------------------------------------------------- -! initialization -!----------------------------------------------------------------------- - QTTOPAA = zero - QTTOPCA = zero - - RCA = zero - FCA = zero - DCA = zero - RAMA = zero - FAMA = zero - DAMA = zero - - AMPCT = zero - AMCLPCT = zero - CLNEWPCT = zero - CLNEWAMPCT = zero - CLOLDPCT = zero - CLOLDAMPCT = zero - - -!----------------------------------------------------------------------- -! Check whether precip in top layer - if so, require CF ge 0.2 -!----------------------------------------------------------------------- - if( RLS(LE) > zero ) then - CFXX(LE) = max( CFMIN,CFR(LE) ) - else - CFXX(LE) = CFR(LE) - endif - - rnew_flag(1:le) = .false. - -level_loop : & - do L = LE,1,-1 - LM1 = L - 1 - FAX = zero - RAX = zero - DAX = zero - FCXA = zero - FCXB = zero - DCXA = zero - DCXB = zero - RCXA = zero - RCXB = zero - - QTDISCF = zero - QTDISRIME = zero - QTDISCXA = zero - - QTEVAPAXP = zero - QTEVAPAXW = zero - QTEVAPAX = zero - QTWASHAX = zero - - QTEVAPCXAP = zero - QTEVAPCXAW = zero - QTEVAPCXA = zero - QTRIMECXA = zero - QTWASHCXA = zero - QTRAINCXA = zero - QTRAINCXB = zero - - RAMPCT = zero - RCXPCT = zero - - RCXALOC = zero - RCXBLOC = zero - RAXLOC = zero - RAMALOC = zero - RCALOC = zero - - RPRECIP = zero - DELTARIMEMASS = zero - DELTARIME = zero - DOR = zero - DNEW = zero - - QTTOPAAX = zero - QTTOPCAX = zero - -has_rls : & - if( rls_flag(l) ) then -!----------------------------------------------------------------------- -!-----Evaporate ambient precip and decrease area------------------------- -!-----If ice, diam=diam falling from above If rain, diam=4mm (not used) -!-----Evaporate tracer contained in evaporated precip -!-----Can't evaporate more than we start with----------------------------- -!-----Don't do washout until we adjust ambient precip to match Rbot if needed -!------(after RNEW if statements) -!----------------------------------------------------------------------- - FAX = max( zero,FAMA*(one - evaprate(l)) ) - RAX = RAMA !kg/m2/s - if ( debug .and. masterproc ) then - if( (l == 3 .or. l == 2) ) then - write(*,*) 'washout: l,rls,fax = ',l,rls(l),fax - endif - endif - if( FAMA > zero ) then - if( freezing(l) ) then - DAX = DAMA !mm - else - DAX = four !mm - not necessary - endif - else - DAX = zero - endif - - if( RAMA > zero ) then - QTEVAPAXP = min( QTTOPAA,EVAPRATE(L)*QTTOPAA ) - else - QTEVAPAXP = zero - endif - if( is_hno3 ) then - rax_wrk(l,1) = rax - fax_wrk(l,1) = fax - endif - - -!----------------------------------------------------------------------- -! Determine how much the in-cloud precip rate has increased------ -!----------------------------------------------------------------------- - WRK = RAX*FAX + RCA*FCA - if( WRK > 0._r8 ) then - RNEW_TST = RLS(L)/(GAREA * WRK) - else - RNEW_TST = 10._r8 - endif - RNEW = RLSOG(L) - (RAX*FAX + RCA*FCA) !GBA*CF - rnew_wrk(l) = rnew_tst - if ( debug .and. masterproc ) then - if( is_hno3 .and. l == kdiag-1 ) then - write(*,*) ' ' - write(*,*) 'washout: rls,rax,fax,rca,fca' - write(*,'(1p,5g15.7)') rls(l),rax,fax,rca,fca - write(*,*) ' ' - endif - endif -!----------------------------------------------------------------------- -! if RNEW>0, there is growth and/or new precip formation -!----------------------------------------------------------------------- -has_rnew: if( rlsog(l) > adj_factor*(rax*fax + rca*fca) ) then -!----------------------------------------------------------------------- -! Min cloudwater requirement for cloud with new precip -! Min CF is set at top for LE, at end for other levels -! CWMIN is only needed for new precip formation - do not need for RNEW<0 -!----------------------------------------------------------------------- - if( cfxx(l) == zero ) then - if ( do_diag ) then - write(*,*) 'cfxx(l) == zero',l - write(*,*) qttjfl(:,n) - write(*,*) qm(:) - write(*,*) pofl(:) - write(*,*) delz(:) - write(*,*) rls(:) - write(*,*) clwc(:) - write(*,*) ciwc(:) - write(*,*) cfr(:) - write(*,*) tem(:) - write(*,*) evaprate(:) - write(*,*) hstar(:,n) - end if -! -! if we are here,, that means that there is -! a inconsistency and this will lead to a division -! by 0 later on! This column should then be skipped -! - QTTJFL(:lpar,n) = QTT(:lpar) - cycle species_loop -! -! call endrun() -! - endif - rnew_flag(l) = .true. - CLWX = max( CLWC(L)+CIWC(L),CWMIN*CFXX(L) ) - if( is_hno3 ) then - clwx_wrk(l) = clwx - endif -!----------------------------------------------------------------------- -! Area of old cloud and new cloud -!----------------------------------------------------------------------- - FCXA = FCA - FCXB = max( zero,CFXX(L)-FCXA ) -!----------------------------------------------------------------------- -! ICE -! For ice and mixed phase, grow precip in old cloud by riming -! Use only portion of cloudwater in old cloud fraction -! and rain above old cloud fraction -! COLEFF from Lohmann and Roeckner (1996), Loss rate from Rotstayn (1997) -!----------------------------------------------------------------------- -is_freezing : & - if( freezing(l) ) then - COLEFFSNOW = exp( 2.5e-2_r8*(TEM(L) - TICE) ) - if( TEM(L) <= TFROZ ) then - RHOSNOW = RHOSNOWFIX - else - RHOSNOW = 0.303_r8*(TEM(L) - TFROZ)*RHOSNOWFIX - endif - if( FCXA > zero ) then - if( DCA > zero ) then - DELTARIMEMASS = CLWX*QM(L)*(FCXA/CFXX(L))* & - (one - exp( (-COLEFFSNOW/(DCA*1.e-3_r8))*((RCA)/(2._r8*RHOSNOW))*DTSCAV )) !uses GBA R - else - DELTARIMEMASS = zero - endif - else - DELTARIMEMASS = zero - endif -!----------------------------------------------------------------------- -! Increase in precip rate due to riming (kg/m2/s): -! Limit to total increase in R in cloud -!----------------------------------------------------------------------- - if( FCXA > zero ) then - DELTARIME = min( RNEW/FCXA,DELTARIMEMASS/(FCXA*GAREA*DTSCAV) ) !GBA - else - DELTARIME = zero - endif - if( is_hno3 ) then - deltarime_wrk(l) = deltarime - endif -!----------------------------------------------------------------------- -! Find diameter of rimed precip, must be at least .1mm -!----------------------------------------------------------------------- - if( RCA > zero ) then - DOR = max( DMIN,(((RCA+DELTARIME)/RCA)**VOLPOW)*DCA ) - else - DOR = zero - endif -!----------------------------------------------------------------------- -! If there is some in-cloud precip left, we have new precip formation -! Will be spread over whole cloud fraction -!----------------------------------------------------------------------- -! Calculate precip rate in old and new cloud fractions -!----------------------------------------------------------------------- - RPRECIP = (RNEW-(DELTARIME*FCXA))/CFXX(L) !kg/m2/s !GBA -!----------------------------------------------------------------------- -! Calculate precip rate in old and new cloud fractions -!----------------------------------------------------------------------- - RCXA = RCA + DELTARIME + RPRECIP !kg/m2/s GBA - RCXB = RPRECIP !kg/m2/s GBA - -!----------------------------------------------------------------------- -! Find diameter of new precip from empirical relation using Rprecip -! in given area of box- use density of water, not snow, to convert kg/s -! to mm/s -> as given in Field and Heymsfield -! Also calculate diameter of mixed precip,DCXA, from empirical relation -! using total R in FCXA - this will give larger particles than averaging DOR and -! DNEW in the next level -! DNEW and DCXA must be at least .1mm -!----------------------------------------------------------------------- - if( RPRECIP > zero ) then - WEMP = (CLWX*QM(L))/(GAREA*CFXX(L)*DELZ(L)) !kg/m3 - REMP = RPRECIP/((RHORAIN/1.e3_r8)) !mm/s local - DNEW = DEMPIRICAL( WEMP, REMP ) - if ( debug .and. masterproc ) then - if( is_hno3 .and. l >= 15 ) then - write(*,*) ' ' - write(*,*) 'washout: wemp,remp.dnew @ l = ',l - write(*,'(1p,3g15.7)') wemp,remp,dnew - write(*,*) ' ' - endif - endif - DNEW = max( DMIN,DNEW ) - if( FCXB > zero ) then - DCXB = DNEW - else - DCXB = zero - endif - else - DCXB = zero - endif - - if( FCXA > zero ) then - WEMP = (CLWX*QM(L)*(FCXA/CFXX(L)))/(GAREA*FCXA*DELZ(L)) !kg/m3 - REMP = RCXA/((RHORAIN/1.e3_r8)) !mm/s local - DEMP = DEMPIRICAL( WEMP, REMP ) - DCXA = ((RCA+DELTARIME)/RCXA)*DOR + (RPRECIP/RCXA)*DNEW - DCXA = max( DEMP,DCXA ) - DCXA = max( DMIN,DCXA ) - else - WEMP = zero - REMP = zero - DEMP = zero - DCXA = zero - endif - if ( debug .and. masterproc ) then - if( is_hno3 .and. l >= 15 ) then - write(*,*) ' ' - write(*,*) 'washout: rca,rcxa,deltarime,dor,rprecip,dnew @ l = ',l - write(*,'(1p,6g15.7)') rca,rcxa,deltarime,dor,rprecip,dnew - write(*,*) 'washout: dcxa,dcxb,wemp,remp,demp' - write(*,'(1p,5g15.7)') dcxa,dcxb,wemp,remp,demp - write(*,*) ' ' - end if - endif - - if( QTT(L) > zero ) then -!----------------------------------------------------------------------- -! ICE SCAVENGING -!----------------------------------------------------------------------- -! For ice, rainout only hno3/aerosols using new precip -! Tracer dissolved given by Kaercher and Voigt (2006) for T<258K -! For T>258K, use Henry's Law with Retention coefficient -! Rain out in whole CF -!----------------------------------------------------------------------- - if( RPRECIP > zero ) then - if( LICETYP == 1 ) then - RRAIN = RPRECIP*GAREA !kg/s local - call DISGAS( CLWX, CFXX(L), TCMASS(N), HSTAR(L,N), & - TEM(L),POFL(L),QM(L), & - QTT(L)*CFXX(L),QTDISCF ) - call RAINGAS( RRAIN, DTSCAV, CLWX, CFXX(L), & - QM(L), QTT(L), QTDISCF, QTRAIN ) - WRK = QTRAIN/CFXX(L) - QTRAINCXA = FCXA*WRK - QTRAINCXB = FCXB*WRK - elseif( LICETYP == 2 ) then - QTRAINCXA = zero - QTRAINCXB = zero - endif - if( debug .and. masterproc .and. is_hno3 .and. l == kdiag ) then - write(*,*) ' ' - write(*,*) 'washout: Ice Scavenging' - write(*,*) 'washout: qtraincxa, qtraincxb, fcxa, fcxb, qt_rain, cfxx(l), wrk @ level = ',l - write(*,'(1p,7g15.7)') qtraincxa, qtraincxb, fcxa, fcxb, qt_rain(l), cfxx(l), wrk - write(*,*) ' ' - endif - endif -!----------------------------------------------------------------------- -! For ice, accretion removal for hno3 and aerosols is propotional to riming, -! no accretion removal for gases -! remove only in mixed portion of cloud -! Limit DELTARIMEMASS to RNEW*DTSCAV for ice - evaporation of rimed ice to match -! RNEW precip rate would result in HNO3 escaping from ice (no trapping) -!----------------------------------------------------------------------- - if( DELTARIME > zero ) then - if( LICETYP == 1 ) then - if( TEM(L) <= TFROZ ) then - RHOSNOW = RHOSNOWFIX - else - RHOSNOW = 0.303_r8*(TEM(L) - TFROZ)*RHOSNOWFIX - endif - QTCXA = QTT(L)*FCXA - call DISGAS( CLWX*(FCXA/CFXX(L)), FCXA, TCMASS(N), & - HSTAR(L,N), TEM(L), POFL(L), & - QM(L), QTCXA, QTDISRIME ) - QTDISSTAR = (QTDISRIME*QTCXA)/(QTDISRIME + QTCXA) - if ( debug .and. masterproc ) then - if( is_hno3 .and. l >= 15 ) then - write(*,*) ' ' - write(*,*) 'washout: fcxa,dca,rca,qtdisstar @ l = ',l - write(*,'(1p,4g15.7)') fcxa,dca,rca,qtdisstar - write(*,*) ' ' - endif - endif - QTRIMECXA = QTCXA* & - (one - exp((-COLEFFSNOW/(DCA*1.e-3_r8))* & - (RCA/(2._r8*RHOSNOW))* & !uses GBA R - (QTDISSTAR/QTCXA)*DTSCAV)) - QTRIMECXA = min( QTRIMECXA, & - ((RNEW*GAREA*DTSCAV)/(CLWX*QM(L)*(FCXA/CFXX(L))))*QTDISSTAR) - elseif( LICETYP == 2 ) then - QTRIMECXA = zero - endif - endif - else - QTRAINCXA = zero - QTRAINCXB = zero - QTRIMECXA = zero - endif -!----------------------------------------------------------------------- -! For ice, no washout in interstitial cloud air -!----------------------------------------------------------------------- - QTWASHCXA = zero - QTEVAPCXA = zero - -!----------------------------------------------------------------------- -! RAIN -! For rain, accretion increases rain rate but diameter remains constant -! Diameter is 4mm (not used) -!----------------------------------------------------------------------- - else is_freezing - if( FCXA > zero ) then - DELTARIMEMASS = (CLWX*QM(L))*(FCXA/CFXX(L))* & - (one - exp( -0.24_r8*COLEFFRAIN*((RCA)**0.75_r8)*DTSCAV )) !local - else - DELTARIMEMASS = zero - endif -!----------------------------------------------------------------------- -! Increase in precip rate due to riming (kg/m2/s): -! Limit to total increase in R in cloud -!----------------------------------------------------------------------- - if( FCXA > zero ) then - DELTARIME = min( RNEW/FCXA,DELTARIMEMASS/(FCXA*GAREA*DTSCAV) ) !GBA - else - DELTARIME = zero - endif -!----------------------------------------------------------------------- -! If there is some in-cloud precip left, we have new precip formation -!----------------------------------------------------------------------- - RPRECIP = (RNEW-(DELTARIME*FCXA))/CFXX(L) !GBA - - RCXA = RCA + DELTARIME + RPRECIP !kg/m2/s GBA - RCXB = RPRECIP !kg/m2/s GBA - DCXA = FOUR - if( FCXB > zero ) then - DCXB = FOUR - else - DCXB = zero - endif -!----------------------------------------------------------------------- -! RAIN SCAVENGING -! For rain, rainout both hno3/aerosols and gases using new precip -!----------------------------------------------------------------------- - if( QTT(L) > zero ) then - if( RPRECIP > zero ) then - RRAIN = (RPRECIP*GAREA) !kg/s local - call DISGAS( CLWX, CFXX(L), TCMASS(N), HSTAR(L,N), & - TEM(L), POFL(L), QM(L), & - QTT(L)*CFXX(L), QTDISCF ) - call RAINGAS( RRAIN, DTSCAV, CLWX, CFXX(L), & - QM(L), QTT(L), QTDISCF, QTRAIN ) - WRK = QTRAIN/CFXX(L) - QTRAINCXA = FCXA*WRK - QTRAINCXB = FCXB*WRK - if( debug .and. masterproc .and. is_hno3 .and. l == kdiag ) then - write(*,*) ' ' - write(*,*) 'washout: Rain Scavenging' - write(*,*) 'washout: qtraincxa, qtraincxb, fcxa, fcxb, qt_rain, cfxx(l), wrk @ level = ',l - write(*,'(1p,7g15.7)') qtraincxa, qtraincxb, fcxa, fcxb, qt_rain(l), cfxx(l), wrk - write(*,*) ' ' - endif - endif -!----------------------------------------------------------------------- -! For rain, accretion removal is propotional to riming -! caclulate for hno3/aerosols and gases -! Remove only in mixed portion of cloud -! Limit DELTARIMEMASS to RNEW*DTSCAV -!----------------------------------------------------------------------- - if( DELTARIME > zero ) then - QTCXA = QTT(L)*FCXA - call DISGAS( CLWX*(FCXA/CFXX(L)), FCXA, TCMASS(N), & - HSTAR(L,N), TEM(L), POFL(L), & - QM(L), QTCXA, QTDISRIME ) - QTDISSTAR = (QTDISRIME*QTCXA)/(QTDISRIME + QTCXA) - QTRIMECXA = QTCXA* & - (one - exp(-0.24_r8*COLEFFRAIN* & - ((RCA)**0.75_r8)* & !local - (QTDISSTAR/QTCXA)*DTSCAV)) - QTRIMECXA = min( QTRIMECXA, & - ((RNEW*GAREA*DTSCAV)/(CLWX*QM(L)*(FCXA/CFXX(L))))*QTDISSTAR) - else - QTRIMECXA = zero - endif - else - QTRAINCXA = zero - QTRAINCXB = zero - QTRIMECXA = zero - endif -!----------------------------------------------------------------------- -! For rain, washout gases and HNO3/aerosols using rain from above old cloud -! Washout for HNO3/aerosols is only on non-dissolved portion, impaction-style -! Washout for gases is on non-dissolved portion, limited by QTTOP+QTRIME -!----------------------------------------------------------------------- - if( RCA > zero ) then - QTPRECIP = FCXA*QTT(L) - QTDISRIME - if( HSTAR(L,N) > 1.e4_r8 ) then - if( QTPRECIP > zero ) then - QTWASHCXA = QTPRECIP*(one - exp( -0.24_r8*COLEFFAER*((RCA)**0.75_r8)*DTSCAV )) !local - else - QTWASHCXA = zero - endif - QTEVAPCXA = zero - else - RWASH = RCA*GAREA !kg/s local - if( QTPRECIP > zero ) then - call WASHGAS( RWASH, FCA, DTSCAV, QTTOPCA+QTRIMECXA, & - HSTAR(L,N), TEM(L), POFL(L), & - QM(L), QTPRECIP, QTWASHCXA, QTEVAPCXA ) - else - QTWASHCXA = zero - QTEVAPCXA = zero - endif - endif - endif - endif is_freezing -!----------------------------------------------------------------------- -! If RNEW zero ) then - RCXA = min( RCA,RLS(L)/(GAREA*FCXA) ) !kg/m2/s GBA - if( FAX > zero .and. ((RCXA+1.e-12_r8) < RLS(L)/(GAREA*FCXA)) ) then - RAXADJF = RLS(L)/GAREA - RCXA*FCXA - RAMPCT = RAXADJF/(RAX*FAX) - FAXADJ = RAMPCT*FAX - if( FAXADJ > zero ) then - RAXADJ = RAXADJF/FAXADJ - else - RAXADJ = zero - endif - else - RAXADJ = zero - RAMPCT = zero - FAXADJ = zero - endif - else - RCXA = zero - if( FAX > zero ) then - RAXADJF = RLS(L)/GAREA - RAMPCT = RAXADJF/(RAX*FAX) - FAXADJ = RAMPCT*FAX - if( FAXADJ > zero ) then - RAXADJ = RAXADJF/FAXADJ - else - RAXADJ = zero - endif - else - RAXADJ = zero - RAMPCT = zero - FAXADJ = zero - endif - endif - - QTEVAPAXP = min( QTTOPAA,QTTOPAA - (RAMPCT*(QTTOPAA-QTEVAPAXP)) ) - FAX = FAXADJ - RAX = RAXADJ - if ( debug .and. masterproc ) then - if( (l == 3 .or. l == 2) ) then - write(*,*) 'washout: l,fcxa,fax = ',l,fcxa,fax - endif - endif - -!----------------------------------------------------------------------- -! IN-CLOUD EVAPORATION/WASHOUT -! If precip out the bottom of the cloud is 0, evaporate everything -! If there is no cloud, QTTOPCA=0, so nothing happens -!----------------------------------------------------------------------- - if( RCXA <= zero ) then - QTEVAPCXA = QTTOPCA - RCXA = zero - DCXA = zero - else -!----------------------------------------------------------------------- -! If rain out the bottom of the cloud is >0 (but .le. RCA): -! For ice, decrease particle size, -! no washout -! no evap for non-ice gases (b/c there is nothing in ice) -! TTmix, hno3&aerosols are incorporated into ice structure: -! do not release -! For rain, assume full evaporation of some raindrops -! proportional evaporation for all species -! washout for gases using Rbot -! impact washout for hno3/aerosol portion in gas phase -!----------------------------------------------------------------------- -! if (TEM(L) < TICE ) then -is_freezing_a : & - if( freezing(l) ) then - QTWASHCXA = zero - DCXA = ((RCXA/RCA)**VOLPOW)*DCA - if( LICETYP == 1 ) then - if( TEM(L) <= TMIX ) then - MASSLOSS = (RCA-RCXA)*FCXA*GAREA*DTSCAV -!----------------------------------------------------------------------- -! note-QTT doesn't matter b/c T<258K -!----------------------------------------------------------------------- - call DISGAS( (MASSLOSS/QM(L)), FCXA, TCMASS(N), & - HSTAR(L,N), TEM(L), POFL(L), & - QM(L), QTT(L), QTEVAPCXA ) - QTEVAPCXA = min( QTTOPCA,QTEVAPCXA ) - else - QTEVAPCXA = zero - endif - elseif( LICETYP == 2 ) then - QTEVAPCXA = zero - endif - else is_freezing_a - QTEVAPCXAP = (RCA - RCXA)/RCA*QTTOPCA - DCXA = FOUR - QTCXA = FCXA*QTT(L) - if( HSTAR(L,N) > 1.e4_r8 ) then - if( QTT(L) > zero ) then - call DISGAS( CLWX*(FCXA/CFXX(L)), FCXA, TCMASS(N), & - HSTAR(L,N), TEM(L), POFL(L), & - QM(L), QTCXA, QTDISCXA ) - if( QTCXA > QTDISCXA ) then - QTWASHCXA = (QTCXA - QTDISCXA)*(one - exp( -0.24_r8*COLEFFAER*((RCXA)**0.75_r8)*DTSCAV )) !local - else - QTWASHCXA = zero - endif - QTEVAPCXAW = zero - else - QTWASHCXA = zero - QTEVAPCXAW = zero - endif - else - RWASH = RCXA*GAREA !kg/s local - call WASHGAS( RWASH, FCXA, DTSCAV, QTTOPCA, HSTAR(L,N), & - TEM(L), POFL(L), QM(L), & - QTCXA-QTDISCXA, QTWASHCXA, QTEVAPCXAW ) - endif - QTEVAPCXA = QTEVAPCXAP + QTEVAPCXAW - endif is_freezing_a - endif - endif has_rnew - -!----------------------------------------------------------------------- -! AMBIENT WASHOUT -! Ambient precip is finalized - if it is rain, washout -! no ambient washout for ice, since gases are in vapor phase -!----------------------------------------------------------------------- - if( RAX > zero ) then - if( .not. freezing(l) ) then - QTAX = FAX*QTT(L) - if( HSTAR(L,N) > 1.e4_r8 ) then - QTWASHAX = QTAX* & - (one - exp(-0.24_r8*COLEFFAER* & - ((RAX)**0.75_r8)*DTSCAV)) !local - QTEVAPAXW = zero - else - RWASH = RAX*GAREA !kg/s local - call WASHGAS( RWASH, FAX, DTSCAV, QTTOPAA, HSTAR(L,N), & - TEM(L), POFL(L), QM(L), QTAX, & - QTWASHAX, QTEVAPAXW ) - endif - else - QTEVAPAXW = zero - QTWASHAX = zero - endif - else - QTEVAPAXW = zero - QTWASHAX = zero - endif - QTEVAPAX = QTEVAPAXP + QTEVAPAXW - -!----------------------------------------------------------------------- -! END SCAVENGING -! Require CF if our ambient evaporation rate would give less -! precip than R from model. -!----------------------------------------------------------------------- - if( do_diag .and. is_hno3 ) then - rls_wrk(l) = rls(l)/garea - rca_wrk(l) = rca - fca_wrk(l) = fca - rcxa_wrk(l) = rcxa - fcxa_wrk(l) = fcxa - rcxb_wrk(l) = rcxb - fcxb_wrk(l) = fcxb - rax_wrk(l,2) = rax - fax_wrk(l,2) = fax - endif -upper_level : & - if( L > 1 ) then - FAMA = max( FCXA + FCXB + FAX - CFR(LM1),zero ) - if( FAX > zero ) then - RAXLOC = RAX/FAX - else - RAXLOC = zero - endif - if( FCXA > zero ) then - RCXALOC = RCXA/FCXA - else - RCXALOC = zero - endif - if( FCXB > zero ) then - RCXBLOC = RCXB/FCXB - else - RCXBLOC = zero - endif - - if( CFR(LM1) >= CFMIN ) then - CFXX(LM1) = CFR(LM1) - else - if( adj_factor*RLSOG(LM1) >= (RCXA*FCXA + RCXB*FCXB + RAX*FAX)*(one - EVAPRATE(LM1)) ) then - CFXX(LM1) = CFMIN - cf_trigger(lm1) = .true. - else - CFXX(LM1) = CFR(LM1) - endif - if( is_hno3 .and. lm1 == kdiag .and. debug .and. masterproc ) then - write(*,*) ' ' - write(*,*) 'washout: rls,garea,rcxa,fcxa,rcxb,fcxb,rax,fax' - write(*,'(1p,8g15.7)') rls(lm1),garea,rcxa,fcxa,rcxb,fcxb,rax,fax - write(*,*) ' ' - endif - endif -!----------------------------------------------------------------------- -! Figure out what will go into ambient and cloud below -! Don't do for lowest level -!----------------------------------------------------------------------- - if( FAX > zero ) then - RAXLOC = RAX/FAX - AMPCT = max( zero,min( one,(CFXX(L) + FAX - CFXX(LM1))/FAX ) ) - AMCLPCT = one - AMPCT - else - RAXLOC = zero - AMPCT = zero - AMCLPCT = zero - endif - if( FCXB > zero ) then - RCXBLOC = RCXB/FCXB - CLNEWPCT = max( zero,min( (CFXX(LM1) - FCXA)/FCXB,one ) ) - CLNEWAMPCT = one - CLNEWPCT - else - RCXBLOC = zero - CLNEWPCT = zero - CLNEWAMPCT = zero - endif - if( FCXA > zero ) then - RCXALOC = RCXA/FCXA - CLOLDPCT = max( zero,min( CFXX(LM1)/FCXA,one ) ) - CLOLDAMPCT = one - CLOLDPCT - else - RCXALOC = zero - CLOLDPCT = zero - CLOLDAMPCT = zero - endif -!----------------------------------------------------------------------- -! Remix everything for the next level -!----------------------------------------------------------------------- - FCA = min( CFXX(LM1),FCXA*CLOLDPCT + CLNEWPCT*FCXB + AMCLPCT*FAX ) - if( FCA > zero ) then -!----------------------------------------------------------------------- -! Maintain cloud core by reducing NC and AM area going into cloud below -!----------------------------------------------------------------------- - RCA = (RCXA*FCXA*CLOLDPCT + RCXB*FCXB*CLNEWPCT + RAX*FAX*AMCLPCT)/FCA - if ( debug .and. masterproc ) then - if( is_hno3 ) then - write(*,*) ' ' - write(*,*) 'washout: rcxa,fcxa,cloldpctrca,rca,fca,dcxa @ l = ',l - write(*,'(1p,6g15.7)') rcxa,fcxa,cloldpct,rca,fca,dcxa - write(*,*) 'washout: rcxb,fcxb,clnewpct,dcxb' - write(*,'(1p,4g15.7)') rcxb,fcxb,clnewpct,dcxb - write(*,*) 'washout: rax,fax,amclpct,dax' - write(*,'(1p,4g15.7)') rax,fax,amclpct,dax - write(*,*) ' ' - endif - endif - - if (RCA > zero) then - DCA = (RCXA*FCXA*CLOLDPCT)/(RCA*FCA)*DCXA + & - (RCXB*FCXB*CLNEWPCT)/(RCA*FCA)*DCXB + & - (RAX*FAX*AMCLPCT)/(RCA*FCA)*DAX - else - DCA = zero - FCA = zero - endif - - else - FCA = zero - DCA = zero - RCA = zero - endif - - FAMA = FCXA + FCXB + FAX - CFXX(LM1) - if( FAMA > zero ) then - RAMA = (RCXA*FCXA*CLOLDAMPCT + RCXB*FCXB*CLNEWAMPCT + RAX*FAX*AMPCT)/FAMA - if( RAMA > zero ) then - DAMA = (RCXA*FCXA*CLOLDAMPCT)/(RAMA*FAMA)*DCXA + & - (RCXB*FCXB*CLNEWAMPCT)/(RAMA*FAMA)*DCXB + & - (RAX*FAX*AMPCT)/(RAMA*FAMA)*DAX - else - FAMA = zero - DAMA = zero - endif - else - FAMA = zero - DAMA = zero - RAMA = zero - endif - else upper_level - AMPCT = zero - AMCLPCT = zero - CLNEWPCT = zero - CLNEWAMPCT = zero - CLOLDPCT = zero - CLOLDAMPCT = zero - endif upper_level - else has_rls - RNEW = zero - QTEVAPCXA = QTTOPCA - QTEVAPAX = QTTOPAA - if( L > 1 ) then - if( RLS(LM1) > zero ) then - CFXX(LM1) = max( CFMIN,CFR(LM1) ) -! if( CFR(LM1) >= CFMIN ) then -! CFXX(LM1) = CFR(LM1) -! else -! CFXX(LM1) = CFMIN -! endif - else - CFXX(LM1) = CFR(LM1) - endif - endif - AMPCT = zero - AMCLPCT = zero - CLNEWPCT = zero - CLNEWAMPCT = zero - CLOLDPCT = zero - CLOLDAMPCT = zero - RCA = zero - RAMA = zero - FCA = zero - FAMA = zero - DCA = zero - DAMA = zero - endif has_rls - - if( do_diag .and. is_hno3 ) then - fama_wrk(l) = fama - rama_wrk(l) = rama - endif -!----------------------------------------------------------------------- -! Net loss can not exceed QTT in each region -!----------------------------------------------------------------------- - QTNETLCXA = QTRAINCXA + QTRIMECXA + QTWASHCXA - QTEVAPCXA - QTNETLCXA = min( QTT(L)*FCXA,QTNETLCXA ) - - QTNETLCXB =QTRAINCXB - QTNETLCXB = min( QTT(L)*FCXB,QTNETLCXB ) - - QTNETLAX = QTWASHAX - QTEVAPAX - QTNETLAX = min( QTT(L)*FAX,QTNETLAX ) - - QTTNEW(L) = QTT(L) - (QTNETLCXA + QTNETLCXB + QTNETLAX) - - if( do_diag .and. is_hno3 ) then - qt_rain(l) = qtraincxa + qtraincxb - qt_rime(l) = qtrimecxa - qt_wash(l) = qtwashcxa + qtwashax - qt_evap(l) = qtevapcxa + qtevapax - frc(l,1) = qtnetlcxa - frc(l,2) = qtnetlcxb - frc(l,3) = qtnetlax - endif - if( debug .and. masterproc .and. is_hno3 .and. l == kdiag ) then - write(*,*) ' ' - write(*,*) 'washout: qtraincxa, qtraincxb, qtrimecxa @ level = ',l - write(*,'(1p,3g15.7)') qtraincxa, qtraincxb, qtrimecxa - write(*,*) ' ' - endif - if ( debug .and. masterproc ) then - if( (l == 3 .or. l == 2) ) then - write(*,*) 'washout: hno3, hno3, qtnetlca,b, qtnetlax @ level = ',l - write(*,'(1p,5g15.7)') qttnew(l), qtt(l), qtnetlcxa, qtnetlcxb, qtnetlax - write(*,*) 'washout: qtwashax, qtevapax,fax,fama' - write(*,'(1p,5g15.7)') qtwashax, qtevapax, fax, fama - endif - endif - - QTTOPCAX = (QTTOPCA + QTNETLCXA)*CLOLDPCT + QTNETLCXB*CLNEWPCT + (QTTOPAA + QTNETLAX)*AMCLPCT - QTTOPAAX = (QTTOPCA + QTNETLCXA)*CLOLDAMPCT + QTNETLCXB*CLNEWAMPCT + (QTTOPAA + QTNETLAX)*AMPCT - QTTOPCA = QTTOPCAX - QTTOPAA = QTTOPAAX - end do level_loop - - if ( debug .and. masterproc) then - if( is_hno3 ) then - write(*,*) ' ' - write(*,*) 'washout: clwx_wrk' - write(*,'(1p,5g15.7)') clwx_wrk(1:le) - write(*,*) 'washout: cfr' - write(*,'(1p,5g15.7)') cfr(1:le) - write(*,*) 'washout: cfxx' - write(*,'(1p,5g15.7)') cfxx(1:le) - write(*,*) 'washout: cf trigger' - write(*,'(10l4)') cf_trigger(1:le) - write(*,*) 'washout: evaprate' - write(*,'(1p,5g15.7)') evaprate(1:le) - write(*,*) 'washout: rls' - write(*,'(1p,5g15.7)') rls(1:le) - write(*,*) 'washout: rls/garea' - write(*,'(1p,5g15.7)') rls_wrk(1:le) - write(*,*) 'washout: rnew_wrk' - write(*,'(1p,5g15.7)') rnew_wrk(1:le) - write(*,*) 'washout: rnew_flag' - write(*,'(10l4)') rnew_flag(1:le) - write(*,*) 'washout: deltarime_wrk' - write(*,'(1p,5g15.7)') deltarime_wrk(1:le) - write(*,*) 'washout: rama_wrk' - write(*,'(1p,5g15.7)') rama_wrk(1:le) - write(*,*) 'washout: fama_wrk' - write(*,'(1p,5g15.7)') fama_wrk(1:le) - write(*,*) 'washout: rca_wrk' - write(*,'(1p,5g15.7)') rca_wrk(1:le) - write(*,*) 'washout: fca_wrk' - write(*,'(1p,5g15.7)') fca_wrk(1:le) - write(*,*) 'washout: rcxa_wrk' - write(*,'(1p,5g15.7)') rcxa_wrk(1:le) - write(*,*) 'washout: fcxa_wrk' - write(*,'(1p,5g15.7)') fcxa_wrk(1:le) - write(*,*) 'washout: rcxb_wrk' - write(*,'(1p,5g15.7)') rcxb_wrk(1:le) - write(*,*) 'washout: fcxb_wrk' - write(*,'(1p,5g15.7)') fcxb_wrk(1:le) - write(*,*) 'washout: rax1_wrk' - write(*,'(1p,5g15.7)') rax_wrk(1:le,1) - write(*,*) 'washout: fax1_wrk' - write(*,'(1p,5g15.7)') fax_wrk(1:le,1) - write(*,*) 'washout: rax2_wrk' - write(*,'(1p,5g15.7)') rax_wrk(1:le,2) - write(*,*) 'washout: fax2_wrk' - write(*,'(1p,5g15.7)') fax_wrk(1:le,2) - write(*,*) 'washout: rls_flag' - write(*,'(1p,10l4)') rls_flag(1:le) - write(*,*) 'washout: freezing' - write(*,'(1p,10l4)') freezing(1:le) - write(*,*) 'washout: qtnetlcxa' - write(*,'(1p,5g15.7)') frc(1:le,1) - write(*,*) 'washout: qtnetlcxb' - write(*,'(1p,5g15.7)') frc(1:le,2) - write(*,*) 'washout: qtnetlax' - write(*,'(1p,5g15.7)') frc(1:le,3) - write(*,*) ' ' - endif - endif -!----------------------------------------------------------------------- -! reload new tracer mass and rescale moments: check upper limits (LE) -!----------------------------------------------------------------------- - QTTJFL(:le,N) = QTTNEW(:le) - - end do species_loop -! - return - end subroutine washo -!--------------------------------------------------------------------- - subroutine DISGAS (CLWX,CFX,MOLMASS,HSTAR,TM,PR,QM,QT,QTDIS) -!--------------------------------------------------------------------- - implicit none - real(r8), intent(in) :: CLWX,CFX !cloud water,cloud fraction - real(r8), intent(in) :: MOLMASS !molecular mass of tracer - real(r8), intent(in) :: HSTAR !Henry's Law coeffs A*exp(-B/T) - real(r8), intent(in) :: TM !temperature of box (K) - real(r8), intent(in) :: PR !pressure of box (hPa) - real(r8), intent(in) :: QM !air mass in box (kg) - real(r8), intent(in) :: QT !tracer in box (kg) - real(r8), intent(out) :: QTDIS !tracer dissolved in aqueous phase - - real(r8) MUEMP - real(r8), parameter :: INV298 = 1._r8/298._r8 - real(r8), parameter :: TMIX=258._r8 - real(r8), parameter :: RETEFF=0.5_r8 -!---Next calculate rate of uptake of tracer - -!---effective Henry's Law constant: H* = moles-T / liter-precip / press(atm-T) -!---p(atm of tracer-T) = (QT/QM) * (.029/MolWt-T) * pressr(hPa)/1000 -!---limit temperature effects to T above freezing -!----MU from fit to Kaercher and Voigt (2006) - - if(TM .ge. TICE) then - QTDIS=(HSTAR*(QT/(QM*CFX))*0.029_r8*(PR/1.0e3_r8))*(CLWX*QM) - elseif (TM .le. TMIX) then - MUEMP=exp(-14.2252_r8+(1.55704e-1_r8*TM)-(7.1929e-4_r8*(TM**2.0_r8))) - QTDIS=MUEMP*(MOLMASS/18._r8)*(CLWX*QM) - else - QTDIS=RETEFF*((HSTAR*(QT/(QM*CFX))*0.029_r8*(PR/1.0e3_r8))*(CLWX*QM)) - endif - - return - end subroutine DISGAS - -!----------------------------------------------------------------------- - subroutine RAINGAS (RRAIN,DTSCAV,CLWX,CFX,QM,QT,QTDIS,QTRAIN) -!----------------------------------------------------------------------- -!---New trace-gas rainout from large-scale precip with two time scales, -!---one based on precip formation from cloud water and one based on -!---Henry's Law solubility: correct limit for delta-t -!--- -!---NB this code does not consider the aqueous dissociation (eg, C-q) -!--- that makes uptake of HNO3 and H2SO4 so complete. To do so would -!--- require that we keep track of the pH of the falling rain. -!---THUS the Henry's Law coefficient KHA needs to be enhanced to incldue this! -!---ALSO the possible formation of other soluble species from, eg, CH2O, H2O2 -!--- can be considered with enhanced values of KHA. -!--- -!---Does NOT now use RMC (moist conv rain) but could, assuming 30% coverage -!----------------------------------------------------------------------- - implicit none - real(r8), intent(in) :: RRAIN !new rain formation in box (kg/s) - real(r8), intent(in) :: DTSCAV !time step (s) - real(r8), intent(in) :: CLWX,CFX !cloud water and cloud fraction - real(r8), intent(in) :: QM !air mass in box (kg) - real(r8), intent(in) :: QT !tracer in box (kg) - real(r8), intent(in) :: QTDIS !tracer in aqueous phase (kg) - real(r8), intent(out) :: QTRAIN !tracer picked up by new rain - - real(r8) QTLF,QTDISSTAR - - - - - - QTDISSTAR=(QTDIS*(QT*CFX))/(QTDIS+(QT*CFX)) - -!---Tracer Loss frequency (1/s) within cloud fraction: - QTLF = (RRAIN*QTDISSTAR)/(CLWX*QM*QT*CFX) - -!---in time = DTSCAV, the amount of QTT scavenged is calculated -!---from CF*AMOUNT OF UPTAKE - QTRAIN = QT*CFX*(1._r8 - exp(-DTSCAV*QTLF)) - - return - end subroutine RAINGAS - - -!----------------------------------------------------------------------- - subroutine WASHGAS (RWASH,BOXF,DTSCAV,QTRTOP,HSTAR,TM,PR,QM, & - QT,QTWASH,QTEVAP) -!----------------------------------------------------------------------- -!---for most gases below-cloud washout assume Henry-Law equilib with precip -!---assumes that precip is liquid, if frozen, do not call this sub -!---since solubility is moderate, fraction of box with rain does not matter -!---NB this code does not consider the aqueous dissociation (eg, C-q) -!--- that makes uptake of HNO3 and H2SO4 so complete. To do so would -!--- require that we keep track of the pH of the falling rain. -!---THUS the Henry's Law coefficient KHA needs to be enhanced to incldue this! -!---ALSO the possible formation of other soluble species from, eg, CH2O, H2O2 -!--- can be considered with enhanced values of KHA. -!----------------------------------------------------------------------- - implicit none - real(r8), intent(in) :: RWASH ! precip leaving bottom of box (kg/s) - real(r8), intent(in) :: BOXF ! fraction of box with washout - real(r8), intent(in) :: DTSCAV ! time step (s) - real(r8), intent(in) :: QTRTOP ! tracer-T in rain entering top of box -! over time step (kg) - real(r8), intent(in) :: HSTAR ! Henry's Law coeffs A*exp(-B/T) - real(r8), intent(in) :: TM ! temperature of box (K) - real(r8), intent(in) :: PR ! pressure of box (hPa) - real(r8), intent(in) :: QT ! tracer in box (kg) - real(r8), intent(in) :: QM ! air mass in box (kg) - real(r8), intent(out) :: QTWASH ! tracer picked up by precip (kg) - real(r8), intent(out) :: QTEVAP ! tracer evaporated from precip (kg) - - real(r8), parameter :: INV298 = 1._r8/298._r8 - real(r8) :: FWASH, QTMAX, QTDIF - -!---effective Henry's Law constant: H* = moles-T / liter-precip / press(atm-T) -!---p(atm of tracer-T) = (QT/QM) * (.029/MolWt-T) * pressr(hPa)/1000 -!---limit temperature effects to T above freezing - -! -! jfl -! -! added test for BOXF = 0. -! - if ( BOXF == 0._r8 ) then - QTWASH = 0._r8 - QTEVAP = 0._r8 - return - end if - -!---effective washout frequency (1/s): - FWASH = (RWASH*HSTAR*29.e-6_r8*PR)/(QM*BOXF) -!---equilib amount of T (kg) in rain thru bottom of box over time step - QTMAX = QT*FWASH*DTSCAV - if (QTMAX .gt. QTRTOP) then -!---more of tracer T can go into rain - QTDIF = min (QT, QTMAX-QTRTOP) - QTWASH = QTDIF * (1._r8 - exp(-DTSCAV*FWASH)) - QTEVAP=0._r8 - else -!--too much of T in rain, must degas/evap T - QTWASH = 0._r8 - QTEVAP = QTRTOP - QTMAX - endif - - return - end subroutine WASHGAS - -!----------------------------------------------------------------------- - function DEMPIRICAL (CWATER,RRATE) -!----------------------------------------------------------------------- - use shr_spfn_mod, only: shr_spfn_gamma - - implicit none - real(r8), intent(in) :: CWATER - real(r8), intent(in) :: RRATE - - real(r8) :: DEMPIRICAL - - real(r8) RRATEX,WX,THETA,PHI,ETA,BETA,ALPHA,BEE - real(r8) GAMTHETA,GAMBETA - - - - RRATEX=RRATE*3600._r8 !mm/hr - WX=CWATER*1.0e3_r8 !g/m3 - - if(RRATEX .gt. 0.04_r8) then - THETA=exp(-1.43_r8*dlog10(7._r8*RRATEX))+2.8_r8 - else - THETA=5._r8 - endif - PHI=RRATEX/(3600._r8*10._r8) !cgs units - ETA=exp((3.01_r8*THETA)-10.5_r8) - BETA=THETA/(1._r8+0.638_r8) - ALPHA=exp(4._r8*(BETA-3.5_r8)) - BEE=(.638_r8*THETA/(1._r8+.638_r8))-1.0_r8 - GAMTHETA = shr_spfn_gamma(THETA) - GAMBETA = shr_spfn_gamma(BETA+1._r8) - DEMPIRICAL=(((WX*ETA*GAMTHETA)/(1.0e6_r8*ALPHA*PHI*GAMBETA))** & - (-1._r8/BEE))*10._r8 ! in mm (wx/1e6 for cgs) - - - return - end function DEMPIRICAL -! -end module mo_neu_wetdep diff --git a/src/chemistry/mozart/mo_neu_wetdep.F90 b/src/chemistry/mozart/mo_neu_wetdep.F90 index 0b2d3ff35e..ed6a39171b 100644 --- a/src/chemistry/mozart/mo_neu_wetdep.F90 +++ b/src/chemistry/mozart/mo_neu_wetdep.F90 @@ -51,7 +51,7 @@ subroutine neu_wetdep_init ! use constituents, only : cnst_get_ind,cnst_mw use cam_history, only : addfld, add_default, horiz_only - use phys_control, only : phys_getopts + use phys_control, only : phys_getopts, cam_chempkg_is ! integer :: m,l character*20 :: test_name @@ -85,6 +85,9 @@ subroutine neu_wetdep_init ! mapping based on the MOZART4 wet removal subroutine; ! this might need to be redone (JFL: Sep 2010) ! +! Skip mapping if using GEOS-Chem; all GEOS-Chem species are in dep_data_file +! (heff table) specified in namelist drv_flds_in (EWL: Dec 2022) + if ( .not. cam_chempkg_is('geoschem_mam4') ) then select case( trim(test_name) ) ! ! CCMI: added SO2t and NH_50W @@ -108,6 +111,7 @@ subroutine neu_wetdep_init case( 'SOAGbb4' ) test_name = 'SOAGff4' end select + endif ! do l = 1,n_species_table ! From c7d196c3438065e192b2b04aa57ba874eb46ea9d Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Wed, 4 Jan 2023 12:41:49 -0700 Subject: [PATCH 083/291] Use mozart chem_prod_loss_diags.F90 rather than copy if GEOS-Chem enabled Signed-off-by: Lizzie Lundgren --- .../geoschem/chem_prod_loss_diags.F90 | 37 ------------------- 1 file changed, 37 deletions(-) delete mode 100644 src/chemistry/geoschem/chem_prod_loss_diags.F90 diff --git a/src/chemistry/geoschem/chem_prod_loss_diags.F90 b/src/chemistry/geoschem/chem_prod_loss_diags.F90 deleted file mode 100644 index b3eb614cf4..0000000000 --- a/src/chemistry/geoschem/chem_prod_loss_diags.F90 +++ /dev/null @@ -1,37 +0,0 @@ -module chem_prod_loss_diags - use shr_kind_mod, only : r8 => shr_kind_r8 - use chem_mods, only : clscnt1, clscnt4, gas_pcnst, clsmap, permute - use ppgrid, only : pver - use chem_mods, only : rxntot - use cam_history, only : addfld, outfld, add_default - !use mo_tracname, only : solsym - - implicit none - - private - public :: chem_prod_loss_diags_init - public :: chem_prod_loss_diags_out - -contains - - !----------------------------------------------------------------------------- - !----------------------------------------------------------------------------- - subroutine chem_prod_loss_diags_init - - end subroutine chem_prod_loss_diags_init - - !----------------------------------------------------------------------------- - !----------------------------------------------------------------------------- - subroutine chem_prod_loss_diags_out( ncol, lchnk, base_sol, reaction_rates, prod_in, loss_in, xhnm ) - - integer, intent(in) :: ncol, lchnk - real(r8), intent(in) :: base_sol(ncol,pver,gas_pcnst) - real(r8), intent(in) :: reaction_rates(ncol,pver,max(1,rxntot)) - real(r8), intent(in) :: prod_in(ncol,pver,max(1,clscnt4)) - real(r8), intent(in) :: loss_in(ncol,pver,max(1,clscnt4)) - real(r8), intent(in) :: xhnm(ncol,pver) - - end subroutine chem_prod_loss_diags_out - -end module chem_prod_loss_diags - From ae549e22f1e3d2f02d68826221c36a5f9f3b5e2e Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Mon, 9 Jan 2023 12:41:43 -0700 Subject: [PATCH 084/291] Modifications to use Mozart short_lived_species module in GEOS-Chem Signed-off-by: Lizzie Lundgren --- src/chemistry/geoschem/chem_mods.F90 | 6 +- src/chemistry/geoschem/chemistry.F90 | 15 +- .../geoschem/short_lived_species.F90 | 221 ------------------ src/chemistry/mozart/short_lived_species.F90 | 70 +++++- src/chemistry/pp_none/chem_mods.F90 | 1 + src/chemistry/pp_terminator/chem_mods.F90 | 1 + src/chemistry/pp_trop_mam3/chem_mods.F90 | 1 + src/chemistry/pp_trop_mam4/chem_mods.F90 | 1 + src/chemistry/pp_trop_mam5/chem_mods.F90 | 1 + src/chemistry/pp_trop_mam7/chem_mods.F90 | 1 + src/chemistry/pp_trop_mozart/chem_mods.F90 | 1 + .../pp_trop_strat_mam4_ts2/chem_mods.F90 | 1 + .../pp_trop_strat_mam4_vbs/chem_mods.F90 | 1 + .../pp_trop_strat_mam4_vbsext/chem_mods.F90 | 1 + src/chemistry/pp_waccm_ma/chem_mods.F90 | 1 + src/chemistry/pp_waccm_ma_mam4/chem_mods.F90 | 1 + .../pp_waccm_ma_sulfur/chem_mods.F90 | 1 + src/chemistry/pp_waccm_mad/chem_mods.F90 | 1 + src/chemistry/pp_waccm_mad_mam4/chem_mods.F90 | 1 + src/chemistry/pp_waccm_sc/chem_mods.F90 | 1 + src/chemistry/pp_waccm_sc_mam4/chem_mods.F90 | 1 + .../pp_waccm_tsmlt_mam4/chem_mods.F90 | 1 + .../pp_waccm_tsmlt_mam5/chem_mods.F90 | 1 + 23 files changed, 97 insertions(+), 234 deletions(-) delete mode 100644 src/chemistry/geoschem/short_lived_species.F90 diff --git a/src/chemistry/geoschem/chem_mods.F90 b/src/chemistry/geoschem/chem_mods.F90 index 03c0805ffc..bbd21c9b2b 100644 --- a/src/chemistry/geoschem/chem_mods.F90 +++ b/src/chemistry/geoschem/chem_mods.F90 @@ -79,8 +79,8 @@ module chem_mods indexh2o = 4, & ! index of water vapor density clsze = 1, & ! loop length for implicit chemistry rxt_tag_cnt = 95, & - enthalpy_cnt = 0 -! nslvd = 0 + enthalpy_cnt = 0, & + nslvd = 86 ! number of short-lived (non-advected) species integer :: clscnt(5) = 0 integer :: cls_rxt_cnt(4,5) = 0 integer :: clsmap(gas_pcnst,5) = 0 @@ -101,8 +101,6 @@ module chem_mods logical :: frc_from_dataset(max(1,extcnt)) logical :: is_vector logical :: is_scalar -! character(len=16) :: slvd_lst(max(1,nslvd)) - integer :: nslvd character(len=255), allocatable :: slvd_lst(:) real(r8), allocatable :: slvd_ref_mmr(:) diff --git a/src/chemistry/geoschem/chemistry.F90 b/src/chemistry/geoschem/chemistry.F90 index 46dcf32309..10d11d95d8 100644 --- a/src/chemistry/geoschem/chemistry.F90 +++ b/src/chemistry/geoschem/chemistry.F90 @@ -890,8 +890,11 @@ subroutine chem_readnl(nlfile) CALL MPIBCAST (h2orates, LEN(h2orates), MPICHAR, 0, MPICOM) #endif - ! Update "short_lived_species" arrays - nSlvd = nSls + IF ( nSls .NE. nSlvd ) THEN + write(iulog,'(a,i4)') 'nSlvd in geoschem/chem_mods.F90 does not match # non-advected KPP species. Set nSlvd to ', nSls + CALL ENDRUN('Failure while allocating slvd_Lst') + ENDIF + ALLOCATE(slvd_Lst(nSlvd), STAT=IERR) IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating slvd_Lst') ALLOCATE(slvd_ref_MMR(nSlvd), STAT=IERR) @@ -1892,8 +1895,8 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) ! Grid area use Phys_Grid, only : get_area_all_p, get_lat_all_p, get_lon_all_p - use short_lived_species, only : get_short_lived_species - use short_lived_species, only : set_short_lived_species + use short_lived_species, only : get_short_lived_species_gc + use short_lived_species, only : set_short_lived_species_gc #if defined( MODAL_AERO ) ! Aqueous chemistry and aerosol growth @@ -2163,7 +2166,7 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) ! Retrieve previous value of species data SlsData(:,:,:) = 0.0e+0_r8 - CALL get_short_lived_species( SlsData, LCHNK, nY, pbuf ) + CALL get_short_lived_species_gc( SlsData, LCHNK, nY, pbuf ) IF ( iStep == 1 ) THEN ! Retrieve list of species with surface boundary conditions (copied from @@ -4051,7 +4054,7 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) IF ( M <= 0 ) CYCLE SlsData(:nY,nZ:1:-1,N) = REAL(State_Chm(LCHNK)%Species(M)%Conc(1,:nY,:nZ),r8) ENDDO - CALL set_short_lived_species( SlsData, LCHNK, nY, pbuf ) + CALL set_short_lived_species_gc( SlsData, LCHNK, nY, pbuf ) ! Apply tendencies to GEOS-Chem species DO N = 1, pcnst diff --git a/src/chemistry/geoschem/short_lived_species.F90 b/src/chemistry/geoschem/short_lived_species.F90 deleted file mode 100644 index 293aaa65cd..0000000000 --- a/src/chemistry/geoschem/short_lived_species.F90 +++ /dev/null @@ -1,221 +0,0 @@ -!--------------------------------------------------------------------- -! Manages the storage of non-transported short-lived chemical species -! in the physics buffer. -! -! Created by: Francis Vitt -- 20 Aug 2008 -!--------------------------------------------------------------------- -module short_lived_species - - use shr_kind_mod, only : r8 => shr_kind_r8 - use chem_mods, only : slvd_lst, nslvd, gas_pcnst, slvd_ref_mmr - use cam_logfile, only : iulog - use ppgrid, only : pcols, pver, begchunk, endchunk - use spmd_utils, only : masterproc - - - implicit none - - save - private - public :: register_short_lived_species - public :: short_lived_species_initic - public :: short_lived_species_writeic - public :: initialize_short_lived_species - public :: set_short_lived_species - public :: get_short_lived_species - public :: slvd_index - public :: pbf_idx - - integer :: pbf_idx - - character(len=16), parameter :: pbufname = 'ShortLivedSpecies' - -contains - -!--------------------------------------------------------------------- -!--------------------------------------------------------------------- - subroutine register_short_lived_species - use physics_buffer, only : pbuf_add_field, dtype_r8 - - implicit none - - integer :: m - - if ( nslvd < 1 ) return - - call pbuf_add_field(pbufname,'global',dtype_r8,(/pcols,pver,nslvd/),pbf_idx) - - end subroutine register_short_lived_species - -!--------------------------------------------------------------------- -!--------------------------------------------------------------------- - subroutine short_lived_species_initic -#ifdef WACCMX_IONOS - use cam_history, only : addfld, add_default - - integer :: m - character(len=24) :: varname - - do m=1,nslvd - varname = trim(slvd_lst(m))//'&IC' - call addfld (varname, (/ 'lev' /),'I','kg/kg',trim(varname)//' not-transported species',gridname='physgrid') - call add_default (varname,0, 'I') - enddo -#endif - end subroutine short_lived_species_initic - -!--------------------------------------------------------------------- -!--------------------------------------------------------------------- - subroutine short_lived_species_writeic( lchnk, pbuf ) - use cam_history, only : outfld, write_inithist - use physics_buffer, only : physics_buffer_desc, pbuf_get_field - - integer , intent(in) :: lchnk ! chunk identifier - type(physics_buffer_desc), pointer :: pbuf(:) -#ifdef WACCMX_IONOS - real(r8),pointer :: tmpptr(:,:) - integer :: m - character(len=24) :: varname - - if ( write_inithist() ) then - do m=1,nslvd - varname = trim(slvd_lst(m))//'&IC' - call pbuf_get_field(pbuf, pbf_idx, tmpptr, start=(/1,1,m/), kount=(/ pcols,pver,1 /)) - call outfld(varname, tmpptr, pcols,lchnk) - enddo - endif -#endif - end subroutine short_lived_species_writeic - -!--------------------------------------------------------------------- -!--------------------------------------------------------------------- - subroutine initialize_short_lived_species(ncid_ini, pbuf2d) - use cam_grid_support, only : cam_grid_check, cam_grid_id - use cam_grid_support, only : cam_grid_get_dim_names - use cam_abortutils, only : endrun - !use mo_tracname, only : solsym !TMMF - use ncdio_atm, only : infld - use pio, only : file_desc_t - use physics_buffer, only : physics_buffer_desc, pbuf_set_field, pbuf_get_chunk, pbuf_get_field - - implicit none - - type(file_desc_t), intent(inout) :: ncid_ini - type(physics_buffer_desc), pointer :: pbuf2d(:,:) - - integer :: m,n,lchnk - integer :: grid_id - character(len=255) :: fieldname - character(len=4) :: dim1name, dim2name - logical :: found - real(r8),pointer :: tmpptr(:,:,:) ! temporary pointer - real(r8),pointer :: tmpptr2(:,:,:) ! temporary pointer - character(len=*), parameter :: subname='INITIALIZE_SHORT_LIVED_SPECIES' - - if ( nslvd < 1 ) return - - found = .false. - - grid_id = cam_grid_id('physgrid') - if (.not. cam_grid_check(grid_id)) then - call endrun(trim(subname)//': Internal error, no "physgrid" grid') - end if - call cam_grid_get_dim_names(grid_id, dim1name, dim2name) - - call pbuf_set_field(pbuf2d, pbf_idx, 0._r8) - - allocate(tmpptr(pcols,pver,begchunk:endchunk)) - - do m=1,nslvd - write(fieldname,'(a,a)') trim(slvd_lst(m)) - call infld( fieldname,ncid_ini,dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, & - tmpptr, found, gridname='physgrid') - - if (.not.found) then - !tmpptr(:,:,:) = 1.e-36_r8 - tmpptr(:,:,:) = slvd_ref_mmr(m) - endif - - call pbuf_set_field(pbuf2d, pbf_idx, tmpptr, start=(/1,1,m/),kount=(/pcols,pver,1/)) - - if (MasterProc) write(iulog,'(a20,a)') TRIM(fieldname), ' is set to short-lived' - ! DEBUG: remove as this will be confusing to most due to the negative - ! dummy MW which was used to calculate the reference MMR - if (MasterProc) write(iulog,'(a, E16.5E4)') ' --> reference MMR: ', slvd_ref_mmr(m) - - enddo - - deallocate(tmpptr) - - end subroutine initialize_short_lived_species - -!--------------------------------------------------------------------- -!--------------------------------------------------------------------- - subroutine set_short_lived_species( q, lchnk, ncol, pbuf ) - - use physics_buffer, only : physics_buffer_desc, pbuf_set_field - - implicit none - - real(r8), intent(in) :: q(pcols,pver,nslvd) - integer, intent(in) :: lchnk, ncol - type(physics_buffer_desc), pointer :: pbuf(:) - - integer :: m,n - - if ( nslvd < 1 ) return - - do m=1,nslvd - call pbuf_set_field(pbuf, pbf_idx, q(:,:,m), start=(/1,1,m/),kount=(/pcols,pver,1/)) - enddo - - end subroutine set_short_lived_species - -!--------------------------------------------------------------------- -!--------------------------------------------------------------------- - subroutine get_short_lived_species( q, lchnk, ncol, pbuf ) - use physics_buffer, only : physics_buffer_desc, pbuf_get_field - - implicit none - - real(r8), intent(inout) :: q(pcols,pver,nslvd) - integer, intent(in) :: lchnk, ncol - type(physics_buffer_desc), pointer :: pbuf(:) - real(r8),pointer :: tmpptr(:,:) - - - integer :: m,n - - if ( nslvd < 1 ) return - - do m=1,nslvd - call pbuf_get_field(pbuf, pbf_idx, tmpptr, start=(/1,1,m/), kount=(/ pcols,pver,1 /)) - q(:ncol,:,m) = tmpptr(:ncol,:) - enddo - - endsubroutine get_short_lived_species - -!--------------------------------------------------------------------- -!--------------------------------------------------------------------- - function slvd_index( name ) - implicit none - - character(len=*) :: name - integer :: slvd_index - - integer :: m - - slvd_index = -1 - - if ( nslvd < 1 ) return - - do m=1,nslvd - if ( name == slvd_lst(m) ) then - slvd_index = m - return - endif - enddo - - endfunction slvd_index - -end module short_lived_species diff --git a/src/chemistry/mozart/short_lived_species.F90 b/src/chemistry/mozart/short_lived_species.F90 index 76fb30b20e..3ceff24e75 100644 --- a/src/chemistry/mozart/short_lived_species.F90 +++ b/src/chemistry/mozart/short_lived_species.F90 @@ -23,7 +23,9 @@ module short_lived_species public :: short_lived_species_writeic public :: initialize_short_lived_species public :: set_short_lived_species + public :: set_short_lived_species_gc ! for GEOS-Chem chemistry public :: get_short_lived_species + public :: get_short_lived_species_gc ! for GEOS-Chem chemistry public :: slvd_index public :: pbf_idx @@ -91,9 +93,11 @@ subroutine initialize_short_lived_species(ncid_ini, pbuf2d) use cam_grid_support, only : cam_grid_check, cam_grid_id use cam_grid_support, only : cam_grid_get_dim_names use cam_abortutils, only : endrun + use chem_mods, only : slvd_ref_mmr use mo_tracname, only : solsym use ncdio_atm, only : infld use pio, only : file_desc_t + use phys_control, only : cam_chempkg_is use physics_buffer, only : physics_buffer_desc, pbuf_set_field implicit none @@ -124,19 +128,31 @@ subroutine initialize_short_lived_species(ncid_ini, pbuf2d) allocate(tmpptr(pcols,pver,begchunk:endchunk)) do m=1,nslvd - n = map(m) - fieldname = solsym(n) + + if (cam_chempkg_is('geoschem_mam4')) then + write(fieldname,'(a,a)') trim(slvd_lst(m)) + else + n = map(m) + fieldname = solsym(n) + end if + call infld( fieldname,ncid_ini,dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, & tmpptr, found, gridname='physgrid') if (.not.found) then - tmpptr(:,:,:) = 1.e-36_r8 + if ( cam_chempkg_is('geoschem_mam4') ) then + tmpptr(:,:,:) = slvd_ref_mmr(m) + else + tmpptr(:,:,:) = 1.e-36_r8 + endif endif call pbuf_set_field(pbuf2d, pbf_idx, tmpptr, start=(/1,1,m/),kount=(/pcols,pver,1/)) if (masterproc) write(iulog,*) fieldname, ' is set to short-lived' + if (cam_chempkg_is('geoschem_mam4') .and. masterproc) write(iulog,'(a, E16.5E4)') ' --> reference MMR: ', slvd_ref_mmr(m) + enddo deallocate(tmpptr) @@ -166,6 +182,29 @@ subroutine set_short_lived_species( q, lchnk, ncol, pbuf ) end subroutine set_short_lived_species +!--------------------------------------------------------------------- +!--------------------------------------------------------------------- + subroutine set_short_lived_species_gc( q, lchnk, ncol, pbuf ) + + use physics_buffer, only : physics_buffer_desc, pbuf_set_field + + implicit none + + ! 3rd dimension of out array is nslvd if using GEOS-Chem chemistry + real(r8), intent(in) :: q(pcols,pver,nslvd) + integer, intent(in) :: lchnk, ncol + type(physics_buffer_desc), pointer :: pbuf(:) + + integer :: m + + if ( nslvd < 1 ) return + + do m=1,nslvd + call pbuf_set_field(pbuf, pbf_idx, q(:,:,m), start=(/1,1,m/),kount=(/pcols,pver,1/)) + enddo + + end subroutine set_short_lived_species_gc + !--------------------------------------------------------------------- !--------------------------------------------------------------------- subroutine get_short_lived_species( q, lchnk, ncol, pbuf ) @@ -191,6 +230,31 @@ subroutine get_short_lived_species( q, lchnk, ncol, pbuf ) endsubroutine get_short_lived_species +!--------------------------------------------------------------------- +!--------------------------------------------------------------------- + subroutine get_short_lived_species_gc( q, lchnk, ncol, pbuf ) + use physics_buffer, only : physics_buffer_desc, pbuf_get_field + + implicit none + + ! 3rd dimension of out array is nslvd if using GEOS-Chem chemistry + real(r8), intent(inout) :: q(pcols,pver,nslvd) + integer, intent(in) :: lchnk, ncol + type(physics_buffer_desc), pointer :: pbuf(:) + real(r8),pointer :: tmpptr(:,:) + + + integer :: m + + if ( nslvd < 1 ) return + + do m=1,nslvd + call pbuf_get_field(pbuf, pbf_idx, tmpptr, start=(/1,1,m/), kount=(/ pcols,pver,1 /)) + q(:ncol,:,m) = tmpptr(:ncol,:) + enddo + + endsubroutine get_short_lived_species_gc + !--------------------------------------------------------------------- !--------------------------------------------------------------------- function slvd_index( name ) diff --git a/src/chemistry/pp_none/chem_mods.F90 b/src/chemistry/pp_none/chem_mods.F90 index 4dc00c6ced..845261c628 100644 --- a/src/chemistry/pp_none/chem_mods.F90 +++ b/src/chemistry/pp_none/chem_mods.F90 @@ -46,4 +46,5 @@ module chem_mods logical :: is_vector logical :: is_scalar character(len=16) :: slvd_lst(max(1,nslvd)) + real(r8), allocatable :: slvd_ref_mmr(max(1,nslvd)) end module chem_mods diff --git a/src/chemistry/pp_terminator/chem_mods.F90 b/src/chemistry/pp_terminator/chem_mods.F90 index 31d67260c3..ceb2107303 100644 --- a/src/chemistry/pp_terminator/chem_mods.F90 +++ b/src/chemistry/pp_terminator/chem_mods.F90 @@ -47,4 +47,5 @@ module chem_mods logical :: is_vector logical :: is_scalar character(len=16) :: slvd_lst(max(1,nslvd)) + real(r8), allocatable :: slvd_ref_mmr(max(1,nslvd)) end module chem_mods diff --git a/src/chemistry/pp_trop_mam3/chem_mods.F90 b/src/chemistry/pp_trop_mam3/chem_mods.F90 index 69af9e22ab..645b62fba5 100644 --- a/src/chemistry/pp_trop_mam3/chem_mods.F90 +++ b/src/chemistry/pp_trop_mam3/chem_mods.F90 @@ -47,4 +47,5 @@ module chem_mods logical :: is_vector logical :: is_scalar character(len=16) :: slvd_lst(max(1,nslvd)) + real(r8), allocatable :: slvd_ref_mmr(max(1,nslvd)) end module chem_mods diff --git a/src/chemistry/pp_trop_mam4/chem_mods.F90 b/src/chemistry/pp_trop_mam4/chem_mods.F90 index 0b97007e7b..76424a61a3 100644 --- a/src/chemistry/pp_trop_mam4/chem_mods.F90 +++ b/src/chemistry/pp_trop_mam4/chem_mods.F90 @@ -47,4 +47,5 @@ module chem_mods logical :: is_vector logical :: is_scalar character(len=16) :: slvd_lst(max(1,nslvd)) + real(r8), allocatable :: slvd_ref_mmr(max(1,nslvd)) end module chem_mods diff --git a/src/chemistry/pp_trop_mam5/chem_mods.F90 b/src/chemistry/pp_trop_mam5/chem_mods.F90 index 0638b442d5..f7c002b820 100644 --- a/src/chemistry/pp_trop_mam5/chem_mods.F90 +++ b/src/chemistry/pp_trop_mam5/chem_mods.F90 @@ -47,4 +47,5 @@ module chem_mods logical :: is_vector logical :: is_scalar character(len=16) :: slvd_lst(max(1,nslvd)) + real(r8), allocatable :: slvd_ref_mmr(max(1,nslvd)) end module chem_mods diff --git a/src/chemistry/pp_trop_mam7/chem_mods.F90 b/src/chemistry/pp_trop_mam7/chem_mods.F90 index b40e9525b6..872c68441f 100644 --- a/src/chemistry/pp_trop_mam7/chem_mods.F90 +++ b/src/chemistry/pp_trop_mam7/chem_mods.F90 @@ -47,4 +47,5 @@ module chem_mods logical :: is_vector logical :: is_scalar character(len=16) :: slvd_lst(max(1,nslvd)) + real(r8), allocatable :: slvd_ref_mmr(max(1,nslvd)) end module chem_mods diff --git a/src/chemistry/pp_trop_mozart/chem_mods.F90 b/src/chemistry/pp_trop_mozart/chem_mods.F90 index 9b41d9c1cb..edae88dc29 100644 --- a/src/chemistry/pp_trop_mozart/chem_mods.F90 +++ b/src/chemistry/pp_trop_mozart/chem_mods.F90 @@ -47,4 +47,5 @@ module chem_mods logical :: is_vector logical :: is_scalar character(len=16) :: slvd_lst(max(1,nslvd)) + real(r8), allocatable :: slvd_ref_mmr(max(1,nslvd)) end module chem_mods diff --git a/src/chemistry/pp_trop_strat_mam4_ts2/chem_mods.F90 b/src/chemistry/pp_trop_strat_mam4_ts2/chem_mods.F90 index 70d339afc3..414491243e 100644 --- a/src/chemistry/pp_trop_strat_mam4_ts2/chem_mods.F90 +++ b/src/chemistry/pp_trop_strat_mam4_ts2/chem_mods.F90 @@ -47,5 +47,6 @@ module chem_mods logical :: is_vector logical :: is_scalar character(len=16) :: slvd_lst(max(1,nslvd)) + real(r8), allocatable :: slvd_ref_mmr(max(1,nslvd)) integer, parameter :: veclen = 32 end module chem_mods diff --git a/src/chemistry/pp_trop_strat_mam4_vbs/chem_mods.F90 b/src/chemistry/pp_trop_strat_mam4_vbs/chem_mods.F90 index 9af6c6de37..75737d5bf7 100644 --- a/src/chemistry/pp_trop_strat_mam4_vbs/chem_mods.F90 +++ b/src/chemistry/pp_trop_strat_mam4_vbs/chem_mods.F90 @@ -47,5 +47,6 @@ module chem_mods logical :: is_vector logical :: is_scalar character(len=16) :: slvd_lst(max(1,nslvd)) + real(r8), allocatable :: slvd_ref_mmr(max(1,nslvd)) integer, parameter :: veclen = 32 end module chem_mods diff --git a/src/chemistry/pp_trop_strat_mam4_vbsext/chem_mods.F90 b/src/chemistry/pp_trop_strat_mam4_vbsext/chem_mods.F90 index 81fd6d4a31..1225023e14 100644 --- a/src/chemistry/pp_trop_strat_mam4_vbsext/chem_mods.F90 +++ b/src/chemistry/pp_trop_strat_mam4_vbsext/chem_mods.F90 @@ -47,5 +47,6 @@ module chem_mods logical :: is_vector logical :: is_scalar character(len=16) :: slvd_lst(max(1,nslvd)) + real(r8), allocatable :: slvd_ref_mmr(max(1,nslvd)) integer, parameter :: veclen = 32 end module chem_mods diff --git a/src/chemistry/pp_waccm_ma/chem_mods.F90 b/src/chemistry/pp_waccm_ma/chem_mods.F90 index 4daa9f36ee..94dad43671 100644 --- a/src/chemistry/pp_waccm_ma/chem_mods.F90 +++ b/src/chemistry/pp_waccm_ma/chem_mods.F90 @@ -47,5 +47,6 @@ module chem_mods logical :: is_vector logical :: is_scalar character(len=16) :: slvd_lst(max(1,nslvd)) + real(r8), allocatable :: slvd_ref_mmr(max(1,nslvd)) integer, parameter :: veclen = 32 end module chem_mods diff --git a/src/chemistry/pp_waccm_ma_mam4/chem_mods.F90 b/src/chemistry/pp_waccm_ma_mam4/chem_mods.F90 index b3d2ff52e0..9b6c1a3141 100644 --- a/src/chemistry/pp_waccm_ma_mam4/chem_mods.F90 +++ b/src/chemistry/pp_waccm_ma_mam4/chem_mods.F90 @@ -47,5 +47,6 @@ module chem_mods logical :: is_vector logical :: is_scalar character(len=16) :: slvd_lst(max(1,nslvd)) + real(r8), allocatable :: slvd_ref_mmr(max(1,nslvd)) integer, parameter :: veclen = 32 end module chem_mods diff --git a/src/chemistry/pp_waccm_ma_sulfur/chem_mods.F90 b/src/chemistry/pp_waccm_ma_sulfur/chem_mods.F90 index 2dfcf62986..f8995051c9 100644 --- a/src/chemistry/pp_waccm_ma_sulfur/chem_mods.F90 +++ b/src/chemistry/pp_waccm_ma_sulfur/chem_mods.F90 @@ -47,4 +47,5 @@ module chem_mods logical :: is_vector logical :: is_scalar character(len=16) :: slvd_lst(max(1,nslvd)) + real(r8), allocatable :: slvd_ref_mmr(max(1,nslvd)) end module chem_mods diff --git a/src/chemistry/pp_waccm_mad/chem_mods.F90 b/src/chemistry/pp_waccm_mad/chem_mods.F90 index c524ffab6b..ff996a00d4 100644 --- a/src/chemistry/pp_waccm_mad/chem_mods.F90 +++ b/src/chemistry/pp_waccm_mad/chem_mods.F90 @@ -47,4 +47,5 @@ module chem_mods logical :: is_vector logical :: is_scalar character(len=16) :: slvd_lst(max(1,nslvd)) + real(r8), allocatable :: slvd_ref_mmr(max(1,nslvd)) end module chem_mods diff --git a/src/chemistry/pp_waccm_mad_mam4/chem_mods.F90 b/src/chemistry/pp_waccm_mad_mam4/chem_mods.F90 index 6c202fdba7..eb95c69127 100644 --- a/src/chemistry/pp_waccm_mad_mam4/chem_mods.F90 +++ b/src/chemistry/pp_waccm_mad_mam4/chem_mods.F90 @@ -47,4 +47,5 @@ module chem_mods logical :: is_vector logical :: is_scalar character(len=16) :: slvd_lst(max(1,nslvd)) + real(r8), allocatable :: slvd_ref_mmr(max(1,nslvd)) end module chem_mods diff --git a/src/chemistry/pp_waccm_sc/chem_mods.F90 b/src/chemistry/pp_waccm_sc/chem_mods.F90 index b89c8308f5..cf5e4ac056 100644 --- a/src/chemistry/pp_waccm_sc/chem_mods.F90 +++ b/src/chemistry/pp_waccm_sc/chem_mods.F90 @@ -47,4 +47,5 @@ module chem_mods logical :: is_vector logical :: is_scalar character(len=16) :: slvd_lst(max(1,nslvd)) + real(r8), allocatable :: slvd_ref_mmr(max(1,nslvd)) end module chem_mods diff --git a/src/chemistry/pp_waccm_sc_mam4/chem_mods.F90 b/src/chemistry/pp_waccm_sc_mam4/chem_mods.F90 index f75b1c9a8a..5fca9dfce2 100644 --- a/src/chemistry/pp_waccm_sc_mam4/chem_mods.F90 +++ b/src/chemistry/pp_waccm_sc_mam4/chem_mods.F90 @@ -47,4 +47,5 @@ module chem_mods logical :: is_vector logical :: is_scalar character(len=16) :: slvd_lst(max(1,nslvd)) + real(r8), allocatable :: slvd_ref_mmr(max(1,nslvd)) end module chem_mods diff --git a/src/chemistry/pp_waccm_tsmlt_mam4/chem_mods.F90 b/src/chemistry/pp_waccm_tsmlt_mam4/chem_mods.F90 index 336ce725db..56f1a58f89 100644 --- a/src/chemistry/pp_waccm_tsmlt_mam4/chem_mods.F90 +++ b/src/chemistry/pp_waccm_tsmlt_mam4/chem_mods.F90 @@ -47,5 +47,6 @@ module chem_mods logical :: is_vector logical :: is_scalar character(len=16) :: slvd_lst(max(1,nslvd)) + real(r8), allocatable :: slvd_ref_mmr(max(1,nslvd)) integer, parameter :: veclen = 32 end module chem_mods diff --git a/src/chemistry/pp_waccm_tsmlt_mam5/chem_mods.F90 b/src/chemistry/pp_waccm_tsmlt_mam5/chem_mods.F90 index 5cdd14dcd5..3e28b7c55f 100644 --- a/src/chemistry/pp_waccm_tsmlt_mam5/chem_mods.F90 +++ b/src/chemistry/pp_waccm_tsmlt_mam5/chem_mods.F90 @@ -47,5 +47,6 @@ module chem_mods logical :: is_vector logical :: is_scalar character(len=16) :: slvd_lst(max(1,nslvd)) + real(r8), allocatable :: slvd_ref_mmr(max(1,nslvd)) integer, parameter :: veclen = 32 end module chem_mods From 08ea9a38ae17ce4f2c7cc8d97ba6c2fc0002be91 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Tue, 10 Jan 2023 15:13:40 -0700 Subject: [PATCH 085/291] Add missing GEOS-Chem diagnostics subroutine calls; cleanup other files Signed-off-by: Lizzie Lundgren --- src/chemistry/geoschem/chemistry.F90 | 27 +++++++++++++++++++++++++++ src/cpl/mct/cam_cpl_indices.F90 | 8 -------- src/cpl/nuopc/atm_comp_nuopc.F90 | 18 ------------------ src/physics/cam/physpkg.F90 | 5 ----- 4 files changed, 27 insertions(+), 31 deletions(-) diff --git a/src/chemistry/geoschem/chemistry.F90 b/src/chemistry/geoschem/chemistry.F90 index 10d11d95d8..0ec367f543 100644 --- a/src/chemistry/geoschem/chemistry.F90 +++ b/src/chemistry/geoschem/chemistry.F90 @@ -1850,6 +1850,9 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) use modal_aero_data, only : lptr2_soa_a_amode, lptr2_soa_g_amode #endif + use Diagnostics_Mod, only : Zero_Diagnostics_StartOfTimestep + use Diagnostics_Mod, only : Set_Diagnostics_EndofTimestep + use Aerosol_Mod, only : Set_AerMass_Diagnostic use Olson_Landmap_Mod, only : Compute_Olson_Landmap use Modis_LAI_Mod, only : Compute_XLAI use CMN_Size_Mod, only : NSURFTYPE @@ -2216,6 +2219,13 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) ENDDO ENDIF + !----------------------------------------------------------------------- + ! ... Reset certain GEOS-Chem diagnostics at start of timestep + !----------------------------------------------------------------------- + CALL Zero_Diagnostics_StartOfTimestep( Input_Opt = Input_Opt, & + State_Diag = State_Diag(LCHNK), & + RC = RC ) + !----------------------------------------------------------------------- ! ... Set atmosphere mean mass !----------------------------------------------------------------------- @@ -4147,6 +4157,23 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) mmr_tend = mmr_tend, & LCHNK = LCHNK ) + CALL Set_Diagnostics_EndofTimestep( Input_Opt = Input_Opt, & + State_Chm = State_Chm(LCHNK), & + State_Diag = State_Diag(LCHNK), & + State_Grid = State_Grid(LCHNK), & + State_Met = State_Met(LCHNK), & + RC = RC ) + + + IF ( State_Diag(LCHNK)%Archive_AerMass ) THEN + CALL Set_AerMass_Diagnostic( Input_Opt = Input_Opt, & + State_Chm = State_Chm(LCHNK), & + State_Diag = State_Diag(LCHNK), & + State_Grid = State_Grid(LCHNK), & + State_Met = State_Met(LCHNK), & + RC = RC ) + ENDIF + ! Compute new GEOS-Chem diagnostics into CESM History (hplin, 10/31/22) ! Note that the containers (data pointers) actually need to be updated every time step, ! because the State_Chm(LCHNK) target changes. There is some registry lookup overhead diff --git a/src/cpl/mct/cam_cpl_indices.F90 b/src/cpl/mct/cam_cpl_indices.F90 index 2dc5b8e014..ba38a67fe4 100644 --- a/src/cpl/mct/cam_cpl_indices.F90 +++ b/src/cpl/mct/cam_cpl_indices.F90 @@ -92,10 +92,6 @@ module cam_cpl_indices integer :: index_x2a_So_re ! square of atm/ocn exch. coeff integer :: index_x2a_So_ssq ! surface saturation specific humidity in ocean integer :: index_x2a_Sl_ddvel ! dry deposition velocities from land - !ewl: comment out what Thibaud added - !integer :: index_x2a_Sl_lwtgcell ! landunit area weights - !integer :: index_x2a_Sl_pwtgcell ! patch area weights - !integer :: index_x2a_Sl_lai ! leaf area indices integer :: index_x2a_Sx_u10 ! 10m wind contains @@ -170,10 +166,6 @@ subroutine cam_cpl_indices_set( ) index_x2a_Sl_ddvel = mct_avect_indexra(x2a, trim(drydep_fields_token)) else index_x2a_Sl_ddvel = 0 - ! ewl: comment out what thibaud added - !index_x2a_Sl_lwtgcell = 0 - !index_x2a_Sl_pwtgcell = 0 - !index_x2a_Sl_lai = 0 end if index_a2x_Sa_z = mct_avect_indexra(a2x,'Sa_z') diff --git a/src/cpl/nuopc/atm_comp_nuopc.F90 b/src/cpl/nuopc/atm_comp_nuopc.F90 index 9e51d370de..87077ea3a6 100644 --- a/src/cpl/nuopc/atm_comp_nuopc.F90 +++ b/src/cpl/nuopc/atm_comp_nuopc.F90 @@ -622,8 +622,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) stop_ymd=stop_ymd, stop_tod=stop_tod, curr_ymd=curr_ymd, curr_tod=curr_tod, & cam_out=cam_out, cam_in=cam_in) - if ( masterproc) print *, "ewl: in atm_comp_nuopc.F90: after cam_init" - if (mediator_present) then if (single_column) then @@ -747,8 +745,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) end if ! end of mediator_present if-block - if ( masterproc) print *, "ewl: in atm_comp_nuopc.F90: after mediator_present block" - call shr_file_setLogUnit (shrlogunit) #if (defined _MEMTRACE) @@ -764,8 +760,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) end if - if ( masterproc) print *, "ewl: in atm_comp_nuopc.F90: end of InitializeRealize" - end subroutine InitializeRealize !=============================================================================== @@ -1013,8 +1007,6 @@ subroutine ModelAdvance(gcomp, rc) rc = ESMF_SUCCESS - if ( masterproc) print *, "ewl: At start of ModelAdvance" - !$ call omp_set_num_threads(nthrds) call shr_file_getLogUnit (shrlogunit) @@ -1114,20 +1106,14 @@ subroutine ModelAdvance(gcomp, rc) ! Run CAM (run2, run3, run4) - if ( masterproc) print *, "ewl: In ModelAdvance: before cam_run2" - call t_startf ('CAM_run2') call cam_run2( cam_out, cam_in ) call t_stopf ('CAM_run2') - if ( masterproc) print *, "ewl: In ModelAdvance: before cam_run3" - call t_startf ('CAM_run3') call cam_run3( cam_out ) call t_stopf ('CAM_run3') - if ( masterproc) print *, "ewl: In ModelAdvance: before cam_run4" - call t_startf ('CAM_run4') call cam_run4( cam_out, cam_in, rstwr, nlend, & yr_spec=yr_sync, mon_spec=mon_sync, day_spec=day_sync, sec_spec=tod_sync) @@ -1135,16 +1121,12 @@ subroutine ModelAdvance(gcomp, rc) ! Advance cam time step - if ( masterproc) print *, "ewl: In ModelAdvance: advancing timestep" - call t_startf ('CAM_adv_timestep') call advance_timestep() call t_stopf ('CAM_adv_timestep') ! Run cam radiation/clouds (run1) - if ( masterproc) print *, "ewl: In ModelAdvance: before cam_run1" - call t_startf ('CAM_run1') call cam_run1 ( cam_in, cam_out ) call t_stopf ('CAM_run1') diff --git a/src/physics/cam/physpkg.F90 b/src/physics/cam/physpkg.F90 index f049e06439..d2d72b2f00 100644 --- a/src/physics/cam/physpkg.F90 +++ b/src/physics/cam/physpkg.F90 @@ -1619,7 +1619,6 @@ subroutine tphysac (ztodt, cam_in, & !------------------------------------------ ! Call major diffusion for extended model !------------------------------------------ - if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then call waccmx_phys_mspd_tend (ztodt ,state ,ptend) endif @@ -1646,7 +1645,6 @@ subroutine tphysac (ztodt, cam_in, & !=================================================== ! Rayleigh friction calculation !=================================================== - call t_startf('rayleigh_friction') call rayleigh_friction_tend( ztodt, state, ptend) if ( ptend%lu ) then @@ -1701,7 +1699,6 @@ subroutine tphysac (ztodt, cam_in, & ! that cam_out%xxxdryxxx fields have already been set for CAM aerosols and cam_out ! can be added to for CARMA aerosols. if (carma_do_aerosol) then - call t_startf('carma_timestep_tend') call carma_timestep_tend(state, cam_in, cam_out, ptend, ztodt, pbuf, obklen=obklen, ustar=surfric) call physics_update(state, ptend, ztodt, tend) @@ -1714,7 +1711,6 @@ subroutine tphysac (ztodt, cam_in, & !--------------------------------------------------------------------------------- ! ... enforce charge neutrality !--------------------------------------------------------------------------------- - call charge_balance(state, pbuf) !=================================================== @@ -1807,7 +1803,6 @@ subroutine tphysac (ztodt, cam_in, & !---------------------------------------------------------------------------- ! Call ionosphere routines for extended model if mode is set to ionosphere !---------------------------------------------------------------------------- - if( waccmx_is('ionosphere') ) then call waccmx_phys_ion_elec_temp_tend(state, ptend, pbuf, ztodt) endif From f60ef7a859f12d682432683c80da16e2d92d5a37 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Wed, 11 Jan 2023 14:38:46 -0700 Subject: [PATCH 086/291] Update GEOS-Chem compset diagnostics list; fix build-namelist permissions Signed-off-by: Lizzie Lundgren --- bld/build-namelist | 0 .../use_cases/2000_geoschem.xml | 118 +++++++++- .../use_cases/2010_geoschem.xml | 113 ++++++++- .../use_cases/hist_geoschem.xml | 216 +++++++++--------- .../use_cases/hist_geoschem_nudged.xml | 216 +++++++++--------- bld/namelist_files/use_cases/sd_geoschem.xml | 211 +++++++++-------- 6 files changed, 555 insertions(+), 319 deletions(-) mode change 100644 => 100755 bld/build-namelist diff --git a/bld/build-namelist b/bld/build-namelist old mode 100644 new mode 100755 diff --git a/bld/namelist_files/use_cases/2000_geoschem.xml b/bld/namelist_files/use_cases/2000_geoschem.xml index 670cff6809..e7be6f4774 100644 --- a/bld/namelist_files/use_cases/2000_geoschem.xml +++ b/bld/namelist_files/use_cases/2000_geoschem.xml @@ -76,14 +76,118 @@ .false. .false. - - 'Q', 'U', 'V', 'OMEGA', 'T', 'PS', +'AREA', +'HEIGHT', +'T', +'U', +'V', +'Q', +'PS', +'CLOUD', +'TROPP_P', +'TROPP_T', +'TROPP_Z', +'DF_CO', +'DF_O3', +'DF_NO2', +'DF_SO4', +'DF_NIT', +'CT_O3', +'CT_OH', +'OHwgtByAirMassColumnFull', +'Chem_SO3AQ', +'Jval_Cl2O2', +'Jval_H2O2', +'Jval_NO2', +'Jval_PAN', +'JvalO3O3P', +'JvalO3O1D', +'LNO_COL_PROD', +'Prod_Ox', +'Prod_SO4', +'Prod_CO', +'Prod_H2O2', +'ProdCOfromCH4', +'ProdCOfromNMVOC', +'Loss_Ox', +'Loss_CH4', +'Loss_CO', +'LossOHbyCH4columnTrop', +'LossOHbyMCFcolumnTrop', +'LossHNO3onSeaSalt', +'ACET', +'ALD2', +'ALK4', +'BR', +'BRCL', +'BRNO3', +'BRO', +'BROX', +'BROY', +'C3H8', +'CH2O', +'CH3CL', +'CH4', +'CL', +'CLNO3', +'CLO', +'CLOX', +'CLOY', +'CO', +'DMS', +'EOH', +'H2O', +'H2O2', +'H2SO4', +'HO2', +'HOX', +'HBR', +'HCL', +'HOBR', +'HOCL', +'HNO3', +'HNO4', +'ISOP', +'MACR', +'MAP', +'MEK', +'MOH', +'MVK', +'N2O', +'N2O5', +'NHX', +'NIT', +'NO', +'NO2', +'NO3', +'NOX', +'NOY', +'O3', +'OH', +'PAN', +'PM25', +'RCHO', +'SALA', +'SALC', +'SO2', +'SO4', +'SOX', +'TOLU', +'bc_a1', +'bc_a4', +'dst_a1', +'dst_a2', +'dst_a3', +'num_a1', +'num_a2', +'num_a3', +'num_a4', +'pom_a1', +'pom_a4', +'so4_a1', +'so4_a2', +'so4_a3', - - - 'O3', 'NO', 'NO2', 'CO', 'HNO3', 'CH4', 'NIT', 'NH4', 'NH3', 'SO4', 'SO2', 'OH', - - diff --git a/bld/namelist_files/use_cases/2010_geoschem.xml b/bld/namelist_files/use_cases/2010_geoschem.xml index 847a245a70..56d1182cd8 100644 --- a/bld/namelist_files/use_cases/2010_geoschem.xml +++ b/bld/namelist_files/use_cases/2010_geoschem.xml @@ -72,9 +72,118 @@ .false. .false. - - 'Q', 'U', 'V', 'OMEGA', 'T', 'PS', +'AREA', +'HEIGHT', +'T', +'U', +'V', +'Q', +'PS', +'CLOUD', +'TROPP_P', +'TROPP_T', +'TROPP_Z', +'DF_CO', +'DF_O3', +'DF_NO2', +'DF_SO4', +'DF_NIT', +'CT_O3', +'CT_OH', +'OHwgtByAirMassColumnFull', +'Chem_SO3AQ', +'Jval_Cl2O2', +'Jval_H2O2', +'Jval_NO2', +'Jval_PAN', +'JvalO3O3P', +'JvalO3O1D', +'LNO_COL_PROD', +'Prod_Ox', +'Prod_SO4', +'Prod_CO', +'Prod_H2O2', +'ProdCOfromCH4', +'ProdCOfromNMVOC', +'Loss_Ox', +'Loss_CH4', +'Loss_CO', +'LossOHbyCH4columnTrop', +'LossOHbyMCFcolumnTrop', +'LossHNO3onSeaSalt', +'ACET', +'ALD2', +'ALK4', +'BR', +'BRCL', +'BRNO3', +'BRO', +'BROX', +'BROY', +'C3H8', +'CH2O', +'CH3CL', +'CH4', +'CL', +'CLNO3', +'CLO', +'CLOX', +'CLOY', +'CO', +'DMS', +'EOH', +'H2O', +'H2O2', +'H2SO4', +'HO2', +'HOX', +'HBR', +'HCL', +'HOBR', +'HOCL', +'HNO3', +'HNO4', +'ISOP', +'MACR', +'MAP', +'MEK', +'MOH', +'MVK', +'N2O', +'N2O5', +'NHX', +'NIT', +'NO', +'NO2', +'NO3', +'NOX', +'NOY', +'O3', +'OH', +'PAN', +'PM25', +'RCHO', +'SALA', +'SALC', +'SO2', +'SO4', +'SOX', +'TOLU', +'bc_a1', +'bc_a4', +'dst_a1', +'dst_a2', +'dst_a3', +'num_a1', +'num_a2', +'num_a3', +'num_a4', +'pom_a1', +'pom_a4', +'so4_a1', +'so4_a2', +'so4_a3', diff --git a/bld/namelist_files/use_cases/hist_geoschem.xml b/bld/namelist_files/use_cases/hist_geoschem.xml index 6e0c1cee83..161db508ee 100644 --- a/bld/namelist_files/use_cases/hist_geoschem.xml +++ b/bld/namelist_files/use_cases/hist_geoschem.xml @@ -70,112 +70,118 @@ .false. .false. - - - 'AODDUST', 'AODDUST2', 'T', 'U', 'V', 'O3', 'OH', 'NO3', 'HO2', - 'LNO_COL_PROD', 'NO2_CLXF', 'SFNO', 'SFNH3', 'BRO', - 'CH3CL', 'CLO', 'CO2', 'HCL', 'HO2', 'HOCL', 'PHIS', 'Z3', - 'BENZ', 'C2H6', 'C3H8', 'CCL4', 'CFC11', 'CFC113', 'CFC12', - 'CH2O', 'CH3BR', 'CH3CCL3', 'ALD2', 'CH3CL', 'ACET', 'MOH', 'CH4', - 'CO', 'H2O2', 'HCFC22', 'HNO3', 'ISOP', 'MTPA', 'N2O', 'O3', - 'PAN', 'SO2', 'OH', 'ALK4', 'PRPE', 'BR', 'BRCL', 'BRO', 'BRNO3', - 'EOH', 'ETP', 'PRPE', 'RA3P', 'CCL4', 'H1211', 'H1301', - 'CFC11', 'CFC113', 'CFC114', 'CFC115', 'CFC12', 'CH2BR2', 'CH2O', - 'CH3BR', 'CH3CCL3', 'ALD2', 'CH3CL', 'MGLY', 'ACTA', 'MAP', 'MP', - 'CH4', 'CHBR3', 'CL', 'CL2', 'CL2O2', 'CLO', 'CLNO3', 'CO', - 'CO2', 'DMS', 'GLYC', 'GLYX', - 'H', 'H2', 'H2402', 'H2O2', 'HBR', 'HCFC141B', 'HCFC142B', 'HCFC22', - 'HCL', 'HNO3', 'HNO4', 'HOBR', 'HOCL', 'HONIT', 'HPALD1', 'HPALD2', 'HPALD3', - 'HPALD4', 'HAC', 'HC5A', 'IEPOXA', 'IEPOXB', 'IEPOXD', 'ISOP', 'IHN1', 'IHN2', 'IHN3', - 'IHN4', 'INO2B', 'INO2D', 'INPB', 'INPD', 'RIPA', 'RIPB', 'RIPC', 'RIPD', - 'MACR', 'MVKHP', 'MEK', 'MCRDH', 'MPAN', 'MVK', 'N', 'N2O', 'N2O5', 'ICN', - 'NH3', 'NH4', 'NO', 'NO2', 'NO3', 'PROPNN', 'OLND', 'OLNN', 'O', 'OCLO', - 'OCS', 'PAN', 'SO2', 'SO4', 'TOLU', 'XYLE', - 'R4O2', 'BRO2', 'ETO2', 'A3O2', 'MCO3', 'MO2', 'HO2', 'O1D', 'OH', - 'TSOA0', 'TSOA1', 'TSOA2', 'TSOA3', 'ASOAN', 'ASOA1', 'ASOA2', 'ASOA3', - 'SOAIE', 'SOAGX', - 'H2O', 'SAD_PSC', 'SAD_SULFC', 'SAD_TROP', 'SAD_AERO', 'REFF_AERO', - 'PDELDRY', 'RAD_PSC', 'RAD_SULFC', - 'HNO3_GAS', 'HNO3_STS', 'HNO3_NAT', 'NOX', 'NOY', 'CLOX', 'CLOY', - 'BROX', 'BROY', 'TCLY', 'TOTH', 'MASS', 'TBRY', 'HCL_GAS', - 'HCL_GAS', 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'ABSORB', - 'AODVISdn', 'AODdnMODE1', 'AODVISstdn', 'AODNIRstdn', - 'AODUVstdn', 'AODdnMODE2', 'AODdnMODE3', 'AODdnDUST1', 'AODdnDUST2', - 'AODdnDUST3', 'AODVISstdn', 'AODUVstdn', 'AODNIRstdn', - 'AODNIRstdn', 'AODVISdn', 'AODUVdn', 'EXTINCTdn', 'EXTxASYMdn', - 'EXTINCTNIRdn', 'EXTINCTUVdn', - 'WD_EOH', 'WD_ETP', 'WD_RA3P', 'WD_CH2O', 'WD_ALD2', - 'WD_MGLY', 'WD_ACTA', 'WD_MAP', 'WD_MOH', 'WD_MP', - 'WD_GLYC', 'WD_H2O2', 'WD_SO4', 'WD_HBR', 'WD_HCL', - 'WD_HNO3', 'WD_HOBR', 'WD_HOCL', 'WD_HONIT', 'WD_HAC', 'WD_IEPOXA', - 'WD_IEPOXB', 'WD_IEPOXD', 'WD_MVK', 'WD_NH3', 'WD_NH4', 'WD_SO2', - 'DF_EOH', 'DF_ETP', 'DF_RA3P', 'DF_CH2O', 'DF_ALD2', 'DF_ACET', - 'DF_MGLY', 'DF_ACTA', 'DF_MAP', 'DF_MOH', 'DF_MP', 'DF_CO', - 'DF_GLYC', 'DF_H2O2', 'DF_SO4', 'DF_HNO3', 'DF_HNO4', - 'DF_HONIT', 'DF_HPALD1', 'DF_HPALD2', 'DF_HPALD3', 'DF_HPALD4', - 'DF_HAC', 'DF_IEPOXA', 'DF_IEPOXB', 'DF_IEPOXD', - 'DF_MPAN', 'DF_NH3', 'DF_NH4', 'DF_NO', - 'DF_NO2', 'DF_O3', 'DF_PAN', 'DF_SO2', - 'SO2_CLXF', 'SO2_XFRC', - 'CO_CLXF', 'NO2_CLXF', 'LNO_PROD', 'LNO_COL_PROD', - 'SFEOH', 'SFALD2', 'SFMEK', 'SFCH2O', 'SFC2H6', 'SFC3H8', - 'SFALK4', 'SFPRPE', 'SFBENZ', 'SFTOLU', 'SFXYLE', - 'SFNO', 'SFACTA', 'SFDMS', 'SFMEK', 'SFSO2', 'SFNH3', - 'SFISOP', 'SFMTPA', 'SFMOH', 'SFACET', 'SFCO', - 'MEG_ISOP', 'MEG_MOH', 'MEG_EOH', 'MEG_CH2O', 'MEG_ALD2', 'MEG_ACTA', - 'MEG_ACET', 'MEG_HCOOH', 'MEG_HCN', 'MEG_CO', 'MEG_C2H6', 'MEG_C2H4', - 'MEG_C3H8', 'MEG_ALK4', 'MEG_PRPE', 'MEG_TOLU', 'MEG_LIMO', 'MEG_MTPA', - 'MEG_MTPO', 'Dso4_a1CHM', 'Dso4_a2CHM', 'Dso4_a3CHM', 'DO3CHM', 'DCOCHM', - 'DHNO3CHM', 'DH2O2CHM', 'DO3CHM', 'DCOCHM', 'AQ_SO2', 'GS_SO2', 'SO2_CLXF', - 'MASS', 'ABSORB', - 'JvalO3O1D', 'Jval_NO2', 'Jval_PAN', 'Jval_H2O2', 'Jval_Cl2O2', - 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a1', - 'ncl_a2', 'ncl_a3', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', - 'soa1_a1', 'soa2_a1', 'soa3_a1', 'soa4_a1', 'soa5_a1', 'soa1_a2', 'soa2_a2', 'soa3_a2', - 'soa4_a2', 'soa5_a2', 'bc_c1', 'bc_c4', 'dst_c1', 'dst_c2', 'dst_c3', 'ncl_c1', 'ncl_c1', - 'ncl_c2', 'ncl_c3', 'pom_c1', 'pom_c4', 'so4_c1', 'so4_c2', 'so4_c3', 'soa1_c1', 'soa2_c1', - 'soa3_c1', 'soa4_c1', 'soa5_c1', 'soa1_c2', 'soa2_c2', 'soa3_c2', 'soa4_c2', 'soa5_c2', - 'bc_a1SFWET', 'num_a1','num_a2','num_a3','num_a4','num_c1','num_c2','num_c3','num_c4', - 'bc_a1SFWET', 'bc_a4SFWET', 'dst_a1SFWET', 'dst_a2SFWET', 'dst_a3SFWET', 'ncl_a1SFWET', - 'ncl_a2SFWET', 'ncl_a3SFWET', 'pom_a1SFWET', 'pom_a4SFWET', - 'so4_a1SFWET', 'so4_a2SFWET', 'so4_a3SFWET', 'soa1_a1SFWET', 'soa1_a2SFWET', - 'soa2_a1SFWET', 'soa2_a2SFWET', 'soa3_a1SFWET', 'soa3_a2SFWET', - 'soa4_a1SFWET', 'soa4_a2SFWET', 'soa5_a1SFWET', 'soa5_a2SFWET', 'bc_c1SFWET', - 'bc_c4SFWET', 'dst_c1SFWET', 'dst_c2SFWET', 'dst_c3SFWET', - 'ncl_c1SFWET', 'ncl_c2SFWET', 'ncl_c3SFWET', 'pom_c1SFWET', 'pom_c4SFWET', - 'so4_c1SFWET', 'so4_c2SFWET', 'so4_c3SFWET', 'soa1_c1SFWET', - 'soa1_c2SFWET', 'soa2_c1SFWET', 'soa2_c2SFWET', 'soa3_c1SFWET', 'soa3_c2SFWET', - 'soa4_c1SFWET', 'soa4_c2SFWET', 'soa5_c1SFWET', 'soa5_c2SFWET', - 'bc_a1DDF', 'bc_a4DDF', 'dst_a1DDF', 'dst_a2DDF', 'dst_a3DDF', 'ncl_a1DDF', - 'ncl_a2DDF', 'ncl_a3DDF', 'pom_a1DDF', - 'pom_a4DDF', 'so4_a1DDF', 'so4_a2DDF', 'so4_a3DDF', 'soa1_a1DDF', - 'soa1_a2DDF', 'soa2_a1DDF', 'soa2_a2DDF', 'soa3_a1DDF', - 'soa3_a2DDF', 'soa4_a1DDF', 'soa4_a2DDF', 'soa5_a1DDF', 'soa5_a2DDF', - 'bc_c1DDF', 'bc_c4DDF', 'dst_c1DDF', 'dst_c2DDF', - 'dst_c3DDF', 'ncl_c1DDF', 'ncl_c2DDF', 'ncl_c3DDF', 'pom_c1DDF', - 'pom_c4DDF', 'so4_c1DDF', 'so4_c2DDF', 'so4_c3DDF', - 'soa1_c1DDF', 'soa1_c2DDF', 'soa2_c1DDF', 'soa2_c2DDF', 'soa3_c1DDF', - 'soa3_c2DDF', 'soa4_c1DDF', 'soa4_c2DDF', 'soa5_c1DDF', - 'soa5_c2DDF', 'num_a1DDF', 'num_a2DDF', 'num_a3DDF', 'num_a4DDF', - 'num_c1DDF', 'num_c2DDF', 'num_c3DDF', 'num_c4DDF', - 'bc_a4_CLXF', 'pom_a4_CLXF', 'so4_a1_CLXF', 'so4_a2_CLXF', - 'num_a1_CLXF', 'num_a2_CLXF', 'SFbc_a4', 'SFpom_a4', 'SFso4_a1', - 'SFso4_a2', 'SFnum_a1', 'SFnum_a2', 'SFnum_a3', 'so4_a1_sfgaex1', - 'so4_a2_sfgaex1', 'so4_a3_sfgaex1', 'soa1_a1_sfgaex1', 'soa1_a2_sfgaex1', - 'soa2_a1_sfgaex1', 'soa2_a2_sfgaex1', 'soa3_a1_sfgaex1', 'soa3_a2_sfgaex1', - 'soa4_a1_sfgaex1', 'soa4_a2_sfgaex1', 'soa5_a1_sfgaex1', 'soa5_a2_sfgaex1', - 'so4_a2_sfnnuc1', 'so4_c1AQH2SO4', 'so4_c2AQH2SO4', 'so4_c3AQH2SO4', - 'so4_c1AQSO4', 'so4_c2AQSO4', 'so4_c3AQSO4', 'SFdst_a1', 'SFdst_a2', 'SFdst_a3', - 'SFncl_a1', 'SFncl_a2', 'SFncl_a3', - 'TMOCS', 'TMSO2', 'TMso4_a1', 'TMso4_a2', 'TMso4_a3', - 'BURDENDUSTdn', 'BURDENPOMdn', 'BURDENSO4dn', 'BURDENSOAdn', - 'BURDENSEASALTdn','BURDENBCdn', 'PM25' +'AREA', +'HEIGHT', +'T', +'U', +'V', +'Q', +'PS', +'CLOUD', +'TROPP_P', +'TROPP_T', +'TROPP_Z', +'DF_CO', +'DF_O3', +'DF_NO2', +'DF_SO4', +'DF_NIT', +'CT_O3', +'CT_OH', +'OHwgtByAirMassColumnFull', +'Chem_SO3AQ', +'Jval_Cl2O2', +'Jval_H2O2', +'Jval_NO2', +'Jval_PAN', +'JvalO3O3P', +'JvalO3O1D', +'LNO_COL_PROD', +'Prod_Ox', +'Prod_SO4', +'Prod_CO', +'Prod_H2O2', +'ProdCOfromCH4', +'ProdCOfromNMVOC', +'Loss_Ox', +'Loss_CH4', +'Loss_CO', +'LossOHbyCH4columnTrop', +'LossOHbyMCFcolumnTrop', +'LossHNO3onSeaSalt', +'ACET', +'ALD2', +'ALK4', +'BR', +'BRCL', +'BRNO3', +'BRO', +'BROX', +'BROY', +'C3H8', +'CH2O', +'CH3CL', +'CH4', +'CL', +'CLNO3', +'CLO', +'CLOX', +'CLOY', +'CO', +'DMS', +'EOH', +'H2O', +'H2O2', +'H2SO4', +'HO2', +'HOX', +'HBR', +'HCL', +'HOBR', +'HOCL', +'HNO3', +'HNO4', +'ISOP', +'MACR', +'MAP', +'MEK', +'MOH', +'MVK', +'N2O', +'N2O5', +'NHX', +'NIT', +'NO', +'NO2', +'NO3', +'NOX', +'NOY', +'O3', +'OH', +'PAN', +'PM25', +'RCHO', +'SALA', +'SALC', +'SO2', +'SO4', +'SOX', +'TOLU', +'bc_a1', +'bc_a4', +'dst_a1', +'dst_a2', +'dst_a3', +'num_a1', +'num_a2', +'num_a3', +'num_a4', +'pom_a1', +'pom_a4', +'so4_a1', +'so4_a2', +'so4_a3', - - diff --git a/bld/namelist_files/use_cases/hist_geoschem_nudged.xml b/bld/namelist_files/use_cases/hist_geoschem_nudged.xml index d5ab458374..2b1bcf64f9 100644 --- a/bld/namelist_files/use_cases/hist_geoschem_nudged.xml +++ b/bld/namelist_files/use_cases/hist_geoschem_nudged.xml @@ -125,112 +125,118 @@ .false. .false. - - - 'AODDUST', 'AODDUST2', 'T', 'U', 'V', 'O3', 'OH', 'NO3', 'HO2', - 'LNO_COL_PROD', 'NO2_CLXF', 'SFNO', 'SFNH3', 'BRO', - 'CH3CL', 'CLO', 'CO2', 'HCL', 'HO2', 'HOCL', 'PHIS', 'Z3', - 'BENZ', 'C2H6', 'C3H8', 'CCL4', 'CFC11', 'CFC113', 'CFC12', - 'CH2O', 'CH3BR', 'CH3CCL3', 'ALD2', 'CH3CL', 'ACET', 'MOH', 'CH4', - 'CO', 'H2O2', 'HCFC22', 'HNO3', 'ISOP', 'MTPA', 'N2O', 'O3', - 'PAN', 'SO2', 'OH', 'ALK4', 'PRPE', 'BR', 'BRCL', 'BRO', 'BRNO3', - 'EOH', 'ETP', 'PRPE', 'RA3P', 'CCL4', 'H1211', 'H1301', - 'CFC11', 'CFC113', 'CFC114', 'CFC115', 'CFC12', 'CH2BR2', 'CH2O', - 'CH3BR', 'CH3CCL3', 'ALD2', 'CH3CL', 'MGLY', 'ACTA', 'MAP', 'MP', - 'CH4', 'CHBR3', 'CL', 'CL2', 'CL2O2', 'CLO', 'CLNO3', 'CO', - 'CO2', 'DMS', 'GLYC', 'GLYX', - 'H', 'H2', 'H2402', 'H2O2', 'HBR', 'HCFC141B', 'HCFC142B', 'HCFC22', - 'HCL', 'HNO3', 'HNO4', 'HOBR', 'HOCL', 'HONIT', 'HPALD1', 'HPALD2', 'HPALD3', - 'HPALD4', 'HAC', 'HC5A', 'IEPOXA', 'IEPOXB', 'IEPOXD', 'ISOP', 'IHN1', 'IHN2', 'IHN3', - 'IHN4', 'INO2B', 'INO2D', 'INPB', 'INPD', 'RIPA', 'RIPB', 'RIPC', 'RIPD', - 'MACR', 'MVKHP', 'MEK', 'MCRDH', 'MPAN', 'MVK', 'N', 'N2O', 'N2O5', 'ICN', - 'NH3', 'NH4', 'NO', 'NO2', 'NO3', 'PROPNN', 'OLND', 'OLNN', 'O', 'OCLO', - 'OCS', 'PAN', 'SO2', 'SO4', 'TOLU', 'XYLE', - 'R4O2', 'BRO2', 'ETO2', 'A3O2', 'MCO3', 'MO2', 'HO2', 'O1D', 'OH', - 'TSOA0', 'TSOA1', 'TSOA2', 'TSOA3', 'ASOAN', 'ASOA1', 'ASOA2', 'ASOA3', - 'SOAIE', 'SOAGX', - 'H2O', 'SAD_PSC', 'SAD_SULFC', 'SAD_TROP', 'SAD_AERO', 'REFF_AERO', - 'PDELDRY', 'RAD_PSC', 'RAD_SULFC', - 'HNO3_GAS', 'HNO3_STS', 'HNO3_NAT', 'NOX', 'NOY', 'CLOX', 'CLOY', - 'BROX', 'BROY', 'TCLY', 'TOTH', 'MASS', 'TBRY', 'HCL_GAS', - 'HCL_GAS', 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'ABSORB', - 'AODVISdn', 'AODdnMODE1', 'AODVISstdn', 'AODNIRstdn', - 'AODUVstdn', 'AODdnMODE2', 'AODdnMODE3', 'AODdnDUST1', 'AODdnDUST2', - 'AODdnDUST3', 'AODVISstdn', 'AODUVstdn', 'AODNIRstdn', - 'AODNIRstdn', 'AODVISdn', 'AODUVdn', 'EXTINCTdn', 'EXTxASYMdn', - 'EXTINCTNIRdn', 'EXTINCTUVdn', - 'WD_EOH', 'WD_ETP', 'WD_RA3P', 'WD_CH2O', 'WD_ALD2', - 'WD_MGLY', 'WD_ACTA', 'WD_MAP', 'WD_MOH', 'WD_MP', - 'WD_GLYC', 'WD_H2O2', 'WD_SO4', 'WD_HBR', 'WD_HCL', - 'WD_HNO3', 'WD_HOBR', 'WD_HOCL', 'WD_HONIT', 'WD_HAC', 'WD_IEPOXA', - 'WD_IEPOXB', 'WD_IEPOXD', 'WD_MVK', 'WD_NH3', 'WD_NH4', 'WD_SO2', - 'DF_EOH', 'DF_ETP', 'DF_RA3P', 'DF_CH2O', 'DF_ALD2', 'DF_ACET', - 'DF_MGLY', 'DF_ACTA', 'DF_MAP', 'DF_MOH', 'DF_MP', 'DF_CO', - 'DF_GLYC', 'DF_H2O2', 'DF_SO4', 'DF_HNO3', 'DF_HNO4', - 'DF_HONIT', 'DF_HPALD1', 'DF_HPALD2', 'DF_HPALD3', 'DF_HPALD4', - 'DF_HAC', 'DF_IEPOXA', 'DF_IEPOXB', 'DF_IEPOXD', - 'DF_MPAN', 'DF_NH3', 'DF_NH4', 'DF_NO', - 'DF_NO2', 'DF_O3', 'DF_PAN', 'DF_SO2', - 'SO2_CLXF', 'SO2_XFRC', - 'CO_CLXF', 'NO2_CLXF', 'LNO_PROD', 'LNO_COL_PROD', - 'SFEOH', 'SFALD2', 'SFMEK', 'SFCH2O', 'SFC2H6', 'SFC3H8', - 'SFALK4', 'SFPRPE', 'SFBENZ', 'SFTOLU', 'SFXYLE', - 'SFNO', 'SFACTA', 'SFDMS', 'SFMEK', 'SFSO2', 'SFNH3', - 'SFISOP', 'SFMTPA', 'SFMOH', 'SFACET', 'SFCO', - 'MEG_ISOP', 'MEG_MOH', 'MEG_EOH', 'MEG_CH2O', 'MEG_ALD2', 'MEG_ACTA', - 'MEG_ACET', 'MEG_HCOOH', 'MEG_HCN', 'MEG_CO', 'MEG_C2H6', 'MEG_C2H4', - 'MEG_C3H8', 'MEG_ALK4', 'MEG_PRPE', 'MEG_TOLU', 'MEG_LIMO', 'MEG_MTPA', - 'MEG_MTPO', 'Dso4_a1CHM', 'Dso4_a2CHM', 'Dso4_a3CHM', 'DO3CHM', 'DCOCHM', - 'DHNO3CHM', 'DH2O2CHM', 'DO3CHM', 'DCOCHM', 'AQ_SO2', 'GS_SO2', 'SO2_CLXF', - 'MASS', 'ABSORB', - 'JvalO3O1D', 'Jval_NO2', 'Jval_PAN', 'Jval_H2O2', 'Jval_Cl2O2', - 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a1', - 'ncl_a2', 'ncl_a3', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', - 'soa1_a1', 'soa2_a1', 'soa3_a1', 'soa4_a1', 'soa5_a1', 'soa1_a2', 'soa2_a2', 'soa3_a2', - 'soa4_a2', 'soa5_a2', 'bc_c1', 'bc_c4', 'dst_c1', 'dst_c2', 'dst_c3', 'ncl_c1', 'ncl_c1', - 'ncl_c2', 'ncl_c3', 'pom_c1', 'pom_c4', 'so4_c1', 'so4_c2', 'so4_c3', 'soa1_c1', 'soa2_c1', - 'soa3_c1', 'soa4_c1', 'soa5_c1', 'soa1_c2', 'soa2_c2', 'soa3_c2', 'soa4_c2', 'soa5_c2', - 'bc_a1SFWET', 'num_a1','num_a2','num_a3','num_a4','num_c1','num_c2','num_c3','num_c4', - 'bc_a1SFWET', 'bc_a4SFWET', 'dst_a1SFWET', 'dst_a2SFWET', 'dst_a3SFWET', 'ncl_a1SFWET', - 'ncl_a2SFWET', 'ncl_a3SFWET', 'pom_a1SFWET', 'pom_a4SFWET', - 'so4_a1SFWET', 'so4_a2SFWET', 'so4_a3SFWET', 'soa1_a1SFWET', 'soa1_a2SFWET', - 'soa2_a1SFWET', 'soa2_a2SFWET', 'soa3_a1SFWET', 'soa3_a2SFWET', - 'soa4_a1SFWET', 'soa4_a2SFWET', 'soa5_a1SFWET', 'soa5_a2SFWET', 'bc_c1SFWET', - 'bc_c4SFWET', 'dst_c1SFWET', 'dst_c2SFWET', 'dst_c3SFWET', - 'ncl_c1SFWET', 'ncl_c2SFWET', 'ncl_c3SFWET', 'pom_c1SFWET', 'pom_c4SFWET', - 'so4_c1SFWET', 'so4_c2SFWET', 'so4_c3SFWET', 'soa1_c1SFWET', - 'soa1_c2SFWET', 'soa2_c1SFWET', 'soa2_c2SFWET', 'soa3_c1SFWET', 'soa3_c2SFWET', - 'soa4_c1SFWET', 'soa4_c2SFWET', 'soa5_c1SFWET', 'soa5_c2SFWET', - 'bc_a1DDF', 'bc_a4DDF', 'dst_a1DDF', 'dst_a2DDF', 'dst_a3DDF', 'ncl_a1DDF', - 'ncl_a2DDF', 'ncl_a3DDF', 'pom_a1DDF', - 'pom_a4DDF', 'so4_a1DDF', 'so4_a2DDF', 'so4_a3DDF', 'soa1_a1DDF', - 'soa1_a2DDF', 'soa2_a1DDF', 'soa2_a2DDF', 'soa3_a1DDF', - 'soa3_a2DDF', 'soa4_a1DDF', 'soa4_a2DDF', 'soa5_a1DDF', 'soa5_a2DDF', - 'bc_c1DDF', 'bc_c4DDF', 'dst_c1DDF', 'dst_c2DDF', - 'dst_c3DDF', 'ncl_c1DDF', 'ncl_c2DDF', 'ncl_c3DDF', 'pom_c1DDF', - 'pom_c4DDF', 'so4_c1DDF', 'so4_c2DDF', 'so4_c3DDF', - 'soa1_c1DDF', 'soa1_c2DDF', 'soa2_c1DDF', 'soa2_c2DDF', 'soa3_c1DDF', - 'soa3_c2DDF', 'soa4_c1DDF', 'soa4_c2DDF', 'soa5_c1DDF', - 'soa5_c2DDF', 'num_a1DDF', 'num_a2DDF', 'num_a3DDF', 'num_a4DDF', - 'num_c1DDF', 'num_c2DDF', 'num_c3DDF', 'num_c4DDF', - 'bc_a4_CLXF', 'pom_a4_CLXF', 'so4_a1_CLXF', 'so4_a2_CLXF', - 'num_a1_CLXF', 'num_a2_CLXF', 'SFbc_a4', 'SFpom_a4', 'SFso4_a1', - 'SFso4_a2', 'SFnum_a1', 'SFnum_a2', 'SFnum_a3', 'so4_a1_sfgaex1', - 'so4_a2_sfgaex1', 'so4_a3_sfgaex1', 'soa1_a1_sfgaex1', 'soa1_a2_sfgaex1', - 'soa2_a1_sfgaex1', 'soa2_a2_sfgaex1', 'soa3_a1_sfgaex1', 'soa3_a2_sfgaex1', - 'soa4_a1_sfgaex1', 'soa4_a2_sfgaex1', 'soa5_a1_sfgaex1', 'soa5_a2_sfgaex1', - 'so4_a2_sfnnuc1', 'so4_c1AQH2SO4', 'so4_c2AQH2SO4', 'so4_c3AQH2SO4', - 'so4_c1AQSO4', 'so4_c2AQSO4', 'so4_c3AQSO4', 'SFdst_a1', 'SFdst_a2', 'SFdst_a3', - 'SFncl_a1', 'SFncl_a2', 'SFncl_a3', - 'TMOCS', 'TMSO2', 'TMso4_a1', 'TMso4_a2', 'TMso4_a3', - 'BURDENDUSTdn', 'BURDENPOMdn', 'BURDENSO4dn', 'BURDENSOAdn', - 'BURDENSEASALTdn','BURDENBCdn', 'PM25' +'AREA', +'HEIGHT', +'T', +'U', +'V', +'Q', +'PS', +'CLOUD', +'TROPP_P', +'TROPP_T', +'TROPP_Z', +'DF_CO', +'DF_O3', +'DF_NO2', +'DF_SO4', +'DF_NIT', +'CT_O3', +'CT_OH', +'OHwgtByAirMassColumnFull', +'Chem_SO3AQ', +'Jval_Cl2O2', +'Jval_H2O2', +'Jval_NO2', +'Jval_PAN', +'JvalO3O3P', +'JvalO3O1D', +'LNO_COL_PROD', +'Prod_Ox', +'Prod_SO4', +'Prod_CO', +'Prod_H2O2', +'ProdCOfromCH4', +'ProdCOfromNMVOC', +'Loss_Ox', +'Loss_CH4', +'Loss_CO', +'LossOHbyCH4columnTrop', +'LossOHbyMCFcolumnTrop', +'LossHNO3onSeaSalt', +'ACET', +'ALD2', +'ALK4', +'BR', +'BRCL', +'BRNO3', +'BRO', +'BROX', +'BROY', +'C3H8', +'CH2O', +'CH3CL', +'CH4', +'CL', +'CLNO3', +'CLO', +'CLOX', +'CLOY', +'CO', +'DMS', +'EOH', +'H2O', +'H2O2', +'H2SO4', +'HO2', +'HOX', +'HBR', +'HCL', +'HOBR', +'HOCL', +'HNO3', +'HNO4', +'ISOP', +'MACR', +'MAP', +'MEK', +'MOH', +'MVK', +'N2O', +'N2O5', +'NHX', +'NIT', +'NO', +'NO2', +'NO3', +'NOX', +'NOY', +'O3', +'OH', +'PAN', +'PM25', +'RCHO', +'SALA', +'SALC', +'SO2', +'SO4', +'SOX', +'TOLU', +'bc_a1', +'bc_a4', +'dst_a1', +'dst_a2', +'dst_a3', +'num_a1', +'num_a2', +'num_a3', +'num_a4', +'pom_a1', +'pom_a4', +'so4_a1', +'so4_a2', +'so4_a3', - - diff --git a/bld/namelist_files/use_cases/sd_geoschem.xml b/bld/namelist_files/use_cases/sd_geoschem.xml index a398cc0a5e..04e5e60e5a 100644 --- a/bld/namelist_files/use_cases/sd_geoschem.xml +++ b/bld/namelist_files/use_cases/sd_geoschem.xml @@ -89,107 +89,118 @@ .false. .false. - - - 'AODDUST', 'AODDUST2', 'T', 'U', 'V', 'O3', 'OH', 'NO3', 'HO2', - 'LNO_COL_PROD', 'NO2_CLXF', 'SFNO', 'SFNH3', 'BRO', - 'CH3CL', 'CLO', 'CO2', 'HCL', 'HO2', 'HOCL', 'PHIS', 'Z3', - 'BENZ', 'C2H6', 'C3H8', 'CCL4', 'CFC11', 'CFC113', 'CFC12', - 'CH2O', 'CH3BR', 'CH3CCL3', 'ALD2', 'CH3CL', 'ACET', 'MOH', 'CH4', - 'CO', 'H2O2', 'HCFC22', 'HNO3', 'ISOP', 'MTPA', 'N2O', 'O3', - 'PAN', 'SO2', 'OH', 'ALK4', 'PRPE', 'BR', 'BRCL', 'BRO', 'BRNO3', - 'EOH', 'ETP', 'PRPE', 'RA3P', 'CCL4', 'H1211', 'H1301', - 'CFC11', 'CFC113', 'CFC114', 'CFC115', 'CFC12', 'CH2BR2', 'CH2O', - 'CH3BR', 'CH3CCL3', 'ALD2', 'CH3CL', 'MGLY', 'ACTA', 'MAP', 'MP', - 'CH4', 'CHBR3', 'CL', 'CL2', 'CL2O2', 'CLO', 'CLNO3', 'CO', - 'CO2', 'DMS', 'GLYC', 'GLYX', - 'H', 'H2', 'H2402', 'H2O2', 'HBR', 'HCFC141B', 'HCFC142B', 'HCFC22', - 'HCL', 'HNO3', 'HNO4', 'HOBR', 'HOCL', 'HONIT', 'HPALD1', 'HPALD2', 'HPALD3', - 'HPALD4', 'HAC', 'HC5A', 'IEPOXA', 'IEPOXB', 'IEPOXD', 'ISOP', 'IHN1', 'IHN2', 'IHN3', - 'IHN4', 'INO2B', 'INO2D', 'INPB', 'INPD', 'RIPA', 'RIPB', 'RIPC', 'RIPD', - 'MACR', 'MVKHP', 'MEK', 'MCRDH', 'MPAN', 'MVK', 'N', 'N2O', 'N2O5', 'ICN', - 'NH3', 'NH4', 'NO', 'NO2', 'NO3', 'PROPNN', 'OLND', 'OLNN', 'O', 'OCLO', - 'OCS', 'PAN', 'SO2', 'SO4', 'TOLU', 'XYLE', - 'R4O2', 'BRO2', 'ETO2', 'A3O2', 'MCO3', 'MO2', 'HO2', 'O1D', 'OH', - 'TSOA0', 'TSOA1', 'TSOA2', 'TSOA3', 'ASOAN', 'ASOA1', 'ASOA2', 'ASOA3', - 'SOAIE', 'SOAGX', - 'H2O', 'SAD_PSC', 'SAD_SULFC', 'SAD_TROP', 'SAD_AERO', 'REFF_AERO', - 'PDELDRY', 'RAD_PSC', 'RAD_SULFC', - 'HNO3_GAS', 'HNO3_STS', 'HNO3_NAT', 'NOX', 'NOY', 'CLOX', 'CLOY', - 'BROX', 'BROY', 'TCLY', 'TOTH', 'MASS', 'TBRY', 'HCL_GAS', - 'HCL_GAS', 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'ABSORB', - 'AODVISdn', 'AODdnMODE1', 'AODVISstdn', 'AODNIRstdn', - 'AODUVstdn', 'AODdnMODE2', 'AODdnMODE3', 'AODdnDUST1', 'AODdnDUST2', - 'AODdnDUST3', 'AODVISstdn', 'AODUVstdn', 'AODNIRstdn', - 'AODNIRstdn', 'AODVISdn', 'AODUVdn', 'EXTINCTdn', 'EXTxASYMdn', - 'EXTINCTNIRdn', 'EXTINCTUVdn', - 'WD_EOH', 'WD_ETP', 'WD_RA3P', 'WD_CH2O', 'WD_ALD2', - 'WD_MGLY', 'WD_ACTA', 'WD_MAP', 'WD_MOH', 'WD_MP', - 'WD_GLYC', 'WD_H2O2', 'WD_SO4', 'WD_HBR', 'WD_HCL', - 'WD_HNO3', 'WD_HOBR', 'WD_HOCL', 'WD_HONIT', 'WD_HAC', 'WD_IEPOXA', - 'WD_IEPOXB', 'WD_IEPOXD', 'WD_MVK', 'WD_NH3', 'WD_NH4', 'WD_SO2', - 'DF_EOH', 'DF_ETP', 'DF_RA3P', 'DF_CH2O', 'DF_ALD2', 'DF_ACET', - 'DF_MGLY', 'DF_ACTA', 'DF_MAP', 'DF_MOH', 'DF_MP', 'DF_CO', - 'DF_GLYC', 'DF_H2O2', 'DF_SO4', 'DF_HNO3', 'DF_HNO4', - 'DF_HONIT', 'DF_HPALD1', 'DF_HPALD2', 'DF_HPALD3', 'DF_HPALD4', - 'DF_HAC', 'DF_IEPOXA', 'DF_IEPOXB', 'DF_IEPOXD', - 'DF_MPAN', 'DF_NH3', 'DF_NH4', 'DF_NO', - 'DF_NO2', 'DF_O3', 'DF_PAN', 'DF_SO2', - 'SO2_CLXF', 'SO2_XFRC', - 'CO_CLXF', 'NO2_CLXF', 'LNO_PROD', 'LNO_COL_PROD', - 'SFEOH', 'SFALD2', 'SFMEK', 'SFCH2O', 'SFC2H6', 'SFC3H8', - 'SFALK4', 'SFPRPE', 'SFBENZ', 'SFTOLU', 'SFXYLE', - 'SFNO', 'SFACTA', 'SFDMS', 'SFMEK', 'SFSO2', 'SFNH3', - 'SFISOP', 'SFMTPA', 'SFMOH', 'SFACET', 'SFCO', - 'MEG_ISOP', 'MEG_MOH', 'MEG_EOH', 'MEG_CH2O', 'MEG_ALD2', 'MEG_ACTA', - 'MEG_ACET', 'MEG_HCOOH', 'MEG_HCN', 'MEG_CO', 'MEG_C2H6', 'MEG_C2H4', - 'MEG_C3H8', 'MEG_ALK4', 'MEG_PRPE', 'MEG_TOLU', 'MEG_LIMO', 'MEG_MTPA', - 'MEG_MTPO', 'Dso4_a1CHM', 'Dso4_a2CHM', 'Dso4_a3CHM', 'DO3CHM', 'DCOCHM', - 'DHNO3CHM', 'DH2O2CHM', 'DO3CHM', 'DCOCHM', 'AQ_SO2', 'GS_SO2', 'SO2_CLXF', - 'MASS', 'ABSORB', - 'JvalO3O1D', 'Jval_NO2', 'Jval_PAN', 'Jval_H2O2', 'Jval_Cl2O2', - 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a1', - 'ncl_a2', 'ncl_a3', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', - 'soa1_a1', 'soa2_a1', 'soa3_a1', 'soa4_a1', 'soa5_a1', 'soa1_a2', 'soa2_a2', 'soa3_a2', - 'soa4_a2', 'soa5_a2', 'bc_c1', 'bc_c4', 'dst_c1', 'dst_c2', 'dst_c3', 'ncl_c1', 'ncl_c1', - 'ncl_c2', 'ncl_c3', 'pom_c1', 'pom_c4', 'so4_c1', 'so4_c2', 'so4_c3', 'soa1_c1', 'soa2_c1', - 'soa3_c1', 'soa4_c1', 'soa5_c1', 'soa1_c2', 'soa2_c2', 'soa3_c2', 'soa4_c2', 'soa5_c2', - 'bc_a1SFWET', 'num_a1','num_a2','num_a3','num_a4','num_c1','num_c2','num_c3','num_c4', - 'bc_a1SFWET', 'bc_a4SFWET', 'dst_a1SFWET', 'dst_a2SFWET', 'dst_a3SFWET', 'ncl_a1SFWET', - 'ncl_a2SFWET', 'ncl_a3SFWET', 'pom_a1SFWET', 'pom_a4SFWET', - 'so4_a1SFWET', 'so4_a2SFWET', 'so4_a3SFWET', 'soa1_a1SFWET', 'soa1_a2SFWET', - 'soa2_a1SFWET', 'soa2_a2SFWET', 'soa3_a1SFWET', 'soa3_a2SFWET', - 'soa4_a1SFWET', 'soa4_a2SFWET', 'soa5_a1SFWET', 'soa5_a2SFWET', 'bc_c1SFWET', - 'bc_c4SFWET', 'dst_c1SFWET', 'dst_c2SFWET', 'dst_c3SFWET', - 'ncl_c1SFWET', 'ncl_c2SFWET', 'ncl_c3SFWET', 'pom_c1SFWET', 'pom_c4SFWET', - 'so4_c1SFWET', 'so4_c2SFWET', 'so4_c3SFWET', 'soa1_c1SFWET', - 'soa1_c2SFWET', 'soa2_c1SFWET', 'soa2_c2SFWET', 'soa3_c1SFWET', 'soa3_c2SFWET', - 'soa4_c1SFWET', 'soa4_c2SFWET', 'soa5_c1SFWET', 'soa5_c2SFWET', - 'bc_a1DDF', 'bc_a4DDF', 'dst_a1DDF', 'dst_a2DDF', 'dst_a3DDF', 'ncl_a1DDF', - 'ncl_a2DDF', 'ncl_a3DDF', 'pom_a1DDF', - 'pom_a4DDF', 'so4_a1DDF', 'so4_a2DDF', 'so4_a3DDF', 'soa1_a1DDF', - 'soa1_a2DDF', 'soa2_a1DDF', 'soa2_a2DDF', 'soa3_a1DDF', - 'soa3_a2DDF', 'soa4_a1DDF', 'soa4_a2DDF', 'soa5_a1DDF', 'soa5_a2DDF', - 'bc_c1DDF', 'bc_c4DDF', 'dst_c1DDF', 'dst_c2DDF', - 'dst_c3DDF', 'ncl_c1DDF', 'ncl_c2DDF', 'ncl_c3DDF', 'pom_c1DDF', - 'pom_c4DDF', 'so4_c1DDF', 'so4_c2DDF', 'so4_c3DDF', - 'soa1_c1DDF', 'soa1_c2DDF', 'soa2_c1DDF', 'soa2_c2DDF', 'soa3_c1DDF', - 'soa3_c2DDF', 'soa4_c1DDF', 'soa4_c2DDF', 'soa5_c1DDF', - 'soa5_c2DDF', 'num_a1DDF', 'num_a2DDF', 'num_a3DDF', 'num_a4DDF', - 'num_c1DDF', 'num_c2DDF', 'num_c3DDF', 'num_c4DDF', - 'bc_a4_CLXF', 'pom_a4_CLXF', 'so4_a1_CLXF', 'so4_a2_CLXF', - 'num_a1_CLXF', 'num_a2_CLXF', 'SFbc_a4', 'SFpom_a4', 'SFso4_a1', - 'SFso4_a2', 'SFnum_a1', 'SFnum_a2', 'SFnum_a3', 'so4_a1_sfgaex1', - 'so4_a2_sfgaex1', 'so4_a3_sfgaex1', 'soa1_a1_sfgaex1', 'soa1_a2_sfgaex1', - 'soa2_a1_sfgaex1', 'soa2_a2_sfgaex1', 'soa3_a1_sfgaex1', 'soa3_a2_sfgaex1', - 'soa4_a1_sfgaex1', 'soa4_a2_sfgaex1', 'soa5_a1_sfgaex1', 'soa5_a2_sfgaex1', - 'so4_a2_sfnnuc1', 'so4_c1AQH2SO4', 'so4_c2AQH2SO4', 'so4_c3AQH2SO4', - 'so4_c1AQSO4', 'so4_c2AQSO4', 'so4_c3AQSO4', 'SFdst_a1', 'SFdst_a2', 'SFdst_a3', - 'SFncl_a1', 'SFncl_a2', 'SFncl_a3', - 'TMOCS', 'TMSO2', 'TMso4_a1', 'TMso4_a2', 'TMso4_a3', - 'BURDENDUSTdn', 'BURDENPOMdn', 'BURDENSO4dn', 'BURDENSOAdn', - 'BURDENSEASALTdn','BURDENBCdn', 'PM25' +'AREA', +'HEIGHT', +'T', +'U', +'V', +'Q', +'PS', +'CLOUD', +'TROPP_P', +'TROPP_T', +'TROPP_Z', +'DF_CO', +'DF_O3', +'DF_NO2', +'DF_SO4', +'DF_NIT', +'CT_O3', +'CT_OH', +'OHwgtByAirMassColumnFull', +'Chem_SO3AQ', +'Jval_Cl2O2', +'Jval_H2O2', +'Jval_NO2', +'Jval_PAN', +'JvalO3O3P', +'JvalO3O1D', +'LNO_COL_PROD', +'Prod_Ox', +'Prod_SO4', +'Prod_CO', +'Prod_H2O2', +'ProdCOfromCH4', +'ProdCOfromNMVOC', +'Loss_Ox', +'Loss_CH4', +'Loss_CO', +'LossOHbyCH4columnTrop', +'LossOHbyMCFcolumnTrop', +'LossHNO3onSeaSalt', +'ACET', +'ALD2', +'ALK4', +'BR', +'BRCL', +'BRNO3', +'BRO', +'BROX', +'BROY', +'C3H8', +'CH2O', +'CH3CL', +'CH4', +'CL', +'CLNO3', +'CLO', +'CLOX', +'CLOY', +'CO', +'DMS', +'EOH', +'H2O', +'H2O2', +'H2SO4', +'HO2', +'HOX', +'HBR', +'HCL', +'HOBR', +'HOCL', +'HNO3', +'HNO4', +'ISOP', +'MACR', +'MAP', +'MEK', +'MOH', +'MVK', +'N2O', +'N2O5', +'NHX', +'NIT', +'NO', +'NO2', +'NO3', +'NOX', +'NOY', +'O3', +'OH', +'PAN', +'PM25', +'RCHO', +'SALA', +'SALC', +'SO2', +'SO4', +'SOX', +'TOLU', +'bc_a1', +'bc_a4', +'dst_a1', +'dst_a2', +'dst_a3', +'num_a1', +'num_a2', +'num_a3', +'num_a4', +'pom_a1', +'pom_a4', +'so4_a1', +'so4_a2', +'so4_a3', From f9de91643febc094af55578bded6f6aae3ce5efd Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Thu, 12 Jan 2023 10:19:32 -0700 Subject: [PATCH 087/291] Update cam_physics_mesh defaults for HEMCO Signed-off-by: Lizzie Lundgren --- bld/namelist_files/namelist_defaults_cam.xml | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/bld/namelist_files/namelist_defaults_cam.xml b/bld/namelist_files/namelist_defaults_cam.xml index 34c67a5fd7..12b2bd0290 100644 --- a/bld/namelist_files/namelist_defaults_cam.xml +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -779,8 +779,9 @@ atm/cam/coords/ne16np4_esmf_c210305.nc atm/cam/coords/ne30np4_esmf_c210305.nc atm/cam/coords/ne30pg3_esmf_20200428.nc -atm/cam/coords/fv0.9x1.25_esmf_141008.nc' -atm/cam/coords/fv1.9x2.5_esmf_141008.nc' +atm/cam/coords/fv0.9x1.25_esmf_c210305.nc +atm/cam/coords/fv1.9x2.5_esmf_200428.nc +atm/cam/coords/ne30np4_esmf_c210305.nc 1.00D0 From 0d98d570a6769294e82dc9f566ba78b869cdcfeb Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Fri, 20 Jan 2023 14:01:20 -0500 Subject: [PATCH 088/291] Draft commit to support HEMCO_CESM v1.1.0. - Only emissions in extfrc_lst (in mo_sim_dat) will have 3-D emissions now, as only these will have a 3-D pbuf available to save memory. This is accounted for in cesmgc_emissions_mod.F90. - The list of species with 3-D emissions in GEOS-Chem are now listed in mo_sim_dat.F90. - The number of species with 3-D emissions (length of extfrc_lst) is now specified in extcnt in chem_mods.F90. This is a preliminary commit. Further updates are needed to update the HEMCO_CESM external to the appropriate version, as well as moving up to HEMCO 3.6.0. --- .../geoschem/cesmgc_emissions_mod.F90 | 41 +++++++++++++++---- src/chemistry/geoschem/chem_mods.F90 | 2 +- src/chemistry/geoschem/mo_sim_dat.F90 | 20 ++++++++- 3 files changed, 52 insertions(+), 11 deletions(-) diff --git a/src/chemistry/geoschem/cesmgc_emissions_mod.F90 b/src/chemistry/geoschem/cesmgc_emissions_mod.F90 index 3b4eaf35ad..4ab4304cce 100644 --- a/src/chemistry/geoschem/cesmgc_emissions_mod.F90 +++ b/src/chemistry/geoschem/cesmgc_emissions_mod.F90 @@ -52,9 +52,12 @@ MODULE CESMGC_Emissions_Mod INTEGER, ALLOCATABLE :: megan_indices_map(:) REAL(r8), ALLOCATABLE :: megan_wght_factors(:) + ! Cache for is_extfrc? + LOGICAL :: pcnst_is_extfrc(iFirstCnst:pcnst) ! no idea why the indexing is not 1:gas_pcnst or why iFirstCnst can be < 0 ! ! !REVISION HISTORY: ! 07 Oct 2020 - T. M. Fritz - Initial version +! 20 Jan 2023 - H.P. Lin - Update for 2D/3D pbuf switches !EOP !------------------------------------------------------------------------------ !BOC @@ -80,7 +83,7 @@ SUBROUTINE CESMGC_Emissions_Init( lght_no_prd_factor ) USE PHYSICS_TYPES, ONLY : physics_state USE CONSTITUENTS, ONLY : cnst_get_ind USE PHYS_CONTROL, ONLY : phys_getopts - USE MO_CHEM_UTLS, ONLY : get_spc_ndx + USE MO_CHEM_UTLS, ONLY : get_spc_ndx, get_extfrc_ndx USE CAM_HISTORY, ONLY : addfld, add_default, horiz_only USE MO_LIGHTNING, ONLY : lightning_inti USE FIRE_EMISSIONS, ONLY : fire_emissions_init @@ -244,6 +247,12 @@ SUBROUTINE CESMGC_Emissions_Init( lght_no_prd_factor ) !----------------------------------------------------------------------- CALL fire_emissions_init() + ! Initialize pcnst_is_extfrc cache to avoid lengthy lookups in future timesteps + ! on the get_extfrc_ndx routine. (hplin 1/20/23) + do n = iFirstCnst, pcnst + pcnst_is_extfrc(n) = (get_extfrc_ndx(trim(cnst_name(n))) > 0) + enddo + END SUBROUTINE CESMGC_Emissions_Init !EOC !------------------------------------------------------------------------------ @@ -368,16 +377,32 @@ SUBROUTINE CESMGC_Emissions_Calc( state, hco_pbuf2d, State_Met, cam_in, eflx, iS ELSE ! This is already in chunk, retrieve it pbuf_chnk => pbuf_get_chunk(hco_pbuf2d, LCHNK) - CALL pbuf_get_field(pbuf_chnk, tmpIdx, pbuf_ik) - IF ( .NOT. ASSOCIATED(pbuf_ik) ) THEN ! Sanity check - CALL ENDRUN("CESMGC_Emissions_Calc: FATAL - tmpIdx > 0 but pbuf_ik not associated") - ENDIF + ! Check if we need to get 3-D, or 2-D data + IF (pcnst_is_extfrc(N)) THEN + CALL pbuf_get_field(pbuf_chnk, tmpIdx, pbuf_ik) + + IF ( .NOT. ASSOCIATED(pbuf_ik) ) THEN ! Sanity check + CALL ENDRUN("CESMGC_Emissions_Calc: FATAL - tmpIdx > 0 but pbuf_ik not associated (E-1)") + ENDIF + + eflx(1:nY,:nZ,N) = pbuf_ik(1:nY,:nZ) - eflx(1:nY,:nZ,N) = pbuf_ik(1:nY,:nZ) + ! Reset pointers + pbuf_ik => NULL() + ELSE ! 2-D + CALL pbuf_get_field(pbuf_chnk, tmpIdx, pbuf_i) + + IF ( .NOT. ASSOCIATED(pbuf_i) ) THEN ! Sanity check + CALL ENDRUN("CESMGC_Emissions_Calc: FATAL - tmpIdx > 0 but pbuf_i not associated (E-2)") + ENDIF + + eflx(1:nY,:nZ,N) = pbuf_i(1:nY) + + ! Reset pointers + pbuf_i => NULL() + ENDIF - ! Reset pointers - pbuf_ik => NULL() pbuf_chnk => NULL() !IF ( MINVAL(eflx(:nY,:nZ,N)) < 0.0e+00_r8 ) THEN diff --git a/src/chemistry/geoschem/chem_mods.F90 b/src/chemistry/geoschem/chem_mods.F90 index bbd21c9b2b..c19edcfb37 100644 --- a/src/chemistry/geoschem/chem_mods.F90 +++ b/src/chemistry/geoschem/chem_mods.F90 @@ -69,7 +69,7 @@ module chem_mods relcnt = 0, & ! number of relationship species grpcnt = 0, & ! number of group members nzcnt = 824, & ! number of non-zero matrix entries - extcnt = 0, & ! number of species with external forcing + extcnt = 34, & ! number of species with external forcing, aka 3-D emissions clscnt1 = 8, & ! number of species in explicit class clscnt2 = 0, & ! number of species in hov class clscnt3 = 0, & ! number of species in ebi class diff --git a/src/chemistry/geoschem/mo_sim_dat.F90 b/src/chemistry/geoschem/mo_sim_dat.F90 index 5bd6d5a199..13f5740645 100644 --- a/src/chemistry/geoschem/mo_sim_dat.F90 +++ b/src/chemistry/geoschem/mo_sim_dat.F90 @@ -237,9 +237,25 @@ subroutine set_sim_dat 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, & 44.010000_r8, 33.0100000_r8, 17.0100000_r8 /) - extfrc_lst(: 1) = (/ ' ' /) + extfrc_lst(: 34) = (/ 'NO ', 'CO ', 'SO2 ', 'SO4 ', & + 'NH3 ', 'ACET ', 'ALD2 ', 'ALK4 ', & + 'C2H6 ', 'C3H8 ', 'CH2O ', 'PRPE ', & + 'MACR ', 'RCHO ', 'BCPI ', 'OCPI ', & + 'HNO2 ', 'NO2 ', 'so4_a1 ', 'num_a1 ', & + 'H2O ', 'bc_a4 ', 'pom_a4 ', 'num_a4 ', & + 'MEK ', 'POG1 ', 'POG2 ', 'MTPA ', & + 'BENZ ', 'TOLU ', 'XYLE ', 'NAP ', & + 'EOH ', 'MOH ' /) - frc_from_dataset(: 1) = (/ .false. /) + frc_from_dataset(: 34) = (/ .false., .false., .false., .false., & + .false., .false., .false., .false., & + .false., .false., .false., .false., & + .false., .false., .false., .false., & + .false., .false., .false., .false., & + .false., .false., .false., .false., & + .false., .false., .false., .false., & + .false., .false., .false., .false., & + .false., .false. /) ! crb_mass(:221) = (/ 60.055000_r8, 60.055000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & ! 180.165000_r8, 72.066000_r8, 72.066000_r8, 72.066000_r8, 60.055000_r8, & From 60861dca9d4c380b42605970baf4ce47a85e5be5 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Thu, 9 Feb 2023 14:11:54 -0500 Subject: [PATCH 089/291] Tag to upstream HEMCO-CESM 1.1.0 and HEMCO 3.6.0 --- Externals_CAM.cfg | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Externals_CAM.cfg b/Externals_CAM.cfg index 5cbbf4cbfc..d20ea57a7e 100644 --- a/Externals_CAM.cfg +++ b/Externals_CAM.cfg @@ -84,7 +84,7 @@ local_path = src/chemistry/geoschem/geoschem_src required = True [hemco] -tag = hemco-cesm1_0_hemco3_5_1 +tag = hemco-cesm1_1_0_hemco3_6_0 protocol = git repo_url = https://github.com/ESCOMP/HEMCO_CESM.git local_path = src/hemco From 99e30ec788fc125928829c8f0951ed57253d2b6e Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Mon, 13 Feb 2023 14:25:06 -0500 Subject: [PATCH 090/291] Fix automatic array indexing --- src/chemistry/geoschem/cesmgc_emissions_mod.F90 | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/src/chemistry/geoschem/cesmgc_emissions_mod.F90 b/src/chemistry/geoschem/cesmgc_emissions_mod.F90 index 4ab4304cce..5995014efb 100644 --- a/src/chemistry/geoschem/cesmgc_emissions_mod.F90 +++ b/src/chemistry/geoschem/cesmgc_emissions_mod.F90 @@ -53,7 +53,7 @@ MODULE CESMGC_Emissions_Mod REAL(r8), ALLOCATABLE :: megan_wght_factors(:) ! Cache for is_extfrc? - LOGICAL :: pcnst_is_extfrc(iFirstCnst:pcnst) ! no idea why the indexing is not 1:gas_pcnst or why iFirstCnst can be < 0 + LOGICAL, ALLOCATABLE :: pcnst_is_extfrc(:) ! no idea why the indexing is not 1:gas_pcnst or why iFirstCnst can be < 0 ! ! !REVISION HISTORY: ! 07 Oct 2020 - T. M. Fritz - Initial version @@ -249,8 +249,11 @@ SUBROUTINE CESMGC_Emissions_Init( lght_no_prd_factor ) ! Initialize pcnst_is_extfrc cache to avoid lengthy lookups in future timesteps ! on the get_extfrc_ndx routine. (hplin 1/20/23) + if(.not. allocated(pcnst_is_extfrc)) then + allocate(pcnst_is_extfrc(pcnst - iFirstCnst + 1)) + endif do n = iFirstCnst, pcnst - pcnst_is_extfrc(n) = (get_extfrc_ndx(trim(cnst_name(n))) > 0) + pcnst_is_extfrc(n - iFirstCnst + 1) = (get_extfrc_ndx(trim(cnst_name(n))) > 0) enddo END SUBROUTINE CESMGC_Emissions_Init @@ -379,7 +382,7 @@ SUBROUTINE CESMGC_Emissions_Calc( state, hco_pbuf2d, State_Met, cam_in, eflx, iS pbuf_chnk => pbuf_get_chunk(hco_pbuf2d, LCHNK) ! Check if we need to get 3-D, or 2-D data - IF (pcnst_is_extfrc(N)) THEN + IF (pcnst_is_extfrc(N - iFirstCnst + 1)) THEN CALL pbuf_get_field(pbuf_chnk, tmpIdx, pbuf_ik) IF ( .NOT. ASSOCIATED(pbuf_ik) ) THEN ! Sanity check @@ -397,7 +400,8 @@ SUBROUTINE CESMGC_Emissions_Calc( state, hco_pbuf2d, State_Met, cam_in, eflx, iS CALL ENDRUN("CESMGC_Emissions_Calc: FATAL - tmpIdx > 0 but pbuf_i not associated (E-2)") ENDIF - eflx(1:nY,:nZ,N) = pbuf_i(1:nY) + ! note: write to nZ level here as this is surface + eflx(1:nY,nZ,N) = pbuf_i(1:nY) ! Reset pointers pbuf_i => NULL() From fb7acecad6906a187f19d380096902d92efbe76a Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Thu, 2 Mar 2023 12:08:34 -0500 Subject: [PATCH 091/291] Updates H2SO4 production rate passed to MAM4 sulfate nucleation to use actual H2SO4 production rate computed by KPP in GEOS-Chem (SO2 + OH). This commit requires GEOS-Chem 14.1.1. --- src/chemistry/geoschem/chemistry.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/chemistry/geoschem/chemistry.F90 b/src/chemistry/geoschem/chemistry.F90 index 0ec367f543..bbf0687e81 100644 --- a/src/chemistry/geoschem/chemistry.F90 +++ b/src/chemistry/geoschem/chemistry.F90 @@ -3867,8 +3867,8 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) ENDIF ! Amount of chemically-produced H2SO4 (mol/mol) - del_h2so4_gasprod(:nY,:nZ) = vmr1(:nY,:nZ,l_H2SO4) & - - vmr0(:nY,:nZ,l_H2SO4) + ! This is archived from fullchem_mod.F90 using SO2 + OH rate from KPP (hplin, 1/25/23) + del_h2so4_gasprod(:nY,:nZ) = State_Chm(LCHNK)%H2SO4_PRDR(1,:nY,nZ:1:-1) call aero_model_gasaerexch( loffset = iFirstCnst - 1, & ncol = NCOL, & From c5f6792faeb80281d00ab3256f730fea6d4ffe3b Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Thu, 2 Mar 2023 12:17:31 -0500 Subject: [PATCH 092/291] Use online CLM albedo for CESM-GC simulations instead of offline albedo from archive --- src/chemistry/geoschem/chemistry.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/chemistry/geoschem/chemistry.F90 b/src/chemistry/geoschem/chemistry.F90 index 0ec367f543..7c999d079b 100644 --- a/src/chemistry/geoschem/chemistry.F90 +++ b/src/chemistry/geoschem/chemistry.F90 @@ -1167,7 +1167,7 @@ subroutine chem_init(phys_state, pbuf2d) ! onlineAlbedo -> True (use CLM albedo) ! -> False (read monthly-mean albedo from HEMCO) - Input_Opt%onlineAlbedo = .False. + Input_Opt%onlineAlbedo = .true. ! applyQtend: apply tendencies of water vapor to specific humidity Input_Opt%applyQtend = .False. From f501dfba11305d94b7e9d434298d3a02a4338083 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Thu, 2 Mar 2023 13:41:38 -0500 Subject: [PATCH 093/291] Set rxt_tag_cnt to 0 in GEOS-Chem as feature is unused --- src/chemistry/geoschem/chem_mods.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/chemistry/geoschem/chem_mods.F90 b/src/chemistry/geoschem/chem_mods.F90 index bbd21c9b2b..e45464731b 100644 --- a/src/chemistry/geoschem/chem_mods.F90 +++ b/src/chemistry/geoschem/chem_mods.F90 @@ -78,7 +78,7 @@ module chem_mods indexm = 1, & ! index of total atm density in invariant array indexh2o = 4, & ! index of water vapor density clsze = 1, & ! loop length for implicit chemistry - rxt_tag_cnt = 95, & + rxt_tag_cnt = 0, & ! number of tagged reactions (unused in GEOS-Chem) enthalpy_cnt = 0, & nslvd = 86 ! number of short-lived (non-advected) species integer :: clscnt(5) = 0 From 9126efbe78796ea7675ab76a452d39ad10809ed1 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Thu, 2 Mar 2023 15:19:43 -0500 Subject: [PATCH 094/291] Update cesmgc_diag_mod for moved ucx_mod module variables --- src/chemistry/geoschem/cesmgc_diag_mod.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/chemistry/geoschem/cesmgc_diag_mod.F90 b/src/chemistry/geoschem/cesmgc_diag_mod.F90 index b689ef3bb5..3db38020ec 100644 --- a/src/chemistry/geoschem/cesmgc_diag_mod.F90 +++ b/src/chemistry/geoschem/cesmgc_diag_mod.F90 @@ -890,7 +890,7 @@ SUBROUTINE CESMGC_Diag_Calc( Input_Opt, State_Chm, State_Diag, & ! !INPUT PARAMETERS: ! TYPE(OptInput), INTENT(IN) :: Input_Opt ! Input options - TYPE(ChmState), INTENT(IN) :: State_Chm ! Chemistry State object + TYPE(ChmState), INTENT(INOUT) :: State_Chm ! Chemistry State object TYPE(DgnState), INTENT(IN) :: State_Diag ! Diag State object TYPE(GrdState), INTENT(IN) :: State_Grid ! Grid State object TYPE(MetState), INTENT(IN) :: State_Met ! Meteorology State object @@ -1250,7 +1250,7 @@ SUBROUTINE CESMGC_Diag_Calc( Input_Opt, State_Chm, State_Diag, & radTmp = 0.0e+00_r8 DO J = 1, nY DO L = 1, nZ - CALL GET_STRAT_OPT(1,J,L,1,RAER,REFF,SADSTRAT,XSASTRAT) + CALL GET_STRAT_OPT(State_Chm,1,J,L,1,RAER,REFF,SADSTRAT,XSASTRAT) outTmp(J,nZ+1-L) = SADSTRAT radTmp(J,nZ+1-L) = RAER ENDDO @@ -1263,7 +1263,7 @@ SUBROUTINE CESMGC_Diag_Calc( Input_Opt, State_Chm, State_Diag, & outTmp = 0.0e+00_r8 DO J = 1, nY DO L = 1, nZ - CALL GET_STRAT_OPT(1,J,L,2,RAER,REFF,SADSTRAT,XSASTRAT) + CALL GET_STRAT_OPT(State_Chm,1,J,L,2,RAER,REFF,SADSTRAT,XSASTRAT) outTmp(J,nZ+1-L) = SADSTRAT radTmp(J,nZ+1-L) = RAER ENDDO From 37b34b1dd4d731d3db6ce4edf00f05c2c85fe6c8 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Thu, 2 Mar 2023 15:22:58 -0500 Subject: [PATCH 095/291] Remove LWI; remove cleanup_ucx --- src/chemistry/geoschem/chemistry.F90 | 8 -------- 1 file changed, 8 deletions(-) diff --git a/src/chemistry/geoschem/chemistry.F90 b/src/chemistry/geoschem/chemistry.F90 index 0ec367f543..684d1ffba1 100644 --- a/src/chemistry/geoschem/chemistry.F90 +++ b/src/chemistry/geoschem/chemistry.F90 @@ -3204,12 +3204,6 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) IF ( iMaxLoc(1) == 3 ) iMaxLoc(1) = 0 ! reset ocean to 0 - ! Field : LWI - ! Description: Land/water indices - ! Unit : - - ! Dimensions : nX, nY - State_Met(LCHNK)%LWI(1,J) = FLOAT( iMaxLoc(1) ) - IF ( iMaxLoc(1) == 0 ) THEN State_Met(LCHNK)%isLand(1,J) = .False. State_Met(LCHNK)%isWater(1,J) = .True. @@ -4272,7 +4266,6 @@ subroutine chem_final use State_Met_Mod, only : Cleanup_State_Met use Error_Mod, only : Cleanup_Error use Fullchem_Mod, only : Cleanup_FullChem - use UCX_Mod, only : Cleanup_UCX use Drydep_Mod, only : Cleanup_Drydep use Carbon_Mod, only : Cleanup_Carbon use Dust_Mod, only : Cleanup_Dust @@ -4300,7 +4293,6 @@ subroutine chem_final ! Finalize GEOS-Chem - CALL Cleanup_UCX CALL Cleanup_Aerosol CALL Cleanup_Carbon CALL Cleanup_Drydep From 0fadb7bd2e5985a0f3978e462ca8a1c2fdab517e Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Thu, 2 Mar 2023 18:12:18 -0500 Subject: [PATCH 096/291] Update to upstream HEMCO-CESM 1.1.1 and HEMCO 3.6.2 --- Externals_CAM.cfg | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Externals_CAM.cfg b/Externals_CAM.cfg index d20ea57a7e..857b1c7058 100644 --- a/Externals_CAM.cfg +++ b/Externals_CAM.cfg @@ -84,7 +84,7 @@ local_path = src/chemistry/geoschem/geoschem_src required = True [hemco] -tag = hemco-cesm1_1_0_hemco3_6_0 +tag = hemco-cesm1_1_1_hemco3_6_2 protocol = git repo_url = https://github.com/ESCOMP/HEMCO_CESM.git local_path = src/hemco From 9af0d172a5c3feaaf3efc7b67ae4ab8697f02e53 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Fri, 3 Mar 2023 14:44:06 -0500 Subject: [PATCH 097/291] Also run Init_UCX per State_Chm, not just once --- src/chemistry/geoschem/chemistry.F90 | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/src/chemistry/geoschem/chemistry.F90 b/src/chemistry/geoschem/chemistry.F90 index 684d1ffba1..c2eba8e780 100644 --- a/src/chemistry/geoschem/chemistry.F90 +++ b/src/chemistry/geoschem/chemistry.F90 @@ -1609,11 +1609,17 @@ subroutine chem_init(phys_state, pbuf2d) ENDIF ENDIF + ! hplin 3/3/23: note, since we moved UCX module variables to + ! individual State_Chm variables, Init_UCX has to be called + ! for all chunks (all State_Chm) to properly initialize all + ! variables. IF ( Input_Opt%LChem ) THEN - CALL Init_UCX( Input_Opt = Input_Opt, & - State_Chm = State_Chm(BEGCHUNK), & - State_Diag = State_Diag(BEGCHUNK), & - State_Grid = maxGrid ) + DO I = BEGCHUNK, ENDCHUNK + CALL Init_UCX( Input_Opt = Input_Opt, & + State_Chm = State_Chm(I), & + State_Diag = State_Diag(I), & + State_Grid = State_Grid(I) ) + ENDDO ENDIF IF ( Input_Opt%Linear_Chem ) THEN From a6a71d62a98359f56d9c3e9b47a0c0dc4696f86f Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Fri, 3 Mar 2023 18:52:57 -0500 Subject: [PATCH 098/291] Add comments on aerosol mapping code --- src/chemistry/geoschem/chemistry.F90 | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/src/chemistry/geoschem/chemistry.F90 b/src/chemistry/geoschem/chemistry.F90 index c2eba8e780..f9b07f810a 100644 --- a/src/chemistry/geoschem/chemistry.F90 +++ b/src/chemistry/geoschem/chemistry.F90 @@ -2278,6 +2278,27 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) ENDDO ! Compute ratios of bin to bulk mass + !------------------------------------------------------------------------------------------ + ! Notes for the indices used here (hplin 3/3/23): + ! + ! K = GEOS-Chem species index in State_Chm%Species(K). + ! P = constituent index for BULK lumped tracer in GEOS-Chem (BCPI, BCPO, DST1, DST4, SO4, SALA, SALC, OCPI, OCPO) + ! N = constituent index for MODAL tracer in MAM4 (bc_a1, bc_a4, ...) + ! each combination of species and mode is described by (SM, M) + ! SM = species (i.e., bc, dst, so4, ncl, pom) in mode M + ! M = mode number + ! constituent indices are used in state%q(column number,level number,constituent index) + ! chemical tracer index (NOT constituent index) is used in mo_sim_dat, e.g., adv_mass(tracer index) + ! + ! Mapping functions: maps from... ...to + ! mapCnst(constituent index) constituent index chemical tracer index + ! lmassptr_amode(SM, M) SM, M constituent index (modal) + ! map2GC(bulk constituent index) constituent index (bulk) GEOS-Chem species index (bulk) + ! map2MAM4(SM, M) SM, M (modal) constituent index (bulk) this is a N to 1 operation. + ! + ! Query functions: + ! xname_massptr(SM, M) SM, M NAME of modal aer (bc_a1, bc_a4, ...) + !------------------------------------------------------------------------------------------ binRatio = 0.0e+00_r8 DO M = 1, ntot_amode DO SM = 1, nspec_amode(M) From 5afb2934a8324ad0614dae2a891dde1e9908c1cc Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Mon, 6 Mar 2023 10:34:36 -0700 Subject: [PATCH 099/291] Change GEOS-Chem version tag to 14.1.1 Signed-off-by: Lizzie Lundgren --- Externals_CAM.cfg | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Externals_CAM.cfg b/Externals_CAM.cfg index 857b1c7058..b38b933ff1 100644 --- a/Externals_CAM.cfg +++ b/Externals_CAM.cfg @@ -77,7 +77,7 @@ hash = ff76a231 required = True [geoschem] -tag = 14.0.1 +tag = 14.1.1 protocol = git repo_url = https://github.com/geoschem/geos-chem.git local_path = src/chemistry/geoschem/geoschem_src From 1cb122379822256a5311d122ea453e7ef7babaa3 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Mon, 6 Mar 2023 11:12:27 -0700 Subject: [PATCH 100/291] Change names of GEOS-Chem diagnostic and emissions modules and subroutines The three GEOS-Chem modules for diagnostics and emissions are now prefixed with 'geoschem_' and contain submodules prefixed with 'GC_'. "Diag" is also expanded to "Diagnostics". Signed-off-by: Lizzie Lundgren --- src/chemistry/geoschem/chemistry.F90 | 56 +++++++-------- ...g_mod.F90 => geoschem_diagnostics_mod.F90} | 42 +++++------ ...ons_mod.F90 => geoschem_emissions_mod.F90} | 72 +++++++++---------- ...story_mod.F90 => geoschem_history_mod.F90} | 28 ++++---- 4 files changed, 99 insertions(+), 99 deletions(-) rename src/chemistry/geoschem/{cesmgc_diag_mod.F90 => geoschem_diagnostics_mod.F90} (98%) rename src/chemistry/geoschem/{cesmgc_emissions_mod.F90 => geoschem_emissions_mod.F90} (89%) rename src/chemistry/geoschem/{cesmgc_history_mod.F90 => geoschem_history_mod.F90} (98%) diff --git a/src/chemistry/geoschem/chemistry.F90 b/src/chemistry/geoschem/chemistry.F90 index f282c09811..c6d43ba2df 100644 --- a/src/chemistry/geoschem/chemistry.F90 +++ b/src/chemistry/geoschem/chemistry.F90 @@ -37,7 +37,7 @@ module chemistry !-------------------------------------------------------------------- ! GEOS-Chem History exports module !-------------------------------------------------------------------- - use CESMGC_History_Mod + use GeosChem_History_Mod !-------------------------------------------------------------------- ! CAM modules @@ -1012,8 +1012,8 @@ subroutine chem_init(phys_state, pbuf2d) use tracer_cnst, only : tracer_cnst_init use tracer_srcs, only : tracer_srcs_init - use CESMGC_Emissions_Mod, only : CESMGC_Emissions_Init - use CESMGC_Diag_Mod, only : CESMGC_Diag_Init + use GeosChem_Emissions_Mod, only : GC_Emissions_Init + use GeosChem_Diagnostics_Mod, only : GC_Diagnostics_Init TYPE(physics_state), INTENT(IN ) :: phys_state(BEGCHUNK:ENDCHUNK) TYPE(physics_buffer_desc), POINTER, INTENT(INOUT) :: pbuf2d(:,:) @@ -1408,7 +1408,7 @@ subroutine chem_init(phys_state, pbuf2d) ! within HistoryConfig to mimic the properties of GCHP. ! ! The above original implementation is similar to GC-Classic and WRF-GC, - ! and is used by cesmgc_diag_mod for lookups for certain diagnostic + ! and is used by geoschem_diagnostics_mod for lookups for certain diagnostic ! fields for compatibility with CAM-chem outputs. ! (hplin, 10/31/22) CALL HistoryExports_SetServices(am_I_Root = masterproc, & @@ -1688,12 +1688,12 @@ subroutine chem_init(phys_state, pbuf2d) ENDIF ! Initialize diagnostics interface - CALL CESMGC_Diag_Init( Input_Opt = Input_Opt, & - State_Chm = State_Chm(BEGCHUNK), & - State_Met = State_Met(BEGCHUNK) ) + CALL GC_Diagnostics_Init( Input_Opt = Input_Opt, & + State_Chm = State_Chm(BEGCHUNK), & + State_Met = State_Met(BEGCHUNK) ) ! Initialize emissions interface - CALL CESMGC_Emissions_Init( lght_no_prd_factor = lght_no_prd_factor ) + CALL GC_Emissions_Init( lght_no_prd_factor = lght_no_prd_factor ) hco_pbuf2d => pbuf2d @@ -1887,9 +1887,9 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) use Linear_Chem_Mod, only : TrID_GC, GC_Bry_TrID, NSCHEM use Linear_Chem_Mod, only : BrPtrDay, BrPtrNight, PLVEC, GMI_OH - use CESMGC_Emissions_Mod,only : CESMGC_Emissions_Calc - use CESMGC_Diag_Mod, only : CESMGC_Diag_Calc - use CESMGC_Diag_Mod, only : wetdep_name, wtrate_name + use GeosChem_Emissions_Mod, only : GC_Emissions_Calc + use GeosChem_Diagnostics_Mod, only : GC_Diagnostics_Calc + use GeosChem_Diagnostics_Mod, only : wetdep_name, wtrate_name use Tropopause, only : Tropopause_findChemTrop, Tropopause_Find use HCO_Interface_GC_Mod ! Utility routines for GC-HEMCO interface @@ -3644,12 +3644,12 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) ! Add surface emissions to cam_in !----------------------------------------------------------------------- - CALL CESMGC_Emissions_Calc( state = state, & - hco_pbuf2d = hco_pbuf2d, & - State_Met = State_Met(LCHNK), & - cam_in = cam_in, & - eflx = eflx, & - iStep = iStep ) + CALL GC_Emissions_Calc( state = state, & + hco_pbuf2d = hco_pbuf2d, & + State_Met = State_Met(LCHNK), & + cam_in = cam_in, & + eflx = eflx, & + iStep = iStep ) !----------------------------------------------------------------------- ! Add dry deposition flux @@ -4168,15 +4168,15 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) ptend%q(:,:,cQ) = ptend%q(:,:,cH2O) ENDIF - CALL CESMGC_Diag_Calc( Input_Opt = Input_Opt, & - State_Chm = State_Chm(LCHNK), & - State_Diag = State_Diag(LCHNK), & - State_Grid = State_Grid(LCHNK), & - State_Met = State_Met(LCHNK), & - cam_in = cam_in, & - state = state, & - mmr_tend = mmr_tend, & - LCHNK = LCHNK ) + CALL GC_Diagnostics_Calc( Input_Opt = Input_Opt, & + State_Chm = State_Chm(LCHNK), & + State_Diag = State_Diag(LCHNK), & + State_Grid = State_Grid(LCHNK), & + State_Met = State_Met(LCHNK), & + cam_in = cam_in, & + state = state, & + mmr_tend = mmr_tend, & + LCHNK = LCHNK ) CALL Set_Diagnostics_EndofTimestep( Input_Opt = Input_Opt, & State_Chm = State_Chm(LCHNK), & @@ -4310,7 +4310,7 @@ subroutine chem_final use Diag_Mod, only : Cleanup_Diag #endif - use CESMGC_Emissions_Mod, only: CESMGC_Emissions_Final + use GeosChem_Emissions_Mod, only: GC_Emissions_Final ! Local variables INTEGER :: I, RC @@ -4335,7 +4335,7 @@ subroutine chem_final CALL Cleanup_Sulfate CALL Cleanup_Linear_Chem - CALL CESMGC_Emissions_Final + CALL GC_Emissions_Final CALL Cleanup_CMN_FJX( RC ) IF ( RC /= GC_SUCCESS ) THEN diff --git a/src/chemistry/geoschem/cesmgc_diag_mod.F90 b/src/chemistry/geoschem/geoschem_diagnostics_mod.F90 similarity index 98% rename from src/chemistry/geoschem/cesmgc_diag_mod.F90 rename to src/chemistry/geoschem/geoschem_diagnostics_mod.F90 index 3db38020ec..1b729121f1 100644 --- a/src/chemistry/geoschem/cesmgc_diag_mod.F90 +++ b/src/chemistry/geoschem/geoschem_diagnostics_mod.F90 @@ -1,17 +1,17 @@ !------------------------------------------------------------------------------ -! "GEOS-Chem" chemistry diagnostics interface ! +! GEOS-Chem chemistry diagnostics interface ! !------------------------------------------------------------------------------ !BOP ! -! !MODULE: cesmgc_diag_mod.F90 +! !MODULE: geoschem_diagnostics_mod.F90 ! -! !DESCRIPTION: Module cesmgc\_diag\_mod contains routines which aim to +! !DESCRIPTION: Module geoschem\_diagnostics\_mod contains routines which aim to ! diagnose variables from GEOS-Chem !\\ !\\ ! !INTERFACE: ! -MODULE CESMGC_Diag_Mod +MODULE GeosChem_Diagnostics_Mod ! ! !USES: ! @@ -36,8 +36,8 @@ MODULE CESMGC_Diag_Mod ! ! !PUBLIC MEMBER FUNCTIONS: ! - PUBLIC :: CESMGC_Diag_Init - PUBLIC :: CESMGC_Diag_Calc + PUBLIC :: GC_Diagnostics_Init + PUBLIC :: GC_Diagnostics_Calc PUBLIC :: wetdep_name, wtrate_name CHARACTER(LEN=fieldname_len) :: srcnam(gas_pcnst) ! Names of source/sink tendencies @@ -137,15 +137,15 @@ MODULE CESMGC_Diag_Mod !------------------------------------------------------------------------------ !BOP ! -! !IROUTINE: cesmgc_diag_init +! !IROUTINE: gc_diagnostics_init ! -! !DESCRIPTION: Subroutine CESMGC\_Diag\_Init declares the variables to +! !DESCRIPTION: Subroutine GC\_Diagnostics\_Init declares the variables to ! diagnosethe !\\ !\\ ! !INTERFACE: ! - SUBROUTINE CESMGC_Diag_Init( Input_Opt, State_Chm, State_Met ) + SUBROUTINE GC_Diagnostics_Init( Input_Opt, State_Chm, State_Met ) ! ! !USES: ! @@ -220,7 +220,7 @@ SUBROUTINE CESMGC_Diag_Init( Input_Opt, State_Chm, State_Met ) TYPE(RegItem ), POINTER :: Item !================================================================= - ! CESMGC_Diag_Init begins here! + ! GC_Diagnostics_Init begins here! !================================================================= ! Initialize pointers @@ -845,22 +845,22 @@ SUBROUTINE CESMGC_Diag_Init( Input_Opt, State_Chm, State_Met ) Current => NULL() Item => NULL() - END SUBROUTINE CESMGC_Diag_Init + END SUBROUTINE GC_Diagnostics_Init !EOC !------------------------------------------------------------------------------ !BOP ! -! !IROUTINE: cesmgc_diag_calc +! !IROUTINE: gc_diagnostics_calc ! -! !DESCRIPTION: Subroutine CESMGC\_Diag\_Calc passes the diagnostics variable +! !DESCRIPTION: Subroutine GC\_Diagnostics\_Calc passes the diagnostics variable ! to the CAM History routines !\\ !\\ ! !INTERFACE: ! - SUBROUTINE CESMGC_Diag_Calc( Input_Opt, State_Chm, State_Diag, & - State_Grid, State_Met, cam_in, state, & - mmr_tend, LCHNK ) + SUBROUTINE GC_Diagnostics_Calc( Input_Opt, State_Chm, State_Diag, & + State_Grid, State_Met, cam_in, state, & + mmr_tend, LCHNK ) ! ! !USES: ! @@ -947,7 +947,7 @@ SUBROUTINE CESMGC_Diag_Calc( Input_Opt, State_Chm, State_Diag, & TYPE(RegItem ), POINTER :: Item !================================================================= - ! CESMGC_Diag_Calc begins here! + ! GC_Diagnostics_Calc begins here! !================================================================= nY = State_Grid%nY @@ -959,8 +959,8 @@ SUBROUTINE CESMGC_Diag_Calc( Input_Opt, State_Chm, State_Diag, & Item => NULL() ! For error trapping - ErrMsg = '' - ThisLoc = ' -> at CESMGC_Diag_Calc (in chemistry/geoschem/cesmgc_diag_mod.F90)' + ErrMsg = '' + ThisLoc = ' -> at GC_Diagnostics_Calc (in chemistry/geoschem/geoschem_diagnostics_mod.F90)' ! Define rootChunk rootChunk = ( MasterProc.and.(LCHNK==BEGCHUNK) ) @@ -1438,8 +1438,8 @@ SUBROUTINE CESMGC_Diag_Calc( Input_Opt, State_Chm, State_Diag, & Ptr2d_8 => NULL() Ptr3d_8 => NULL() - END SUBROUTINE CESMGC_Diag_Calc + END SUBROUTINE GC_Diagnostics_Calc !EOC !------------------------------------------------------------------------------ - END MODULE CESMGC_Diag_Mod + END MODULE GeosChem_Diagnostics_Mod diff --git a/src/chemistry/geoschem/cesmgc_emissions_mod.F90 b/src/chemistry/geoschem/geoschem_emissions_mod.F90 similarity index 89% rename from src/chemistry/geoschem/cesmgc_emissions_mod.F90 rename to src/chemistry/geoschem/geoschem_emissions_mod.F90 index 5995014efb..4859aee573 100644 --- a/src/chemistry/geoschem/cesmgc_emissions_mod.F90 +++ b/src/chemistry/geoschem/geoschem_emissions_mod.F90 @@ -3,15 +3,15 @@ !------------------------------------------------------------------------------ !BOP ! -! !MODULE: cesmgc_emissions_mod.F90 +! !MODULE: geoschem_emissions_mod.F90 ! -! !DESCRIPTION: Module cesmgc\_emissions\_mod contains routines which retrieve +! !DESCRIPTION: Module geoschem\_emissions\_mod contains routines which retrieve ! emission fluxes from HEMCO and transfers it back to the CESM-GC interface !\\ !\\ ! !INTERFACE: ! -MODULE CESMGC_Emissions_Mod +MODULE GeosChem_Emissions_Mod ! ! !USES: ! @@ -30,9 +30,9 @@ MODULE CESMGC_Emissions_Mod ! ! !PUBLIC MEMBER FUNCTIONS: ! - PUBLIC :: CESMGC_Emissions_Init - PUBLIC :: CESMGC_Emissions_Calc - PUBLIC :: CESMGC_Emissions_Final + PUBLIC :: GC_Emissions_Init + PUBLIC :: GC_Emissions_Calc + PUBLIC :: GC_Emissions_Final ! Constituent number for NO INTEGER :: iNO @@ -68,15 +68,15 @@ MODULE CESMGC_Emissions_Mod !------------------------------------------------------------------------------ !BOP ! -! !IROUTINE: cesmgc_emissions_init +! !IROUTINE: gc_emissions_init ! -! !DESCRIPTION: Subroutine CESMGC\_Emissions\_Init initializes the emissions +! !DESCRIPTION: Subroutine GC\_Emissions\_Init initializes the emissions ! routine !\\ !\\ ! !INTERFACE: ! - SUBROUTINE CESMGC_Emissions_Init( lght_no_prd_factor ) + SUBROUTINE GC_Emissions_Init( lght_no_prd_factor ) ! ! !USES: ! @@ -117,7 +117,7 @@ SUBROUTINE CESMGC_Emissions_Init( lght_no_prd_factor ) REAL(r8) :: MW !================================================================= - ! CESMGC_Emissions_Init begins here! + ! GC_Emissions_Init begins here! !================================================================= CALL phys_getopts( history_aerosol_out = history_aerosol, & @@ -256,21 +256,21 @@ SUBROUTINE CESMGC_Emissions_Init( lght_no_prd_factor ) pcnst_is_extfrc(n - iFirstCnst + 1) = (get_extfrc_ndx(trim(cnst_name(n))) > 0) enddo - END SUBROUTINE CESMGC_Emissions_Init + END SUBROUTINE GC_Emissions_Init !EOC !------------------------------------------------------------------------------ !BOP ! -! !IROUTINE: cesmgc_emissions_calc +! !IROUTINE: gc_emissions_calc ! -! !DESCRIPTION: Subroutine CESMGC\_Emissions\_Calc retrieves emission fluxes +! !DESCRIPTION: Subroutine GC\_Emissions\_Calc retrieves emission fluxes ! from HEMCO and returns a 3-D array of emission flux to the CESM-GC ! interface. On top of passing data, this routine handles a number of checks. !\\ !\\ ! !INTERFACE: ! - SUBROUTINE CESMGC_Emissions_Calc( state, hco_pbuf2d, State_Met, cam_in, eflx, iStep ) + SUBROUTINE GC_Emissions_Calc( state, hco_pbuf2d, State_Met, cam_in, eflx, iStep ) ! ! !USES: ! @@ -352,7 +352,7 @@ SUBROUTINE CESMGC_Emissions_Calc( state, hco_pbuf2d, State_Met, cam_in, eflx, iS CHARACTER(LEN=255) :: fldname_ns ! field name HCO_* !================================================================= - ! CESMGC_Emissions_Calc begins here! + ! GC_Emissions_Calc begins here! !================================================================= ! Initialize pointers @@ -375,7 +375,7 @@ SUBROUTINE CESMGC_Emissions_Calc( state, hco_pbuf2d, State_Met, cam_in, eflx, iS tmpIdx = pbuf_get_index(fldname_ns, RC) IF ( tmpIdx < 0 .OR. ( iStep == 1 ) ) THEN - IF ( rootChunk ) Write(iulog,'(a,a)') " CESMGC_Emissions_Calc: Field not found ", & + IF ( rootChunk ) Write(iulog,'(a,a)') " GC_Emissions_Calc: Field not found ", & TRIM(fldname_ns) ELSE ! This is already in chunk, retrieve it @@ -386,7 +386,7 @@ SUBROUTINE CESMGC_Emissions_Calc( state, hco_pbuf2d, State_Met, cam_in, eflx, iS CALL pbuf_get_field(pbuf_chnk, tmpIdx, pbuf_ik) IF ( .NOT. ASSOCIATED(pbuf_ik) ) THEN ! Sanity check - CALL ENDRUN("CESMGC_Emissions_Calc: FATAL - tmpIdx > 0 but pbuf_ik not associated (E-1)") + CALL ENDRUN("GC_Emissions_Calc: FATAL - tmpIdx > 0 but pbuf_ik not associated (E-1)") ENDIF eflx(1:nY,:nZ,N) = pbuf_ik(1:nY,:nZ) @@ -397,7 +397,7 @@ SUBROUTINE CESMGC_Emissions_Calc( state, hco_pbuf2d, State_Met, cam_in, eflx, iS CALL pbuf_get_field(pbuf_chnk, tmpIdx, pbuf_i) IF ( .NOT. ASSOCIATED(pbuf_i) ) THEN ! Sanity check - CALL ENDRUN("CESMGC_Emissions_Calc: FATAL - tmpIdx > 0 but pbuf_i not associated (E-2)") + CALL ENDRUN("GC_Emissions_Calc: FATAL - tmpIdx > 0 but pbuf_i not associated (E-2)") ENDIF ! note: write to nZ level here as this is surface @@ -410,16 +410,16 @@ SUBROUTINE CESMGC_Emissions_Calc( state, hco_pbuf2d, State_Met, cam_in, eflx, iS pbuf_chnk => NULL() !IF ( MINVAL(eflx(:nY,:nZ,N)) < 0.0e+00_r8 ) THEN - ! Write(iulog,*) " CESMGC_Emissions_Calc: HEMCO emission flux is negative for ", & + ! Write(iulog,*) " GC_Emissions_Calc: HEMCO emission flux is negative for ", & ! TRIM(cnst_name(N)), " with value ", MINVAL(eflx(:nY,:nZ,N)), " at ", & ! MINLOC(eflx(:nY,:nZ,N)) !ENDIF IF ( rootChunk .AND. (iStep == 2) .AND. ( MAXVAL(eflx(:nY,:nZ,N)) > 0.0e+0_r8 ) ) THEN ! Only print this once - Write(iulog,'(a,a,a,a)') " CESMGC_Emissions_Calc: HEMCO flux ", & + Write(iulog,'(a,a,a,a)') " GC_Emissions_Calc: HEMCO flux ", & TRIM(fldname_ns), " added to ", TRIM(cnst_name(N)) - Write(iulog,'(a,a,E16.4)') " CESMGC_Emissions_Calc: Maximum flux ", & + Write(iulog,'(a,a,E16.4)') " GC_Emissions_Calc: Maximum flux ", & TRIM(fldname_ns), MAXVAL(eflx(:nY,:nZ,N)) ENDIF ENDIF @@ -449,20 +449,20 @@ SUBROUTINE CESMGC_Emissions_Calc( state, hco_pbuf2d, State_Met, cam_in, eflx, iS CALL pbuf_get_field(pbuf_chnk, tmpIdx, pbuf_i) IF ( .NOT. ASSOCIATED(pbuf_i) ) THEN ! Sanity check - CALL ENDRUN("CESMGC_Emissions_Calc: FATAL - tmpIdx > 0 but pbuf_i not associated (2)") + CALL ENDRUN("GC_Emissions_Calc: FATAL - tmpIdx > 0 but pbuf_i not associated (2)") ENDIF ! apply loss flux to surface (level nZ) eflx(1:NY,nZ,id_O3) = eflx(1:NY,nZ,id_O3) - pbuf_i(1:nY) !IF ( MINVAL(eflx(:nY,nZ,id_O3)) < 0.0e+00_r8 ) THEN - ! Write(iulog,*) " CESMGC_Emissions_Calc: HEMCO sfc flux after ParaNOx is negative for O3 with value ", MINVAL(eflx(:nY,:nZ,id_O3)), " at ", & + ! Write(iulog,*) " GC_Emissions_Calc: HEMCO sfc flux after ParaNOx is negative for O3 with value ", MINVAL(eflx(:nY,:nZ,id_O3)), " at ", & ! MINLOC(eflx(:nY,nZ,id_O3)) !ENDIF IF ( rootChunk .and. ( MINVAL(pbuf_i(1:nY)) < 0.0e+0_r8 ) ) THEN - Write(iulog,'(a,a,a,a)') " CESMGC_Emissions_Calc: HEMCO dflx(paranox) O3 added to ", TRIM(cnst_name(id_O3)) - Write(iulog,'(a,a,E16.4)') " CESMGC_Emissions_Calc: Minval dflx(paranox), eflx(sfc) O3 ", MINVAL(pbuf_i(1:nY)), MINVAL(eflx(:nY,nZ,id_O3)) + Write(iulog,'(a,a,a,a)') " GC_Emissions_Calc: HEMCO dflx(paranox) O3 added to ", TRIM(cnst_name(id_O3)) + Write(iulog,'(a,a,E16.4)') " GC_Emissions_Calc: Minval dflx(paranox), eflx(sfc) O3 ", MINVAL(pbuf_i(1:nY)), MINVAL(eflx(:nY,nZ,id_O3)) ENDIF ! Reset pointers @@ -478,19 +478,19 @@ SUBROUTINE CESMGC_Emissions_Calc( state, hco_pbuf2d, State_Met, cam_in, eflx, iS CALL pbuf_get_field(pbuf_chnk, tmpIdx, pbuf_i) IF ( .NOT. ASSOCIATED(pbuf_i) ) THEN ! Sanity check - CALL ENDRUN("CESMGC_Emissions_Calc: FATAL - tmpIdx > 0 but pbuf_i not associated (3)") + CALL ENDRUN("GC_Emissions_Calc: FATAL - tmpIdx > 0 but pbuf_i not associated (3)") ENDIF eflx(1:NY,nZ,id_HNO3) = eflx(1:NY,nZ,id_HNO3) - pbuf_i(1:nY) !IF ( MINVAL(eflx(:nY,nZ,id_HNO3)) < 0.0e+00_r8 ) THEN - ! Write(iulog,*) " CESMGC_Emissions_Calc: HEMCO sfc flux after ParaNOx is negative for HNO3 with value ", MINVAL(eflx(:nY,nZ,id_HNO3)), " at ", & + ! Write(iulog,*) " GC_Emissions_Calc: HEMCO sfc flux after ParaNOx is negative for HNO3 with value ", MINVAL(eflx(:nY,nZ,id_HNO3)), " at ", & ! MINLOC(eflx(:nY,nZ,id_HNO3)) !ENDIF IF ( rootChunk .and. ( MINVAL(pbuf_i(1:nY)) < 0.0e+0_r8 ) ) THEN - Write(iulog,'(a,a,a,a)') " CESMGC_Emissions_Calc: HEMCO dflx(paranox) HNO3 added to ", TRIM(cnst_name(id_HNO3)) - Write(iulog,'(a,a,E16.4)') " CESMGC_Emissions_Calc: Minval dflx(paranox), eflx(sfc) HNO3 ", MINVAL(pbuf_i(1:nY)), MINVAL(eflx(:nY,nZ,id_HNO3)) + Write(iulog,'(a,a,a,a)') " GC_Emissions_Calc: HEMCO dflx(paranox) HNO3 added to ", TRIM(cnst_name(id_HNO3)) + Write(iulog,'(a,a,E16.4)') " GC_Emissions_Calc: Minval dflx(paranox), eflx(sfc) HNO3 ", MINVAL(pbuf_i(1:nY)), MINVAL(eflx(:nY,nZ,id_HNO3)) ENDIF ! Reset pointers @@ -607,19 +607,19 @@ SUBROUTINE CESMGC_Emissions_Calc( state, hco_pbuf2d, State_Met, cam_in, eflx, iS cam_in%cflx(1:nY,:) = cam_in%cflx(1:nY,:) + eflx(1:nY,nZ,:) eflx(1:nY,nZ,:) = 0.0e+00_r8 - END SUBROUTINE CESMGC_Emissions_Calc + END SUBROUTINE GC_Emissions_Calc !EOC !------------------------------------------------------------------------------ !BOP ! -! !IROUTINE: cesmgc_emissions_final +! !IROUTINE: gc_emissions_final ! -! !DESCRIPTION: Subroutine CESMGC\_Emissions\_Final cleans up the module +! !DESCRIPTION: Subroutine GC\_Emissions\_Final cleans up the module !\\ !\\ ! !INTERFACE: ! - SUBROUTINE CESMGC_Emissions_Final + SUBROUTINE GC_Emissions_Final ! ! !REVISION HISTORY: ! 07 Oct 2020 - T. M. Fritz - Initial version @@ -628,14 +628,14 @@ SUBROUTINE CESMGC_Emissions_Final !BOC ! !================================================================= - ! CESMGC_Emissions_Final begins here! + ! GC_Emissions_Final begins here! !================================================================= IF ( ALLOCATED( megan_indices_map ) ) DEALLOCATE( megan_indices_map ) IF ( ALLOCATED( megan_wght_factors ) ) DEALLOCATE( megan_wght_factors ) - END SUBROUTINE CESMGC_Emissions_Final + END SUBROUTINE GC_Emissions_Final !EOC !------------------------------------------------------------------------------ !EOC - END MODULE CESMGC_Emissions_Mod + END MODULE GeosChem_Emissions_Mod diff --git a/src/chemistry/geoschem/cesmgc_history_mod.F90 b/src/chemistry/geoschem/geoschem_history_mod.F90 similarity index 98% rename from src/chemistry/geoschem/cesmgc_history_mod.F90 rename to src/chemistry/geoschem/geoschem_history_mod.F90 index 5e221cdafb..fb722c44a5 100644 --- a/src/chemistry/geoschem/cesmgc_history_mod.F90 +++ b/src/chemistry/geoschem/geoschem_history_mod.F90 @@ -1,4 +1,4 @@ -#define _ASSERT(cond,msg) if(.not.cond) then; print *, "assertion error: ", Iam, __LINE__; call endrun("assertion error - look above - in cesmgc_history_mod.F90"); endif +#define _ASSERT(cond,msg) if(.not.cond) then; print *, "assertion error: ", Iam, __LINE__; call endrun("assertion error - look above - in geoschem_history_mod.F90"); endif #define _Iam_(name) character(len=255) :: Iam=name #define __Iam__(name) integer :: STATUS; _Iam_(name) ! Above are compatibility shorthands to avoid excessive divergence from @@ -8,9 +8,9 @@ !------------------------------------------------------------------------------ !BOP ! -! !MODULE: cesmgc_history_mod.F90 +! !MODULE: geoschem_history_mod.F90 ! -! !DESCRIPTION: Module CESMGC\_History\_Mod interfaces between the CAM history +! !DESCRIPTION: Module GeosChem\_History\_Mod interfaces between the CAM history ! component, the HISTORY.rc configuration file, and the GEOS-Chem State registry. ! This module is based off GCHP\_HistoryExports\_Mod originally developed by ! Lizzie Lundgren for GCHP. @@ -18,7 +18,7 @@ !\\ ! !INTERFACE: ! -MODULE CESMGC_History_Mod +MODULE GeosChem_History_Mod ! ! !USES: ! @@ -151,7 +151,7 @@ SUBROUTINE Init_HistoryConfig ( am_I_Root, HistoryConfig, configFile, RC ) !EOP !------------------------------------------------------------------------------ !BOC - __Iam__('Init_HistoryConfig (cesmgc_history_mod.F90)') + __Iam__('Init_HistoryConfig (geoschem_history_mod.F90)') RC = GC_SUCCESS ALLOCATE(HistoryConfig) HistoryConfig%ROOT = '' @@ -237,7 +237,7 @@ SUBROUTINE Init_HistoryExportsList ( am_I_Root, HistoryConfig, RC ) ! ================================================================ ! Init_HistoryExportsList begins here ! ================================================================ - __Iam__('Init_HistoryExportsList (cesmgc_history_mod.F90)') + __Iam__('Init_HistoryExportsList (geoschem_history_mod.F90)') RC = GC_SUCCESS ! Init @@ -425,7 +425,7 @@ SUBROUTINE Init_HistoryExport ( am_I_Root, NewHistExp, name, & !EOP !------------------------------------------------------------------------------ !BOC - __Iam__('Init_HistoryExport (cesmgc_history_mod.F90)') + __Iam__('Init_HistoryExport (geoschem_history_mod.F90)') RC = GC_SUCCESS ALLOCATE(NewHistExp) @@ -560,7 +560,7 @@ SUBROUTINE Append_HistoryExportsList ( am_I_Root, HistoryExport, & ! ================================================================ ! Append_HistoryExportsList begins here ! ================================================================ - __Iam__('Append_HistoryExportsList (cesmgc_history_mod.F90)') + __Iam__('Append_HistoryExportsList (geoschem_history_mod.F90)') RC = GC_SUCCESS ! Add new object to the beginning of the linked list @@ -610,7 +610,7 @@ SUBROUTINE Check_HistoryExportsList ( am_I_Root, name, & ! TYPE(HistoryExportObj), POINTER :: current - __Iam__('Check_HistoryExportsList (cesmgc_history_mod.F90)') + __Iam__('Check_HistoryExportsList (geoschem_history_mod.F90)') RC = GC_SUCCESS ! Assume not found @@ -682,7 +682,7 @@ SUBROUTINE HistoryExports_SetServices( am_I_Root, config_file, & ! ================================================================ ! For error handling (defines Iam and STATUS) - __Iam__('HistoryExports_SetServices (cesmgc_history_mod.F90)') + __Iam__('HistoryExports_SetServices (geoschem_history_mod.F90)') RC = GC_SUCCESS ! Create a config object if it does not already exist @@ -817,7 +817,7 @@ SUBROUTINE CopyGCStates2Exports( am_I_Root, Input_Opt, State_Grid, HistoryConfig ! ================================================================ ! CopyGCStates2Exports begins here ! ================================================================ - __Iam__('CopyGCStates2Exports (cesmgc_history_mod.F90)') + __Iam__('CopyGCStates2Exports (geoschem_history_mod.F90)') RC = GC_SUCCESS ! Loop over the History Exports list @@ -939,7 +939,7 @@ SUBROUTINE Print_HistoryExportsList( am_I_Root, HistoryConfig, RC ) ! ================================================================ ! Print_HistoryExportsList begins here ! ================================================================ - __Iam__('Print_HistoryExportsList (cesmgc_history_mod.F90)') + __Iam__('Print_HistoryExportsList (geoschem_history_mod.F90)') RC = GC_SUCCESS ! Loop over the History Exports list @@ -1158,7 +1158,7 @@ SUBROUTINE Destroy_HistoryConfig ( am_I_Root, HistoryConfig, RC ) ! ================================================================ ! Destroy_HistoryConfig begins here ! ================================================================ - __Iam__('Destroy_HistoryConfig (cesmgc_history_mod.F90)') + __Iam__('Destroy_HistoryConfig (geoschem_history_mod.F90)') current => NULL() next => NULL() @@ -1188,4 +1188,4 @@ SUBROUTINE Destroy_HistoryConfig ( am_I_Root, HistoryConfig, RC ) END SUBROUTINE Destroy_HistoryConfig !EOC -END MODULE CESMGC_History_Mod \ No newline at end of file +END MODULE GeosChem_History_Mod From 99a66984ac2619a5cc243e84a0887c78c01799d2 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Mon, 6 Mar 2023 14:36:53 -0700 Subject: [PATCH 101/291] Move short-lived reference MMR array from chem_mods to short-lived module Reference mixing ratios for short-lived species can now be passed to subroutine register_short_lived_species as an optional argument. If passed then the new module variable for reference values will be allocated and set using the values. Later during initialization these values will be used if the module array is allocated. Also added is a new finalize subroutine for the short_lived_species module so that the module array is deallocated. Signed-off-by: Lizzie Lundgren --- src/chemistry/geoschem/chem_mods.F90 | 2 -- src/chemistry/geoschem/chemistry.F90 | 30 +++++++++---------- src/chemistry/mozart/chemistry.F90 | 2 ++ src/chemistry/mozart/short_lived_species.F90 | 26 ++++++++++++---- src/chemistry/pp_none/chem_mods.F90 | 1 - src/chemistry/pp_terminator/chem_mods.F90 | 1 - src/chemistry/pp_trop_mam3/chem_mods.F90 | 1 - src/chemistry/pp_trop_mam4/chem_mods.F90 | 1 - src/chemistry/pp_trop_mam5/chem_mods.F90 | 1 - src/chemistry/pp_trop_mam7/chem_mods.F90 | 1 - src/chemistry/pp_trop_mozart/chem_mods.F90 | 1 - .../pp_trop_strat_mam4_ts2/chem_mods.F90 | 1 - .../pp_trop_strat_mam4_vbs/chem_mods.F90 | 1 - .../pp_trop_strat_mam4_vbsext/chem_mods.F90 | 1 - src/chemistry/pp_waccm_ma_mam4/chem_mods.F90 | 1 - .../pp_waccm_ma_sulfur/chem_mods.F90 | 1 - src/chemistry/pp_waccm_mad/chem_mods.F90 | 1 - src/chemistry/pp_waccm_mad_mam4/chem_mods.F90 | 1 - src/chemistry/pp_waccm_sc/chem_mods.F90 | 1 - src/chemistry/pp_waccm_sc_mam4/chem_mods.F90 | 1 - .../pp_waccm_tsmlt_mam4/chem_mods.F90 | 1 - .../pp_waccm_tsmlt_mam5/chem_mods.F90 | 1 - 22 files changed, 37 insertions(+), 41 deletions(-) diff --git a/src/chemistry/geoschem/chem_mods.F90 b/src/chemistry/geoschem/chem_mods.F90 index 1f46975f39..40a8828dbb 100644 --- a/src/chemistry/geoschem/chem_mods.F90 +++ b/src/chemistry/geoschem/chem_mods.F90 @@ -21,7 +21,6 @@ module chem_mods INTEGER :: nSls CHARACTER(LEN=255) :: slsNames(nSlsMax) CHARACTER(LEN=255) :: slsLongnames(nSlsMax) - REAL(r8) :: sls_Ref_MMR(nSlsMax) ! Mapping between constituents and GEOS-Chem tracers INTEGER :: map2GC(pcnst) @@ -102,7 +101,6 @@ module chem_mods logical :: is_vector logical :: is_scalar character(len=255), allocatable :: slvd_lst(:) - real(r8), allocatable :: slvd_ref_mmr(:) ! Mapping between chemical species and GEOS-Chem species/other tracers INTEGER :: map2chm(gas_pcnst) diff --git a/src/chemistry/geoschem/chemistry.F90 b/src/chemistry/geoschem/chemistry.F90 index c6d43ba2df..e801587b1e 100644 --- a/src/chemistry/geoschem/chemistry.F90 +++ b/src/chemistry/geoschem/chemistry.F90 @@ -32,7 +32,7 @@ module chemistry USE Error_Mod ! For error checking USE Precision_Mod, ONLY : fp, f4 ! Flexible precision - use chem_mods, only : nSlvd, slvd_Lst, slvd_ref_MMR + use chem_mods, only : nSlvd, slvd_Lst !-------------------------------------------------------------------- ! GEOS-Chem History exports module @@ -55,7 +55,6 @@ module chemistry use chem_mods, only : nSlsMax use chem_mods, only : nSls use chem_mods, only : slsNames - use chem_mods, only : sls_ref_MMR use chem_mods, only : nAerMax use chem_mods, only : nAer use chem_mods, only : aerNames @@ -200,9 +199,7 @@ subroutine chem_register use physics_buffer, only : pbuf_add_field, dtype_r8 use PhysConst, only : MWDry - - use Short_Lived_Species, only : Register_Short_Lived_Species - + use short_lived_species, only : Register_Short_Lived_Species use State_Grid_Mod, only : Init_State_Grid, Cleanup_State_Grid use State_Chm_Mod, only : Init_State_Chm, Cleanup_State_Chm use State_Chm_Mod, only : Ind_ @@ -236,6 +233,7 @@ subroutine chem_register REAL(r8) :: MWTmp REAL(r8) :: qmin REAL(r8) :: refmmr, refvmr + REAL(r8), ALLOCATABLE :: slvd_refmmr(:) CHARACTER(LEN=128) :: mixtype CHARACTER(LEN=128) :: molectype CHARACTER(LEN=128) :: lngName @@ -478,23 +476,23 @@ subroutine chem_register ! Now unadvected species map2GC_Sls = 0 - sls_ref_MMR(:) = 0.0e+0_r8 - DO I = 1, nSls + ALLOCATE(slvd_refmmr(nslvd), STAT=IERR) + slvd_refmmr(:) = 0.0e+0_r8 + IF ( IERR .NE. 0 ) CALL ENDRUN('Failed to allocate map2MAM4') + DO I = 1, nSlvd N = Ind_(slsNames(I)) IF ( N .GT. 0 ) THEN ThisSpc => SC%SpcData(N)%Info MWTmp = REAL(ThisSpc%MW_g,r8) refvmr = REAL(ThisSpc%BackgroundVV,r8) lngName = TRIM(ThisSpc%FullName) - sls_ref_MMR(I) = refvmr / (MWDry / MWTmp) + slvd_refmmr(I) = refvmr / (MWDry / MWTmp) map2GC_Sls(I) = N ThisSpc => NULL() ENDIF ENDDO - - ! Pass information to "short_lived_species" module - slvd_ref_MMR(1:nSls) = sls_ref_MMR(1:nSls) - CALL Register_Short_Lived_Species() + CALL Register_Short_Lived_Species(slvd_refmmr) + DEALLOCATE(slvd_refmmr) ! More information: ! http://www.cesm.ucar.edu/models/atm-cam/docs/phys-interface/node5.html @@ -897,8 +895,6 @@ subroutine chem_readnl(nlfile) ALLOCATE(slvd_Lst(nSlvd), STAT=IERR) IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating slvd_Lst') - ALLOCATE(slvd_ref_MMR(nSlvd), STAT=IERR) - IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating slvd_ref_MMR') DO I = 1, nSls slvd_Lst(I) = TRIM(slsNames(I)) ENDDO @@ -4310,7 +4306,8 @@ subroutine chem_final use Diag_Mod, only : Cleanup_Diag #endif - use GeosChem_Emissions_Mod, only: GC_Emissions_Final + use GeosChem_Emissions_Mod, only : GC_Emissions_Final + use short_lived_species, only : short_lived_species_final ! Local variables INTEGER :: I, RC @@ -4337,6 +4334,8 @@ subroutine chem_final CALL GC_Emissions_Final + CALL short_lived_species_final() + CALL Cleanup_CMN_FJX( RC ) IF ( RC /= GC_SUCCESS ) THEN ErrMsg = 'Error encountered in "Cleanup_CMN_FJX"!' @@ -4373,7 +4372,6 @@ subroutine chem_final IF ( ALLOCATED( State_Met ) ) DEALLOCATE( State_Met ) IF ( ALLOCATED( slvd_Lst ) ) DEALLOCATE( slvd_Lst ) - IF ( ALLOCATED( slvd_ref_MMR ) ) DEALLOCATE( slvd_ref_MMR ) RETURN diff --git a/src/chemistry/mozart/chemistry.F90 b/src/chemistry/mozart/chemistry.F90 index 5637ebc1f7..13bd39761e 100644 --- a/src/chemistry/mozart/chemistry.F90 +++ b/src/chemistry/mozart/chemistry.F90 @@ -1296,7 +1296,9 @@ end subroutine chem_timestep_tend !------------------------------------------------------------------- subroutine chem_final() use mee_ionization, only: mee_ion_final + use short_lived_species, only: short_lived_species_final call mee_ion_final() + call short_lived_species_final() end subroutine chem_final !------------------------------------------------------------------- diff --git a/src/chemistry/mozart/short_lived_species.F90 b/src/chemistry/mozart/short_lived_species.F90 index 3ceff24e75..8807776d98 100644 --- a/src/chemistry/mozart/short_lived_species.F90 +++ b/src/chemistry/mozart/short_lived_species.F90 @@ -12,7 +12,6 @@ module short_lived_species use ppgrid, only : pcols, pver, begchunk, endchunk use spmd_utils, only : masterproc - implicit none save @@ -28,21 +27,31 @@ module short_lived_species public :: get_short_lived_species_gc ! for GEOS-Chem chemistry public :: slvd_index public :: pbf_idx + public :: short_lived_species_final integer :: pbf_idx integer :: map(nslvd) character(len=*), parameter :: pbufname = 'ShortLivedSpecies' + real(r8), allocatable :: slvd_ref_mmr(:) + contains !--------------------------------------------------------------------- !--------------------------------------------------------------------- - subroutine register_short_lived_species + subroutine register_short_lived_species (ref_mmr) use physics_buffer, only : pbuf_add_field, dtype_r8 + real(r8), optional :: ref_mmr(nslvd) + if ( nslvd < 1 ) return + if ( present(ref_mmr) ) then + allocate(slvd_ref_mmr(nslvd)) + slvd_ref_mmr = ref_mmr + endif + call pbuf_add_field(pbufname,'global',dtype_r8,(/pcols,pver,nslvd/),pbf_idx) end subroutine register_short_lived_species @@ -93,7 +102,6 @@ subroutine initialize_short_lived_species(ncid_ini, pbuf2d) use cam_grid_support, only : cam_grid_check, cam_grid_id use cam_grid_support, only : cam_grid_get_dim_names use cam_abortutils, only : endrun - use chem_mods, only : slvd_ref_mmr use mo_tracname, only : solsym use ncdio_atm, only : infld use pio, only : file_desc_t @@ -140,7 +148,7 @@ subroutine initialize_short_lived_species(ncid_ini, pbuf2d) tmpptr, found, gridname='physgrid') if (.not.found) then - if ( cam_chempkg_is('geoschem_mam4') ) then + if ( allocated(slvd_ref_mmr) ) then tmpptr(:,:,:) = slvd_ref_mmr(m) else tmpptr(:,:,:) = 1.e-36_r8 @@ -151,7 +159,7 @@ subroutine initialize_short_lived_species(ncid_ini, pbuf2d) if (masterproc) write(iulog,*) fieldname, ' is set to short-lived' - if (cam_chempkg_is('geoschem_mam4') .and. masterproc) write(iulog,'(a, E16.5E4)') ' --> reference MMR: ', slvd_ref_mmr(m) + if ( allocated(slvd_ref_mmr) .and. masterproc) write(iulog,'(a, E16.5E4)') ' --> reference MMR: ', slvd_ref_mmr(m) enddo @@ -278,4 +286,12 @@ function slvd_index( name ) endfunction slvd_index +!--------------------------------------------------------------------- +!--------------------------------------------------------------------- + subroutine short_lived_species_final + + if ( allocated(slvd_ref_mmr) ) deallocate(slvd_ref_mmr) + + end subroutine short_lived_species_final + end module short_lived_species diff --git a/src/chemistry/pp_none/chem_mods.F90 b/src/chemistry/pp_none/chem_mods.F90 index 845261c628..4dc00c6ced 100644 --- a/src/chemistry/pp_none/chem_mods.F90 +++ b/src/chemistry/pp_none/chem_mods.F90 @@ -46,5 +46,4 @@ module chem_mods logical :: is_vector logical :: is_scalar character(len=16) :: slvd_lst(max(1,nslvd)) - real(r8), allocatable :: slvd_ref_mmr(max(1,nslvd)) end module chem_mods diff --git a/src/chemistry/pp_terminator/chem_mods.F90 b/src/chemistry/pp_terminator/chem_mods.F90 index ceb2107303..31d67260c3 100644 --- a/src/chemistry/pp_terminator/chem_mods.F90 +++ b/src/chemistry/pp_terminator/chem_mods.F90 @@ -47,5 +47,4 @@ module chem_mods logical :: is_vector logical :: is_scalar character(len=16) :: slvd_lst(max(1,nslvd)) - real(r8), allocatable :: slvd_ref_mmr(max(1,nslvd)) end module chem_mods diff --git a/src/chemistry/pp_trop_mam3/chem_mods.F90 b/src/chemistry/pp_trop_mam3/chem_mods.F90 index 645b62fba5..69af9e22ab 100644 --- a/src/chemistry/pp_trop_mam3/chem_mods.F90 +++ b/src/chemistry/pp_trop_mam3/chem_mods.F90 @@ -47,5 +47,4 @@ module chem_mods logical :: is_vector logical :: is_scalar character(len=16) :: slvd_lst(max(1,nslvd)) - real(r8), allocatable :: slvd_ref_mmr(max(1,nslvd)) end module chem_mods diff --git a/src/chemistry/pp_trop_mam4/chem_mods.F90 b/src/chemistry/pp_trop_mam4/chem_mods.F90 index 76424a61a3..0b97007e7b 100644 --- a/src/chemistry/pp_trop_mam4/chem_mods.F90 +++ b/src/chemistry/pp_trop_mam4/chem_mods.F90 @@ -47,5 +47,4 @@ module chem_mods logical :: is_vector logical :: is_scalar character(len=16) :: slvd_lst(max(1,nslvd)) - real(r8), allocatable :: slvd_ref_mmr(max(1,nslvd)) end module chem_mods diff --git a/src/chemistry/pp_trop_mam5/chem_mods.F90 b/src/chemistry/pp_trop_mam5/chem_mods.F90 index f7c002b820..0638b442d5 100644 --- a/src/chemistry/pp_trop_mam5/chem_mods.F90 +++ b/src/chemistry/pp_trop_mam5/chem_mods.F90 @@ -47,5 +47,4 @@ module chem_mods logical :: is_vector logical :: is_scalar character(len=16) :: slvd_lst(max(1,nslvd)) - real(r8), allocatable :: slvd_ref_mmr(max(1,nslvd)) end module chem_mods diff --git a/src/chemistry/pp_trop_mam7/chem_mods.F90 b/src/chemistry/pp_trop_mam7/chem_mods.F90 index 872c68441f..b40e9525b6 100644 --- a/src/chemistry/pp_trop_mam7/chem_mods.F90 +++ b/src/chemistry/pp_trop_mam7/chem_mods.F90 @@ -47,5 +47,4 @@ module chem_mods logical :: is_vector logical :: is_scalar character(len=16) :: slvd_lst(max(1,nslvd)) - real(r8), allocatable :: slvd_ref_mmr(max(1,nslvd)) end module chem_mods diff --git a/src/chemistry/pp_trop_mozart/chem_mods.F90 b/src/chemistry/pp_trop_mozart/chem_mods.F90 index edae88dc29..9b41d9c1cb 100644 --- a/src/chemistry/pp_trop_mozart/chem_mods.F90 +++ b/src/chemistry/pp_trop_mozart/chem_mods.F90 @@ -47,5 +47,4 @@ module chem_mods logical :: is_vector logical :: is_scalar character(len=16) :: slvd_lst(max(1,nslvd)) - real(r8), allocatable :: slvd_ref_mmr(max(1,nslvd)) end module chem_mods diff --git a/src/chemistry/pp_trop_strat_mam4_ts2/chem_mods.F90 b/src/chemistry/pp_trop_strat_mam4_ts2/chem_mods.F90 index 414491243e..70d339afc3 100644 --- a/src/chemistry/pp_trop_strat_mam4_ts2/chem_mods.F90 +++ b/src/chemistry/pp_trop_strat_mam4_ts2/chem_mods.F90 @@ -47,6 +47,5 @@ module chem_mods logical :: is_vector logical :: is_scalar character(len=16) :: slvd_lst(max(1,nslvd)) - real(r8), allocatable :: slvd_ref_mmr(max(1,nslvd)) integer, parameter :: veclen = 32 end module chem_mods diff --git a/src/chemistry/pp_trop_strat_mam4_vbs/chem_mods.F90 b/src/chemistry/pp_trop_strat_mam4_vbs/chem_mods.F90 index 75737d5bf7..9af6c6de37 100644 --- a/src/chemistry/pp_trop_strat_mam4_vbs/chem_mods.F90 +++ b/src/chemistry/pp_trop_strat_mam4_vbs/chem_mods.F90 @@ -47,6 +47,5 @@ module chem_mods logical :: is_vector logical :: is_scalar character(len=16) :: slvd_lst(max(1,nslvd)) - real(r8), allocatable :: slvd_ref_mmr(max(1,nslvd)) integer, parameter :: veclen = 32 end module chem_mods diff --git a/src/chemistry/pp_trop_strat_mam4_vbsext/chem_mods.F90 b/src/chemistry/pp_trop_strat_mam4_vbsext/chem_mods.F90 index 1225023e14..81fd6d4a31 100644 --- a/src/chemistry/pp_trop_strat_mam4_vbsext/chem_mods.F90 +++ b/src/chemistry/pp_trop_strat_mam4_vbsext/chem_mods.F90 @@ -47,6 +47,5 @@ module chem_mods logical :: is_vector logical :: is_scalar character(len=16) :: slvd_lst(max(1,nslvd)) - real(r8), allocatable :: slvd_ref_mmr(max(1,nslvd)) integer, parameter :: veclen = 32 end module chem_mods diff --git a/src/chemistry/pp_waccm_ma_mam4/chem_mods.F90 b/src/chemistry/pp_waccm_ma_mam4/chem_mods.F90 index 9b6c1a3141..b3d2ff52e0 100644 --- a/src/chemistry/pp_waccm_ma_mam4/chem_mods.F90 +++ b/src/chemistry/pp_waccm_ma_mam4/chem_mods.F90 @@ -47,6 +47,5 @@ module chem_mods logical :: is_vector logical :: is_scalar character(len=16) :: slvd_lst(max(1,nslvd)) - real(r8), allocatable :: slvd_ref_mmr(max(1,nslvd)) integer, parameter :: veclen = 32 end module chem_mods diff --git a/src/chemistry/pp_waccm_ma_sulfur/chem_mods.F90 b/src/chemistry/pp_waccm_ma_sulfur/chem_mods.F90 index f8995051c9..2dfcf62986 100644 --- a/src/chemistry/pp_waccm_ma_sulfur/chem_mods.F90 +++ b/src/chemistry/pp_waccm_ma_sulfur/chem_mods.F90 @@ -47,5 +47,4 @@ module chem_mods logical :: is_vector logical :: is_scalar character(len=16) :: slvd_lst(max(1,nslvd)) - real(r8), allocatable :: slvd_ref_mmr(max(1,nslvd)) end module chem_mods diff --git a/src/chemistry/pp_waccm_mad/chem_mods.F90 b/src/chemistry/pp_waccm_mad/chem_mods.F90 index ff996a00d4..c524ffab6b 100644 --- a/src/chemistry/pp_waccm_mad/chem_mods.F90 +++ b/src/chemistry/pp_waccm_mad/chem_mods.F90 @@ -47,5 +47,4 @@ module chem_mods logical :: is_vector logical :: is_scalar character(len=16) :: slvd_lst(max(1,nslvd)) - real(r8), allocatable :: slvd_ref_mmr(max(1,nslvd)) end module chem_mods diff --git a/src/chemistry/pp_waccm_mad_mam4/chem_mods.F90 b/src/chemistry/pp_waccm_mad_mam4/chem_mods.F90 index eb95c69127..6c202fdba7 100644 --- a/src/chemistry/pp_waccm_mad_mam4/chem_mods.F90 +++ b/src/chemistry/pp_waccm_mad_mam4/chem_mods.F90 @@ -47,5 +47,4 @@ module chem_mods logical :: is_vector logical :: is_scalar character(len=16) :: slvd_lst(max(1,nslvd)) - real(r8), allocatable :: slvd_ref_mmr(max(1,nslvd)) end module chem_mods diff --git a/src/chemistry/pp_waccm_sc/chem_mods.F90 b/src/chemistry/pp_waccm_sc/chem_mods.F90 index cf5e4ac056..b89c8308f5 100644 --- a/src/chemistry/pp_waccm_sc/chem_mods.F90 +++ b/src/chemistry/pp_waccm_sc/chem_mods.F90 @@ -47,5 +47,4 @@ module chem_mods logical :: is_vector logical :: is_scalar character(len=16) :: slvd_lst(max(1,nslvd)) - real(r8), allocatable :: slvd_ref_mmr(max(1,nslvd)) end module chem_mods diff --git a/src/chemistry/pp_waccm_sc_mam4/chem_mods.F90 b/src/chemistry/pp_waccm_sc_mam4/chem_mods.F90 index 5fca9dfce2..f75b1c9a8a 100644 --- a/src/chemistry/pp_waccm_sc_mam4/chem_mods.F90 +++ b/src/chemistry/pp_waccm_sc_mam4/chem_mods.F90 @@ -47,5 +47,4 @@ module chem_mods logical :: is_vector logical :: is_scalar character(len=16) :: slvd_lst(max(1,nslvd)) - real(r8), allocatable :: slvd_ref_mmr(max(1,nslvd)) end module chem_mods diff --git a/src/chemistry/pp_waccm_tsmlt_mam4/chem_mods.F90 b/src/chemistry/pp_waccm_tsmlt_mam4/chem_mods.F90 index 56f1a58f89..336ce725db 100644 --- a/src/chemistry/pp_waccm_tsmlt_mam4/chem_mods.F90 +++ b/src/chemistry/pp_waccm_tsmlt_mam4/chem_mods.F90 @@ -47,6 +47,5 @@ module chem_mods logical :: is_vector logical :: is_scalar character(len=16) :: slvd_lst(max(1,nslvd)) - real(r8), allocatable :: slvd_ref_mmr(max(1,nslvd)) integer, parameter :: veclen = 32 end module chem_mods diff --git a/src/chemistry/pp_waccm_tsmlt_mam5/chem_mods.F90 b/src/chemistry/pp_waccm_tsmlt_mam5/chem_mods.F90 index 3e28b7c55f..5cdd14dcd5 100644 --- a/src/chemistry/pp_waccm_tsmlt_mam5/chem_mods.F90 +++ b/src/chemistry/pp_waccm_tsmlt_mam5/chem_mods.F90 @@ -47,6 +47,5 @@ module chem_mods logical :: is_vector logical :: is_scalar character(len=16) :: slvd_lst(max(1,nslvd)) - real(r8), allocatable :: slvd_ref_mmr(max(1,nslvd)) integer, parameter :: veclen = 32 end module chem_mods From a924520cbb4b252e0601bdc3afebfa5ddf09c3c7 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Tue, 7 Mar 2023 09:22:02 -0700 Subject: [PATCH 102/291] Delete unused GEOS-Chem build code Code removal guided by: 1. chem value 'geoschem' is not used. Only 'geoschem_mam4' is used 2. CLM version CPP definition -DCLM[40,45,50] no longer used in GEOS-Chem 3. Only CAM60 is used Signed-off-by: Lizzie Lundgren --- bld/config_files/definition.xml | 4 ++-- bld/configure | 19 ++----------------- cime_config/config_component.xml | 3 +-- 3 files changed, 5 insertions(+), 21 deletions(-) diff --git a/bld/config_files/definition.xml b/bld/config_files/definition.xml index 84f55922bf..e198e1bd65 100644 --- a/bld/config_files/definition.xml +++ b/bld/config_files/definition.xml @@ -98,8 +98,8 @@ meteor_smoke (Meteor Smoke), mixed_sulfate (Meteor Smoke and Sulfate), pmc (Pola 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). - - Chemistry package: none,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_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,geoschem_mam4 + + Chemistry package: none,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_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 Prognostic mozart species packages: list of any subset of the following: DST,SSLT,SO4,GHG,OC,BC,CARBON16 diff --git a/bld/configure b/bld/configure index 6560aabcfe..05509afaec 100755 --- a/bld/configure +++ b/bld/configure @@ -67,11 +67,8 @@ OPTIONS trop_strat_mam4_vbs | trop_strat_mam4_vbsext | trop_strat_mam5_ts2 | 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 | geoschem_mam4 ]. + waccm_ma_mam5 | waccm_tsmlt_mam5 | waccm_tsmlt_mam5_vbsext | geoschem_mam4 ]. Default: trop_mam4 for cam6 and trop_mam3 for cam5. - -clm_vers Version of land model to use. This option is only used when chem - is set to 'geoschem'. - [ 4.0 | 4.5 | 5.0 ] -[no]clubb_sgs Switch on [off] CLUBB_SGS. Default: on for cam6, otherwise off. -clubb_opts Comma separated list of CLUBB options to turn on/off. By default they are all off. Current option is: clubb_do_adv (Advect CLUBB moments) @@ -251,7 +248,6 @@ GetOptions( "cc=s" => \$opts{'cc'}, "cflags=s" => \$opts{'cflags'}, "chem=s" => \$opts{'chem'}, - "clm_vers=s" => \$opts{'clm_vers'}, "clubb_sgs!" => \$opts{'clubb_sgs'}, "clubb_opts=s" => \$opts{'clubb_opts'}, "co2_cycle" => \$opts{'co2_cycle'}, @@ -1401,21 +1397,10 @@ if ($chem_pkg =~ '_mam3') { $chem_cppdefs = ' -DMODAL_AERO -DMODAL_AERO_7MODE '; } -# TMMF - wedge in GEOS-Chem CPP definitions here +# Set GEOS-Chem CPP definitions here if ($chem_pkg =~ 'geoschem') { $chem_cppdefs .= ' -DEXTERNAL_GRID -DEXTERNAL_FORCING -DLINUX_IFORT -DUSE_REAL8 -DMODEL_ -DMODEL_CESM'; $chem_nadv = 267; # includes GC advected species (233), CO2 (1), and MAM aerosols (33) - if (defined $opts{'clm_vers'}) { - if ($opts{'clm_vers'} =~ 'CLM4.0') { - $chem_cppdefs .= ' -DCLM40' - } - elsif ($opts{'clm_vers'} =~ 'CLM4.5') { - $chem_cppdefs .= ' -DCLM45' - } - elsif ($opts{'clm_vers'} =~ 'CLM5.0') { - $chem_cppdefs .= ' -DCLM50' - } - } } diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index 83df6df22e..b09dd13d17 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -131,12 +131,11 @@ -phys cam_dev -chem trop_strat_mam5_vbs - -chem geoschem_mam4 -hemco + -chem geoschem_mam4 -hemco -chem trop_mam7 -chem trop_strat_mam5_vbsext -chem trop_strat_mam5_ts2 - -chem geoschem -hemco -clubb_sgs -dyn eul -scam -rad camrt -chem none -spcam_nx 32 -spcam_ny 1 -spcam_dx 4000 -spcam_dt 20 -phys spcam_sam1mom From 66887030c4d2fe284cc21606c3abe1e859ae997e Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Tue, 7 Mar 2023 12:14:16 -0700 Subject: [PATCH 103/291] Assorted minor code cleanup; add preliminary GEOS-Chem tests Signed-off-by: Lizzie Lundgren --- cime_config/testdefs/testlist_cam.xml | 38 +++++++++++++++++++++++++ src/chemistry/pp_waccm_ma/chem_mods.F90 | 1 - src/cpl/mct/cam_cpl_indices.F90 | 2 +- src/physics/cam/physpkg.F90 | 9 ------ 4 files changed, 39 insertions(+), 11 deletions(-) diff --git a/cime_config/testdefs/testlist_cam.xml b/cime_config/testdefs/testlist_cam.xml index 7e94ce3d6a..9ffad598cd 100644 --- a/cime_config/testdefs/testlist_cam.xml +++ b/cime_config/testdefs/testlist_cam.xml @@ -17,6 +17,14 @@ + + + + + + + + @@ -43,6 +51,14 @@ + + + + + + + + @@ -1529,6 +1545,14 @@ + + + + + + + + @@ -1579,6 +1603,15 @@ + + + + + + + + + @@ -1753,6 +1786,11 @@ + + + + + diff --git a/src/chemistry/pp_waccm_ma/chem_mods.F90 b/src/chemistry/pp_waccm_ma/chem_mods.F90 index 94dad43671..4daa9f36ee 100644 --- a/src/chemistry/pp_waccm_ma/chem_mods.F90 +++ b/src/chemistry/pp_waccm_ma/chem_mods.F90 @@ -47,6 +47,5 @@ module chem_mods logical :: is_vector logical :: is_scalar character(len=16) :: slvd_lst(max(1,nslvd)) - real(r8), allocatable :: slvd_ref_mmr(max(1,nslvd)) integer, parameter :: veclen = 32 end module chem_mods diff --git a/src/cpl/mct/cam_cpl_indices.F90 b/src/cpl/mct/cam_cpl_indices.F90 index ba38a67fe4..f5fe1ef26c 100644 --- a/src/cpl/mct/cam_cpl_indices.F90 +++ b/src/cpl/mct/cam_cpl_indices.F90 @@ -165,7 +165,7 @@ subroutine cam_cpl_indices_set( ) if ( n_drydep>0 )then index_x2a_Sl_ddvel = mct_avect_indexra(x2a, trim(drydep_fields_token)) else - index_x2a_Sl_ddvel = 0 + index_x2a_Sl_ddvel = 0 end if index_a2x_Sa_z = mct_avect_indexra(a2x,'Sa_z') diff --git a/src/physics/cam/physpkg.F90 b/src/physics/cam/physpkg.F90 index 7f7c7261cb..c726eb490e 100644 --- a/src/physics/cam/physpkg.F90 +++ b/src/physics/cam/physpkg.F90 @@ -1427,7 +1427,6 @@ subroutine tphysac (ztodt, cam_in, & integer :: ixq logical :: labort ! abort flag - logical :: debug ! enable status prints real(r8) tvm(pcols,pver) ! virtual temperature real(r8) prect(pcols) ! total precipitation @@ -1463,8 +1462,6 @@ subroutine tphysac (ztodt, cam_in, & nstep = get_nstep() call cnst_get_ind('Q', ixq) - debug = .false. - ! Adjust the surface fluxes to reduce instabilities in near sfc layer if (phys_do_flux_avg()) then call flux_avg_run(state, cam_in, pbuf, nstep, ztodt) @@ -1588,10 +1585,8 @@ subroutine tphysac (ztodt, cam_in, & fh2o, surfric, obklen, flx_heat) end if - if (debug .and. masterproc) print *, "cam/physpkg.F90: calling chem_timestep_tend" call chem_timestep_tend(state, ptend, cam_in, cam_out, ztodt, & pbuf, fh2o=fh2o) - if (debug .and. masterproc) print *, "cam/physpkg.F90: chem_timestep_tend complete" if ( (trim(cam_take_snapshot_after) == "chem_timestep_tend") .and. & (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then @@ -1681,8 +1676,6 @@ subroutine tphysac (ztodt, cam_in, & fh2o, surfric, obklen, flx_heat) end if - if (debug .and. masterproc) print *, "cam/physpkg.F90: calling aero_model_drydep" - 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 @@ -1690,8 +1683,6 @@ subroutine tphysac (ztodt, cam_in, & end if call physics_update(state, ptend, ztodt, tend) - if (debug .and. masterproc) print *, "cam/physpkg.F90: aero_model_drydep complete" - if (trim(cam_take_snapshot_after) == "aero_model_drydep") then call cam_snapshot_all_outfld_tphysac(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf,& fh2o, surfric, obklen, flx_heat) From 1dc70198bbcc3a8f195ddeaa22c09826aa35e489 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Wed, 8 Mar 2023 15:56:45 -0500 Subject: [PATCH 104/291] Now emit surface emissions consistently as a 3-D flux term. This is for consistency with recent updates to HEMCO within CAM-chem where emission fluxes are applied as a 3-D flux, even for surface emissions. Signed-off-by: Haipeng Lin --- .../geoschem/geoschem_emissions_mod.F90 | 22 +++++++++++-------- 1 file changed, 13 insertions(+), 9 deletions(-) diff --git a/src/chemistry/geoschem/geoschem_emissions_mod.F90 b/src/chemistry/geoschem/geoschem_emissions_mod.F90 index 4859aee573..cc3160d212 100644 --- a/src/chemistry/geoschem/geoschem_emissions_mod.F90 +++ b/src/chemistry/geoschem/geoschem_emissions_mod.F90 @@ -317,6 +317,7 @@ SUBROUTINE GC_Emissions_Calc( state, hco_pbuf2d, State_Met, cam_in, eflx, iStep ! ! !REVISION HISTORY: ! 07 Oct 2020 - T. M. Fritz - Initial version +! 06 Mar 2023 - H.P. Lin - Now emit surface fluxes directly !EOP !------------------------------------------------------------------------------ !BOC @@ -429,10 +430,10 @@ SUBROUTINE GC_Emissions_Calc( state, hco_pbuf2d, State_Met, cam_in, eflx, iStep ! Deposition fluxes from HEMCO !----------------------------------------------------------------------- - ! Part 1: Eventually retrieve deposition velocities [1/s] from HEMCO - ! and convert to negative flux and apply. - ! TODO hplin 3/24/21 - + ! Deposition velocities in HEMCO are now handled within HEMCO_CESM for a + ! hardcoded list of species, primarily for the SeaFlux extension. + ! This is not to be confused with dry deposition fluxes which are not + ! handled by HEMCO. ! Part 2: Handle special deposition fluxes for the ParaNOx extension ! for PAR_O3_DEP and PAR_HNO3_DEP @@ -601,11 +602,14 @@ SUBROUTINE GC_Emissions_Calc( state, hco_pbuf2d, State_Met, cam_in, eflx, iStep ! TMMF - vertical distribution of fire emissions is not implemented yet !CALL fire_emissions_vrt( nY, LCHNK, zint, cam_in%fireflx, cam_in%fireztop, extfrc ) - !----------------------------------------------------------------------- - ! Add near-surface emissions to surface flux boundary condition - !----------------------------------------------------------------------- - cam_in%cflx(1:nY,:) = cam_in%cflx(1:nY,:) + eflx(1:nY,nZ,:) - eflx(1:nY,nZ,:) = 0.0e+00_r8 + ! Near-surface emissions are now emitted directly to GEOS-Chem Species array + ! for consistency with CAM-chem implementation of HEMCO + ! (but not with GEOS-Chem standalone, where fluxes are mixed by the turbulence routines) + ! Refer to discussion here: https://github.com/ESCOMP/CAM/pull/560#discussion_r1084559191 + ! + ! To replicate old behavior, uncomment these two lines below: + ! cam_in%cflx(1:nY,:) = cam_in%cflx(1:nY,:) + eflx(1:nY,nZ,:) + ! eflx(1:nY,nZ,:) = 0.0e+00_r8 END SUBROUTINE GC_Emissions_Calc !EOC From 1a3fbcff71cc0903289ed87e47a9066d693e5c98 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Fri, 17 Mar 2023 18:14:39 -0400 Subject: [PATCH 105/291] Fix SOA mapping indices --- src/chemistry/geoschem/chemistry.F90 | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/src/chemistry/geoschem/chemistry.F90 b/src/chemistry/geoschem/chemistry.F90 index e801587b1e..dd8f0c9b1a 100644 --- a/src/chemistry/geoschem/chemistry.F90 +++ b/src/chemistry/geoschem/chemistry.F90 @@ -2430,25 +2430,28 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) K4 = Ind_(speciesName_4) DO J = 1, nY DO L = 1, nZ + ! Total SOA aerosol masses from GC are available. Partition according to the ratio given in speciesId_N to totMass summed above. IF ( totMass(J,L) > 0.0e+00_r8 ) THEN IF ( K1 > 0 ) State_Chm(LCHNK)%Species(K1)%Conc(1,J,L) = state%q(J,nZ+1-L,speciesId_1) / totMass(J,nZ+1-L) * bulkMass(J,nZ+1-L) * adv_mass(mapCnst(speciesId_1)) / tmpMW_g - IF ( K2 > 0 ) State_Chm(LCHNK)%Species(K1)%Conc(1,J,L) = state%q(J,nZ+1-L,speciesId_2) / totMass(J,nZ+1-L) * bulkMass(J,nZ+1-L) * adv_mass(mapCnst(speciesId_2)) / tmpMW_g + IF ( K2 > 0 ) State_Chm(LCHNK)%Species(K2)%Conc(1,J,L) = state%q(J,nZ+1-L,speciesId_2) / totMass(J,nZ+1-L) * bulkMass(J,nZ+1-L) * adv_mass(mapCnst(speciesId_2)) / tmpMW_g IF ( K3 > 0 ) State_Chm(LCHNK)%Species(K3)%Conc(1,J,L) = state%q(J,nZ+1-L,speciesId_3) / totMass(J,nZ+1-L) * bulkMass(J,nZ+1-L) * adv_mass(mapCnst(speciesId_3)) / tmpMW_g IF ( K4 > 0 ) State_Chm(LCHNK)%Species(K4)%Conc(1,J,L) = state%q(J,nZ+1-L,speciesId_4) / totMass(J,nZ+1-L) * bulkMass(J,nZ+1-L) * adv_mass(mapCnst(speciesId_4)) / tmpMW_g ELSE + ! Total SOA aerosol masses from GC are unknown. In this case partition the bulkMass by 1/2 to K1 and K2. IF ( K1 == K2 ) THEN + ! ... go in same bin. This actually does not exist in the partitioning above. State_Chm(LCHNK)%Species(K1)%Conc(1,J,L) = bulkMass(J,nZ+1-L) * adv_mass(mapCnst(speciesId_1)) / tmpMW_g ELSE State_Chm(LCHNK)%Species(K1)%Conc(1,J,L) = bulkMass(J,nZ+1-L) * adv_mass(mapCnst(speciesId_1)) / tmpMW_g / 2.0_r8 - State_Chm(LCHNK)%Species(K1)%Conc(1,J,L) = bulkMass(J,nZ+1-L) * adv_mass(mapCnst(speciesId_1)) / tmpMW_g / 2.0_r8 + State_Chm(LCHNK)%Species(K2)%Conc(1,J,L) = bulkMass(J,nZ+1-L) * adv_mass(mapCnst(speciesId_2)) / tmpMW_g / 2.0_r8 ENDIF ENDIF ENDDO ENDDO IF ( K1 > 0 ) MMR_Beg(:nY,:nZ,K1) = State_Chm(LCHNK)%Species(K1)%Conc(1,:nY,:nZ) IF ( K2 > 0 ) MMR_Beg(:nY,:nZ,K2) = State_Chm(LCHNK)%Species(K2)%Conc(1,:nY,:nZ) - IF ( K3 > 0 ) MMR_Beg(:nY,:nZ,K4) = State_Chm(LCHNK)%Species(K3)%Conc(1,:nY,:nZ) - IF ( K4 > 0 ) MMR_Beg(:nY,:nZ,K3) = State_Chm(LCHNK)%Species(K4)%Conc(1,:nY,:nZ) + IF ( K3 > 0 ) MMR_Beg(:nY,:nZ,K3) = State_Chm(LCHNK)%Species(K3)%Conc(1,:nY,:nZ) + IF ( K4 > 0 ) MMR_Beg(:nY,:nZ,K4) = State_Chm(LCHNK)%Species(K4)%Conc(1,:nY,:nZ) ENDDO ENDIF From e07c7d67bb217fb71f43c36a50dcbd611082285d Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Mon, 20 Mar 2023 15:38:22 -0400 Subject: [PATCH 106/291] Fix TSKIN field to correct value --- src/chemistry/geoschem/chemistry.F90 | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/src/chemistry/geoschem/chemistry.F90 b/src/chemistry/geoschem/chemistry.F90 index e801587b1e..14fae16d66 100644 --- a/src/chemistry/geoschem/chemistry.F90 +++ b/src/chemistry/geoschem/chemistry.F90 @@ -2782,12 +2782,18 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) ! Dimensions : nX, nY State_Met(LCHNK)%SLP (1,:nY) = state%ps(:nY)*0.01e+0_fp - ! Field : TS, TSKIN - ! Description: Surface temperature, surface skin temperature + ! Field : TS + ! Description: Surface temperature ! Unit : K ! Dimensions : nX, nY State_Met(LCHNK)%TS (1,:nY) = cam_in%TS(:nY) - State_Met(LCHNK)%TSKIN (1,:nY) = cam_in%TS(:nY) + + ! Field : TSKIN + ! Description: Surface skin temperature + ! Remarks : NOT to be confused with TS (T at 2m) (hplin, 3/20/23) + ! Unit : K + ! Dimensions : nX, nY + State_Met(LCHNK)%TSKIN (1,:nY) = cam_in%SST(:nY) ! Field : SWGDN ! Description: Incident radiation @ ground From bda2db3104138b810df8a2888c033400d1376ddf Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Mon, 20 Mar 2023 15:48:21 -0400 Subject: [PATCH 107/291] Update upstream HEMCO-CESM 1.1.3 --- Externals_CAM.cfg | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Externals_CAM.cfg b/Externals_CAM.cfg index 19fd8351de..15aa548487 100644 --- a/Externals_CAM.cfg +++ b/Externals_CAM.cfg @@ -84,7 +84,7 @@ local_path = src/chemistry/geoschem/geoschem_src required = True [hemco] -tag = hemco-cesm1_1_1_hemco3_6_2 +tag = hemco-cesm1_1_3_hemco3_6_2 protocol = git repo_url = https://github.com/ESCOMP/HEMCO_CESM.git local_path = src/hemco From 935edbb2e2ef27f6d3d7a32c5b9c6a3092786ae6 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Thu, 30 Mar 2023 17:38:27 -0400 Subject: [PATCH 108/291] Fix other indices in the reverse direction. --- src/chemistry/geoschem/chemistry.F90 | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/chemistry/geoschem/chemistry.F90 b/src/chemistry/geoschem/chemistry.F90 index dd8f0c9b1a..9127d3bc6a 100644 --- a/src/chemistry/geoschem/chemistry.F90 +++ b/src/chemistry/geoschem/chemistry.F90 @@ -3927,8 +3927,8 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) ! First deal with lowest two volatility bins speciesName_1 = 'TSOA0' speciesName_2 = 'ASOAN' - speciesName_2 = 'SOAIE' - speciesName_2 = 'SOAGX' + speciesName_3 = 'SOAIE' + speciesName_4 = 'SOAGX' K1 = get_spc_ndx(TRIM(speciesName_1), compare_uppercase=.true.) K2 = get_spc_ndx(TRIM(speciesName_2), compare_uppercase=.true.) K3 = get_spc_ndx(TRIM(speciesName_3), compare_uppercase=.true.) @@ -3986,11 +3986,12 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) ENDDO ! Now deal with gaseous SOA species - ! Deal with lowest two volatility bins + ! Deal with lowest two volatility bins - TSOG0 corresponds to SOAG0 and SOAG1 speciesName_1 = 'TSOG0' K1 = get_spc_ndx(TRIM(speciesName_1), compare_uppercase=.true.) N = lptr2_soa_g_amode(1) P = mapCnst(N) + ! current mode other modes (this mapping was verified to be correct.) vmr1(:nY,:nZ,P) = vmr0(:nY,:nZ,P) / (vmr0(:nY,:nZ,P) + vmr0(:nY,:nZ,mapCnst(lptr2_soa_g_amode(2)))) & * vmr1(:nY,:nZ,K1) N = lptr2_soa_g_amode(2) From 794d1baf1bcd6c7857bbed3dd81dc11f12407f9c Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Tue, 18 Apr 2023 14:33:24 -0400 Subject: [PATCH 109/291] Fix dry and wet deposition for GEOS-Chem non-gas species. --- bld/namelist_files/use_cases/2000_geoschem.xml | 6 +++--- bld/namelist_files/use_cases/2010_geoschem.xml | 6 +++--- bld/namelist_files/use_cases/hist_geoschem.xml | 6 +++--- bld/namelist_files/use_cases/hist_geoschem_nudged.xml | 8 +++++--- bld/namelist_files/use_cases/sd_geoschem.xml | 6 +++--- 5 files changed, 17 insertions(+), 15 deletions(-) diff --git a/bld/namelist_files/use_cases/2000_geoschem.xml b/bld/namelist_files/use_cases/2000_geoschem.xml index e7be6f4774..49b49d6cd6 100644 --- a/bld/namelist_files/use_cases/2000_geoschem.xml +++ b/bld/namelist_files/use_cases/2000_geoschem.xml @@ -12,7 +12,7 @@ /glade/p/univ/umit0034/Shared/GEOS-Chem/f.e20.FC2010.f19_f19.144.GC_vbsext.001.cam.i.0007-01-01-00000.nc -/glade/u/home/elundgren/drydep_henrys_law_nc/dep_data_file_geoschem.nc +/glade/p/univ/umit0034/Shared/dep_data_file_geoschem_c230417.nc @@ -43,12 +43,12 @@ -'ACET','ACTA','ALD2','AROMP4','AROMP5','ATOOH','BALD','BENZP','BR2','BRCL','BRNO3','BZCO3H','BZPAN','CH2O','CL2','CLNO2','CLNO3','CLO','CLOO','CSL','EOH','ETHLN','ETHN','ETHP','ETNO3','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HI','HMHP','HMML','HNO3','HOBR','HOCL','HOI','HONIT','HPALD1','HPALD2','HPALD3','HPALD4','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDC','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','IPRNO3','ITCN','ITHN','LIMO','LVOC','MACR','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MCT','MENO3','MGLY','MOH','MONITS','MONITU','MPAN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','N2O5','NH3','NO2','NPHEN','NPRNO3','O3','PAN','PHEN','PP','PPN','PROPNN','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2' +'ACET','ACTA','ALD2','AROMP4','AROMP5','ATOOH','BALD','BENZP','BR2','BRCL','BRNO3','BZCO3H','BZPAN','CH2O','CL2','CLNO2','CLNO3','CLO','CLOO','CSL','EOH','ETHLN','ETHN','ETHP','ETNO3','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HI','HMHP','HMML','HNO3','HOBR','HOCL','HOI','HONIT','HPALD1','HPALD2','HPALD3','HPALD4','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDC','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','IPRNO3','ITCN','ITHN','LIMO','LVOC','MACR','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MCT','MENO3','MGLY','MOH','MONITS','MONITU','MPAN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','N2O5','NH3','NO2','NPHEN','NPRNO3','O3','PAN','PHEN','PP','PPN','PROPNN','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2','AERI','AONITA','ASOA1','ASOA2','ASOA3','ASOAN','ASOG1','ASOG2','ASOG3','BRSALA','BRSALC','INDIOL','IONITA','ISALA','ISALC','MONITA','MSA','NH4','NIT','NITS','SALAAL','SALACL','SALCAL','SALCCL','SO4S','SOAGX','SOAIE','TSOA0','TSOA1','TSOA2','TSOA3','TSOG0','TSOG1','TSOG2','TSOG3','PFE' -'ACTA','ALD2','AROMP4','AROMP5','ATOOH','BALD','BENZP','BR2','BRCL','BZCO3H','BZPAN','CH2O','CSL','EOH','ETHLN','ETHN','ETHP','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HI','HMHP','HMML','HNO3','HOBR','HOCL','HOI','HONIT','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','ITCN','ITHN','LIMO','LVOC','LVOCOA','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MCT','MEK','MGLY','MOH','MONITS','MONITU','MP','MPAN','MPN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','NH3','NPHEN','PAN','PHEN','PP','PPN','PROPNN','PRPE','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2' +'ACTA','ALD2','AROMP4','AROMP5','ATOOH','BALD','BENZP','BR2','BRCL','BZCO3H','BZPAN','CH2O','CSL','EOH','ETHLN','ETHN','ETHP','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HI','HMHP','HMML','HNO3','HOBR','HOCL','HOI','HONIT','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','ITCN','ITHN','LIMO','LVOC','LVOCOA','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MCT','MEK','MGLY','MOH','MONITS','MONITU','MP','MPAN','MPN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','NH3','NPHEN','PAN','PHEN','PP','PPN','PROPNN','PRPE','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2','AERI','AONITA','ASOA1','ASOA2','ASOA3','ASOAN','ASOG1','ASOG2','ASOG3','BRSALA','BRSALC','INDIOL','IONITA','ISALA','ISALC','MONITA','MSA','NH4','NIT','NITS','SALAAL','SALACL','SALCAL','SALCCL','SO4S','SOAGX','SOAIE','TSOA0','TSOA1','TSOA2','TSOA3','TSOG0','TSOG1','TSOG2','TSOG3','PFE' diff --git a/bld/namelist_files/use_cases/2010_geoschem.xml b/bld/namelist_files/use_cases/2010_geoschem.xml index 56d1182cd8..cf9ae2af8b 100644 --- a/bld/namelist_files/use_cases/2010_geoschem.xml +++ b/bld/namelist_files/use_cases/2010_geoschem.xml @@ -10,7 +10,7 @@ /glade/p/univ/umit0034/Shared/GEOS-Chem/f.e20.FC2010.f19_f19.144.GC_vbsext.001.cam.i.0007-01-01-00000.nc -/glade/u/home/elundgren/drydep_henrys_law_nc/dep_data_file_geoschem.nc +/glade/p/univ/umit0034/Shared/dep_data_file_geoschem_c230417.nc @@ -39,12 +39,12 @@ -'ACET','ACTA','ALD2','AROMP4','AROMP5','ATOOH','BALD','BENZP','BR2','BRCL','BRNO3','BZCO3H','BZPAN','CH2O','CL2','CLNO2','CLNO3','CLO','CLOO','CSL','EOH','ETHLN','ETHN','ETHP','ETNO3','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HI','HMHP','HMML','HNO3','HOBR','HOCL','HOI','HONIT','HPALD1','HPALD2','HPALD3','HPALD4','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDC','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','IPRNO3','ITCN','ITHN','LIMO','LVOC','MACR','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MCT','MENO3','MGLY','MOH','MONITS','MONITU','MPAN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','N2O5','NH3','NO2','NPHEN','NPRNO3','O3','PAN','PHEN','PP','PPN','PROPNN','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2' +'ACET','ACTA','ALD2','AROMP4','AROMP5','ATOOH','BALD','BENZP','BR2','BRCL','BRNO3','BZCO3H','BZPAN','CH2O','CL2','CLNO2','CLNO3','CLO','CLOO','CSL','EOH','ETHLN','ETHN','ETHP','ETNO3','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HI','HMHP','HMML','HNO3','HOBR','HOCL','HOI','HONIT','HPALD1','HPALD2','HPALD3','HPALD4','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDC','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','IPRNO3','ITCN','ITHN','LIMO','LVOC','MACR','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MCT','MENO3','MGLY','MOH','MONITS','MONITU','MPAN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','N2O5','NH3','NO2','NPHEN','NPRNO3','O3','PAN','PHEN','PP','PPN','PROPNN','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2','AERI','AONITA','ASOA1','ASOA2','ASOA3','ASOAN','ASOG1','ASOG2','ASOG3','BRSALA','BRSALC','INDIOL','IONITA','ISALA','ISALC','MONITA','MSA','NH4','NIT','NITS','SALAAL','SALACL','SALCAL','SALCCL','SO4S','SOAGX','SOAIE','TSOA0','TSOA1','TSOA2','TSOA3','TSOG0','TSOG1','TSOG2','TSOG3','PFE' -'ACTA','ALD2','AROMP4','AROMP5','ATOOH','BALD','BENZP','BR2','BRCL','BZCO3H','BZPAN','CH2O','CSL','EOH','ETHLN','ETHN','ETHP','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HI','HMHP','HMML','HNO3','HOBR','HOCL','HOI','HONIT','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','ITCN','ITHN','LIMO','LVOC','LVOCOA','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MCT','MEK','MGLY','MOH','MONITS','MONITU','MP','MPAN','MPN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','NH3','NPHEN','PAN','PHEN','PP','PPN','PROPNN','PRPE','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2' +'ACTA','ALD2','AROMP4','AROMP5','ATOOH','BALD','BENZP','BR2','BRCL','BZCO3H','BZPAN','CH2O','CSL','EOH','ETHLN','ETHN','ETHP','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HI','HMHP','HMML','HNO3','HOBR','HOCL','HOI','HONIT','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','ITCN','ITHN','LIMO','LVOC','LVOCOA','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MCT','MEK','MGLY','MOH','MONITS','MONITU','MP','MPAN','MPN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','NH3','NPHEN','PAN','PHEN','PP','PPN','PROPNN','PRPE','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2','AERI','AONITA','ASOA1','ASOA2','ASOA3','ASOAN','ASOG1','ASOG2','ASOG3','BRSALA','BRSALC','INDIOL','IONITA','ISALA','ISALC','MONITA','MSA','NH4','NIT','NITS','SALAAL','SALACL','SALCAL','SALCCL','SO4S','SOAGX','SOAIE','TSOA0','TSOA1','TSOA2','TSOA3','TSOG0','TSOG1','TSOG2','TSOG3','PFE' diff --git a/bld/namelist_files/use_cases/hist_geoschem.xml b/bld/namelist_files/use_cases/hist_geoschem.xml index 161db508ee..83d3fc39ba 100644 --- a/bld/namelist_files/use_cases/hist_geoschem.xml +++ b/bld/namelist_files/use_cases/hist_geoschem.xml @@ -12,7 +12,7 @@ /glade/p/univ/umit0034/Shared/GEOS-Chem/f.e20.FC2010.f19_f19.144.GC_vbsext.001.cam.i.0007-01-01-00000.nc -/glade/u/home/elundgren/drydep_henrys_law_nc/dep_data_file_geoschem.nc +/glade/p/univ/umit0034/Shared/dep_data_file_geoschem_c230417.nc @@ -37,12 +37,12 @@ -'ACET','ACTA','ALD2','AROMP4','AROMP5','ATOOH','BALD','BENZP','BR2','BRCL','BRNO3','BZCO3H','BZPAN','CH2O','CL2','CLNO2','CLNO3','CLO','CLOO','CSL','EOH','ETHLN','ETHN','ETHP','ETNO3','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HI','HMHP','HMML','HNO3','HOBR','HOCL','HOI','HONIT','HPALD1','HPALD2','HPALD3','HPALD4','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDC','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','IPRNO3','ITCN','ITHN','LIMO','LVOC','LVOCOA','MACR','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MCT','MENO3','MGLY','MOH','MONITS','MONITU','MPAN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','N2O5','NH3','NO2','NPHEN','NPRNO3','O3','PAN','PHEN','PP','PPN','PROPNN','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2' +'ACET','ACTA','ALD2','AROMP4','AROMP5','ATOOH','BALD','BENZP','BR2','BRCL','BRNO3','BZCO3H','BZPAN','CH2O','CL2','CLNO2','CLNO3','CLO','CLOO','CSL','EOH','ETHLN','ETHN','ETHP','ETNO3','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HI','HMHP','HMML','HNO3','HOBR','HOCL','HOI','HONIT','HPALD1','HPALD2','HPALD3','HPALD4','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDC','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','IPRNO3','ITCN','ITHN','LIMO','LVOC','LVOCOA','MACR','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MCT','MENO3','MGLY','MOH','MONITS','MONITU','MPAN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','N2O5','NH3','NO2','NPHEN','NPRNO3','O3','PAN','PHEN','PP','PPN','PROPNN','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2','AERI','AONITA','ASOA1','ASOA2','ASOA3','ASOAN','ASOG1','ASOG2','ASOG3','BRSALA','BRSALC','INDIOL','IONITA','ISALA','ISALC','MONITA','MSA','NH4','NIT','NITS','SALAAL','SALACL','SALCAL','SALCCL','SO4S','SOAGX','SOAIE','TSOA0','TSOA1','TSOA2','TSOA3','TSOG0','TSOG1','TSOG2','TSOG3','PFE' -'ACTA','ALD2','AROMP4','AROMP5','ATOOH','BALD','BENZP','BR2','BRCL','BZCO3H','BZPAN','CH2O','CSL','EOH','ETHLN','ETHN','ETHP','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HI','HMHP','HMML','HNO3','HOBR','HOCL','HOI','HONIT','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','ITCN','ITHN','LIMO','LVOC','LVOCOA','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MCT','MEK','MGLY','MOH','MONITS','MONITU','MP','MPAN','MPN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','NH3','NPHEN','PAN','PHEN','PP','PPN','PROPNN','PRPE','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2' +'ACTA','ALD2','AROMP4','AROMP5','ATOOH','BALD','BENZP','BR2','BRCL','BZCO3H','BZPAN','CH2O','CSL','EOH','ETHLN','ETHN','ETHP','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HI','HMHP','HMML','HNO3','HOBR','HOCL','HOI','HONIT','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','ITCN','ITHN','LIMO','LVOC','LVOCOA','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MCT','MEK','MGLY','MOH','MONITS','MONITU','MP','MPAN','MPN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','NH3','NPHEN','PAN','PHEN','PP','PPN','PROPNN','PRPE','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2','AERI','AONITA','ASOA1','ASOA2','ASOA3','ASOAN','ASOG1','ASOG2','ASOG3','BRSALA','BRSALC','INDIOL','IONITA','ISALA','ISALC','MONITA','MSA','NH4','NIT','NITS','SALAAL','SALACL','SALCAL','SALCCL','SO4S','SOAGX','SOAIE','TSOA0','TSOA1','TSOA2','TSOA3','TSOG0','TSOG1','TSOG2','TSOG3','PFE' diff --git a/bld/namelist_files/use_cases/hist_geoschem_nudged.xml b/bld/namelist_files/use_cases/hist_geoschem_nudged.xml index 2b1bcf64f9..cf75619028 100644 --- a/bld/namelist_files/use_cases/hist_geoschem_nudged.xml +++ b/bld/namelist_files/use_cases/hist_geoschem_nudged.xml @@ -12,7 +12,7 @@ /glade/p/univ/umit0034/Shared/GEOS-Chem/f.e20.FC2010.f19_f19.144.GC_vbsext.001.cam.i.0007-01-01-00000.nc -/glade/u/home/elundgren/drydep_henrys_law_nc/dep_data_file_geoschem.nc +/glade/p/univ/umit0034/Shared/dep_data_file_geoschem_c230417.nc @@ -91,13 +91,15 @@ + + -'ACET','ACTA','ALD2','AROMP4','AROMP5','ATOOH','BALD','BENZP','BR2','BRCL','BRNO3','BZCO3H','BZPAN','CH2O','CL2','CLNO2','CLNO3','CLO','CLOO','CSL','EOH','ETHLN','ETHN','ETHP','ETNO3','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HI','HMHP','HMML','HNO3','HOBR','HOCL','HOI','HONIT','HPALD1','HPALD2','HPALD3','HPALD4','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDC','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','IPRNO3','ITCN','ITHN','LIMO','LVOC','LVOCOA','MACR','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MCT','MENO3','MGLY','MOH','MONITS','MONITU','MPAN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','N2O5','NH3','NO2','NPHEN','NPRNO3','O3','PAN','PHEN','PP','PPN','PROPNN','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2' +'ACET','ACTA','ALD2','AROMP4','AROMP5','ATOOH','BALD','BENZP','BR2','BRCL','BRNO3','BZCO3H','BZPAN','CH2O','CL2','CLNO2','CLNO3','CLO','CLOO','CSL','EOH','ETHLN','ETHN','ETHP','ETNO3','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HI','HMHP','HMML','HNO3','HOBR','HOCL','HOI','HONIT','HPALD1','HPALD2','HPALD3','HPALD4','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDC','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','IPRNO3','ITCN','ITHN','LIMO','LVOC','LVOCOA','MACR','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MCT','MENO3','MGLY','MOH','MONITS','MONITU','MPAN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','N2O5','NH3','NO2','NPHEN','NPRNO3','O3','PAN','PHEN','PP','PPN','PROPNN','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2','AERI','AONITA','ASOA1','ASOA2','ASOA3','ASOAN','ASOG1','ASOG2','ASOG3','BRSALA','BRSALC','INDIOL','IONITA','ISALA','ISALC','MONITA','MSA','NH4','NIT','NITS','SALAAL','SALACL','SALCAL','SALCCL','SO4S','SOAGX','SOAIE','TSOA0','TSOA1','TSOA2','TSOA3','TSOG0','TSOG1','TSOG2','TSOG3','PFE' -'ACTA','ALD2','AROMP4','AROMP5','ATOOH','BALD','BENZP','BR2','BRCL','BZCO3H','BZPAN','CH2O','CSL','EOH','ETHLN','ETHN','ETHP','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HI','HMHP','HMML','HNO3','HOBR','HOCL','HOI','HONIT','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','ITCN','ITHN','LIMO','LVOC','LVOCOA','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MCT','MEK','MGLY','MOH','MONITS','MONITU','MP','MPAN','MPN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','NH3','NPHEN','PAN','PHEN','PP','PPN','PROPNN','PRPE','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2' +'ACTA','ALD2','AROMP4','AROMP5','ATOOH','BALD','BENZP','BR2','BRCL','BZCO3H','BZPAN','CH2O','CSL','EOH','ETHLN','ETHN','ETHP','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HI','HMHP','HMML','HNO3','HOBR','HOCL','HOI','HONIT','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','ITCN','ITHN','LIMO','LVOC','LVOCOA','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MCT','MEK','MGLY','MOH','MONITS','MONITU','MP','MPAN','MPN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','NH3','NPHEN','PAN','PHEN','PP','PPN','PROPNN','PRPE','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2','AERI','AONITA','ASOA1','ASOA2','ASOA3','ASOAN','ASOG1','ASOG2','ASOG3','BRSALA','BRSALC','INDIOL','IONITA','ISALA','ISALC','MONITA','MSA','NH4','NIT','NITS','SALAAL','SALACL','SALCAL','SALCCL','SO4S','SOAGX','SOAIE','TSOA0','TSOA1','TSOA2','TSOA3','TSOG0','TSOG1','TSOG2','TSOG3','PFE' diff --git a/bld/namelist_files/use_cases/sd_geoschem.xml b/bld/namelist_files/use_cases/sd_geoschem.xml index 04e5e60e5a..41647f8ecb 100644 --- a/bld/namelist_files/use_cases/sd_geoschem.xml +++ b/bld/namelist_files/use_cases/sd_geoschem.xml @@ -14,7 +14,7 @@ /glade/p/univ/umit0034/Shared/GEOS-Chem/f.e20.FCSD.f09_f09_mg17.cesm2.1-exp002.001.cam.i.2005-01-01-00000_c180801.nc atm/cam/met/MERRA2/0.9x1.25/fv_0.9x1.25_nc3000_Nsw042_Nrs008_Co060_Fi001_ZR_sgh30_24km_GRNL_MERRA2_c171218.nc -/glade/u/home/elundgren/drydep_henrys_law_nc/dep_data_file_geoschem.nc +/glade/p/univ/umit0034/Shared/dep_data_file_geoschem_c230417.nc @@ -57,12 +57,12 @@ -'ACET','ACTA','ALD2','AROMP4','AROMP5','ATOOH','BALD','BENZP','BR2','BRCL','BRNO3','BZCO3H','BZPAN','CH2O','CL2','CLNO2','CLNO3','CLO','CLOO','CSL','EOH','ETHLN','ETHN','ETHP','ETNO3','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HI','HMHP','HMML','HNO3','HOBR','HOCL','HOI','HONIT','HPALD1','HPALD2','HPALD3','HPALD4','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDC','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','IPRNO3','ITCN','ITHN','LIMO','LVOC','MACR','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MCT','MENO3','MGLY','MOH','MONITS','MONITU','MPAN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','N2O5','NH3','NO2','NPHEN','NPRNO3','O3','PAN','PHEN','PP','PPN','PROPNN','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2' +'ACET','ACTA','ALD2','AROMP4','AROMP5','ATOOH','BALD','BENZP','BR2','BRCL','BRNO3','BZCO3H','BZPAN','CH2O','CL2','CLNO2','CLNO3','CLO','CLOO','CSL','EOH','ETHLN','ETHN','ETHP','ETNO3','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HI','HMHP','HMML','HNO3','HOBR','HOCL','HOI','HONIT','HPALD1','HPALD2','HPALD3','HPALD4','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDC','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','IPRNO3','ITCN','ITHN','LIMO','LVOC','MACR','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MCT','MENO3','MGLY','MOH','MONITS','MONITU','MPAN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','N2O5','NH3','NO2','NPHEN','NPRNO3','O3','PAN','PHEN','PP','PPN','PROPNN','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2','AERI','AONITA','ASOA1','ASOA2','ASOA3','ASOAN','ASOG1','ASOG2','ASOG3','BRSALA','BRSALC','INDIOL','IONITA','ISALA','ISALC','MONITA','MSA','NH4','NIT','NITS','SALAAL','SALACL','SALCAL','SALCCL','SO4S','SOAGX','SOAIE','TSOA0','TSOA1','TSOA2','TSOA3','TSOG0','TSOG1','TSOG2','TSOG3','PFE' -'ACTA','ALD2','AROMP4','AROMP5','ATOOH','BALD','BENZP','BR2','BRCL','BZCO3H','BZPAN','CH2O','CSL','EOH','ETHLN','ETHN','ETHP','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HI','HMHP','HMML','HNO3','HOBR','HOCL','HOI','HONIT','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','ITCN','ITHN','LIMO','LVOC','LVOCOA','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MCT','MEK','MGLY','MOH','MONITS','MONITU','MP','MPAN','MPN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','NH3','NPHEN','PAN','PHEN','PP','PPN','PROPNN','PRPE','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2' +'ACTA','ALD2','AROMP4','AROMP5','ATOOH','BALD','BENZP','BR2','BRCL','BZCO3H','BZPAN','CH2O','CSL','EOH','ETHLN','ETHN','ETHP','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HI','HMHP','HMML','HNO3','HOBR','HOCL','HOI','HONIT','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','ITCN','ITHN','LIMO','LVOC','LVOCOA','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MCT','MEK','MGLY','MOH','MONITS','MONITU','MP','MPAN','MPN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','NH3','NPHEN','PAN','PHEN','PP','PPN','PROPNN','PRPE','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2','AERI','AONITA','ASOA1','ASOA2','ASOA3','ASOAN','ASOG1','ASOG2','ASOG3','BRSALA','BRSALC','INDIOL','IONITA','ISALA','ISALC','MONITA','MSA','NH4','NIT','NITS','SALAAL','SALACL','SALCAL','SALCCL','SO4S','SOAGX','SOAIE','TSOA0','TSOA1','TSOA2','TSOA3','TSOG0','TSOG1','TSOG2','TSOG3','PFE' From a16a4ffbe3c5c10ac844abd56a27dcb52777a083 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Tue, 18 Apr 2023 16:09:21 -0600 Subject: [PATCH 110/291] Fix GEOS-Chem tests by replacing StrSplit in chem_readnl For some reason the StrSplit routine in GEOS-Chem charpak_mod.F90 has unexpected behavior when run within the CAM test suite. Replacing it with basic Fortran fixes the issue reading advected species from geoschem_config.yml. Signed-off-by: Lizzie Lundgren --- cime_config/testdefs/testlist_cam.xml | 2 +- src/chemistry/geoschem/chemistry.F90 | 15 ++++++++------- 2 files changed, 9 insertions(+), 8 deletions(-) diff --git a/cime_config/testdefs/testlist_cam.xml b/cime_config/testdefs/testlist_cam.xml index 9ffad598cd..4806d18d52 100644 --- a/cime_config/testdefs/testlist_cam.xml +++ b/cime_config/testdefs/testlist_cam.xml @@ -19,7 +19,7 @@ - + diff --git a/src/chemistry/geoschem/chemistry.F90 b/src/chemistry/geoschem/chemistry.F90 index 41b1464d51..dea62ead0e 100644 --- a/src/chemistry/geoschem/chemistry.F90 +++ b/src/chemistry/geoschem/chemistry.F90 @@ -686,7 +686,6 @@ subroutine chem_readnl(nlfile) #endif use gckpp_Model, only : nSpec, Spc_Names use chem_mods, only : drySpc_ndx - use charpak_mod, only : strsplit ! args CHARACTER(LEN=*), INTENT(IN) :: nlfile ! filepath for file containing namelist input @@ -771,7 +770,6 @@ subroutine chem_readnl(nlfile) Write(iulog,'(/,a,/)') 'Now defining GEOS-Chem tracers and dry deposition mapping...' - !============================================================== ! Read GEOS-Chem advected species from geoschem_config.yml !============================================================== @@ -791,7 +789,7 @@ subroutine chem_readnl(nlfile) IF ( INDEX( LINE, 'transported_species' ) > 0 ) EXIT ENDDO - if (debug .and. masterproc) write(iulog,'(a)') 'chem_readnl: reading advected species list from geoschem_config.yml' + if (debug) write(iulog,'(a)') 'chem_readnl: reading advected species list from geoschem_config.yml' ! Read in all advected species names and add them to tracer names list nTracers = 0 @@ -799,12 +797,11 @@ subroutine chem_readnl(nlfile) READ(unitn,'(a)', IOSTAT=IERR) line IF ( IERR .NE. 0 ) CALL ENDRUN('chem_readnl: error setting adv spc list') line = ADJUSTL( ADJUSTR( line ) ) - IF ( INDEX( line, 'passive_species' ) > 0 ) EXIT - CALL StrSplit( line, '-', substrs, N ) IF ( INDEX( LINE, '-' ) > 0 ) THEN + substrs(1) = LINE(3:) substrs(1) = ADJUSTL( ADJUSTR( substrs(1) ) ) - + ! Remove quotes (i.e. 'NO' -> NO) I = INDEX( substrs(1), "'" ) IF ( I > 0 ) THEN @@ -857,7 +854,11 @@ subroutine chem_readnl(nlfile) !============================================================== unitn = getunit() - OPEN( unitn, FILE=TRIM(nlfile), STATUS='old' ) + OPEN( unitn, FILE=TRIM(nlfile), STATUS='old', IOSTAT=IERR ) + IF (IERR .NE. 0) THEN + CALL ENDRUN('chem_readnl: ERROR opening '//TRIM(nlfile)) + ENDIF + CALL find_group_name(unitn, 'chem_inparm', STATUS=IERR) IF (IERR == 0) THEN READ(unitn, chem_inparm, IOSTAT=IERR) From 1eccc4920f8dc67b27ba4f7693dd025bdc978f67 Mon Sep 17 00:00:00 2001 From: Brian Eaton Date: Fri, 5 May 2023 12:59:20 -0400 Subject: [PATCH 111/291] merge rrtmgp code from brianpm fork --- Externals_CAM.cfg | 7 + bld/build-namelist | 31 +- bld/config_files/definition.xml | 4 +- bld/configure | 12 +- bld/namelist_files/namelist_defaults_cam.xml | 72 + bld/namelist_files/namelist_definition.xml | 21 +- .../usermods_dirs/rrtmgp/shell_commands | 7 + cime_config/usermods_dirs/rrtmgp/user_nl_cam | 11 + .../usermods_dirs/scam_rrtmgp/shell_commands | 21 + .../usermods_dirs/scam_rrtmgp/user_nl_cam | 15 + src/physics/cam/modal_aer_opt.F90 | 16 +- src/physics/rrtmg/radiation.F90 | 6 + src/physics/rrtmgp/b_checker.f90 | 163 + src/physics/rrtmgp/cloud_rad_props.F90 | 840 +++++ src/physics/rrtmgp/ebert_curry.F90 | 408 +++ src/physics/rrtmgp/mcica_subcol_gen.F90 | 293 ++ src/physics/rrtmgp/oldcloud.F90 | 643 ++++ src/physics/rrtmgp/rad_solar_var.F90 | 148 + src/physics/rrtmgp/radconstants.F90 | 427 +++ src/physics/rrtmgp/radiation.F90 | 3070 +++++++++++++++++ src/physics/rrtmgp/rrtmgp_driver.F90 | 386 +++ src/physics/rrtmgp/rrtmgp_inputs.F90 | 838 +++++ src/physics/rrtmgp/slingo.F90 | 409 +++ 23 files changed, 7832 insertions(+), 16 deletions(-) create mode 100755 cime_config/usermods_dirs/rrtmgp/shell_commands create mode 100644 cime_config/usermods_dirs/rrtmgp/user_nl_cam create mode 100755 cime_config/usermods_dirs/scam_rrtmgp/shell_commands create mode 100644 cime_config/usermods_dirs/scam_rrtmgp/user_nl_cam create mode 100644 src/physics/rrtmgp/b_checker.f90 create mode 100644 src/physics/rrtmgp/cloud_rad_props.F90 create mode 100644 src/physics/rrtmgp/ebert_curry.F90 create mode 100644 src/physics/rrtmgp/mcica_subcol_gen.F90 create mode 100644 src/physics/rrtmgp/oldcloud.F90 create mode 100644 src/physics/rrtmgp/rad_solar_var.F90 create mode 100644 src/physics/rrtmgp/radconstants.F90 create mode 100644 src/physics/rrtmgp/radiation.F90 create mode 100644 src/physics/rrtmgp/rrtmgp_driver.F90 create mode 100644 src/physics/rrtmgp/rrtmgp_inputs.F90 create mode 100644 src/physics/rrtmgp/slingo.F90 diff --git a/Externals_CAM.cfg b/Externals_CAM.cfg index caba5270c2..a87d3b1719 100644 --- a/Externals_CAM.cfg +++ b/Externals_CAM.cfg @@ -1,3 +1,10 @@ +[rrtmgp] +local_path = src/physics/rrtmgp/ext +protocol = git +repo_url = https://github.com/earth-system-radiation/rte-rrtmgp.git +tag = v1.6 +required = True + [chem_proc] local_path = chem_proc protocol = git diff --git a/bld/build-namelist b/bld/build-namelist index 2cec1b4a51..fe4e4af791 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -670,6 +670,22 @@ my $rad_pkg = $cfg->get('rad'); if ($rad_pkg eq 'camrt') { add_default($nl, 'absems_data'); } +elsif ($rad_pkg eq 'rrtmgp') { + # Data for gas optics is provided with the source code. The paths to this data + # are relative to the root directory of the cam component. + my $cam_dir = $cfg->get('cam_dir'); + + add_default($nl, 'rrtmgp_coefs_lw_file'); + my $rel_path = $nl->get_value('rrtmgp_coefs_lw_file'); + my $abs_path = quote_string(set_abs_filepath($rel_path, $cam_dir)); + # need to overwrite the relative pathname with the absolute pathname in the namelist object + $nl->set_variable_value('radiation_nl', 'rrtmgp_coefs_lw_file', $abs_path); + + add_default($nl, 'rrtmgp_coefs_sw_file'); + $rel_path = $nl->get_value('rrtmgp_coefs_sw_file'); + my $abs_path = quote_string(set_abs_filepath($rel_path, $cam_dir)); + $nl->set_variable_value('radiation_nl', 'rrtmgp_coefs_sw_file', $abs_path); +} # Solar irradiance @@ -681,15 +697,18 @@ if (defined $nl->get_value('solar_const') and } -if ($rad_pkg eq 'rrtmg' or $chem =~ /waccm/) { +if ($rad_pkg =~ /rrtmg/ or $chem =~ /waccm/) { if (defined $nl->get_value('solar_const')) { - die "$ProgName - ERROR: Specifying solar_const with RRTMG or WACCM is not allowed.\n" + die "$ProgName - ERROR: Specifying solar_const with RRTMG/RRTMGP or WACCM is not allowed.\n" } # use solar data file as the default for rrtmg and waccm_ma add_default($nl, 'solar_irrad_data_file'); - add_default($nl, 'solar_htng_spctrl_scl', 'val'=>'.true.'); + # restrict this option to just the rrtmg code + if ($rad_pkg eq 'rrtmg') { + add_default($nl, 'solar_htng_spctrl_scl', 'val'=>'.true.'); + } } elsif (!$simple_phys) { @@ -1095,7 +1114,7 @@ if ($aer_model eq 'mam' ) { } if ($rad_prog_sslt) { - if ($rrtmg) { + if ($rad_pkg =~ /rrtmg/) { push(@aero_names, "SSLT01", "SSLT02", "SSLT03", "SSLT04"); push(@aerosources, "A:", "A:", "A:", "A:" ); } else { @@ -1103,7 +1122,7 @@ if ($aer_model eq 'mam' ) { push(@aerosources, "N:", "N:"); } } elsif ($moz_aero_data =~ /$TRUE/io ) { - if ($rrtmg) { + if ($rad_pkg =~ /rrtmg/) { push(@aero_names, "sslt1", "sslt2", "sslt3", "sslt4"); push(@aerosources, "N:", "N:", "N:", "N:" ); } else { @@ -1618,7 +1637,7 @@ if ($rad_pkg ne 'none') { } # Cloud optics -if ($rrtmg) { +if ($rad_pkg =~ /rrtmg/) { # matches both rrtmg and rrtmgp add_default($nl, 'liqcldoptics'); add_default($nl, 'icecldoptics'); add_default($nl, 'liqopticsfile'); diff --git a/bld/config_files/definition.xml b/bld/config_files/definition.xml index 095bf87d97..1cac857da4 100644 --- a/bld/config_files/definition.xml +++ b/bld/config_files/definition.xml @@ -83,9 +83,9 @@ on Mapes and Neale (2011): 0 => no, 1 => yes PBL package: uw (University of Washington), hb (Holtslag and Boville), hbr (Holtslag, Boville, and Rasch), clubb_sgs, spcam_sam1om, spcam_m2005, none. - + Radiative transfer calculation: -camrt (CAM3 and CAM4 RT package), rrtmg (RRTMG package from AER). +camrt (CAM3 and CAM4 RT package), rrtmg (RRTMG package from AER), rrtmgp (updated version). CARMA sectional microphysics: diff --git a/bld/configure b/bld/configure index 3bb8f8958b..1bfb2b3983 100755 --- a/bld/configure +++ b/bld/configure @@ -102,7 +102,7 @@ OPTIONS -prog_species Comma-separate list of prognostic mozart species packages. Currently available: DST,SSLT,SO4,GHG,OC,BC,CARBON16 -psubcols Maximum number of sub-columns in a run - set to 1 if not using sub-columns (default) - -rad Specify the radiation package [rrtmg | camrt] + -rad Specify the radiation package [rrtmg | rrtmgp | camrt] -silhs Switch on SILHS. -spcam_clubb_sgs Turn on the SPCAM version of CLUBB -spcam_nx SPCAM x-grid. - defaults to 4 (note the CRM requires spcam_nx to be greater than or equal to 4) @@ -2162,6 +2162,16 @@ sub write_filepath elsif ($rad eq 'camrt') { print $fh "$camsrcdir/src/physics/camrt\n"; } + elsif ($rad eq 'rrtmgp') { + print $fh "$camsrcdir/src/physics/rrtmgp\n"; + print $fh "$camsrcdir/src/physics/rrtmgp/ext\n"; + print $fh "$camsrcdir/src/physics/rrtmgp/ext/rrtmgp\n"; + print $fh "$camsrcdir/src/physics/rrtmgp/ext/rte\n"; + print $fh "$camsrcdir/src/physics/rrtmgp/ext/rte/kernels\n"; + print $fh "$camsrcdir/src/physics/rrtmgp/ext/rrtmgp/kernels\n"; + print $fh "$camsrcdir/src/physics/rrtmgp/ext/extensions\n"; + print $fh "$camsrcdir/src/physics/rrtmgp/ext/extensions/cloud_optics\n"; + } if ($clubb_sgs) { print $fh "$camsrcdir/src/physics/clubb\n"; diff --git a/bld/namelist_files/namelist_defaults_cam.xml b/bld/namelist_files/namelist_defaults_cam.xml index 3444771dae..a765e0ea59 100644 --- a/bld/namelist_files/namelist_defaults_cam.xml +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -426,6 +426,36 @@ atm/cam/physprops/ssam_rrtmg_c080918.nc atm/cam/physprops/sscm_rrtmg_c080918.nc + +atm/cam/physprops/sulfate_rrtmg_c080918.nc +atm/cam/physprops/sulfate_rrtmg_c080918.nc +atm/cam/physprops/dust1_rrtmg_c080918.nc +atm/cam/physprops/dust1_rrtmg_c080918.nc +atm/cam/physprops/dust2_rrtmg_c080918.nc +atm/cam/physprops/dust2_rrtmg_c080918.nc +atm/cam/physprops/dust3_rrtmg_c080918.nc +atm/cam/physprops/dust3_rrtmg_c080918.nc +atm/cam/physprops/dust4_rrtmg_c080918.nc +atm/cam/physprops/dust4_rrtmg_c080918.nc +atm/cam/physprops/bcpho_rrtmg_c080918.nc +atm/cam/physprops/bcpho_rrtmg_c080918.nc +atm/cam/physprops/bcphi_rrtmg_c080918.nc +atm/cam/physprops/bcphi_rrtmg_c080918.nc +atm/cam/physprops/ocpho_rrtmg_c080918.nc +atm/cam/physprops/ocpho_rrtmg_c080918.nc +atm/cam/physprops/ocphi_rrtmg_c080918.nc +atm/cam/physprops/ocphi_rrtmg_c080918.nc +atm/cam/physprops/seasalt1_rrtmg_c080918.nc +atm/cam/physprops/seasalt1_rrtmg_c080918.nc +atm/cam/physprops/seasalt2_rrtmg_c080918.nc +atm/cam/physprops/seasalt2_rrtmg_c080918.nc +atm/cam/physprops/seasalt3_rrtmg_c080918.nc +atm/cam/physprops/seasalt3_rrtmg_c080918.nc +atm/cam/physprops/seasalt4_rrtmg_c080918.nc +atm/cam/physprops/seasalt4_rrtmg_c080918.nc +atm/cam/physprops/ssam_rrtmg_c080918.nc +atm/cam/physprops/sscm_rrtmg_c080918.nc + @@ -437,6 +467,15 @@ atm/cam/physprops/ssam_rrtmg_c100508.nc atm/cam/physprops/dust_aeronet_rrtmg_c141106.nc atm/cam/physprops/sulfate_rrtmg_c080918.nc + +atm/cam/physprops/sulfate_rrtmg_c080918.nc +atm/cam/physprops/ocpho_rrtmg_c101112.nc +atm/cam/physprops/ocpho_rrtmg_c130709.nc +atm/cam/physprops/ocphi_rrtmg_c100508.nc +atm/cam/physprops/bcpho_rrtmg_c100508.nc +atm/cam/physprops/ssam_rrtmg_c100508.nc +atm/cam/physprops/dust_aeronet_rrtmg_c141106.nc +atm/cam/physprops/sulfate_rrtmg_c080918.nc atm/cam/physprops/volc_camRT_byradius_sigma1.6_c130724.nc @@ -445,6 +484,11 @@ atm/cam/physprops/volc_camRRTMG_byradius_sigma1.6_mode1_c210211.nc atm/cam/physprops/volc_camRRTMG_byradius_sigma1.6_mode2_c210211.nc atm/cam/physprops/volc_camRRTMG_byradius_sigma1.2_mode3_c210211.nc + +atm/cam/physprops/volc_camRRTMG_byradius_sigma1.6_c130724.nc +atm/cam/physprops/volc_camRRTMG_byradius_sigma1.6_mode1_c210211.nc +atm/cam/physprops/volc_camRRTMG_byradius_sigma1.6_mode2_c210211.nc +atm/cam/physprops/volc_camRRTMG_byradius_sigma1.2_mode3_c210211.nc atm/cam/physprops/mam4_mode1_rrtmg_aeronetdust_c141106.nc @@ -475,6 +519,25 @@ atm/cam/physprops/mam7_mode5_rrtmg_c120904.nc atm/cam/physprops/mam7_mode6_rrtmg_c120904.nc atm/cam/physprops/mam7_mode7_rrtmg_c120904.nc + +atm/cam/physprops/mam4_mode1_rrtmg_aeronetdust_c141106.nc +atm/cam/physprops/mam4_mode2_rrtmg_aitkendust_c141106.nc +atm/cam/physprops/mam4_mode3_rrtmg_aeronetdust_c141106.nc +atm/cam/physprops/mam4_mode1_rrtmg_aeronetdust_sig1.6_dgnh.48_c140304.nc +atm/cam/physprops/mam4_mode3_rrtmg_aeronetdust_sig1.2_dgnl.40_c150219.nc +atm/cam/physprops/mam4_mode1_rrtmg_aeronetdust_c141106.nc +atm/cam/physprops/mam4_mode2_rrtmg_aitkendust_c141106.nc +atm/cam/physprops/mam4_mode3_rrtmg_aeronetdust_c141106.nc +atm/cam/physprops/mam4_mode4_rrtmg_c130628.nc +atm/cam/physprops/mam4_mode1_rrtmg_aeronetdust_sig1.6_dgnh.48_c140304.nc +atm/cam/physprops/mam4_mode3_rrtmg_aeronetdust_sig1.2_dgnl.40_c150219.nc +atm/cam/physprops/mam7_mode1_rrtmg_c120904.nc +atm/cam/physprops/mam7_mode2_rrtmg_c120904.nc +atm/cam/physprops/mam7_mode3_rrtmg_c120904.nc +atm/cam/physprops/mam7_mode4_rrtmg_c120904.nc +atm/cam/physprops/mam7_mode5_rrtmg_c120904.nc +atm/cam/physprops/mam7_mode6_rrtmg_c120904.nc +atm/cam/physprops/mam7_mode7_rrtmg_c120904.nc atm/cam/physprops/water_refindex_rrtmg_c080910.nc @@ -490,6 +553,15 @@ atm/cam/physprops/iceoptics_c080917.nc atm/cam/physprops/F_nwvl200_mu20_lam50_res64_t298_c080428.nc + +gammadist +mitchell +atm/cam/physprops/iceoptics_c080917.nc +atm/cam/physprops/F_nwvl200_mu20_lam50_res64_t298_c080428.nc + +src/physics/rrtmgp/ext/rrtmgp/data/rrtmgp-data-lw-g128-210809.nc +src/physics/rrtmgp/ext/rrtmgp/data/rrtmgp-data-sw-g112-210809.nc + atm/cam/rad/abs_ems_factors_fastvx.c030508.nc diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index 14b0dcfc8c..1ad86f2bdc 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -5219,7 +5219,7 @@ Default: Unused + group="phys_ctl_nl" valid_values="rrtmgp,rrtmg,camrt" > Type of radiation scheme employed. Default: set by build-namelist @@ -5409,6 +5409,25 @@ Switch to turn on Fixed Dynamical Heating in the offline radiation tool (PORT). Default: false + + + +Relative pathname for LW gas optics coefficients for RRTMGP. This data is +part of the RRTMGP source, thus this pathname is relative to the root source +code directory for the CAM component. +Default: set by build-namelist. + + + +Relative pathname for SW gas optics coefficients for RRTMGP. This data is +part of the RRTMGP source, thus this pathname is relative to the root source +code directory for the CAM component. +Default: set by build-namelist. + + + max_bound ) then + err_message = "validate: array values too large" + end if + end subroutine + + subroutine check_bounds_2d(arr, max_bound, min_bound, err_message) + real(r8), intent(in) :: arr(:,:) + real(r8), intent(in) :: max_bound, min_bound + character(len=128), intent(out) :: err_message + real(r8) :: mx, mn + err_message = '' + mx = maxval(arr) + mn = minval(arr) + if (mn < min_bound) then + err_message = "validate: array values too small " + end if + if (mx > max_bound ) then + err_message = "validate: array values too large" + end if + end subroutine + + subroutine check_bounds_3d(arr, max_bound, min_bound, err_message) + real(r8), intent(in) :: arr(:,:,:) + real(r8), intent(in) :: max_bound, min_bound + character(len=128), intent(out) :: err_message + real(r8) :: mx, mn + err_message = '' + mx = maxval(arr) + mn = minval(arr) + if (mn < min_bound) then + err_message = "validate: array values too small " + end if + if (mx > max_bound ) then + err_message = "validate: array values too large" + end if + end subroutine + + subroutine check_bounds_4d(arr, max_bound, min_bound, err_message) + real(r8), intent(in) :: arr(:,:,:,:) + real(r8), intent(in) :: max_bound, min_bound + character(len=128), intent(out) :: err_message + real(r8) :: mx, mn + err_message = '' + mx = maxval(arr) + mn = minval(arr) + if (mn < min_bound) then + err_message = "validate: array values too small " + end if + if (mx > max_bound ) then + err_message = "validate: array values too large" + end if + end subroutine + + subroutine check_bounds_5d(arr, max_bound, min_bound, err_message) + real(r8), intent(in) :: arr(:,:,:,:,:) + real(r8), intent(in) :: max_bound, min_bound + character(len=128), intent(out) :: err_message + real(r8) :: mx, mn + err_message = '' + mx = maxval(arr) + mn = minval(arr) + if (mn < min_bound) then + err_message = "validate: array values too small " + end if + if (mx > max_bound ) then + err_message = "validate: array values too large" + end if + end subroutine + + subroutine check_bounds_gas_concs(ncol, nlay, gasconcs, err_message) + integer, intent(in) :: ncol, nlay + type(ty_gas_concs), intent(in) :: gasconcs + character(len=128), intent(out) :: err_message + character(32), dimension(gasconcs%get_num_gases()) :: gc_gas_names + integer :: i + real(r8) :: vmr(ncol,nlay) + gc_gas_names(:) = gasconcs%get_gas_names() + do i = 1, gasconcs%get_num_gases() + err_message = gasconcs%get_vmr(gc_gas_names(i), vmr) ! gets values in vmr + if (len_trim(err_message) > 0) then + call endrun('check_bounds_gas_concs: error getting VMR for '//gc_gas_names(i)//' --> Error Message: '//trim(err_message)) + end if + call check_bounds(vmr, 1.0_r8, 0.0_r8, err_message) + if (len_trim(err_message) > 0) then + err_message = 'check_bounds_gas_concs: VMR error for '//gc_gas_names(i)//' --> Error Message: '//trim(err_message) + end if + end do + end subroutine + + subroutine check_bounds_gas_optics(kdist, err_message) + type(ty_gas_optics_rrtmgp), intent(in) :: kdist + character(len=128), intent(out) :: err_message + write(iulog,*) '[check_bonds_gas_optics DRAFT] : kdist' + ! write(iulog,*) 'number of gases: ',kdist%get_ngas() + ! write(iulog,*) 'gas names: ',kdist%get_gases() + ! write(iulog,*) 'kdist%source_is_external() = ',kdist%source_is_external() + err_message = "" + end subroutine + + + subroutine assert_shape_2dreal(arr, shp, err_message) + real(r8), intent(in) :: arr(:,:) ! 2-D array to check + integer, intent(in) :: shp(2) ! Expected shape + character(len=*), intent(out) :: err_message + character(len=512) :: err_append + integer :: r ! rank of arr + integer :: i + r = RANK(arr) + err_message = '' + if (r .ne. SIZE(shp)) then + err_message = 'Array is wrong rank (how could that happen?).' + end if + if (len_trim(err_message) == 0) then + do i = 1,r + if (SIZE(arr, i) /= shp(i)) then + write(err_append, "(a39,i3,a2)") 'Array size does not match on Dimension ', i, '._' + err_message = trim(err_message) // trim(err_append) + end if + end do + end if +end subroutine + +end module b_checker diff --git a/src/physics/rrtmgp/cloud_rad_props.F90 b/src/physics/rrtmgp/cloud_rad_props.F90 new file mode 100644 index 0000000000..1099fb714a --- /dev/null +++ b/src/physics/rrtmgp/cloud_rad_props.F90 @@ -0,0 +1,840 @@ +module cloud_rad_props + +!------------------------------------------------------------------------------------------------ +!------------------------------------------------------------------------------------------------ + +use shr_kind_mod, only: r8 => shr_kind_r8 +use ppgrid, only: pcols, pver, pverp +use physics_types, only: physics_state +use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_get_field, pbuf_old_tim_idx +use radconstants, only: nswbands, nlwbands, idx_sw_diag, ot_length, idx_lw_diag +use cam_abortutils, only: endrun +use rad_constituents, only: iceopticsfile, liqopticsfile +use oldcloud, only: oldcloud_lw, old_liq_get_rad_props_lw, old_ice_get_rad_props_lw, oldcloud_init + +use ebert_curry, only: scalefactor +use cam_logfile, only: iulog + +use interpolate_data, only: interp_type, lininterp_init, lininterp, & + extrap_method_bndry, lininterp_finish + +implicit none +private +save + +public :: & + cloud_rad_props_init, & + get_ice_optics_sw, & ! return Mitchell SW ice radiative properties + ice_cloud_get_rad_props_lw, & ! return Mitchell LW ice radiative properties + get_liquid_optics_sw, & ! return Conley SW radiative properties + liquid_cloud_get_rad_props_lw, & ! return Conley LW radiative properties + grau_cloud_get_rad_props_lw, & + get_grau_optics_sw, & + snow_cloud_get_rad_props_lw, & + get_snow_optics_sw, & + ! NOTE: Are these required, or are they obsolete? + cloud_rad_props_get_sw, & ! return SW optical props of total bulk aerosols (?) + cloud_rad_props_get_lw ! return LW optical props of total bulk aerosols (?) + +integer :: nmu, nlambda +real(r8), allocatable :: g_mu(:) ! mu samples on grid +real(r8), allocatable :: g_lambda(:,:) ! lambda scale samples on grid +real(r8), allocatable :: ext_sw_liq(:,:,:) +real(r8), allocatable :: ssa_sw_liq(:,:,:) +real(r8), allocatable :: asm_sw_liq(:,:,:) +real(r8), allocatable :: abs_lw_liq(:,:,:) + +integer :: n_g_d +real(r8), allocatable :: g_d_eff(:) ! radiative effective diameter samples on grid +real(r8), allocatable :: ext_sw_ice(:,:) +real(r8), allocatable :: ssa_sw_ice(:,:) +real(r8), allocatable :: asm_sw_ice(:,:) +real(r8), allocatable :: abs_lw_ice(:,:) + +! +! indexes into pbuf for optical parameters of MG clouds +! + integer :: i_dei, i_mu, i_lambda, i_iciwp, i_iclwp, i_des, i_icswp + integer :: i_degrau, i_icgrauwp + +! indexes into constituents for old optics + integer :: & + ixcldice, & ! cloud ice water index + ixcldliq ! cloud liquid water index + + +!============================================================================== +contains +!============================================================================== + +subroutine cloud_rad_props_init() + + use netcdf + use spmd_utils, only: masterproc + use ioFileMod, only: getfil + use error_messages, only: handle_ncerr +#if ( defined SPMD ) + use mpishorthand +#endif + use constituents, only: cnst_get_ind + use slingo, only: slingo_rad_props_init + use ebert_curry, only: ec_rad_props_init, scalefactor + + character(len=256) :: liquidfile + character(len=256) :: icefile + character(len=256) :: locfn + + integer :: ncid, dimid, f_nlwbands, f_nswbands, ierr + integer :: vdimids(NF90_MAX_VAR_DIMS), ndims, templen + ! liquid clouds + integer :: mudimid, lambdadimid + integer :: mu_id, lambda_id, ext_sw_liq_id, ssa_sw_liq_id, asm_sw_liq_id, abs_lw_liq_id + + ! ice clouds + integer :: d_dimid ! diameters + integer :: d_id, ext_sw_ice_id, ssa_sw_ice_id, asm_sw_ice_id, abs_lw_ice_id + + integer :: err + + liquidfile = liqopticsfile + icefile = iceopticsfile + + call slingo_rad_props_init + call ec_rad_props_init + call oldcloud_init + + i_dei = pbuf_get_index('DEI',errcode=err) + i_mu = pbuf_get_index('MU',errcode=err) + i_lambda = pbuf_get_index('LAMBDAC',errcode=err) + i_iciwp = pbuf_get_index('ICIWP',errcode=err) + i_iclwp = pbuf_get_index('ICLWP',errcode=err) + i_des = pbuf_get_index('DES',errcode=err) + i_icswp = pbuf_get_index('ICSWP',errcode=err) + i_icgrauwp = pbuf_get_index('ICGRAUWP',errcode=err) ! Available when using MG3 + i_degrau = pbuf_get_index('DEGRAU',errcode=err) ! Available when using MG3 + + ! old optics + call cnst_get_ind('CLDICE', ixcldice) + call cnst_get_ind('CLDLIQ', ixcldliq) + + ! read liquid cloud optics + if (masterproc) then + call getfil( trim(liquidfile), locfn, 0) + call handle_ncerr( nf90_open(locfn, NF90_NOWRITE, ncid), 'liquid optics file missing') + write(iulog,*)' reading liquid cloud optics from file ',locfn + + call handle_ncerr(nf90_inq_dimid( ncid, 'lw_band', dimid), 'getting lw_band dim') + call handle_ncerr(nf90_inquire_dimension( ncid, dimid, len=f_nlwbands), 'getting n lw bands') + if (f_nlwbands /= nlwbands) call endrun('number of lw bands does not match') + + call handle_ncerr(nf90_inq_dimid( ncid, 'sw_band', dimid), 'getting sw_band_dim') + call handle_ncerr(nf90_inquire_dimension( ncid, dimid, len=f_nswbands), 'getting n sw bands') + if (f_nswbands /= nswbands) call endrun('number of sw bands does not match') + + call handle_ncerr(nf90_inq_dimid( ncid, 'mu', mudimid), 'getting mu dim') + call handle_ncerr(nf90_inquire_dimension( ncid, mudimid, len=nmu), 'getting n mu samples') + + call handle_ncerr(nf90_inq_dimid( ncid, 'lambda_scale', lambdadimid), 'getting lambda dim') + call handle_ncerr(nf90_inquire_dimension( ncid, lambdadimid, len=nlambda), 'getting n lambda samples') + end if ! if (masterproc) + +#if ( defined SPMD ) + call mpibcast(nmu, 1, mpiint, 0, mpicom, ierr) + call mpibcast(nlambda, 1, mpiint, 0, mpicom, ierr) +#endif + + if (.not.allocated(g_mu)) allocate(g_mu(nmu)) + if (.not.allocated(g_lambda)) allocate(g_lambda(nmu,nlambda)) + if (.not.allocated(ext_sw_liq)) allocate(ext_sw_liq(nmu,nlambda,nswbands) ) + if (.not.allocated(ssa_sw_liq)) allocate(ssa_sw_liq(nmu,nlambda,nswbands)) + if (.not.allocated(asm_sw_liq)) allocate(asm_sw_liq(nmu,nlambda,nswbands)) + if (.not.allocated(abs_lw_liq)) allocate(abs_lw_liq(nmu,nlambda,nlwbands)) + + if (masterproc) then + call handle_ncerr( nf90_inq_varid(ncid, 'mu', mu_id),& + 'cloud optics mu get') + call handle_ncerr( nf90_get_var(ncid, mu_id, g_mu),& + 'read cloud optics mu values') + + call handle_ncerr( nf90_inq_varid(ncid, 'lambda', lambda_id),& + 'cloud optics lambda get') + call handle_ncerr( nf90_get_var(ncid, lambda_id, g_lambda),& + 'read cloud optics lambda values') + + call handle_ncerr( nf90_inq_varid(ncid, 'k_ext_sw', ext_sw_liq_id),& + 'cloud optics ext_sw_liq get') + call handle_ncerr( nf90_get_var(ncid, ext_sw_liq_id, ext_sw_liq),& + 'read cloud optics ext_sw_liq values') + + call handle_ncerr( nf90_inq_varid(ncid, 'ssa_sw', ssa_sw_liq_id),& + 'cloud optics ssa_sw_liq get') + call handle_ncerr( nf90_get_var(ncid, ssa_sw_liq_id, ssa_sw_liq),& + 'read cloud optics ssa_sw_liq values') + + call handle_ncerr( nf90_inq_varid(ncid, 'asm_sw', asm_sw_liq_id),& + 'cloud optics asm_sw_liq get') + call handle_ncerr( nf90_get_var(ncid, asm_sw_liq_id, asm_sw_liq),& + 'read cloud optics asm_sw_liq values') + + call handle_ncerr( nf90_inq_varid(ncid, 'k_abs_lw', abs_lw_liq_id),& + 'cloud optics abs_lw_liq get') + call handle_ncerr( nf90_get_var(ncid, abs_lw_liq_id, abs_lw_liq),& + 'read cloud optics abs_lw_liq values') + + call handle_ncerr( nf90_close(ncid), 'liquid optics file missing') + end if ! if masterproc + +#if ( defined SPMD ) + call mpibcast(g_mu, nmu, mpir8, 0, mpicom, ierr) + call mpibcast(g_lambda, nmu*nlambda, mpir8, 0, mpicom, ierr) + call mpibcast(ext_sw_liq, nmu*nlambda*nswbands, mpir8, 0, mpicom, ierr) + call mpibcast(ssa_sw_liq, nmu*nlambda*nswbands, mpir8, 0, mpicom, ierr) + call mpibcast(asm_sw_liq, nmu*nlambda*nswbands, mpir8, 0, mpicom, ierr) + call mpibcast(abs_lw_liq, nmu*nlambda*nlwbands, mpir8, 0, mpicom, ierr) +#endif + ! I forgot to convert kext from m^2/Volume to m^2/Kg + ext_sw_liq = ext_sw_liq / 0.9970449e3_r8 + abs_lw_liq = abs_lw_liq / 0.9970449e3_r8 + + ! read ice cloud optics + if (masterproc) then + call getfil( trim(icefile), locfn, 0) + call handle_ncerr( nf90_open(locfn, NF90_NOWRITE, ncid), 'ice optics file missing') + write(iulog,*)' reading ice cloud optics from file ',locfn + call handle_ncerr(nf90_inq_dimid( ncid, 'lw_band', dimid), 'getting lw_band dim') + call handle_ncerr(nf90_inquire_dimension( ncid, dimid, len=f_nlwbands), 'getting n lw bands') + if (f_nlwbands /= nlwbands) then + call endrun('number of lw bands does not match') + end if + call handle_ncerr(nf90_inq_dimid( ncid, 'sw_band', dimid), 'getting sw_band_dim') + call handle_ncerr(nf90_inquire_dimension( ncid, dimid, len=f_nswbands), 'getting n sw bands') + if (f_nswbands /= nswbands) then + call endrun('number of sw bands does not match') + end if + call handle_ncerr(nf90_inq_dimid( ncid, 'd_eff', d_dimid), 'getting deff dim') + call handle_ncerr(nf90_inquire_dimension( ncid, d_dimid, len=n_g_d), 'getting n deff samples') + end if ! if (masterproc) + +#if ( defined SPMD ) + call mpibcast(n_g_d, 1, mpiint, 0, mpicom, ierr) +! call mpibcast(nswbands, 1, mpiint, 0, mpicom, ierr) +! call mpibcast(nlwbands, 1, mpiint, 0, mpicom, ierr) +#endif + + if (.not.allocated(g_d_eff)) allocate(g_d_eff(n_g_d)) + if (.not.allocated(ext_sw_ice)) allocate(ext_sw_ice(n_g_d,nswbands)) + if (.not.allocated(ssa_sw_ice)) allocate(ssa_sw_ice(n_g_d,nswbands)) + if (.not.allocated(asm_sw_ice)) allocate(asm_sw_ice(n_g_d,nswbands)) + if (.not.allocated(abs_lw_ice)) allocate(abs_lw_ice(n_g_d,nlwbands)) + + if (masterproc) then + call handle_ncerr( nf90_inq_varid(ncid, 'd_eff', d_id),& + 'cloud optics deff get') + call handle_ncerr( nf90_get_var(ncid, d_id, g_d_eff),& + 'read cloud optics deff values') + + call handle_ncerr( nf90_inq_varid(ncid, 'sw_ext', ext_sw_ice_id),& + 'cloud optics ext_sw_ice get') + call handle_ncerr(nf90_inquire_variable ( ncid, ext_sw_ice_id, ndims=ndims, dimids=vdimids),& + 'checking dimensions of ext_sw_ice') + call handle_ncerr(nf90_inquire_dimension( ncid, vdimids(1), len=templen),& + 'getting first dimension sw_ext') + call handle_ncerr(nf90_inquire_dimension( ncid, vdimids(2), len=templen),& + 'getting first dimension sw_ext') + call handle_ncerr( nf90_get_var(ncid, ext_sw_ice_id, ext_sw_ice),& + 'read cloud optics ext_sw_ice values') + + call handle_ncerr( nf90_inq_varid(ncid, 'sw_ssa', ssa_sw_ice_id),& + 'cloud optics ssa_sw_ice get') + call handle_ncerr( nf90_get_var(ncid, ssa_sw_ice_id, ssa_sw_ice),& + 'read cloud optics ssa_sw_ice values') + + call handle_ncerr( nf90_inq_varid(ncid, 'sw_asm', asm_sw_ice_id),& + 'cloud optics asm_sw_ice get') + call handle_ncerr( nf90_get_var(ncid, asm_sw_ice_id, asm_sw_ice),& + 'read cloud optics asm_sw_ice values') + + call handle_ncerr( nf90_inq_varid(ncid, 'lw_abs', abs_lw_ice_id),& + 'cloud optics abs_lw_ice get') + call handle_ncerr( nf90_get_var(ncid, abs_lw_ice_id, abs_lw_ice),& + 'read cloud optics abs_lw_ice values') + + call handle_ncerr( nf90_close(ncid), 'ice optics file missing') + end if ! if masterproc + +#if ( defined SPMD ) + call mpibcast(g_d_eff, n_g_d, mpir8, 0, mpicom, ierr) + call mpibcast(ext_sw_ice, n_g_d*nswbands, mpir8, 0, mpicom, ierr) + call mpibcast(ssa_sw_ice, n_g_d*nswbands, mpir8, 0, mpicom, ierr) + call mpibcast(asm_sw_ice, n_g_d*nswbands, mpir8, 0, mpicom, ierr) + call mpibcast(abs_lw_ice, n_g_d*nlwbands, mpir8, 0, mpicom, ierr) +#endif + + return + +end subroutine cloud_rad_props_init + +!============================================================================== + +subroutine cloud_rad_props_get_sw(state, pbuf, & + tau, tau_w, tau_w_g, tau_w_f,& + diagnosticindex, oldliq, oldice) + +! return totaled (across all species) layer tau, omega, g, f +! for all spectral interval for aerosols affecting the climate + + ! Arguments + type(physics_state), intent(in) :: state + type(physics_buffer_desc),pointer :: pbuf(:) + integer, optional, intent(in) :: diagnosticindex ! index (if present) to radiation diagnostic information + + real(r8), intent(out) :: tau (nswbands,pcols,pver) ! aerosol extinction optical depth + real(r8), intent(out) :: tau_w (nswbands,pcols,pver) ! aerosol single scattering albedo * tau + real(r8), intent(out) :: tau_w_g(nswbands,pcols,pver) ! aerosol assymetry parameter * tau * w + real(r8), intent(out) :: tau_w_f(nswbands,pcols,pver) ! aerosol forward scattered fraction * tau * w + + logical, optional, intent(in) :: oldliq,oldice + + ! Local variables + + integer :: ncol + integer :: lchnk + integer :: k, i ! lev and daycolumn indices + integer :: iswband ! sw band indices + + ! optical props for each aerosol + real(r8), pointer :: h_ext(:,:) + real(r8), pointer :: h_ssa(:,:) + real(r8), pointer :: h_asm(:,:) + real(r8), pointer :: n_ext(:) + real(r8), pointer :: n_ssa(:) + real(r8), pointer :: n_asm(:) + + ! rad properties for liquid clouds + real(r8) :: liq_tau (nswbands,pcols,pver) ! aerosol extinction optical depth + real(r8) :: liq_tau_w (nswbands,pcols,pver) ! aerosol single scattering albedo * tau + real(r8) :: liq_tau_w_g(nswbands,pcols,pver) ! aerosol assymetry parameter * tau * w + real(r8) :: liq_tau_w_f(nswbands,pcols,pver) ! aerosol forward scattered fraction * tau * w + + ! rad properties for ice clouds + real(r8) :: ice_tau (nswbands,pcols,pver) ! aerosol extinction optical depth + real(r8) :: ice_tau_w (nswbands,pcols,pver) ! aerosol single scattering albedo * tau + real(r8) :: ice_tau_w_g(nswbands,pcols,pver) ! aerosol assymetry parameter * tau * w + real(r8) :: ice_tau_w_f(nswbands,pcols,pver) ! aerosol forward scattered fraction * tau * w + + !----------------------------------------------------------------------------- + + ncol = state%ncol + lchnk = state%lchnk + + ! initialize to conditions that would cause failure + tau (:,:,:) = -100._r8 + tau_w (:,:,:) = -100._r8 + tau_w_g (:,:,:) = -100._r8 + tau_w_f (:,:,:) = -100._r8 + + ! initialize layers to accumulate od's + tau (:,1:ncol,:) = 0._r8 + tau_w (:,1:ncol,:) = 0._r8 + tau_w_g(:,1:ncol,:) = 0._r8 + tau_w_f(:,1:ncol,:) = 0._r8 + + + call get_liquid_optics_sw(state, pbuf, liq_tau, liq_tau_w, liq_tau_w_g, liq_tau_w_f) + + call get_ice_optics_sw (state, pbuf, ice_tau, ice_tau_w, ice_tau_w_g, ice_tau_w_f) + + tau (:,1:ncol,:) = liq_tau (:,1:ncol,:) + ice_tau (:,1:ncol,:) + tau_w (:,1:ncol,:) = liq_tau_w (:,1:ncol,:) + ice_tau_w (:,1:ncol,:) + tau_w_g(:,1:ncol,:) = liq_tau_w_g(:,1:ncol,:) + ice_tau_w_g(:,1:ncol,:) + tau_w_f(:,1:ncol,:) = liq_tau_w_f(:,1:ncol,:) + ice_tau_w_f(:,1:ncol,:) + +end subroutine cloud_rad_props_get_sw +!============================================================================== + +subroutine cloud_rad_props_get_lw(state, pbuf, cld_abs_od, diagnosticindex, oldliq, oldice, oldcloud) + +! Purpose: Compute cloud longwave absorption optical depth +! cloud_rad_props_get_lw() is called by radlw() + + ! Arguments + type(physics_state), intent(in) :: state + type(physics_buffer_desc),pointer:: pbuf(:) + real(r8), intent(out) :: cld_abs_od(nlwbands,pcols,pver) ! [fraction] absorption optical depth, per layer + integer, optional, intent(in) :: diagnosticindex + logical, optional, intent(in) :: oldliq ! use old liquid optics + logical, optional, intent(in) :: oldice ! use old ice optics + logical, optional, intent(in) :: oldcloud ! use old optics for both (b4b) + + ! Local variables + + integer :: bnd_idx ! LW band index + integer :: i ! column index + integer :: k ! lev index + integer :: ncol ! number of columns + integer :: lchnk + + ! rad properties for liquid clouds + real(r8) :: liq_tau_abs_od(nlwbands,pcols,pver) ! liquid cloud absorption optical depth + + ! rad properties for ice clouds + real(r8) :: ice_tau_abs_od(nlwbands,pcols,pver) ! ice cloud absorption optical depth + + !----------------------------------------------------------------------------- + + ncol = state%ncol + lchnk = state%lchnk + + ! compute optical depths cld_absod + cld_abs_od = 0._r8 + + if(present(oldcloud))then + if(oldcloud) then + ! make diagnostic calls to these first to output ice and liq OD's + !call old_liq_get_rad_props_lw(state, pbuf, liq_tau_abs_od, oldliqwp=.false.) + !call old_ice_get_rad_props_lw(state, pbuf, ice_tau_abs_od, oldicewp=.false.) + ! This affects climate (cld_abs_od) + call oldcloud_lw(state,pbuf,cld_abs_od,oldwp=.false.) + return + endif + endif + + if(present(oldliq))then + if(oldliq) then + call old_liq_get_rad_props_lw(state, pbuf, liq_tau_abs_od, oldliqwp=.false.) + else + call liquid_cloud_get_rad_props_lw(state, pbuf, liq_tau_abs_od) + endif + else + call liquid_cloud_get_rad_props_lw(state, pbuf, liq_tau_abs_od) + endif + + if(present(oldice))then + if(oldice) then + call old_ice_get_rad_props_lw(state, pbuf, ice_tau_abs_od, oldicewp=.false.) + else + call ice_cloud_get_rad_props_lw(state, pbuf, ice_tau_abs_od) + endif + else + call ice_cloud_get_rad_props_lw(state, pbuf, ice_tau_abs_od) + endif + + cld_abs_od(:,1:ncol,:) = liq_tau_abs_od(:,1:ncol,:) + ice_tau_abs_od(:,1:ncol,:) + +end subroutine cloud_rad_props_get_lw + +!============================================================================== + +subroutine get_snow_optics_sw(state, pbuf, tau, tau_w, tau_w_g, tau_w_f) + type(physics_state), intent(in) :: state + type(physics_buffer_desc),pointer :: pbuf(:) + + real(r8),intent(out) :: tau (nswbands,pcols,pver) ! extinction optical depth + real(r8),intent(out) :: tau_w (nswbands,pcols,pver) ! single scattering albedo * tau + real(r8),intent(out) :: tau_w_g(nswbands,pcols,pver) ! assymetry parameter * tau * w + real(r8),intent(out) :: tau_w_f(nswbands,pcols,pver) ! forward scattered fraction * tau * w + + real(r8), pointer :: icswpth(:,:), des(:,:) + + ! This does the same thing as get_ice_optics_sw, except with a different + ! water path and effective diameter. + call pbuf_get_field(pbuf, i_icswp, icswpth) + call pbuf_get_field(pbuf, i_des, des) + + call interpolate_ice_optics_sw(state%ncol, icswpth, des, tau, tau_w, & + tau_w_g, tau_w_f) + +end subroutine get_snow_optics_sw + +!============================================================================== + +subroutine get_grau_optics_sw(state, pbuf, tau, tau_w, tau_w_g, tau_w_f) + type(physics_state), intent(in) :: state + type(physics_buffer_desc),pointer :: pbuf(:) + + real(r8),intent(out) :: tau (nswbands,pcols,pver) ! extinction optical depth + real(r8),intent(out) :: tau_w (nswbands,pcols,pver) ! single scattering albedo * tau + real(r8),intent(out) :: tau_w_g(nswbands,pcols,pver) ! assymetry parameter * tau * w + real(r8),intent(out) :: tau_w_f(nswbands,pcols,pver) ! forward scattered fraction * tau * w + + real(r8), pointer :: icgrauwpth(:,:), degrau(:,:) + + integer :: i,k + + ! This does the same thing as get_ice_optics_sw, except with a different + ! water path and effective diameter. + if((i_icgrauwp > 0) .and. (i_degrau > 0)) then + + call pbuf_get_field(pbuf, i_icgrauwp, icgrauwpth) + call pbuf_get_field(pbuf, i_degrau, degrau) + + call interpolate_ice_optics_sw(state%ncol, icgrauwpth, degrau, tau, tau_w, & + tau_w_g, tau_w_f) + do i = 1, pcols + do k = 1, pver + if (tau(idx_sw_diag,i,k).gt.100._r8) then + write(iulog,*) 'WARNING: SW Graupel Tau > 100 (i,k,icgrauwpth,degrau,tau):' + write(iulog,*) i,k,icgrauwpth(i,k), degrau(i,k), tau(idx_sw_diag,i,k) + end if + enddo + enddo + + else + call endrun('ERROR: Get_grau_optics_sw called when graupel properties not supported') + end if + +end subroutine get_grau_optics_sw + +!============================================================================== +! Private methods +!============================================================================== + +subroutine get_ice_optics_sw(state, pbuf, tau, tau_w, tau_w_g, tau_w_f) + type(physics_state), intent(in) :: state + type(physics_buffer_desc),pointer :: pbuf(:) + + real(r8),intent(out) :: tau (nswbands,pcols,pver) ! extinction optical depth + real(r8),intent(out) :: tau_w (nswbands,pcols,pver) ! single scattering albedo * tau + real(r8),intent(out) :: tau_w_g(nswbands,pcols,pver) ! assymetry parameter * tau * w + real(r8),intent(out) :: tau_w_f(nswbands,pcols,pver) ! forward scattered fraction * tau * w + + real(r8), pointer :: iciwpth(:,:), dei(:,:) + + ! Get relevant pbuf fields, and interpolate optical properties from + ! the lookup tables. + call pbuf_get_field(pbuf, i_iciwp, iciwpth) + call pbuf_get_field(pbuf, i_dei, dei) + + call interpolate_ice_optics_sw(state%ncol, iciwpth, dei, tau, tau_w, & + tau_w_g, tau_w_f) + +end subroutine get_ice_optics_sw + +!============================================================================== + +subroutine interpolate_ice_optics_sw(ncol, iciwpth, dei, tau, tau_w, & + tau_w_g, tau_w_f) + + integer, intent(in) :: ncol + real(r8), intent(in) :: iciwpth(pcols,pver) + real(r8), intent(in) :: dei(pcols,pver) + + real(r8),intent(out) :: tau (nswbands,pcols,pver) ! extinction optical depth + real(r8),intent(out) :: tau_w (nswbands,pcols,pver) ! single scattering albedo * tau + real(r8),intent(out) :: tau_w_g(nswbands,pcols,pver) ! assymetry parameter * tau * w + real(r8),intent(out) :: tau_w_f(nswbands,pcols,pver) ! forward scattered fraction * tau * w + + type(interp_type) :: dei_wgts + + integer :: i, k, swband + real(r8) :: ext(nswbands), ssa(nswbands), asm(nswbands) + + do k = 1,pver + do i = 1,ncol + if( iciwpth(i,k) < 1.e-80_r8 .or. dei(i,k) == 0._r8) then + ! if ice water path is too small, OD := 0 + tau (:,i,k) = 0._r8 + tau_w (:,i,k) = 0._r8 + tau_w_g(:,i,k) = 0._r8 + tau_w_f(:,i,k) = 0._r8 + else + ! for each cell interpolate to find weights in g_d_eff grid. + call lininterp_init(g_d_eff, n_g_d, dei(i:i,k), 1, & + extrap_method_bndry, dei_wgts) + ! interpolate into grid and extract radiative properties + do swband = 1, nswbands + call lininterp(ext_sw_ice(:,swband), n_g_d, & + ext(swband:swband), 1, dei_wgts) + call lininterp(ssa_sw_ice(:,swband), n_g_d, & + ssa(swband:swband), 1, dei_wgts) + call lininterp(asm_sw_ice(:,swband), n_g_d, & + asm(swband:swband), 1, dei_wgts) + end do + tau (:,i,k) = iciwpth(i,k) * ext + tau_w (:,i,k) = tau(:,i,k) * ssa + tau_w_g(:,i,k) = tau_w(:,i,k) * asm + tau_w_f(:,i,k) = tau_w_g(:,i,k) * asm + call lininterp_finish(dei_wgts) + endif + enddo + enddo + +end subroutine interpolate_ice_optics_sw + +!============================================================================== + +subroutine get_liquid_optics_sw(state, pbuf, tau, tau_w, tau_w_g, tau_w_f) + type(physics_state), intent(in) :: state + type(physics_buffer_desc),pointer :: pbuf(:) + + real(r8),intent(out) :: tau (nswbands,pcols,pver) ! extinction optical depth + real(r8),intent(out) :: tau_w (nswbands,pcols,pver) ! single scattering albedo * tau + real(r8),intent(out) :: tau_w_g(nswbands,pcols,pver) ! asymetry parameter * tau * w + real(r8),intent(out) :: tau_w_f(nswbands,pcols,pver) ! forward scattered fraction * tau * w + + real(r8), pointer, dimension(:,:) :: lamc, pgam, iclwpth + real(r8), dimension(pcols,pver) :: kext + integer i,k,swband,lchnk,ncol + + lchnk = state%lchnk + ncol = state%ncol + + + call pbuf_get_field(pbuf, i_lambda, lamc) + call pbuf_get_field(pbuf, i_mu, pgam) + call pbuf_get_field(pbuf, i_iclwp, iclwpth) + + do k = 1,pver + do i = 1,ncol + if(lamc(i,k) > 0._r8) then ! This seems to be clue from microphysics of no cloud + call gam_liquid_sw(iclwpth(i,k), lamc(i,k), pgam(i,k), & + tau(1:nswbands,i,k), tau_w(1:nswbands,i,k), tau_w_g(1:nswbands,i,k), tau_w_f(1:nswbands,i,k)) + else + tau(1:nswbands,i,k) = 0._r8 + tau_w(1:nswbands,i,k) = 0._r8 + tau_w_g(1:nswbands,i,k) = 0._r8 + tau_w_f(1:nswbands,i,k) = 0._r8 + endif + enddo + enddo + +end subroutine get_liquid_optics_sw + +!============================================================================== + +subroutine liquid_cloud_get_rad_props_lw(state, pbuf, abs_od) + type(physics_state), intent(in) :: state + type(physics_buffer_desc),pointer :: pbuf(:) + real(r8), intent(out) :: abs_od(nlwbands,pcols,pver) + + integer :: lchnk, ncol + real(r8), pointer, dimension(:,:) :: lamc, pgam, iclwpth + + integer lwband, i, k + + abs_od = 0._r8 + + lchnk = state%lchnk + ncol = state%ncol + + call pbuf_get_field(pbuf, i_lambda, lamc) + call pbuf_get_field(pbuf, i_mu, pgam) + call pbuf_get_field(pbuf, i_iclwp, iclwpth) + + do k = 1,pver + do i = 1,ncol + if(lamc(i,k) > 0._r8) then ! This seems to be the clue for no cloud from microphysics formulation + call gam_liquid_lw(iclwpth(i,k), lamc(i,k), pgam(i,k), abs_od(1:nlwbands,i,k)) + else + abs_od(1:nlwbands,i,k) = 0._r8 + endif + enddo + enddo + +end subroutine liquid_cloud_get_rad_props_lw +!============================================================================== + +subroutine snow_cloud_get_rad_props_lw(state, pbuf, abs_od) + type(physics_state), intent(in) :: state + type(physics_buffer_desc), pointer :: pbuf(:) + real(r8), intent(out) :: abs_od(nlwbands,pcols,pver) + + real(r8), pointer :: icswpth(:,:), des(:,:) + + ! This does the same thing as ice_cloud_get_rad_props_lw, except with a + ! different water path and effective diameter. + call pbuf_get_field(pbuf, i_icswp, icswpth) + call pbuf_get_field(pbuf, i_des, des) + + call interpolate_ice_optics_lw(state%ncol,icswpth, des, abs_od) + +end subroutine snow_cloud_get_rad_props_lw + + +!============================================================================== + +subroutine grau_cloud_get_rad_props_lw(state, pbuf, abs_od) + type(physics_state), intent(in) :: state + type(physics_buffer_desc), pointer :: pbuf(:) + real(r8), intent(out) :: abs_od(nlwbands,pcols,pver) + + real(r8), pointer :: icgrauwpth(:,:), degrau(:,:) + + ! This does the same thing as ice_cloud_get_rad_props_lw, except with a + ! different water path and effective diameter. + if((i_icgrauwp > 0) .and. (i_degrau > 0)) then + call pbuf_get_field(pbuf, i_icgrauwp, icgrauwpth) + call pbuf_get_field(pbuf, i_degrau, degrau) + + call interpolate_ice_optics_lw(state%ncol,icgrauwpth, degrau, abs_od) + else + call endrun('ERROR: Grau_cloud_get_rad_props_lw called when graupel & + &properties not supported') + end if + +end subroutine grau_cloud_get_rad_props_lw + +!============================================================================== + +subroutine ice_cloud_get_rad_props_lw(state, pbuf, abs_od) + type(physics_state), intent(in) :: state + type(physics_buffer_desc), pointer :: pbuf(:) + real(r8), intent(out) :: abs_od(nlwbands,pcols,pver) + + real(r8), pointer :: iciwpth(:,:), dei(:,:) + + ! Get relevant pbuf fields, and interpolate optical properties from + ! the lookup tables. + call pbuf_get_field(pbuf, i_iciwp, iciwpth) + call pbuf_get_field(pbuf, i_dei, dei) + + call interpolate_ice_optics_lw(state%ncol,iciwpth, dei, abs_od) + +end subroutine ice_cloud_get_rad_props_lw + +!============================================================================== + +subroutine interpolate_ice_optics_lw(ncol, iciwpth, dei, abs_od) + + integer, intent(in) :: ncol + real(r8), intent(in) :: iciwpth(pcols,pver) + real(r8), intent(in) :: dei(pcols,pver) + + real(r8),intent(out) :: abs_od(nlwbands,pcols,pver) + + type(interp_type) :: dei_wgts + + integer :: i, k, lwband + real(r8) :: absor(nlwbands) + + do k = 1,pver + do i = 1,ncol + ! if ice water path is too small, OD := 0 + if( iciwpth(i,k) < 1.e-80_r8 .or. dei(i,k) == 0._r8) then + abs_od (:,i,k) = 0._r8 + else + ! for each cell interpolate to find weights in g_d_eff grid. + call lininterp_init(g_d_eff, n_g_d, dei(i:i,k), 1, & + extrap_method_bndry, dei_wgts) + ! interpolate into grid and extract radiative properties + do lwband = 1, nlwbands + call lininterp(abs_lw_ice(:,lwband), n_g_d, & + absor(lwband:lwband), 1, dei_wgts) + enddo + abs_od(:,i,k) = iciwpth(i,k) * absor + where(abs_od(:,i,k) > 50.0_r8) abs_od(:,i,k) = 50.0_r8 + call lininterp_finish(dei_wgts) + endif + enddo + enddo + +end subroutine interpolate_ice_optics_lw + +!============================================================================== + +subroutine gam_liquid_lw(clwptn, lamc, pgam, abs_od) + real(r8), intent(in) :: clwptn ! cloud water liquid path new (in cloud) (in g/m^2)? + real(r8), intent(in) :: lamc ! prognosed value of lambda for cloud + real(r8), intent(in) :: pgam ! prognosed value of mu for cloud + real(r8), intent(out) :: abs_od(1:nlwbands) + + integer :: lwband ! sw band index + + type(interp_type) :: mu_wgts + type(interp_type) :: lambda_wgts + + if (clwptn < 1.e-80_r8) then + abs_od = 0._r8 + return + endif + + call get_mu_lambda_weights(lamc, pgam, mu_wgts, lambda_wgts) + + do lwband = 1, nlwbands + call lininterp(abs_lw_liq(:,:,lwband), nmu, nlambda, & + abs_od(lwband:lwband), 1, mu_wgts, lambda_wgts) + enddo + + abs_od = clwptn * abs_od + + call lininterp_finish(mu_wgts) + call lininterp_finish(lambda_wgts) + +end subroutine gam_liquid_lw + +!============================================================================== + +subroutine gam_liquid_sw(clwptn, lamc, pgam, tau, tau_w, tau_w_g, tau_w_f) + real(r8), intent(in) :: clwptn ! cloud water liquid path new (in cloud) (in g/m^2)? + real(r8), intent(in) :: lamc ! prognosed value of lambda for cloud + real(r8), intent(in) :: pgam ! prognosed value of mu for cloud + real(r8), intent(out) :: tau(1:nswbands), tau_w(1:nswbands), tau_w_f(1:nswbands), tau_w_g(1:nswbands) + + integer :: swband ! sw band index + + real(r8) :: ext(nswbands), ssa(nswbands), asm(nswbands) + + type(interp_type) :: mu_wgts + type(interp_type) :: lambda_wgts + + if (clwptn < 1.e-80_r8) then + tau = 0._r8 + tau_w = 0._r8 + tau_w_g = 0._r8 + tau_w_f = 0._r8 + return + endif + + call get_mu_lambda_weights(lamc, pgam, mu_wgts, lambda_wgts) + + do swband = 1, nswbands + call lininterp(ext_sw_liq(:,:,swband), nmu, nlambda, & + ext(swband:swband), 1, mu_wgts, lambda_wgts) + call lininterp(ssa_sw_liq(:,:,swband), nmu, nlambda, & + ssa(swband:swband), 1, mu_wgts, lambda_wgts) + call lininterp(asm_sw_liq(:,:,swband), nmu, nlambda, & + asm(swband:swband), 1, mu_wgts, lambda_wgts) + enddo + + ! compute radiative properties + tau = clwptn * ext + tau_w = tau * ssa + tau_w_g = tau_w * asm + tau_w_f = tau_w_g * asm + + call lininterp_finish(mu_wgts) + call lininterp_finish(lambda_wgts) + +end subroutine gam_liquid_sw + +!============================================================================== + +subroutine get_mu_lambda_weights(lamc, pgam, mu_wgts, lambda_wgts) + real(r8), intent(in) :: lamc ! prognosed value of lambda for cloud + real(r8), intent(in) :: pgam ! prognosed value of mu for cloud + ! Output interpolation weights. Caller is responsible for freeing these. + type(interp_type), intent(out) :: mu_wgts + type(interp_type), intent(out) :: lambda_wgts + + integer :: ilambda + real(r8) :: g_lambda_interp(nlambda) + + ! Make interpolation weights for mu. + ! (Put pgam in a temporary array for this purpose.) + call lininterp_init(g_mu, nmu, [pgam], 1, extrap_method_bndry, mu_wgts) + + ! Use mu weights to interpolate to a row in the lambda table. + do ilambda = 1, nlambda + call lininterp(g_lambda(:,ilambda), nmu, & + g_lambda_interp(ilambda:ilambda), 1, mu_wgts) + end do + + ! Make interpolation weights for lambda. + call lininterp_init(g_lambda_interp, nlambda, [lamc], 1, & + extrap_method_bndry, lambda_wgts) + +end subroutine get_mu_lambda_weights + +!============================================================================== + +end module cloud_rad_props diff --git a/src/physics/rrtmgp/ebert_curry.F90 b/src/physics/rrtmgp/ebert_curry.F90 new file mode 100644 index 0000000000..a1e1c031b1 --- /dev/null +++ b/src/physics/rrtmgp/ebert_curry.F90 @@ -0,0 +1,408 @@ +module ebert_curry + +!------------------------------------------------------------------------------------------------ +!------------------------------------------------------------------------------------------------ + +use shr_kind_mod, only: r8 => shr_kind_r8 +use ppgrid, only: pcols, pver, pverp +use physics_types, only: physics_state +use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_get_field, pbuf_old_tim_idx +use radconstants, only: nswbands, nlwbands, idx_sw_diag, ot_length, idx_lw_diag, get_sw_spectral_boundaries +use cam_abortutils, only: endrun +use cam_history, only: outfld + +implicit none +private +save + +public :: & + ec_rad_props_init, & + cloud_rad_props_get_sw, & ! return SW optical props of total bulk aerosols + cloud_rad_props_get_lw, & ! return LW optical props of total bulk aerosols + ec_ice_optics_sw, & + ec_ice_get_rad_props_lw + + +real(r8), public, parameter:: scalefactor = 1._r8 !500._r8/917._r8 + +! Minimum cloud amount (as a fraction of the grid-box area) to +! distinguish from clear sky +! + real(r8) cldmin + parameter (cldmin = 1.0e-80_r8) +! +! Decimal precision of cloud amount (0 -> preserve full resolution; +! 10^-n -> preserve n digits of cloud amount) +! + real(r8) cldeps + parameter (cldeps = 0.0_r8) + +! +! indexes into pbuf for optical parameters of MG clouds +! + integer :: dei_idx = 0 + integer :: mu_idx = 0 + integer :: lambda_idx = 0 + integer :: iciwp_idx = 0 + integer :: iclwp_idx = 0 + integer :: cld_idx = 0 + integer :: rei_idx = 0 + +! indexes into constituents for old optics + integer :: & + ixcldice, & ! cloud ice water index + ixcldliq ! cloud liquid water index + + +!============================================================================== +contains +!============================================================================== + +subroutine ec_rad_props_init() + +! use cam_history, only: addfld + use netcdf + use spmd_utils, only: masterproc + use ioFileMod, only: getfil + use cam_logfile, only: iulog + use error_messages, only: handle_ncerr +#if ( defined SPMD ) + use mpishorthand +#endif + use constituents, only: cnst_get_ind + + integer :: err + + iciwp_idx = pbuf_get_index('ICIWP',errcode=err) + iclwp_idx = pbuf_get_index('ICLWP',errcode=err) + cld_idx = pbuf_get_index('CLD') + rei_idx = pbuf_get_index('REI') + + ! old optics + call cnst_get_ind('CLDICE', ixcldice) + call cnst_get_ind('CLDLIQ', ixcldliq) + + !call addfld ('CLWPTH_OLD',(/ 'lev' /), 'I','Kg/m2','old In Cloud Liquid Water Path', sampling_seq='rad_lwsw') + !call addfld ('KEXT_OLD',(/ 'lev' /),'I','m^2/kg','old extinction') + !call addfld ('CLDOD_OLD',(/ 'lev' /),'I','1','old liquid OD') + !call addfld ('REL_OLD',(/ 'lev' /),'I','1','old liquid effective radius (liquid)') + + !call addfld ('CLWPTH_NEW',(/ 'lev' /), 'I','Kg/m2','In Cloud Liquid Water Path', sampling_seq='rad_lwsw') + !call addfld ('KEXT_NEW',(/ 'lev' /),'I','m^2/kg','extinction') + !call addfld ('CLDOD_NEW',(/ 'lev' /),'I','1','liquid OD') + + !call addfld('CIWPTH_NEW',(/ 'lev' /), 'I','Kg/m2','In Cloud Ice Water Path', sampling_seq='rad_lwsw') + !call addfld('CIWPTH_OLD',(/ 'lev' /), 'I','Kg/m2','In Cloud Ice Water Path (old)', sampling_seq='rad_lwsw') + + return + +end subroutine ec_rad_props_init + +!============================================================================== + +subroutine cloud_rad_props_get_sw(state, pbuf, & + tau, tau_w, tau_w_g, tau_w_f,& + diagnosticindex, oldliq, oldice) + +! return totaled (across all species) layer tau, omega, g, f +! for all spectral interval for aerosols affecting the climate + + ! Arguments + type(physics_state), intent(in) :: state + type(physics_buffer_desc), pointer :: pbuf(:) + integer, optional, intent(in) :: diagnosticindex ! index (if present) to radiation diagnostic information + + real(r8), intent(out) :: tau (nswbands,pcols,pver) ! aerosol extinction optical depth + real(r8), intent(out) :: tau_w (nswbands,pcols,pver) ! aerosol single scattering albedo * tau + real(r8), intent(out) :: tau_w_g(nswbands,pcols,pver) ! aerosol assymetry parameter * tau * w + real(r8), intent(out) :: tau_w_f(nswbands,pcols,pver) ! aerosol forward scattered fraction * tau * w + + logical, optional, intent(in) :: oldliq,oldice + + ! Local variables + + integer :: ncol + integer :: lchnk + integer :: k, i ! lev and daycolumn indices + integer :: iswband ! sw band indices + + !----------------------------------------------------------------------------- + + ncol = state%ncol + lchnk = state%lchnk + + ! initialize to conditions that would cause failure + tau (:,:,:) = -100._r8 + tau_w (:,:,:) = -100._r8 + tau_w_g (:,:,:) = -100._r8 + tau_w_f (:,:,:) = -100._r8 + + ! initialize layers to accumulate od's + tau (:,1:ncol,:) = 0._r8 + tau_w (:,1:ncol,:) = 0._r8 + tau_w_g(:,1:ncol,:) = 0._r8 + tau_w_f(:,1:ncol,:) = 0._r8 + + + call ec_ice_optics_sw (state, pbuf, tau, tau_w, tau_w_g, tau_w_f, oldicewp=.true.) +! call outfld ('CI_OD_SW_OLD', ice_tau(idx_sw_diag,:,:), pcols, lchnk) + + +end subroutine cloud_rad_props_get_sw +!============================================================================== + +subroutine cloud_rad_props_get_lw(state, pbuf, cld_abs_od, diagnosticindex, oldliq, oldice, oldcloud) + +! Purpose: Compute cloud longwave absorption optical depth +! cloud_rad_props_get_lw() is called by radlw() + + ! Arguments + type(physics_state), intent(in) :: state + type(physics_buffer_desc), pointer :: pbuf(:) + real(r8), intent(out) :: cld_abs_od(nlwbands,pcols,pver) ! [fraction] absorption optical depth, per layer + integer, optional, intent(in) :: diagnosticindex + logical, optional, intent(in) :: oldliq ! use old liquid optics + logical, optional, intent(in) :: oldice ! use old ice optics + logical, optional, intent(in) :: oldcloud ! use old optics for both (b4b) + + ! Local variables + + integer :: bnd_idx ! LW band index + integer :: i ! column index + integer :: k ! lev index + integer :: ncol ! number of columns + integer :: lchnk + + !----------------------------------------------------------------------------- + + ncol = state%ncol + lchnk = state%lchnk + + ! compute optical depths cld_absod + cld_abs_od = 0._r8 + + call ec_ice_get_rad_props_lw(state, pbuf, cld_abs_od, oldicewp=.true.) + !call outfld('CI_OD_LW_OLD', ice_tau_abs_od(idx_lw_diag ,:,:), pcols, lchnk) + +end subroutine cloud_rad_props_get_lw + +!============================================================================== +! Private methods +!============================================================================== + +subroutine ec_ice_optics_sw (state, pbuf, ice_tau, ice_tau_w, ice_tau_w_g, ice_tau_w_f, oldicewp) + + use physconst, only: gravit + + type(physics_state), intent(in) :: state + type(physics_buffer_desc), pointer :: pbuf(:) + + real(r8),intent(out) :: ice_tau (nswbands,pcols,pver) ! extinction optical depth + real(r8),intent(out) :: ice_tau_w (nswbands,pcols,pver) ! single scattering albedo * tau + real(r8),intent(out) :: ice_tau_w_g(nswbands,pcols,pver) ! assymetry parameter * tau * w + real(r8),intent(out) :: ice_tau_w_f(nswbands,pcols,pver) ! forward scattered fraction * tau * w + logical, intent(in) :: oldicewp + + real(r8), pointer, dimension(:,:) :: rei + real(r8), pointer, dimension(:,:) :: cldn + real(r8), pointer, dimension(:,:) :: tmpptr + real(r8), dimension(pcols,pver) :: cicewp + real(r8), dimension(nswbands) :: wavmin + real(r8), dimension(nswbands) :: wavmax + ! + ! ice water coefficients (Ebert and Curry,1992, JGR, 97, 3831-3836) + real(r8) :: abari(4) = & ! a coefficient for extinction optical depth + (/ 3.448e-03_r8, 3.448e-03_r8,3.448e-03_r8,3.448e-03_r8/) + real(r8) :: bbari(4) = & ! b coefficient for extinction optical depth + (/ 2.431_r8 , 2.431_r8 ,2.431_r8 ,2.431_r8 /) + real(r8) :: cbari(4) = & ! c coefficient for single scat albedo + (/ 1.00e-05_r8 , 1.10e-04_r8 ,1.861e-02_r8,.46658_r8 /) + real(r8) :: dbari(4) = & ! d coefficient for single scat albedo + (/ 0.0_r8 , 1.405e-05_r8,8.328e-04_r8,2.05e-05_r8 /) + real(r8) :: ebari(4) = & ! e coefficient for asymmetry parameter + (/ 0.7661_r8 , 0.7730_r8 ,0.794_r8 ,0.9595_r8 /) + real(r8) :: fbari(4) = & ! f coefficient for asymmetry parameter + (/ 5.851e-04_r8, 5.665e-04_r8,7.267e-04_r8,1.076e-04_r8/) + + real(r8) :: abarii ! A coefficient for current spectral band + real(r8) :: bbarii ! B coefficient for current spectral band + real(r8) :: cbarii ! C coefficient for current spectral band + real(r8) :: dbarii ! D coefficient for current spectral band + real(r8) :: ebarii ! E coefficient for current spectral band + real(r8) :: fbarii ! F coefficient for current spectral band + + ! Minimum cloud amount (as a fraction of the grid-box area) to + ! distinguish from clear sky + real(r8), parameter :: cldmin = 1.0e-80_r8 + + ! Decimal precision of cloud amount (0 -> preserve full resolution; + ! 10^-n -> preserve n digits of cloud amount) + real(r8), parameter :: cldeps = 0.0_r8 + + integer :: ns, i, k, indxsl, lchnk, Nday + integer :: itim_old + real(r8) :: tmp1i, tmp2i, tmp3i, g + + Nday = state%ncol + lchnk = state%lchnk + + itim_old = pbuf_old_tim_idx() + call pbuf_get_field(pbuf, cld_idx,cldn, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, rei_idx,rei) + + if(oldicewp) then + do k=1,pver + do i = 1,Nday + cicewp(i,k) = 1000.0_r8*state%q(i,k,ixcldice)*state%pdel(i,k) /(gravit* max(0.01_r8,cldn(i,k))) + end do + end do + else + if (iciwp_idx<=0) then + call endrun('ec_ice_optics_sw: oldicewp must be set to true since ICIWP was not found in pbuf') + endif + call pbuf_get_field(pbuf, iciwp_idx, tmpptr) + cicewp(1:pcols,1:pver) = 1000.0_r8*tmpptr(1:pcols,1:pver) + endif + + call get_sw_spectral_boundaries(wavmin,wavmax,'microns') + + do ns = 1, nswbands + + if(wavmax(ns) <= 0.7_r8) then + indxsl = 1 + else if(wavmax(ns) <= 1.25_r8) then + indxsl = 2 + else if(wavmax(ns) <= 2.38_r8) then + indxsl = 3 + else if(wavmax(ns) > 2.38_r8) then + indxsl = 4 + end if + + abarii = abari(indxsl) + bbarii = bbari(indxsl) + cbarii = cbari(indxsl) + dbarii = dbari(indxsl) + ebarii = ebari(indxsl) + fbarii = fbari(indxsl) + + do k=1,pver + do i=1,Nday + + ! note that optical properties for ice valid only + ! in range of 13 > rei > 130 micron (Ebert and Curry 92) + if (cldn(i,k) >= cldmin .and. cldn(i,k) >= cldeps) then + tmp1i = abarii + bbarii/max(13._r8,min(scalefactor*rei(i,k),130._r8)) + ice_tau(ns,i,k) = cicewp(i,k)*tmp1i + else + ice_tau(ns,i,k) = 0.0_r8 + endif + + tmp2i = 1._r8 - cbarii - dbarii*min(max(13._r8,scalefactor*rei(i,k)),130._r8) + tmp3i = fbarii*min(max(13._r8,scalefactor*rei(i,k)),130._r8) + ! Do not let single scatter albedo be 1. Delta-eddington solution + ! for non-conservative case has different analytic form from solution + ! for conservative case, and raddedmx is written for non-conservative case. + ice_tau_w(ns,i,k) = ice_tau(ns,i,k) * min(tmp2i,.999999_r8) + g = ebarii + tmp3i + ice_tau_w_g(ns,i,k) = ice_tau_w(ns,i,k) * g + ice_tau_w_f(ns,i,k) = ice_tau_w(ns,i,k) * g * g + + end do ! End do i=1,Nday + end do ! End do k=1,pver + end do ! nswbands + +end subroutine ec_ice_optics_sw +!============================================================================== + +subroutine ec_ice_get_rad_props_lw(state, pbuf, abs_od, oldicewp) + use physconst, only: gravit + + type(physics_state), intent(in) :: state + type(physics_buffer_desc),pointer :: pbuf(:) + real(r8), intent(out) :: abs_od(nlwbands,pcols,pver) + logical, intent(in) :: oldicewp + + real(r8) :: gicewp(pcols,pver) + real(r8) :: gliqwp(pcols,pver) + real(r8) :: cicewp(pcols,pver) + real(r8) :: cliqwp(pcols,pver) + real(r8) :: ficemr(pcols,pver) + real(r8) :: cwp(pcols,pver) + real(r8) :: cldtau(pcols,pver) + + real(r8), pointer, dimension(:,:) :: cldn + real(r8), pointer, dimension(:,:) :: rei + integer :: ncol, itim_old, lwband, i, k, lchnk + + real(r8) :: kabs, kabsi + + real(r8) kabsl ! longwave liquid absorption coeff (m**2/g) + parameter (kabsl = 0.090361_r8) + + real(r8), pointer, dimension(:,:) :: iclwpth, iciwpth + + + ncol = state%ncol + lchnk = state%lchnk + + itim_old = pbuf_old_tim_idx() + call pbuf_get_field(pbuf, rei_idx, rei) + call pbuf_get_field(pbuf, cld_idx, cldn, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + + + if(oldicewp) then + do k=1,pver + do i = 1,ncol + gicewp(i,k) = state%q(i,k,ixcldice)*state%pdel(i,k)/gravit*1000.0_r8 ! Grid box ice water path. + gliqwp(i,k) = state%q(i,k,ixcldliq)*state%pdel(i,k)/gravit*1000.0_r8 ! Grid box liquid water path. + cicewp(i,k) = gicewp(i,k) / max(0.01_r8,cldn(i,k)) ! In-cloud ice water path. + cliqwp(i,k) = gliqwp(i,k) / max(0.01_r8,cldn(i,k)) ! In-cloud liquid water path. + ficemr(i,k) = state%q(i,k,ixcldice) / & + max(1.e-10_r8,(state%q(i,k,ixcldice)+state%q(i,k,ixcldliq))) + end do + end do + cwp(:ncol,:pver) = cicewp(:ncol,:pver) + cliqwp(:ncol,:pver) + else + if (iclwp_idx<=0 .or. iciwp_idx<=0) then + call endrun('ec_ice_get_rad_props_lw: oldicewp must be set to true since ICIWP and/or ICLWP were not found in pbuf') + endif + call pbuf_get_field(pbuf, iclwp_idx, iclwpth) + call pbuf_get_field(pbuf, iciwp_idx, iciwpth) + do k=1,pver + do i = 1,ncol + cwp(i,k) = 1000.0_r8 *iciwpth(i,k) + 1000.0_r8 *iclwpth(i,k) + ficemr(i,k) = 1000.0_r8*iciwpth(i,k)/(max(1.e-18_r8,cwp(i,k))) + end do + end do + endif + + do k=1,pver + do i=1,ncol + + ! Note from Andrew Conley: + ! Optics for RK no longer supported, This is constructed to get + ! close to bit for bit. Otherwise we could simply use ice water path + !note that optical properties for ice valid only + !in range of 13 > rei > 130 micron (Ebert and Curry 92) + kabsi = 0.005_r8 + 1._r8/min(max(13._r8,scalefactor*rei(i,k)),130._r8) + kabs = kabsi*ficemr(i,k) ! kabsl*(1._r8-ficemr(i,k)) + kabsi*ficemr(i,k) + !emis(i,k) = 1._r8 - exp(-1.66_r8*kabs*clwp(i,k)) + cldtau(i,k) = kabs*cwp(i,k) + end do + end do +! + do lwband = 1,nlwbands + abs_od(lwband,1:ncol,1:pver)=cldtau(1:ncol,1:pver) + enddo + + !if(oldicewp) then + ! call outfld('CIWPTH_OLD',cicewp(:,:)/1000,pcols,lchnk) + !else + ! call outfld('CIWPTH_OLD',iciwpth(:,:),pcols,lchnk) + !endif + !call outfld('CI_OD_LW_OLD',cldtau(:,:),pcols,lchnk) + +end subroutine ec_ice_get_rad_props_lw +!============================================================================== + +end module ebert_curry diff --git a/src/physics/rrtmgp/mcica_subcol_gen.F90 b/src/physics/rrtmgp/mcica_subcol_gen.F90 new file mode 100644 index 0000000000..c77b20e4ed --- /dev/null +++ b/src/physics/rrtmgp/mcica_subcol_gen.F90 @@ -0,0 +1,293 @@ +module mcica_subcol_gen + +! -------------------------------------------------------------------------- +! | | +! | Copyright 2006-2007, Atmospheric & Environmental Research, Inc. (AER). | +! | This software may be used, copied, or redistributed as long as it is | +! | not sold and this copyright notice is reproduced on each copy made. | +! | This model is provided as is without any express or implied warranties. | +! | (http://www.rtweb.aer.com/) | +! | | +! -------------------------------------------------------------------------- + +!---------------------------------------------------------------------------------------- +! +! Purpose: Create McICA stochastic arrays for cloud optical properties. +! Input cloud optical properties directly: cloud optical depth, single +! scattering albedo and asymmetry parameter. Output will be stochastic +! arrays of these variables. (longwave scattering is not yet available) +! +! Original code: From RRTMG based on Raisanen et al., QJRMS, 2004. +! +! Uses the KISS random number generator. +! +! Overlap assumption: maximum-random. +! +!---------------------------------------------------------------------------------------- + +use shr_kind_mod, only: r8 => shr_kind_r8 +use ppgrid, only: pcols, pver, pverp +use cam_abortutils, only: endrun + +use shr_RandNum_mod, only: ShrKissRandGen + +! old: use mo_gas_optics_specification, only: ty_gas_optics_specification +! use mo_gas_optics, only: ty_gas_optics ! Wrong? +use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp +use cam_logfile, only: iulog ! just for debugging (BPM) + +implicit none +private +save + +public :: mcica_subcol_lw, mcica_subcol_sw + +!======================================================================================== +contains +!======================================================================================== + +subroutine mcica_subcol_lw( & + kdist, nbnd, ngpt, ncol, changeseed, & + pmid, cldfrac, tauc, taucmcl) + + ! Arrays use CAM vertical index convention: index increases from top to bottom. + ! This index ordering is assumed in the maximum-random overlap algorithm which starts + ! at the top of a column and marches down, with each layer depending on the state + ! of the layer above it. + ! + ! For GCM mode, changeseed must be offset between LW and SW by at least the + ! number of subcolumns + + ! arguments + ! class(ty_gas_optics), intent(in) :: kdist ! spectral information ! Wrong? + class(ty_gas_optics_rrtmgp), intent(in) :: kdist ! spectral information + integer, intent(in) :: nbnd ! number of spectral bands + integer, intent(in) :: ngpt ! number of subcolumns (g-point intervals) + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: changeseed ! if the subcolumn generator is called multiple times, + ! permute the seed between each call. + real(r8), intent(in) :: pmid(pcols,pver) ! layer pressures (Pa) + real(r8), intent(in) :: cldfrac(pcols,pver) ! layer cloud fraction + real(r8), intent(in) :: tauc(nbnd,pcols,pver) ! cloud optical depth + + real(r8), intent(out) :: taucmcl(ngpt,ncol,pver) ! subcolumn cloud optical depth [mcica] + + ! Local vars + + integer :: i, isubcol, k, n + + real(r8), parameter :: cldmin = 1.0e-80_r8 ! min cloud fraction + real(r8) :: cldf(ncol,pver) ! cloud fraction clipped to cldmin + + type(ShrKissRandGen) :: kiss_gen ! KISS RNG object + integer :: kiss_seed(ncol,4) + real(r8) :: rand_num_1d(ncol,1) ! random number (kissvec) + real(r8) :: rand_num(ncol,pver) ! random number (kissvec) + + real(r8) :: cdf(ngpt,ncol,pver) ! random numbers + logical :: iscloudy(ngpt,ncol,pver) ! flag that says whether a gridbox is cloudy + !------------------------------------------------------------------------------------------ + ! clip cloud fraction + cldf(:,:) = cldfrac(:ncol,:) + where (cldf(:,:) < cldmin) + cldf(:,:) = 0._r8 + end where + + ! Create a seed that depends on the state of the columns. + ! Use pmid from bottom four layers. + do i = 1, ncol + kiss_seed(i,1) = (pmid(i,pver) - int(pmid(i,pver))) * 1000000000 + kiss_seed(i,2) = (pmid(i,pver-1) - int(pmid(i,pver-1))) * 1000000000 + kiss_seed(i,3) = (pmid(i,pver-2) - int(pmid(i,pver-2))) * 1000000000 + kiss_seed(i,4) = (pmid(i,pver-3) - int(pmid(i,pver-3))) * 1000000000 + end do + + ! create the RNG object + kiss_gen = ShrKissRandGen(kiss_seed) + + ! Advance randum number generator by changeseed values + do i = 1, changeSeed + call kiss_gen%random(rand_num_1d) + end do + + ! Generate random numbers in each subcolumn at every level + do isubcol = 1,ngpt + call kiss_gen%random(rand_num) + cdf(isubcol,:,:) = rand_num(:,:) + enddo + + ! Maximum-Random overlap + ! i) pick a random number for top layer. + ! ii) walk down the column: + ! - if the layer above is cloudy, use the same random number as in the layer above + ! - if the layer above is clear, use a new random number + + do k = 2, pver + do i = 1, ncol + do isubcol = 1, ngpt + if (cdf(isubcol,i,k-1) > 1._r8 - cldf(i,k-1) ) then + cdf(isubcol,i,k) = cdf(isubcol,i,k-1) + else + cdf(isubcol,i,k) = cdf(isubcol,i,k) * (1._r8 - cldf(i,k-1)) + end if + end do + end do + end do + + do k = 1, pver + iscloudy(:,:,k) = (cdf(:,:,k) >= 1._r8 - spread(cldf(:,k), dim=1, nCopies=ngpt) ) + end do + + ! -- generate subcolumns for homogeneous clouds ----- + ! where there is a cloud, set the subcolumn cloud properties; + ! incoming tauc should be in-cloud quantites and not grid-averaged quantities + do k = 1,pver + do i = 1,ncol + do isubcol = 1,ngpt + if (iscloudy(isubcol,i,k) .and. (cldf(i,k) > 0._r8) ) then + n = kdist%convert_gpt2band(isubcol) + taucmcl(isubcol,i,k) = tauc(n,i,k) + else + taucmcl(isubcol,i,k) = 0._r8 + end if + end do + end do + end do + + call kiss_gen%finalize() + +end subroutine mcica_subcol_lw + +!======================================================================================== + +subroutine mcica_subcol_sw( & + kdist, nbnd, ngpt, ncol, nlay, nver, changeseed, & + pmid, cldfrac, tauc, ssac, asmc, & + taucmcl, ssacmcl, asmcmcl) + + ! Arrays use CAM vertical index convention: index increases from top to bottom. + ! This index ordering is assumed in the maximum-random overlap algorithm which starts + ! at the top of a column and marches down, with each layer depending on the state + ! of the layer above it. + ! + ! For GCM mode, changeseed must be offset between LW and SW by at least the + ! number of subcolumns + + ! arguments + ! class(ty_gas_optics), intent(in) :: kdist ! spectral information ! Wrong? + class(ty_gas_optics_rrtmgp), intent(in) :: kdist ! spectral information + integer, intent(in) :: nbnd ! number of spectral bands + integer, intent(in) :: ngpt ! number of subcolumns (g-point intervals) + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlay ! number of vertical layers in radiation calc; + ! may include an "extra layer" + integer, intent(in) :: nver ! number of CAM's vertical layers in rad calc + integer, intent(in) :: changeseed ! if the subcolumn generator is called multiple times, + ! permute the seed between each call. + real(r8), intent(in) :: pmid(ncol,nlay) ! layer midpoint pressures (Pa) + real(r8), intent(in) :: cldfrac(ncol,nver) ! layer cloud fraction + real(r8), intent(in) :: tauc(nbnd,ncol,nver) ! cloud optical depth + real(r8), intent(in) :: ssac(nbnd,ncol,nver) ! cloud single scattering albedo (non-delta scaled) + real(r8), intent(in) :: asmc(nbnd,ncol,nver) ! cloud asymmetry parameter (non-delta scaled) + + + real(r8), intent(out) :: taucmcl(ngpt,ncol,nver) ! subcolumn cloud optical depth [mcica] + real(r8), intent(out) :: ssacmcl(ngpt,ncol,nver) ! subcolumn cloud single scattering albedo [mcica] + real(r8), intent(out) :: asmcmcl(ngpt,ncol,nver) ! subcolumn cloud asymmetry parameter [mcica] + + ! Local vars + + integer :: i, isubcol, k, n + + real(r8), parameter :: cldmin = 1.0e-80_r8 ! min cloud fraction + real(r8) :: cldf(ncol,nver) ! cloud fraction clipped to cldmin + + type(ShrKissRandGen) :: kiss_gen ! KISS RNG object + integer :: kiss_seed(ncol,4) + real(r8) :: rand_num_1d(ncol,1) ! random number (kissvec) + real(r8) :: rand_num(ncol,nver) ! random number (kissvec) + + real(r8) :: cdf(ngpt,ncol,nver) ! random numbers + logical :: iscloudy(ngpt,ncol,nver) ! flag that says whether a gridbox is cloudy + !------------------------------------------------------------------------------------------ + + ! clip cloud fraction + cldf(:,:) = cldfrac(:ncol,:) + where (cldf(:,:) < cldmin) + cldf(:,:) = 0._r8 + end where + + ! Create a seed that depends on the state of the columns. + ! Use pmid from bottom four layers. + do i = 1, ncol + kiss_seed(i,1) = (pmid(i,nlay) - int(pmid(i,nlay))) * 1000000000 + kiss_seed(i,2) = (pmid(i,nlay-1) - int(pmid(i,nlay-1))) * 1000000000 + kiss_seed(i,3) = (pmid(i,nlay-2) - int(pmid(i,nlay-2))) * 1000000000 + kiss_seed(i,4) = (pmid(i,nlay-3) - int(pmid(i,nlay-3))) * 1000000000 + end do + + ! create the RNG object + kiss_gen = ShrKissRandGen(kiss_seed) + + ! Advance randum number generator by changeseed values + do i = 1, changeSeed + call kiss_gen%random(rand_num_1d) + end do + + ! Generate random numbers in each subcolumn at every level + do isubcol = 1,ngpt + call kiss_gen%random(rand_num) + cdf(isubcol,:,:) = rand_num(:,:) + enddo + + ! Maximum-Random overlap + ! i) pick a random number for top layer. + ! ii) walk down the column: + ! - if the layer above is cloudy, use the same random number as in the layer above + ! - if the layer above is clear, use a new random number + + do k = 2, nver + do i = 1, ncol + do isubcol = 1, ngpt + if (cdf(isubcol,i,k-1) > 1._r8 - cldf(i,k-1) ) then + cdf(isubcol,i,k) = cdf(isubcol,i,k-1) + else + cdf(isubcol,i,k) = cdf(isubcol,i,k) * (1._r8 - cldf(i,k-1)) + end if + end do + end do + end do + + do k = 1, nver + iscloudy(:,:,k) = (cdf(:,:,k) >= 1._r8 - spread(cldf(:,k), dim=1, nCopies=ngpt) ) + ! write(iulog,*) 'level ',k,' any(iscloud) = ',any(iscloudy(:,1,k)) ! BPM - Debugging - remove when done + end do + + ! -- generate subcolumns for homogeneous clouds ----- + ! where there is a cloud, set the subcolumn cloud properties; + ! incoming tauc should be in-cloud quantites and not grid-averaged quantities + do k = 1,nver + do i = 1,ncol + do isubcol = 1,ngpt + if (iscloudy(isubcol,i,k) .and. (cldf(i,k) > 0._r8) ) then + n = kdist%convert_gpt2band(isubcol) + taucmcl(isubcol,i,k) = tauc(n,i,k) + ssacmcl(isubcol,i,k) = ssac(n,i,k) + asmcmcl(isubcol,i,k) = asmc(n,i,k) + ! write(iulog,*) 'level ',k,' subcolumn ',isubcol, 'CLOUD! ssacmcl = ',ssacmcl(isubcol,i,k),', asmcmcl = ',asmcmcl(isubcol,i,k) ! BPM - Debugging - remove when done + else + taucmcl(isubcol,i,k) = 0._r8 + ssacmcl(isubcol,i,k) = 1._r8 + asmcmcl(isubcol,i,k) = 0._r8 + end if + end do + end do + end do + + call kiss_gen%finalize() + +end subroutine mcica_subcol_sw + + +end module mcica_subcol_gen + diff --git a/src/physics/rrtmgp/oldcloud.F90 b/src/physics/rrtmgp/oldcloud.F90 new file mode 100644 index 0000000000..609c6b4668 --- /dev/null +++ b/src/physics/rrtmgp/oldcloud.F90 @@ -0,0 +1,643 @@ +module oldcloud + +!------------------------------------------------------------------------------------------------ +!------------------------------------------------------------------------------------------------ + +use shr_kind_mod, only: r8 => shr_kind_r8 +use ppgrid, only: pcols, pver, pverp +use physics_types, only: physics_state +use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_old_tim_idx, pbuf_get_field +use radconstants, only: nswbands, nlwbands, idx_sw_diag, ot_length, idx_lw_diag, get_sw_spectral_boundaries +use cam_abortutils, only: endrun +use cam_history, only: outfld +use rad_constituents, only: iceopticsfile, liqopticsfile +use ebert_curry, only: scalefactor + +implicit none +private +save + +public :: & + oldcloud_init, oldcloud_lw, old_liq_get_rad_props_lw, old_ice_get_rad_props_lw + +integer :: nmu, nlambda +real(r8), allocatable :: g_mu(:) ! mu samples on grid +real(r8), allocatable :: g_lambda(:,:) ! lambda scale samples on grid +real(r8), allocatable :: ext_sw_liq(:,:,:) +real(r8), allocatable :: ssa_sw_liq(:,:,:) +real(r8), allocatable :: asm_sw_liq(:,:,:) +real(r8), allocatable :: abs_lw_liq(:,:,:) + +integer :: n_g_d +real(r8), allocatable :: g_d_eff(:) ! radiative effective diameter samples on grid +real(r8), allocatable :: ext_sw_ice(:,:) +real(r8), allocatable :: ssa_sw_ice(:,:) +real(r8), allocatable :: asm_sw_ice(:,:) +real(r8), allocatable :: abs_lw_ice(:,:) + +! Minimum cloud amount (as a fraction of the grid-box area) to +! distinguish from clear sky +! + real(r8) cldmin + parameter (cldmin = 1.0e-80_r8) +! +! Decimal precision of cloud amount (0 -> preserve full resolution; +! 10^-n -> preserve n digits of cloud amount) +! + real(r8) cldeps + parameter (cldeps = 0.0_r8) + +! +! indexes into pbuf for optical parameters of MG clouds +! + integer :: iciwp_idx = 0 + integer :: iclwp_idx = 0 + integer :: cld_idx = 0 + integer :: rel_idx = 0 + integer :: rei_idx = 0 + +! indexes into constituents for old optics + integer :: & + ixcldice, & ! cloud ice water index + ixcldliq ! cloud liquid water index + + +!============================================================================== +contains +!============================================================================== + +subroutine oldcloud_init() + + use constituents, only: cnst_get_ind + + integer :: err + + iciwp_idx = pbuf_get_index('ICIWP',errcode=err) + iclwp_idx = pbuf_get_index('ICLWP',errcode=err) + cld_idx = pbuf_get_index('CLD') + rel_idx = pbuf_get_index('REL') + rei_idx = pbuf_get_index('REI') + + ! old optics + call cnst_get_ind('CLDICE', ixcldice) + call cnst_get_ind('CLDLIQ', ixcldliq) + + return + +end subroutine oldcloud_init + +!============================================================================== +! Private methods +!============================================================================== + +subroutine old_liquid_optics_sw(state, pbuf, liq_tau, liq_tau_w, liq_tau_w_g, liq_tau_w_f, oldliqwp) + + use physconst, only: gravit + + type(physics_state), intent(in) :: state + type(physics_buffer_desc),pointer :: pbuf(:) + + real(r8),intent(out) :: liq_tau (nswbands,pcols,pver) ! extinction optical depth + real(r8),intent(out) :: liq_tau_w (nswbands,pcols,pver) ! single scattering albedo * tau + real(r8),intent(out) :: liq_tau_w_g(nswbands,pcols,pver) ! assymetry parameter * tau * w + real(r8),intent(out) :: liq_tau_w_f(nswbands,pcols,pver) ! forward scattered fraction * tau * w + logical, intent(in) :: oldliqwp + + real(r8), pointer, dimension(:,:) :: rel + real(r8), pointer, dimension(:,:) :: cldn + real(r8), pointer, dimension(:,:) :: tmpptr + real(r8), dimension(pcols,pver) :: cliqwp + real(r8), dimension(nswbands) :: wavmin + real(r8), dimension(nswbands) :: wavmax + + ! Minimum cloud amount (as a fraction of the grid-box area) to + ! distinguish from clear sky + real(r8), parameter :: cldmin = 1.0e-80_r8 + + ! Decimal precision of cloud amount (0 -> preserve full resolution; + ! 10^-n -> preserve n digits of cloud amount) + real(r8), parameter :: cldeps = 0.0_r8 + + ! A. Slingo's data for cloud particle radiative properties (from 'A GCM + ! Parameterization for the Shortwave Properties of Water Clouds' JAS + ! vol. 46 may 1989 pp 1419-1427) + real(r8) :: abarl(4) = & ! A coefficient for extinction optical depth + (/ 2.817e-02_r8, 2.682e-02_r8,2.264e-02_r8,1.281e-02_r8/) + real(r8) :: bbarl(4) = & ! B coefficient for extinction optical depth + (/ 1.305_r8 , 1.346_r8 ,1.454_r8 ,1.641_r8 /) + real(r8) :: cbarl(4) = & ! C coefficient for single scat albedo + (/-5.62e-08_r8 ,-6.94e-06_r8 ,4.64e-04_r8 ,0.201_r8 /) + real(r8) :: dbarl(4) = & ! D coefficient for single scat albedo + (/ 1.63e-07_r8 , 2.35e-05_r8 ,1.24e-03_r8 ,7.56e-03_r8 /) + real(r8) :: ebarl(4) = & ! E coefficient for asymmetry parameter + (/ 0.829_r8 , 0.794_r8 ,0.754_r8 ,0.826_r8 /) + real(r8) :: fbarl(4) = & ! F coefficient for asymmetry parameter + (/ 2.482e-03_r8, 4.226e-03_r8,6.560e-03_r8,4.353e-03_r8/) + + real(r8) :: abarli ! A coefficient for current spectral band + real(r8) :: bbarli ! B coefficient for current spectral band + real(r8) :: cbarli ! C coefficient for current spectral band + real(r8) :: dbarli ! D coefficient for current spectral band + real(r8) :: ebarli ! E coefficient for current spectral band + real(r8) :: fbarli ! F coefficient for current spectral band + + ! Caution... A. Slingo recommends no less than 4.0 micro-meters nor + ! greater than 20 micro-meters + + integer :: ns, i, k, indxsl, Nday + integer :: lchnk, itim_old + real(r8) :: tmp1l, tmp2l, tmp3l, g + real(r8) :: kext(pcols,pver) + real(r8), pointer, dimension(:,:) :: iclwpth + + Nday = state%ncol + lchnk = state%lchnk + + itim_old = pbuf_old_tim_idx() + call pbuf_get_field(pbuf, cld_idx,cldn, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, rel_idx,rel) + + if (oldliqwp) then + do k=1,pver + do i = 1,Nday + cliqwp(i,k) = state%q(i,k,ixcldliq)*state%pdel(i,k)/(gravit*max(0.01_r8,cldn(i,k))) + end do + end do + else + if (iclwp_idx<0) then + call endrun('old_liquid_optics_sw: oldliqwp must be set to true since ICLWP was not found in pbuf') + endif + ! The following is the eventual target specification for in cloud liquid water path. + call pbuf_get_field(pbuf, iclwp_idx, tmpptr) + cliqwp = tmpptr + endif + + call get_sw_spectral_boundaries(wavmin,wavmax,'microns') + + do ns = 1, nswbands + ! Set index for cloud particle properties based on the wavelength, + ! according to A. Slingo (1989) equations 1-3: + ! Use index 1 (0.25 to 0.69 micrometers) for visible + ! Use index 2 (0.69 - 1.19 micrometers) for near-infrared + ! Use index 3 (1.19 to 2.38 micrometers) for near-infrared + ! Use index 4 (2.38 to 4.00 micrometers) for near-infrared + if(wavmax(ns) <= 0.7_r8) then + indxsl = 1 + else if(wavmax(ns) <= 1.25_r8) then + indxsl = 2 + else if(wavmax(ns) <= 2.38_r8) then + indxsl = 3 + else if(wavmin(ns) > 2.38_r8) then + indxsl = 4 + end if + + ! Set cloud extinction optical depth, single scatter albedo, + ! asymmetry parameter, and forward scattered fraction: + abarli = abarl(indxsl) + bbarli = bbarl(indxsl) + cbarli = cbarl(indxsl) + dbarli = dbarl(indxsl) + ebarli = ebarl(indxsl) + fbarli = fbarl(indxsl) + + do k=1,pver + do i=1,Nday + + ! note that optical properties for liquid valid only + ! in range of 4.2 > rel > 16 micron (Slingo 89) + if (cldn(i,k) >= cldmin .and. cldn(i,k) >= cldeps) then + tmp1l = abarli + bbarli/min(max(4.2_r8,rel(i,k)),16._r8) + liq_tau(ns,i,k) = 1000._r8*cliqwp(i,k)*tmp1l + else + liq_tau(ns,i,k) = 0.0_r8 + endif + + tmp2l = 1._r8 - cbarli - dbarli*min(max(4.2_r8,rel(i,k)),16._r8) + tmp3l = fbarli*min(max(4.2_r8,rel(i,k)),16._r8) + ! Do not let single scatter albedo be 1. Delta-eddington solution + ! for non-conservative case has different analytic form from solution + ! for conservative case, and raddedmx is written for non-conservative case. + liq_tau_w(ns,i,k) = liq_tau(ns,i,k) * min(tmp2l,.999999_r8) + g = ebarli + tmp3l + liq_tau_w_g(ns,i,k) = liq_tau_w(ns,i,k) * g + liq_tau_w_f(ns,i,k) = liq_tau_w(ns,i,k) * g * g + + end do ! End do i=1,Nday + end do ! End do k=1,pver + end do ! nswbands + + !call outfld('CL_OD_SW_OLD',liq_tau(idx_sw_diag,:,:), pcols, lchnk) + !call outfld('REL_OLD',rel(:,:), pcols, lchnk) + !call outfld('CLWPTH_OLD',cliqwp(:,:), pcols, lchnk) + !call outfld('KEXT_OLD',kext(:,:), pcols, lchnk) + + +end subroutine old_liquid_optics_sw +!============================================================================== + +subroutine old_ice_optics_sw (state, pbuf, ice_tau, ice_tau_w, ice_tau_w_g, ice_tau_w_f, oldicewp) + + use physconst, only: gravit + + type(physics_state), intent(in) :: state + type(physics_buffer_desc),pointer :: pbuf(:) + + real(r8),intent(out) :: ice_tau (nswbands,pcols,pver) ! extinction optical depth + real(r8),intent(out) :: ice_tau_w (nswbands,pcols,pver) ! single scattering albedo * tau + real(r8),intent(out) :: ice_tau_w_g(nswbands,pcols,pver) ! assymetry parameter * tau * w + real(r8),intent(out) :: ice_tau_w_f(nswbands,pcols,pver) ! forward scattered fraction * tau * w + logical, intent(in) :: oldicewp + + real(r8), pointer, dimension(:,:) :: rei + real(r8), pointer, dimension(:,:) :: cldn + real(r8), pointer, dimension(:,:) :: tmpptr + real(r8), dimension(pcols,pver) :: cicewp + real(r8), dimension(nswbands) :: wavmin + real(r8), dimension(nswbands) :: wavmax + ! + ! ice water coefficients (Ebert and Curry,1992, JGR, 97, 3831-3836) + real(r8) :: abari(4) = & ! a coefficient for extinction optical depth + (/ 3.448e-03_r8, 3.448e-03_r8,3.448e-03_r8,3.448e-03_r8/) + real(r8) :: bbari(4) = & ! b coefficient for extinction optical depth + (/ 2.431_r8 , 2.431_r8 ,2.431_r8 ,2.431_r8 /) + real(r8) :: cbari(4) = & ! c coefficient for single scat albedo + (/ 1.00e-05_r8 , 1.10e-04_r8 ,1.861e-02_r8,.46658_r8 /) + real(r8) :: dbari(4) = & ! d coefficient for single scat albedo + (/ 0.0_r8 , 1.405e-05_r8,8.328e-04_r8,2.05e-05_r8 /) + real(r8) :: ebari(4) = & ! e coefficient for asymmetry parameter + (/ 0.7661_r8 , 0.7730_r8 ,0.794_r8 ,0.9595_r8 /) + real(r8) :: fbari(4) = & ! f coefficient for asymmetry parameter + (/ 5.851e-04_r8, 5.665e-04_r8,7.267e-04_r8,1.076e-04_r8/) + + real(r8) :: abarii ! A coefficient for current spectral band + real(r8) :: bbarii ! B coefficient for current spectral band + real(r8) :: cbarii ! C coefficient for current spectral band + real(r8) :: dbarii ! D coefficient for current spectral band + real(r8) :: ebarii ! E coefficient for current spectral band + real(r8) :: fbarii ! F coefficient for current spectral band + + ! Minimum cloud amount (as a fraction of the grid-box area) to + ! distinguish from clear sky + real(r8), parameter :: cldmin = 1.0e-80_r8 + + ! Decimal precision of cloud amount (0 -> preserve full resolution; + ! 10^-n -> preserve n digits of cloud amount) + real(r8), parameter :: cldeps = 0.0_r8 + + integer :: ns, i, k, indxsl, lchnk, Nday + integer :: itim_old + real(r8) :: tmp1i, tmp2i, tmp3i, g + + Nday = state%ncol + lchnk = state%lchnk + + itim_old = pbuf_old_tim_idx() + call pbuf_get_field(pbuf, cld_idx,cldn, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, rei_idx,rei) + + if(oldicewp) then + do k=1,pver + do i = 1,Nday + cicewp(i,k) = 1000.0_r8*state%q(i,k,ixcldice)*state%pdel(i,k) /(gravit* max(0.01_r8,cldn(i,k))) + end do + end do + else + if (iciwp_idx<=0) then + call endrun('old_ice_optics_sw: oldicewp must be set to true since ICIWP was not found in pbuf') + endif + call pbuf_get_field(pbuf, iciwp_idx, tmpptr) + cicewp(1:pcols,1:pver) = 1000.0_r8*tmpptr + endif + + call get_sw_spectral_boundaries(wavmin,wavmax,'microns') + + do ns = 1, nswbands + + if(wavmax(ns) <= 0.7_r8) then + indxsl = 1 + else if(wavmax(ns) <= 1.25_r8) then + indxsl = 2 + else if(wavmax(ns) <= 2.38_r8) then + indxsl = 3 + else if(wavmin(ns) > 2.38_r8) then + indxsl = 4 + end if + + abarii = abari(indxsl) + bbarii = bbari(indxsl) + cbarii = cbari(indxsl) + dbarii = dbari(indxsl) + ebarii = ebari(indxsl) + fbarii = fbari(indxsl) + + do k=1,pver + do i=1,Nday + + ! note that optical properties for ice valid only + ! in range of 13 > rei > 130 micron (Ebert and Curry 92) + if (cldn(i,k) >= cldmin .and. cldn(i,k) >= cldeps) then + tmp1i = abarii + bbarii/max(13._r8,min(scalefactor*rei(i,k),130._r8)) + ice_tau(ns,i,k) = cicewp(i,k)*tmp1i + else + ice_tau(ns,i,k) = 0.0_r8 + endif + + tmp2i = 1._r8 - cbarii - dbarii*min(max(13._r8,scalefactor*rei(i,k)),130._r8) + tmp3i = fbarii*min(max(13._r8,scalefactor*rei(i,k)),130._r8) + ! Do not let single scatter albedo be 1. Delta-eddington solution + ! for non-conservative case has different analytic form from solution + ! for conservative case, and raddedmx is written for non-conservative case. + ice_tau_w(ns,i,k) = ice_tau(ns,i,k) * min(tmp2i,.999999_r8) + g = ebarii + tmp3i + ice_tau_w_g(ns,i,k) = ice_tau_w(ns,i,k) * g + ice_tau_w_f(ns,i,k) = ice_tau_w(ns,i,k) * g * g + + end do ! End do i=1,Nday + end do ! End do k=1,pver + end do ! nswbands + +end subroutine old_ice_optics_sw +!============================================================================== + +subroutine oldcloud_lw(state,pbuf,cld_abs_od,oldwp) + use physconst, only: gravit + type(physics_state), intent(in) :: state + type(physics_buffer_desc),pointer :: pbuf(:) + real(r8), intent(out) :: cld_abs_od(nlwbands,pcols,pver) ! [fraction] absorption optical depth, per layer + logical,intent(in) :: oldwp ! use old definition of waterpath + + + real(r8) :: gicewp(pcols,pver) + real(r8) :: gliqwp(pcols,pver) + real(r8) :: cicewp(pcols,pver) + real(r8) :: cliqwp(pcols,pver) + real(r8) :: ficemr(pcols,pver) + real(r8) :: cwp(pcols,pver) + real(r8) :: cldtau(pcols,pver) + + real(r8), pointer, dimension(:,:) :: cldn + real(r8), pointer, dimension(:,:) :: rei + integer :: ncol, itim_old, lwband, i, k, lchnk + real(r8), pointer, dimension(:,:) :: iclwpth, iciwpth + + real(r8) :: kabs, kabsi + real(r8) kabsl ! longwave liquid absorption coeff (m**2/g) + parameter (kabsl = 0.090361_r8) + + + + ncol = state%ncol + lchnk = state%lchnk + + itim_old = pbuf_old_tim_idx() + call pbuf_get_field(pbuf, rei_idx, rei) + call pbuf_get_field(pbuf, cld_idx, cldn, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + + if (oldwp) then + do k=1,pver + do i = 1,ncol + gicewp(i,k) = state%q(i,k,ixcldice)*state%pdel(i,k)/gravit*1000.0_r8 ! Grid box ice water path. + gliqwp(i,k) = state%q(i,k,ixcldliq)*state%pdel(i,k)/gravit*1000.0_r8 ! Grid box liquid water path. + cicewp(i,k) = gicewp(i,k) / max(0.01_r8,cldn(i,k)) ! In-cloud ice water path. + cliqwp(i,k) = gliqwp(i,k) / max(0.01_r8,cldn(i,k)) ! In-cloud liquid water path. + ficemr(i,k) = state%q(i,k,ixcldice) / & + max(1.e-10_r8,(state%q(i,k,ixcldice)+state%q(i,k,ixcldliq))) + end do + end do + cwp(:ncol,:pver) = cicewp(:ncol,:pver) + cliqwp(:ncol,:pver) + else + if (iclwp_idx<=0 .or. iciwp_idx<=0) then + call endrun('oldcloud_lw: oldwp must be set to true since ICIWP and/or ICLWP were not found in pbuf') + endif + call pbuf_get_field(pbuf, iclwp_idx, iclwpth) + call pbuf_get_field(pbuf, iciwp_idx, iciwpth) + do k=1,pver + do i = 1,ncol + cwp(i,k) = 1000.0_r8 *iclwpth(i,k) + 1000.0_r8 *iciwpth(i, k) + ficemr(i,k) = 1000.0_r8 * iciwpth(i,k)/(max(1.e-18_r8,cwp(i,k))) + end do + end do + endif + + do k=1,pver + do i=1,ncol + + !note that optical properties for ice valid only + !in range of 13 > rei > 130 micron (Ebert and Curry 92) + kabsi = 0.005_r8 + 1._r8/min(max(13._r8,scalefactor*rei(i,k)),130._r8) + kabs = kabsl*(1._r8-ficemr(i,k)) + kabsi*ficemr(i,k) + !emis(i,k) = 1._r8 - exp(-1.66_r8*kabs*clwp(i,k)) + cldtau(i,k) = kabs*cwp(i,k) + end do + end do +! + do lwband = 1,nlwbands + cld_abs_od(lwband,1:ncol,1:pver)=cldtau(1:ncol,1:pver) + enddo + +end subroutine oldcloud_lw + +!============================================================================== +subroutine old_liq_get_rad_props_lw(state, pbuf, abs_od, oldliqwp) + use physconst, only: gravit + + type(physics_state), intent(in) :: state + type(physics_buffer_desc),pointer :: pbuf(:) + real(r8), intent(out) :: abs_od(nlwbands,pcols,pver) + logical, intent(in) :: oldliqwp + + real(r8) :: gicewp(pcols,pver) + real(r8) :: gliqwp(pcols,pver) + real(r8) :: cicewp(pcols,pver) + real(r8) :: cliqwp(pcols,pver) + real(r8) :: ficemr(pcols,pver) + real(r8) :: cwp(pcols,pver) + real(r8) :: cldtau(pcols,pver) + + real(r8), pointer, dimension(:,:) :: cldn + real(r8), pointer, dimension(:,:) :: rei + integer :: ncol, itim_old, lwband, i, k, lchnk + + real(r8) :: kabs, kabsi + real(r8) kabsl ! longwave liquid absorption coeff (m**2/g) + parameter (kabsl = 0.090361_r8) + + real(r8), pointer, dimension(:,:) :: iclwpth, iciwpth + + ncol=state%ncol + lchnk = state%lchnk + + itim_old = pbuf_old_tim_idx() + call pbuf_get_field(pbuf, rei_idx, rei) + call pbuf_get_field(pbuf, cld_idx, cldn, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + + if (oldliqwp) then + do k=1,pver + do i = 1,ncol + gicewp(i,k) = state%q(i,k,ixcldice)*state%pdel(i,k)/gravit*1000.0_r8 ! Grid box ice water path. + gliqwp(i,k) = state%q(i,k,ixcldliq)*state%pdel(i,k)/gravit*1000.0_r8 ! Grid box liquid water path. + cicewp(i,k) = gicewp(i,k) / max(0.01_r8,cldn(i,k)) ! In-cloud ice water path. + cliqwp(i,k) = gliqwp(i,k) / max(0.01_r8,cldn(i,k)) ! In-cloud liquid water path. + ficemr(i,k) = state%q(i,k,ixcldice) / & + max(1.e-10_r8,(state%q(i,k,ixcldice)+state%q(i,k,ixcldliq))) + end do + end do + cwp(:ncol,:pver) = cicewp(:ncol,:pver) + cliqwp(:ncol,:pver) + else + if (iclwp_idx<=0 .or. iciwp_idx<=0) then + call endrun('old_liq_get_rad_props_lw: oldliqwp must be set to true since ICIWP and/or ICLWP were not found in pbuf') + endif + call pbuf_get_field(pbuf, iclwp_idx, iclwpth) + call pbuf_get_field(pbuf, iciwp_idx, iciwpth) + do k=1,pver + do i = 1,ncol + cwp(i,k) = 1000.0_r8 *iclwpth(i,k) + 1000.0_r8 *iciwpth(i, k) + ficemr(i,k) = 1000.0_r8 * iciwpth(i,k)/(max(1.e-18_r8,cwp(i,k))) + end do + end do + endif + + + do k=1,pver + do i=1,ncol + + ! Note from Andrew Conley: + ! Optics for RK no longer supported, This is constructed to get + ! close to bit for bit. Otherwise we could simply use liquid water path + !note that optical properties for ice valid only + !in range of 13 > rei > 130 micron (Ebert and Curry 92) + kabsi = 0.005_r8 + 1._r8/min(max(13._r8,scalefactor*rei(i,k)),130._r8) + kabs = kabsl*(1._r8-ficemr(i,k)) ! + kabsi*ficemr(i,k) + !emis(i,k) = 1._r8 - exp(-1.66_r8*kabs*clwp(i,k)) + cldtau(i,k) = kabs*cwp(i,k) + end do + end do +! + do lwband = 1,nlwbands + abs_od(lwband,1:ncol,1:pver)=cldtau(1:ncol,1:pver) + enddo + + +end subroutine old_liq_get_rad_props_lw +!============================================================================== + +subroutine old_ice_get_rad_props_lw(state, pbuf, abs_od, oldicewp) + use physconst, only: gravit + type(physics_state), intent(in) :: state + type(physics_buffer_desc),pointer :: pbuf(:) + real(r8), intent(out) :: abs_od(nlwbands,pcols,pver) + logical, intent(in) :: oldicewp + + real(r8) :: gicewp(pcols,pver) + real(r8) :: gliqwp(pcols,pver) + real(r8) :: cicewp(pcols,pver) + real(r8) :: cliqwp(pcols,pver) + real(r8) :: ficemr(pcols,pver) + real(r8) :: cwp(pcols,pver) + real(r8) :: cldtau(pcols,pver) + + real(r8), pointer, dimension(:,:) :: cldn + real(r8), pointer, dimension(:,:) :: rei + integer :: ncol, itim_old, lwband, i, k, lchnk + + real(r8) :: kabs, kabsi + + real(r8) kabsl ! longwave liquid absorption coeff (m**2/g) + parameter (kabsl = 0.090361_r8) + + real(r8), pointer, dimension(:,:) :: iclwpth, iciwpth + + + ncol = state%ncol + lchnk = state%lchnk + + itim_old = pbuf_old_tim_idx() + call pbuf_get_field(pbuf, rei_idx, rei) + call pbuf_get_field(pbuf, cld_idx, cldn, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + + if(oldicewp) then + do k=1,pver + do i = 1,ncol + gicewp(i,k) = state%q(i,k,ixcldice)*state%pdel(i,k)/gravit*1000.0_r8 ! Grid box ice water path. + gliqwp(i,k) = state%q(i,k,ixcldliq)*state%pdel(i,k)/gravit*1000.0_r8 ! Grid box liquid water path. + cicewp(i,k) = gicewp(i,k) / max(0.01_r8,cldn(i,k)) ! In-cloud ice water path. + cliqwp(i,k) = gliqwp(i,k) / max(0.01_r8,cldn(i,k)) ! In-cloud liquid water path. + ficemr(i,k) = state%q(i,k,ixcldice) / & + max(1.e-10_r8,(state%q(i,k,ixcldice)+state%q(i,k,ixcldliq))) + end do + end do + cwp(:ncol,:pver) = cicewp(:ncol,:pver) + cliqwp(:ncol,:pver) + else + if (iclwp_idx<=0 .or. iciwp_idx<=0) then + call endrun('old_ice_get_rad_props_lw: oldicewp must be set to true since ICIWP and/or ICLWP were not found in pbuf') + endif + call pbuf_get_field(pbuf, iclwp_idx, iclwpth) + call pbuf_get_field(pbuf, iciwp_idx, iciwpth) + do k=1,pver + do i = 1,ncol + cwp(i,k) = 1000.0_r8 *iciwpth(i,k) + 1000.0_r8 *iclwpth(i,k) + ficemr(i,k) = 1000.0_r8*iciwpth(i,k)/(max(1.e-18_r8,cwp(i,k))) + end do + end do + endif + + do k=1,pver + do i=1,ncol + + ! Note from Andrew Conley: + ! Optics for RK no longer supported, This is constructed to get + ! close to bit for bit. Otherwise we could simply use ice water path + !note that optical properties for ice valid only + !in range of 13 > rei > 130 micron (Ebert and Curry 92) + kabsi = 0.005_r8 + 1._r8/min(max(13._r8,scalefactor*rei(i,k)),130._r8) + kabs = kabsi*ficemr(i,k) ! kabsl*(1._r8-ficemr(i,k)) + kabsi*ficemr(i,k) + !emis(i,k) = 1._r8 - exp(-1.66_r8*kabs*clwp(i,k)) + cldtau(i,k) = kabs*cwp(i,k) + end do + end do +! + do lwband = 1,nlwbands + abs_od(lwband,1:ncol,1:pver)=cldtau(1:ncol,1:pver) + enddo + + !if(oldicewp) then + ! call outfld('CIWPTH_OLD',cicewp(:,:)/1000,pcols,lchnk) + !else + ! call outfld('CIWPTH_OLD',iciwpth(:,:),pcols,lchnk) + !endif + !call outfld('CI_OD_LW_OLD',cldtau(:,:),pcols,lchnk) + +end subroutine old_ice_get_rad_props_lw +!============================================================================== + +subroutine cloud_total_vis_diag_out(lchnk, nnite, idxnite, tau, radsuffix) + + ! output total aerosol optical depth for the visible band + + use cam_history, only: outfld + use cam_history_support, only : fillvalue + + integer, intent(in) :: lchnk + integer, intent(in) :: nnite ! number of night columns + integer, intent(in) :: idxnite(nnite) ! local column indices of night columns + real(r8), intent(in) :: tau(:,:) + character(len=*), intent(in) :: radsuffix ! identifies whether the radiation call + ! is for the climate calc or a diagnostic calc + + ! Local variables + integer :: i + real(r8) :: tmp(pcols) + !----------------------------------------------------------------------------- + + ! compute total aerosol optical depth output where only daylight columns + tmp(:) = sum(tau(:,:), 2) + do i = 1, nnite + tmp(idxnite(i)) = fillvalue + end do + !call outfld('cloudOD_v'//trim(radsuffix), tmp, pcols, lchnk) + +end subroutine cloud_total_vis_diag_out + +!============================================================================== + +end module oldcloud diff --git a/src/physics/rrtmgp/rad_solar_var.F90 b/src/physics/rrtmgp/rad_solar_var.F90 new file mode 100644 index 0000000000..82c6b120d3 --- /dev/null +++ b/src/physics/rrtmgp/rad_solar_var.F90 @@ -0,0 +1,148 @@ +!------------------------------------------------------------------------------- +! This module uses the Lean solar irradiance data to provide a solar cycle +! scaling factor used in heating rate calculations +!------------------------------------------------------------------------------- +module rad_solar_var + + use shr_kind_mod , only : r8 => shr_kind_r8 + use solar_irrad_data, only : sol_irrad, we, nbins, has_spectrum, sol_tsi + use solar_irrad_data, only : do_spctrl_scaling + use cam_abortutils, only : endrun + + implicit none + save + + private + public :: rad_solar_var_init + public :: get_variability + + real(r8), allocatable :: ref_band_irrad(:) ! scaling will be relative to ref_band_irrad in each band + real(r8), allocatable :: irrad(:) ! solar irradiance at model timestep in each band + real(r8) :: tsi_ref ! total solar irradiance assumed by RRTMGP + + real(r8), allocatable :: radbinmax(:) + real(r8), allocatable :: radbinmin(:) + integer :: nradbins + +!------------------------------------------------------------------------------- +contains +!------------------------------------------------------------------------------- + + subroutine rad_solar_var_init( ) + use radconstants, only : get_number_sw_bands + use radconstants, only : get_sw_spectral_boundaries + use radconstants, only : get_ref_solar_band_irrad + use radconstants, only : get_ref_total_solar_irrad + + integer :: i + integer :: ierr + integer :: yr, mon, tod + integer :: radmax_loc + + + call get_number_sw_bands(nradbins) + + if ( do_spctrl_scaling ) then + + if ( .not.has_spectrum ) then + call endrun('rad_solar_var_init: solar input file must have irradiance spectrum') + endif + + allocate (radbinmax(nradbins),stat=ierr) + if (ierr /= 0) then + call endrun('rad_solar_var_init: Error allocating space for radbinmax') + end if + + allocate (radbinmin(nradbins),stat=ierr) + if (ierr /= 0) then + call endrun('rad_solar_var_init: Error allocating space for radbinmin') + end if + + allocate (ref_band_irrad(nradbins), stat=ierr) + if (ierr /= 0) then + call endrun('rad_solar_var_init: Error allocating space for ref_band_irrad') + end if + + allocate (irrad(nradbins), stat=ierr) + if (ierr /= 0) then + call endrun('rad_solar_var_init: Error allocating space for irrad') + end if + + call get_sw_spectral_boundaries(radbinmin, radbinmax, 'nm') + + ! Make sure that the far-IR is included, even if RRTMG does not + ! extend that far down. 10^5 nm corresponds to a wavenumber of + ! 100 cm^-1. + radmax_loc = maxloc(radbinmax,1) + radbinmax(radmax_loc) = max(100000._r8,radbinmax(radmax_loc)) + + ! for rrtmg, reference spectrum from rrtmg + call get_ref_solar_band_irrad( ref_band_irrad ) + + else + + call get_ref_total_solar_irrad(tsi_ref) + + endif + + end subroutine rad_solar_var_init + +!------------------------------------------------------------------------------- +!------------------------------------------------------------------------------- + subroutine get_variability( sfac ) + + real(r8), intent(out) :: sfac(nradbins) ! scaling factors for CAM heating + + integer :: yr, mon, day, tod + + if ( do_spctrl_scaling ) then + call integrate_spectrum( nbins, nradbins, we, radbinmin, radbinmax, sol_irrad, irrad) + sfac(:nradbins) = irrad(:nradbins)/ref_band_irrad(:nradbins) + else + sfac(:nradbins) = sol_tsi/tsi_ref + endif + + end subroutine get_variability + +!------------------------------------------------------------------------------- +! private method......... +!------------------------------------------------------------------------------- + + subroutine integrate_spectrum( nsrc, ntrg, src_x, min_trg, max_trg, src, trg ) + + use mo_util, only : rebin + + implicit none + + !--------------------------------------------------------------- + ! ... dummy arguments + !--------------------------------------------------------------- + integer, intent(in) :: nsrc ! dimension source array + integer, intent(in) :: ntrg ! dimension target array + real(r8), intent(in) :: src_x(nsrc+1) ! source coordinates + real(r8), intent(in) :: max_trg(ntrg) ! target coordinates + real(r8), intent(in) :: min_trg(ntrg) ! target coordinates + real(r8), intent(in) :: src(nsrc) ! source array + real(r8), intent(out) :: trg(ntrg) ! target array + + !--------------------------------------------------------------- + ! ... local variables + !--------------------------------------------------------------- + real(r8) :: trg_x(2), targ(1) ! target coordinates + integer :: i + + do i = 1, ntrg + + trg_x(1) = min_trg(i) + trg_x(2) = max_trg(i) + + call rebin( nsrc, 1, src_x, trg_x, src(1:nsrc), targ(:) ) + ! W/m2/nm --> W/m2 + trg( i ) = targ(1)*(trg_x(2)-trg_x(1)) + + enddo + + + end subroutine integrate_spectrum + +end module rad_solar_var diff --git a/src/physics/rrtmgp/radconstants.F90 b/src/physics/rrtmgp/radconstants.F90 new file mode 100644 index 0000000000..1d1657fdc4 --- /dev/null +++ b/src/physics/rrtmgp/radconstants.F90 @@ -0,0 +1,427 @@ +module radconstants + +! This module contains constants that are specific to the radiative transfer +! code used in the RRTMGP model. + +! This comment from E3SM implementation, and is entirely relevant here: +! TODO: Should this data be handled in a more robust way? Much of this contains +! explicit mappings to indices, which would probably be better handled with get_ +! functions. I.e., get_nswbands() could query the kdist objects in case of +! RRTMGP, and the diag indices could look up the actual bands used in the kdist +! objects as well. On that note, this module should probably go away if +! possible in the future, and we should provide more robust access to the +! radiation interface. + + +use shr_kind_mod, only: r8 => shr_kind_r8 +use cam_abortutils, only: endrun + +implicit none +private +save + +! Number of bands in SW and LW (these will be set when RRTMGP initializes) +integer, public, protected :: nswbands = 14 +integer, public, protected :: nlwbands = 16 + +! Band limits (these get also get set at initialization) +real(r8), public, allocatable :: wavenumber_low_shortwave(:) +real(r8), public, allocatable :: wavenumber_high_shortwave(:) +real(r8), public, allocatable :: wavenumber_low_longwave(:) +real(r8), public, allocatable :: wavenumber_high_longwave(:) +! Reference irradiance per band +real(r8), public, allocatable :: solar_ref_band_irradiance(:) +real(r8), public, protected :: ref_tsi + +! SHORTWAVE DATA + + +! Wavenumbers of band boundaries +! +! Note: Currently rad_solar_var extends the lowest band down to +! 100 cm^-1 if it is too high to cover the far-IR. Any changes meant +! to affect IR solar variability should take note of this. + +! NOTE: these follow the non-monotonic ordering used for RRTMG +! - This is necessary because the optical properties files made for RRTMG use this order too. + +! NOTE: aside from order, as noted, these values match the ones in +! RRTMGP coefficients files. But I think we should be *setting* these +! values based on what is in that file, rather than hard-coding it here. + +! BPM: comment this data structure --> set it from radiation_init +! real(r8),parameter :: wavenumber_low_shortwave(nswbands) = & ! in cm^-1 +! (/2600._r8, 3250._r8, 4000._r8, 4650._r8, 5150._r8, 6150._r8, 7700._r8, & +! 8050._r8,12850._r8,16000._r8,22650._r8,29000._r8,38000._r8, 820._r8/) +! real(r8),parameter :: wavenumber_high_shortwave(nswbands) = & ! in cm^-1 +! (/3250._r8, 4000._r8, 4650._r8, 5150._r8, 6150._r8, 7700._r8, 8050._r8, & +! 12850._r8,16000._r8,22650._r8,29000._r8,38000._r8,50000._r8, 2600._r8/) + +! Mapping from RRTMG shortwave bands to RRTMGP +integer, parameter, dimension(14), public :: rrtmg_to_rrtmgp_swbands = & + (/ & + 14, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13 & + /) + +! BPM <-- commented this block. Replaced by allocatable, get values by calling set_irrad_by_band --> +! Solar irradiance at 1 A.U. in W/m^2 assumed by radiation code +! Rescaled so that sum is precisely 1368.22 and fractional amounts sum to 1.0 +! real(r8), parameter :: solar_ref_band_irradiance(nswbands) = & +! (/ & +! 12.11_r8, 20.3600000000001_r8, 23.73_r8, & +! 22.43_r8, 55.63_r8, 102.93_r8, 24.29_r8, & +! 345.74_r8, 218.19_r8, 347.20_r8, & +! 129.49_r8, 50.15_r8, 3.08_r8, 12.89_r8 & +! /) + +! These are indices to the band for diagnostic output +! CHANGE: rather than make these parameters, provide subroutines that set them +! using the function get_band_index_by_value (which should be called on initializing radiation) +! integer, parameter, public :: idx_sw_diag = 10 ! index to sw visible band (441 - 625 nm) +! integer, parameter, public :: idx_nir_diag = 8 ! index to sw near infrared (778-1240 nm) band +! integer, parameter, public :: idx_uv_diag = 11 ! index to sw uv (345-441 nm) band + +! integer, parameter, public :: rrtmg_sw_cloudsim_band = 9 ! rrtmgp band for .67 micron +! integer, parameter, public :: rrtmgp_sw_cloudsim_band = 10 ! b/c one band moves to beginning + +integer, public :: idx_sw_diag ! index to sw visible band (441 - 625 nm) +integer, public :: idx_nir_diag! index to sw near infrared (778-1240 nm) band +integer, public :: idx_uv_diag ! index to sw uv (345-441 nm) band + +! CHANGE: instead of setting rrtmg[p]_sw_cloudsim_band in radconstants, just make it in radiation +! rrtmgp_sw_cloudsim_band = get_band_index_by_value('sw', 0.67_r8, 'micron') ! rrtmgp band for .67 micron +! same for lw: +! rrtmgp_lw_cloudsim_band = get_band_index_by_value('lw', 10.5_r8, 'micron') + +! Number of evenly spaced intervals in rh +! The globality of this mesh may not be necessary +! Perhaps it could be specific to the aerosol +! But it is difficult to see how refined it must be +! for lookup. This value was found to be sufficient +! for Sulfate and probably necessary to resolve the +! high variation near rh = 1. Alternative methods +! were found to be too slow. +! Optimal approach would be for cam to specify size of aerosol +! based on each aerosol's characteristics. Radiation +! should know nothing about hygroscopic growth! +integer, parameter, public :: nrh = 1000 + +! LONGWAVE DATA + +! These are indices to the band for diagnostic output (see comment above about change) +! integer, parameter, public :: idx_lw_diag = 7 ! index to (H20 window) LW band +integer, public :: idx_lw_diag + + +! These are commented, and intended to be replaced by reading the RRTMGP optics object +! real(r8), parameter :: wavenumber_low_longwave(nlwbands) = &! Longwave spectral band limits (cm-1) +! (/ 10._r8, 350._r8, 500._r8, 630._r8, 700._r8, 820._r8, 980._r8, 1080._r8, & +! 1180._r8, 1390._r8, 1480._r8, 1800._r8, 2080._r8, 2250._r8, 2380._r8, 2600._r8 /) + +! real(r8), parameter :: wavenumber_high_longwave(nlwbands) = &! Longwave spectral band limits (cm-1) +! (/ 350._r8, 500._r8, 630._r8, 700._r8, 820._r8, 980._r8, 1080._r8, 1180._r8, & +! 1390._r8, 1480._r8, 1800._r8, 2080._r8, 2250._r8, 2380._r8, 2600._r8, 3250._r8 /) + +! GASES TREATED BY RADIATION (line spectrae) +integer, public, parameter :: gasnamelength = 5 +integer, public, parameter :: nradgas = 8 +character(len=gasnamelength), public, parameter :: gaslist(nradgas) & + = (/'H2O ','O3 ', 'O2 ', 'CO2 ', 'N2O ', 'CH4 ', 'CFC11', 'CFC12'/) + +! what is the minimum mass mixing ratio that can be supported by radiation implementation? +real(r8), public, parameter :: minmmr(nradgas) & + = epsilon(1._r8) + +! Length of "optics type" string specified in optics files. +integer, parameter, public :: ot_length = 32 + +public :: rad_gas_index + +public :: get_number_sw_bands, & + get_sw_spectral_boundaries, & + get_lw_spectral_boundaries, & + get_ref_solar_band_irrad, & + get_ref_total_solar_irrad, & + ! get_solar_band_fraction_irrad, & + get_idx_sw_diag, & + get_idx_nir_diag, & + get_idx_uv_diag, & + get_idx_lw_diag, & + get_band_index_by_value, & + set_wavenumber_bands,& + get_number_lw_bands, & + set_number_lw_bands, & + set_number_sw_bands, & + set_irrad_by_band, & + set_reference_tsi + +contains +!------------------------------------------------------------------------------ + ! COMMENT -- THIS CODE IS NOT USED. + ! subroutine get_solar_band_fraction_irrad(fractional_irradiance) + ! ! provide Solar Irradiance for each band in RRTMG + + ! ! fraction of solar irradiance in each band + ! real(r8), intent(out) :: fractional_irradiance(1:nswbands) + ! real(r8) :: tsi ! total solar irradiance + + ! tsi = sum(solar_ref_band_irradiance) + ! fractional_irradiance = solar_ref_band_irradiance / tsi + + ! end subroutine get_solar_band_fraction_irrad +!------------------------------------------------------------------------------ +subroutine get_ref_total_solar_irrad(tsi) + ! provide Total Solar Irradiance assumed by RRTMGP + + real(r8), intent(out) :: tsi + + ! tsi = sum(solar_ref_band_irradiance) + tsi = ref_tsi + +end subroutine get_ref_total_solar_irrad +!------------------------------------------------------------------------------ +subroutine set_reference_tsi(tsi) + ! set ref_tsi to provide total solar irradiance + ! this usually comes from reading a file + ! provided by the radiation scheme developers + real(r8), intent(in) :: tsi + ref_tsi = tsi +end subroutine set_reference_tsi +!------------------------------------------------------------------------------ +subroutine get_ref_solar_band_irrad( band_irrad ) + ! note: this shouldn't be used. + ! Instead, just use radconstants, only: solar_ref_band_irradiance + ! to access the data directly + ! solar irradiance in each band (W/m^2) + real(r8), intent(out) :: band_irrad(nswbands) + + if (allocated(solar_ref_band_irradiance)) then + band_irrad = solar_ref_band_irradiance + else + ! what to do + end if + +end subroutine get_ref_solar_band_irrad +!------------------------------------------------------------------------------ +subroutine get_number_sw_bands(number_of_bands) + + ! number of solar (shortwave) bands + integer, intent(out) :: number_of_bands + + number_of_bands = nswbands + +end subroutine get_number_sw_bands +!------------------------------------------------------------------------------ +subroutine set_number_sw_bands(number_of_bands) + ! set module data nswbands + ! expect: number_of_bands provided from RRTMGP optical properties object + integer, intent(in) :: number_of_bands + nswbands = number_of_bands +end subroutine set_number_sw_bands +!------------------------------------------------------------------------------ +subroutine get_number_lw_bands(number_of_bands) + + ! number of longwave bands + integer, intent(out) :: number_of_bands + + number_of_bands = nlwbands + +end subroutine get_number_lw_bands +!------------------------------------------------------------------------------ +subroutine set_number_lw_bands(number_of_bands) + ! set module data nlwbands + ! expect: number_of_bands provided from RRTMGP optical properties object + integer, intent(in) :: number_of_bands + nlwbands = number_of_bands +end subroutine set_number_lw_bands +!------------------------------------------------------------------------------ +subroutine set_wavenumber_bands(swlw, nbands, values) + ! set the low and high limits of the wavenumber grid for sw or lw + ! expect that values comes from RRTMGP method get_band_lims_wavenumber + character(*), intent(in) :: swlw ! which set of bands to set ['sw', 'lw'] + integer, intent(in) :: nbands + real(r8), intent(in) :: values(2,nbands) + select case(swlw) + case ('sw') + allocate(wavenumber_low_shortwave(nbands)) + allocate(wavenumber_high_shortwave(nbands)) + wavenumber_low_shortwave = values(1,:) + wavenumber_high_shortwave = values(2,:) + case ('lw') + allocate(wavenumber_low_longwave(nbands)) + allocate(wavenumber_high_longwave(nbands)) + wavenumber_low_longwave = values(1,:) + wavenumber_high_longwave = values(2,:) + end select +end subroutine set_wavenumber_bands +!------------------------------------------------------------------------------ +subroutine get_lw_spectral_boundaries(low_boundaries, high_boundaries, units) + ! provide spectral boundaries of each longwave band + + real(r8), intent(out) :: low_boundaries(nlwbands), high_boundaries(nlwbands) + character(*), intent(in) :: units ! requested units + + select case (units) + case ('inv_cm','cm^-1','cm-1') + low_boundaries = wavenumber_low_longwave + high_boundaries = wavenumber_high_longwave + case('m','meter','meters') + low_boundaries = 1.e-2_r8/wavenumber_high_longwave + high_boundaries = 1.e-2_r8/wavenumber_low_longwave + case('nm','nanometer','nanometers') + low_boundaries = 1.e7_r8/wavenumber_high_longwave + high_boundaries = 1.e7_r8/wavenumber_low_longwave + case('um','micrometer','micrometers','micron','microns') + low_boundaries = 1.e4_r8/wavenumber_high_longwave + high_boundaries = 1.e4_r8/wavenumber_low_longwave + case('cm','centimeter','centimeters') + low_boundaries = 1._r8/wavenumber_high_longwave + high_boundaries = 1._r8/wavenumber_low_longwave + case default + call endrun('get_lw_spectral_boundaries: spectral units not acceptable'//units) + end select + +end subroutine get_lw_spectral_boundaries + +!------------------------------------------------------------------------------ +subroutine get_sw_spectral_boundaries(low_boundaries, high_boundaries, units) + ! provide spectral boundaries of each shortwave band + + real(r8), intent(out) :: low_boundaries(nswbands), high_boundaries(nswbands) + character(*), intent(in) :: units ! requested units + + select case (units) + case ('inv_cm','cm^-1','cm-1') + low_boundaries = wavenumber_low_shortwave + high_boundaries = wavenumber_high_shortwave + case('m','meter','meters') + low_boundaries = 1.e-2_r8/wavenumber_high_shortwave + high_boundaries = 1.e-2_r8/wavenumber_low_shortwave + case('nm','nanometer','nanometers') + low_boundaries = 1.e7_r8/wavenumber_high_shortwave + high_boundaries = 1.e7_r8/wavenumber_low_shortwave + case('um','micrometer','micrometers','micron','microns') + low_boundaries = 1.e4_r8/wavenumber_high_shortwave + high_boundaries = 1.e4_r8/wavenumber_low_shortwave + case('cm','centimeter','centimeters') + low_boundaries = 1._r8/wavenumber_high_shortwave + high_boundaries = 1._r8/wavenumber_low_shortwave + case default + call endrun('rad_constants.F90: spectral units not acceptable'//units) + end select + +end subroutine get_sw_spectral_boundaries + +!------------------------------------------------------------------------------ +integer function rad_gas_index(gasname) + + ! return the index in the gaslist array of the specified gasname + + character(len=*),intent(in) :: gasname + integer :: igas + + rad_gas_index = -1 + do igas = 1, nradgas + if (trim(gaslist(igas)).eq.trim(gasname)) then + rad_gas_index = igas + return + endif + enddo + call endrun ("rad_gas_index: can not find gas with name "//gasname) +end function rad_gas_index +!------------------------------------------------------------------------------ +subroutine get_idx_sw_diag() + idx_sw_diag = get_band_index_by_value('sw', 500.0_r8, 'nm') +end subroutine + +subroutine get_idx_nir_diag() + idx_nir_diag = get_band_index_by_value('sw', 1000.0_r8, 'nm') +end subroutine + +subroutine get_idx_uv_diag() + idx_uv_diag = get_band_index_by_value('sw', 400._r8, 'nm') +end subroutine + +subroutine get_idx_lw_diag() + idx_lw_diag = get_band_index_by_value('lw', 1000.0_r8, 'cm^-1') + ! value chosen to match the band used in CESM1/CESM2 +end subroutine + +function get_band_index_by_value(swlw, targetvalue, units) result(ans) + character(len=*),intent(in) :: swlw ! sw or lw bands + real(r8),intent(in) :: targetvalue + character(len=*),intent(in) :: units ! units of targetvalue + integer :: ans + ! local + real(r8), allocatable, dimension(:) :: lowboundaries, highboundaries + real(r8) :: tgt + integer :: nbnds, i + + select case (swlw) + case ('sw','SW','shortwave') + nbnds = nswbands + allocate(lowboundaries(nbnds), highboundaries(nbnds)) + lowboundaries = wavenumber_low_shortwave + highboundaries = wavenumber_high_shortwave + case ('lw', 'LW', 'longwave') + nbnds = nlwbands + allocate(lowboundaries(nbnds), highboundaries(nbnds)) + lowboundaries = wavenumber_low_longwave + highboundaries = wavenumber_high_longwave + case default + call endrun('rad_constants.F90: get_band_index_by_value: type of bands not accepted '//swlw) + end select + ! band info is in cm^-1 but target value may be other units, + ! so convert targetvalue to cm^-1 + select case (units) + case ('inv_cm','cm^-1','cm-1') + tgt = targetvalue + case('m','meter','meters') + tgt = 1.0_r8 / (targetvalue * 1.e2_r8) + case('nm','nanometer','nanometers') + tgt = 1.0_r8 / (targetvalue * 1.e-7_r8) + case('um','micrometer','micrometers','micron','microns') + tgt = 1.0_r8 / (targetvalue * 1.e-4_r8) + case('cm','centimeter','centimeters') + tgt = 1._r8/targetvalue + case default + call endrun('rad_constants.F90: get_band_index_by_value: units not acceptable'//units) + end select + ! now just loop through the array + do i = 1,nbnds + if ((tgt > lowboundaries(i)) .and. (tgt <= highboundaries(i))) then + ans = i + exit + end if + end do + ! Do something if the answer is not found? +end function get_band_index_by_value + + +subroutine set_irrad_by_band(solar_source, g2b) + ! Sets the solar irradiance in each shortwave band by summing the irradiance from gpoints. + ! solar_source = kdist_sw%solar_source <-- private TRY solar_source = kdist_sw%solar_source_quiet + ! g2b = kdist_sw%get_gpoint_bands() + real(r8), intent(in) :: solar_source(:) ! size ngpoints: irradiance per gpoint + integer, intent(in) :: g2b(:) ! size ngpoints: mapping from gpoint to band + integer :: i + allocate(solar_ref_band_irradiance(nswbands)) + solar_ref_band_irradiance(:) = 0.0_r8 + do i = 1,size(g2b) + solar_ref_band_irradiance(g2b(i)) = solar_ref_band_irradiance(g2b(i)) + solar_source(i) + end do +end subroutine set_irrad_by_band + +function get_irrad_by_band(solar_source, g2b) result(ans) + real(r8) :: solar_source(:) + integer :: g2b(:) + real(r8), allocatable :: ans(:) + if (.not. allocated(solar_ref_band_irradiance)) then + call set_irrad_by_band(solar_source, g2b) + end if + allocate(ans(size(solar_ref_band_irradiance))) + ans = solar_ref_band_irradiance +end function get_irrad_by_band + + +end module radconstants diff --git a/src/physics/rrtmgp/radiation.F90 b/src/physics/rrtmgp/radiation.F90 new file mode 100644 index 0000000000..c33a36101b --- /dev/null +++ b/src/physics/rrtmgp/radiation.F90 @@ -0,0 +1,3070 @@ +module radiation + +!--------------------------------------------------------------------------------- +! +! CAM interface to RRTMGP radiation parameterization. +! +!--------------------------------------------------------------------------------- + +use shr_kind_mod, only: r8=>shr_kind_r8, cl=>shr_kind_cl +use spmd_utils, only: masterproc +use shr_mem_mod, only: shr_mem_getusage +use ppgrid, only: pcols, pver, pverp, begchunk, endchunk +use ref_pres, only: pref_edge +use physics_types, only: physics_state, physics_ptend +use physics_buffer, only: physics_buffer_desc, pbuf_get_field, pbuf_old_tim_idx +use camsrfexch, only: cam_out_t, cam_in_t +use physconst, only: cappa, cpair, gravit + +use time_manager, only: get_nstep, is_first_restart_step, & + get_curr_calday, get_step_size + +use rad_constituents, only: N_DIAG, rad_cnst_get_call_list, & + rad_cnst_get_info, & + rad_cnst_get_gas, & + rad_cnst_out, & + oldcldoptics, & + liqcldoptics, & + icecldoptics + +use radconstants, only: nswbands, nlwbands, & ! number of bands + idx_sw_diag, & ! indices for diagnostics + idx_nir_diag, & + idx_uv_diag, & + idx_lw_diag, & + get_idx_sw_diag, & ! sets the idx_*_diag in radconstants module + get_idx_nir_diag, & + get_idx_uv_diag, & + get_idx_lw_diag, & + rrtmg_to_rrtmgp_swbands, & ! maps bands between rrtmg and rrtmgp + get_band_index_by_value, & ! function that figures out band for a wavelength + gasnamelength, & + nradgas, & + gaslist + +use mo_gas_concentrations, only: ty_gas_concs +use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp + +use cam_history, only: addfld, add_default, horiz_only, outfld, hist_fld_active +use cam_history_support, only: fillvalue + +use ioFileMod, only: getfil +use cam_pio_utils, only: cam_pio_openfile +use pio, only: file_desc_t, & + var_desc_t, & + pio_int, & + PIO_NOERR, & + PIO_INTERNAL_ERROR, & + pio_seterrorhandling, & + PIO_BCAST_ERROR, & + pio_inq_dimlen, & + pio_inq_dimid, & + pio_inq_varid, & + pio_def_var, & + pio_put_var, & + pio_get_var, & + pio_put_att, & + PIO_NOWRITE, & + pio_closefile + +use cam_abortutils, only: endrun +use error_messages, only: handle_err +use cam_logfile, only: iulog +use scamMod, only: scm_crm_mode, single_column, have_cld, cldobs + +use cospsimulator_intr, only: docosp, cospsimulator_intr_init, & + cospsimulator_intr_run, cosp_nradsteps + + +implicit none +private +save + +public :: & + radiation_readnl, &! read namelist variables + radiation_register, &! registers radiation physics buffer fields + radiation_nextsw_cday, &! calendar day of next radiation calculation + radiation_do, &! query which radiation calcs are done this timestep + radiation_init, &! initialization + radiation_define_restart, &! define variables for restart + radiation_write_restart, &! write variables to restart + radiation_read_restart, &! read variables from restart + radiation_tend, &! compute heating rates and fluxes + rad_out_t ! type for diagnostic outputs + +integer,public, allocatable :: cosp_cnt(:) ! counter for cosp +integer,public :: cosp_cnt_init = 0 !initial value for cosp counter +integer, public :: sw_cloudsim_band, lw_cloudsim_band ! radiation bands that COSP uses + +real(r8), public, protected :: nextsw_cday ! future radiation calday for surface models + +type rad_out_t + real(r8) :: solin(pcols) ! Solar incident flux + + real(r8) :: qrsc(pcols,pver) + + real(r8) :: flux_sw_net_top(pcols) ! net shortwave flux at top (FSNT) + + real(r8) :: fsnsc(pcols) ! Clear sky surface abs solar flux + real(r8) :: fsntc(pcols) ! Clear sky total column abs solar flux + real(r8) :: fsdsc(pcols) ! Clear sky surface downwelling solar flux + + real(r8) :: fsntoa(pcols) ! Net solar flux at TOA + real(r8) :: fsntoac(pcols) ! Clear sky net solar flux at TOA + real(r8) :: fsutoa(pcols) ! upwelling solar flux at TOA + + real(r8) :: fsnirt(pcols) ! Near-IR flux absorbed at toa + real(r8) :: fsnrtc(pcols) ! Clear sky near-IR flux absorbed at toa + real(r8) :: fsnirtsq(pcols) ! Near-IR flux absorbed at toa >= 0.7 microns + + real(r8) :: fsn200(pcols) ! fns interpolated to 200 mb + real(r8) :: fsn200c(pcols) ! fcns interpolated to 200 mb + real(r8) :: fsnr(pcols) ! fns interpolated to tropopause + + real(r8) :: flux_sw_up(pcols,pverp) ! upward shortwave flux on interfaces + real(r8) :: flux_sw_clr_up(pcols,pverp) ! upward shortwave clearsky flux + real(r8) :: flux_sw_dn(pcols,pverp) ! downward flux + real(r8) :: flux_sw_clr_dn(pcols,pverp) ! downward clearsky flux + + real(r8) :: flux_lw_up(pcols,pverp) ! upward shortwave flux on interfaces + real(r8) :: flux_lw_clr_up(pcols,pverp) ! upward shortwave clearsky flux + real(r8) :: flux_lw_dn(pcols,pverp) ! downward flux + real(r8) :: flux_lw_clr_dn(pcols,pverp) ! downward clearsky flux + + real(r8) :: qrlc(pcols,pver) + + real(r8) :: flntc(pcols) ! Clear sky lw flux at model top + real(r8) :: flut(pcols) ! Upward flux at top of model + real(r8) :: flutc(pcols) ! Upward Clear Sky flux at top of model + real(r8) :: lwcf(pcols) ! longwave cloud forcing + + real(r8) :: fln200(pcols) ! net longwave flux interpolated to 200 mb + real(r8) :: fln200c(pcols) ! net clearsky longwave flux interpolated to 200 mb + real(r8) :: flnr(pcols) ! net longwave flux interpolated to tropopause + + real(r8) :: flnsc(pcols) ! Clear sky lw flux at srf (up-down) + real(r8) :: fldsc(pcols) ! Clear sky lw flux at srf (down) + + real(r8) :: tot_cld_vistau(pcols,pver) ! gbx water+ice cloud optical depth (only during day, night = fillvalue) + real(r8) :: tot_icld_vistau(pcols,pver) ! in-cld water+ice cloud optical depth (only during day, night = fillvalue) + real(r8) :: liq_icld_vistau(pcols,pver) ! in-cld liq cloud optical depth (only during day, night = fillvalue) + real(r8) :: ice_icld_vistau(pcols,pver) ! in-cld ice cloud optical depth (only during day, night = fillvalue) + real(r8) :: snow_icld_vistau(pcols,pver) ! snow in-cloud visible sw optical depth for output on history files + real(r8) :: grau_icld_vistau(pcols,pver) ! Graupel in-cloud visible sw optical depth for output on history files +end type rad_out_t + +! Control variables set via namelist +character(len=cl) :: coefs_lw_file ! filepath for lw coefficients +character(len=cl) :: coefs_sw_file ! filepath for sw coefficients + +integer :: iradsw = -1 ! freq. of shortwave radiation calc in time steps (positive) + ! or hours (negative). +integer :: iradlw = -1 ! frequency of longwave rad. calc. in time steps (positive) + ! or hours (negative). + +integer :: irad_always = 0 ! Specifies length of time in timesteps (positive) + ! or hours (negative) SW/LW radiation will be + ! run continuously from the start of an + ! initial or restart run +logical :: use_rad_dt_cosz = .false. ! if true, use radiation dt for all cosz calculations +logical :: spectralflux = .false. ! calculate fluxes (up and down) per band. +logical :: graupel_in_rad = .false. ! graupel in radiation code +logical :: use_rad_uniform_angle = .false. ! if true, use the namelist rad_uniform_angle for the coszrs calculation + +! Physics buffer indices +integer :: qrs_idx = 0 +integer :: qrl_idx = 0 +integer :: su_idx = 0 +integer :: sd_idx = 0 +integer :: lu_idx = 0 +integer :: ld_idx = 0 +integer :: fsds_idx = 0 +integer :: fsns_idx = 0 +integer :: fsnt_idx = 0 +integer :: flns_idx = 0 +integer :: flnt_idx = 0 +integer :: cldfsnow_idx = 0 +integer :: cld_idx = 0 +integer :: cldfgrau_idx = 0 + +character(len=4) :: diag(0:N_DIAG) =(/' ','_d1 ','_d2 ','_d3 ','_d4 ','_d5 ','_d6 ','_d7 ','_d8 ','_d9 ','_d10'/) + +! averaging time interval for zenith angle +real(r8) :: dt_avg = 0._r8 +real(r8) :: rad_uniform_angle = -99._r8 + +! Number of layers in radiation calculations. +integer :: nlay + +! Indices for copying data between cam and rrtmgp arrays +! The code currently assumes the rrtmgp vertical index goes bottom to top, +! while CAM goes top-to-bottom ... +! Newer RRTMGP checks for host model order and adjusts, so a lot of the assumptions are unncessary. +integer :: ktopcamm ! cam index of top layer +integer :: ktopradm ! rrtmgp index of layer corresponding to ktopcamm +integer :: ktopcami ! cam index of top interface +integer :: ktopradi ! rrtmgp index of interface corresponding to ktopcami + +! LW coefficients +type(ty_gas_optics_rrtmgp) :: kdist_lw ! bpm changed here +integer :: ngpt_lw + +! SW coefficients +type(ty_gas_optics_rrtmgp) :: kdist_sw ! bpm changed here +integer :: ngpt_sw + +! data to go from bands to gpoints (bpm) +integer, allocatable :: band2gpt_sw(:,:) ! n[s,l]wbands come from radconstants for now +integer, allocatable :: band2gpt_lw(:,:) + + +! Gases to use in the radiative calculations. +! RRTMGP kdist initialization needs to know the names of the +! gases before these are available via the rad_cnst interface. +! TODO: Move this to namelist or somewhere appropriate. +! NOTE: This list is not the same as `gaslist` in radconstants; is that a problem? Implication for diagnostic calls? +! character(len=5), dimension(10) :: active_gases = (/ & +! 'H2O ', 'CO2 ', 'O3 ', 'N2O ', & +! 'CO ', 'CH4 ', 'O2 ', 'N2 ', & +! 'CFC11', 'CFC12' /) +! BPM: use radconstants to define the active gases: +character(len=gasnamelength), dimension(nradgas) :: active_gases = gaslist + +type(var_desc_t) :: cospcnt_desc ! cosp +type(var_desc_t) :: nextsw_cday_desc + +!=============================================================================== +contains +!=============================================================================== + + +subroutine radiation_readnl(nlfile) + + ! Read radiation_nl namelist group. + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use spmd_utils, only: mpicom, mstrid=>masterprocid, mpi_integer, mpi_logical, & + mpi_character + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + integer :: dtime ! timestep size + character(len=*), parameter :: subroutine_name = 'radiation_readnl' + + character(len=cl) :: rrtmgp_coefs_lw_file, rrtmgp_coefs_sw_file + + + namelist /radiation_nl/ rrtmgp_coefs_lw_file, & + rrtmgp_coefs_sw_file, & + iradsw, & + iradlw, & + irad_always, & + use_rad_dt_cosz, & + spectralflux, & + use_rad_uniform_angle, & + rad_uniform_angle, & + graupel_in_rad + !----------------------------------------------------------------------------- + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'radiation_nl', status=ierr) + if (ierr == 0) then + read(unitn, radiation_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subroutine_name // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + + ! Broadcast namelist variables + call mpi_bcast(rrtmgp_coefs_lw_file, cl, mpi_character, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(subroutine_name//": FATAL: mpi_bcast: rrtmgp_coefs_lw_file") + call mpi_bcast(rrtmgp_coefs_sw_file, cl, mpi_character, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(subroutine_name//": FATAL: mpi_bcast: coefs_sw_file") + call mpi_bcast(iradsw, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(subroutine_name//": FATAL: mpi_bcast: iradsw") + call mpi_bcast(iradlw, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(subroutine_name//": FATAL: mpi_bcast: iradlw") + call mpi_bcast(irad_always, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(subroutine_name//": FATAL: mpi_bcast: irad_always") + call mpi_bcast(use_rad_dt_cosz, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(subroutine_name//": FATAL: mpi_bcast: use_rad_dt_cosz") + call mpi_bcast(spectralflux, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(subroutine_name//": FATAL: mpi_bcast: spectralflux") + call mpi_bcast(use_rad_uniform_angle, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(subroutine_name//": FATAL: mpi_bcast: use_rad_uniform_angle") + call mpi_bcast(rad_uniform_angle, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(subroutine_name//": FATAL: mpi_bcast: rad_uniform_angle") + call mpi_bcast(graupel_in_rad, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(subroutine_name//": FATAL: mpi_bcast: graupel_in_rad") + + if (use_rad_uniform_angle .and. rad_uniform_angle == -99._r8) then + call endrun(subroutine_name // ' ERROR - use_rad_uniform_angle is set to .true, but rad_uniform_angle is not set ') + end if + + + ! Set module data + coefs_lw_file = rrtmgp_coefs_lw_file + coefs_sw_file = rrtmgp_coefs_sw_file + + ! Convert iradsw, iradlw and irad_always from hours to timesteps if necessary + dtime = get_step_size() + if (iradsw < 0) iradsw = nint((-iradsw *3600._r8)/dtime) + if (iradlw < 0) iradlw = nint((-iradlw *3600._r8)/dtime) + if (irad_always < 0) irad_always = nint((-irad_always*3600._r8)/dtime) + + !----------------------------------------------------------------------- + ! Print runtime options to log. + !----------------------------------------------------------------------- + + if (masterproc) then + write(iulog,*) 'RRTMGP radiation scheme parameters:' + write(iulog,10) trim(coefs_lw_file), trim(coefs_sw_file), iradsw, iradlw, & + irad_always, use_rad_dt_cosz, spectralflux, graupel_in_rad + end if + +10 format(' LW coefficents file: ', a/, & + ' SW coefficents file: ', a/, & + ' Frequency (timesteps) of Shortwave Radiation calc: ',i5/, & + ' Frequency (timesteps) of Longwave Radiation calc: ',i5/, & + ' SW/LW calc done every timestep for first N steps. N=',i5/, & + ' Use average zenith angle: ',l5/, & + ' Output spectrally resolved fluxes: ',l5/, & + ' Graupel in Radiation Code: ',l5/) + +end subroutine radiation_readnl + +!================================================================================================ + +subroutine radiation_register + + ! Register radiation fields in the physics buffer + + use physics_buffer, only: pbuf_add_field, dtype_r8 + use radiation_data, only: rad_data_register + + call pbuf_add_field('QRS' , 'global',dtype_r8,(/pcols,pver/), qrs_idx) ! shortwave radiative heating rate + call pbuf_add_field('QRL' , 'global',dtype_r8,(/pcols,pver/), qrl_idx) ! longwave radiative heating rate + + call pbuf_add_field('FSDS' , 'global',dtype_r8,(/pcols/), fsds_idx) ! Surface solar downward flux + call pbuf_add_field('FSNS' , 'global',dtype_r8,(/pcols/), fsns_idx) ! Surface net shortwave flux + call pbuf_add_field('FSNT' , 'global',dtype_r8,(/pcols/), fsnt_idx) ! Top-of-model net shortwave flux + + call pbuf_add_field('FLNS' , 'global',dtype_r8,(/pcols/), flns_idx) ! Surface net longwave flux + call pbuf_add_field('FLNT' , 'global',dtype_r8,(/pcols/), flnt_idx) ! Top-of-model net longwave flux + + ! If the namelist has been configured for preserving the spectral fluxes, then create + ! physics buffer variables to store the results. + if (spectralflux) then + call pbuf_add_field('SU' , 'global',dtype_r8,(/pcols,pverp,nswbands/), su_idx) ! shortwave upward flux (per band) + call pbuf_add_field('SD' , 'global',dtype_r8,(/pcols,pverp,nswbands/), sd_idx) ! shortwave downward flux (per band) + call pbuf_add_field('LU' , 'global',dtype_r8,(/pcols,pverp,nlwbands/), lu_idx) ! longwave upward flux (per band) + call pbuf_add_field('LD' , 'global',dtype_r8,(/pcols,pverp,nlwbands/), ld_idx) ! longwave downward flux (per band) + end if + + call rad_data_register() ! if "fixed dynamical heating", this adds 4 fields to physics buffer (needed?) + +end subroutine radiation_register + +!================================================================================================ + +function radiation_do(op, timestep) + + ! Return true if the specified operation is done this timestep. + + character(len=*), intent(in) :: op ! name of operation + integer, intent(in), optional:: timestep + logical :: radiation_do ! return value + + ! Local variables + integer :: nstep ! current timestep number + !----------------------------------------------------------------------- + + if (present(timestep)) then + nstep = timestep + else + nstep = get_nstep() + end if + + select case (op) + case ('sw') ! do a shortwave heating calc this timestep? + radiation_do = nstep == 0 .or. iradsw == 1 & + .or. (mod(nstep-1,iradsw) == 0 .and. nstep /= 1) & + .or. nstep <= irad_always + case ('lw') ! do a longwave heating calc this timestep? + radiation_do = nstep == 0 .or. iradlw == 1 & + .or. (mod(nstep-1,iradlw) == 0 .and. nstep /= 1) & + .or. nstep <= irad_always + case default + call endrun('radiation_do: unknown operation:'//op) + end select +end function radiation_do + +!================================================================================================ + +real(r8) function radiation_nextsw_cday() + + ! Return calendar day of next sw radiation calculation + + ! Local variables + integer :: nstep ! timestep counter + logical :: dosw ! true => do shosrtwave calc + integer :: offset ! offset for calendar day calculation + integer :: dtime ! integer timestep size + real(r8):: calday ! calendar day of + real(r8):: caldayp1 ! calendar day of next time-step + + !----------------------------------------------------------------------- + + radiation_nextsw_cday = -1._r8 + dosw = .false. + nstep = get_nstep() + dtime = get_step_size() + offset = 0 + do while (.not. dosw) + nstep = nstep + 1 + offset = offset + dtime + if (radiation_do('sw', nstep)) then + radiation_nextsw_cday = get_curr_calday(offset=offset) + dosw = .true. + end if + end do + if(radiation_nextsw_cday == -1._r8) then + call endrun('error in radiation_nextsw_cday') + end if + + ! determine if next radiation time-step not equal to next time-step + if (get_nstep() >= 1) then + caldayp1 = get_curr_calday(offset=int(dtime)) + if (caldayp1 /= radiation_nextsw_cday) radiation_nextsw_cday = -1._r8 + end if + +end function radiation_nextsw_cday + +!================================================================================================ + +subroutine radiation_init(pbuf2d) + + ! Initialize the radiation, cloud, and aerosol optics, and solar variability + ! parameterizations. + ! Add fields to the history buffer. + + use physics_buffer, only: pbuf_get_index, pbuf_set_field + use phys_control, only: phys_getopts + use rad_solar_var, only: rad_solar_var_init ! This initializes total solar irradiance + use radiation_data, only: rad_data_init + use cloud_rad_props, only: cloud_rad_props_init + use modal_aer_opt, only: modal_aer_opt_init + use rrtmgp_inputs, only: rrtmgp_inputs_init + use time_manager, only: is_first_step + use radconstants, only: set_number_sw_bands, set_number_lw_bands, set_wavenumber_bands, set_irrad_by_band, set_reference_tsi + + ! arguments + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + ! local variables + character(len=128) :: errmsg + + ! names of gases that are available in the model + ! -- needed for the kdist initialization routines + type(ty_gas_concs) :: available_gases + + integer :: icall, nmodes + logical :: active_calls(0:N_DIAG) + integer :: nstep ! current timestep number + logical :: history_amwg ! output the variables used by the AMWG diag package + logical :: history_vdiag ! output the variables used by the AMWG variability diag package + logical :: history_budget ! output tendencies and state variables for CAM4 + ! temperature, water vapor, cloud ice and cloud + ! liquid budgets. + integer :: history_budget_histfile_num ! output history file number for budget fields + integer :: ierr + + integer :: dtime + real(r8) :: ref_tsi + + character(len=*), parameter :: sub = 'radiation_init' + !----------------------------------------------------------------------- + + ! + ! replacement of RRTMG's rrtmg_state_init + ! + + ! Number of layers in radiation calculation is capped by the number of + ! pressure interfaces below 1 Pa. When the entire model atmosphere is + ! below 1 Pa then an extra layer is added to the top of the model for + ! the purpose of the radiation calculation. + nlay = count( pref_edge(:) > 1._r8 ) ! pascals (0.01 mbar) + + ! Use k*rad* to access variables ON THE RADIATION GRID + ! Use k*cam* to access variables ON THE CAM GRID + if (nlay == pverp) then + ktopcamm = 1 ! interpretation: highest CAM grid layer at which radiation is active + ktopcami = 1 + ktopradm = nlay + 1 - pver ! radiation grid layer the corresponds to CAM's highest layer (expected to be 2) + ktopradi = nlay + 1 - pver + else ! nlay < pverp + ! nlay layers are set by radiation + ! nlay+1 interfaces are set by radiation + ktopcamm = pverp - nlay + 1 + ktopcami = pverp - nlay + 1 + ktopradm = 1 ! radiation grid index at top is just 1 + ktopradi = 1 + end if + ! bottom indices are known, so we don't need to have extra variables. + ! kbotcamm = pver + ! kbotcami = pverp + ! kbotradm = nlay + ! kbotradi = nlay + 1 + + call set_available_gases(active_gases, available_gases) ! gases needed to initialize spectral info + + call coefs_init(coefs_lw_file, kdist_lw, available_gases, band2gpt_lw) + call coefs_init(coefs_sw_file, kdist_sw, available_gases, band2gpt_sw, ref_tsi) ! bpm : these now provide band2gpt which should be global + call set_reference_tsi(ref_tsi) + + ! set number of sw/lw bands in radconstants + call set_number_sw_bands(kdist_sw%get_nband()) + call set_number_lw_bands(kdist_lw%get_nband()) + write(iulog, *) 'rad_init: NUMBER SW BANDS: ',kdist_sw%get_nband(),' NUMBER LW BANDS: ',kdist_lw%get_nband() + + ! set the sw/lw band limits in radconstants + call set_wavenumber_bands('sw', kdist_sw%get_nband(), kdist_sw%get_band_lims_wavenumber()) + call set_wavenumber_bands('lw', kdist_lw%get_nband(), kdist_lw%get_band_lims_wavenumber()) + + call rad_solar_var_init() ! sets the total solar irradiance (I wonder whether this should use kdist information instead of radconstants; alternative use kdist%set_tsi to ensure consistency?) + call rrtmgp_inputs_init(ktopcamm, ktopradm, ktopcami, ktopradi) ! this sets these values as module data in rrtmgp_inputs + + call rad_data_init(pbuf2d) ! initialize output fields for offline driver + call cloud_rad_props_init() + + ngpt_lw = kdist_lw%get_ngpt() ! these set global values + ngpt_sw = kdist_sw%get_ngpt() + + ! bpm: set the indices used for diagnostics using specific band: + call get_idx_sw_diag() ! index to sw visible band (441 - 625 nm) + call get_idx_nir_diag() ! index to sw near infrared (778-1240 nm) band + call get_idx_uv_diag() ! index to sw uv (345-441 nm) band + if (docosp) then + sw_cloudsim_band = get_band_index_by_value('sw', 0.67_r8, 'micron') ! rrtmgp band for .67 micron + lw_cloudsim_band = get_band_index_by_value('lw', 10.5_r8, 'micron') + end if + call get_idx_lw_diag() + + + if (is_first_step()) then + call pbuf_set_field(pbuf2d, qrl_idx, 0._r8) + end if + + + ! Set the radiation timestep for cosz calculations if requested using + ! the adjusted iradsw value from radiation + if (use_rad_dt_cosz) then + dtime = get_step_size() + dt_avg = iradsw*dtime + end if + + ! Surface components to get radiation computed today + if (.not. is_first_restart_step()) then + nextsw_cday = get_curr_calday() + end if + + call phys_getopts(history_amwg_out = history_amwg, & + history_vdiag_out = history_vdiag, & + history_budget_out = history_budget, & + history_budget_histfile_num_out = history_budget_histfile_num) + + ! Determine whether modal aerosols are affecting the climate, and if so + ! then initialize the modal aerosol optics module + call rad_cnst_get_info(0, nmodes=nmodes) + if (nmodes > 0) then + call modal_aer_opt_init() + end if + + ! "irad_always" is number of time steps to execute radiation + ! continuously from start of initial OR restart run + ! _This gets used in radiation_do_ + nstep = get_nstep() + if (irad_always > 0) then + nstep = get_nstep() + irad_always = irad_always + nstep + end if + + if (docosp) call cospsimulator_intr_init + allocate(cosp_cnt(begchunk:endchunk)) + if (is_first_restart_step()) then + cosp_cnt(begchunk:endchunk) = cosp_cnt_init + else + cosp_cnt(begchunk:endchunk) = 0 + end if + + + ! Add fields to history buffer + + call addfld('TOT_CLD_VISTAU', (/ 'lev' /), 'A', '1', & + 'Total gbx cloud extinction visible sw optical depth', & + sampling_seq='rad_lwsw', flag_xyfill=.true.) + call addfld('TOT_ICLD_VISTAU', (/ 'lev' /), 'A', '1', & + 'Total in-cloud extinction visible sw optical depth', & + sampling_seq='rad_lwsw', flag_xyfill=.true.) + call addfld('LIQ_ICLD_VISTAU', (/ 'lev' /), 'A', '1', & + 'Liquid in-cloud extinction visible sw optical depth', & + sampling_seq='rad_lwsw', flag_xyfill=.true.) + call addfld('ICE_ICLD_VISTAU', (/ 'lev' /), 'A', '1', & + 'Ice in-cloud extinction visible sw optical depth', & + sampling_seq='rad_lwsw', flag_xyfill=.true.) + + + ! get list of active radiation calls + call rad_cnst_get_call_list(active_calls) + + ! Add shortwave radiation fields to history master field list. + + do icall = 0, N_DIAG + + if (active_calls(icall)) then + + call addfld('SOLIN'//diag(icall), horiz_only, 'A', 'W/m2', 'Solar insolation', sampling_seq='rad_lwsw') + + call addfld('QRS'//diag(icall), (/ 'lev' /), 'A', 'K/s', 'Solar heating rate', sampling_seq='rad_lwsw') + call addfld('QRSC'//diag(icall), (/ 'lev' /), 'A', 'K/s', 'Clearsky solar heating rate', & + sampling_seq='rad_lwsw') + call addfld('FSNT'//diag(icall), horiz_only, 'A', 'W/m2', 'Net solar flux at top of model', & + sampling_seq='rad_lwsw') + call addfld('FSNTC'//diag(icall), horiz_only, 'A', 'W/m2', 'Clearsky net solar flux at top of model', & + sampling_seq='rad_lwsw') + call addfld('FSNTOA'//diag(icall), horiz_only, 'A', 'W/m2', 'Net solar flux at top of atmosphere', & + sampling_seq='rad_lwsw') + call addfld('FSNTOAC'//diag(icall), horiz_only, 'A', 'W/m2', 'Clearsky net solar flux at top of atmosphere', & + sampling_seq='rad_lwsw') + call addfld('SWCF'//diag(icall), horiz_only, 'A', 'W/m2', 'Shortwave cloud forcing', & + sampling_seq='rad_lwsw') + call addfld('FSUTOA'//diag(icall), horiz_only, 'A', 'W/m2', 'Upwelling solar flux at top of atmosphere', & + sampling_seq='rad_lwsw') + call addfld('FSNIRTOA'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Net near-infrared flux (Nimbus-7 WFOV) at top of atmosphere', sampling_seq='rad_lwsw') + call addfld('FSNRTOAC'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Clearsky net near-infrared flux (Nimbus-7 WFOV) at top of atmosphere', sampling_seq='rad_lwsw') + call addfld('FSNRTOAS'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Net near-infrared flux (>= 0.7 microns) at top of atmosphere', sampling_seq='rad_lwsw') + + call addfld('FSN200'//diag(icall), horiz_only, 'A', 'W/m2', 'Net shortwave flux at 200 mb', & + sampling_seq='rad_lwsw') + call addfld('FSN200C'//diag(icall), horiz_only, 'A', 'W/m2', 'Clearsky net shortwave flux at 200 mb', & + sampling_seq='rad_lwsw') + + call addfld('FSNR'//diag(icall), horiz_only, 'A', 'W/m2', 'Net solar flux at tropopause', & + sampling_seq='rad_lwsw') + + call addfld('SOLL'//diag(icall), horiz_only, 'A', 'W/m2', 'Solar downward near infrared direct to surface', & + sampling_seq='rad_lwsw') + call addfld('SOLS'//diag(icall), horiz_only, 'A', 'W/m2', 'Solar downward visible direct to surface', & + sampling_seq='rad_lwsw') + call addfld('SOLLD'//diag(icall), horiz_only, 'A', 'W/m2', 'Solar downward near infrared diffuse to surface', & + sampling_seq='rad_lwsw') + call addfld('SOLSD'//diag(icall), horiz_only, 'A', 'W/m2', 'Solar downward visible diffuse to surface', & + sampling_seq='rad_lwsw') + call addfld('FSNS'//diag(icall), horiz_only, 'A', 'W/m2', 'Net solar flux at surface', & + sampling_seq='rad_lwsw') + call addfld('FSNSC'//diag(icall), horiz_only, 'A', 'W/m2', 'Clearsky net solar flux at surface', & + sampling_seq='rad_lwsw') + + call addfld('FSDS'//diag(icall), horiz_only, 'A', 'W/m2', 'Downwelling solar flux at surface', & + sampling_seq='rad_lwsw') + call addfld('FSDSC'//diag(icall), horiz_only, 'A', 'W/m2', 'Clearsky downwelling solar flux at surface', & + sampling_seq='rad_lwsw') + + call addfld('FUS'//diag(icall), (/ 'ilev' /), 'I', 'W/m2', 'Shortwave upward flux') + call addfld('FDS'//diag(icall), (/ 'ilev' /), 'I', 'W/m2', 'Shortwave downward flux') + call addfld('FUSC'//diag(icall), (/ 'ilev' /), 'I', 'W/m2', 'Shortwave clear-sky upward flux') + call addfld('FDSC'//diag(icall), (/ 'ilev' /), 'I', 'W/m2', 'Shortwave clear-sky downward flux') + + if (history_amwg) then + call add_default('SOLIN'//diag(icall), 1, ' ') + call add_default('QRS'//diag(icall), 1, ' ') + call add_default('FSNT'//diag(icall), 1, ' ') + call add_default('FSNTC'//diag(icall), 1, ' ') + call add_default('FSNTOA'//diag(icall), 1, ' ') + call add_default('FSNTOAC'//diag(icall), 1, ' ') + call add_default('SWCF'//diag(icall), 1, ' ') + call add_default('FSNS'//diag(icall), 1, ' ') + call add_default('FSNSC'//diag(icall), 1, ' ') + call add_default('FSUTOA'//diag(icall), 1, ' ') + call add_default('FSDSC'//diag(icall), 1, ' ') + call add_default('FSDS'//diag(icall), 1, ' ') + endif + + end if + end do + + ! Add longwave radiation fields to history master field list. + + do icall = 0, N_DIAG + + if (active_calls(icall)) then + call addfld('QRL'//diag(icall), (/ 'lev' /), 'A', 'K/s', & + 'Longwave heating rate', sampling_seq='rad_lwsw') + call addfld('QRLC'//diag(icall), (/ 'lev' /), 'A', 'K/s', & + 'Clearsky longwave heating rate', sampling_seq='rad_lwsw') + call addfld('FLNT'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Net longwave flux at top of model', sampling_seq='rad_lwsw') + call addfld('FLNTC'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Clearsky net longwave flux at top of model', sampling_seq='rad_lwsw') + call addfld('FLUT'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Upwelling longwave flux at top of model', sampling_seq='rad_lwsw') + call addfld('FLUTC'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Clearsky upwelling longwave flux at top of model', sampling_seq='rad_lwsw') + call addfld('LWCF'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Longwave cloud forcing', sampling_seq='rad_lwsw') + call addfld('FLN200'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Net longwave flux at 200 mb', sampling_seq='rad_lwsw') + call addfld('FLN200C'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Clearsky net longwave flux at 200 mb', sampling_seq='rad_lwsw') + call addfld('FLNR'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Net longwave flux at tropopause', sampling_seq='rad_lwsw') + call addfld('FLNS'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Net longwave flux at surface', sampling_seq='rad_lwsw') + call addfld('FLNSC'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Clearsky net longwave flux at surface', sampling_seq='rad_lwsw') + call addfld('FLDS'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Downwelling longwave flux at surface', sampling_seq='rad_lwsw') + call addfld('FLDSC'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Clearsky Downwelling longwave flux at surface', sampling_seq='rad_lwsw') + call addfld('FUL'//diag(icall), (/ 'ilev' /), 'I', 'W/m2', 'Longwave upward flux') + call addfld('FDL'//diag(icall), (/ 'ilev' /), 'I', 'W/m2', 'Longwave downward flux') + call addfld('FULC'//diag(icall), (/ 'ilev' /), 'I', 'W/m2', 'Longwave clear-sky upward flux') + call addfld('FDLC'//diag(icall), (/ 'ilev' /), 'I', 'W/m2', 'Longwave clear-sky downward flux') + + if (history_amwg) then + call add_default('QRL'//diag(icall), 1, ' ') + call add_default('FLNT'//diag(icall), 1, ' ') + call add_default('FLNTC'//diag(icall), 1, ' ') + call add_default('FLUT'//diag(icall), 1, ' ') + call add_default('FLUTC'//diag(icall), 1, ' ') + call add_default('LWCF'//diag(icall), 1, ' ') + call add_default('FLNS'//diag(icall), 1, ' ') + call add_default('FLNSC'//diag(icall), 1, ' ') + call add_default('FLDS'//diag(icall), 1, ' ') + end if + + end if + end do + + call addfld('EMIS', (/ 'lev' /), 'A', '1', 'Cloud longwave emissivity') ! COSP-related output + + ! NOTE: HIRS/MSU diagnostic brightness temperatures are removed. + + ! Heating rate needed for d(theta)/dt computation + call addfld ('HR',(/ 'lev' /), 'A','K/s','Heating rate needed for d(theta)/dt computation') + + if ( history_budget .and. history_budget_histfile_num > 1 ) then + call add_default ('QRL ', history_budget_histfile_num, ' ') + call add_default ('QRS ', history_budget_histfile_num, ' ') + end if + + if (history_vdiag) then + call add_default('FLUT', 2, ' ') + call add_default('FLUT', 3, ' ') + end if + + cld_idx = pbuf_get_index('CLD') + cldfsnow_idx = pbuf_get_index('CLDFSNOW',errcode=ierr) + cldfgrau_idx = pbuf_get_index('CLDFGRAU',errcode=ierr) + if (cldfsnow_idx > 0) then + call addfld('SNOW_ICLD_VISTAU', (/ 'lev' /), 'A', '1', & + 'Snow in-cloud extinction visible sw optical depth', & + sampling_seq='rad_lwsw', flag_xyfill=.true.) + end if + if (cldfgrau_idx > 0 .and. graupel_in_rad) then + call addfld('GRAU_ICLD_VISTAU', (/ 'lev' /), 'A', '1', & + 'Graupel in-cloud extinction visible sw optical depth', & + sampling_seq='rad_lwsw', flag_xyfill=.true.) + endif + +end subroutine radiation_init + +!=============================================================================== + +subroutine radiation_define_restart(file) + + ! define variables to be written to restart file + + ! arguments + type(file_desc_t), intent(inout) :: file + + ! local variables + integer :: ierr + !---------------------------------------------------------------------------- + + call pio_seterrorhandling(file, PIO_BCAST_ERROR) + + ierr = pio_def_var(file, 'nextsw_cday', pio_int, nextsw_cday_desc) + ierr = pio_put_att(file, nextsw_cday_desc, 'long_name', 'future radiation calday for surface models') + if (docosp) then + ierr = pio_def_var(File, 'cosp_cnt_init', pio_int, cospcnt_desc) + end if + +end subroutine radiation_define_restart + +!=============================================================================== + +subroutine radiation_write_restart(file) + + ! write variables to restart file + + ! arguments + type(file_desc_t), intent(inout) :: file + + ! local variables + integer :: ierr + !---------------------------------------------------------------------------- + ierr = pio_put_var(File, nextsw_cday_desc, (/ nextsw_cday /)) + if (docosp) then + ierr = pio_put_var(File, cospcnt_desc, (/cosp_cnt(begchunk)/)) + end if + +end subroutine radiation_write_restart + +!=============================================================================== + +subroutine radiation_read_restart(file) + + ! read variables from restart file + + ! arguments + type(file_desc_t), intent(inout) :: file + + ! local variables + integer :: ierr + type(var_desc_t) :: vardesc + integer :: err_handling + + !---------------------------------------------------------------------------- + if (docosp) then + call pio_seterrorhandling(File, PIO_BCAST_ERROR, err_handling) + ierr = pio_inq_varid(File, 'cosp_cnt_init', vardesc) + call pio_seterrorhandling(File, err_handling) + if (ierr /= PIO_NOERR) then + cosp_cnt_init = 0 + else + ierr = pio_get_var(File, vardesc, cosp_cnt_init) + end if + end if + + ierr = pio_inq_varid(file, 'nextsw_cday', vardesc) + ierr = pio_get_var(file, vardesc, nextsw_cday) + + +end subroutine radiation_read_restart + +!=============================================================================== + +subroutine radiation_tend( & + state, ptend, pbuf, cam_out, cam_in, net_flx, rd_out) + + !----------------------------------------------------------------------- + ! + ! Driver for radiation computation. + ! + !----------------------------------------------------------------------- + + ! Location/Orbital Parameters for cosine zenith angle + use phys_grid, only: get_rlat_all_p, get_rlon_all_p + use cam_control_mod, only: eccen, mvelpp, lambm0, obliqr + use shr_orb_mod, only: shr_orb_decl, shr_orb_cosz + + use mo_gas_concentrations, only: ty_gas_concs + use rrtmgp_inputs, only: rrtmgp_set_state, rrtmgp_set_gases_lw, rrtmgp_set_cloud_lw, & + rrtmgp_set_aer_lw, rrtmgp_set_gases_sw, rrtmgp_set_cloud_sw, & + rrtmgp_set_aer_sw + + use aer_rad_props, only: aer_rad_props_sw, aer_rad_props_lw + + use cloud_rad_props, only: get_ice_optics_sw, ice_cloud_get_rad_props_lw, & + get_liquid_optics_sw, liquid_cloud_get_rad_props_lw, & + get_snow_optics_sw, snow_cloud_get_rad_props_lw, & + cloud_rad_props_get_lw, & + grau_cloud_get_rad_props_lw, & + get_grau_optics_sw + + use slingo, only: slingo_liq_get_rad_props_lw, slingo_liq_optics_sw + use ebert_curry, only: ec_ice_optics_sw, ec_ice_get_rad_props_lw + + use mo_optical_props, only: ty_optical_props, ty_optical_props_2str, ty_optical_props_1scl + + use mo_fluxes_byband, only: ty_fluxes_byband + + ! use mo_rrtmgp_clr_all_sky, only: rte_lw, rte_sw + use rrtmgp_driver, only: rte_lw, rte_sw + + use radheat, only: radheat_tend + + use radiation_data, only: rad_data_write + + use interpolate_data, only: vertinterp + use tropopause, only: tropopause_find, TROP_ALG_HYBSTOB, TROP_ALG_CLIMATE + use cospsimulator_intr, only: docosp, cospsimulator_intr_run, cosp_nradsteps + + + ! Arguments + type(physics_state), intent(in), target :: state + type(physics_ptend), intent(out) :: ptend + type(physics_buffer_desc), pointer :: pbuf(:) + type(cam_out_t), intent(inout) :: cam_out + type(cam_in_t), intent(in) :: cam_in + real(r8), intent(out) :: net_flx(pcols) + + type(rad_out_t), target, optional, intent(out) :: rd_out + + + ! Local variables + type(rad_out_t), pointer :: rd ! allow rd_out to be optional by allocating a local object + ! if the argument is not present + logical :: write_output + + integer :: i, k + integer :: lchnk, ncol + logical :: dosw, dolw + + real(r8) :: calday ! current calendar day + real(r8) :: delta ! Solar declination angle in radians + real(r8) :: eccf ! Earth orbit eccentricity factor + real(r8) :: clat(pcols) ! current latitudes(radians) + real(r8) :: clon(pcols) ! current longitudes(radians) + real(r8) :: coszrs(pcols) ! Cosine solar zenith angle + + ! Gathered indices of day and night columns + ! chunk_column_index = IdxDay(daylight_column_index) + integer :: Nday ! Number of daylight columns + integer :: Nnite ! Number of night columns + integer :: IdxDay(pcols) ! Indices of daylight columns -- Dimension is pcols, and is filled from beginning, so idxday(1:nday) are the indices of daylit columns. + integer :: IdxNite(pcols) ! Indices of night columns + + integer :: itim_old + + real(r8), pointer :: cld(:,:) ! cloud fraction + real(r8), pointer :: cldfsnow(:,:) ! cloud fraction of just "snow clouds"- whatever they are + real(r8), pointer :: cldfgrau(:,:) ! cloud fraction of just "graupel clouds"- whatever they are + real(r8), pointer :: qrs(:,:) => null() ! shortwave radiative heating rate + real(r8), pointer :: qrl(:,:) => null() ! longwave radiative heating rate + real(r8), pointer :: fsds(:) ! Surface solar down flux + real(r8), pointer :: fsns(:) ! Surface solar absorbed flux + real(r8), pointer :: fsnt(:) ! Net column abs solar flux at model top + real(r8), pointer :: flns(:) ! Srf longwave cooling (up-down) flux + real(r8), pointer :: flnt(:) ! Net outgoing lw flux at model top + + real(r8), pointer, dimension(:,:,:) :: su => NULL() ! shortwave spectral flux up + real(r8), pointer, dimension(:,:,:) :: sd => NULL() ! shortwave spectral flux down + real(r8), pointer, dimension(:,:,:) :: lu => NULL() ! longwave spectral flux up + real(r8), pointer, dimension(:,:,:) :: ld => NULL() ! longwave spectral flux down + + ! tropopause diagnostic + integer :: troplev(pcols) + real(r8) :: p_trop(pcols) + + ! state data passed to radiation calc + real(r8), allocatable :: t_sfc(:) + real(r8), allocatable :: emis_sfc(:,:) + real(r8), allocatable :: t_rad(:,:) + real(r8), allocatable :: pmid_rad(:,:) + real(r8), allocatable :: pint_rad(:,:) + real(r8), allocatable :: t_day(:,:) + real(r8), allocatable :: pmid_day(:,:) + real(r8), allocatable :: pint_day(:,:) + real(r8), allocatable :: coszrs_day(:) + real(r8), allocatable :: alb_dir(:,:) + real(r8), allocatable :: alb_dif(:,:) + real(r8) :: tsi + + + ! cloud radiative parameters are "in cloud" not "in cell" + real(r8) :: ice_tau (nswbands,pcols,pver) ! ice extinction optical depth + real(r8) :: ice_tau_w (nswbands,pcols,pver) ! ice single scattering albedo * tau + real(r8) :: ice_tau_w_g(nswbands,pcols,pver) ! ice assymetry parameter * tau * w + real(r8) :: ice_tau_w_f(nswbands,pcols,pver) ! ice forward scattered fraction * tau * w + real(r8) :: ice_lw_abs (nlwbands,pcols,pver) ! ice absorption optics depth (LW) + + ! cloud radiative parameters are "in cloud" not "in cell" + real(r8) :: liq_tau (nswbands,pcols,pver) ! liquid extinction optical depth + real(r8) :: liq_tau_w (nswbands,pcols,pver) ! liquid single scattering albedo * tau + real(r8) :: liq_tau_w_g(nswbands,pcols,pver) ! liquid assymetry parameter * tau * w + real(r8) :: liq_tau_w_f(nswbands,pcols,pver) ! liquid forward scattered fraction * tau * w + real(r8) :: liq_lw_abs (nlwbands,pcols,pver) ! liquid absorption optics depth (LW) + + ! cloud radiative parameters are "in cloud" not "in cell" + real(r8) :: cld_tau (nswbands,pcols,pver) ! cloud extinction optical depth + real(r8) :: cld_tau_w (nswbands,pcols,pver) ! cloud single scattering albedo * tau + real(r8) :: cld_tau_w_g(nswbands,pcols,pver) ! cloud assymetry parameter * w * tau + real(r8) :: cld_tau_w_f(nswbands,pcols,pver) ! cloud forward scattered fraction * w * tau + real(r8) :: cld_lw_abs (nlwbands,pcols,pver) ! cloud absorption optics depth (LW) + + ! "snow" cloud radiative parameters are "in cloud" not "in cell" + real(r8) :: snow_tau (nswbands,pcols,pver) ! snow extinction optical depth + real(r8) :: snow_tau_w (nswbands,pcols,pver) ! snow single scattering albedo * tau + real(r8) :: snow_tau_w_g(nswbands,pcols,pver) ! snow assymetry parameter * tau * w + real(r8) :: snow_tau_w_f(nswbands,pcols,pver) ! snow forward scattered fraction * tau * w + real(r8) :: snow_lw_abs (nlwbands,pcols,pver)! snow absorption optics depth (LW) + + ! Add graupel as another snow species. + ! cloud radiative parameters are "in cloud" not "in cell" + real(r8) :: grau_tau (nswbands,pcols,pver) ! graupel extinction optical depth + real(r8) :: grau_tau_w (nswbands,pcols,pver) ! graupel single scattering albedo * tau + real(r8) :: grau_tau_w_g(nswbands,pcols,pver) ! graupel assymetry parameter * tau * w + real(r8) :: grau_tau_w_f(nswbands,pcols,pver) ! graupel forward scattered fraction * tau * w + real(r8) :: grau_lw_abs (nlwbands,pcols,pver)! graupel absorption optics depth (LW) + + ! combined cloud radiative parameters are "in cloud" not "in cell" + real(r8) :: cldfprime(pcols,pver) ! combined cloud fraction (snow plus regular) + real(r8) :: c_cld_tau (nswbands,pcols,pver) ! combined cloud extinction optical depth + real(r8) :: c_cld_tau_w (nswbands,pcols,pver) ! combined cloud single scattering albedo * tau + real(r8) :: c_cld_tau_w_g(nswbands,pcols,pver) ! combined cloud assymetry parameter * w * tau + real(r8) :: c_cld_tau_w_f(nswbands,pcols,pver) ! combined cloud forward scattered fraction * w * tau + real(r8) :: c_cld_lw_abs (nlwbands,pcols,pver) ! combined cloud absorption optics depth (LW) + + ! Aerosol radiative properties **N.B.** These are zero-indexed to be on RADIATION GRID (assumes "extra layer" is being added?) + real(r8) :: aer_tau (pcols,0:pver,nswbands) ! aerosol extinction optical depth + real(r8) :: aer_tau_w (pcols,0:pver,nswbands) ! aerosol single scattering albedo * tau + real(r8) :: aer_tau_w_g(pcols,0:pver,nswbands) ! aerosol assymetry parameter * w * tau + real(r8) :: aer_tau_w_f(pcols,0:pver,nswbands) ! aerosol forward scattered fraction * w * tau + real(r8) :: aer_lw_abs (pcols,pver,nlwbands) ! aerosol absorption optics depth (LW) + + ! RRTMGP cloud objects (McICA sampling of cloud optical properties) + type(ty_optical_props_1scl) :: cloud_lw + type(ty_optical_props_2str) :: cloud_sw + + ! Irradiance + integer :: icall ! index through climate/diagnostic radiation calls + logical :: active_calls(0:N_DIAG) + + ! gas vmr + type(ty_gas_concs) :: gas_concs_lw + type(ty_gas_concs) :: gas_concs_sw + ! RRTMGP aerosol objects + type(ty_optical_props_1scl) :: aer_lw + type(ty_optical_props_2str) :: aer_sw + + ! Fluxes + ! These are used locally only. SW fluxes are on day columns only. + ! "Output" (i.e. diagnostic) fluxes are provided with rd, fsns, fcns, fnl, fcnl, etc. + ! see set_sw_diags and radiation_output_sw and radiation_output_lw + type(ty_fluxes_byband) :: fsw, fswc + type(ty_fluxes_byband) :: flw, flwc + + real(r8) :: fns(pcols,pverp) ! net shortwave flux + real(r8) :: fcns(pcols,pverp) ! net clear-sky shortwave flux + real(r8) :: fnl(pcols,pverp) ! net longwave flux + real(r8) :: fcnl(pcols,pverp) ! net clear-sky longwave flux + + + real(r8) :: emis(pcols,pver) ! Cloud longwave emissivity ! for COSP + real(r8) :: gb_snow_tau(pcols,pver) ! grid-box mean snow_tau ! for COSP + real(r8) :: gb_snow_lw(pcols,pver) ! grid-box mean LW snow optical depth ! for COSP + + + real(r8) :: ftem(pcols,pver) ! Temporary workspace for outfld variables + + character(len=128) :: errmsg + + character(len=*), parameter :: sub = 'radiation_tend' + + logical :: conserve_energy = .false. ! Flag to carry (QRS,QRL)*dp across time steps. + + integer :: iband + integer :: nlevcam, nlevrad + real(r8) :: mem_hw_end, mem_hw_beg, mem_end, mem_beg, temp + + !-------------------------------------------------------------------------------------- + + lchnk = state%lchnk + ncol = state%ncol + nlevcam = size(state%t,2) ! number of levels in CAM grid + + if (present(rd_out)) then + rd => rd_out + write_output = .false. + else + allocate(rd) + write_output = .true. + end if + + dosw = radiation_do('sw', get_nstep()) ! do shortwave heating calc this timestep? + dolw = radiation_do('lw', get_nstep()) ! do longwave heating calc this timestep? + + ! Cosine solar zenith angle for current time step + calday = get_curr_calday() + call get_rlat_all_p(lchnk, ncol, clat) + call get_rlon_all_p(lchnk, ncol, clon) + + call shr_orb_decl(calday, eccen, mvelpp, lambm0, obliqr, & + delta, eccf) + + if (use_rad_uniform_angle) then + do i = 1, ncol + coszrs(i) = shr_orb_cosz(calday, clat(i), clon(i), delta, dt_avg, uniform_angle=rad_uniform_angle) + end do + else + do i = 1, ncol + coszrs(i) = shr_orb_cosz(calday, clat(i), clon(i), delta, dt_avg) ! if dt_avg /= 0, it triggers using avg coszrs + end do + end if + + ! Gather night/day column indices. + Nday = 0 + Nnite = 0 + do i = 1, ncol + if ( coszrs(i) > 0.0_r8 ) then + Nday = Nday + 1 + IdxDay(Nday) = i + else + Nnite = Nnite + 1 + IdxNite(Nnite) = i + end if + end do + + ! Associate pointers to physics buffer fields + itim_old = pbuf_old_tim_idx() + if (cldfsnow_idx > 0) then + call pbuf_get_field(pbuf, & + cldfsnow_idx, & + cldfsnow, & + start=(/1,1,itim_old/), & + kount=(/pcols,pver,1/) ) + end if + if (cldfgrau_idx > 0 .and. graupel_in_rad) then + call pbuf_get_field(pbuf, cldfgrau_idx, cldfgrau, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + endif + + call pbuf_get_field(pbuf, cld_idx, cld, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + + call pbuf_get_field(pbuf, qrs_idx, qrs) + call pbuf_get_field(pbuf, qrl_idx, qrl) + + call pbuf_get_field(pbuf, fsns_idx, fsns) + call pbuf_get_field(pbuf, fsnt_idx, fsnt) + call pbuf_get_field(pbuf, fsds_idx, fsds) + call pbuf_get_field(pbuf, flns_idx, flns) + call pbuf_get_field(pbuf, flnt_idx, flnt) + + if (spectralflux) then + call pbuf_get_field(pbuf, su_idx, su) + call pbuf_get_field(pbuf, sd_idx, sd) + call pbuf_get_field(pbuf, lu_idx, lu) + call pbuf_get_field(pbuf, ld_idx, ld) + end if + + ! initialize (and reset) all the fluxes // sw fluxes only on nday columns + call initialize_rrtmgp_fluxes(nday, nlay+1, nswbands, fsw, do_direct=.true.) + call initialize_rrtmgp_fluxes(nday, nlay+1, nswbands, fswc, do_direct=.true.) + call initialize_rrtmgp_fluxes(ncol, nlay+1, nlwbands, flw) + call initialize_rrtmgp_fluxes(ncol, nlay+1, nlwbands, flwc) + + ! For CRM, make cloud equal to input observations: + if (scm_crm_mode .and. have_cld) then + do k = 1, pver + cld(:ncol,k)= cldobs(k) + end do + end if + + + ! Find tropopause height if needed for diagnostic output + if (hist_fld_active('FSNR') .or. hist_fld_active('FLNR')) then + call tropopause_find(state, troplev, tropP=p_trop, & + primary=TROP_ALG_HYBSTOB, & + backup=TROP_ALG_CLIMATE) + end if + + ! Get time of next radiation calculation - albedos will need to be + ! calculated by each surface model at this time + nextsw_cday = radiation_nextsw_cday() + + + ! if Nday = 0, then we should not do shortwave, + ! *but* at then end of subroutine, heating rates will still be calculated, + ! and would get whatever is in pbuf for qrl / qrs. + ! To avoid non-daylit columns + ! from having shortwave heating, we should reset here: + if (nday == 0) then + qrs(1:ncol,1:pver) = 0 + rd%qrsc(1:ncol,1:pver) = 0 ! this is what gets turned into QRSC in output (probably not needed here.) + dosw = .false. + end if + + ! On first time step, do we need to initialize the heating rates in pbuf? + ! what about on a restart? + if (get_nstep() == 0) then + qrs = 0._r8 + qrl = 0._r8 + end if + + + if (dosw .or. dolw) then + + allocate( & + t_sfc(ncol), & + emis_sfc(nlwbands,ncol), & + t_rad(ncol,nlay), & + pmid_rad(ncol,nlay), & + pint_rad(ncol,nlay+1), & + t_day(nday,nlay), & + pmid_day(nday,nlay), & + pint_day(nday,nlay+1), & + coszrs_day(nday), & + alb_dir(nswbands,nday), & + alb_dif(nswbands,nday) & + ) + + + call rrtmgp_set_state( & ! Prepares state variables, daylit columns, albedos for RRTMGP + state, & ! input (%t, %pmid, %pint) + cam_in, & ! input (%lwup, %aldir, %asdir, %aldif, %asdif) + ncol, & ! input + nlay, & ! input + nlwbands, & ! input + nswbands, & ! input + ngpt_sw, & ! input + nday, & ! input + idxday, & ! input, [would prefer to truncate as 1:ncol] + coszrs, & ! input + kdist_sw, & ! input (from init) ! removed: eccf, & ! input + band2gpt_sw, & ! input (from init), gpoints by band + t_sfc, & ! output + emis_sfc, & ! output + t_rad, & ! output + pmid_rad, & ! output + pint_rad, & ! output + t_day, & ! output + pmid_day, & ! output + pint_day, & ! output + coszrs_day, & ! output + alb_dir, & ! output + alb_dif, & ! output + tsi & ! output, total solar irradiance (not scaled) + ) + nlevrad = size(t_rad,2) + + !!--> Set TSI used in radiation to the value in the solar forcing file. + !!--> This replaces get_variability() and does same thing. + !!--> The Earth-Sun distance (eccf) provides another scaling, applied later. + errmsg = kdist_sw%set_tsi(tsi) ! scales the TSI but does not change spectral distribution + if (len_trim(errmsg) > 0) then + call endrun(sub//': ERROR: kdist_sw%set_tsi: '//trim(errmsg)) + end if + + ! check bounds for temperature -- These are specified in the coefficients file, + ! and RRTMGP will not operate if outside the specified range. + call clipper(t_day, kdist_lw%get_temp_min(), kdist_lw%get_temp_max()) + call clipper(t_rad, kdist_lw%get_temp_min(), kdist_lw%get_temp_max()) + + ! Modify cloud fraction to account for radiatively active snow and/or graupel + call modified_cloud_fraction(cld, cldfsnow, cldfgrau, cldfsnow_idx, cldfgrau_idx, cldfprime) + + + if (dosw) then + ! + ! "--- SET OPTICAL PROPERTIES & DO SHORTWAVE CALCULATION ---" + ! + if (oldcldoptics) then + call ec_ice_optics_sw(state, pbuf, ice_tau, ice_tau_w, ice_tau_w_g, ice_tau_w_f, oldicewp=.false.) + call slingo_liq_optics_sw(state, pbuf, liq_tau, liq_tau_w, liq_tau_w_g, liq_tau_w_f, oldliqwp=.false.) + else + select case (icecldoptics) + case ('ebertcurry') + call ec_ice_optics_sw(state, pbuf, ice_tau, ice_tau_w, ice_tau_w_g, ice_tau_w_f, oldicewp=.true.) + case ('mitchell') + call get_ice_optics_sw(state, pbuf, ice_tau, ice_tau_w, ice_tau_w_g, ice_tau_w_f) + case default + call endrun('iccldoptics must be one either ebertcurry or mitchell') + end select + + select case (liqcldoptics) + case ('slingo') + call slingo_liq_optics_sw(state, pbuf, liq_tau, liq_tau_w, liq_tau_w_g, liq_tau_w_f, oldliqwp=.true.) + case ('gammadist') + call get_liquid_optics_sw(state, pbuf, liq_tau, liq_tau_w, liq_tau_w_g, liq_tau_w_f) + case default + call endrun('liqcldoptics must be either slingo or gammadist') + end select + end if + + cld_tau(:,:ncol,:) = liq_tau(:,:ncol,:) + ice_tau(:,:ncol,:) + cld_tau_w(:,:ncol,:) = liq_tau_w(:,:ncol,:) + ice_tau_w(:,:ncol,:) + cld_tau_w_g(:,:ncol,:) = liq_tau_w_g(:,:ncol,:) + ice_tau_w_g(:,:ncol,:) + cld_tau_w_f(:,:ncol,:) = liq_tau_w_f(:,:ncol,:) + ice_tau_w_f(:,:ncol,:) + + if (cldfsnow_idx > 0) then + ! add in snow + call get_snow_optics_sw(state, pbuf, snow_tau, snow_tau_w, snow_tau_w_g, snow_tau_w_f) + do i = 1, ncol + do k = 1, pver + if (cldfprime(i,k) > 0.) then + c_cld_tau(:,i,k) = ( cldfsnow(i,k)*snow_tau(:,i,k) & + + cld(i,k)*cld_tau(:,i,k) )/cldfprime(i,k) + + c_cld_tau_w(:,i,k) = ( cldfsnow(i,k)*snow_tau_w(:,i,k) & + + cld(i,k)*cld_tau_w(:,i,k) )/cldfprime(i,k) + + c_cld_tau_w_g(:,i,k) = ( cldfsnow(i,k)*snow_tau_w_g(:,i,k) & + + cld(i,k)*cld_tau_w_g(:,i,k) )/cldfprime(i,k) + + c_cld_tau_w_f(:,i,k) = ( cldfsnow(i,k)*snow_tau_w_f(:,i,k) & + + cld(i,k)*cld_tau_w_f(:,i,k) )/cldfprime(i,k) + else + c_cld_tau(:,i,k) = 0._r8 + c_cld_tau_w(:,i,k) = 0._r8 + c_cld_tau_w_g(:,i,k) = 0._r8 + c_cld_tau_w_f(:,i,k) = 0._r8 + end if + end do + end do + else + c_cld_tau(:,:ncol,:) = cld_tau(:,:ncol,:) + c_cld_tau_w(:,:ncol,:) = cld_tau_w(:,:ncol,:) + c_cld_tau_w_g(:,:ncol,:) = cld_tau_w_g(:,:ncol,:) + c_cld_tau_w_f(:,:ncol,:) = cld_tau_w_f(:,:ncol,:) + end if + + if (cldfgrau_idx > 0 .and. graupel_in_rad) then + ! add in graupel + call get_grau_optics_sw(state, pbuf, grau_tau, grau_tau_w, grau_tau_w_g, grau_tau_w_f) + do i = 1, ncol + do k = 1, pver + + if (cldfprime(i,k) > 0._r8) then + + c_cld_tau(:,i,k) = ( cldfgrau(i,k)*grau_tau(:,i,k) & + + cld(i,k)*c_cld_tau(:,i,k) )/cldfprime(i,k) + + c_cld_tau_w(:,i,k) = ( cldfgrau(i,k)*grau_tau_w(:,i,k) & + + cld(i,k)*c_cld_tau_w(:,i,k) )/cldfprime(i,k) + + c_cld_tau_w_g(:,i,k) = ( cldfgrau(i,k)*grau_tau_w_g(:,i,k) & + + cld(i,k)*c_cld_tau_w_g(:,i,k) )/cldfprime(i,k) + + c_cld_tau_w_f(:,i,k) = ( cldfgrau(i,k)*grau_tau_w_f(:,i,k) & + + cld(i,k)*c_cld_tau_w_f(:,i,k) )/cldfprime(i,k) + else + c_cld_tau(:,i,k) = 0._r8 + c_cld_tau_w(:,i,k) = 0._r8 + c_cld_tau_w_g(:,i,k) = 0._r8 + c_cld_tau_w_f(:,i,k) = 0._r8 + end if + end do + end do + end if + + ! At this point we have cloud optical properties including snow and graupel, + ! but they need to be re-ordered from the old RRTMG spectral bands to RRTMGP's + ! + ! Mapping from old RRTMG sw bands to new band ordering in RRTMGP + ! 1. This should be automated to provide generalization to arbitrary spectral grid. + ! 2. This is used for setting cloud and aerosol optical properties, so probably should be put into a different module. + c_cld_tau(:,1:ncol,1:pver) = c_cld_tau (rrtmg_to_rrtmgp_swbands, 1:ncol, 1:pver) + c_cld_tau_w(:,1:ncol,1:pver) = c_cld_tau_w (rrtmg_to_rrtmgp_swbands, 1:ncol, 1:pver) + c_cld_tau_w_g(:,1:ncol,1:pver) = c_cld_tau_w_g(rrtmg_to_rrtmgp_swbands, 1:ncol, 1:pver) + c_cld_tau_w_f(:,1:ncol,1:pver) = c_cld_tau_w_f(rrtmg_to_rrtmgp_swbands, 1:ncol, 1:pver) + + ! cloud_sw : cloud optical properties. + call initialize_rrtmgp_cloud_optics_sw(nday, nlay, kdist_sw, cloud_sw) + + call rrtmgp_set_cloud_sw( & ! the result cloud_sw is gpoints ("quadrature" points) + nswbands, & ! input + nday, & ! input + nlay, & ! input + idxday(1:ncol), & ! input, [require to truncate to 1 to ncol b/c the array is size pcol] + pmid_day(:,nlay:1:-1), & ! input + cldfprime, & ! input + c_cld_tau, & ! input + c_cld_tau_w, & ! input + c_cld_tau_w_g, & ! input + c_cld_tau_w_f, & ! input + kdist_sw, & ! input + cloud_sw & ! inout, outputs %g, %ssa, %tau + ) + + ! allocate object for aerosol optics + errmsg = aer_sw%alloc_2str(nday, nlay, kdist_sw%get_band_lims_wavenumber(), & + name='shortwave aerosol optics') + if (len_trim(errmsg) > 0) then + call endrun(sub//': ERROR: aer_sw%alloc_2str: '//trim(errmsg)) + end if + + ! + ! SHORTWAVE DIAGNOSTICS & OUTPUT + ! + ! cloud optical depth fields for the visible band + ! This uses idx_sw_diag to get a specific band; + ! is hard-coded in radconstants and is correct for RRTMGP ordering. + rd%tot_icld_vistau(:ncol,:) = c_cld_tau(idx_sw_diag,:ncol,:) ! should be equal to cloud_sw%tau except ordering + rd%liq_icld_vistau(:ncol,:) = liq_tau(idx_sw_diag,:ncol,:) + rd%ice_icld_vistau(:ncol,:) = ice_tau(idx_sw_diag,:ncol,:) + if (cldfsnow_idx > 0) then + rd%snow_icld_vistau(:ncol,:) = snow_tau(idx_sw_diag,:ncol,:) + endif + if (cldfgrau_idx > 0 .and. graupel_in_rad) then + rd%grau_icld_vistau(:ncol,:) = grau_tau(idx_sw_diag,:ncol,:) + endif + + ! multiply by total cloud fraction to get gridbox value + rd%tot_cld_vistau(:ncol,:) = c_cld_tau(idx_sw_diag,:ncol,:)*cldfprime(:ncol,:) + + ! add fillvalue for night columns + do i = 1, Nnite + rd%tot_cld_vistau(IdxNite(i),:) = fillvalue + rd%tot_icld_vistau(IdxNite(i),:) = fillvalue + rd%liq_icld_vistau(IdxNite(i),:) = fillvalue + rd%ice_icld_vistau(IdxNite(i),:) = fillvalue + if (cldfsnow_idx > 0) then + rd%snow_icld_vistau(IdxNite(i),:) = fillvalue + end if + if (cldfgrau_idx > 0 .and. graupel_in_rad) then + rd%grau_icld_vistau(IdxNite(i),:) = fillvalue + end if + end do + + if (write_output) then + call radiation_output_cld(lchnk, ncol, rd) + end if + ! + ! SHORTWAVE CALCULATION(S) + ! + ! Get the active climate/diagnostic shortwave calculations + call rad_cnst_get_call_list(active_calls) + + ! The climate (icall==0) calculation must occur last. + do icall = N_DIAG, 0, -1 + if (active_calls(icall)) then + call set_available_gases(active_gases, gas_concs_sw) ! set gas concentrations + + call rrtmgp_set_gases_sw( & ! Put gas volume mixing ratio into gas_concs_sw + icall, & ! input + state, & ! input ; note: state/pbuf are top-to-bottom + pbuf, & ! input + nlay, & ! input + nday, & ! input + idxday, & ! input [this is full array, but could be 1:nday] + gas_concs_sw & ! inout ; will be bottom-to-top !! concentrations will be size ncol, but only 1:nday should be used + ) + + call aer_rad_props_sw( & ! Get aerosol shortwave optical properties + icall, & ! input + state, & ! input + pbuf, & ! input pointer + nnite, & ! input + idxnite, & ! input + aer_tau, & ! output + aer_tau_w, & ! output + aer_tau_w_g, & ! output + aer_tau_w_f & ! output + ) + ! NOTE: CAM fields are products tau, tau*ssa, tau*ssa*asy, tau*ssa*asy*fsf + ! but RRTMGP is expecting just the values per band. + ! rrtmgp_set_aer_sw does the division and puts values into aer_sw: + ! aer_sw%g = aer_tau_w_g / aer_taw_w + ! aer_sw%ssa = aer_tau_w / aer_tau + ! aer_sw%tau = aer_tau + ! ** As with cloud above, we need to re-order to account for band differences: + + aer_tau(:, :, :) = aer_tau( :, :, rrtmg_to_rrtmgp_swbands) + aer_tau_w(:, :, :) = aer_tau_w( :, :, rrtmg_to_rrtmgp_swbands) + aer_tau_w_g(:, :, :) = aer_tau_w_g(:, :, rrtmg_to_rrtmgp_swbands) + aer_tau_w_f(:, :, :) = aer_tau_w_f(:, :, rrtmg_to_rrtmgp_swbands) + + ! Convert from the products to individual properties, + ! and only provide them on the daylit points. + call rrtmgp_set_aer_sw( & + nswbands, & + nday, & + idxday(1:nday), & ! required to truncate to 1:nday + aer_tau, & + aer_tau_w, & + aer_tau_w_g, & + aer_tau_w_f, & + aer_sw) + + ! Compute SW fluxes + + ! check that optical properties are in bounds: + call clipper(cloud_sw%tau, 0._r8, huge(cloud_sw%tau)) + call clipper(cloud_sw%ssa, 0._r8, 1._r8) + call clipper(cloud_sw%g, -1._r8, 1._r8) + + ! CHECK BOUNDS OF ARRAYS: + ! errmsg = cloud_sw%validate() ! rte provides validate method for tau, ssa, and g all at once. + ! if (len_trim(errmsg) > 0) then + ! call endrun(sub//': ERROR code returned by check_bounds cloud_sw: '//trim(errmsg)) + ! end if + ! errmsg = aer_sw%validate() ! rte provides validate method for tau, ssa, and g all at once. + ! if (len_trim(errmsg) > 0) then + ! call endrun(sub//': ERROR code returned by check_bounds aer_sw: '//trim(errmsg)) + ! end if + ! call check_bounds(alb_dir, 1.0_r8, 0.0_r8, errmsg) + ! if (len_trim(errmsg) > 0) then + ! call endrun(sub//': ERROR code returned by check_bounds alb_dir: '//trim(errmsg)) + ! end if + ! call check_bounds(alb_dif, 1.0_r8, 0.0_r8, errmsg) + ! if (len_trim(errmsg) > 0) then + ! call endrun(sub//': ERROR code returned by check_bounds alb_dif: '//trim(errmsg)) + ! end if + ! call check_bounds(coszrs_day, 1.0_r8, 0.0_r8, errmsg) + ! if (len_trim(errmsg) > 0) then + ! call endrun(sub//': ERROR code returned by check_bounds coszrs_day: '//trim(errmsg)) + ! end if + ! call check_bounds(pint_day, 120000.0_r8, 1.0_r8, errmsg) ! Pa -- give pretty big bounds + ! if (len_trim(errmsg) > 0) then + ! call endrun(sub//': ERROR code returned by check_bounds pint_day: '//trim(errmsg)) + ! end if + ! call check_bounds(t_day, 350.0_r8, 150.0_r8, errmsg) ! K -- give pretty big bounds + ! if (len_trim(errmsg) > 0) then + ! call endrun(sub//': ERROR code returned by check_bounds t_day: '//trim(errmsg)) + ! end if + ! call check_bounds(pmid_day, 120000.0_r8, 1.0_r8, errmsg) ! Pa -- give pretty big bounds + ! if (len_trim(errmsg) > 0) then + ! call endrun(sub//': ERROR code returned by check_bounds pint_day: '//trim(errmsg)) + ! end if + + + ! Still to validate: + ! - kdist_sw + ! - gas_concs_sw + ! call check_bounds(nday, nlay, gas_concs_sw, errmsg) + ! if (len_trim(errmsg) > 0) then + ! call endrun(sub//': ERROR code returned by check_bounds gas_concs_sw: '//trim(errmsg)) + ! end if + ! call check_bounds(kdist_sw, errmsg) + call shr_mem_getusage(mem_hw_beg, mem_beg) + ! inputs are the daylit columns --> output fluxes therefore also on daylit columns. + errmsg = rte_sw( kdist_sw, & ! input (from init) + gas_concs_sw, & ! input, (from rrtmgp_set_gases_sw) + pmid_day, & ! input, (from rrtmgp_set_state) + t_day, & ! input, (from rrtmgp_set_state) + pint_day, & ! input, (from rrtmgp_set_state) + coszrs_day, & ! input, (from rrtmgp_set_state) + alb_dir, & ! input, (from rrtmgp_set_state) + alb_dif, & ! input, (from rrtmgp_set_state) + cloud_sw, & ! input, (from rrtmgp_set_cloud_sw) + fsw, & ! inout + fswc, & ! inout + aer_props=aer_sw, & ! optional input (from rrtmgp_set_aer_sw) + tsi_scaling=eccf & !< optional input, scaling for irradiance + ) + + call shr_mem_getusage(mem_hw_end, mem_end) + temp = mem_hw_end - mem_hw_beg + if (masterproc) then + write(iulog, *) 'rte_sw: Increase in memory highwater = ', & + temp, ' (MB)' + end if + temp = mem_end - mem_beg + if (masterproc) then + write(iulog, *) 'rte_sw: Increase in memory usage = ', & + temp, ' (MB)' + end if + + if (len_trim(errmsg) > 0) then + call endrun(sub//': ERROR code returned by rte_sw: '//trim(errmsg)) + end if + ! + ! -- shortwave output -- + ! + + ! Transform RRTMGP outputs to CAM outputs + ! - including fsw (W/m2) -> qrs (J/(kgK)) + call set_sw_diags() + + if (write_output) then + call radiation_output_sw(lchnk, ncol, icall, rd, pbuf, cam_out) ! QRS = qrs/cpair; whatever qrs is in pbuf + end if + + end if ! (active_calls(icall)) + end do ! loop over diagnostic calcs (icall) + + else + if (conserve_energy) then + qrs(1:ncol,1:pver) = qrs(1:ncol,1:pver) / state%pdel(1:ncol,1:pver) + end if + end if ! if (dosw) + + ! Output aerosol mmr + ! This happens between SW and LW (Why?) + call rad_cnst_out(0, state, pbuf) + + ! + ! -- LONGWAVE -- + ! + if (dolw) then + if (oldcldoptics) then + call cloud_rad_props_get_lw(state, pbuf, cld_lw_abs, oldcloud=.true.) + else + select case (icecldoptics) + case ('ebertcurry') + call ec_ice_get_rad_props_lw(state, pbuf, ice_lw_abs, oldicewp=.true.) + case ('mitchell') + call ice_cloud_get_rad_props_lw(state, pbuf, ice_lw_abs) + case default + call endrun('ERROR: iccldoptics must be one either ebertcurry or mitchell') + end select + + select case (liqcldoptics) + case ('slingo') + call slingo_liq_get_rad_props_lw(state, pbuf, liq_lw_abs, oldliqwp=.true.) + case ('gammadist') + call liquid_cloud_get_rad_props_lw(state, pbuf, liq_lw_abs) + case default + call endrun('ERROR: liqcldoptics must be either slingo or gammadist') + end select + + cld_lw_abs(:,:ncol,:) = liq_lw_abs(:,:ncol,:) + ice_lw_abs(:,:ncol,:) + end if + + cld_lw_abs(:,:ncol,:) = liq_lw_abs(:,:ncol,:) + ice_lw_abs(:,:ncol,:) + if (cldfsnow_idx > 0) then + ! add in snow + call snow_cloud_get_rad_props_lw(state, pbuf, snow_lw_abs) + do i = 1, ncol + do k = 1, pver + if (cldfprime(i,k) > 0._r8) then + c_cld_lw_abs(:,i,k) = ( cldfsnow(i,k)*snow_lw_abs(:,i,k) & + + cld(i,k)*cld_lw_abs(:,i,k) )/cldfprime(i,k) + else + c_cld_lw_abs(:,i,k) = 0._r8 + end if + end do + end do + else + c_cld_lw_abs(:,:ncol,:) = cld_lw_abs(:,:ncol,:) + end if + if (cldfgrau_idx > 0 .and. graupel_in_rad) then + ! add in graupel + call grau_cloud_get_rad_props_lw(state, pbuf, grau_lw_abs) + do i = 1, ncol + do k = 1, pver + if (cldfprime(i,k) > 0._r8) then + c_cld_lw_abs(:,i,k) = ( cldfgrau(i,k)*grau_lw_abs(:,i,k) & + + cld(i,k)*c_cld_lw_abs(:,i,k) )/cldfprime(i,k) + else + c_cld_lw_abs(:,i,k) = 0._r8 + end if + end do + end do + end if + + ! cloud_lw : cloud optical properties. + call initialize_rrtmgp_cloud_optics_lw(ncol, nlay, kdist_lw, cloud_lw) + + call rrtmgp_set_cloud_lw( & ! Sets the LW optical depth (tau) that is passed to RRTMGP + state, & ! input (%ncol, %pmid [top-to-bottom]) + nlwbands, & ! input + cldfprime, & ! input Ordered top-to-bottom + c_cld_lw_abs, & ! input Ordered top-to-bottom + kdist_lw, & ! input (%get_ngpt, and whole object passed to mcica) + cloud_lw & ! inout (%tau is set, and returned bottom-to-top) + ) + + ! initialize/allocate object for aerosol optics (note, don't just give it nlwbands b/c wrong type) + errmsg = aer_lw%alloc_1scl(ncol, & + nlay, & + kdist_lw%get_band_lims_wavenumber(), & + name='longwave aerosol optics') + + if (len_trim(errmsg) > 0) then + call endrun(sub//': ERROR: aer_lw%init_1scalar: '//trim(errmsg)) + end if + + call rad_cnst_get_call_list(active_calls) ! get list of diagnostic calls + + ! The climate (icall==0) calculation must occur last. + do icall = N_DIAG, 0, -1 + + if (active_calls(icall)) then + ! initialize the gas concentrations + call set_available_gases(active_gases, gas_concs_lw) +! errmsg = gas_concs_lw%init(active_gases) +! if (len_trim(errmsg) > 0) then +! call endrun(sub//': ERROR code returned by gas_concs_lw%init: '//trim(errmsg)) +! end if + call rrtmgp_set_gases_lw(icall, state, pbuf, nlay, gas_concs_lw) + + call aer_rad_props_lw( & ! get absorption optical depth + icall, & ! input + state, & ! input + pbuf, & ! input + aer_lw_abs & ! outut + ) + call rrtmgp_set_aer_lw( & ! put absorption optical depth into aer_lw + ncol, & ! input + nlwbands, & ! input + aer_lw_abs, & ! input + aer_lw & ! output, %tau, ordered bottom-to-top + ) + + ! check that optical properties are in bounds: + call clipper(cloud_lw%tau, 0._r8, huge(cloud_lw%tau)) + call clipper(aer_lw%tau, 0._r8, huge(aer_lw%tau)) + + ! Compute LW fluxes + errmsg = rte_lw(kdist_lw, & ! input + gas_concs_lw, & ! input, (rrtmgp_set_gases_lw) + pmid_rad, & ! input, (rrtmgp_set_state) + t_rad, & ! input, (rrtmgp_set_state) + pint_rad, & ! input, (rrtmgp_set_state) + t_sfc, & ! input (rrtmgp_set_state) + emis_sfc, & ! input (rrtmgp_set_state) + cloud_lw, & ! input, (rrtmgp_set_cloud_lw) + flw, & ! output + flwc, & ! output + aer_props=aer_lw & ! optional input, (rrtmgp_set_aer_lw) + ) ! note inc_flux is an optional input, but as defined in set_rrtmgp_state, it is only for shortwave + if (len_trim(errmsg) > 0) then + ! + ! DEBUG -- if we die here, find out why + ! + write(iulog,*) '** [radiation_tend] DIAGNOSE LW CRASH **' + do i = 1,ncol + write(iulog,*) 'ncol = ',ncol,' t_sfc = ',t_sfc(i),' AT LOCATION lat = ', clat(i), ' lon = ', clon(i) + end do + call endrun(sub//': ERROR code returned by rte_lw: '//trim(errmsg)) + end if + ! + ! -- longwave output -- + ! + call set_lw_diags() ! Reverse direction of LW fluxes back to TOP-to-BOTTOM + ! And derive LW dry static energy tendency (QRL, rd%QRLC (J/kg/s)) + if (write_output) then + ! QRL retrieved from pbuf and divided by cpair [(J/(kg s)) / (J/(K kg)) = K/s] + call radiation_output_lw(lchnk, ncol, icall, rd, pbuf, cam_out) + end if + + end if + end do + + else + if (conserve_energy) then + qrl(1:ncol,1:pver) = qrl(1:ncol,1:pver) / state%pdel(1:ncol,1:pver) + end if + end if ! if (dolw) + + ! replaces old "rrtmg_state_destroy" -- deallocates outputs from rrtmgp_set_state() + ! note rd%solin is not being deallocated here, but rd is deallocated after the output stage. + deallocate( & + t_sfc, emis_sfc, t_rad, pmid_rad, pint_rad, & + t_day, pmid_day, pint_day, coszrs_day, alb_dir, & + alb_dif) + + + !!! *** BEGIN COSP *** + if (docosp) then + ! initialize and calculate emis + emis(:,:) = 0._r8 + emis(:ncol,:) = 1._r8 - exp(-cld_lw_abs(lw_cloudsim_band,:ncol,:)) + call outfld('EMIS', emis, pcols, lchnk) + + ! compute grid-box mean SW and LW snow optical depth for use by COSP + gb_snow_tau(:,:) = 0._r8 + gb_snow_lw(:,:) = 0._r8 + if (cldfsnow_idx > 0) then + do i = 1, ncol + do k = 1, pver + if (cldfsnow(i,k) > 0._r8) then + + ! Add graupel to snow tau for cosp + if (cldfgrau_idx > 0 .and. graupel_in_rad) then + gb_snow_tau(i,k) = snow_tau(sw_cloudsim_band,i,k)*cldfsnow(i,k) + & + grau_tau(sw_cloudsim_band,i,k)*cldfgrau(i,k) + gb_snow_lw(i,k) = snow_lw_abs(lw_cloudsim_band,i,k)*cldfsnow(i,k) + & + grau_lw_abs(lw_cloudsim_band,i,k)*cldfgrau(i,k) + else + gb_snow_tau(i,k) = snow_tau(sw_cloudsim_band,i,k)*cldfsnow(i,k) + gb_snow_lw(i,k) = snow_lw_abs(lw_cloudsim_band,i,k)*cldfsnow(i,k) + end if + end if + end do + end do + end if + + ! advance counter for this timestep (chunk dimension required for thread safety) + cosp_cnt(lchnk) = cosp_cnt(lchnk) + 1 + + ! if counter is the same as cosp_nradsteps, run cosp and reset counter + if (cosp_nradsteps .eq. cosp_cnt(lchnk)) then + + ! N.B.: For snow optical properties, the GRID-BOX MEAN shortwave and longwave + ! optical depths are passed. + call cospsimulator_intr_run(state, pbuf, cam_in, emis, coszrs, & + cld_swtau_in=cld_tau(sw_cloudsim_band,:,:),& + snow_tau_in=gb_snow_tau, snow_emis_in=gb_snow_lw) + cosp_cnt(lchnk) = 0 + end if + end if + !!! *** END COSP *** + + else ! if (dosw .or. dolw) --> no radiation being done. + ! convert radiative heating rates from Q*dp to Q for energy conservation + ! qrs and qrl are whatever are in pbuf + ! since those might have been multiplied by pdel, we actually need to divide by pdel + ! to get back to what we want, which is a DSE tendency. + ! ** if you change qrs and qrl from J/kg/s here, then it won't be a DSE tendency, + ! yet it is expected to be in radheat_tend to get ptend%s + ! Does not matter if qrs and qrl are zero on these time steps + + ! this completes the conserve_energy logic, since neither sw nor lw ran + if (conserve_energy) then + qrs(1:ncol,1:pver) = qrs(1:ncol,1:pver) / state%pdel(1:ncol,1:pver) + qrl(1:ncol,1:pver) = qrl(1:ncol,1:pver) / state%pdel(1:ncol,1:pver) + end if + + end if ! if (dosw .or. dolw) then + + ! write(iulog,*) 'Radiation_Tend finished calculation [timestep ',get_nstep(), ', chunk: ',lchnk,'] -- qrs max: ',maxval(qrs),' min: ',minval(qrs),' -- qrl max: ',maxval(qrl), ' min: ',minval(qrl) + + + ! ------------------------------------------------------------------------ + ! + ! After any radiative transfer is done: output & convert fluxes to heating + ! + + call rad_data_write(pbuf, state, cam_in, coszrs) ! output rad inputs and resulting heating rates + + ! NET RADIATIVE HEATING TENDENCY + ! INPUT: state, qrl, qrs, fsns, fsnt, flns, flnt, asdir + ! OUTPUT: + ! ptend%s = (qrs + qrl) + ! net_flx = fsnt - fsns - flnt + flns + ! pbuf is an argument, but *is not used* (qrl/qrs are pointers into it) + call radheat_tend(state, pbuf, ptend, qrl, qrs, fsns, & + fsnt, flns, flnt, cam_in%asdir, net_flx) + + if (write_output) then + ! Compute heating rate for dtheta/dt + do k = 1, pver + do i = 1, ncol + ftem(i,k) = (qrs(i,k) + qrl(i,k))/cpair * (1.e5_r8/state%pmid(i,k))**cappa + end do + end do + call outfld('HR', ftem, pcols, lchnk) + end if + + ! convert radiative heating rates to Q*dp for energy conservation + ! QRS & QRL should be in J/(kg s) (dry static energy tendency); not sure where this goes after radiation. + if (conserve_energy) then + qrs(1:ncol,1:pver) = qrs(1:ncol,1:pver) * state%pdel(1:ncol,1:pver) + qrl(1:ncol,1:pver) = qrl(1:ncol,1:pver) * state%pdel(1:ncol,1:pver) + end if + + if (.not. present(rd_out)) then + deallocate(rd) + end if + call free_optics_sw(cloud_sw) + call free_optics_sw(aer_sw) + call free_fluxes(fsw) + call free_fluxes(fswc) + + call free_optics_lw(cloud_lw) + call free_optics_lw(aer_lw) + call free_fluxes(flw) + call free_fluxes(flwc) + + ! write(iulog,*) 'Radiation_Tend END [timestep ',get_nstep(), ', chunk: ',lchnk,']' + +!------------------------------------------------------------------------------- +contains +!------------------------------------------------------------------------------- + + subroutine set_sw_diags() + + ! Transform RRTMGP output for CAM + ! Uses the fluxes that come out of RRTMGP. + + ! Expects fluxes on day columns, and expands to full columns. + + integer :: i + real(r8), dimension(size(fsw%bnd_flux_dn,1), & + size(fsw%bnd_flux_dn,2), & + size(fsw%bnd_flux_dn,3)) :: flux_dn_diffuse + !------------------------------------------------------------------------- + fns = 0._r8 ! net sw flux + fcns = 0._r8 ! net sw clearsky flux + fsds = 0._r8 ! downward sw flux at surface + rd%fsdsc = 0._r8 ! downward sw clearsky flux at surface + rd%fsutoa = 0._r8 ! upward sw flux at TOA + rd%fsntoa = 0._r8 ! net sw at TOA + rd%fsntoac = 0._r8 ! net sw clearsky flux at TOA + rd%solin = 0._r8 ! solar irradiance at TOA + + ! fns, fcns, rd are on CAM grid (do not have "extra layer" when it is present.) + ! fill in the daylit columns: + do i = 1, nday + fns(idxday(i),ktopcami:) = fsw%flux_net(i, ktopradi:) + fcns(idxday(i),ktopcami:) = fswc%flux_net(i,ktopradi:) + rd%flux_sw_up(idxday(i),ktopcami:) = & + fsw%flux_up(i,ktopradi:) + rd%flux_sw_dn(idxday(i),ktopcami:) = & + fsw%flux_dn(i,ktopradi:) + rd%flux_sw_clr_up(idxday(i),ktopcami:) = & + fswc%flux_up(i,ktopradi:) + rd%flux_sw_clr_dn(idxday(i),ktopcami:) = & + fswc%flux_dn(i,ktopradi:) + fsds(idxday(i)) = fsw%flux_dn(i, nlay+1) + rd%fsdsc(idxday(i)) = fswc%flux_dn(i, nlay+1) + rd%fsutoa(idxday(i)) = fsw%flux_up(i, ktopradi) + rd%fsntoa(idxday(i)) = fsw%flux_net(i, ktopradi) ! net sw flux at TOA (*NOT* the same as fsnt) + rd%fsntoac(idxday(i)) = fswc%flux_net(i, ktopradi) ! net sw clearsky flux at TOA (*NOT* the same as fsntc) + rd%solin(idxday(i)) = fswc%flux_dn(i, ktopradi) + end do + + call heating_rate('SW', ncol, fns, qrs) + call heating_rate('SW', ncol, fcns, rd%qrsc) + + fsns(:ncol) = fns(:ncol,pverp) ! net sw flux at surface + fsnt(:ncol) = fns(:ncol,1) ! net sw flux at top-of-model (w/o extra layer) + rd%flux_sw_net_top(:ncol) = fns(:ncol, 1) + rd%fsnsc(:ncol) = fcns(:ncol,pverp) ! net sw clearsky flux at surface + rd%fsntc(:ncol) = fcns(:ncol,1) ! net sw clearsky flux at top + + cam_out%netsw(:ncol) = fsns(:ncol) + + ! Output fluxes at 200 mb + call vertinterp(ncol, pcols, pverp, state%pint, 20000._r8, fns, rd%fsn200) + call vertinterp(ncol, pcols, pverp, state%pint, 20000._r8, fcns, rd%fsn200c) + if (hist_fld_active('FSNR')) then + do i = 1,ncol + call vertinterp(1, 1, pverp, state%pint(i,:), p_trop(i), fns(i,:), rd%fsnr(i)) + end do + end if + + if (spectralflux) then + su = 0._r8 + sd = 0._r8 + do i = 1, nday + su(idxday(i),ktopcami:,:) = fsw%bnd_flux_up(i,ktopradi:,:) + sd(idxday(i),ktopcami:,:) = fsw%bnd_flux_dn(i,ktopradi:,:) + end do + end if + + ! Export surface fluxes + ! sols(pcols) Direct solar rad on surface (< 0.7) + ! soll(pcols) Direct solar rad on surface (>= 0.7) + ! RRTMG: Near-IR bands (1-9 and 14), 820-16000 cm-1, 0.625-12.195 microns + ! RRTMGP: Near-IR bands (1-10), 820-16000 cm-1, 0.625-12.195 microns + ! Put half of band 10 in each of the UV/visible and near-IR values, + ! since this band straddles 0.7 microns: + ! UV/visible bands 10-13, 16000-50000 cm-1, 0.200-0.625 micron + + ! reset fluxes + cam_out%sols = 0.0_r8 + cam_out%soll = 0.0_r8 + cam_out%solsd = 0.0_r8 + cam_out%solld = 0.0_r8 + + ! Calculate diffuse flux from total and direct + flux_dn_diffuse = fsw%bnd_flux_dn - fsw%bnd_flux_dn_dir + + do i = 1, nday + ! These use hard-coded indexes assuming default RRTMGP sw bands + ! Should be generalized to use specified frequencies. + cam_out%soll(idxday(i)) = sum(fsw%bnd_flux_dn_dir(i,nlay+1,1:9)) & + + 0.5_r8 * fsw%bnd_flux_dn_dir(i,nlay+1,10) + + cam_out%sols(idxday(i)) = 0.5_r8 * fsw%bnd_flux_dn_dir(i,nlay+1,10) & + + sum(fsw%bnd_flux_dn_dir(i,nlay+1,11:14)) + + cam_out%solld(idxday(i)) = sum(flux_dn_diffuse(i,nlay+1,1:9)) & + + 0.5_r8 * flux_dn_diffuse(i,nlay+1,10) + + cam_out%solsd(idxday(i)) = 0.5_r8 * flux_dn_diffuse(i, nlay+1, 10) & + + sum(flux_dn_diffuse(i,nlay+1,11:14)) + + end do + + end subroutine set_sw_diags + + !------------------------------------------------------------------------------- + + subroutine set_lw_diags() + + ! Transform RRTMGP output for CAM + ! Assumes RRTMGP levels are bottom to top (though it does not care need to be consistent). + ! CAM levels are top to bottom. + !---------------------------------------------------------------------------- + + fnl = 0._r8 + fcnl = 0._r8 + + ! RTE-RRTMGP convention for net is (down - up) **CAM assumes (up - down) !! + fnl(:ncol,ktopcami:) = -1._r8 * flw%flux_net( :, ktopradi:) + fcnl(:ncol,ktopcami:) = -1._r8 * flwc%flux_net( :, ktopradi:) + rd%flux_lw_up(:ncol,ktopcami:) = flw%flux_up( :, ktopradi:) + rd%flux_lw_clr_up(:ncol,ktopcami:) = flwc%flux_up(:, ktopradi:) + rd%flux_lw_dn(:ncol,ktopcami:) = flw%flux_dn( :, ktopradi:) + rd%flux_lw_clr_dn(:ncol,ktopcami:) = flwc%flux_dn(:, ktopradi:) + + call heating_rate('LW', ncol, fnl, qrl) + call heating_rate('LW', ncol, fcnl, rd%qrlc) + + flns(:ncol) = fnl(:ncol, pverp) + flnt(:ncol) = fnl(:ncol, 1) + + rd%flnsc(:ncol) = fcnl(:ncol, pverp) + rd%flntc(:ncol) = fcnl(:ncol, 1) ! net lw flux at top-of-model + + cam_out%flwds(:ncol) = flw%flux_dn(:, nlay+1) + rd%fldsc(:ncol) = flwc%flux_dn(:, nlay+1) + + rd%flut(:ncol) = flw%flux_up(:, ktopradi) + rd%flutc(:ncol) = flwc%flux_up(:, ktopradi) + + ! Output fluxes at 200 mb + call vertinterp(ncol, pcols, pverp, state%pint, 20000._r8, fnl, rd%fln200) + call vertinterp(ncol, pcols, pverp, state%pint, 20000._r8, fcnl, rd%fln200c) + if (hist_fld_active('FLNR')) then + do i = 1,ncol + call vertinterp(1, 1, pverp, state%pint(i,:), p_trop(i), fnl(i,:), rd%flnr(i)) + end do + end if + + if (spectralflux) then + lu = 0._r8 + ld = 0._r8 + lu(:ncol, ktopcami:, :) = flw%bnd_flux_up(:, ktopradi:, :) + ld(:ncol, ktopcami:, :) = flw%bnd_flux_dn(:, ktopradi:, :) + end if + + end subroutine set_lw_diags + + !------------------------------------------------------------------------------- + + subroutine heating_rate(type, ncol, flux_net, hrate) + + ! Compute heating rate as a dry static energy tendency + + ! arguments + character(2), intent(in) :: type ! either LW or SW + integer, intent(in) :: ncol + real(r8), intent(in) :: flux_net(pcols,pverp) ! W/m^2 + real(r8), intent(out) :: hrate(pcols,pver) ! J/kg/s + + ! local vars + integer :: k + + select case (type) + case ('LW') + + do k = 1, pver + ! (flux divergence as bottom-MINUS-top) * g/dp + hrate(:ncol,k) = (flux_net(:ncol,k+1) - flux_net(:ncol,k)) * & + gravit / state%pdel(:ncol,k) + end do + + case ('SW') + + do k = 1, pver + ! top - bottom + hrate(:ncol,k) = (flux_net(:ncol,k) - flux_net(:ncol,k+1)) * & + gravit / state%pdel(:ncol,k) + end do + + end select + + end subroutine heating_rate + + !---------------------------------------------------------------------------- + ! -- end contains statement of radiation_tend -- + !---------------------------------------------------------------------------- +end subroutine radiation_tend + +!=============================================================================== + + +subroutine radiation_output_sw(lchnk, ncol, icall, rd, pbuf, cam_out) + + ! Dump shortwave radiation information to history buffer. + + integer , intent(in) :: lchnk + integer, intent(in) :: ncol + integer, intent(in) :: icall + type(rad_out_t), intent(in) :: rd + type(physics_buffer_desc), pointer :: pbuf(:) + type(cam_out_t), intent(in) :: cam_out + + ! local variables + real(r8), pointer :: qrs(:,:) + real(r8), pointer :: fsnt(:) + real(r8), pointer :: fsns(:) + real(r8), pointer :: fsds(:) + real(r8), pointer :: su(:,:),sd(:,:),lu(:,:),ld(:,:) + + real(r8) :: ftem(pcols) + !---------------------------------------------------------------------------- + + call pbuf_get_field(pbuf, qrs_idx, qrs) + call pbuf_get_field(pbuf, fsnt_idx, fsnt) + call pbuf_get_field(pbuf, fsns_idx, fsns) + call pbuf_get_field(pbuf, fsds_idx, fsds) + + call outfld('SOLIN'//diag(icall), rd%solin, pcols, lchnk) + + call outfld('QRS'//diag(icall), qrs(:ncol,:)/cpair, ncol, lchnk) ! not sure why ncol instead of pcols, but matches RRTMG version + call outfld('QRSC'//diag(icall), rd%qrsc(:ncol,:)/cpair, ncol, lchnk) + + call outfld('FSNT'//diag(icall), rd%flux_sw_net_top, pcols, lchnk) + call outfld('FSNTC'//diag(icall), rd%fsntc, pcols, lchnk) + call outfld('FSNTOA'//diag(icall), rd%fsntoa, pcols, lchnk) + call outfld('FSNTOAC'//diag(icall), rd%fsntoac, pcols, lchnk) + + ftem(:ncol) = rd%fsntoa(:ncol) - rd%fsntoac(:ncol) + call outfld('SWCF'//diag(icall), ftem, pcols, lchnk) + + call outfld('FSUTOA'//diag(icall), rd%fsutoa, pcols, lchnk) + + call outfld('FSNIRTOA'//diag(icall), rd%fsnirt, pcols, lchnk) + call outfld('FSNRTOAC'//diag(icall), rd%fsnrtc, pcols, lchnk) + call outfld('FSNRTOAS'//diag(icall), rd%fsnirtsq, pcols, lchnk) + + call outfld('FSN200'//diag(icall), rd%fsn200, pcols, lchnk) + call outfld('FSN200C'//diag(icall), rd%fsn200c, pcols, lchnk) + + call outfld('FSNR'//diag(icall), rd%fsnr, pcols, lchnk) + + call outfld('SOLS'//diag(icall), cam_out%sols, pcols, lchnk) + call outfld('SOLL'//diag(icall), cam_out%soll, pcols, lchnk) + call outfld('SOLSD'//diag(icall), cam_out%solsd, pcols, lchnk) + call outfld('SOLLD'//diag(icall), cam_out%solld, pcols, lchnk) + + call outfld('FSNS'//diag(icall), fsns, pcols, lchnk) + call outfld('FSNSC'//diag(icall), rd%fsnsc, pcols, lchnk) + + call outfld('FSDS'//diag(icall), fsds, pcols, lchnk) + call outfld('FSDSC'//diag(icall), rd%fsdsc, pcols, lchnk) + + call outfld('FUS'//diag(icall), rd%flux_sw_up, pcols, lchnk) + call outfld('FUSC'//diag(icall), rd%flux_sw_clr_up, pcols, lchnk) + call outfld('FDS'//diag(icall), rd%flux_sw_dn, pcols, lchnk) + call outfld('FDSC'//diag(icall), rd%flux_sw_clr_dn, pcols, lchnk) + +end subroutine radiation_output_sw + + +!=============================================================================== + +subroutine radiation_output_cld(lchnk, ncol, rd) + + ! Dump shortwave cloud optics information to history buffer. + + integer , intent(in) :: lchnk + integer, intent(in) :: ncol + type(rad_out_t), intent(in) :: rd + !---------------------------------------------------------------------------- + + call outfld('TOT_CLD_VISTAU', rd%tot_cld_vistau, pcols, lchnk) + call outfld('TOT_ICLD_VISTAU', rd%tot_icld_vistau, pcols, lchnk) + call outfld('LIQ_ICLD_VISTAU', rd%liq_icld_vistau, pcols, lchnk) + call outfld('ICE_ICLD_VISTAU', rd%ice_icld_vistau, pcols, lchnk) + if (cldfsnow_idx > 0) then + call outfld('SNOW_ICLD_VISTAU', rd%snow_icld_vistau, pcols, lchnk) + endif + if (cldfgrau_idx > 0 .and. graupel_in_rad) then + call outfld('GRAU_ICLD_VISTAU', rd%grau_icld_vistau , pcols, lchnk) + endif + +end subroutine radiation_output_cld + +!=============================================================================== + +subroutine radiation_output_lw(lchnk, ncol, icall, rd, pbuf, cam_out) + + ! Dump longwave radiation information to history buffer + + integer, intent(in) :: lchnk + integer, intent(in) :: ncol + integer, intent(in) :: icall ! icall=0 for climate diagnostics + type(rad_out_t), intent(in) :: rd + type(physics_buffer_desc), pointer :: pbuf(:) + type(cam_out_t), intent(in) :: cam_out + + ! local variables + real(r8), pointer :: qrl(:,:) + real(r8), pointer :: flnt(:) + real(r8), pointer :: flns(:) + + real(r8) :: ftem(pcols) + !---------------------------------------------------------------------------- + + call pbuf_get_field(pbuf, qrl_idx, qrl) + call pbuf_get_field(pbuf, flnt_idx, flnt) + call pbuf_get_field(pbuf, flns_idx, flns) + + call outfld('QRL'//diag(icall), qrl(:ncol,:)/cpair, ncol, lchnk) + call outfld('QRLC'//diag(icall), rd%qrlc(:ncol,:)/cpair, ncol, lchnk) + + call outfld('FLNT'//diag(icall), flnt, pcols, lchnk) + call outfld('FLNTC'//diag(icall), rd%flntc, pcols, lchnk) + + call outfld('FLUT'//diag(icall), rd%flut, pcols, lchnk) + call outfld('FLUTC'//diag(icall), rd%flutc, pcols, lchnk) + + ftem(:ncol) = rd%flutc(:ncol) - rd%flut(:ncol) + call outfld('LWCF'//diag(icall), ftem, pcols, lchnk) + + call outfld('FLN200'//diag(icall), rd%fln200, pcols, lchnk) + call outfld('FLN200C'//diag(icall), rd%fln200c, pcols, lchnk) + + call outfld('FLNR'//diag(icall), rd%flnr, pcols, lchnk) + + call outfld('FLNS'//diag(icall), flns, pcols, lchnk) + call outfld('FLNSC'//diag(icall), rd%flnsc, pcols, lchnk) + + call outfld('FLDS'//diag(icall), cam_out%flwds, pcols, lchnk) + call outfld('FLDSC'//diag(icall), rd%fldsc, pcols, lchnk) + + call outfld('FDL'//diag(icall), rd%flux_lw_dn, pcols, lchnk) + call outfld('FDLC'//diag(icall), rd%flux_lw_clr_dn, pcols, lchnk) + call outfld('FUL'//diag(icall), rd%flux_lw_up, pcols, lchnk) + call outfld('FULC'//diag(icall), rd%flux_lw_clr_up, pcols, lchnk) +end subroutine radiation_output_lw + +!=============================================================================== + +subroutine calc_col_mean(state, mmr_pointer, mean_value) + + ! Compute the column mean mass mixing ratio. + + type(physics_state), intent(in) :: state + real(r8), dimension(:,:), pointer :: mmr_pointer ! mass mixing ratio (lev) + real(r8), dimension(pcols), intent(out) :: mean_value ! column mean mmr + + integer :: i, k, ncol + real(r8) :: ptot(pcols) + !----------------------------------------------------------------------- + + ncol = state%ncol + mean_value = 0.0_r8 + ptot = 0.0_r8 + + do k=1,pver + do i=1,ncol + mean_value(i) = mean_value(i) + mmr_pointer(i,k)*state%pdeldry(i,k) + ptot(i) = ptot(i) + state%pdeldry(i,k) + end do + end do + do i=1,ncol + mean_value(i) = mean_value(i) / ptot(i) + end do + +end subroutine calc_col_mean + +!=============================================================================== + +subroutine coefs_init(coefs_file, kdist, available_gases, band2gpt, tsi_default) + + ! Read data from coefficients file. Initialize the kdist object. + + ! arguments + character(len=*), intent(in) :: coefs_file + class(ty_gas_optics_rrtmgp), intent(out) :: kdist + class(ty_gas_concs), intent(in) :: available_gases ! Which gases does the host model have available? + + real(r8), intent(out), optional :: tsi_default ! RRTMGP reference TSI + + ! local variables + type(file_desc_t) :: fh ! pio file handle + character(len=256) :: locfn ! path to actual file used + + ! File dimensions + integer :: & + absorber, & + atmos_layer, & + bnd, & + pressure, & + temperature, & + absorber_ext, & ! replaces `major_absorber` + pressure_interp, & + mixing_fraction, & + gpt, & + temperature_Planck + + integer :: i, j, k + integer :: did, vid + integer :: ierr + + character(32), dimension(:), allocatable :: gas_names + integer, dimension(:,:,:), allocatable :: key_species + integer, dimension(:,:), allocatable, intent(out) :: band2gpt ! -> file : 'bnd_limits_gpt' + real(r8), dimension(:,:), allocatable :: band_lims_wavenum ! -> file : 'bnd_limits_wavenumber' + real(r8), dimension(:), allocatable :: press_ref, temp_ref + real(r8) :: press_ref_trop, temp_ref_t, temp_ref_p + real(r8), dimension(:,:,:), allocatable :: vmr_ref + real(r8), dimension(:,:,:,:), allocatable :: kmajor + ! ? real(r8), dimension(:,:,:), allocatable :: selfrefin, forrefin + real(r8), dimension(:,:,:), allocatable :: kminor_lower, kminor_upper + real(r8), dimension(:,:), allocatable :: totplnk + real(r8), dimension(:,:,:,:), allocatable :: planck_frac + real(r8), dimension(:), allocatable :: solar_src_quiet, solar_src_facular, solar_src_sunspot ! updated from solar_src + real(r8), dimension(:,:,:), allocatable :: rayl_lower, rayl_upper + character(len=32), dimension(:), allocatable :: gas_minor, & + identifier_minor, & + minor_gases_lower, & + minor_gases_upper, & + scaling_gas_lower, & + scaling_gas_upper + integer, dimension(:,:), allocatable :: minor_limits_gpt_lower, & + minor_limits_gpt_upper + ! Send these to RRTMGP as logicals, + ! but they have to be read from the netCDF as integers + logical, dimension(:), allocatable :: minor_scales_with_density_lower, & + minor_scales_with_density_upper + logical, dimension(:), allocatable :: scale_by_complement_lower, & + scale_by_complement_upper + integer, dimension(:), allocatable :: int2log ! use this to convert integer-to-logical. + integer, dimension(:), allocatable :: kminor_start_lower, kminor_start_upper + real(r8), dimension(:,:), allocatable :: optimal_angle_fit + real(r8) :: mg_default, sb_default + + integer :: pairs, & + minorabsorbers, & + minor_absorber_intervals_lower, & + minor_absorber_intervals_upper, & + contributors_lower, & + contributors_upper, & + fit_coeffs + + character(len=128) :: error_msg + character(len=*), parameter :: sub = 'coefs_init' + !---------------------------------------------------------------------------- + + ! Open file + call getfil(coefs_file, locfn, 0) + call cam_pio_openfile(fh, locfn, PIO_NOWRITE) + + call pio_seterrorhandling(fh, PIO_BCAST_ERROR) + + + ! Get variables and validate them, then put into kdist + + ! Get dimensions and check for consistency with parameter values + + ierr = pio_inq_dimid(fh, 'absorber', did) + if (ierr /= PIO_NOERR) call endrun(sub//': absorber not found') + ierr = pio_inq_dimlen(fh, did, absorber) + + ierr = pio_inq_dimid(fh, 'atmos_layer', did) + if (ierr /= PIO_NOERR) call endrun(sub//': atmos_layer not found') + ierr = pio_inq_dimlen(fh, did, atmos_layer) + + ierr = pio_inq_dimid(fh, 'bnd', did) + if (ierr /= PIO_NOERR) call endrun(sub//': bnd not found') + ierr = pio_inq_dimlen(fh, did, bnd) + + ierr = pio_inq_dimid(fh, 'pressure', did) + if (ierr /= PIO_NOERR) call endrun(sub//': pressure not found') + ierr = pio_inq_dimlen(fh, did, pressure) + + ierr = pio_inq_dimid(fh, 'temperature', did) + if (ierr /= PIO_NOERR) call endrun(sub//': temperature not found') + ierr = pio_inq_dimlen(fh, did, temperature) + + ierr = pio_inq_dimid(fh, 'absorber_ext', did) + if (ierr /= PIO_NOERR) call endrun(sub//': absorber_ext not found') + ierr = pio_inq_dimlen(fh, did, absorber_ext) + + ierr = pio_inq_dimid(fh, 'pressure_interp', did) + if (ierr /= PIO_NOERR) call endrun(sub//': pressure_interp not found') + ierr = pio_inq_dimlen(fh, did, pressure_interp) + + ierr = pio_inq_dimid(fh, 'mixing_fraction', did) + if (ierr /= PIO_NOERR) call endrun(sub//': mixing_fraction not found') + ierr = pio_inq_dimlen(fh, did, mixing_fraction) + + ierr = pio_inq_dimid(fh, 'gpt', did) + if (ierr /= PIO_NOERR) call endrun(sub//': gpt not found') + ierr = pio_inq_dimlen(fh, did, gpt) + + temperature_Planck = 0 + ierr = pio_inq_dimid(fh, 'temperature_Planck', did) + if (ierr == PIO_NOERR) then + ierr = pio_inq_dimlen(fh, did, temperature_Planck) + end if + ierr = pio_inq_dimid(fh, 'pair', did) + if (ierr /= PIO_NOERR) call endrun(sub//': pair not found') + ierr = pio_inq_dimlen(fh, did, pairs) + ierr = pio_inq_dimid(fh, 'minor_absorber', did) + if (ierr /= PIO_NOERR) call endrun(sub//': minor_absorber not found') + ierr = pio_inq_dimlen(fh, did, minorabsorbers) + ierr = pio_inq_dimid(fh, 'minor_absorber_intervals_lower', did) + if (ierr /= PIO_NOERR) call endrun(sub//': minor_absorber_intervals_lower not found') + ierr = pio_inq_dimlen(fh, did, minor_absorber_intervals_lower) + ierr = pio_inq_dimid(fh, 'minor_absorber_intervals_upper', did) + if (ierr /= PIO_NOERR) call endrun(sub//': minor_absorber_intervals_upper not found') + ierr = pio_inq_dimlen(fh, did, minor_absorber_intervals_upper) + ierr = pio_inq_dimid(fh, 'contributors_lower', did) + if (ierr /= PIO_NOERR) call endrun(sub//': contributors_lower not found') + ierr = pio_inq_dimlen(fh, did, contributors_lower) + ierr = pio_inq_dimid(fh, 'contributors_upper', did) + if (ierr /= PIO_NOERR) call endrun(sub//': contributors_upper not found') + ierr = pio_inq_dimlen(fh, did, contributors_upper) + + ierr = pio_inq_dimid(fh, 'fit_coeffs', did) + if (ierr == PIO_NOERR) then + ierr = pio_inq_dimlen(fh, did, fit_coeffs) + end if + + + ! Get variables + + ! names of absorbing gases + allocate(gas_names(absorber)) + ierr = pio_inq_varid(fh, 'gas_names', vid) + if (ierr /= PIO_NOERR) call endrun(sub//': gas_names not found') + ierr = pio_get_var(fh, vid, gas_names) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading gas_names') + + ! key species pair for each band + allocate(key_species(2,atmos_layer,bnd)) + ierr = pio_inq_varid(fh, 'key_species', vid) + if (ierr /= PIO_NOERR) call endrun(sub//': key_species not found') + ierr = pio_get_var(fh, vid, key_species) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading key_species') + + ! beginning and ending gpoint for each band + allocate(band2gpt(2,bnd)) + ierr = pio_inq_varid(fh, 'bnd_limits_gpt', vid) + if (ierr /= PIO_NOERR) call endrun(sub//': bnd_limits_gpt not found') + ierr = pio_get_var(fh, vid, band2gpt) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading bnd_limits_gpt') + + ! beginning and ending wavenumber for each band + allocate(band_lims_wavenum(2,bnd)) + ierr = pio_inq_varid(fh, 'bnd_limits_wavenumber', vid) + if (ierr /= PIO_NOERR) call endrun(sub//': bnd_limits_wavenumber not found') + ierr = pio_get_var(fh, vid, band_lims_wavenum) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading bnd_limits_wavenumber') + + ! pressures [hPa] for reference atmosphere; press_ref(# reference layers) + allocate(press_ref(pressure)) + ierr = pio_inq_varid(fh, 'press_ref', vid) + if (ierr /= PIO_NOERR) call endrun(sub//': press_ref not found') + ierr = pio_get_var(fh, vid, press_ref) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading press_ref') + + ! reference pressure separating the lower and upper atmosphere + ierr = pio_inq_varid(fh, 'press_ref_trop', vid) + if (ierr /= PIO_NOERR) call endrun(sub//': press_ref_trop not found') + ierr = pio_get_var(fh, vid, press_ref_trop) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading press_ref_trop') + + ! temperatures [K] for reference atmosphere; temp_ref(# reference layers) + allocate(temp_ref(temperature)) + ierr = pio_inq_varid(fh, 'temp_ref', vid) + if (ierr /= PIO_NOERR) call endrun(sub//': temp_ref not found') + ierr = pio_get_var(fh, vid, temp_ref) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading temp_ref') + + ! standard spectroscopic reference temperature [K] + ierr = pio_inq_varid(fh, 'absorption_coefficient_ref_T', vid) + if (ierr /= PIO_NOERR) call endrun(sub//': absorption_coefficient_ref_T not found') + ierr = pio_get_var(fh, vid, temp_ref_t) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading absorption_coefficient_ref_T') + + ! standard spectroscopic reference pressure [hPa] + ierr = pio_inq_varid(fh, 'absorption_coefficient_ref_P', vid) + if (ierr /= PIO_NOERR) call endrun(sub//': absorption_coefficient_ref_P not found') + ierr = pio_get_var(fh, vid, temp_ref_p) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading absorption_coefficient_ref_P') + + ! volume mixing ratios for reference atmosphere + ! vmr_ref(temperature, absorber_ext, atmos_layer) + allocate(vmr_ref(atmos_layer, absorber_ext, temperature)) + ierr = pio_inq_varid(fh, 'vmr_ref', vid) + if (ierr /= PIO_NOERR) call endrun(sub//': vmr_ref not found') + ierr = pio_get_var(fh, vid, vmr_ref) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading vmr_ref') + + ! absorption coefficients due to major absorbing gases + allocate(kmajor(gpt,mixing_fraction,pressure_interp,temperature)) + ierr = pio_inq_varid(fh, 'kmajor', vid) + if (ierr /= PIO_NOERR) call endrun(sub//': kmajor not found') + ierr = pio_get_var(fh, vid, kmajor) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading kmajor') + + ! -bpm - variable wv_self & wv_for not in the newer files. + ! ! absorption coefficients due to water vapor self continuum + ! allocate(selfrefin(gpt,mixing_fraction,temperature)) + ! ierr = pio_inq_varid(fh, 'wv_self', vid) + ! if (ierr /= PIO_NOERR) call endrun(sub//': wv_self not found') + ! ierr = pio_get_var(fh, vid, selfrefin) + ! if (ierr /= PIO_NOERR) call endrun(sub//': error reading wv_self') + + ! ! absorption coefficients due to water vapor foreign continuum + ! allocate(forrefin(gpt,mixing_fraction,temperature)) + ! ierr = pio_inq_varid(fh, 'wv_for', vid) + ! if (ierr /= PIO_NOERR) call endrun(sub//': wv_for not found') + ! ierr = pio_get_var(fh, vid, forrefin) + ! if (ierr /= PIO_NOERR) call endrun(sub//': error reading wv_for') + + ! absorption coefficients due to minor absorbing gases in lower part of atmosphere + allocate(kminor_lower(contributors_lower, mixing_fraction, temperature)) + ierr = pio_inq_varid(fh, 'kminor_lower', vid) + if (ierr /= PIO_NOERR) call endrun(sub//': kminor_lower not found') + ierr = pio_get_var(fh, vid, kminor_lower) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading kminor_lower') + + ! absorption coefficients due to minor absorbing gases in upper part of atmosphere + allocate(kminor_upper(contributors_upper, mixing_fraction, temperature)) + ierr = pio_inq_varid(fh, 'kminor_upper', vid) + if (ierr /= PIO_NOERR) call endrun(sub//': kminor_upper not found') + ierr = pio_get_var(fh, vid, kminor_upper) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading kminor_upper') + + ! integrated Planck function by band + ierr = pio_inq_varid(fh, 'totplnk', vid) + if (ierr == PIO_NOERR) then + allocate(totplnk(temperature_Planck,bnd)) + ierr = pio_get_var(fh, vid, totplnk) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading totplnk') + end if + + ! Planck fractions + ierr = pio_inq_varid(fh, 'plank_fraction', vid) + if (ierr == PIO_NOERR) then + allocate(planck_frac(gpt,mixing_fraction,pressure_interp,temperature)) + ierr = pio_get_var(fh, vid, planck_frac) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading plank_fraction') + end if + + ierr = pio_inq_varid(fh, 'optimal_angle_fit', vid) + if (ierr == PIO_NOERR) then + allocate(optimal_angle_fit(fit_coeffs, bnd)) + ierr = pio_get_var(fh, vid, optimal_angle_fit) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading optimal_angle_fit') + end if + + ! solar_src + ! !bpm -- solar_source is not in file, there are solar_source_[facular, sunspot, quiet] + ! There's a method that adds them together to get solar_source. + ! ierr = pio_inq_varid(fh, 'solar_source', vid) + ! if (ierr == PIO_NOERR) then + ! allocate(solar_src(gpt)) + ! ierr = pio_get_var(fh, vid, solar_src) + ! if (ierr /= PIO_NOERR) call endrun(sub//': error reading solar_source') + ! end if + ierr = pio_inq_varid(fh, 'solar_source_quiet', vid) + if (ierr == PIO_NOERR) then + allocate(solar_src_quiet(gpt)) + ierr = pio_get_var(fh, vid, solar_src_quiet) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading solar_source_quiet') + end if + ierr = pio_inq_varid(fh, 'solar_source_facular', vid) + if (ierr == PIO_NOERR) then + allocate(solar_src_facular(gpt)) + ierr = pio_get_var(fh, vid, solar_src_facular) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading solar_source_facular') + end if + ierr = pio_inq_varid(fh, 'solar_source_sunspot', vid) + if (ierr == PIO_NOERR) then + allocate(solar_src_sunspot(gpt)) + ierr = pio_get_var(fh, vid, solar_src_sunspot) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading solar_source_sunspot') + end if + + ! +bpm also need to have tsi_default, mg_default, and sb_default + ierr = pio_inq_varid(fh, 'tsi_default', vid) + if (ierr == PIO_NOERR) then + ierr = pio_get_var(fh, vid, tsi_default) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading tsi_default') + end if + + ierr = pio_inq_varid(fh, 'mg_default', vid) + if (ierr == PIO_NOERR) then + ierr = pio_get_var(fh, vid, mg_default) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading mg_default') + end if + + ierr = pio_inq_varid(fh, 'sb_default', vid) + if (ierr == PIO_NOERR) then + ierr = pio_get_var(fh, vid, sb_default) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading sb_default') + end if + + ! rayleigh scattering contribution in lower part of atmosphere + ierr = pio_inq_varid(fh, 'rayl_lower', vid) + if (ierr == PIO_NOERR) then + allocate(rayl_lower(gpt,mixing_fraction,temperature)) + ierr = pio_get_var(fh, vid, rayl_lower) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading rayl_lower') + end if + + ! rayleigh scattering contribution in upper part of atmosphere + ierr = pio_inq_varid(fh, 'rayl_upper', vid) + if (ierr == PIO_NOERR) then + allocate(rayl_upper(gpt,mixing_fraction,temperature)) + ierr = pio_get_var(fh, vid, rayl_upper) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading rayl_upper') + end if + + ! +bpm the others + allocate(gas_minor(minorabsorbers)) + ierr = pio_inq_varid(fh, 'gas_minor', vid) + if (ierr /= PIO_NOERR) call endrun(sub//': gas_minor not found') + ierr = pio_get_var(fh, vid, gas_minor) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading gas_minor') + + allocate(identifier_minor(minorabsorbers)) + ierr = pio_inq_varid(fh, 'identifier_minor', vid) + if (ierr /= PIO_NOERR) call endrun(sub//': identifier_minor not found') + ierr = pio_get_var(fh, vid, identifier_minor) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading identifier_minor') + + allocate(minor_gases_lower(minor_absorber_intervals_lower)) + ierr = pio_inq_varid(fh, 'minor_gases_lower', vid) + if (ierr /= PIO_NOERR) call endrun(sub//': minor_gases_lower not found') + ierr = pio_get_var(fh, vid, minor_gases_lower) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading minor_gases_lower') + + allocate(minor_gases_upper(minor_absorber_intervals_upper)) + ierr = pio_inq_varid(fh, 'minor_gases_upper', vid) + if (ierr /= PIO_NOERR) call endrun(sub//': minor_gases_upper not found') + ierr = pio_get_var(fh, vid, minor_gases_upper) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading minor_gases_upper') + + allocate(minor_limits_gpt_lower(pairs,minor_absorber_intervals_lower)) + ierr = pio_inq_varid(fh, 'minor_limits_gpt_lower', vid) + if (ierr /= PIO_NOERR) call endrun(sub//': minor_limits_gpt_lower not found') + ierr = pio_get_var(fh, vid, minor_limits_gpt_lower) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading minor_limits_gpt_lower') + + allocate(minor_limits_gpt_upper(pairs,minor_absorber_intervals_upper)) + ierr = pio_inq_varid(fh, 'minor_limits_gpt_upper', vid) + if (ierr /= PIO_NOERR) call endrun(sub//': minor_limits_gpt_upper not found') + ierr = pio_get_var(fh, vid, minor_limits_gpt_upper) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading minor_limits_gpt_upper') + + ! Read as integer and convert to logical + allocate(int2log(minor_absorber_intervals_lower)) + allocate(minor_scales_with_density_lower(minor_absorber_intervals_lower)) + ierr = pio_inq_varid(fh, 'minor_scales_with_density_lower', vid) + if (ierr /= PIO_NOERR) call endrun(sub//': minor_scales_with_density_lower not found') + ierr = pio_get_var(fh, vid, int2log) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading minor_scales_with_density_lower') + do i = 1,minor_absorber_intervals_lower + if (int2log(i) .eq. 0) then + minor_scales_with_density_lower(i) = .false. + else + minor_scales_with_density_lower(i) = .true. + end if + end do + deallocate(int2log) + + ! Read as integer and convert to logical + allocate(int2log(minor_absorber_intervals_upper)) + allocate(minor_scales_with_density_upper(minor_absorber_intervals_upper)) + ierr = pio_inq_varid(fh, 'minor_scales_with_density_upper', vid) + if (ierr /= PIO_NOERR) call endrun(sub//': minor_scales_with_density_upper not found') + ierr = pio_get_var(fh, vid, int2log) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading minor_scales_with_density_upper') + do i = 1,minor_absorber_intervals_upper + if (int2log(i) .eq. 0) then + minor_scales_with_density_upper(i) = .false. + else + minor_scales_with_density_upper(i) = .true. + end if + end do + deallocate(int2log) + + ! Read as integer and convert to logical + allocate(int2log(minor_absorber_intervals_lower)) + allocate(scale_by_complement_lower(minor_absorber_intervals_lower)) + ierr = pio_inq_varid(fh, 'scale_by_complement_lower', vid) + if (ierr /= PIO_NOERR) call endrun(sub//': scale_by_complement_lower not found') + ierr = pio_get_var(fh, vid, int2log) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading scale_by_complement_lower') + do i = 1,minor_absorber_intervals_lower + if (int2log(i) .eq. 0) then + scale_by_complement_lower(i) = .false. + else + scale_by_complement_lower(i) = .true. + end if + end do + deallocate(int2log) + + ! Read as integer and convert to logical + allocate(int2log(minor_absorber_intervals_upper)) + allocate(scale_by_complement_upper(minor_absorber_intervals_upper)) + ierr = pio_inq_varid(fh, 'scale_by_complement_upper', vid) + if (ierr /= PIO_NOERR) call endrun(sub//': scale_by_complement_upper not found') + ierr = pio_get_var(fh, vid, int2log) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading scale_by_complement_upper') + do i = 1,minor_absorber_intervals_upper + if (int2log(i) .eq. 0) then + scale_by_complement_upper(i) = .false. + else + scale_by_complement_upper(i) = .true. + end if + end do + deallocate(int2log) + + allocate(scaling_gas_lower(minor_absorber_intervals_lower)) + ierr = pio_inq_varid(fh, 'scaling_gas_lower', vid) + if (ierr /= PIO_NOERR) call endrun(sub//': scaling_gas_lower not found') + ierr = pio_get_var(fh, vid, scaling_gas_lower) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading scaling_gas_lower') + + allocate(scaling_gas_upper(minor_absorber_intervals_upper)) + ierr = pio_inq_varid(fh, 'scaling_gas_upper', vid) + if (ierr /= PIO_NOERR) call endrun(sub//': scaling_gas_upper not found') + ierr = pio_get_var(fh, vid, scaling_gas_upper) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading scaling_gas_upper') + + allocate(kminor_start_lower(minor_absorber_intervals_lower)) + ierr = pio_inq_varid(fh, 'kminor_start_lower', vid) + if (ierr /= PIO_NOERR) call endrun(sub//': kminor_start_lower not found') + ierr = pio_get_var(fh, vid, kminor_start_lower) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading kminor_start_lower') + + allocate(kminor_start_upper(minor_absorber_intervals_upper)) + ierr = pio_inq_varid(fh, 'kminor_start_upper', vid) + if (ierr /= PIO_NOERR) call endrun(sub//': kminor_start_upper not found') + ierr = pio_get_var(fh, vid, kminor_start_upper) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading kminor_start_upper') + + ! Close file + call pio_closefile(fh) + + ! Initialize the gas optics class with data. The calls look slightly different depending + ! on whether the radiation sources are internal to the atmosphere (longwave) or external (shortwave) + ! gas_optics%load() returns a string; a non-empty string indicates an error. + ! + if (allocated(totplnk) .and. allocated(planck_frac)) then + error_msg = kdist%load(available_gases, gas_names, key_species, & + band2gpt, & + band_lims_wavenum, & + press_ref, & + press_ref_trop, & + temp_ref, & + temp_ref_p, & + temp_ref_t, & + vmr_ref, & + kmajor, & + kminor_lower, & + kminor_upper, & + gas_minor, & + identifier_minor, & + minor_gases_lower, & + minor_gases_upper, & + minor_limits_gpt_lower, & + minor_limits_gpt_upper, & + minor_scales_with_density_lower, & + minor_scales_with_density_upper, & + scaling_gas_lower, & + scaling_gas_upper, & + scale_by_complement_lower, & + scale_by_complement_upper, & + kminor_start_lower, & + kminor_start_upper, & + totplnk, planck_frac, & + rayl_lower, rayl_upper, & + optimal_angle_fit) + else if (allocated(solar_src_quiet)) then + error_msg = kdist%load(available_gases, & + gas_names, & + key_species, & + band2gpt, & + band_lims_wavenum, & + press_ref, & + press_ref_trop, & + temp_ref, & + temp_ref_p, & + temp_ref_t, & + vmr_ref, & + kmajor, & + kminor_lower, & + kminor_upper, & + gas_minor, & + identifier_minor, & + minor_gases_lower, & + minor_gases_upper, & + minor_limits_gpt_lower, & + minor_limits_gpt_upper, & + minor_scales_with_density_lower, & + minor_scales_with_density_upper, & + scaling_gas_lower, & + scaling_gas_upper, & + scale_by_complement_lower, & + scale_by_complement_upper, & + kminor_start_lower, & + kminor_start_upper, & + solar_src_quiet, & + solar_src_facular, & + solar_src_sunspot, & + tsi_default, & + mg_default, & + sb_default, & + rayl_lower, & + rayl_upper) + else + error_msg = 'must supply either totplnk and planck_frac, or solar_src_[*]' + end if + + if (len_trim(error_msg) > 0) then + call endrun(sub//': ERROR: '//trim(error_msg)) + end if + + deallocate( & + gas_names, key_species, & + band_lims_wavenum, & + press_ref, temp_ref, vmr_ref, & + kmajor, kminor_lower, kminor_upper, & + gas_minor, identifier_minor, & + minor_gases_lower, minor_gases_upper, & + scaling_gas_lower, scaling_gas_upper, & + minor_limits_gpt_lower, & + minor_limits_gpt_upper, & + minor_scales_with_density_lower, & + minor_scales_with_density_upper, & + scale_by_complement_lower, & + scale_by_complement_upper, & + kminor_start_lower, kminor_start_upper) + ! did not deallocate band2gpt because we want to use it later (changed it to intent(out), bpm) + if (allocated(optimal_angle_fit)) deallocate(optimal_angle_fit) + if (allocated(totplnk)) deallocate(totplnk) + if (allocated(planck_frac)) deallocate(planck_frac) + if (allocated(solar_src_quiet)) deallocate(solar_src_quiet) + if (allocated(solar_src_facular)) deallocate(solar_src_facular) + if (allocated(solar_src_sunspot)) deallocate(solar_src_sunspot) + if (allocated(rayl_lower)) deallocate(rayl_lower) + if (allocated(rayl_upper)) deallocate(rayl_upper) +end subroutine coefs_init + + + +subroutine set_available_gases(gases, gas_concentrations) + ! This subroutine is based on the E3SM implementation. -bpm + ! For each gas name in gases, initialize that gas in gas_concentrations. + use mo_gas_concentrations, only: ty_gas_concs + use mo_rrtmgp_util_string, only: lower_case + ! Arguments + type(ty_gas_concs), intent(inout) :: gas_concentrations + character(len=*), intent(in) :: gases(:) + ! Local + character(len=32), dimension(size(gases)) :: gases_lowercase + integer :: igas + character(len=128) :: error_msg + ! Initialize with lowercase gas names; we should work in lowercase + ! whenever possible because we cannot trust string comparisons in RRTMGP + ! to be case insensitive ... it *should* work regardless of case. + do igas = 1,size(gases) + gases_lowercase(igas) = trim(lower_case(gases(igas))) + end do + error_msg = gas_concentrations%init(gases_lowercase) + if (len_trim(error_msg) > 0) then + call endrun('Setting available gases. ERROR: '//trim(error_msg)) + end if +end subroutine set_available_gases + + +subroutine reset_fluxes(fluxes) + + use mo_fluxes_byband, only: ty_fluxes_byband + type(ty_fluxes_byband), intent(inout) :: fluxes + + ! Reset broadband fluxes + fluxes%flux_up(:,:) = 0._r8 + fluxes%flux_dn(:,:) = 0._r8 + fluxes%flux_net(:,:) = 0._r8 + if (associated(fluxes%flux_dn_dir)) then + fluxes%flux_dn_dir(:,:) = 0._r8 + end if + + ! Reset band-by-band fluxes + fluxes%bnd_flux_up(:,:,:) = 0._r8 + fluxes%bnd_flux_dn(:,:,:) = 0._r8 + fluxes%bnd_flux_net(:,:,:) = 0._r8 + if (associated(fluxes%bnd_flux_dn_dir)) then + fluxes%bnd_flux_dn_dir(:,:,:) = 0._r8 + end if + +end subroutine reset_fluxes + + +subroutine initialize_rrtmgp_fluxes(ncol, nlevels, nbands, fluxes, do_direct) + ! This closely follows the E3SM implementation. + use mo_fluxes_byband, only: ty_fluxes_byband + integer, intent(in) :: ncol, nlevels, nbands + type(ty_fluxes_byband), intent(inout) :: fluxes + logical, intent(in), optional :: do_direct + + logical :: do_direct_local + + if (present(do_direct)) then + do_direct_local = .true. + else + do_direct_local = .false. + end if + + ! Allocate flux arrays + ! NOTE: fluxes defined at interfaces, so need to either pass nlevels as + ! number of model levels plus one, or allocate as nlevels+1 if nlevels + ! represents number of model levels rather than number of interface levels. + + ! Broadband fluxes + allocate(fluxes%flux_up(ncol, nlevels)) + allocate(fluxes%flux_dn(ncol, nlevels)) + allocate(fluxes%flux_net(ncol, nlevels)) + if (do_direct_local) allocate(fluxes%flux_dn_dir(ncol, nlevels)) + + ! Fluxes by band + allocate(fluxes%bnd_flux_up(ncol, nlevels, nbands)) + allocate(fluxes%bnd_flux_dn(ncol, nlevels, nbands)) + allocate(fluxes%bnd_flux_net(ncol, nlevels, nbands)) + if (do_direct_local) allocate(fluxes%bnd_flux_dn_dir(ncol, nlevels, nbands)) + + ! Initialize + call reset_fluxes(fluxes) + +end subroutine initialize_rrtmgp_fluxes + + +subroutine initialize_rrtmgp_cloud_optics_sw(ncol, nlevels, kdist, optics) + ! use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp ! module level + use mo_optical_props, only: ty_optical_props_2str + + integer, intent(in) :: ncol, nlevels + type(ty_gas_optics_rrtmgp), intent(in) :: kdist + type(ty_optical_props_2str), intent(out) :: optics + + integer :: ngpt + character(len=128) :: errmsg + character(len=128) :: sub = 'initialize_rrtmgp_cloud_optics_sw' + + ! ngpt = kdist%get_ngpt() + + errmsg = optics%alloc_2str(ncol, nlevels, kdist, name='shortwave cloud optics') + if (len_trim(errmsg) > 0) then + call endrun(trim(sub)//': ERROR: optics%alloc_2str: '//trim(errmsg)) + end if + ! these are all expected to be shape (ncol, nlay, ngpt) + optics%tau = 0.0_r8 + optics%ssa = 1.0_r8 + optics%g = 0.0_r8 +end subroutine initialize_rrtmgp_cloud_optics_sw + + +subroutine initialize_rrtmgp_cloud_optics_lw(ncol, nlevels, kdist, optics) + ! use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp ! module level + use mo_optical_props, only: ty_optical_props_1scl + + integer, intent(in) :: ncol, nlevels + type(ty_gas_optics_rrtmgp), intent(in) :: kdist + type(ty_optical_props_1scl), intent(out) :: optics + + integer :: ngpt + character(len=128) :: errmsg + character(len=128) :: sub = 'initialize_rrtmgp_cloud_optics_lw' + + ngpt = kdist%get_ngpt() + errmsg =optics%alloc_1scl(ncol, nlevels, kdist, name='longwave cloud optics') + if (len_trim(errmsg) > 0) then + call endrun(trim(sub)//': ERROR: optics%init_1scalar: '//trim(errmsg)) + end if + optics%tau(:ncol, :nlevels, :ngpt) = 0.0 + +end subroutine initialize_rrtmgp_cloud_optics_lw + + +subroutine free_optics_sw(optics) + use mo_optical_props, only: ty_optical_props_2str + type(ty_optical_props_2str), intent(inout) :: optics + if (allocated(optics%tau)) deallocate(optics%tau) + if (allocated(optics%ssa)) deallocate(optics%ssa) + if (allocated(optics%g)) deallocate(optics%g) + call optics%finalize() +end subroutine free_optics_sw + + +subroutine free_optics_lw(optics) + use mo_optical_props, only: ty_optical_props_1scl + type(ty_optical_props_1scl), intent(inout) :: optics + if (allocated(optics%tau)) deallocate(optics%tau) + call optics%finalize() +end subroutine free_optics_lw + + +subroutine free_fluxes(fluxes) + use mo_fluxes_byband, only: ty_fluxes_byband + type(ty_fluxes_byband), intent(inout) :: fluxes + if (associated(fluxes%flux_up)) deallocate(fluxes%flux_up) + if (associated(fluxes%flux_dn)) deallocate(fluxes%flux_dn) + if (associated(fluxes%flux_net)) deallocate(fluxes%flux_net) + if (associated(fluxes%flux_dn_dir)) deallocate(fluxes%flux_dn_dir) + if (associated(fluxes%bnd_flux_up)) deallocate(fluxes%bnd_flux_up) + if (associated(fluxes%bnd_flux_dn)) deallocate(fluxes%bnd_flux_dn) + if (associated(fluxes%bnd_flux_net)) deallocate(fluxes%bnd_flux_net) + if (associated(fluxes%bnd_flux_dn_dir)) deallocate(fluxes%bnd_flux_dn_dir) +end subroutine free_fluxes + + +subroutine modified_cloud_fraction(cld, cldfsnow, cldfgrau, cldfsnow_idx, cldfgrau_idx, cldfprime) + real(r8), pointer :: cld(:,:) ! cloud fraction + real(r8), pointer :: cldfsnow(:,:) ! cloud fraction of just "snow clouds"- whatever they are + real(r8), pointer :: cldfgrau(:,:) ! cloud fraction of just "graupel clouds"- whatever they are + integer, intent(in) :: cldfsnow_idx ! physics buffer index for snow cloud fraction + integer, intent(in) :: cldfgrau_idx ! physics buffer index for graupel cloud fraction + real(r8), intent(inout) :: cldfprime(:,:) ! combined cloud fraction (snow plus regular) + integer :: k,i,ncol,nlev + + ! graupel_in_rad is module data from namelist. + ! pcols is "physics columns" and comes from module data. + ! pver is "physics vertical levels" and comes from module data. + + ! 1. initialize as cld + ! 2. check whether to modify for snow, where snow is, use max(cld, cldfsnow) + ! 3. check whether to modify for graupel, where graupel, use max(cldfprime, cldfgrau) + ! -- use cldfprime as it will already be modified for snow if necessary, and equal to cld if not. + + ncol = size(cld,1) + nlev = size(cld,2) + cldfprime(1:ncol, 1:nlev) = cld(1:ncol, 1:nlev) ! originally nlev here was pver + + if (cldfsnow_idx > 0) then + do k = 1, nlev + do i = 1, ncol + cldfprime(i,k) = max(cld(i,k), cldfsnow(i,k)) + end do + end do + else + cldfprime(:ncol,:) = cld(:ncol,:) + end if + + if (cldfgrau_idx > 0 .and. graupel_in_rad) then + do k = 1, nlev + do i = 1, ncol + cldfprime(i,k) = max(cldfprime(i,k), cldfgrau(i,k)) + end do + end do + end if + +end subroutine modified_cloud_fraction + +! +! a simple clipping subroutine +! +elemental subroutine clipper(scalar, minval, maxval) + real(r8), intent(inout) :: scalar + real(r8), intent(in) :: minval, maxval + if (minval < maxval) then + if (scalar < minval) then + scalar = minval + end if + if (scalar > maxval) then + scalar = maxval + end if + end if +end subroutine clipper + + +end module radiation + diff --git a/src/physics/rrtmgp/rrtmgp_driver.F90 b/src/physics/rrtmgp/rrtmgp_driver.F90 new file mode 100644 index 0000000000..12f16e7b5c --- /dev/null +++ b/src/physics/rrtmgp/rrtmgp_driver.F90 @@ -0,0 +1,386 @@ +! This code is based closely on mo_rrtmgp_clr_all_sky.F90 from +! RRTM for GCM Applications - Parallel (RRTMGP) +! +! Eli Mlawer and Robert Pincus +! Andre Wehe and Jennifer Delamere +! email: rrtmgp@aer.com +! +! Copyright 2017, Atmospheric and Environmental Research and +! Regents of the University of Colorado. All right reserved. +! +! Use and duplication is permitted under the terms of the +! BSD 3-clause license, see http://opensource.org/licenses/BSD-3-Clause +! + +! +! This module provides an interface to RRTMGP for a common use case -- +! users want to start from gas concentrations, pressures, and temperatures, +! and compute clear-sky (aerosol plus gases) and all-sky fluxes. +! The routines here have the same names as those in mo_rrtmgp_[ls]w; normally users +! will use either this module or the underling modules, but not both +! +module rrtmgp_driver + use mo_rte_kind, only: wp + ! use mo_gas_optics, only: ty_gas_optics ! replacing this with _rrtmgp version + + use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp + + use mo_gas_concentrations, only: ty_gas_concs + use mo_optical_props, only: ty_optical_props, & + ty_optical_props_arry, & + ty_optical_props_1scl, & + ty_optical_props_2str, & + ty_optical_props_nstr + use mo_source_functions, only: ty_source_func_lw + ! use mo_fluxes, only: ty_fluxes ! not needed b/c mo_fluxes_byband extends this type + use mo_fluxes_byband, only: ty_fluxes_byband + use mo_rte_lw, only: base_rte_lw => rte_lw + use mo_rte_sw, only: base_rte_sw => rte_sw + + use cam_logfile, only: iulog + + implicit none + private + + public :: rte_lw, rte_sw +contains + ! -------------------------------------------------- + ! + ! Interfaces using clear (gas + aerosol) and all-sky categories, starting from + ! pressures, temperatures, and gas amounts for the gas contribution + ! + ! -------------------------------------------------- + function rte_lw(k_dist, gas_concs, p_lay, t_lay, p_lev, & + t_sfc, sfc_emis, cloud_props, & + allsky_fluxes, clrsky_fluxes, & + aer_props, col_dry, t_lev, inc_flux, n_gauss_angles) result(error_msg) + ! class(ty_gas_optics), intent(in ) :: k_dist !< derived type with spectral information + class(ty_gas_optics_rrtmgp), intent(in ) :: k_dist !< derived type with spectral information + + type(ty_gas_concs), intent(in ) :: gas_concs !< derived type encapsulating gas concentrations + real(wp), dimension(:,:), intent(in ) :: p_lay, t_lay !< pressure [Pa], temperature [K] at layer centers (ncol,nlay) + real(wp), dimension(:,:), intent(in ) :: p_lev !< pressure at levels/interfaces [Pa] (ncol,nlay+1) + real(wp), dimension(:), intent(in ) :: t_sfc !< surface temperature [K] (ncol) + real(wp), dimension(:,:), intent(in ) :: sfc_emis !< emissivity at surface [] (nband, ncol) + class(ty_optical_props_arry), intent(in ) :: cloud_props !< cloud optical properties (ncol,nlay,ngpt) + class(ty_fluxes_byband), intent(inout) :: allsky_fluxes, clrsky_fluxes ! 3/21 - _byband bpm + + ! Optional inputs + class(ty_optical_props_arry), & + optional, intent(in ) :: aer_props !< aerosol optical properties + real(wp), dimension(:,:), & + optional, intent(in ) :: col_dry !< Molecular number density (ncol, nlay) + real(wp), dimension(:,:), target, & + optional, intent(in ) :: t_lev !< temperature at levels [K] (ncol, nlay+1) + real(wp), dimension(:,:), target, & + optional, intent(in ) :: inc_flux !< incident flux at domain top [W/m2] (ncol, ngpts) + integer, optional, intent(in ) :: n_gauss_angles ! Number of angles used in Gaussian quadrature (no-scattering solution) + character(len=128) :: error_msg + ! -------------------------------- + ! Local variables + ! + class(ty_optical_props_arry), allocatable :: optical_props + type(ty_source_func_lw) :: sources + + integer :: ncol, nlay, ngpt, nband, nstr + logical :: top_at_1 + ! -------------------------------- + ! Problem sizes + ! + + error_msg = "" + + ncol = size(p_lay, 1) + nlay = size(p_lay, 2) + ngpt = k_dist%get_ngpt() + nband = k_dist%get_nband() + + !$acc kernels copyout(top_at_1) + !$omp target map(from:top_at_1) + top_at_1 = p_lay(1, 1) < p_lay(1, nlay) + !$acc end kernels + !$omp end target + + ! ------------------------------------------------------------------------------------ + ! Error checking + ! + if(present(aer_props)) then + if(any([aer_props%get_ncol(), & + aer_props%get_nlay()] /= [ncol, nlay])) & + error_msg = "rrtmpg_lw: aerosol properties inconsistently sized" + if(.not. any(aer_props%get_ngpt() /= [ngpt, nband])) & + error_msg = "rrtmpg_lw: aerosol properties inconsistently sized" + end if + + if(present(t_lev)) then + if(any([size(t_lev, 1), & + size(t_lev, 2)] /= [ncol, nlay+1])) & + error_msg = "rrtmpg_lw: t_lev inconsistently sized" + end if + + if(present(inc_flux)) then + if(any([size(inc_flux, 1), & + size(inc_flux, 2)] /= [ncol, ngpt])) & + error_msg = "rrtmpg_lw: incident flux inconsistently sized" + end if + if(len_trim(error_msg) > 0) return + + ! ------------------------------------------------------------------------------------ + ! Optical properties arrays + ! + select type(cloud_props) + class is (ty_optical_props_1scl) ! No scattering + allocate(ty_optical_props_1scl::optical_props) + class is (ty_optical_props_2str) + allocate(ty_optical_props_2str::optical_props) + class is (ty_optical_props_nstr) + allocate(ty_optical_props_nstr::optical_props) + nstr = size(cloud_props%tau,1) + end select + + error_msg = optical_props%init(k_dist) + + if(len_trim(error_msg) > 0) return + select type (optical_props) + class is (ty_optical_props_1scl) ! No scattering + error_msg = optical_props%alloc_1scl(ncol, nlay) + class is (ty_optical_props_2str) + error_msg = optical_props%alloc_2str(ncol, nlay) + class is (ty_optical_props_nstr) + error_msg = optical_props%alloc_nstr(nstr, ncol, nlay) + end select + if (error_msg /= '') return + + ! + ! Source function + ! + error_msg = sources%init(k_dist) + error_msg = sources%alloc(ncol, nlay) + if (error_msg /= '') return + + ! ------------------------------------------------------------------------------------ + ! Clear skies + ! + ! Gas optical depth -- pressure need to be expressed as Pa + ! + error_msg = k_dist%gas_optics(p_lay, p_lev, t_lay, t_sfc, gas_concs, & + optical_props, sources) !, & + ! col_dry, t_lev) + ! col_dry & t_lev are optional, and we have not provided them. + if (error_msg /= '') then + return + end if + + ! ---------------------------------------------------- + ! Clear sky is gases + aerosols (if they're supplied) + ! + if (present(aer_props)) then + error_msg = aer_props%increment(optical_props) + end if + if (error_msg /= '') then + return + end if + + error_msg = base_rte_lw(optical_props, top_at_1, sources, & + sfc_emis, clrsky_fluxes, & + inc_flux, n_gauss_angles) + if (error_msg /= '') then + return + end if + + ! ------------------------------------------------------------------------------------ + ! All-sky fluxes = clear skies + clouds + ! + error_msg = cloud_props%increment(optical_props) + if(error_msg /= '') return + + error_msg = base_rte_lw(optical_props, top_at_1, sources, & + sfc_emis, allsky_fluxes, & + inc_flux, n_gauss_angles) + + call sources%finalize() + call optical_props%finalize() + + end function rte_lw + ! -------------------------------------------------- + ! -------------------------------------------------- + ! -------------------------------------------------- + function rte_sw(k_dist, & + gas_concs, & + p_lay, & + t_lay, & + p_lev, & + mu0, & + sfc_alb_dir, & + sfc_alb_dif, & + cloud_props, & + allsky_fluxes, & + clrsky_fluxes, & + aer_props, & + col_dry, & + inc_flux, & !< optional input: total solar irradiance (ncol, ngpt) + tsi_scaling, & !< optional input: scalar scaling factor for TSI + tsi_scaling_gpt & !< optional input: scaling for TSI by gpt + ) result(error_msg) + class(ty_gas_optics_rrtmgp), intent(in ) :: k_dist !< derived type with spectral information + + type(ty_gas_concs), intent(in ) :: gas_concs !< derived type encapsulating gas concentrations + real(wp), dimension(:,:), intent(in ) :: p_lay, t_lay !< pressure [Pa], temperature [K] at layer centers (ncol,nlay) + real(wp), dimension(:,:), intent(in ) :: p_lev !< pressure at levels/interfaces [Pa] (ncol,nlay+1) + real(wp), dimension(: ), intent(in ) :: mu0 !< cosine of solar zenith angle + real(wp), dimension(:,:), intent(in ) :: sfc_alb_dir, sfc_alb_dif + ! surface albedo for direct and diffuse radiation (band, col) + class(ty_optical_props_arry), intent(in ) :: cloud_props !< cloud optical properties (ncol,nlay,ngpt) + class(ty_fluxes_byband), intent(inout) :: allsky_fluxes, clrsky_fluxes + + ! Optional inputs + class(ty_optical_props_arry), target, & + optional, intent(in ) :: aer_props !< aerosol optical properties + real(wp), dimension(:,:), & + optional, intent(in ) :: col_dry, & !< Molecular number density (ncol, nlay) + inc_flux !< incident flux at domain top [W/m2] (ncol, ngpts) + real(wp), optional, intent(in ) :: tsi_scaling !< Optional scaling for total solar irradiance (SCALAR) + real(wp), dimension(:), optional, intent(in ) :: tsi_scaling_gpt !< Optional scaling of solar irradiance by gpoint + + + character(len=128) :: error_msg + ! -------------------------------- + ! Local variables + ! + class(ty_optical_props_arry), allocatable :: optical_props + real(wp), dimension(:,:), allocatable :: toa_flux + integer :: ncol, nlay, ngpt, nband, nstr + integer :: icol + logical :: top_at_1 + ! -------------------------------- + ! Problem sizes + ! + + error_msg = "" + + ncol = size(p_lay, 1) + nlay = size(p_lay, 2) + ngpt = k_dist%get_ngpt() + nband = k_dist%get_nband() + + top_at_1 = p_lay(1, 1) < p_lay(1, nlay) + + ! ------------------------------------------------------------------------------------ + ! Error checking + ! + if(present(aer_props)) then + if(any([aer_props%get_ncol(), & + aer_props%get_nlay()] /= [ncol, nlay])) & + error_msg = "rrtmgp_driver rte_sw: aerosol properties inconsistently sized" + if(.not. any(aer_props%get_ngpt() /= [ngpt, nband])) & + error_msg = "rrtmgp_driver rte_sw: aerosol properties inconsistently sized" + end if + + if (present(tsi_scaling) .and. (present(tsi_scaling_gpt))) then + error_msg = "rrtmgp_driver rte_sw: Only one of [tsi_scaling, tsi_scaling_gpt] may be specified." + end if + + if(present(tsi_scaling)) then + if(tsi_scaling <= 0._wp) then + error_msg = "rrtmgp_driver rte_sw: tsi_scaling is < 0" + end if + end if + + if(present(inc_flux)) then + if(any([size(inc_flux, 1), size(inc_flux, 2)] /= [ncol, ngpt])) then + error_msg = "rrtmgp_driver rte_sw: incident flux inconsistently sized" + end if + end if + if(len_trim(error_msg) > 0) return + + ! ------------------------------------------------------------------------------------ + ! + ! Optical properties arrays + ! + select type(cloud_props) + class is (ty_optical_props_1scl) ! No scattering + allocate(ty_optical_props_1scl::optical_props) + class is (ty_optical_props_2str) + allocate(ty_optical_props_2str::optical_props) + class is (ty_optical_props_nstr) + allocate(ty_optical_props_nstr::optical_props) + nstr = cloud_props%get_nmom() + end select + + error_msg = optical_props%init(k_dist%get_band_lims_wavenumber(), & + k_dist%get_band_lims_gpoint()) + if(len_trim(error_msg) > 0) return + select type (optical_props) + class is (ty_optical_props_1scl) ! No scattering + error_msg = optical_props%alloc_1scl(ncol, nlay) + class is (ty_optical_props_2str) + error_msg = optical_props%alloc_2str(ncol, nlay) + class is (ty_optical_props_nstr) + error_msg = optical_props%alloc_nstr(nstr, ncol, nlay) + end select + if (error_msg /= '') return + + allocate(toa_flux(ncol, ngpt)) + ! ------------------------------------------------------------------------------------ + ! Clear skies + ! + ! Gas optical depth -- pressure need to be expressed as Pa + ! + error_msg = k_dist%gas_optics(p_lay, p_lev, t_lay, gas_concs, & + optical_props, toa_flux) ! , & + ! col_dry) + ! col_dry is optional and we have not provided it. + if (error_msg /= '') return + ! + ! If users have supplied an incident flux, use that + ! + if (present(inc_flux)) then + toa_flux(:,:) = inc_flux(:,:) + end if + ! + ! If there is a scaling provided, apply it + ! + if(present(tsi_scaling)) toa_flux(:,:) = toa_flux(:,:) * tsi_scaling + + if(present(tsi_scaling_gpt)) then + do icol = 1,ncol + toa_flux(icol,:) = toa_flux(icol,:) * tsi_scaling_gpt + end do + end if + ! ---------------------------------------------------- + ! Clear sky is gases + aerosols (if they're supplied) + ! + if(present(aer_props)) error_msg = aer_props%increment(optical_props) + if(error_msg /= '') return + + error_msg = base_rte_sw(optical_props, top_at_1, & + mu0, toa_flux, & + sfc_alb_dir, sfc_alb_dif, & + clrsky_fluxes) + + if(error_msg /= '') return + ! ------------------------------------------------------------------------------------ + ! All-sky fluxes = clear skies + clouds + ! + error_msg = cloud_props%increment(optical_props) + if (error_msg /= '') then + return + end if + + error_msg = base_rte_sw(optical_props, & ! (in) Optical properties provided as arrays + top_at_1, & ! (in) Is the top of the domain at index 1? + mu0, & ! (in) cosine of solar zenith angle (ncol) + toa_flux, & ! (in) incident flux at top of domain [W/m2] (ncol, ngpt) + sfc_alb_dir, & ! (in) surface albedo, direct (nband, ncol) + sfc_alb_dif, & ! (in) surface albedo, diffuse (nband, ncol) + allsky_fluxes & ! (inout) Class describing output calculations (ty_fluxes_byband) + ) + + + call optical_props%finalize() + if (allocated(toa_flux)) then + deallocate(toa_flux) + end if + end function rte_sw + +end module rrtmgp_driver diff --git a/src/physics/rrtmgp/rrtmgp_inputs.F90 b/src/physics/rrtmgp/rrtmgp_inputs.F90 new file mode 100644 index 0000000000..90d87fcf07 --- /dev/null +++ b/src/physics/rrtmgp/rrtmgp_inputs.F90 @@ -0,0 +1,838 @@ +module rrtmgp_inputs + +!-------------------------------------------------------------------------------- +! Transform data for state inputs from CAM's data structures to those used by +! RRTMGP. Subset the number of model levels if CAM's top exceeds RRTMGP's +! valid domain. +! +! This code is currently set up to send RRTMGP vertical layers ordered bottom +! to top of model. Although the RRTMGP is supposed to be agnostic about the +! vertical ordering problems have arisen trying to use the top to bottom order +! as used by CAM's infrastructure. +! +!-------------------------------------------------------------------------------- + +use shr_kind_mod, only: r8=>shr_kind_r8 +use ppgrid, only: pcols, pver, pverp + +use physconst, only: stebol + +use physics_types, only: physics_state +use physics_buffer, only: physics_buffer_desc +use camsrfexch, only: cam_in_t + +use radconstants, only: get_ref_solar_band_irrad, rad_gas_index +use radconstants, only: nradgas, gaslist, rrtmg_to_rrtmgp_swbands +use rad_solar_var, only: get_variability +use solar_irrad_data, only : do_spctrl_scaling, sol_tsi +use rad_constituents, only: rad_cnst_get_gas + +use mcica_subcol_gen, only: mcica_subcol_sw, mcica_subcol_lw + +use mo_gas_concentrations, only: ty_gas_concs +use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp +use mo_optical_props, only: ty_optical_props, ty_optical_props_2str, ty_optical_props_1scl + +! unneeded use mo_rrtmgp_util_string, only: lower_case +use cam_logfile, only: iulog +use cam_abortutils, only: endrun + +use cam_history, only: outfld ! just for getting ozone VMR above model top. +use b_checker, only: assert_shape ! checking on shapes + +implicit none +private +save + +public :: & + rrtmgp_inputs_init, & + rrtmgp_set_state, & + rrtmgp_set_gases_lw, & + rrtmgp_set_gases_sw, & + rrtmgp_set_cloud_lw, & + rrtmgp_set_cloud_sw, & + rrtmgp_set_aer_lw, & + rrtmgp_set_aer_sw + +real(r8), parameter :: cldmin = 1.0e-80_r8 ! min cloud fraction + +real(r8), parameter :: amdw = 1.607793_r8 ! Molecular weight of dry air / water vapor +real(r8), parameter :: amdc = 0.658114_r8 ! Molecular weight of dry air / carbon dioxide +real(r8), parameter :: amdo = 0.603428_r8 ! Molecular weight of dry air / ozone +real(r8), parameter :: amdm = 1.805423_r8 ! Molecular weight of dry air / methane +real(r8), parameter :: amdn = 0.658090_r8 ! Molecular weight of dry air / nitrous oxide +real(r8), parameter :: amdo2 = 0.905140_r8 ! Molecular weight of dry air / oxygen +real(r8), parameter :: amdc1 = 0.210852_r8 ! Molecular weight of dry air / CFC11 +real(r8), parameter :: amdc2 = 0.239546_r8 ! Molecular weight of dry air / CFC12 + +! Indices for copying data between cam and rrtmgp arrays +! Assume the rrtmgp vertical index goes bottom to top of atm +integer :: ktopcamm ! cam index of top layer +integer :: ktopradm ! rrtmgp index of layer corresponding to ktopcamm +integer :: ktopcami ! cam index of top interface +integer :: ktopradi ! rrtmgp index of interface corresponding to ktopcami + +!================================================================================================== +contains +!================================================================================================== + +subroutine rrtmgp_inputs_init(ktcamm, ktradm, ktcami, ktradi) + + integer, intent(in) :: ktcamm + integer, intent(in) :: ktradm + integer, intent(in) :: ktcami + integer, intent(in) :: ktradi + + ktopcamm = ktcamm + ktopradm = ktradm + ktopcami = ktcami + ktopradi = ktradi + +end subroutine rrtmgp_inputs_init + +!================================================================================================== + +subroutine rrtmgp_set_state( & + pstate, cam_in, ncol, nlay, nlwbands, & + nswbands, ngpt_sw, nday, idxday, coszrs, & + kdist_sw, & ! eccf, & !!! Removing eccf from arguments, as it is not needed here + band2gpt_sw, & + t_sfc, emis_sfc, t_rad, & + pmid_rad, pint_rad, t_day, pmid_day, pint_day, & + coszrs_day, alb_dir, alb_dif, tsi) + + ! arguments + type(physics_state), target, intent(in) :: pstate + type(cam_in_t), intent(in) :: cam_in + integer, intent(in) :: ncol + integer, intent(in) :: nlay + integer, intent(in) :: nlwbands + integer, intent(in) :: nswbands + integer, intent(in) :: ngpt_sw + integer, intent(in) :: nday + integer, intent(in) :: idxday(:) + real(r8), intent(in) :: coszrs(:) + ! real(r8), intent(in) :: eccf ! Earth orbit eccentricity factor + integer, intent(in) :: band2gpt_sw(:,:) !< (2, nswbands) + + class(ty_gas_optics_rrtmgp), intent(in) :: kdist_sw ! spectral information +!!! CHECK pcols vs ncol !!! + real(r8), intent(out) :: t_sfc(ncol) ! surface temperature [K] + real(r8), intent(out) :: emis_sfc(nlwbands,ncol) ! emissivity at surface [] + real(r8), intent(out) :: t_rad(ncol,nlay) ! layer midpoint temperatures [K] + real(r8), intent(out) :: pmid_rad(ncol,nlay) ! layer midpoint pressures [Pa] + real(r8), intent(out) :: pint_rad(ncol,nlay+1) ! layer interface pressures [Pa] + real(r8), intent(out) :: t_day(nday,nlay) ! layer midpoint temperatures [K] + real(r8), intent(out) :: pmid_day(nday,nlay) ! layer midpoint pressure [Pa] + real(r8), intent(out) :: pint_day(nday,nlay+1) ! layer interface pressures [Pa] + real(r8), intent(out) :: coszrs_day(nday) ! cosine of solar zenith angle + real(r8), intent(out) :: alb_dir(nswbands,nday) ! surface albedo, direct radiation + real(r8), intent(out) :: alb_dif(nswbands,nday) ! surface albedo, diffuse radiation + ! real(r8), intent(out) :: solin(ncol) ! incident flux at domain top [W/m2] + ! real(r8), intent(out) :: solar_irrad_gpt(nday,ngpt_sw) ! incident flux at domain top per gpoint [W/m2] AT DAYLIT POINTS + ! real(r8), intent(out) :: tsi_scaling_gpt(ngpt_sw) ! scale factor for irradiance by gpoint [fraction] + real(r8), intent(out) :: tsi ! total irradiance W/m2 + + ! local variables + integer :: k, kk, i, iband + + real(r8) :: solar_band_irrad(nswbands) ! specified solar irradiance in each sw band (per radconstants) + + real(r8) :: sfac(nswbands) ! time varying scaling factors due to Solar Spectral + ! Irrad at 1 A.U. per band + real(r8) :: wavenumber_limits(2,nswbands) + + ! real(r8) :: toa_flx_by_band(nswbands) ! temporary array of incoming flux by band + ! real(r8) :: toa_flx_by_gpt(ngpt_sw) ! temporary array of incoming flux by gpt + + character(len=*), parameter :: sub='rrtmgp_set_state' + character(len=512) :: errmsg + !-------------------------------------------------------------------------------- + + ! + ! bpm note: the size of pstate%t 's 1st dimension can be larger than ncol. Assume we are only interested in 1:ncol. + ! + ! call assert_shape(pstate%t, (/ncol, pver/), errmsg) + ! if (len_trim(errmsg) > 0) then + ! write(iulog,*) '['//sub//'] : pstate%t -- shape: ',SHAPE(pstate%t),'[EXPECTED: (',ncol,'x',pver,')] max: ',maxval(pstate%t),' min: ',minval(pstate%t) + ! call endrun(sub//trim(errmsg)) + ! end if + ! call assert_shape(pstate%pmid, (/ncol, pver/), errmsg) + ! if (len_trim(errmsg) > 0) then + ! write(iulog,*) '['//sub//'] : pstate%pmid -- shape: ',SHAPE(pstate%pmid),' max: ',maxval(pstate%pmid),' min: ',minval(pstate%pmid) + ! call endrun(sub//trim(errmsg)) + ! end if + ! call assert_shape(pstate%pint, (/ncol, pverp/), errmsg) + ! if (len_trim(errmsg) > 0) then + ! write(iulog,*) '['//sub//'] : pstate%pint -- shape: ',SHAPE(pstate%pint),' max: ',maxval(pstate%pint),' min: ',minval(pstate%pint) + ! call endrun(sub//trim(errmsg)) + ! end if + + t_sfc = sqrt(sqrt(cam_in%lwup(:ncol)/stebol)) ! Surface temp set based on longwave up flux. + + ! Set surface emissivity to 1.0. + ! The land model *does* have its own surface emissivity, but is not spectrally resolved. + ! The LW upward flux is calculated with that land emissivity, and the "radiative temperature" t_sfc is derived + ! from that flux. We assume, therefore, that the emissivity is unity to be consistent with t_sfc. + emis_sfc(:,:) = 1._r8 + + + ! Assume level ordering is the same for both CAM and RAD (top to bottom) + if (nlay == pver) then + t_rad(:ncol, :) = pstate%t(:ncol, :) + pmid_rad(:ncol, :) = pstate%pmid(:ncol, :) + pint_rad(:ncol, :) = pstate%pint(:ncol, :) + else if (nlay < pver) then + t_rad(:ncol, :) = pstate%t(:ncol, pver-nlay+1:pver) + pmid_rad(:ncol, :) = pstate%pmid(:ncol, pver-nlay+1:pver) + pint_rad(:ncol, :) = pstate%pint(:ncol, pver-nlay+1:pverp) + else if (nlay > pver) then + t_rad(:ncol, nlay-pver+1:) = pstate%t(:ncol, :) + pmid_rad(:ncol, nlay-pver+1:) = pstate%pmid(:ncol, :) + pint_rad(:ncol, nlay-pver+1:) = pstate%pint(:ncol, :) + end if + + + if (nlay == pverp) then + ! add midpoint and top interface values for extra layer + t_rad(:,1) = pstate%t(:ncol,1) + pmid_rad(:,1) = 0.5_r8 * pstate%pint(:ncol,1) + + ! pint_rad(:,nlay+1) = 1.e-2_r8 ! rrtmg value (in hPa?) + pint_rad(:,1) = 1.01_r8 ! in Pa + else if (nlay > pverp) then + call endrun(sub//': ERROR: radiation should not have more layers than CAM has interfaces') + end if + + ! properties needed at day columns + do i = 1, nday + t_day(i,:) = t_rad(idxday(i),:) + pmid_day(i,:) = pmid_rad(idxday(i),:) + pint_day(i,:) = pint_rad(idxday(i),:) + coszrs_day(i) = coszrs(idxday(i)) + end do + + + ! total solar incident radiation + tsi = sol_tsi ! when using sol_tsi from solar_irrad_data, this is read from a file. + + ! TO BE REMOVED + ! We can get TSI from the solar forcing file (above). + ! We can't get the scaling here because we might not have access + ! to RRTMGP's reference irradiance on bands yet (without running kdist%gas_optics). + ! The scaling can be derived in rrtmgp_driver / rte_sw (after %gas_optics provides the toa_flux). + ! call get_ref_solar_band_irrad(solar_band_irrad) + ! call get_variability(sfac) + ! solar_band_irrad = solar_band_irrad(rrtmg_to_rrtmgp_swbands) + ! tsi = sum(solar_band_irrad(:)) ! total TSI integrated across bands, BUT NOT scaled for variability + ! ! convert from irradiance scale factor per band (sfac) to per gpoint + ! ! --> this can then be used in rrtmgp_driver module, rte_sw to scale TOA flux + ! tsi_scaling_gpt = 0.0 + + ! do iband = 1,nswbands + ! tsi_scaling_gpt(band2gpt_sw(1,iband):band2gpt_sw(2,iband)) = sfac(iband) + ! end do + + ! if we had a method to produce toa flux by gpoint, we could make that an output here. + + ! <-- begin: old way of setting albedo hard-wired to 14 SW bands --> + ! ! Surface albedo (band mapping is hardcoded for RRTMG(P) code) + ! ! This mapping assumes nswbands=14. + ! if (nswbands /= 14) & + ! call endrun(sub//': ERROR: albedo band mapping assumes nswbands=14') + + ! do i = 1, nday + ! ! Near-IR bands (1-9 and 14), 820-16000 cm-1, 0.625-12.195 microns + ! alb_dir(1:8,i) = cam_in%aldir(idxday(i)) + ! alb_dif(1:8,i) = cam_in%aldif(idxday(i)) + ! alb_dir(14,i) = cam_in%aldir(idxday(i)) + ! alb_dif(14,i) = cam_in%aldif(idxday(i)) + + ! ! Set band 24 (or, band 9 counting from 1) to use linear average of UV/visible + ! ! and near-IR values, since this band straddles 0.7 microns: + ! alb_dir(9,i) = 0.5_r8*(cam_in%aldir(idxday(i)) + cam_in%asdir(idxday(i))) + ! alb_dif(9,i) = 0.5_r8*(cam_in%aldif(idxday(i)) + cam_in%asdif(idxday(i))) + + ! ! UV/visible bands 25-28 (10-13), 16000-50000 cm-1, 0.200-0.625 micron + ! alb_dir(10:13,i) = cam_in%asdir(idxday(i)) + ! alb_dif(10:13,i) = cam_in%asdif(idxday(i)) + ! enddo + ! <-- end: old way of setting albedo hard-wired to 14 SW bands --> + + ! More flexible way to assign albedo (from E3SM implementation) + ! adapted here to loop over bands and cols b/c cam_in has all cols but albedos are daylit cols + ! We could remove cols loop if we just set albedos for all columns separate from rrtmgp_set_state. + ! Albedos are input as broadband (visible, and near-IR), and we need to map + ! these to appropriate bands. Bands are categorized broadly as "visible" or + ! "infrared" based on wavenumber, so we get the wavenumber limits here + wavenumber_limits = kdist_sw%get_band_lims_wavenumber() + ! Loop over bands, and determine for each band whether it is broadly in the + ! visible or infrared part of the spectrum (visible or "not visible") + do iband = 1,nswbands + if (is_visible(wavenumber_limits(1,iband)) .and. & + is_visible(wavenumber_limits(2,iband))) then + + ! Entire band is in the visible + do i = 1, nday + alb_dir(iband,i) = cam_in%asdir(idxday(i)) + alb_dif(iband,i) = cam_in%asdif(idxday(i)) + end do + + else if (.not.is_visible(wavenumber_limits(1,iband)) .and. & + .not.is_visible(wavenumber_limits(2,iband))) then + ! Entire band is in the longwave (near-infrared) + do i = 1, nday + alb_dir(iband,i) = cam_in%aldir(idxday(i)) + alb_dif(iband,i) = cam_in%aldif(idxday(i)) + end do + else + ! Band straddles the visible to near-infrared transition, so we take + ! the albedo to be the average of the visible and near-infrared + ! broadband albedos + do i = 1, nday + alb_dir(iband,i) = 0.5 * (cam_in%aldir(idxday(i)) + cam_in%asdir(idxday(i))) + alb_dif(iband,i) = 0.5 * (cam_in%aldif(idxday(i)) + cam_in%asdif(idxday(i))) + end do + end if + end do + + + ! Strictly enforce albedo bounds + where (alb_dir < 0) + alb_dir = 0.0_r8 + end where + where (alb_dir > 1) + alb_dir = 1.0_r8 + end where + where (alb_dif < 0) + alb_dif = 0.0_r8 + end where + where (alb_dif > 1) + alb_dif = 1.0_r8 + end where + +end subroutine rrtmgp_set_state +! + +! Function to check if a wavenumber is in the visible or IR +logical function is_visible(wavenumber) + + ! wavenumber in inverse cm (cm^-1) + real(r8), intent(in) :: wavenumber + + ! Threshold between visible and infrared is 0.7 micron, or 14286 cm^-1 + real(r8), parameter :: visible_wavenumber_threshold = 14286._r8 ! cm^-1 + + ! Wavenumber is in the visible if it is above the visible threshold + ! wavenumber, and in the infrared if it is below the threshold + if (wavenumber > visible_wavenumber_threshold) then + is_visible = .true. + else + is_visible = .false. + end if + +end function is_visible + + +!================================================================================================== +function get_molar_mass_ratio(gas_name) result(massratio) + ! return the molar mass ratio of dry air to gas based on gas_name + character(len=*),intent(in) :: gas_name + real(r8) :: massratio + + select case (trim(gas_name)) + case ('h2o', 'H2O') + massratio = 1.607793_r8 + case ('co2', 'CO2') + massratio = 0.658114_r8 + case ('o3', 'O3') + massratio = 0.603428_r8 + case ('ch4', 'CH4') + massratio = 1.805423_r8 + case ('n2o', 'N2O') + massratio = 0.658090_r8 + case ('o2', 'O2') + massratio = 0.905140_r8 + case ('cfc11', 'CFC11') + massratio = 0.210852_r8 + case ('cfc12', 'CFC12') + massratio = 0.239546_r8 + case default + call endrun("Invalid gas: "//trim(gas_name)) + end select +end function get_molar_mass_ratio + +subroutine rad_gas_get_vmr(icall, gas_name, pstate, pbuf, nlay, numactivecols, gas_concs, indices) + ! provides volume mixing ratio into gas_concs data structure + ! Assumes gas_name will be found with rad_cnst_get_gas(). + integer, intent(in) :: icall ! index of climate/diagnostic radiation call + character(len=*), intent(in) :: gas_name + type(physics_state), target, intent(in) :: pstate + type(physics_buffer_desc), pointer :: pbuf(:) + integer, intent(in) :: nlay ! number of layers in radiation calculation + integer, intent(in) :: numactivecols ! number of columns, ncol for LW, nday for SW + + type(ty_gas_concs), intent(inout) :: gas_concs ! the result is VRM inside gas_concs + + integer, intent(in), OPTIONAL :: indices(:) ! this would be idxday, providing the indices of the active columns + + ! local + real(r8), pointer :: gas_mmr(:,:) + real(r8), allocatable :: gas_vmr(:,:) + character(len=128) :: errmsg + real(r8), allocatable :: mmr(:,:) + character(len=*), parameter :: sub = 'rad_gas_get_vmr' + ! -- for ozone profile above model + real(r8), allocatable :: P_int(:), P_mid(:), alpha(:), beta(:), a(:), b(:), chi_mid(:), chi_0(:), chi_eff(:) + real(r8) :: P_top + integer :: idx(numactivecols) + integer :: i + real(r8) :: alpha_value + real(r8) :: amdo !! alpha_value of ozone + + + allocate(mmr(numactivecols, nlay)) + allocate(gas_vmr(numactivecols, nlay)) + + call rad_cnst_get_gas(icall, gas_name, pstate, pbuf, gas_mmr) + ! copy the gas and actually convert to mmr in case of H2O (specific to mixing ratio) + + mmr = gas_mmr + ! special case: H2O is specific humidity, not mixing ratio. Use r = q/(1-q): + if (gas_name == 'h2o') then + mmr = mmr / (1._r8 - mmr) + end if + + ! convert MMR to VMR, multipy by ratio of dry air molar mas to gas molar mass. + alpha_value = get_molar_mass_ratio(gas_name) + + ! set the column indices; when indices is provided (e.g. daylit columns) use them, otherwise just count. + do i = 1,numactivecols + if (present(indices)) then + idx(i) = indices(i) + else + idx(i) = i + end if + end do + + + if (nlay == pver) then + do i = 1,numactivecols + gas_vmr(i, :pver) = mmr(idx(i),:pver) * alpha_value + end do + else if (nlay < pver) then ! radiation calculation doesn't go through atmospheric depth + do i = 1,numactivecols + gas_vmr(i,nlay+1-pver:) = mmr(idx(i),:pver) * alpha_value + end do + else if (nlay > pver) then ! radiation has more layers than atmosphere --> only one extra layer allowed, so could say gas_vmr(:ncol, 2:) = gas_mmr(:ncol, :pver)*amdc + do i = 1,numactivecols + gas_vmr(i,nlay+1-pver:) = mmr(idx(i),:pver) * alpha_value + end do + if (nlay == pverp) then + gas_vmr(:,1) = gas_vmr(:,nlay+1-pver) + else + call endrun(sub//': Radiation can not have more than 1 extra layer.') + end if + end if + + ! special case: O3 + ! + ! """ + ! For the purpose of attenuating solar fluxes above the CAM model top, we assume that ozone + ! mixing decreases linearly in each column from the value in the top layer of CAM to zero at + ! the pressure level set by P_top. P_top has been set to 50 Pa (0.5 hPa) based on model tuning + ! to produce temperatures at the top of CAM that are most consistent with WACCM at similar pressure levels. + ! """ + if ((gas_name == 'O3') .and. (nlay == pverp)) then + allocate(P_int(numactivecols), P_mid(numactivecols), alpha(numactivecols), beta(numactivecols), a(numactivecols), b(numactivecols), chi_mid(numactivecols), chi_0(numactivecols), chi_eff(numactivecols)) + amdo = get_molar_mass_ratio('O3') + do i = 1, numactivecols + P_top = 50.0_r8 ! pressure (Pa) at which we assume O3 = 0 in linear decay from CAM top + P_int(i) = pstate%pint(idx(i),1) ! pressure (Pa) at upper interface of CAM + P_mid(i) = pstate%pmid(idx(i),1) ! pressure (Pa) at midpoint of top layer of CAM + alpha(i) = 0.0_r8 + beta(i) = 0.0_r8 + alpha(i) = log(P_int(i)/P_top) + beta(i) = log(P_mid(i)/P_int(i))/log(P_mid(i)/P_top) + + a(i) = ( (1._r8 + alpha(i)) * exp(-alpha(i)) - 1._r8 ) / alpha(i) + b(i) = 1._r8 - exp(-alpha(i)) + + if (alpha(i) .gt. 0) then ! only apply where top level is below 80 km + chi_mid(i) = mmr(i,1)*amdo ! molar mixing ratio of O3 at midpoint of top layer + chi_0(i) = chi_mid(i) / (1._r8 + beta(i)) + chi_eff(i) = chi_0(i) * (a(i) + b(i)) + gas_vmr(i,1) = chi_eff(i) + chi_eff(i) = chi_eff(i) * P_int(i) / amdo / 9.8_r8 ! O3 column above in kg m-2 + chi_eff(i) = chi_eff(i) / 2.1415e-5_r8 ! O3 column above in DU + end if + end do + deallocate(P_int, P_mid, alpha, beta, a, b, chi_mid, chi_0, chi_eff) + end if + + ! other special cases: + ! N2 and CO: If these are in the gas list, would set them to constants + ! as in E3SM. Currently, these will abort run because they are not found by rad_cnst_get_gas. + ! So while RTE-RRTMGP can cope with them, we do not use them for radiation at this time. + + errmsg = gas_concs%set_vmr(gas_name, gas_vmr) + if (len_trim(errmsg) > 0) then + call endrun(sub//': error setting CO2: '//trim(errmsg)) + end if + + deallocate(gas_vmr) + deallocate(mmr) + +end subroutine rad_gas_get_vmr + +!================================================================================================== + +subroutine rrtmgp_set_gases_lw(icall, pstate, pbuf, nlay, gas_concs) + + ! The gases in the LW coefficients file are: + ! H2O, CO2, O3, N2O, CO, CH4, O2, N2 + ! But we only use the gases in the radconstants module's gaslist. + + ! The memory management for the gas_concs object is internal. The arrays passed to it + ! are copied to the internally allocated memory. Each call to the set_vmr method checks + ! whether the gas already has memory allocated, and if it does that memory is deallocated + ! and new memory is allocated. + + ! arguments + integer, intent(in) :: icall ! index of climate/diagnostic radiation call + type(physics_state), target, intent(in) :: pstate + type(physics_buffer_desc), pointer :: pbuf(:) + integer, intent(in) :: nlay + type(ty_gas_concs), intent(inout) :: gas_concs + + ! local variables + integer :: ncol + + integer :: lchnk + character(len=*), parameter :: sub = 'rrtmgp_set_gases_lw' + integer :: i + !-------------------------------------------------------------------------------- + + ncol = pstate%ncol + lchnk = pstate%lchnk + do i = 1,nradgas + call rad_gas_get_vmr(icall, gaslist(i), pstate, pbuf, nlay, ncol, gas_concs) + end do +end subroutine rrtmgp_set_gases_lw + +!================================================================================================== + +subroutine rrtmgp_set_gases_sw( & + icall, pstate, pbuf, nlay, nday, & + idxday, gas_concs) + + ! Return gas_concs with gas volume mixing ratio on DAYLIT columns. + + ! The gases in the SW coefficients file are: + ! H2O, CO2, O3, N2O, CO, CH4, O2, N2, CCL4, CFC11, CFC12, CFC22, HFC143a, + ! HFC125, HFC23, HFC32, HFC134a, CF4, NO2 + ! We only use the gases in radconstants gaslist. + + ! arguments + integer, intent(in) :: icall ! index of climate/diagnostic radiation call + type(physics_state), target, intent(in) :: pstate + type(physics_buffer_desc), pointer :: pbuf(:) + integer, intent(in) :: nlay + integer, intent(in) :: nday + integer, intent(in) :: idxday(:) + type(ty_gas_concs), intent(inout) :: gas_concs + + ! local variables + character(len=*), parameter :: sub = 'rrtmgp_set_gases_sw' + integer :: i + + ! use the optional argument indices to specify which columns are sunlit + do i = 1,nradgas + call rad_gas_get_vmr(icall, gaslist(i), pstate, pbuf, nlay, nday, gas_concs, indices=idxday) + end do + +end subroutine rrtmgp_set_gases_sw + +!================================================================================================== + +subroutine rrtmgp_set_cloud_lw(state, nlwbands, cldfrac, c_cld_lw_abs, lwkDist, cloud_lw) + + ! Create MCICA stochastic arrays for cloud LW optical properties. + + ! arguments + type(physics_state), intent(in) :: state + integer, intent(in) :: nlwbands + real(r8), intent(in) :: cldfrac(pcols,pver) ! combined cloud fraction (snow plus regular) + real(r8), intent(in) :: c_cld_lw_abs(nlwbands,pcols,pver) ! combined cloud absorption optics depth (LW) + class(ty_gas_optics_rrtmgp), intent(in) :: lwkDist + type(ty_optical_props_1scl), intent(inout) :: cloud_lw + ! local vars + integer :: i + integer :: ncol + integer :: ngptlw + real(r8), allocatable :: taucmcl(:,:,:) ! cloud optical depth [mcica] + character(len=32) :: sub = 'rrtmgp_set_cloud_lw' + character(len=128) :: errmsg + !-------------------------------------------------------------------------------- + ncol = state%ncol + ngptlw = lwkDist%get_ngpt() + + allocate(taucmcl(ngptlw,ncol,pver)) + + !***NB*** this code is currently set up to create the subcols for all model layers + ! not just the ones where the radiation calc is being done. Need + ! to subset cldfrac and c_cld_lw_abs to avoid computing unneeded random numbers. + + call mcica_subcol_lw( & + lwkdist, & ! spectral information + nlwbands, & ! number of spectral bands + ngptlw, & ! number of subcolumns (g-point intervals) + ncol, & ! number of columns + ngptlw, & ! changeseed, should be set to number of subcolumns + state%pmid, & ! layer pressures (Pa) + cldfrac, & ! layer cloud fraction + c_cld_lw_abs, & ! cloud optical depth + taucmcl & ! OUTPUT: subcolumn cloud optical depth [mcica] (ngpt, ncol, nver) + ) + + ! If there is an extra layer in the radiation then this initialization + ! will provide zero optical depths there. + cloud_lw%tau = 0.0_r8 + do i = 1, ngptlw + cloud_lw%tau(:ncol, ktopradm:, i) = taucmcl(i, :ncol, ktopcamm:) + end do + errmsg = cloud_lw%validate() + if (len_trim(errmsg) > 0) then + call endrun(sub//': ERROR: cloud_lw%validate: '//trim(errmsg)) + end if + deallocate(taucmcl) +end subroutine rrtmgp_set_cloud_lw + +!================================================================================================== + +subroutine rrtmgp_set_aer_lw(ncol, nlwbands, aer_lw_abs, aer_lw) + + ! Load aerosol optical properties into the RRTMGP object. + + ! arguments + integer, intent(in) :: ncol + integer, intent(in) :: nlwbands + real(r8), intent(in) :: aer_lw_abs(pcols,pver,nlwbands) ! aerosol absorption optics depth (LW) + type(ty_optical_props_1scl), intent(inout) :: aer_lw + character(len=32) :: sub = 'rrtmgp_set_aer_lw' + character(len=128) :: errmsg + + !-------------------------------------------------------------------------------- + ! If there is an extra layer in the radiation then this initialization + ! will provide zero optical depths there. + aer_lw%tau = 0.0_r8 + aer_lw%tau(:ncol, ktopradm:, :) = aer_lw_abs(:ncol, ktopcamm:, :) + errmsg = aer_lw%validate() + if (len_trim(errmsg) > 0) then + call endrun(sub//': ERROR: aer_lw%validate: '//trim(errmsg)) + end if +end subroutine rrtmgp_set_aer_lw + +!================================================================================================== + +subroutine rrtmgp_set_cloud_sw( & + nswbands, nday, nlay, idxday, pmid, cldfrac, & + c_cld_tau, c_cld_tau_w, c_cld_tau_w_g, c_cld_tau_w_f, kdist_sw, & + cloud_sw) + + ! Create MCICA stochastic arrays for cloud SW optical properties. + + ! arguments + integer, intent(in) :: nswbands + integer, intent(in) :: nday + integer, intent(in) :: nlay ! number of layers in rad calc (may include "extra layer") + integer, intent(in) :: idxday(:) + + real(r8), intent(in) :: pmid(nday,nlay) ! pressure at layer midpoints (Pa) + real(r8), intent(in) :: cldfrac(pcols,pver) ! combined cloud fraction (snow plus regular) + real(r8), intent(in) :: c_cld_tau (nswbands,pcols,pver) ! combined cloud extinction optical depth + real(r8), intent(in) :: c_cld_tau_w (nswbands,pcols,pver) ! combined cloud single scattering albedo * tau + real(r8), intent(in) :: c_cld_tau_w_g(nswbands,pcols,pver) ! combined cloud assymetry parameter * w * tau + real(r8), intent(in) :: c_cld_tau_w_f(nswbands,pcols,pver) ! combined cloud forward scattered fraction * w * tau + + class(ty_gas_optics_rrtmgp), intent(in) :: kdist_sw ! shortwave gas optics object + type(ty_optical_props_2str), intent(inout) :: cloud_sw ! cloud optical properties object + + ! local vars + integer, parameter :: changeseed = 1 + + integer :: i, k, kk, ns, igpt + integer :: ngptsw + integer :: nver ! nver is the number of cam layers in the SW calc. It + ! does not include the "extra layer". + + real(r8), allocatable :: cldf(:,:) + real(r8), allocatable :: tauc(:,:,:) + real(r8), allocatable :: ssac(:,:,:) + real(r8), allocatable :: asmc(:,:,:) + real(r8), allocatable :: taucmcl(:,:,:) + real(r8), allocatable :: ssacmcl(:,:,:) + real(r8), allocatable :: asmcmcl(:,:,:) + + character(len=32) :: sub = 'rrtmgp_set_cloud_sw' + character(len=128) :: errmsg + real(r8) :: small_val = 1.e-80_r8 + real(r8), allocatable :: day_cld_tau(:,:,:) + real(r8), allocatable :: day_cld_tau_w(:,:,:) + real(r8), allocatable :: day_cld_tau_w_g(:,:,:) + !-------------------------------------------------------------------------------- + ngptsw = kdist_sw%get_ngpt() + nver = pver - ktopcamm + 1 ! number of CAM's layers in radiation calculation. + + ! Compute the input quantities needed for the 2-stream optical props + ! object. Also subset the vertical levels and the daylight columns + ! here. But don't reorder the vertical index because the mcica sub-column + ! generator assumes the CAM vertical indexing. + allocate( & + cldf(nday,nver), & + tauc(nswbands,nday,nver), & + ssac(nswbands,nday,nver), & + asmc(nswbands,nday,nver), & + taucmcl(ngptsw,nday,nver), & + ssacmcl(ngptsw,nday,nver), & + asmcmcl(ngptsw,nday,nver), & + day_cld_tau(nswbands,nday,nver), & + day_cld_tau_w(nswbands,nday,nver), & + day_cld_tau_w_g(nswbands,nday,nver)) + + ! get daylit arrays on radiation levels, note: expect idxday to be truncated to size nday + day_cld_tau = c_cld_tau( :, idxday(1:nday), ktopcamm:) + day_cld_tau_w = c_cld_tau_w( :, idxday(1:nday), ktopcamm:) + day_cld_tau_w_g = c_cld_tau_w_g(:, idxday(1:nday), ktopcamm:) + cldf = cldfrac(idxday(1:nday), ktopcamm:) ! daylit cloud fraction on radiation levels + tauc = merge(day_cld_tau, 0.0_r8, day_cld_tau > 0.0_r8) ! start by setting cloud optical depth, clip @ zero + asmc = merge(day_cld_tau_w_g / max(day_cld_tau_w, small_val), 0.0_r8, day_cld_tau_w > 0.0_r8) ! set value of asymmetry + ssac = merge(max(day_cld_tau_w, small_val) / max(tauc, small_val), 1.0_r8 , tauc > 0.0_r8) + asmc = merge(asmc, 0.0_r8, tauc > 0.0_r8) ! double-check asymmetry; reset when tauc = 0 + + + ! mcica_subcol_sw converts to gpts (e.g., 224 pts instead of 14 bands) + ! inputs (pmid, cldf, tauc, ssac, asmc) and outputs (taucmcl, ssacmcl, asmcmcl) + ! are on the same nver vertical levels + ! output is shape (ngpt, ncol, nver) + call mcica_subcol_sw( & + kdist_sw, nswbands, ngptsw, nday, nlay, nver, changeseed, & + pmid, cldf, tauc, ssac, asmc, & + taucmcl, ssacmcl, asmcmcl) ! 32 + + + ! If there is an extra layer in the radiation then this initialization + ! will provide the optical properties there. + ! These should be shape (ncol, nlay, ngpt); assign levels using ktopradm+k, should + cloud_sw%tau(:,:,:) = 0.0_r8 + cloud_sw%ssa(:,:,:) = 1.0_r8 + cloud_sw%g(:,:,:) = 0.0_r8 + do igpt = 1,ngptsw + cloud_sw%g (:, ktopradm:, igpt) = asmcmcl(igpt, ktopcamm:, :) + cloud_sw%ssa(:, ktopradm:, igpt) = ssacmcl(igpt, ktopcamm:, :) + cloud_sw%tau(:, ktopradm:, igpt) = taucmcl(igpt, ktopcamm:, :) + end do + + + errmsg = cloud_sw%validate() + if (len_trim(errmsg) > 0) then + call endrun(sub//': ERROR: cloud_sw%validate: '//trim(errmsg)) + end if + + ! delta scaling adjusts for forward scattering + ! If delta_scale() is applied, cloud_sw%tau differs from RRTMG implementation going into SW calculation. + errmsg = cloud_sw%delta_scale() + if (len_trim(errmsg) > 0) then + call endrun(sub//': ERROR: cloud_sw%delta_scale: '//trim(errmsg)) + end if + + ! all information is in cloud_sw, now deallocate + deallocate( & + cldf, tauc, ssac, asmc, & + taucmcl, ssacmcl, asmcmcl,& + day_cld_tau, day_cld_tau_w, day_cld_tau_w_g ) + +end subroutine rrtmgp_set_cloud_sw + +!================================================================================================== + +subroutine rrtmgp_set_aer_sw( & + nswbands, nday, idxday, aer_tau, aer_tau_w, & + aer_tau_w_g, aer_tau_w_f, aer_sw) + + ! Load aerosol SW optical properties into the RRTMGP object. + ! + ! *** N.B. *** The input optical arrays from CAM are dimensioned in the vertical + ! as 0:pver. The index 0 is for the extra layer used in the radiation + ! calculation. + + + ! arguments + integer, intent(in) :: nswbands + integer, intent(in) :: nday + integer, intent(in) :: idxday(:) + real(r8), intent(in) :: aer_tau (pcols,0:pver,nswbands) ! extinction optical depth + real(r8), intent(in) :: aer_tau_w (pcols,0:pver,nswbands) ! single scattering albedo * tau + real(r8), intent(in) :: aer_tau_w_g(pcols,0:pver,nswbands) ! asymmetry parameter * w * tau + real(r8), intent(in) :: aer_tau_w_f(pcols,0:pver,nswbands) ! forward scattered fraction * w * tau + type(ty_optical_props_2str), intent(inout) :: aer_sw + + ! local variables + integer :: ns + integer :: k, kk + integer :: i + integer, dimension(nday) :: day_cols + character(len=32) :: sub = 'rrtmgp_set_aer_sw' + character(len=128) :: errmsg + !-------------------------------------------------------------------------------- + ! If there is an extra layer in the radiation then this initialization + ! will provide default values there. + aer_sw%tau = 0.0_r8 + aer_sw%ssa = 1.0_r8 + aer_sw%g = 0.0_r8 + day_cols = idxday(1:nday) + + ! aer_sw is on RAD grid, aer_tau* is on CAM grid ... to make sure they align, use ktop* + ! aer_sw has dimensions of (nday, nlay, nswbands) + aer_sw%tau(1:nday, ktopradm:, :) = max(aer_tau(day_cols, ktopcamm:, :), 0._r8) + aer_sw%ssa(1:nday, ktopradm:, :) = merge(aer_tau_w(day_cols, ktopcamm:,:)/aer_tau(day_cols, ktopcamm:, :), 1._r8, aer_tau(day_cols, ktopcamm:, :) > 0._r8) + aer_sw%g( 1:nday, ktopradm:, :) = merge(aer_tau_w_g(day_cols, ktopcamm:, :) / aer_tau_w(day_cols, ktopcamm:, :), 0._r8, aer_tau_w(day_cols, ktopcamm:, :) > 1.e-80_r8) + + ! impose limits on the components: + ! aer_sw%tau = max(aer_sw%tau, 0._r) <-- already imposed + aer_sw%ssa = min(max(aer_sw%ssa, 0._r8), 1._r8) + aer_sw%g = min(max(aer_sw%g, -1._r8), 1._r8) + ! by clamping the values here, the validate method should be guaranteed to succeed, + ! but we're also saying that any errors in the method to this point are being swept aside. + ! We might want to check for out-of-bounds values and report them in the log file. + + errmsg = aer_sw%validate() + if (len_trim(errmsg) > 0) then + call endrun(sub//': ERROR: aer_sw%validate: '//trim(errmsg)) + end if +end subroutine rrtmgp_set_aer_sw + +!================================================================================================== + +subroutine expand_and_transpose(ops,arr_in,arr_out) + ! based on version in mo_rte_sw + class(ty_gas_optics_rrtmgp), intent(in) :: ops ! spectral information + real(r8), dimension(:), intent(in ) :: arr_in ! (nband) + real(r8), dimension(:), intent(out) :: arr_out ! (igpt) + ! ------------- + integer :: nband, ngpt + integer :: iband, igpt + integer, dimension(2,ops%get_nband()) :: limits + + nband = ops%get_nband() + ngpt = ops%get_ngpt() + limits = ops%get_band_lims_gpoint() + do iband = 1, nband + do igpt = limits(1, iband), limits(2, iband) + arr_out(igpt) = arr_in(iband) + end do + end do + + end subroutine expand_and_transpose + +end module rrtmgp_inputs diff --git a/src/physics/rrtmgp/slingo.F90 b/src/physics/rrtmgp/slingo.F90 new file mode 100644 index 0000000000..aedb44bcee --- /dev/null +++ b/src/physics/rrtmgp/slingo.F90 @@ -0,0 +1,409 @@ +module slingo + +!------------------------------------------------------------------------------------------------ +! Implements Slingo Optics for MG/RRTMG for liquid clouds and +! a copy of the old cloud routine for reference +!------------------------------------------------------------------------------------------------ + +use shr_kind_mod, only: r8 => shr_kind_r8 +use ppgrid, only: pcols, pver, pverp +use physics_types, only: physics_state +use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_get_field, pbuf_old_tim_idx +use radconstants, only: nswbands, nlwbands, idx_sw_diag, ot_length, idx_lw_diag, get_sw_spectral_boundaries +use cam_abortutils, only: endrun +use cam_history, only: outfld + +implicit none +private +save + +public :: & + slingo_rad_props_init, & + cloud_rad_props_get_sw, & ! return SW optical props of total bulk aerosols + cloud_rad_props_get_lw, & ! return LW optical props of total bulk aerosols + slingo_liq_get_rad_props_lw, & + slingo_liq_optics_sw + +! Minimum cloud amount (as a fraction of the grid-box area) to +! distinguish from clear sky +! + real(r8) cldmin + parameter (cldmin = 1.0e-80_r8) +! +! Decimal precision of cloud amount (0 -> preserve full resolution; +! 10^-n -> preserve n digits of cloud amount) +! + real(r8) cldeps + parameter (cldeps = 0.0_r8) + +! +! indexes into pbuf for optical parameters of MG clouds +! + integer :: iclwp_idx = 0 + integer :: iciwp_idx = 0 + integer :: cld_idx = 0 + integer :: rel_idx = 0 + integer :: rei_idx = 0 + +! indexes into constituents for old optics + integer :: & + ixcldliq, & ! cloud liquid water index + ixcldice ! cloud liquid water index + + +!============================================================================== +contains +!============================================================================== + +subroutine slingo_rad_props_init() + +! use cam_history, only: addfld + use netcdf + use spmd_utils, only: masterproc + use ioFileMod, only: getfil + use cam_logfile, only: iulog + use error_messages, only: handle_ncerr +#if ( defined SPMD ) + use mpishorthand +#endif + use constituents, only: cnst_get_ind + + integer :: err + + iciwp_idx = pbuf_get_index('ICIWP',errcode=err) + iclwp_idx = pbuf_get_index('ICLWP',errcode=err) + cld_idx = pbuf_get_index('CLD') + rel_idx = pbuf_get_index('REL') + rei_idx = pbuf_get_index('REI') + + ! old optics + call cnst_get_ind('CLDLIQ', ixcldliq) + call cnst_get_ind('CLDICE', ixcldice) + + !call addfld ('CLWPTH_OLD',(/ 'lev' /), 'I','Kg/m2','old In Cloud Liquid Water Path', sampling_seq='rad_lwsw') + !call addfld ('KEXT_OLD',(/ 'lev' /),'I','m^2/kg','old extinction') + !call addfld ('CLDOD_OLD',(/ 'lev' /),'I','1','old liquid OD') + !call addfld ('REL_OLD',(/ 'lev' /),'I','1','old liquid effective radius (liquid)') + + !call addfld ('CLWPTH_NEW',(/ 'lev' /), 'I','Kg/m2','In Cloud Liquid Water Path', sampling_seq='rad_lwsw') + !call addfld ('KEXT_NEW',(/ 'lev' /),'I','m^2/kg','extinction') + !call addfld ('CLDOD_NEW',(/ 'lev' /),'I','1','liquid OD') + + !call addfld('CIWPTH_NEW',(/ 'lev' /), 'I','Kg/m2','In Cloud Ice Water Path', sampling_seq='rad_lwsw') + !call addfld('CIWPTH_OLD',(/ 'lev' /), 'I','Kg/m2','In Cloud Ice Water Path (old)', sampling_seq='rad_lwsw') + + return + +end subroutine slingo_rad_props_init + +!============================================================================== + +subroutine cloud_rad_props_get_sw(state, pbuf, & + tau, tau_w, tau_w_g, tau_w_f,& + diagnosticindex) + +! return totaled (across all species) layer tau, omega, g, f +! for all spectral interval for aerosols affecting the climate + + ! Arguments + type(physics_state), intent(in) :: state + type(physics_buffer_desc), pointer :: pbuf(:) + integer, optional, intent(in) :: diagnosticindex ! index (if present) to radiation diagnostic information + + real(r8), intent(out) :: tau (nswbands,pcols,pver) ! aerosol extinction optical depth + real(r8), intent(out) :: tau_w (nswbands,pcols,pver) ! aerosol single scattering albedo * tau + real(r8), intent(out) :: tau_w_g(nswbands,pcols,pver) ! aerosol assymetry parameter * tau * w + real(r8), intent(out) :: tau_w_f(nswbands,pcols,pver) ! aerosol forward scattered fraction * tau * w + + ! Local variables + + integer :: ncol + integer :: lchnk + integer :: k, i ! lev and daycolumn indices + integer :: iswband ! sw band indices + + real(r8) :: liq_tau (nswbands,pcols,pver) ! aerosol extinction optical depth + real(r8) :: liq_tau_w (nswbands,pcols,pver) ! aerosol single scattering albedo * tau + real(r8) :: liq_tau_w_g(nswbands,pcols,pver) ! aerosol assymetry parameter * tau * w + real(r8) :: liq_tau_w_f(nswbands,pcols,pver) ! aerosol forward scattered fraction * tau * w + + + !----------------------------------------------------------------------------- + + ncol = state%ncol + lchnk = state%lchnk + + call slingo_liq_optics_sw(state, pbuf, tau, tau_w, tau_w_g, tau_w_f, oldliqwp=.true. ) + +end subroutine cloud_rad_props_get_sw +!============================================================================== + +subroutine cloud_rad_props_get_lw(state, pbuf, cld_abs_od, diagnosticindex, oldliq, oldice, oldcloud) + +! Purpose: Compute cloud longwave absorption optical depth +! cloud_rad_props_get_lw() is called by radlw() + + ! Arguments + type(physics_state), intent(in) :: state + type(physics_buffer_desc), pointer :: pbuf(:) + real(r8), intent(out) :: cld_abs_od(nlwbands,pcols,pver) ! [fraction] absorption optical depth, per layer + integer, optional, intent(in) :: diagnosticindex + logical, optional, intent(in) :: oldliq ! use old liquid optics + logical, optional, intent(in) :: oldice ! use old ice optics + logical, optional, intent(in) :: oldcloud ! use old optics for both (b4b) + + ! Local variables + + integer :: bnd_idx ! LW band index + integer :: i ! column index + integer :: k ! lev index + integer :: ncol ! number of columns + integer :: lchnk + + ! rad properties for liquid clouds + real(r8) :: liq_tau_abs_od(nlwbands,pcols,pver) ! liquid cloud absorption optical depth + + !----------------------------------------------------------------------------- + + ncol = state%ncol + lchnk = state%lchnk + + ! compute optical depths cld_absod + cld_abs_od = 0._r8 + + call slingo_liq_get_rad_props_lw(state, pbuf, liq_tau_abs_od, oldliqwp=.true.) + + cld_abs_od(:,1:ncol,:) = liq_tau_abs_od(:,1:ncol,:) + +end subroutine cloud_rad_props_get_lw + +!============================================================================== +! Private methods +!============================================================================== + + +subroutine slingo_liq_optics_sw(state, pbuf, liq_tau, liq_tau_w, liq_tau_w_g, liq_tau_w_f, oldliqwp) + + use physconst, only: gravit + + type(physics_state), intent(in) :: state + type(physics_buffer_desc), pointer :: pbuf(:) + + real(r8),intent(out) :: liq_tau (nswbands,pcols,pver) ! extinction optical depth + real(r8),intent(out) :: liq_tau_w (nswbands,pcols,pver) ! single scattering albedo * tau + real(r8),intent(out) :: liq_tau_w_g(nswbands,pcols,pver) ! assymetry parameter * tau * w + real(r8),intent(out) :: liq_tau_w_f(nswbands,pcols,pver) ! forward scattered fraction * tau * w + logical, intent(in) :: oldliqwp + + real(r8), pointer, dimension(:,:) :: rel + real(r8), pointer, dimension(:,:) :: cldn + real(r8), pointer, dimension(:,:) :: tmpptr + real(r8), dimension(pcols,pver) :: cliqwp + real(r8), dimension(nswbands) :: wavmin + real(r8), dimension(nswbands) :: wavmax + + ! Minimum cloud amount (as a fraction of the grid-box area) to + ! distinguish from clear sky + real(r8), parameter :: cldmin = 1.0e-80_r8 + + ! Decimal precision of cloud amount (0 -> preserve full resolution; + ! 10^-n -> preserve n digits of cloud amount) + real(r8), parameter :: cldeps = 0.0_r8 + + ! A. Slingo's data for cloud particle radiative properties (from 'A GCM + ! Parameterization for the Shortwave Properties of Water Clouds' JAS + ! vol. 46 may 1989 pp 1419-1427) + real(r8) :: abarl(4) = & ! A coefficient for extinction optical depth + (/ 2.817e-02_r8, 2.682e-02_r8,2.264e-02_r8,1.281e-02_r8/) + real(r8) :: bbarl(4) = & ! B coefficient for extinction optical depth + (/ 1.305_r8 , 1.346_r8 ,1.454_r8 ,1.641_r8 /) + real(r8) :: cbarl(4) = & ! C coefficient for single scat albedo + (/-5.62e-08_r8 ,-6.94e-06_r8 ,4.64e-04_r8 ,0.201_r8 /) + real(r8) :: dbarl(4) = & ! D coefficient for single scat albedo + (/ 1.63e-07_r8 , 2.35e-05_r8 ,1.24e-03_r8 ,7.56e-03_r8 /) + real(r8) :: ebarl(4) = & ! E coefficient for asymmetry parameter + (/ 0.829_r8 , 0.794_r8 ,0.754_r8 ,0.826_r8 /) + real(r8) :: fbarl(4) = & ! F coefficient for asymmetry parameter + (/ 2.482e-03_r8, 4.226e-03_r8,6.560e-03_r8,4.353e-03_r8/) + + real(r8) :: abarli ! A coefficient for current spectral band + real(r8) :: bbarli ! B coefficient for current spectral band + real(r8) :: cbarli ! C coefficient for current spectral band + real(r8) :: dbarli ! D coefficient for current spectral band + real(r8) :: ebarli ! E coefficient for current spectral band + real(r8) :: fbarli ! F coefficient for current spectral band + + ! Caution... A. Slingo recommends no less than 4.0 micro-meters nor + ! greater than 20 micro-meters + + integer :: ns, i, k, indxsl, Nday + integer :: i_rel, lchnk, icld, itim_old + real(r8) :: tmp1l, tmp2l, tmp3l, g + real(r8) :: kext(pcols,pver) + real(r8), pointer, dimension(:,:) :: iclwpth + + Nday = state%ncol + lchnk = state%lchnk + + itim_old = pbuf_old_tim_idx() + call pbuf_get_field(pbuf, cld_idx, cldn, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, rel_idx, rel) + + if (oldliqwp) then + do k=1,pver + do i = 1,Nday + cliqwp(i,k) = state%q(i,k,ixcldliq)*state%pdel(i,k)/(gravit*max(0.01_r8,cldn(i,k))) + end do + end do + else + if (iclwp_idx<=0) then + call endrun('slingo_liq_optics_sw: oldliqwp must be set to true since ICLWP was not found in pbuf') + endif + ! The following is the eventual target specification for in cloud liquid water path. + call pbuf_get_field(pbuf, iclwp_idx, tmpptr) + cliqwp = tmpptr + endif + + call get_sw_spectral_boundaries(wavmin,wavmax,'microns') + + do ns = 1, nswbands + ! Set index for cloud particle properties based on the wavelength, + ! according to A. Slingo (1989) equations 1-3: + ! Use index 1 (0.25 to 0.69 micrometers) for visible + ! Use index 2 (0.69 - 1.19 micrometers) for near-infrared + ! Use index 3 (1.19 to 2.38 micrometers) for near-infrared + ! Use index 4 (2.38 to 4.00 micrometers) for near-infrared + if(wavmax(ns) <= 0.7_r8) then + indxsl = 1 + else if(wavmax(ns) <= 1.25_r8) then + indxsl = 2 + else if(wavmax(ns) <= 2.38_r8) then + indxsl = 3 + else if(wavmax(ns) > 2.38_r8) then + indxsl = 4 + end if + + ! Set cloud extinction optical depth, single scatter albedo, + ! asymmetry parameter, and forward scattered fraction: + abarli = abarl(indxsl) + bbarli = bbarl(indxsl) + cbarli = cbarl(indxsl) + dbarli = dbarl(indxsl) + ebarli = ebarl(indxsl) + fbarli = fbarl(indxsl) + + do k=1,pver + do i=1,Nday + + ! note that optical properties for liquid valid only + ! in range of 4.2 > rel > 16 micron (Slingo 89) + if (cldn(i,k) >= cldmin .and. cldn(i,k) >= cldeps) then + tmp1l = abarli + bbarli/min(max(4.2_r8,rel(i,k)),16._r8) + liq_tau(ns,i,k) = 1000._r8*cliqwp(i,k)*tmp1l + else + liq_tau(ns,i,k) = 0.0_r8 + endif + + tmp2l = 1._r8 - cbarli - dbarli*min(max(4.2_r8,rel(i,k)),16._r8) + tmp3l = fbarli*min(max(4.2_r8,rel(i,k)),16._r8) + ! Do not let single scatter albedo be 1. Delta-eddington solution + ! for non-conservative case has different analytic form from solution + ! for conservative case, and raddedmx is written for non-conservative case. + liq_tau_w(ns,i,k) = liq_tau(ns,i,k) * min(tmp2l,.999999_r8) + g = ebarli + tmp3l + liq_tau_w_g(ns,i,k) = liq_tau_w(ns,i,k) * g + liq_tau_w_f(ns,i,k) = liq_tau_w(ns,i,k) * g * g + + end do ! End do i=1,Nday + end do ! End do k=1,pver + end do ! nswbands + + !call outfld('CL_OD_SW_OLD',liq_tau(idx_sw_diag,:,:), pcols, lchnk) + !call outfld('REL_OLD',rel(:,:), pcols, lchnk) + !call outfld('CLWPTH_OLD',cliqwp(:,:), pcols, lchnk) + !call outfld('KEXT_OLD',kext(:,:), pcols, lchnk) + + +end subroutine slingo_liq_optics_sw + +subroutine slingo_liq_get_rad_props_lw(state, pbuf, abs_od, oldliqwp) + use physconst, only: gravit + + type(physics_state), intent(in) :: state + type(physics_buffer_desc),pointer :: pbuf(:) + real(r8), intent(out) :: abs_od(nlwbands,pcols,pver) + logical, intent(in) :: oldliqwp + + real(r8) :: gicewp(pcols,pver) + real(r8) :: gliqwp(pcols,pver) + real(r8) :: cicewp(pcols,pver) + real(r8) :: cliqwp(pcols,pver) + real(r8) :: ficemr(pcols,pver) + real(r8) :: cwp(pcols,pver) + real(r8) :: cldtau(pcols,pver) + + real(r8), pointer, dimension(:,:) :: cldn + real(r8), pointer, dimension(:,:) :: rei + integer :: ncol, icld, itim_old, i_rei, lwband, i, k, lchnk + + real(r8) :: kabs, kabsi + real(r8) kabsl ! longwave liquid absorption coeff (m**2/g) + parameter (kabsl = 0.090361_r8) + + real(r8), pointer, dimension(:,:) :: iclwpth, iciwpth + + ncol=state%ncol + lchnk = state%lchnk + + itim_old = pbuf_old_tim_idx() + call pbuf_get_field(pbuf, rei_idx, rei) + call pbuf_get_field(pbuf, cld_idx, cldn, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + + if (oldliqwp) then + do k=1,pver + do i = 1,ncol + gicewp(i,k) = state%q(i,k,ixcldice)*state%pdel(i,k)/gravit*1000.0_r8 ! Grid box ice water path. + gliqwp(i,k) = state%q(i,k,ixcldliq)*state%pdel(i,k)/gravit*1000.0_r8 ! Grid box liquid water path. + cicewp(i,k) = gicewp(i,k) / max(0.01_r8,cldn(i,k)) ! In-cloud ice water path. + cliqwp(i,k) = gliqwp(i,k) / max(0.01_r8,cldn(i,k)) ! In-cloud liquid water path. + ficemr(i,k) = state%q(i,k,ixcldice) / & + max(1.e-10_r8,(state%q(i,k,ixcldice)+state%q(i,k,ixcldliq))) + end do + end do + cwp(:ncol,:pver) = cicewp(:ncol,:pver) + cliqwp(:ncol,:pver) + else + if (iclwp_idx<=0 .or. iciwp_idx<=0) then + call endrun('slingo_liq_get_rad_props_lw: oldliqwp must be set to true since ICIWP and/or ICLWP were not found in pbuf') + endif + call pbuf_get_field(pbuf, iclwp_idx, iclwpth) + call pbuf_get_field(pbuf, iciwp_idx, iciwpth) + do k=1,pver + do i = 1,ncol + cwp (i,k) = 1000.0_r8 * iclwpth(i,k) + 1000.0_r8 * iciwpth(i, k) + ficemr(i,k) = 1000.0_r8 * iciwpth(i,k)/(max(1.e-18_r8, cwp(i,k))) + end do + end do + endif + + + do k=1,pver + do i=1,ncol + + ! Note from Andrew Conley: + ! Optics for RK no longer supported, This is constructed to get + ! close to bit for bit. Otherwise we could simply use liquid water path + !note that optical properties for ice valid only + !in range of 13 > rei > 130 micron (Ebert and Curry 92) + kabs = kabsl*(1._r8-ficemr(i,k)) + cldtau(i,k) = kabs*cwp(i,k) + end do + end do +! + do lwband = 1,nlwbands + abs_od(lwband,1:ncol,1:pver)=cldtau(1:ncol,1:pver) + enddo + + +end subroutine slingo_liq_get_rad_props_lw + +end module slingo From c17e5e6b175fa4e1dc092900a38e0ff390a4949b Mon Sep 17 00:00:00 2001 From: Brian Eaton Date: Thu, 11 May 2023 15:52:56 -0400 Subject: [PATCH 112/291] update .gitignore with rrtmgp external --- .gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitignore b/.gitignore index 08b47940f0..0002f00ca1 100644 --- a/.gitignore +++ b/.gitignore @@ -11,6 +11,7 @@ src/physics/cosp2/src src/physics/silhs src/physics/pumas src/physics/pumas-frozen +src/physics/rrtmgp/ext src/dynamics/fv3/atmos_cubed_sphere libraries/FMS libraries/mct From e761a7401b095f54379522116788ff4e7b84fb7f Mon Sep 17 00:00:00 2001 From: Brian Eaton Date: Tue, 16 May 2023 12:29:53 -0400 Subject: [PATCH 113/291] get rrtmgp from my fork --- Externals_CAM.cfg | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Externals_CAM.cfg b/Externals_CAM.cfg index a87d3b1719..05d7b1ada3 100644 --- a/Externals_CAM.cfg +++ b/Externals_CAM.cfg @@ -1,8 +1,8 @@ [rrtmgp] local_path = src/physics/rrtmgp/ext protocol = git -repo_url = https://github.com/earth-system-radiation/rte-rrtmgp.git -tag = v1.6 +repo_url = https://github.com/brian-eaton/rte-rrtmgp.git +tag = build_mod01 required = True [chem_proc] From 430185cf7050adb791d59e513010f0a5fcca834c Mon Sep 17 00:00:00 2001 From: Brian Eaton Date: Tue, 16 May 2023 21:31:01 -0400 Subject: [PATCH 114/291] comment out non-working memory monitoring code --- src/physics/rrtmgp/radiation.F90 | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/src/physics/rrtmgp/radiation.F90 b/src/physics/rrtmgp/radiation.F90 index c33a36101b..e3a631d4c4 100644 --- a/src/physics/rrtmgp/radiation.F90 +++ b/src/physics/rrtmgp/radiation.F90 @@ -1538,7 +1538,7 @@ subroutine radiation_tend( & ! call endrun(sub//': ERROR code returned by check_bounds gas_concs_sw: '//trim(errmsg)) ! end if ! call check_bounds(kdist_sw, errmsg) - call shr_mem_getusage(mem_hw_beg, mem_beg) +! call shr_mem_getusage(mem_hw_beg, mem_beg) ! inputs are the daylit columns --> output fluxes therefore also on daylit columns. errmsg = rte_sw( kdist_sw, & ! input (from init) gas_concs_sw, & ! input, (from rrtmgp_set_gases_sw) @@ -1555,17 +1555,17 @@ subroutine radiation_tend( & tsi_scaling=eccf & !< optional input, scaling for irradiance ) - call shr_mem_getusage(mem_hw_end, mem_end) - temp = mem_hw_end - mem_hw_beg - if (masterproc) then - write(iulog, *) 'rte_sw: Increase in memory highwater = ', & - temp, ' (MB)' - end if - temp = mem_end - mem_beg - if (masterproc) then - write(iulog, *) 'rte_sw: Increase in memory usage = ', & - temp, ' (MB)' - end if +! call shr_mem_getusage(mem_hw_end, mem_end) +! temp = mem_hw_end - mem_hw_beg +! if (masterproc) then +! write(iulog, *) 'rte_sw: Increase in memory highwater = ', & +! temp, ' (MB)' +! end if +! temp = mem_end - mem_beg +! if (masterproc) then +! write(iulog, *) 'rte_sw: Increase in memory usage = ', & +! temp, ' (MB)' +! end if if (len_trim(errmsg) > 0) then call endrun(sub//': ERROR code returned by rte_sw: '//trim(errmsg)) From acfe4267ad7cea29c1afe74ada17153314023bd9 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Thu, 18 May 2023 14:36:53 -0600 Subject: [PATCH 115/291] Update lightning emissions code in GEOS-Chem interface for compatibility These updates are necessary when updating from cam3_6_095 to cam3_6_111 Signed-off-by: Lizzie Lundgren --- src/chemistry/geoschem/chemistry.F90 | 12 +++++------- src/chemistry/geoschem/geoschem_emissions_mod.F90 | 12 +----------- 2 files changed, 6 insertions(+), 18 deletions(-) diff --git a/src/chemistry/geoschem/chemistry.F90 b/src/chemistry/geoschem/chemistry.F90 index dea62ead0e..49faa7d6a1 100644 --- a/src/chemistry/geoschem/chemistry.F90 +++ b/src/chemistry/geoschem/chemistry.F90 @@ -166,9 +166,6 @@ module chemistry CHARACTER(len=shr_kind_cl) :: bndtvg = ' ' ! pathname for greenhouse gas loss rate CHARACTER(len=shr_kind_cl) :: h2orates = ' ' ! pathname for greenhouse gas (lyman-alpha H2O loss) - ! lightning - REAL(r8) :: lght_no_prd_factor = 1._r8 - ! Strings CHARACTER(LEN=255) :: ThisLoc CHARACTER(LEN=255) :: ErrMsg @@ -681,6 +678,7 @@ subroutine chem_readnl(nlfile) use dust_model, only : dust_readnl #endif use gas_wetdep_opts, only : gas_wetdep_readnl + use mo_lightning, only : lightning_readnl #ifdef SPMD use mpishorthand #endif @@ -700,8 +698,7 @@ subroutine chem_readnl(nlfile) ! Assume a successful return until otherwise RC = GC_SUCCESS - namelist /chem_inparm/ lght_no_prd_factor, & - depvel_lnd_file + namelist /chem_inparm/ depvel_lnd_file ! ghg chem @@ -754,6 +751,8 @@ subroutine chem_readnl(nlfile) CALL gas_wetdep_readnl(nlfile) + CALL lightning_readnl(nlfile) + CALL gc_readnl(nlfile) IF ( MasterProc ) THEN @@ -883,7 +882,6 @@ subroutine chem_readnl(nlfile) ! Broadcast namelist variables CALL MPIBCAST (depvel_lnd_file, LEN(depvel_lnd_file), MPICHAR, 0, MPICOM) - CALL MPIBCAST (lght_no_prd_factor, 1, MPIR8, 0, MPICOM) CALL MPIBCAST (ghg_chem, 1, MPILOG, 0, MPICOM) CALL MPIBCAST (bndtvg, LEN(bndtvg), MPICHAR, 0, MPICOM) CALL MPIBCAST (h2orates, LEN(h2orates), MPICHAR, 0, MPICOM) @@ -1690,7 +1688,7 @@ subroutine chem_init(phys_state, pbuf2d) State_Met = State_Met(BEGCHUNK) ) ! Initialize emissions interface - CALL GC_Emissions_Init( lght_no_prd_factor = lght_no_prd_factor ) + CALL GC_Emissions_Init( ) hco_pbuf2d => pbuf2d diff --git a/src/chemistry/geoschem/geoschem_emissions_mod.F90 b/src/chemistry/geoschem/geoschem_emissions_mod.F90 index cc3160d212..99bc9eff7f 100644 --- a/src/chemistry/geoschem/geoschem_emissions_mod.F90 +++ b/src/chemistry/geoschem/geoschem_emissions_mod.F90 @@ -76,7 +76,7 @@ MODULE GeosChem_Emissions_Mod !\\ ! !INTERFACE: ! - SUBROUTINE GC_Emissions_Init( lght_no_prd_factor ) + SUBROUTINE GC_Emissions_Init( ) ! ! !USES: ! @@ -85,15 +85,10 @@ SUBROUTINE GC_Emissions_Init( lght_no_prd_factor ) USE PHYS_CONTROL, ONLY : phys_getopts USE MO_CHEM_UTLS, ONLY : get_spc_ndx, get_extfrc_ndx USE CAM_HISTORY, ONLY : addfld, add_default, horiz_only - USE MO_LIGHTNING, ONLY : lightning_inti USE FIRE_EMISSIONS, ONLY : fire_emissions_init USE CHEM_MODS, ONLY : adv_mass USE INFNAN, ONLY : NaN, assignment(=) ! -! !INPUT PARAMETERS: -! - REAL(r8), INTENT(IN ) :: lght_no_prd_factor ! Lightning scaling factor -! ! !REVISION HISTORY: ! 07 Oct 2020 - T. M. Fritz - Initial version !EOP @@ -127,11 +122,6 @@ SUBROUTINE GC_Emissions_Init( lght_no_prd_factor ) ! Get constituent index for NO CALL cnst_get_ind('NO', iNO, abort=.True.) - !----------------------------------------------------------------------- - ! ... initialize the lightning module - !----------------------------------------------------------------------- - CALL lightning_inti(lght_no_prd_factor) - !----------------------------------------------------------------------- ! ... MEGAN emissions !----------------------------------------------------------------------- From 7acbb785ec6a2175d75935d354ac2f9594c40b8a Mon Sep 17 00:00:00 2001 From: Brian Eaton Date: Wed, 5 Jul 2023 10:12:06 -0400 Subject: [PATCH 116/291] use parameters for nswbands, nlwbands --- src/physics/cam/modal_aer_opt.F90 | 16 +-- src/physics/rrtmgp/b_checker.f90 | 163 --------------------------- src/physics/rrtmgp/rad_solar_var.F90 | 21 ++-- src/physics/rrtmgp/radconstants.F90 | 60 ++-------- src/physics/rrtmgp/radiation.F90 | 83 +++----------- 5 files changed, 38 insertions(+), 305 deletions(-) delete mode 100644 src/physics/rrtmgp/b_checker.f90 diff --git a/src/physics/cam/modal_aer_opt.F90 b/src/physics/cam/modal_aer_opt.F90 index 160e47e86c..5c95c17840 100644 --- a/src/physics/cam/modal_aer_opt.F90 +++ b/src/physics/cam/modal_aer_opt.F90 @@ -53,8 +53,8 @@ module modal_aer_opt real(r8) :: xrmin, xrmax ! refractive index for water read in read_water_refindex -complex(r8), allocatable :: crefwsw(:) ! complex refractive index for water visible -complex(r8), allocatable :: crefwlw(:) ! complex refractive index for water infrared +complex(r8) :: crefwsw(nswbands) ! complex refractive index for water visible +complex(r8) :: crefwlw(nlwbands) ! complex refractive index for water infrared ! physics buffer indices integer :: dgnumwet_idx = -1 @@ -601,7 +601,7 @@ subroutine modal_aero_sw(list_idx, state, pbuf, nnite, idxnite, & lchnk = state%lchnk ncol = state%ncol - if (.not. allocated(crefwsw)) allocate(crefwsw(nswbands)) + ! initialize output variables tauxar(:ncol,:,:) = 0._r8 wa(:ncol,:,:) = 0._r8 @@ -1062,7 +1062,6 @@ subroutine modal_aero_sw(list_idx, state, pbuf, nnite, idxnite, & deallocate(drymass_m) deallocate(so4dryvol_m) deallocate(naer_m) - deallocate(crefwsw) end if ! Output visible band diagnostics for quantities summed over the modes @@ -1257,7 +1256,7 @@ subroutine modal_aero_lw(list_idx, state, pbuf, tauxar) lchnk = state%lchnk ncol = state%ncol - if (.not. allocated(crefwlw)) allocate(crefwlw(nlwbands)) + ! initialize output variables tauxar(:ncol,:,:) = 0._r8 @@ -1439,7 +1438,6 @@ subroutine modal_aero_lw(list_idx, state, pbuf, tauxar) deallocate(drymass_m) deallocate(so4dryvol_m) deallocate(naer_m) - deallocate(crefwlw) end if end subroutine modal_aero_lw @@ -1464,8 +1462,7 @@ subroutine read_water_refindex(infilename) real(r8) :: refrwsw(nswbands), refiwsw(nswbands) ! real, imaginary ref index for water visible real(r8) :: refrwlw(nlwbands), refiwlw(nlwbands) ! real, imaginary ref index for water infrared !---------------------------------------------------------------------------- - if (.not. allocated(crefwsw)) allocate(crefwsw(nswbands)) - if (.not. allocated(crefwlw)) allocate(crefwlw(nlwbands)) + ! open file call cam_pio_openfile(ncid, infilename, PIO_NOWRITE) @@ -1507,8 +1504,7 @@ subroutine read_water_refindex(infilename) end do call pio_closefile(ncid) - deallocate(crefwsw) - deallocate(crefwlw) + end subroutine read_water_refindex !=============================================================================== diff --git a/src/physics/rrtmgp/b_checker.f90 b/src/physics/rrtmgp/b_checker.f90 deleted file mode 100644 index a24d7c7b5e..0000000000 --- a/src/physics/rrtmgp/b_checker.f90 +++ /dev/null @@ -1,163 +0,0 @@ -module b_checker -!--------------------------------------------------------------------------------- -! -! Instrumentation for debugging CAM interface to RRTMGP radiation parameterization. -! -!--------------------------------------------------------------------------------- - use shr_kind_mod, only: r8=>shr_kind_r8, cl=>shr_kind_cl - use mo_gas_concentrations, only: ty_gas_concs - use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp - use cam_abortutils, only: endrun - use cam_logfile, only: iulog - - - implicit none - private - public check_bounds_5d, check_bounds_4d, check_bounds_3d, check_bounds_2d, check_bounds_1d, check_bounds, & - assert_shape_2dreal, assert_shape - - ! bpm -- interface for checking array bounds - interface check_bounds - module procedure check_bounds_1d, check_bounds_2d, check_bounds_3d, check_bounds_4d, check_bounds_5d, check_bounds_gas_concs, check_bounds_gas_optics - end interface check_bounds - - interface assert_shape - module procedure assert_shape_2dreal - end interface assert_shape - - contains - - subroutine check_bounds_1d(arr, max_bound, min_bound, err_message) - real(r8), intent(in) :: arr(:) - real(r8), intent(in) :: max_bound, min_bound - character(len=128), intent(out) :: err_message - real(r8) :: mx, mn - err_message='' - mx = maxval(arr) - mn = minval(arr) - if (mn < min_bound) then - err_message = "validate: array values too small " - end if - if (mx > max_bound ) then - err_message = "validate: array values too large" - end if - end subroutine - - subroutine check_bounds_2d(arr, max_bound, min_bound, err_message) - real(r8), intent(in) :: arr(:,:) - real(r8), intent(in) :: max_bound, min_bound - character(len=128), intent(out) :: err_message - real(r8) :: mx, mn - err_message = '' - mx = maxval(arr) - mn = minval(arr) - if (mn < min_bound) then - err_message = "validate: array values too small " - end if - if (mx > max_bound ) then - err_message = "validate: array values too large" - end if - end subroutine - - subroutine check_bounds_3d(arr, max_bound, min_bound, err_message) - real(r8), intent(in) :: arr(:,:,:) - real(r8), intent(in) :: max_bound, min_bound - character(len=128), intent(out) :: err_message - real(r8) :: mx, mn - err_message = '' - mx = maxval(arr) - mn = minval(arr) - if (mn < min_bound) then - err_message = "validate: array values too small " - end if - if (mx > max_bound ) then - err_message = "validate: array values too large" - end if - end subroutine - - subroutine check_bounds_4d(arr, max_bound, min_bound, err_message) - real(r8), intent(in) :: arr(:,:,:,:) - real(r8), intent(in) :: max_bound, min_bound - character(len=128), intent(out) :: err_message - real(r8) :: mx, mn - err_message = '' - mx = maxval(arr) - mn = minval(arr) - if (mn < min_bound) then - err_message = "validate: array values too small " - end if - if (mx > max_bound ) then - err_message = "validate: array values too large" - end if - end subroutine - - subroutine check_bounds_5d(arr, max_bound, min_bound, err_message) - real(r8), intent(in) :: arr(:,:,:,:,:) - real(r8), intent(in) :: max_bound, min_bound - character(len=128), intent(out) :: err_message - real(r8) :: mx, mn - err_message = '' - mx = maxval(arr) - mn = minval(arr) - if (mn < min_bound) then - err_message = "validate: array values too small " - end if - if (mx > max_bound ) then - err_message = "validate: array values too large" - end if - end subroutine - - subroutine check_bounds_gas_concs(ncol, nlay, gasconcs, err_message) - integer, intent(in) :: ncol, nlay - type(ty_gas_concs), intent(in) :: gasconcs - character(len=128), intent(out) :: err_message - character(32), dimension(gasconcs%get_num_gases()) :: gc_gas_names - integer :: i - real(r8) :: vmr(ncol,nlay) - gc_gas_names(:) = gasconcs%get_gas_names() - do i = 1, gasconcs%get_num_gases() - err_message = gasconcs%get_vmr(gc_gas_names(i), vmr) ! gets values in vmr - if (len_trim(err_message) > 0) then - call endrun('check_bounds_gas_concs: error getting VMR for '//gc_gas_names(i)//' --> Error Message: '//trim(err_message)) - end if - call check_bounds(vmr, 1.0_r8, 0.0_r8, err_message) - if (len_trim(err_message) > 0) then - err_message = 'check_bounds_gas_concs: VMR error for '//gc_gas_names(i)//' --> Error Message: '//trim(err_message) - end if - end do - end subroutine - - subroutine check_bounds_gas_optics(kdist, err_message) - type(ty_gas_optics_rrtmgp), intent(in) :: kdist - character(len=128), intent(out) :: err_message - write(iulog,*) '[check_bonds_gas_optics DRAFT] : kdist' - ! write(iulog,*) 'number of gases: ',kdist%get_ngas() - ! write(iulog,*) 'gas names: ',kdist%get_gases() - ! write(iulog,*) 'kdist%source_is_external() = ',kdist%source_is_external() - err_message = "" - end subroutine - - - subroutine assert_shape_2dreal(arr, shp, err_message) - real(r8), intent(in) :: arr(:,:) ! 2-D array to check - integer, intent(in) :: shp(2) ! Expected shape - character(len=*), intent(out) :: err_message - character(len=512) :: err_append - integer :: r ! rank of arr - integer :: i - r = RANK(arr) - err_message = '' - if (r .ne. SIZE(shp)) then - err_message = 'Array is wrong rank (how could that happen?).' - end if - if (len_trim(err_message) == 0) then - do i = 1,r - if (SIZE(arr, i) /= shp(i)) then - write(err_append, "(a39,i3,a2)") 'Array size does not match on Dimension ', i, '._' - err_message = trim(err_message) // trim(err_append) - end if - end do - end if -end subroutine - -end module b_checker diff --git a/src/physics/rrtmgp/rad_solar_var.F90 b/src/physics/rrtmgp/rad_solar_var.F90 index 82c6b120d3..0cf996e901 100644 --- a/src/physics/rrtmgp/rad_solar_var.F90 +++ b/src/physics/rrtmgp/rad_solar_var.F90 @@ -4,6 +4,7 @@ !------------------------------------------------------------------------------- module rad_solar_var + use radconstants, only : nswbands use shr_kind_mod , only : r8 => shr_kind_r8 use solar_irrad_data, only : sol_irrad, we, nbins, has_spectrum, sol_tsi use solar_irrad_data, only : do_spctrl_scaling @@ -22,14 +23,12 @@ module rad_solar_var real(r8), allocatable :: radbinmax(:) real(r8), allocatable :: radbinmin(:) - integer :: nradbins !------------------------------------------------------------------------------- contains !------------------------------------------------------------------------------- subroutine rad_solar_var_init( ) - use radconstants, only : get_number_sw_bands use radconstants, only : get_sw_spectral_boundaries use radconstants, only : get_ref_solar_band_irrad use radconstants, only : get_ref_total_solar_irrad @@ -40,30 +39,28 @@ subroutine rad_solar_var_init( ) integer :: radmax_loc - call get_number_sw_bands(nradbins) - if ( do_spctrl_scaling ) then if ( .not.has_spectrum ) then call endrun('rad_solar_var_init: solar input file must have irradiance spectrum') endif - allocate (radbinmax(nradbins),stat=ierr) + allocate (radbinmax(nswbands),stat=ierr) if (ierr /= 0) then call endrun('rad_solar_var_init: Error allocating space for radbinmax') end if - allocate (radbinmin(nradbins),stat=ierr) + allocate (radbinmin(nswbands),stat=ierr) if (ierr /= 0) then call endrun('rad_solar_var_init: Error allocating space for radbinmin') end if - allocate (ref_band_irrad(nradbins), stat=ierr) + allocate (ref_band_irrad(nswbands), stat=ierr) if (ierr /= 0) then call endrun('rad_solar_var_init: Error allocating space for ref_band_irrad') end if - allocate (irrad(nradbins), stat=ierr) + allocate (irrad(nswbands), stat=ierr) if (ierr /= 0) then call endrun('rad_solar_var_init: Error allocating space for irrad') end if @@ -91,15 +88,15 @@ end subroutine rad_solar_var_init !------------------------------------------------------------------------------- subroutine get_variability( sfac ) - real(r8), intent(out) :: sfac(nradbins) ! scaling factors for CAM heating + real(r8), intent(out) :: sfac(nswbands) ! scaling factors for CAM heating integer :: yr, mon, day, tod if ( do_spctrl_scaling ) then - call integrate_spectrum( nbins, nradbins, we, radbinmin, radbinmax, sol_irrad, irrad) - sfac(:nradbins) = irrad(:nradbins)/ref_band_irrad(:nradbins) + call integrate_spectrum( nbins, nswbands, we, radbinmin, radbinmax, sol_irrad, irrad) + sfac(:nswbands) = irrad(:nswbands)/ref_band_irrad(:nswbands) else - sfac(:nradbins) = sol_tsi/tsi_ref + sfac(:nswbands) = sol_tsi/tsi_ref endif end subroutine get_variability diff --git a/src/physics/rrtmgp/radconstants.F90 b/src/physics/rrtmgp/radconstants.F90 index 1d1657fdc4..e573bfb792 100644 --- a/src/physics/rrtmgp/radconstants.F90 +++ b/src/physics/rrtmgp/radconstants.F90 @@ -20,9 +20,9 @@ module radconstants private save -! Number of bands in SW and LW (these will be set when RRTMGP initializes) -integer, public, protected :: nswbands = 14 -integer, public, protected :: nlwbands = 16 +! Number of bands in SW and LW (these will be checked when RRTMGP initializes) +integer, parameter, public :: nswbands = 14 +integer, parameter, public :: nlwbands = 16 ! Band limits (these get also get set at initialization) real(r8), public, allocatable :: wavenumber_low_shortwave(:) @@ -137,39 +137,23 @@ module radconstants public :: rad_gas_index -public :: get_number_sw_bands, & - get_sw_spectral_boundaries, & +public :: get_sw_spectral_boundaries, & get_lw_spectral_boundaries, & get_ref_solar_band_irrad, & get_ref_total_solar_irrad, & - ! get_solar_band_fraction_irrad, & get_idx_sw_diag, & get_idx_nir_diag, & get_idx_uv_diag, & get_idx_lw_diag, & get_band_index_by_value, & set_wavenumber_bands,& - get_number_lw_bands, & - set_number_lw_bands, & - set_number_sw_bands, & set_irrad_by_band, & set_reference_tsi +!=============================================================================== contains -!------------------------------------------------------------------------------ - ! COMMENT -- THIS CODE IS NOT USED. - ! subroutine get_solar_band_fraction_irrad(fractional_irradiance) - ! ! provide Solar Irradiance for each band in RRTMG - - ! ! fraction of solar irradiance in each band - ! real(r8), intent(out) :: fractional_irradiance(1:nswbands) - ! real(r8) :: tsi ! total solar irradiance - - ! tsi = sum(solar_ref_band_irradiance) - ! fractional_irradiance = solar_ref_band_irradiance / tsi +!=============================================================================== - ! end subroutine get_solar_band_fraction_irrad -!------------------------------------------------------------------------------ subroutine get_ref_total_solar_irrad(tsi) ! provide Total Solar Irradiance assumed by RRTMGP @@ -202,39 +186,9 @@ subroutine get_ref_solar_band_irrad( band_irrad ) end if end subroutine get_ref_solar_band_irrad -!------------------------------------------------------------------------------ -subroutine get_number_sw_bands(number_of_bands) - - ! number of solar (shortwave) bands - integer, intent(out) :: number_of_bands - number_of_bands = nswbands - -end subroutine get_number_sw_bands -!------------------------------------------------------------------------------ -subroutine set_number_sw_bands(number_of_bands) - ! set module data nswbands - ! expect: number_of_bands provided from RRTMGP optical properties object - integer, intent(in) :: number_of_bands - nswbands = number_of_bands -end subroutine set_number_sw_bands !------------------------------------------------------------------------------ -subroutine get_number_lw_bands(number_of_bands) - - ! number of longwave bands - integer, intent(out) :: number_of_bands - number_of_bands = nlwbands - -end subroutine get_number_lw_bands -!------------------------------------------------------------------------------ -subroutine set_number_lw_bands(number_of_bands) - ! set module data nlwbands - ! expect: number_of_bands provided from RRTMGP optical properties object - integer, intent(in) :: number_of_bands - nlwbands = number_of_bands -end subroutine set_number_lw_bands -!------------------------------------------------------------------------------ subroutine set_wavenumber_bands(swlw, nbands, values) ! set the low and high limits of the wavenumber grid for sw or lw ! expect that values comes from RRTMGP method get_band_lims_wavenumber @@ -307,7 +261,7 @@ subroutine get_sw_spectral_boundaries(low_boundaries, high_boundaries, units) low_boundaries = 1._r8/wavenumber_high_shortwave high_boundaries = 1._r8/wavenumber_low_shortwave case default - call endrun('rad_constants.F90: spectral units not acceptable'//units) + call endrun('rad_constants.F90: requested spectral units not acceptable: '//units) end select end subroutine get_sw_spectral_boundaries diff --git a/src/physics/rrtmgp/radiation.F90 b/src/physics/rrtmgp/radiation.F90 index e3a631d4c4..2c49821be6 100644 --- a/src/physics/rrtmgp/radiation.F90 +++ b/src/physics/rrtmgp/radiation.F90 @@ -464,7 +464,7 @@ subroutine radiation_init(pbuf2d) use modal_aer_opt, only: modal_aer_opt_init use rrtmgp_inputs, only: rrtmgp_inputs_init use time_manager, only: is_first_step - use radconstants, only: set_number_sw_bands, set_number_lw_bands, set_wavenumber_bands, set_irrad_by_band, set_reference_tsi + use radconstants, only: set_wavenumber_bands, set_irrad_by_band, set_reference_tsi ! arguments type(physics_buffer_desc), pointer :: pbuf2d(:,:) @@ -530,10 +530,20 @@ subroutine radiation_init(pbuf2d) call coefs_init(coefs_sw_file, kdist_sw, available_gases, band2gpt_sw, ref_tsi) ! bpm : these now provide band2gpt which should be global call set_reference_tsi(ref_tsi) - ! set number of sw/lw bands in radconstants - call set_number_sw_bands(kdist_sw%get_nband()) - call set_number_lw_bands(kdist_lw%get_nband()) - write(iulog, *) 'rad_init: NUMBER SW BANDS: ',kdist_sw%get_nband(),' NUMBER LW BANDS: ',kdist_lw%get_nband() + ! check number of sw/lw bands in gas optics files + if (kdist_sw%get_nband() /= nswbands) then + write(errmsg,'(a,i4,a,i4)') 'number of sw bands in file, ', kdist_sw%get_nband(), & + ", doesn't match parameter nswbands= ", nswbands + call endrun(sub//': ERROR: '//trim(errmsg)) + end if + if (kdist_lw%get_nband() /= nlwbands) then + write(errmsg,'(a,i4,a,i4)') 'number of lw bands in file, ', kdist_lw%get_nband(), & + ", doesn't match parameter nlwbands= ", nlwbands + call endrun(sub//': ERROR: '//trim(errmsg)) + end if + if (masterproc) then + write(iulog, *) sub//': NUMBER SW BANDS: ', nswbands,' NUMBER LW BANDS: ', nlwbands + end if ! set the sw/lw band limits in radconstants call set_wavenumber_bands('sw', kdist_sw%get_nband(), kdist_sw%get_band_lims_wavenumber()) @@ -1495,50 +1505,6 @@ subroutine radiation_tend( & call clipper(cloud_sw%ssa, 0._r8, 1._r8) call clipper(cloud_sw%g, -1._r8, 1._r8) - ! CHECK BOUNDS OF ARRAYS: - ! errmsg = cloud_sw%validate() ! rte provides validate method for tau, ssa, and g all at once. - ! if (len_trim(errmsg) > 0) then - ! call endrun(sub//': ERROR code returned by check_bounds cloud_sw: '//trim(errmsg)) - ! end if - ! errmsg = aer_sw%validate() ! rte provides validate method for tau, ssa, and g all at once. - ! if (len_trim(errmsg) > 0) then - ! call endrun(sub//': ERROR code returned by check_bounds aer_sw: '//trim(errmsg)) - ! end if - ! call check_bounds(alb_dir, 1.0_r8, 0.0_r8, errmsg) - ! if (len_trim(errmsg) > 0) then - ! call endrun(sub//': ERROR code returned by check_bounds alb_dir: '//trim(errmsg)) - ! end if - ! call check_bounds(alb_dif, 1.0_r8, 0.0_r8, errmsg) - ! if (len_trim(errmsg) > 0) then - ! call endrun(sub//': ERROR code returned by check_bounds alb_dif: '//trim(errmsg)) - ! end if - ! call check_bounds(coszrs_day, 1.0_r8, 0.0_r8, errmsg) - ! if (len_trim(errmsg) > 0) then - ! call endrun(sub//': ERROR code returned by check_bounds coszrs_day: '//trim(errmsg)) - ! end if - ! call check_bounds(pint_day, 120000.0_r8, 1.0_r8, errmsg) ! Pa -- give pretty big bounds - ! if (len_trim(errmsg) > 0) then - ! call endrun(sub//': ERROR code returned by check_bounds pint_day: '//trim(errmsg)) - ! end if - ! call check_bounds(t_day, 350.0_r8, 150.0_r8, errmsg) ! K -- give pretty big bounds - ! if (len_trim(errmsg) > 0) then - ! call endrun(sub//': ERROR code returned by check_bounds t_day: '//trim(errmsg)) - ! end if - ! call check_bounds(pmid_day, 120000.0_r8, 1.0_r8, errmsg) ! Pa -- give pretty big bounds - ! if (len_trim(errmsg) > 0) then - ! call endrun(sub//': ERROR code returned by check_bounds pint_day: '//trim(errmsg)) - ! end if - - - ! Still to validate: - ! - kdist_sw - ! - gas_concs_sw - ! call check_bounds(nday, nlay, gas_concs_sw, errmsg) - ! if (len_trim(errmsg) > 0) then - ! call endrun(sub//': ERROR code returned by check_bounds gas_concs_sw: '//trim(errmsg)) - ! end if - ! call check_bounds(kdist_sw, errmsg) -! call shr_mem_getusage(mem_hw_beg, mem_beg) ! inputs are the daylit columns --> output fluxes therefore also on daylit columns. errmsg = rte_sw( kdist_sw, & ! input (from init) gas_concs_sw, & ! input, (from rrtmgp_set_gases_sw) @@ -1555,18 +1521,6 @@ subroutine radiation_tend( & tsi_scaling=eccf & !< optional input, scaling for irradiance ) -! call shr_mem_getusage(mem_hw_end, mem_end) -! temp = mem_hw_end - mem_hw_beg -! if (masterproc) then -! write(iulog, *) 'rte_sw: Increase in memory highwater = ', & -! temp, ' (MB)' -! end if -! temp = mem_end - mem_beg -! if (masterproc) then -! write(iulog, *) 'rte_sw: Increase in memory usage = ', & -! temp, ' (MB)' -! end if - if (len_trim(errmsg) > 0) then call endrun(sub//': ERROR code returned by rte_sw: '//trim(errmsg)) end if @@ -1667,7 +1621,7 @@ subroutine radiation_tend( & cloud_lw & ! inout (%tau is set, and returned bottom-to-top) ) - ! initialize/allocate object for aerosol optics (note, don't just give it nlwbands b/c wrong type) + ! initialize/allocate object for aerosol optics errmsg = aer_lw%alloc_1scl(ncol, & nlay, & kdist_lw%get_band_lims_wavenumber(), & @@ -1821,9 +1775,6 @@ subroutine radiation_tend( & end if ! if (dosw .or. dolw) then - ! write(iulog,*) 'Radiation_Tend finished calculation [timestep ',get_nstep(), ', chunk: ',lchnk,'] -- qrs max: ',maxval(qrs),' min: ',minval(qrs),' -- qrl max: ',maxval(qrl), ' min: ',minval(qrl) - - ! ------------------------------------------------------------------------ ! ! After any radiative transfer is done: output & convert fluxes to heating @@ -1870,8 +1821,6 @@ subroutine radiation_tend( & call free_fluxes(flw) call free_fluxes(flwc) - ! write(iulog,*) 'Radiation_Tend END [timestep ',get_nstep(), ', chunk: ',lchnk,']' - !------------------------------------------------------------------------------- contains !------------------------------------------------------------------------------- From 3022b4c8484e864d312b8093b8702a374ec51db8 Mon Sep 17 00:00:00 2001 From: Brian Eaton Date: Wed, 5 Jul 2023 11:01:23 -0400 Subject: [PATCH 117/291] remove references to b_checker --- src/physics/rrtmgp/rrtmgp_inputs.F90 | 20 -------------------- 1 file changed, 20 deletions(-) diff --git a/src/physics/rrtmgp/rrtmgp_inputs.F90 b/src/physics/rrtmgp/rrtmgp_inputs.F90 index 90d87fcf07..116093add4 100644 --- a/src/physics/rrtmgp/rrtmgp_inputs.F90 +++ b/src/physics/rrtmgp/rrtmgp_inputs.F90 @@ -38,7 +38,6 @@ module rrtmgp_inputs use cam_abortutils, only: endrun use cam_history, only: outfld ! just for getting ozone VMR above model top. -use b_checker, only: assert_shape ! checking on shapes implicit none private @@ -149,25 +148,6 @@ subroutine rrtmgp_set_state( & character(len=512) :: errmsg !-------------------------------------------------------------------------------- - ! - ! bpm note: the size of pstate%t 's 1st dimension can be larger than ncol. Assume we are only interested in 1:ncol. - ! - ! call assert_shape(pstate%t, (/ncol, pver/), errmsg) - ! if (len_trim(errmsg) > 0) then - ! write(iulog,*) '['//sub//'] : pstate%t -- shape: ',SHAPE(pstate%t),'[EXPECTED: (',ncol,'x',pver,')] max: ',maxval(pstate%t),' min: ',minval(pstate%t) - ! call endrun(sub//trim(errmsg)) - ! end if - ! call assert_shape(pstate%pmid, (/ncol, pver/), errmsg) - ! if (len_trim(errmsg) > 0) then - ! write(iulog,*) '['//sub//'] : pstate%pmid -- shape: ',SHAPE(pstate%pmid),' max: ',maxval(pstate%pmid),' min: ',minval(pstate%pmid) - ! call endrun(sub//trim(errmsg)) - ! end if - ! call assert_shape(pstate%pint, (/ncol, pverp/), errmsg) - ! if (len_trim(errmsg) > 0) then - ! write(iulog,*) '['//sub//'] : pstate%pint -- shape: ',SHAPE(pstate%pint),' max: ',maxval(pstate%pint),' min: ',minval(pstate%pint) - ! call endrun(sub//trim(errmsg)) - ! end if - t_sfc = sqrt(sqrt(cam_in%lwup(:ncol)/stebol)) ! Surface temp set based on longwave up flux. ! Set surface emissivity to 1.0. From fd417ba4c9ec127a70de6fb9f63605d7d300e00a Mon Sep 17 00:00:00 2001 From: Brian Eaton Date: Wed, 19 Jul 2023 19:17:00 -0400 Subject: [PATCH 118/291] add configure option rrtmgp_smp; misc cleanup --- bld/configure | 17 +++++-- bld/namelist_files/use_cases/1850_cam5.xml | 54 ++++++++++++++++++++++ src/chemistry/utils/solar_data.F90 | 1 + src/physics/rrtmg/radiation.F90 | 6 --- src/physics/rrtmgp/radiation.F90 | 50 +++++++++----------- 5 files changed, 91 insertions(+), 37 deletions(-) create mode 100644 bld/namelist_files/use_cases/1850_cam5.xml diff --git a/bld/configure b/bld/configure index 11923363dd..d7ff1c0f9e 100755 --- a/bld/configure +++ b/bld/configure @@ -103,7 +103,7 @@ OPTIONS -prog_species Comma-separate list of prognostic mozart species packages. Currently available: DST,SSLT,SO4,GHG,OC,BC,CARBON16 -psubcols Maximum number of sub-columns in a run - set to 1 if not using sub-columns (default) - -rad Specify the radiation package [rrtmg | rrtmgp | camrt] + -rad Specify the radiation package [rrtmg | rrtmgp | rrtmgp_smp | camrt] -silhs Switch on SILHS. -spcam_clubb_sgs Turn on the SPCAM version of CLUBB -spcam_nx SPCAM x-grid. - defaults to 4 (note the CRM requires spcam_nx to be greater than or equal to 4) @@ -1066,8 +1066,16 @@ elsif ($phys_pkg =~ m/^cam[56]$|^cam_dev$|^spcam_m2005$/) { $rad_pkg = 'rrtmg'; } # Allow the user to override the default via the commandline. +my $use_rrtmgp_smp = 0; if (defined $opts{'rad'}) { $rad_pkg = lc($opts{'rad'}); + # If the radiation package is set to rrtmgp_smp then will add the smp code version + # (openmp and openacc) to the Filepath file, but strip off the "_smp" when setting + # the radiation package name in the config_cache file. + if ($rad_pkg eq 'rrtmgp_smp') { + $use_rrtmgp_smp = 1; + $rad_pkg =~ s!_smp!! + } } # consistency checks... @@ -2180,11 +2188,14 @@ sub write_filepath } elsif ($rad eq 'rrtmgp') { print $fh "$camsrcdir/src/physics/rrtmgp\n"; - print $fh "$camsrcdir/src/physics/rrtmgp/ext\n"; print $fh "$camsrcdir/src/physics/rrtmgp/ext/rrtmgp\n"; print $fh "$camsrcdir/src/physics/rrtmgp/ext/rte\n"; - print $fh "$camsrcdir/src/physics/rrtmgp/ext/rte/kernels\n"; + if ($use_rrtmgp_smp) { + print $fh "$camsrcdir/src/physics/rrtmgp/ext/rrtmgp/kernels-openacc\n"; + print $fh "$camsrcdir/src/physics/rrtmgp/ext/rte/kernels-openacc\n"; + } print $fh "$camsrcdir/src/physics/rrtmgp/ext/rrtmgp/kernels\n"; + print $fh "$camsrcdir/src/physics/rrtmgp/ext/rte/kernels\n"; print $fh "$camsrcdir/src/physics/rrtmgp/ext/extensions\n"; print $fh "$camsrcdir/src/physics/rrtmgp/ext/extensions/cloud_optics\n"; } diff --git a/bld/namelist_files/use_cases/1850_cam5.xml b/bld/namelist_files/use_cases/1850_cam5.xml new file mode 100644 index 0000000000..f33151bb3d --- /dev/null +++ b/bld/namelist_files/use_cases/1850_cam5.xml @@ -0,0 +1,54 @@ + + + + + +atm/cam/solar/SOLAR_SPECTRAL_Lean_1610-2008_annual_c090324.nc +18500101 +FIXED + + +284.7e-6 +791.6e-9 +275.68e-9 +12.48e-12 +0.0 + + +atm/cam/ozone +ozone_1.9x2.5_L26_1850clim_c090420.nc +O3 +CYCLICAL +1850 + + +CYCLICAL +atm/cam/chem/trop_mozart_aero/emis/aerocom_mam3_dms_surf_2000_c090129.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_so2_surf_1850_c090726.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_soag_1.5_surf_1850_c100217.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_bc_surf_1850_c090726.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_oc_surf_1850_c090726.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_so4_a1_surf_1850_c090726.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_so4_a2_surf_1850_c090726.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_num_a1_surf_1850_c090726.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_num_a2_surf_1850_c090726.nc + + +CYCLICAL +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_so2_elev_1850_c090726.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_so4_a1_elev_1850_c090726.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_so4_a2_elev_1850_c090726.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_num_a1_elev_1850_c090726.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_num_a2_elev_1850_c090726.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_oc_elev_1850_c090726.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_bc_elev_1850_c090726.nc + + +CYCLICAL +1850 +oxid_1.9x2.5_L26_1850clim_c091123.nc + + +1850 + + diff --git a/src/chemistry/utils/solar_data.F90 b/src/chemistry/utils/solar_data.F90 index da18fbc777..51ad7ad82b 100644 --- a/src/chemistry/utils/solar_data.F90 +++ b/src/chemistry/utils/solar_data.F90 @@ -91,6 +91,7 @@ subroutine solar_data_readnl( nlfile ) write(iulog,*) 'solar_data_readnl: solar_data_type = ',trim(solar_data_type) write(iulog,*) 'solar_data_readnl: solar_data_ymd = ',solar_data_ymd write(iulog,*) 'solar_data_readnl: solar_data_tod = ',solar_data_tod + write(iulog,*) 'solar_data_readnl: solar_htng_spctrl_scl = ',solar_htng_spctrl_scl endif solar_parms_on = solar_parms_data_file.ne.'NONE' diff --git a/src/physics/rrtmg/radiation.F90 b/src/physics/rrtmg/radiation.F90 index 137e4a01d6..31e33b183d 100644 --- a/src/physics/rrtmg/radiation.F90 +++ b/src/physics/rrtmg/radiation.F90 @@ -1215,12 +1215,6 @@ subroutine radiation_tend( & rd%aer_tau400(:ncol,:) = aer_tau(:ncol,:,idx_sw_diag+1) rd%aer_tau700(:ncol,:) = aer_tau(:ncol,:,idx_sw_diag-1) - print*,'--- Right before rad_rrtmg_sw ---' - do k=1,pver - print '("LEVEL",i2,3x,"TAU (max) = ",f7.4,3x)', k,MAXVAL(c_cld_tau(:,1,k)) - end do - - call rad_rrtmg_sw( & lchnk, ncol, num_rrtmg_levs, r_state, state%pmid, & cldfprime, aer_tau, aer_tau_w, aer_tau_w_g, aer_tau_w_f, & diff --git a/src/physics/rrtmgp/radiation.F90 b/src/physics/rrtmgp/radiation.F90 index 2c49821be6..cb65b9108e 100644 --- a/src/physics/rrtmgp/radiation.F90 +++ b/src/physics/rrtmgp/radiation.F90 @@ -196,14 +196,18 @@ module radiation ! Number of layers in radiation calculations. integer :: nlay -! Indices for copying data between cam and rrtmgp arrays -! The code currently assumes the rrtmgp vertical index goes bottom to top, -! while CAM goes top-to-bottom ... -! Newer RRTMGP checks for host model order and adjusts, so a lot of the assumptions are unncessary. -integer :: ktopcamm ! cam index of top layer -integer :: ktopradm ! rrtmgp index of layer corresponding to ktopcamm -integer :: ktopcami ! cam index of top interface -integer :: ktopradi ! rrtmgp index of interface corresponding to ktopcami +! Indices for copying data between CAM/WACCM and RRTMGP arrays. Since RRTMGP is +! vertical order agnostic we can send data using the top to bottom order used +! in CAM/WACCM. But the number of layers that RRTMGP does computations for +! may not match the number of layers in CAM/WACCM for two reasons: +! 1. If the CAM model top is below 1 Pa, then RRTMGP does calculations for an +! extra layer that is added between 1 Pa and the model top. +! 2. If the WACCM model top is above 1 Pa, then RRMTGP only does calculations +! for those model layers that are below 1 Pa. +integer :: ktopcamm ! index in CAM arrays of top layer at which RRTMGP is active +integer :: ktopcami ! index in CAM arrays of top interface at which RRTMGP is active +integer :: ktopradm ! index in RRTMGP arrays of layer corresponding to CAM top layer +integer :: ktopradi ! index in RRTMGP arrays of interface corresponding to CAM top interface ! LW coefficients type(ty_gas_optics_rrtmgp) :: kdist_lw ! bpm changed here @@ -287,7 +291,7 @@ subroutine radiation_readnl(nlfile) call mpi_bcast(rrtmgp_coefs_lw_file, cl, mpi_character, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(subroutine_name//": FATAL: mpi_bcast: rrtmgp_coefs_lw_file") call mpi_bcast(rrtmgp_coefs_sw_file, cl, mpi_character, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(subroutine_name//": FATAL: mpi_bcast: coefs_sw_file") + if (ierr /= 0) call endrun(subroutine_name//": FATAL: mpi_bcast: rrtmgp_coefs_sw_file") call mpi_bcast(iradsw, 1, mpi_integer, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(subroutine_name//": FATAL: mpi_bcast: iradsw") call mpi_bcast(iradlw, 1, mpi_integer, mstrid, mpicom, ierr) @@ -493,36 +497,26 @@ subroutine radiation_init(pbuf2d) character(len=*), parameter :: sub = 'radiation_init' !----------------------------------------------------------------------- - ! - ! replacement of RRTMG's rrtmg_state_init - ! - ! Number of layers in radiation calculation is capped by the number of ! pressure interfaces below 1 Pa. When the entire model atmosphere is ! below 1 Pa then an extra layer is added to the top of the model for ! the purpose of the radiation calculation. nlay = count( pref_edge(:) > 1._r8 ) ! pascals (0.01 mbar) - ! Use k*rad* to access variables ON THE RADIATION GRID - ! Use k*cam* to access variables ON THE CAM GRID if (nlay == pverp) then - ktopcamm = 1 ! interpretation: highest CAM grid layer at which radiation is active - ktopcami = 1 - ktopradm = nlay + 1 - pver ! radiation grid layer the corresponds to CAM's highest layer (expected to be 2) - ktopradi = nlay + 1 - pver - else ! nlay < pverp - ! nlay layers are set by radiation - ! nlay+1 interfaces are set by radiation + ! Top model interface is below 1 Pa. RRTMGP is active in all model layers plus + ! 1 extra layer between model top and 1 Pa. + ktopcamm = 1 + ktopcami = 1 + ktopradm = 2 + ktopradi = 2 + else + ! nlay < pverp. nlay layers are set by radiation ktopcamm = pverp - nlay + 1 ktopcami = pverp - nlay + 1 - ktopradm = 1 ! radiation grid index at top is just 1 + ktopradm = 1 ktopradi = 1 end if - ! bottom indices are known, so we don't need to have extra variables. - ! kbotcamm = pver - ! kbotcami = pverp - ! kbotradm = nlay - ! kbotradi = nlay + 1 call set_available_gases(active_gases, available_gases) ! gases needed to initialize spectral info From f71850c17ca06cbf48f1a4aa18bb1c34695b08a5 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Fri, 28 Jul 2023 09:47:03 -0600 Subject: [PATCH 119/291] Post-merge update to add pbuf argument to GEOS-Chem chem_emissions This update enables GEOS-Chem compsets to compile following update to a more recent version of CAM. Signed-off-by: Lizzie Lundgren --- src/chemistry/geoschem/chemistry.F90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/chemistry/geoschem/chemistry.F90 b/src/chemistry/geoschem/chemistry.F90 index 49faa7d6a1..59c14be74b 100644 --- a/src/chemistry/geoschem/chemistry.F90 +++ b/src/chemistry/geoschem/chemistry.F90 @@ -4452,14 +4452,16 @@ end subroutine chem_read_restart !================================================================================ - subroutine chem_emissions( state, cam_in ) + subroutine chem_emissions( state, cam_in, pbuf ) + use physics_buffer, only : physics_buffer_desc use camsrfexch, only : cam_in_t ! Arguments: TYPE(physics_state), INTENT(IN) :: state ! Physics state variables TYPE(cam_in_t), INTENT(INOUT) :: cam_in ! import state + TYPE(physics_buffer_desc), pointer :: pbuf(:) ! Physics buffer in chunk, for HEMCO INTEGER :: M, N INTEGER :: LCHNK, nY From 5eb55a137df149328a8cc52a4cd580b263aa5ec1 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Fri, 28 Jul 2023 15:17:35 -0600 Subject: [PATCH 120/291] Updates to use HEMCO for GEOS-Chem compset These updates are necessary following changes to how HEMCO is integrated into CESM. Signed-off-by: Lizzie Lundgren --- bld/namelist_files/use_cases/2000_geoschem.xml | 3 +++ bld/namelist_files/use_cases/2010_geoschem.xml | 4 ++++ bld/namelist_files/use_cases/hist_geoschem.xml | 3 +++ bld/namelist_files/use_cases/hist_geoschem_nudged.xml | 3 +++ bld/namelist_files/use_cases/sd_geoschem.xml | 3 +++ cime_config/config_component.xml | 2 +- cime_config/config_compsets.xml | 10 +++++----- 7 files changed, 22 insertions(+), 6 deletions(-) diff --git a/bld/namelist_files/use_cases/2000_geoschem.xml b/bld/namelist_files/use_cases/2000_geoschem.xml index 49b49d6cd6..d967d25c41 100644 --- a/bld/namelist_files/use_cases/2000_geoschem.xml +++ b/bld/namelist_files/use_cases/2000_geoschem.xml @@ -14,6 +14,9 @@ /glade/p/univ/umit0034/Shared/dep_data_file_geoschem_c230417.nc +HEMCO_Config.rc +HEMCO_Diagn.rc + 00010101 diff --git a/bld/namelist_files/use_cases/2010_geoschem.xml b/bld/namelist_files/use_cases/2010_geoschem.xml index cf9ae2af8b..b0bce3ae6b 100644 --- a/bld/namelist_files/use_cases/2010_geoschem.xml +++ b/bld/namelist_files/use_cases/2010_geoschem.xml @@ -12,6 +12,10 @@ /glade/p/univ/umit0034/Shared/dep_data_file_geoschem_c230417.nc +HEMCO_Config.rc +HEMCO_Diagn.rc + + 00010101 diff --git a/bld/namelist_files/use_cases/hist_geoschem.xml b/bld/namelist_files/use_cases/hist_geoschem.xml index 83d3fc39ba..6e4c1d181b 100644 --- a/bld/namelist_files/use_cases/hist_geoschem.xml +++ b/bld/namelist_files/use_cases/hist_geoschem.xml @@ -14,6 +14,9 @@ /glade/p/univ/umit0034/Shared/dep_data_file_geoschem_c230417.nc +HEMCO_Config.rc +HEMCO_Diagn.rc + 00010101 diff --git a/bld/namelist_files/use_cases/hist_geoschem_nudged.xml b/bld/namelist_files/use_cases/hist_geoschem_nudged.xml index cf75619028..13afb38906 100644 --- a/bld/namelist_files/use_cases/hist_geoschem_nudged.xml +++ b/bld/namelist_files/use_cases/hist_geoschem_nudged.xml @@ -14,6 +14,9 @@ /glade/p/univ/umit0034/Shared/dep_data_file_geoschem_c230417.nc +HEMCO_Config.rc +HEMCO_Diagn.rc + 00010101 diff --git a/bld/namelist_files/use_cases/sd_geoschem.xml b/bld/namelist_files/use_cases/sd_geoschem.xml index 41647f8ecb..8691b5babb 100644 --- a/bld/namelist_files/use_cases/sd_geoschem.xml +++ b/bld/namelist_files/use_cases/sd_geoschem.xml @@ -16,6 +16,9 @@ /glade/p/univ/umit0034/Shared/dep_data_file_geoschem_c230417.nc +HEMCO_Config.rc +HEMCO_Diagn.rc + diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index ce2432a7cd..c368028508 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -141,7 +141,7 @@ -phys cam_dev -chem ghg_mam4 -chem trop_strat_mam5_vbs - -chem geoschem_mam4 -hemco + -chem geoschem_mam4 -chem trop_mam7 -chem trop_strat_mam5_vbsext diff --git a/cime_config/config_compsets.xml b/cime_config/config_compsets.xml index 38fdeedf98..7ca1787566 100644 --- a/cime_config/config_compsets.xml +++ b/cime_config/config_compsets.xml @@ -563,27 +563,27 @@ FC2000climo_GC - 2000_CAM60%GC_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV + 2000_CAM60%GC_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV%HEMCO FC2010climo_GC - 2010_CAM60%GC_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV + 2010_CAM60%GC_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV%HEMCO FCHIST_GC - HIST_CAM60%GC_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV + HIST_CAM60%GC_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV%HEMCO FCSD_GC - HIST_CAM60%GC%SDYN_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV + HIST_CAM60%GC%SDYN_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV%HEMCO FCnudged_GC - HIST_CAM60%GC%NUDG_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV + HIST_CAM60%GC%NUDG_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV%HEMCO From 4563541e7f2fd32e1b11ef43b3c2da9819860191 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Fri, 28 Jul 2023 15:17:50 -0600 Subject: [PATCH 121/291] Minor cleanup changes Signed-off-by: Lizzie Lundgren --- bld/build-namelist | 2 +- cime_config/config_component.xml | 8 +------- 2 files changed, 2 insertions(+), 8 deletions(-) diff --git a/bld/build-namelist b/bld/build-namelist index 9289a0ebd5..b36f5d7cb5 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -2473,7 +2473,7 @@ if (($chem =~ /_mam4/ or $chem =~ /_mam5/) and ($phys =~ /cam6/ or $phys =~ /cam $first = 0; } } - if ($chem !~ /geoschem/) { + if ($chem !~ /geoschem/) { add_default($nl, 'ext_frc_specifier', 'val'=>$val); unless (defined $nl->get_value('ext_frc_type')) { add_default($nl, 'ext_frc_type', 'val'=>"'CYCLICAL'"); diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index c368028508..899c6083ae 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -187,7 +187,6 @@ -phys tj2016 -analytic_ic -phys grayrad -analytic_ic -phys held_suarez -analytic_ic - -phys held_suarez -chem geoschem -hemco -analytic_ic -phys kessler -chem terminator -analytic_ic -nadv_tt=6 @@ -228,11 +227,6 @@ waccmxie_ma_2000_cam4 waccmx_ma_2000_cam4 - geoschem - geoschem - geoschem - geoschem_baro_moist - 2000_cam6 2000_cam6 waccm_tsmlt_2000_cam6 @@ -278,7 +272,7 @@ hist_trop_strat_vbsext_cam6 hist_trop_strat_vbsfire_cam6 hist_geoschem - hist_geoschem_nudged + hist_geoschem_nudged waccmx_ma_hist_cam6 1850-PD_cam5 From 8d315350292ae1bd0bbc263ee436be8a174a7a8c Mon Sep 17 00:00:00 2001 From: Brian Eaton Date: Fri, 28 Jul 2023 18:30:12 -0400 Subject: [PATCH 122/291] change rrtmgp_smp to rrtmgp_gpu; fix SW TOA output vars --- bld/configure | 16 ++++++++-------- src/physics/rrtmgp/radiation.F90 | 8 ++++---- 2 files changed, 12 insertions(+), 12 deletions(-) diff --git a/bld/configure b/bld/configure index 5632254270..a6a4ee804d 100755 --- a/bld/configure +++ b/bld/configure @@ -103,7 +103,7 @@ OPTIONS -prog_species Comma-separate list of prognostic mozart species packages. Currently available: DST,SSLT,SO4,GHG,OC,BC,CARBON16 -psubcols Maximum number of sub-columns in a run - set to 1 if not using sub-columns (default) - -rad Specify the radiation package [rrtmg | rrtmgp | rrtmgp_smp | camrt] + -rad Specify the radiation package [rrtmg | rrtmgp | rrtmgp_gpu | camrt] -silhs Switch on SILHS. -spcam_clubb_sgs Turn on the SPCAM version of CLUBB -spcam_nx SPCAM x-grid. - defaults to 4 (note the CRM requires spcam_nx to be greater than or equal to 4) @@ -1066,15 +1066,15 @@ elsif ($phys_pkg =~ m/^cam[56]$|^cam_dev$|^spcam_m2005$/) { $rad_pkg = 'rrtmg'; } # Allow the user to override the default via the commandline. -my $use_rrtmgp_smp = 0; +my $use_rrtmgp_gpu = 0; if (defined $opts{'rad'}) { $rad_pkg = lc($opts{'rad'}); - # If the radiation package is set to rrtmgp_smp then will add the smp code version - # (openmp and openacc) to the Filepath file, but strip off the "_smp" when setting + # If the radiation package is set to rrtmgp_gpu then will add the gpu code version + # (openmp and openacc) to the Filepath file, but strip off the "_gpu" when setting # the radiation package name in the config_cache file. - if ($rad_pkg eq 'rrtmgp_smp') { - $use_rrtmgp_smp = 1; - $rad_pkg =~ s!_smp!! + if ($rad_pkg eq 'rrtmgp_gpu') { + $use_rrtmgp_gpu = 1; + $rad_pkg =~ s!_gpu!! } } @@ -2214,7 +2214,7 @@ sub write_filepath print $fh "$camsrcdir/src/physics/rrtmgp\n"; print $fh "$camsrcdir/src/physics/rrtmgp/ext/rrtmgp\n"; print $fh "$camsrcdir/src/physics/rrtmgp/ext/rte\n"; - if ($use_rrtmgp_smp) { + if ($use_rrtmgp_gpu) { print $fh "$camsrcdir/src/physics/rrtmgp/ext/rrtmgp/kernels-openacc\n"; print $fh "$camsrcdir/src/physics/rrtmgp/ext/rte/kernels-openacc\n"; } diff --git a/src/physics/rrtmgp/radiation.F90 b/src/physics/rrtmgp/radiation.F90 index cb65b9108e..b7883aed45 100644 --- a/src/physics/rrtmgp/radiation.F90 +++ b/src/physics/rrtmgp/radiation.F90 @@ -1855,10 +1855,10 @@ subroutine set_sw_diags() fswc%flux_dn(i,ktopradi:) fsds(idxday(i)) = fsw%flux_dn(i, nlay+1) rd%fsdsc(idxday(i)) = fswc%flux_dn(i, nlay+1) - rd%fsutoa(idxday(i)) = fsw%flux_up(i, ktopradi) - rd%fsntoa(idxday(i)) = fsw%flux_net(i, ktopradi) ! net sw flux at TOA (*NOT* the same as fsnt) - rd%fsntoac(idxday(i)) = fswc%flux_net(i, ktopradi) ! net sw clearsky flux at TOA (*NOT* the same as fsntc) - rd%solin(idxday(i)) = fswc%flux_dn(i, ktopradi) + rd%fsutoa(idxday(i)) = fsw%flux_up(i, 1) + rd%fsntoa(idxday(i)) = fsw%flux_net(i, 1) ! net sw flux at TOA (*NOT* the same as fsnt) + rd%fsntoac(idxday(i)) = fswc%flux_net(i, 1) ! net sw clearsky flux at TOA (*NOT* the same as fsntc) + rd%solin(idxday(i)) = fswc%flux_dn(i, 1) end do call heating_rate('SW', ncol, fns, qrs) From d46aa4b29d32c3c49aa34872053d1ec1e976a8c2 Mon Sep 17 00:00:00 2001 From: Brian Eaton Date: Mon, 14 Aug 2023 15:34:44 -0400 Subject: [PATCH 123/291] add diagnostic output for fluxes on the RRTMGP grid --- src/physics/rrtmgp/radiation.F90 | 111 +++++++++++++++++++++++-------- 1 file changed, 85 insertions(+), 26 deletions(-) diff --git a/src/physics/rrtmgp/radiation.F90 b/src/physics/rrtmgp/radiation.F90 index b7883aed45..9ff948d333 100644 --- a/src/physics/rrtmgp/radiation.F90 +++ b/src/physics/rrtmgp/radiation.F90 @@ -46,7 +46,7 @@ module radiation use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp use cam_history, only: addfld, add_default, horiz_only, outfld, hist_fld_active -use cam_history_support, only: fillvalue +use cam_history_support, only: fillvalue, add_vert_coord use ioFileMod, only: getfil use cam_pio_utils, only: cam_pio_openfile @@ -126,11 +126,21 @@ module radiation real(r8) :: flux_sw_dn(pcols,pverp) ! downward flux real(r8) :: flux_sw_clr_dn(pcols,pverp) ! downward clearsky flux + real(r8), allocatable :: fsdn(:,:) ! Downward SW flux on rrtmgp grid + real(r8), allocatable :: fsdnc(:,:) ! Downward SW clear sky flux on rrtmgp grid + real(r8), allocatable :: fsup(:,:) ! Upward SW flux on rrtmgp grid + real(r8), allocatable :: fsupc(:,:) ! Upward SW clear sky flux on rrtmgp grid + real(r8) :: flux_lw_up(pcols,pverp) ! upward shortwave flux on interfaces real(r8) :: flux_lw_clr_up(pcols,pverp) ! upward shortwave clearsky flux real(r8) :: flux_lw_dn(pcols,pverp) ! downward flux real(r8) :: flux_lw_clr_dn(pcols,pverp) ! downward clearsky flux + real(r8), allocatable :: fldn(:,:) ! Downward LW flux on rrtmgp grid + real(r8), allocatable :: fldnc(:,:) ! Downward LW clear sky flux on rrtmgp grid + real(r8), allocatable :: flup(:,:) ! Upward LW flux on rrtmgp grid + real(r8), allocatable :: flupc(:,:) ! Upward LW clear sky flux on rrtmgp grid + real(r8) :: qrlc(pcols,pver) real(r8) :: flntc(pcols) ! Clear sky lw flux at model top @@ -209,6 +219,9 @@ module radiation integer :: ktopradm ! index in RRTMGP arrays of layer corresponding to CAM top layer integer :: ktopradi ! index in RRTMGP arrays of interface corresponding to CAM top interface +! vertical coordinate for output of fluxes on radiation grid +real(r8), allocatable, target :: plev_rad(:) + ! LW coefficients type(ty_gas_optics_rrtmgp) :: kdist_lw ! bpm changed here integer :: ngpt_lw @@ -349,11 +362,11 @@ end subroutine radiation_readnl subroutine radiation_register - ! Register radiation fields in the physics buffer - use physics_buffer, only: pbuf_add_field, dtype_r8 use radiation_data, only: rad_data_register + ! Register radiation fields in the physics buffer + call pbuf_add_field('QRS' , 'global',dtype_r8,(/pcols,pver/), qrs_idx) ! shortwave radiative heating rate call pbuf_add_field('QRL' , 'global',dtype_r8,(/pcols,pver/), qrl_idx) ! longwave radiative heating rate @@ -502,6 +515,7 @@ subroutine radiation_init(pbuf2d) ! below 1 Pa then an extra layer is added to the top of the model for ! the purpose of the radiation calculation. nlay = count( pref_edge(:) > 1._r8 ) ! pascals (0.01 mbar) + allocate(plev_rad(nlay+1)) if (nlay == pverp) then ! Top model interface is below 1 Pa. RRTMGP is active in all model layers plus @@ -510,14 +524,21 @@ subroutine radiation_init(pbuf2d) ktopcami = 1 ktopradm = 2 ktopradi = 2 + plev_rad(1) = 1.01_r8 ! Top of extra layer, Pa. + plev_rad(2:) = pref_edge else ! nlay < pverp. nlay layers are set by radiation ktopcamm = pverp - nlay + 1 ktopcami = pverp - nlay + 1 ktopradm = 1 ktopradi = 1 + plev_rad = pref_edge(ktopcami:) end if + ! Define a pressure coordinate to allow output of data on the radiation grid. + call add_vert_coord('plev_rad', nlay+1, 'Pressures at radiation flux calculations', & + 'Pa', plev_rad) + call set_available_gases(active_gases, available_gases) ! gases needed to initialize spectral info call coefs_init(coefs_lw_file, kdist_lw, available_gases, band2gpt_lw) @@ -690,6 +711,12 @@ subroutine radiation_init(pbuf2d) call addfld('FUSC'//diag(icall), (/ 'ilev' /), 'I', 'W/m2', 'Shortwave clear-sky upward flux') call addfld('FDSC'//diag(icall), (/ 'ilev' /), 'I', 'W/m2', 'Shortwave clear-sky downward flux') + ! Fluxes on rrtmgp grid + call addfld('FSDN'//diag(icall), (/ 'plev_rad' /), 'I', 'W/m2', 'SW downward flux on rrtmgp grid') + call addfld('FSDNC'//diag(icall), (/ 'plev_rad' /), 'I', 'W/m2', 'SW downward clear sky flux on rrtmgp grid') + call addfld('FSUP'//diag(icall), (/ 'plev_rad' /), 'I', 'W/m2', 'SW upward flux on rrtmgp grid') + call addfld('FSUPC'//diag(icall), (/ 'plev_rad' /), 'I', 'W/m2', 'SW upward clear sky flux on rrtmgp grid') + if (history_amwg) then call add_default('SOLIN'//diag(icall), 1, ' ') call add_default('QRS'//diag(icall), 1, ' ') @@ -746,6 +773,12 @@ subroutine radiation_init(pbuf2d) call addfld('FULC'//diag(icall), (/ 'ilev' /), 'I', 'W/m2', 'Longwave clear-sky upward flux') call addfld('FDLC'//diag(icall), (/ 'ilev' /), 'I', 'W/m2', 'Longwave clear-sky downward flux') + ! Fluxes on rrtmgp grid + call addfld('FLDN'//diag(icall), (/ 'plev_rad' /), 'I', 'W/m2', 'LW downward flux on rrtmgp grid') + call addfld('FLDNC'//diag(icall), (/ 'plev_rad' /), 'I', 'W/m2', 'LW downward clear sky flux on rrtmgp grid') + call addfld('FLUP'//diag(icall), (/ 'plev_rad' /), 'I', 'W/m2', 'LW upward flux on rrtmgp grid') + call addfld('FLUPC'//diag(icall), (/ 'plev_rad' /), 'I', 'W/m2', 'LW upward clear sky flux on rrtmgp grid') + if (history_amwg) then call add_default('QRL'//diag(icall), 1, ' ') call add_default('FLNT'//diag(icall), 1, ' ') @@ -1095,6 +1128,11 @@ subroutine radiation_tend( & write_output = .false. else allocate(rd) + ! allocate some elements of rd + if (.not. allocated(rd%fsdn)) then + allocate(rd%fsdn(pcols,nlay+1), rd%fsdnc(pcols,nlay+1), rd%fsup(pcols,nlay+1), rd%fsupc(pcols,nlay+1), & + rd%fldn(pcols,nlay+1), rd%fldnc(pcols,nlay+1), rd%flup(pcols,nlay+1), rd%flupc(pcols,nlay+1) ) + end if write_output = .true. end if @@ -1831,34 +1869,39 @@ subroutine set_sw_diags() size(fsw%bnd_flux_dn,2), & size(fsw%bnd_flux_dn,3)) :: flux_dn_diffuse !------------------------------------------------------------------------- - fns = 0._r8 ! net sw flux - fcns = 0._r8 ! net sw clearsky flux - fsds = 0._r8 ! downward sw flux at surface - rd%fsdsc = 0._r8 ! downward sw clearsky flux at surface - rd%fsutoa = 0._r8 ! upward sw flux at TOA - rd%fsntoa = 0._r8 ! net sw at TOA - rd%fsntoac = 0._r8 ! net sw clearsky flux at TOA - rd%solin = 0._r8 ! solar irradiance at TOA + + ! Initializing these arrays to 0.0 provides fill in the night columns: + fns = 0._r8 ! net sw flux + fcns = 0._r8 ! net sw clearsky flux + fsds = 0._r8 ! downward sw flux at surface + rd%fsdsc = 0._r8 ! downward sw clearsky flux at surface + rd%fsutoa = 0._r8 ! upward sw flux at TOA + rd%fsntoa = 0._r8 ! net sw at TOA + rd%fsntoac = 0._r8 ! net sw clearsky flux at TOA + rd%solin = 0._r8 ! solar irradiance at TOA + rd%fsdn = 0._r8 + rd%fsdnc = 0._r8 + rd%fsup = 0._r8 + rd%fsupc = 0._r8 ! fns, fcns, rd are on CAM grid (do not have "extra layer" when it is present.) - ! fill in the daylit columns: do i = 1, nday fns(idxday(i),ktopcami:) = fsw%flux_net(i, ktopradi:) fcns(idxday(i),ktopcami:) = fswc%flux_net(i,ktopradi:) - rd%flux_sw_up(idxday(i),ktopcami:) = & - fsw%flux_up(i,ktopradi:) - rd%flux_sw_dn(idxday(i),ktopcami:) = & - fsw%flux_dn(i,ktopradi:) - rd%flux_sw_clr_up(idxday(i),ktopcami:) = & - fswc%flux_up(i,ktopradi:) - rd%flux_sw_clr_dn(idxday(i),ktopcami:) = & - fswc%flux_dn(i,ktopradi:) - fsds(idxday(i)) = fsw%flux_dn(i, nlay+1) - rd%fsdsc(idxday(i)) = fswc%flux_dn(i, nlay+1) - rd%fsutoa(idxday(i)) = fsw%flux_up(i, 1) - rd%fsntoa(idxday(i)) = fsw%flux_net(i, 1) ! net sw flux at TOA (*NOT* the same as fsnt) - rd%fsntoac(idxday(i)) = fswc%flux_net(i, 1) ! net sw clearsky flux at TOA (*NOT* the same as fsntc) - rd%solin(idxday(i)) = fswc%flux_dn(i, 1) + fsds(idxday(i)) = fsw%flux_dn(i, nlay+1) + rd%fsdsc(idxday(i)) = fswc%flux_dn(i, nlay+1) + rd%fsutoa(idxday(i)) = fsw%flux_up(i, 1) + rd%fsntoa(idxday(i)) = fsw%flux_net(i, 1) ! net sw flux at TOA (*NOT* the same as fsnt) + rd%fsntoac(idxday(i)) = fswc%flux_net(i, 1) ! net sw clearsky flux at TOA (*NOT* the same as fsntc) + rd%solin(idxday(i)) = fswc%flux_dn(i, 1) + rd%flux_sw_up(idxday(i),ktopcami:) = fsw%flux_up(i,ktopradi:) + rd%flux_sw_dn(idxday(i),ktopcami:) = fsw%flux_dn(i,ktopradi:) + rd%flux_sw_clr_up(idxday(i),ktopcami:) = fswc%flux_up(i,ktopradi:) + rd%flux_sw_clr_dn(idxday(i),ktopcami:) = fswc%flux_dn(i,ktopradi:) + rd%fsdn(idxday(i),:) = fsw%flux_dn(i,:) + rd%fsdnc(idxday(i),:) = fswc%flux_dn(i,:) + rd%fsup(idxday(i),:) = fsw%flux_up(i,:) + rd%fsupc(idxday(i),:) = fswc%flux_up(i,:) end do call heating_rate('SW', ncol, fns, qrs) @@ -1962,6 +2005,11 @@ subroutine set_lw_diags() rd%flut(:ncol) = flw%flux_up(:, ktopradi) rd%flutc(:ncol) = flwc%flux_up(:, ktopradi) + rd%fldn(:ncol,:) = flw%flux_dn + rd%fldnc(:ncol,:) = flwc%flux_dn + rd%flup(:ncol,:) = flw%flux_up + rd%flupc(:ncol,:) = flwc%flux_up + ! Output fluxes at 200 mb call vertinterp(ncol, pcols, pverp, state%pint, 20000._r8, fnl, rd%fln200) call vertinterp(ncol, pcols, pverp, state%pint, 20000._r8, fcnl, rd%fln200c) @@ -2090,6 +2138,11 @@ subroutine radiation_output_sw(lchnk, ncol, icall, rd, pbuf, cam_out) call outfld('FDS'//diag(icall), rd%flux_sw_dn, pcols, lchnk) call outfld('FDSC'//diag(icall), rd%flux_sw_clr_dn, pcols, lchnk) + call outfld('FSDN'//diag(icall), rd%fsdn, pcols, lchnk) + call outfld('FSDNC'//diag(icall), rd%fsdnc, pcols, lchnk) + call outfld('FSUP'//diag(icall), rd%fsup, pcols, lchnk) + call outfld('FSUPC'//diag(icall), rd%fsupc, pcols, lchnk) + end subroutine radiation_output_sw @@ -2169,6 +2222,12 @@ subroutine radiation_output_lw(lchnk, ncol, icall, rd, pbuf, cam_out) call outfld('FDLC'//diag(icall), rd%flux_lw_clr_dn, pcols, lchnk) call outfld('FUL'//diag(icall), rd%flux_lw_up, pcols, lchnk) call outfld('FULC'//diag(icall), rd%flux_lw_clr_up, pcols, lchnk) + + call outfld('FLDN'//diag(icall), rd%fldn, pcols, lchnk) + call outfld('FLDNC'//diag(icall), rd%fldnc, pcols, lchnk) + call outfld('FLUP'//diag(icall), rd%flup, pcols, lchnk) + call outfld('FLUPC'//diag(icall), rd%flupc, pcols, lchnk) + end subroutine radiation_output_lw !=============================================================================== From 42e49768edde02fed6208e1bf6216e83820f0fe2 Mon Sep 17 00:00:00 2001 From: Brian Eaton Date: Tue, 15 Aug 2023 10:16:46 -0400 Subject: [PATCH 124/291] update rrtmgp external to use local_fix01 --- Externals_CAM.cfg | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Externals_CAM.cfg b/Externals_CAM.cfg index 0fde1a5489..758c04b9c3 100644 --- a/Externals_CAM.cfg +++ b/Externals_CAM.cfg @@ -2,7 +2,7 @@ local_path = src/physics/rrtmgp/ext protocol = git repo_url = https://github.com/brian-eaton/rte-rrtmgp.git -tag = build_mod01 +tag = local_fix01 required = True [chem_proc] From 19b908333bdc0ca75fd9631a62535c636d3c4a1c Mon Sep 17 00:00:00 2001 From: Brian Eaton Date: Wed, 16 Aug 2023 09:31:53 -0400 Subject: [PATCH 125/291] fix in rrtmgp_driver.F90 for gpu --- src/physics/rrtmgp/rrtmgp_driver.F90 | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/src/physics/rrtmgp/rrtmgp_driver.F90 b/src/physics/rrtmgp/rrtmgp_driver.F90 index 12f16e7b5c..c7e0ed5324 100644 --- a/src/physics/rrtmgp/rrtmgp_driver.F90 +++ b/src/physics/rrtmgp/rrtmgp_driver.F90 @@ -40,9 +40,9 @@ module rrtmgp_driver use cam_logfile, only: iulog implicit none - private public :: rte_lw, rte_sw + contains ! -------------------------------------------------- ! @@ -95,11 +95,7 @@ function rte_lw(k_dist, gas_concs, p_lay, t_lay, p_lev, & ngpt = k_dist%get_ngpt() nband = k_dist%get_nband() - !$acc kernels copyout(top_at_1) - !$omp target map(from:top_at_1) top_at_1 = p_lay(1, 1) < p_lay(1, nlay) - !$acc end kernels - !$omp end target ! ------------------------------------------------------------------------------------ ! Error checking From 6b36f66af961304bcfa4340152de28e25e993632 Mon Sep 17 00:00:00 2001 From: Brian Eaton Date: Thu, 24 Aug 2023 13:35:18 -0400 Subject: [PATCH 126/291] cleanup a couple of unused vars --- src/physics/rrtmgp/radiation.F90 | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/src/physics/rrtmgp/radiation.F90 b/src/physics/rrtmgp/radiation.F90 index 9ff948d333..baf9620389 100644 --- a/src/physics/rrtmgp/radiation.F90 +++ b/src/physics/rrtmgp/radiation.F90 @@ -224,7 +224,6 @@ module radiation ! LW coefficients type(ty_gas_optics_rrtmgp) :: kdist_lw ! bpm changed here -integer :: ngpt_lw ! SW coefficients type(ty_gas_optics_rrtmgp) :: kdist_sw ! bpm changed here @@ -570,7 +569,6 @@ subroutine radiation_init(pbuf2d) call rad_data_init(pbuf2d) ! initialize output fields for offline driver call cloud_rad_props_init() - ngpt_lw = kdist_lw%get_ngpt() ! these set global values ngpt_sw = kdist_sw%get_ngpt() ! bpm: set the indices used for diagnostics using specific band: @@ -1114,21 +1112,19 @@ subroutine radiation_tend( & logical :: conserve_energy = .false. ! Flag to carry (QRS,QRL)*dp across time steps. integer :: iband - integer :: nlevcam, nlevrad real(r8) :: mem_hw_end, mem_hw_beg, mem_end, mem_beg, temp !-------------------------------------------------------------------------------------- lchnk = state%lchnk ncol = state%ncol - nlevcam = size(state%t,2) ! number of levels in CAM grid if (present(rd_out)) then rd => rd_out write_output = .false. else allocate(rd) - ! allocate some elements of rd + ! allocate elements of rd for output of fluxes on RRTMGP grid if (.not. allocated(rd%fsdn)) then allocate(rd%fsdn(pcols,nlay+1), rd%fsdnc(pcols,nlay+1), rd%fsup(pcols,nlay+1), rd%fsupc(pcols,nlay+1), & rd%fldn(pcols,nlay+1), rd%fldnc(pcols,nlay+1), rd%flup(pcols,nlay+1), rd%flupc(pcols,nlay+1) ) @@ -1289,7 +1285,6 @@ subroutine radiation_tend( & alb_dif, & ! output tsi & ! output, total solar irradiance (not scaled) ) - nlevrad = size(t_rad,2) !!--> Set TSI used in radiation to the value in the solar forcing file. !!--> This replaces get_variability() and does same thing. From 38d51b7131c07e22e68df085114566895568b39c Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Tue, 29 Aug 2023 14:57:41 -0600 Subject: [PATCH 127/291] Remove HEMCO from src/control/cam_comp.F90 This update is needed to run with the latest cam_development which already had the update. The old code came in with the recent merge. Signed-off-by: Lizzie Lundgren --- src/control/cam_comp.F90 | 42 ---------------------------------------- 1 file changed, 42 deletions(-) diff --git a/src/control/cam_comp.F90 b/src/control/cam_comp.F90 index f4091fda1a..3bb1052288 100644 --- a/src/control/cam_comp.F90 +++ b/src/control/cam_comp.F90 @@ -81,10 +81,6 @@ subroutine cam_init( & use stepon, only: stepon_init use ionosphere_interface, only: ionosphere_init -#if (defined HEMCO_CESM) - use hemco_interface, only: HCOI_Chunk_Init -#endif - use camsrfexch, only: hub2atm_alloc, atm2hub_alloc use cam_history, only: intht use history_scam, only: scm_intht @@ -186,11 +182,6 @@ subroutine cam_init( & ! initialize ionosphere call ionosphere_init() -#if (defined HEMCO_CESM) - ! initialize harmonized emissions component (HEMCO) - call hcoi_chunk_init() -#endif - if (initial_run_in) then call dyn_init(dyn_in, dyn_out) @@ -239,10 +230,6 @@ subroutine cam_run1(cam_in, cam_out) use stepon, only: stepon_run1 use ionosphere_interface,only: ionosphere_run1 -#if (defined HEMCO_CESM) - use hemco_interface, only: HCOI_Chunk_Run -#endif - type(cam_in_t) :: cam_in(begchunk:endchunk) type(cam_out_t) :: cam_out(begchunk:endchunk) @@ -264,13 +251,6 @@ subroutine cam_run1(cam_in, cam_out) !---------------------------------------------------------- call ionosphere_run1(pbuf2d) -#if (defined HEMCO_CESM) - !---------------------------------------------------------- - ! run hemco (first phase?) - !---------------------------------------------------------- - call HCOI_Chunk_Run(cam_in, phys_state, pbuf2d, 1) -#endif - ! !---------------------------------------------------------- ! PHYS_RUN Call the Physics package @@ -302,10 +282,6 @@ subroutine cam_run2( cam_out, cam_in ) use stepon, only: stepon_run2 use ionosphere_interface, only: ionosphere_run2 -#if (defined HEMCO_CESM) - use hemco_interface, only: HCOI_Chunk_Run -#endif - type(cam_out_t), intent(inout) :: cam_out(begchunk:endchunk) type(cam_in_t), intent(inout) :: cam_in(begchunk:endchunk) @@ -314,13 +290,6 @@ subroutine cam_run2( cam_out, cam_in ) return endif -#if (defined HEMCO_CESM) - !---------------------------------------------------------- - ! run hemco (phase 2 before chemistry) - !---------------------------------------------------------- - call HCOI_Chunk_Run(cam_in, phys_state, pbuf2d, 2) -#endif - ! ! Second phase of physics (after surface model update) ! @@ -458,10 +427,6 @@ subroutine cam_final( cam_out, cam_in ) use ionosphere_interface, only: ionosphere_final use cam_control_mod, only: initial_run -#if (defined HEMCO_CESM) - use hemco_interface, only: HCOI_Chunk_Final -#endif - ! ! Arguments ! @@ -476,13 +441,6 @@ subroutine cam_final( cam_out, cam_in ) call stepon_final(dyn_in, dyn_out) call ionosphere_final() -#if (defined HEMCO_CESM) - !---------------------------------------------------------- - ! cleanup hemco - !---------------------------------------------------------- - call HCOI_Chunk_Final() -#endif - if (initial_run) then call cam_initfiles_close() end if From 8796376f28d658c948dc67dcac8bd0a413e769f8 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Tue, 29 Aug 2023 14:59:25 -0600 Subject: [PATCH 128/291] Fix how HEMCO is specified in GEOS-Chem compset configuration Signed-off-by: Lizzie Lundgren --- cime_config/config_compsets.xml | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/cime_config/config_compsets.xml b/cime_config/config_compsets.xml index 7ca1787566..cd274d95ef 100644 --- a/cime_config/config_compsets.xml +++ b/cime_config/config_compsets.xml @@ -563,27 +563,27 @@ FC2000climo_GC - 2000_CAM60%GC_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV%HEMCO + 2000_CAM60%GC%HEMCO_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV FC2010climo_GC - 2010_CAM60%GC_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV%HEMCO + 2010_CAM60%GC%HEMCO_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV FCHIST_GC - HIST_CAM60%GC_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV%HEMCO + HIST_CAM60%GC%HEMCO_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV FCSD_GC - HIST_CAM60%GC%SDYN_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV%HEMCO + HIST_CAM60%GC%HEMCO%SDYN_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV FCnudged_GC - HIST_CAM60%GC%NUDG_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV%HEMCO + HIST_CAM60%GC%HEMCO%NUDG_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV From 750cf521fb1807b3ecba933688bf3ea69b58b198 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Tue, 29 Aug 2023 15:11:59 -0600 Subject: [PATCH 129/291] Use HEMCO config files in Buildconf/camconf when running with GEOS-Chem GEOS-Chem expects to use HEMCO configuration files that are included in the GEOS-Chem repository. Those files get copied into Buildconf/camconf during the first build of any GEOS-Chem compset. If not using GEOS-Chem then HEMCO files are read from the input data path specified as namelist defaults. This update adds a modifier to change the hemco_config_file and hemco_diagn_file namelist parameters when building the namelist for a GEOS-Chem compset to be simply HEMCO_Config.rc and HEMCO_Diagn.rc, with no absolute path specified. Signed-off-by: Lizzie Lundgren --- bld/build-namelist | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/bld/build-namelist b/bld/build-namelist index b36f5d7cb5..a2bf6393f1 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -2963,6 +2963,12 @@ if ($nl->get_value('use_hemco') =~ m/$TRUE/io) { # ignored at runtime when HEMCO is used. $nl->delete_variable('chem_inparm', 'ext_frc_specifier'); $nl->delete_variable('chem_inparm', 'srf_emis_specifier'); + + # If using GEOS-Chem reset paths of HEMCO configuration files to local filename only + if ($chem =~ /geoschem/) { + $nl->set_variable_value('hemco_nl', 'hemco_config_file', "'HEMCO_Config.rc'"); + $nl->set_variable_value('hemco_nl', 'hemco_diagn_file', "'HEMCO_Diagn.rc'"); + } } # Physics options From f57e02726a0736902d2de7aeb6489f656a29effe Mon Sep 17 00:00:00 2001 From: Brian Eaton Date: Fri, 1 Sep 2023 19:58:06 -0400 Subject: [PATCH 130/291] cleanup solar forcing and gas_concs init; bugfix in rrtmgp_inputs --- src/physics/cam/aer_rad_props.F90 | 8 +- src/physics/cam/phys_prop.F90 | 11 +- src/physics/cam/rad_constituents.F90 | 4 +- src/physics/camrt/radconstants.F90 | 17 -- src/physics/rrtmg/cloud_rad_props.F90 | 2 +- src/physics/rrtmg/ebert_curry.F90 | 2 +- src/physics/rrtmg/oldcloud.F90 | 2 +- src/physics/rrtmg/radconstants.F90 | 16 -- src/physics/rrtmg/slingo.F90 | 2 +- src/physics/rrtmgp/cloud_rad_props.F90 | 2 +- src/physics/rrtmgp/ebert_curry.F90 | 15 +- src/physics/rrtmgp/oldcloud.F90 | 8 +- src/physics/rrtmgp/rad_solar_var.F90 | 145 ---------- src/physics/rrtmgp/radconstants.F90 | 350 ++++++++----------------- src/physics/rrtmgp/radiation.F90 | 249 +++++++----------- src/physics/rrtmgp/rrtmgp_inputs.F90 | 150 ++++------- src/physics/rrtmgp/slingo.F90 | 22 +- src/physics/simple/radconstants.F90 | 2 - 18 files changed, 262 insertions(+), 745 deletions(-) delete mode 100644 src/physics/rrtmgp/rad_solar_var.F90 diff --git a/src/physics/cam/aer_rad_props.F90 b/src/physics/cam/aer_rad_props.F90 index 058f53f784..be8f0708a6 100644 --- a/src/physics/cam/aer_rad_props.F90 +++ b/src/physics/cam/aer_rad_props.F90 @@ -11,7 +11,8 @@ module aer_rad_props use physics_types, only: physics_state use physics_buffer, only: physics_buffer_desc -use radconstants, only: nrh, nswbands, nlwbands, idx_sw_diag, ot_length +use radconstants, only: nswbands, nlwbands, idx_sw_diag +use phys_prop, only: nrh, ot_length use rad_constituents, only: rad_cnst_get_info, rad_cnst_get_aer_mmr, & rad_cnst_get_aer_props use wv_saturation, only: qsat @@ -304,9 +305,6 @@ end subroutine aer_rad_props_sw subroutine aer_rad_props_lw(list_idx, state, pbuf, odap_aer) - use radconstants, only: ot_length - - use physics_buffer, only : pbuf_get_field, pbuf_get_index, physics_buffer_desc ! Purpose: Compute aerosol transmissions needed in absorptivity/ ! emissivity calculations @@ -314,6 +312,8 @@ subroutine aer_rad_props_lw(list_idx, state, pbuf, odap_aer) ! species. If this changes, this routine will need to do something ! similar to the sw with routines like get_hygro_lw_abs + use physics_buffer, only : pbuf_get_field, pbuf_get_index, physics_buffer_desc + ! Arguments integer, intent(in) :: list_idx ! index of the climate or a diagnostic list type(physics_state), intent(in), target :: state diff --git a/src/physics/cam/phys_prop.F90 b/src/physics/cam/phys_prop.F90 index 568427e44e..ecbf6f85e0 100644 --- a/src/physics/cam/phys_prop.F90 +++ b/src/physics/cam/phys_prop.F90 @@ -11,7 +11,7 @@ module phys_prop use shr_kind_mod, only: r8 => shr_kind_r8 use spmd_utils, only: masterproc -use radconstants, only: nrh, nlwbands, nswbands, idx_sw_diag +use radconstants, only: nlwbands, nswbands, idx_sw_diag use ioFileMod, only: getfil use cam_pio_utils, only: cam_pio_openfile use pio, only: file_desc_t, var_desc_t, pio_get_var, pio_inq_varid, & @@ -26,6 +26,7 @@ module phys_prop save integer, parameter, public :: ot_length = 32 + public :: & physprop_accum_unique_files, &! Make a list of the unique set of files that contain properties ! This is an initialization step that must be done before calling physprop_init @@ -105,6 +106,10 @@ module phys_prop ! 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 + !================================================================================================ contains !================================================================================================ @@ -1106,6 +1111,8 @@ subroutine bulk_props_init(physprop, nc_id) type(var_desc_T) :: vid + ! ***N.B.*** RRTMGP hasn't set the value of idx_sw_diag when this routine is + ! called. The debug option will need to be modified for RRTMGP. logical :: debug = .true. character(len=*), parameter :: subname = 'bulk_props_init' @@ -1134,7 +1141,7 @@ subroutine bulk_props_init(physprop, nc_id) ierr = pio_get_var(nc_id, vid, physprop%num_to_mass_aer) ! Output select data to log file - if (debug .and. masterproc) then + if (debug .and. masterproc .and. idx_sw_diag > 0) then if (trim(physprop%aername) == 'SULFATE') then write(iulog, '(2x, a)') '_______ hygroscopic growth in visible band _______' call aer_optics_log_rh('SO4', physprop%sw_hygro_ext(:,idx_sw_diag), & diff --git a/src/physics/cam/rad_constituents.F90 b/src/physics/cam/rad_constituents.F90 index ced2c35cfa..42c978cc72 100644 --- a/src/physics/cam/rad_constituents.F90 +++ b/src/physics/cam/rad_constituents.F90 @@ -17,9 +17,9 @@ module rad_constituents use physics_types, only: physics_state use phys_control, only: use_simple_phys use constituents, only: cnst_get_ind -use radconstants, only: nradgas, rad_gas_index, ot_length +use radconstants, only: nradgas, rad_gas_index use phys_prop, only: physprop_accum_unique_files, physprop_init, & - physprop_get_id + physprop_get_id, ot_length use cam_history, only: addfld, fieldname_len, outfld, horiz_only use physics_buffer, only: physics_buffer_desc, pbuf_get_field, pbuf_get_index diff --git a/src/physics/camrt/radconstants.F90 b/src/physics/camrt/radconstants.F90 index 89503fd0f5..c95c8d2154 100644 --- a/src/physics/camrt/radconstants.F90 +++ b/src/physics/camrt/radconstants.F90 @@ -21,9 +21,6 @@ module radconstants public :: radconstants_init public :: rad_gas_index -! optics files specify a type. What length is it? -integer, parameter, public :: ot_length = 32 - ! SHORTWAVE DATA ! number of shorwave spectral intervals @@ -40,20 +37,6 @@ module radconstants integer, parameter, public :: idx_lw_diag = 2 ! index to (H20 window) LW band - -! Number of evenly spaced intervals in rh -! The globality of this mesh may not be necessary -! Perhaps it could be specific to the aerosol -! But it is difficult to see how refined it must be -! for lookup. This value was found to be sufficient -! for Sulfate and probably necessary to resolve the -! high variation near rh = 1. Alternative methods -! were found to be too slow. -! Optimal approach would be for cam to specify size of aerosol -! based on each aerosol's characteristics. Radiation -! should know nothing about hygroscopic growth! -integer, parameter, public :: nrh = 1000 - ! LONGWAVE DATA ! number of lw bands diff --git a/src/physics/rrtmg/cloud_rad_props.F90 b/src/physics/rrtmg/cloud_rad_props.F90 index 2911e0ac21..c629c38e4b 100644 --- a/src/physics/rrtmg/cloud_rad_props.F90 +++ b/src/physics/rrtmg/cloud_rad_props.F90 @@ -7,7 +7,7 @@ module cloud_rad_props use ppgrid, only: pcols, pver, pverp use physics_types, only: physics_state use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_get_field, pbuf_old_tim_idx -use radconstants, only: nswbands, nlwbands, idx_sw_diag, ot_length, idx_lw_diag +use radconstants, only: nswbands, nlwbands, idx_sw_diag, idx_lw_diag use cam_abortutils, only: endrun use rad_constituents, only: iceopticsfile, liqopticsfile use oldcloud, only: oldcloud_lw, old_liq_get_rad_props_lw, old_ice_get_rad_props_lw, oldcloud_init diff --git a/src/physics/rrtmg/ebert_curry.F90 b/src/physics/rrtmg/ebert_curry.F90 index a1e1c031b1..7bca4ce257 100644 --- a/src/physics/rrtmg/ebert_curry.F90 +++ b/src/physics/rrtmg/ebert_curry.F90 @@ -7,7 +7,7 @@ module ebert_curry use ppgrid, only: pcols, pver, pverp use physics_types, only: physics_state use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_get_field, pbuf_old_tim_idx -use radconstants, only: nswbands, nlwbands, idx_sw_diag, ot_length, idx_lw_diag, get_sw_spectral_boundaries +use radconstants, only: nswbands, nlwbands, idx_sw_diag, idx_lw_diag, get_sw_spectral_boundaries use cam_abortutils, only: endrun use cam_history, only: outfld diff --git a/src/physics/rrtmg/oldcloud.F90 b/src/physics/rrtmg/oldcloud.F90 index 609c6b4668..fb0ae4d80e 100644 --- a/src/physics/rrtmg/oldcloud.F90 +++ b/src/physics/rrtmg/oldcloud.F90 @@ -7,7 +7,7 @@ module oldcloud use ppgrid, only: pcols, pver, pverp use physics_types, only: physics_state use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_old_tim_idx, pbuf_get_field -use radconstants, only: nswbands, nlwbands, idx_sw_diag, ot_length, idx_lw_diag, get_sw_spectral_boundaries +use radconstants, only: nswbands, nlwbands, idx_sw_diag, idx_lw_diag, get_sw_spectral_boundaries use cam_abortutils, only: endrun use cam_history, only: outfld use rad_constituents, only: iceopticsfile, liqopticsfile diff --git a/src/physics/rrtmg/radconstants.F90 b/src/physics/rrtmg/radconstants.F90 index f4f8c76b9c..601bcd3cf6 100644 --- a/src/physics/rrtmg/radconstants.F90 +++ b/src/physics/rrtmg/radconstants.F90 @@ -63,19 +63,6 @@ module radconstants integer, parameter, public :: rrtmg_sw_cloudsim_band = 9 ! rrtmg band for .67 micron -! Number of evenly spaced intervals in rh -! The globality of this mesh may not be necessary -! Perhaps it could be specific to the aerosol -! But it is difficult to see how refined it must be -! for lookup. This value was found to be sufficient -! for Sulfate and probably necessary to resolve the -! high variation near rh = 1. Alternative methods -! were found to be too slow. -! Optimal approach would be for cam to specify size of aerosol -! based on each aerosol's characteristics. Radiation -! should know nothing about hygroscopic growth! -integer, parameter, public :: nrh = 1000 - ! LONGWAVE DATA ! These are indices to the band for diagnostic output @@ -123,9 +110,6 @@ module radconstants real(r8), public, parameter :: minmmr(nradgas) & = epsilon(1._r8) -! Length of "optics type" string specified in optics files. -integer, parameter, public :: ot_length = 32 - public :: rad_gas_index public :: get_number_sw_bands, & diff --git a/src/physics/rrtmg/slingo.F90 b/src/physics/rrtmg/slingo.F90 index aedb44bcee..b9d68565ec 100644 --- a/src/physics/rrtmg/slingo.F90 +++ b/src/physics/rrtmg/slingo.F90 @@ -9,7 +9,7 @@ module slingo use ppgrid, only: pcols, pver, pverp use physics_types, only: physics_state use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_get_field, pbuf_old_tim_idx -use radconstants, only: nswbands, nlwbands, idx_sw_diag, ot_length, idx_lw_diag, get_sw_spectral_boundaries +use radconstants, only: nswbands, nlwbands, idx_sw_diag, idx_lw_diag, get_sw_spectral_boundaries use cam_abortutils, only: endrun use cam_history, only: outfld diff --git a/src/physics/rrtmgp/cloud_rad_props.F90 b/src/physics/rrtmgp/cloud_rad_props.F90 index 1099fb714a..1581e04d9a 100644 --- a/src/physics/rrtmgp/cloud_rad_props.F90 +++ b/src/physics/rrtmgp/cloud_rad_props.F90 @@ -7,7 +7,7 @@ module cloud_rad_props use ppgrid, only: pcols, pver, pverp use physics_types, only: physics_state use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_get_field, pbuf_old_tim_idx -use radconstants, only: nswbands, nlwbands, idx_sw_diag, ot_length, idx_lw_diag +use radconstants, only: nswbands, nlwbands, idx_sw_diag use cam_abortutils, only: endrun use rad_constituents, only: iceopticsfile, liqopticsfile use oldcloud, only: oldcloud_lw, old_liq_get_rad_props_lw, old_ice_get_rad_props_lw, oldcloud_init diff --git a/src/physics/rrtmgp/ebert_curry.F90 b/src/physics/rrtmgp/ebert_curry.F90 index a1e1c031b1..c04a864ef0 100644 --- a/src/physics/rrtmgp/ebert_curry.F90 +++ b/src/physics/rrtmgp/ebert_curry.F90 @@ -7,7 +7,7 @@ module ebert_curry use ppgrid, only: pcols, pver, pverp use physics_types, only: physics_state use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_get_field, pbuf_old_tim_idx -use radconstants, only: nswbands, nlwbands, idx_sw_diag, ot_length, idx_lw_diag, get_sw_spectral_boundaries +use radconstants, only: nswbands, nlwbands, get_sw_spectral_boundaries use cam_abortutils, only: endrun use cam_history, only: outfld @@ -143,10 +143,7 @@ subroutine cloud_rad_props_get_sw(state, pbuf, & tau_w_g(:,1:ncol,:) = 0._r8 tau_w_f(:,1:ncol,:) = 0._r8 - call ec_ice_optics_sw (state, pbuf, tau, tau_w, tau_w_g, tau_w_f, oldicewp=.true.) -! call outfld ('CI_OD_SW_OLD', ice_tau(idx_sw_diag,:,:), pcols, lchnk) - end subroutine cloud_rad_props_get_sw !============================================================================== @@ -182,7 +179,6 @@ subroutine cloud_rad_props_get_lw(state, pbuf, cld_abs_od, diagnosticindex, oldl cld_abs_od = 0._r8 call ec_ice_get_rad_props_lw(state, pbuf, cld_abs_od, oldicewp=.true.) - !call outfld('CI_OD_LW_OLD', ice_tau_abs_od(idx_lw_diag ,:,:), pcols, lchnk) end subroutine cloud_rad_props_get_lw @@ -390,18 +386,11 @@ subroutine ec_ice_get_rad_props_lw(state, pbuf, abs_od, oldicewp) cldtau(i,k) = kabs*cwp(i,k) end do end do -! + do lwband = 1,nlwbands abs_od(lwband,1:ncol,1:pver)=cldtau(1:ncol,1:pver) enddo - !if(oldicewp) then - ! call outfld('CIWPTH_OLD',cicewp(:,:)/1000,pcols,lchnk) - !else - ! call outfld('CIWPTH_OLD',iciwpth(:,:),pcols,lchnk) - !endif - !call outfld('CI_OD_LW_OLD',cldtau(:,:),pcols,lchnk) - end subroutine ec_ice_get_rad_props_lw !============================================================================== diff --git a/src/physics/rrtmgp/oldcloud.F90 b/src/physics/rrtmgp/oldcloud.F90 index 609c6b4668..06a91b232e 100644 --- a/src/physics/rrtmgp/oldcloud.F90 +++ b/src/physics/rrtmgp/oldcloud.F90 @@ -7,7 +7,7 @@ module oldcloud use ppgrid, only: pcols, pver, pverp use physics_types, only: physics_state use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_old_tim_idx, pbuf_get_field -use radconstants, only: nswbands, nlwbands, idx_sw_diag, ot_length, idx_lw_diag, get_sw_spectral_boundaries +use radconstants, only: nswbands, nlwbands, get_sw_spectral_boundaries use cam_abortutils, only: endrun use cam_history, only: outfld use rad_constituents, only: iceopticsfile, liqopticsfile @@ -226,12 +226,6 @@ subroutine old_liquid_optics_sw(state, pbuf, liq_tau, liq_tau_w, liq_tau_w_g, li end do ! End do k=1,pver end do ! nswbands - !call outfld('CL_OD_SW_OLD',liq_tau(idx_sw_diag,:,:), pcols, lchnk) - !call outfld('REL_OLD',rel(:,:), pcols, lchnk) - !call outfld('CLWPTH_OLD',cliqwp(:,:), pcols, lchnk) - !call outfld('KEXT_OLD',kext(:,:), pcols, lchnk) - - end subroutine old_liquid_optics_sw !============================================================================== diff --git a/src/physics/rrtmgp/rad_solar_var.F90 b/src/physics/rrtmgp/rad_solar_var.F90 deleted file mode 100644 index 0cf996e901..0000000000 --- a/src/physics/rrtmgp/rad_solar_var.F90 +++ /dev/null @@ -1,145 +0,0 @@ -!------------------------------------------------------------------------------- -! This module uses the Lean solar irradiance data to provide a solar cycle -! scaling factor used in heating rate calculations -!------------------------------------------------------------------------------- -module rad_solar_var - - use radconstants, only : nswbands - use shr_kind_mod , only : r8 => shr_kind_r8 - use solar_irrad_data, only : sol_irrad, we, nbins, has_spectrum, sol_tsi - use solar_irrad_data, only : do_spctrl_scaling - use cam_abortutils, only : endrun - - implicit none - save - - private - public :: rad_solar_var_init - public :: get_variability - - real(r8), allocatable :: ref_band_irrad(:) ! scaling will be relative to ref_band_irrad in each band - real(r8), allocatable :: irrad(:) ! solar irradiance at model timestep in each band - real(r8) :: tsi_ref ! total solar irradiance assumed by RRTMGP - - real(r8), allocatable :: radbinmax(:) - real(r8), allocatable :: radbinmin(:) - -!------------------------------------------------------------------------------- -contains -!------------------------------------------------------------------------------- - - subroutine rad_solar_var_init( ) - use radconstants, only : get_sw_spectral_boundaries - use radconstants, only : get_ref_solar_band_irrad - use radconstants, only : get_ref_total_solar_irrad - - integer :: i - integer :: ierr - integer :: yr, mon, tod - integer :: radmax_loc - - - if ( do_spctrl_scaling ) then - - if ( .not.has_spectrum ) then - call endrun('rad_solar_var_init: solar input file must have irradiance spectrum') - endif - - allocate (radbinmax(nswbands),stat=ierr) - if (ierr /= 0) then - call endrun('rad_solar_var_init: Error allocating space for radbinmax') - end if - - allocate (radbinmin(nswbands),stat=ierr) - if (ierr /= 0) then - call endrun('rad_solar_var_init: Error allocating space for radbinmin') - end if - - allocate (ref_band_irrad(nswbands), stat=ierr) - if (ierr /= 0) then - call endrun('rad_solar_var_init: Error allocating space for ref_band_irrad') - end if - - allocate (irrad(nswbands), stat=ierr) - if (ierr /= 0) then - call endrun('rad_solar_var_init: Error allocating space for irrad') - end if - - call get_sw_spectral_boundaries(radbinmin, radbinmax, 'nm') - - ! Make sure that the far-IR is included, even if RRTMG does not - ! extend that far down. 10^5 nm corresponds to a wavenumber of - ! 100 cm^-1. - radmax_loc = maxloc(radbinmax,1) - radbinmax(radmax_loc) = max(100000._r8,radbinmax(radmax_loc)) - - ! for rrtmg, reference spectrum from rrtmg - call get_ref_solar_band_irrad( ref_band_irrad ) - - else - - call get_ref_total_solar_irrad(tsi_ref) - - endif - - end subroutine rad_solar_var_init - -!------------------------------------------------------------------------------- -!------------------------------------------------------------------------------- - subroutine get_variability( sfac ) - - real(r8), intent(out) :: sfac(nswbands) ! scaling factors for CAM heating - - integer :: yr, mon, day, tod - - if ( do_spctrl_scaling ) then - call integrate_spectrum( nbins, nswbands, we, radbinmin, radbinmax, sol_irrad, irrad) - sfac(:nswbands) = irrad(:nswbands)/ref_band_irrad(:nswbands) - else - sfac(:nswbands) = sol_tsi/tsi_ref - endif - - end subroutine get_variability - -!------------------------------------------------------------------------------- -! private method......... -!------------------------------------------------------------------------------- - - subroutine integrate_spectrum( nsrc, ntrg, src_x, min_trg, max_trg, src, trg ) - - use mo_util, only : rebin - - implicit none - - !--------------------------------------------------------------- - ! ... dummy arguments - !--------------------------------------------------------------- - integer, intent(in) :: nsrc ! dimension source array - integer, intent(in) :: ntrg ! dimension target array - real(r8), intent(in) :: src_x(nsrc+1) ! source coordinates - real(r8), intent(in) :: max_trg(ntrg) ! target coordinates - real(r8), intent(in) :: min_trg(ntrg) ! target coordinates - real(r8), intent(in) :: src(nsrc) ! source array - real(r8), intent(out) :: trg(ntrg) ! target array - - !--------------------------------------------------------------- - ! ... local variables - !--------------------------------------------------------------- - real(r8) :: trg_x(2), targ(1) ! target coordinates - integer :: i - - do i = 1, ntrg - - trg_x(1) = min_trg(i) - trg_x(2) = max_trg(i) - - call rebin( nsrc, 1, src_x, trg_x, src(1:nsrc), targ(:) ) - ! W/m2/nm --> W/m2 - trg( i ) = targ(1)*(trg_x(2)-trg_x(1)) - - enddo - - - end subroutine integrate_spectrum - -end module rad_solar_var diff --git a/src/physics/rrtmgp/radconstants.F90 b/src/physics/rrtmgp/radconstants.F90 index e573bfb792..d086d1ce16 100644 --- a/src/physics/rrtmgp/radconstants.F90 +++ b/src/physics/rrtmgp/radconstants.F90 @@ -3,16 +3,6 @@ module radconstants ! This module contains constants that are specific to the radiative transfer ! code used in the RRTMGP model. -! This comment from E3SM implementation, and is entirely relevant here: -! TODO: Should this data be handled in a more robust way? Much of this contains -! explicit mappings to indices, which would probably be better handled with get_ -! functions. I.e., get_nswbands() could query the kdist objects in case of -! RRTMGP, and the diag indices could look up the actual bands used in the kdist -! objects as well. On that note, this module should probably go away if -! possible in the future, and we should provide more robust access to the -! radiation interface. - - use shr_kind_mod, only: r8 => shr_kind_r8 use cam_abortutils, only: endrun @@ -20,228 +10,93 @@ module radconstants private save -! Number of bands in SW and LW (these will be checked when RRTMGP initializes) +! Number of bands in SW and LW. These values must match data in the RRTMGP coefficients datasets. +! But they are needed to allocate space in the physics buffer and need to be available before the +! RRTMGP datasets are read. So they are set as parameters here and checked in radiation_init after +! the datasets are read. integer, parameter, public :: nswbands = 14 integer, parameter, public :: nlwbands = 16 -! Band limits (these get also get set at initialization) -real(r8), public, allocatable :: wavenumber_low_shortwave(:) -real(r8), public, allocatable :: wavenumber_high_shortwave(:) -real(r8), public, allocatable :: wavenumber_low_longwave(:) -real(r8), public, allocatable :: wavenumber_high_longwave(:) -! Reference irradiance per band -real(r8), public, allocatable :: solar_ref_band_irradiance(:) -real(r8), public, protected :: ref_tsi - -! SHORTWAVE DATA - - -! Wavenumbers of band boundaries -! -! Note: Currently rad_solar_var extends the lowest band down to -! 100 cm^-1 if it is too high to cover the far-IR. Any changes meant -! to affect IR solar variability should take note of this. - -! NOTE: these follow the non-monotonic ordering used for RRTMG -! - This is necessary because the optical properties files made for RRTMG use this order too. - -! NOTE: aside from order, as noted, these values match the ones in -! RRTMGP coefficients files. But I think we should be *setting* these -! values based on what is in that file, rather than hard-coding it here. - -! BPM: comment this data structure --> set it from radiation_init -! real(r8),parameter :: wavenumber_low_shortwave(nswbands) = & ! in cm^-1 -! (/2600._r8, 3250._r8, 4000._r8, 4650._r8, 5150._r8, 6150._r8, 7700._r8, & -! 8050._r8,12850._r8,16000._r8,22650._r8,29000._r8,38000._r8, 820._r8/) -! real(r8),parameter :: wavenumber_high_shortwave(nswbands) = & ! in cm^-1 -! (/3250._r8, 4000._r8, 4650._r8, 5150._r8, 6150._r8, 7700._r8, 8050._r8, & -! 12850._r8,16000._r8,22650._r8,29000._r8,38000._r8,50000._r8, 2600._r8/) - -! Mapping from RRTMG shortwave bands to RRTMGP -integer, parameter, dimension(14), public :: rrtmg_to_rrtmgp_swbands = & - (/ & - 14, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13 & - /) - -! BPM <-- commented this block. Replaced by allocatable, get values by calling set_irrad_by_band --> -! Solar irradiance at 1 A.U. in W/m^2 assumed by radiation code -! Rescaled so that sum is precisely 1368.22 and fractional amounts sum to 1.0 -! real(r8), parameter :: solar_ref_band_irradiance(nswbands) = & -! (/ & -! 12.11_r8, 20.3600000000001_r8, 23.73_r8, & -! 22.43_r8, 55.63_r8, 102.93_r8, 24.29_r8, & -! 345.74_r8, 218.19_r8, 347.20_r8, & -! 129.49_r8, 50.15_r8, 3.08_r8, 12.89_r8 & -! /) - -! These are indices to the band for diagnostic output -! CHANGE: rather than make these parameters, provide subroutines that set them -! using the function get_band_index_by_value (which should be called on initializing radiation) -! integer, parameter, public :: idx_sw_diag = 10 ! index to sw visible band (441 - 625 nm) -! integer, parameter, public :: idx_nir_diag = 8 ! index to sw near infrared (778-1240 nm) band -! integer, parameter, public :: idx_uv_diag = 11 ! index to sw uv (345-441 nm) band - -! integer, parameter, public :: rrtmg_sw_cloudsim_band = 9 ! rrtmgp band for .67 micron -! integer, parameter, public :: rrtmgp_sw_cloudsim_band = 10 ! b/c one band moves to beginning - -integer, public :: idx_sw_diag ! index to sw visible band (441 - 625 nm) -integer, public :: idx_nir_diag! index to sw near infrared (778-1240 nm) band -integer, public :: idx_uv_diag ! index to sw uv (345-441 nm) band - -! CHANGE: instead of setting rrtmg[p]_sw_cloudsim_band in radconstants, just make it in radiation -! rrtmgp_sw_cloudsim_band = get_band_index_by_value('sw', 0.67_r8, 'micron') ! rrtmgp band for .67 micron -! same for lw: -! rrtmgp_lw_cloudsim_band = get_band_index_by_value('lw', 10.5_r8, 'micron') - -! Number of evenly spaced intervals in rh -! The globality of this mesh may not be necessary -! Perhaps it could be specific to the aerosol -! But it is difficult to see how refined it must be -! for lookup. This value was found to be sufficient -! for Sulfate and probably necessary to resolve the -! high variation near rh = 1. Alternative methods -! were found to be too slow. -! Optimal approach would be for cam to specify size of aerosol -! based on each aerosol's characteristics. Radiation -! should know nothing about hygroscopic growth! -integer, parameter, public :: nrh = 1000 - -! LONGWAVE DATA - -! These are indices to the band for diagnostic output (see comment above about change) -! integer, parameter, public :: idx_lw_diag = 7 ! index to (H20 window) LW band -integer, public :: idx_lw_diag - - -! These are commented, and intended to be replaced by reading the RRTMGP optics object -! real(r8), parameter :: wavenumber_low_longwave(nlwbands) = &! Longwave spectral band limits (cm-1) -! (/ 10._r8, 350._r8, 500._r8, 630._r8, 700._r8, 820._r8, 980._r8, 1080._r8, & -! 1180._r8, 1390._r8, 1480._r8, 1800._r8, 2080._r8, 2250._r8, 2380._r8, 2600._r8 /) - -! real(r8), parameter :: wavenumber_high_longwave(nlwbands) = &! Longwave spectral band limits (cm-1) -! (/ 350._r8, 500._r8, 630._r8, 700._r8, 820._r8, 980._r8, 1080._r8, 1180._r8, & -! 1390._r8, 1480._r8, 1800._r8, 2080._r8, 2250._r8, 2380._r8, 2600._r8, 3250._r8 /) +! Band limits (set from data in RRTMGP coefficient datasets) +real(r8), allocatable, target :: wavenumber_low_shortwave(:) +real(r8), allocatable, target :: wavenumber_high_shortwave(:) +real(r8), allocatable, target :: wavenumber_low_longwave(:) +real(r8), allocatable, target :: wavenumber_high_longwave(:) + +! These are indices to specific bands for diagnostic output and COSP input. +integer, public, protected :: idx_sw_diag = -1 ! band contains 500-nm wave +integer, public, protected :: idx_nir_diag = -1 ! band contains 1000-nm wave +integer, public, protected :: idx_uv_diag = -1 ! band contains 400-nm wave +integer, public, protected :: idx_lw_diag = -1 ! band contains 1000 cm-1 wave (H20 window) +integer, public, protected :: idx_sw_cloudsim = -1 ! band contains 670-nm wave (for COSP) +integer, public, protected :: idx_lw_cloudsim = -1 ! band contains 10.5 micron wave (for COSP) ! GASES TREATED BY RADIATION (line spectrae) +! These names are recognized by RRTMGP. They are in the coefficients files as +! lower case strings. These upper case names are used by CAM's namelist and can +! be used to initialize the ty_gas_conc object because the name matching is case +! insensitive. integer, public, parameter :: gasnamelength = 5 integer, public, parameter :: nradgas = 8 character(len=gasnamelength), public, parameter :: gaslist(nradgas) & = (/'H2O ','O3 ', 'O2 ', 'CO2 ', 'N2O ', 'CH4 ', 'CFC11', 'CFC12'/) ! what is the minimum mass mixing ratio that can be supported by radiation implementation? -real(r8), public, parameter :: minmmr(nradgas) & - = epsilon(1._r8) - -! Length of "optics type" string specified in optics files. -integer, parameter, public :: ot_length = 32 - -public :: rad_gas_index - -public :: get_sw_spectral_boundaries, & - get_lw_spectral_boundaries, & - get_ref_solar_band_irrad, & - get_ref_total_solar_irrad, & - get_idx_sw_diag, & - get_idx_nir_diag, & - get_idx_uv_diag, & - get_idx_lw_diag, & - get_band_index_by_value, & - set_wavenumber_bands,& - set_irrad_by_band, & - set_reference_tsi +real(r8), public, parameter :: minmmr(nradgas) = epsilon(1._r8) + +public :: & + set_wavenumber_bands, & + get_sw_spectral_boundaries, & + get_lw_spectral_boundaries, & + get_band_index_by_value, & + rad_gas_index !=============================================================================== contains !=============================================================================== -subroutine get_ref_total_solar_irrad(tsi) - ! provide Total Solar Irradiance assumed by RRTMGP - - real(r8), intent(out) :: tsi - - ! tsi = sum(solar_ref_band_irradiance) - tsi = ref_tsi - -end subroutine get_ref_total_solar_irrad -!------------------------------------------------------------------------------ -subroutine set_reference_tsi(tsi) - ! set ref_tsi to provide total solar irradiance - ! this usually comes from reading a file - ! provided by the radiation scheme developers - real(r8), intent(in) :: tsi - ref_tsi = tsi -end subroutine set_reference_tsi -!------------------------------------------------------------------------------ -subroutine get_ref_solar_band_irrad( band_irrad ) - ! note: this shouldn't be used. - ! Instead, just use radconstants, only: solar_ref_band_irradiance - ! to access the data directly - ! solar irradiance in each band (W/m^2) - real(r8), intent(out) :: band_irrad(nswbands) - - if (allocated(solar_ref_band_irradiance)) then - band_irrad = solar_ref_band_irradiance - else - ! what to do - end if +subroutine set_wavenumber_bands(swlw, nbands, values) -end subroutine get_ref_solar_band_irrad + ! Set the low and high limits of the wavenumber grid for sw or lw. + ! Values comes from RRTMGP coefficients datasets. + ! Also set band indices for bands containing specific wavelengths. -!------------------------------------------------------------------------------ + character(*), intent(in) :: swlw ! which bands to set ['sw', 'lw'] + integer, intent(in) :: nbands + real(r8), intent(in) :: values(2,nbands) ! cm-1 -subroutine set_wavenumber_bands(swlw, nbands, values) - ! set the low and high limits of the wavenumber grid for sw or lw - ! expect that values comes from RRTMGP method get_band_lims_wavenumber - character(*), intent(in) :: swlw ! which set of bands to set ['sw', 'lw'] - integer, intent(in) :: nbands - real(r8), intent(in) :: values(2,nbands) select case(swlw) case ('sw') allocate(wavenumber_low_shortwave(nbands)) allocate(wavenumber_high_shortwave(nbands)) wavenumber_low_shortwave = values(1,:) wavenumber_high_shortwave = values(2,:) + + idx_sw_diag = get_band_index_by_value('sw', 500.0_r8, 'nm') + idx_nir_diag = get_band_index_by_value('sw', 1000.0_r8, 'nm') + idx_uv_diag = get_band_index_by_value('sw', 400._r8, 'nm') + idx_sw_cloudsim = get_band_index_by_value('sw', 0.67_r8, 'micron') + case ('lw') allocate(wavenumber_low_longwave(nbands)) allocate(wavenumber_high_longwave(nbands)) wavenumber_low_longwave = values(1,:) wavenumber_high_longwave = values(2,:) - end select -end subroutine set_wavenumber_bands -!------------------------------------------------------------------------------ -subroutine get_lw_spectral_boundaries(low_boundaries, high_boundaries, units) - ! provide spectral boundaries of each longwave band - real(r8), intent(out) :: low_boundaries(nlwbands), high_boundaries(nlwbands) - character(*), intent(in) :: units ! requested units + idx_lw_diag = get_band_index_by_value('lw', 1000.0_r8, 'cm^-1') + idx_lw_cloudsim = get_band_index_by_value('lw', 10.5_r8, 'micron') - select case (units) - case ('inv_cm','cm^-1','cm-1') - low_boundaries = wavenumber_low_longwave - high_boundaries = wavenumber_high_longwave - case('m','meter','meters') - low_boundaries = 1.e-2_r8/wavenumber_high_longwave - high_boundaries = 1.e-2_r8/wavenumber_low_longwave - case('nm','nanometer','nanometers') - low_boundaries = 1.e7_r8/wavenumber_high_longwave - high_boundaries = 1.e7_r8/wavenumber_low_longwave - case('um','micrometer','micrometers','micron','microns') - low_boundaries = 1.e4_r8/wavenumber_high_longwave - high_boundaries = 1.e4_r8/wavenumber_low_longwave - case('cm','centimeter','centimeters') - low_boundaries = 1._r8/wavenumber_high_longwave - high_boundaries = 1._r8/wavenumber_low_longwave - case default - call endrun('get_lw_spectral_boundaries: spectral units not acceptable'//units) end select -end subroutine get_lw_spectral_boundaries +end subroutine set_wavenumber_bands !------------------------------------------------------------------------------ + subroutine get_sw_spectral_boundaries(low_boundaries, high_boundaries, units) + ! provide spectral boundaries of each shortwave band - real(r8), intent(out) :: low_boundaries(nswbands), high_boundaries(nswbands) + real(r8), intent(out) :: low_boundaries(nswbands), high_boundaries(nswbands) character(*), intent(in) :: units ! requested units select case (units) @@ -261,12 +116,44 @@ subroutine get_sw_spectral_boundaries(low_boundaries, high_boundaries, units) low_boundaries = 1._r8/wavenumber_high_shortwave high_boundaries = 1._r8/wavenumber_low_shortwave case default - call endrun('rad_constants.F90: requested spectral units not acceptable: '//units) + call endrun('rad_constants.F90: requested spectral units not recognized: '//units) end select end subroutine get_sw_spectral_boundaries !------------------------------------------------------------------------------ + +subroutine get_lw_spectral_boundaries(low_boundaries, high_boundaries, units) + + ! provide spectral boundaries of each longwave band + + real(r8), intent(out) :: low_boundaries(nlwbands), high_boundaries(nlwbands) + character(*), intent(in) :: units ! requested units + + select case (units) + case ('inv_cm','cm^-1','cm-1') + low_boundaries = wavenumber_low_longwave + high_boundaries = wavenumber_high_longwave + case('m','meter','meters') + low_boundaries = 1.e-2_r8/wavenumber_high_longwave + high_boundaries = 1.e-2_r8/wavenumber_low_longwave + case('nm','nanometer','nanometers') + low_boundaries = 1.e7_r8/wavenumber_high_longwave + high_boundaries = 1.e7_r8/wavenumber_low_longwave + case('um','micrometer','micrometers','micron','microns') + low_boundaries = 1.e4_r8/wavenumber_high_longwave + high_boundaries = 1.e4_r8/wavenumber_low_longwave + case('cm','centimeter','centimeters') + low_boundaries = 1._r8/wavenumber_high_longwave + high_boundaries = 1._r8/wavenumber_low_longwave + case default + call endrun('get_lw_spectral_boundaries: spectral units not recognized: '//units) + end select + +end subroutine get_lw_spectral_boundaries + +!------------------------------------------------------------------------------ + integer function rad_gas_index(gasname) ! return the index in the gaslist array of the specified gasname @@ -283,48 +170,36 @@ integer function rad_gas_index(gasname) enddo call endrun ("rad_gas_index: can not find gas with name "//gasname) end function rad_gas_index -!------------------------------------------------------------------------------ -subroutine get_idx_sw_diag() - idx_sw_diag = get_band_index_by_value('sw', 500.0_r8, 'nm') -end subroutine -subroutine get_idx_nir_diag() - idx_nir_diag = get_band_index_by_value('sw', 1000.0_r8, 'nm') -end subroutine +!------------------------------------------------------------------------------ -subroutine get_idx_uv_diag() - idx_uv_diag = get_band_index_by_value('sw', 400._r8, 'nm') -end subroutine +function get_band_index_by_value(swlw, targetvalue, units) result(ans) -subroutine get_idx_lw_diag() - idx_lw_diag = get_band_index_by_value('lw', 1000.0_r8, 'cm^-1') - ! value chosen to match the band used in CESM1/CESM2 -end subroutine + ! Find band index for requested wavelength/wavenumber. -function get_band_index_by_value(swlw, targetvalue, units) result(ans) - character(len=*),intent(in) :: swlw ! sw or lw bands - real(r8),intent(in) :: targetvalue - character(len=*),intent(in) :: units ! units of targetvalue + character(len=*), intent(in) :: swlw ! sw or lw bands + real(r8), intent(in) :: targetvalue + character(len=*), intent(in) :: units ! units of targetvalue integer :: ans + ! local - real(r8), allocatable, dimension(:) :: lowboundaries, highboundaries + real(r8), pointer, dimension(:) :: lowboundaries, highboundaries real(r8) :: tgt integer :: nbnds, i select case (swlw) case ('sw','SW','shortwave') nbnds = nswbands - allocate(lowboundaries(nbnds), highboundaries(nbnds)) - lowboundaries = wavenumber_low_shortwave - highboundaries = wavenumber_high_shortwave + lowboundaries => wavenumber_low_shortwave + highboundaries => wavenumber_high_shortwave case ('lw', 'LW', 'longwave') nbnds = nlwbands - allocate(lowboundaries(nbnds), highboundaries(nbnds)) - lowboundaries = wavenumber_low_longwave - highboundaries = wavenumber_high_longwave + lowboundaries => wavenumber_low_longwave + highboundaries => wavenumber_high_longwave case default - call endrun('rad_constants.F90: get_band_index_by_value: type of bands not accepted '//swlw) + call endrun('radconstants.F90: get_band_index_by_value: type of bands not recognized: '//swlw) end select + ! band info is in cm^-1 but target value may be other units, ! so convert targetvalue to cm^-1 select case (units) @@ -339,43 +214,24 @@ function get_band_index_by_value(swlw, targetvalue, units) result(ans) case('cm','centimeter','centimeters') tgt = 1._r8/targetvalue case default - call endrun('rad_constants.F90: get_band_index_by_value: units not acceptable'//units) + call endrun('radconstants.F90: get_band_index_by_value: units not recognized: '//units) end select + ! now just loop through the array + ans = 0 do i = 1,nbnds if ((tgt > lowboundaries(i)) .and. (tgt <= highboundaries(i))) then ans = i exit end if end do - ! Do something if the answer is not found? -end function get_band_index_by_value - -subroutine set_irrad_by_band(solar_source, g2b) - ! Sets the solar irradiance in each shortwave band by summing the irradiance from gpoints. - ! solar_source = kdist_sw%solar_source <-- private TRY solar_source = kdist_sw%solar_source_quiet - ! g2b = kdist_sw%get_gpoint_bands() - real(r8), intent(in) :: solar_source(:) ! size ngpoints: irradiance per gpoint - integer, intent(in) :: g2b(:) ! size ngpoints: mapping from gpoint to band - integer :: i - allocate(solar_ref_band_irradiance(nswbands)) - solar_ref_band_irradiance(:) = 0.0_r8 - do i = 1,size(g2b) - solar_ref_band_irradiance(g2b(i)) = solar_ref_band_irradiance(g2b(i)) + solar_source(i) - end do -end subroutine set_irrad_by_band - -function get_irrad_by_band(solar_source, g2b) result(ans) - real(r8) :: solar_source(:) - integer :: g2b(:) - real(r8), allocatable :: ans(:) - if (.not. allocated(solar_ref_band_irradiance)) then - call set_irrad_by_band(solar_source, g2b) + if (ans == 0) then + call endrun('radconstants.F90: get_band_index_by_value: band not found: ') end if - allocate(ans(size(solar_ref_band_irradiance))) - ans = solar_ref_band_irradiance -end function get_irrad_by_band + +end function get_band_index_by_value +!------------------------------------------------------------------------------ end module radconstants diff --git a/src/physics/rrtmgp/radiation.F90 b/src/physics/rrtmgp/radiation.F90 index baf9620389..12955ae4ed 100644 --- a/src/physics/rrtmgp/radiation.F90 +++ b/src/physics/rrtmgp/radiation.F90 @@ -15,6 +15,7 @@ module radiation use physics_buffer, only: physics_buffer_desc, pbuf_get_field, pbuf_old_tim_idx use camsrfexch, only: cam_out_t, cam_in_t use physconst, only: cappa, cpair, gravit +use solar_irrad_data, only: sol_tsi use time_manager, only: get_nstep, is_first_restart_step, & get_curr_calday, get_step_size @@ -27,20 +28,9 @@ module radiation liqcldoptics, & icecldoptics -use radconstants, only: nswbands, nlwbands, & ! number of bands - idx_sw_diag, & ! indices for diagnostics - idx_nir_diag, & - idx_uv_diag, & - idx_lw_diag, & - get_idx_sw_diag, & ! sets the idx_*_diag in radconstants module - get_idx_nir_diag, & - get_idx_uv_diag, & - get_idx_lw_diag, & - rrtmg_to_rrtmgp_swbands, & ! maps bands between rrtmg and rrtmgp - get_band_index_by_value, & ! function that figures out band for a wavelength - gasnamelength, & - nradgas, & - gaslist +use radconstants, only: nswbands, nlwbands, idx_sw_diag, idx_nir_diag, idx_uv_diag, & + idx_lw_diag, idx_sw_cloudsim, idx_lw_cloudsim, & + nradgas, gasnamelength, gaslist use mo_gas_concentrations, only: ty_gas_concs use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp @@ -67,14 +57,16 @@ module radiation PIO_NOWRITE, & pio_closefile -use cam_abortutils, only: endrun -use error_messages, only: handle_err -use cam_logfile, only: iulog use scamMod, only: scm_crm_mode, single_column, have_cld, cldobs use cospsimulator_intr, only: docosp, cospsimulator_intr_init, & cospsimulator_intr_run, cosp_nradsteps +use string_utils, only: to_lower +use cam_abortutils, only: endrun +use error_messages, only: handle_err +use cam_logfile, only: iulog + implicit none private @@ -94,7 +86,6 @@ module radiation integer,public, allocatable :: cosp_cnt(:) ! counter for cosp integer,public :: cosp_cnt_init = 0 !initial value for cosp counter -integer, public :: sw_cloudsim_band, lw_cloudsim_band ! radiation bands that COSP uses real(r8), public, protected :: nextsw_cday ! future radiation calday for surface models @@ -181,6 +172,10 @@ module radiation logical :: graupel_in_rad = .false. ! graupel in radiation code logical :: use_rad_uniform_angle = .false. ! if true, use the namelist rad_uniform_angle for the coszrs calculation +! active_calls is set by a rad_constituents method after parsing namelist input +! for the rad_climate and rad_diag_N entries. +logical :: active_calls(0:N_DIAG) + ! Physics buffer indices integer :: qrs_idx = 0 integer :: qrl_idx = 0 @@ -222,29 +217,22 @@ module radiation ! vertical coordinate for output of fluxes on radiation grid real(r8), allocatable, target :: plev_rad(:) -! LW coefficients -type(ty_gas_optics_rrtmgp) :: kdist_lw ! bpm changed here - -! SW coefficients -type(ty_gas_optics_rrtmgp) :: kdist_sw ! bpm changed here -integer :: ngpt_sw +! Gas optics objects contain the data read from the coefficients files. +type(ty_gas_optics_rrtmgp) :: kdist_lw +type(ty_gas_optics_rrtmgp) :: kdist_sw -! data to go from bands to gpoints (bpm) -integer, allocatable :: band2gpt_sw(:,:) ! n[s,l]wbands come from radconstants for now +! data to go from bands to gpoints +integer, allocatable :: band2gpt_sw(:,:) integer, allocatable :: band2gpt_lw(:,:) +! Mapping from RRTMG shortwave bands to RRTMGP. Currently needed to continue using +! the SW optics datasets from RRTMG (even thought there is a slight mismatch in the +! band boundaries of the 2 bands that overlap with the LW bands). +integer, parameter, dimension(14) :: rrtmg_to_rrtmgp_swbands = & + [ 14, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13 ] -! Gases to use in the radiative calculations. -! RRTMGP kdist initialization needs to know the names of the -! gases before these are available via the rad_cnst interface. -! TODO: Move this to namelist or somewhere appropriate. -! NOTE: This list is not the same as `gaslist` in radconstants; is that a problem? Implication for diagnostic calls? -! character(len=5), dimension(10) :: active_gases = (/ & -! 'H2O ', 'CO2 ', 'O3 ', 'N2O ', & -! 'CO ', 'CH4 ', 'O2 ', 'N2 ', & -! 'CFC11', 'CFC12' /) -! BPM: use radconstants to define the active gases: -character(len=gasnamelength), dimension(nradgas) :: active_gases = gaslist +! lower case version of gaslist for RRTMGP +character(len=gasnamelength) :: gaslist_lc(nradgas) type(var_desc_t) :: cospcnt_desc ! cosp type(var_desc_t) :: nextsw_cday_desc @@ -474,13 +462,12 @@ subroutine radiation_init(pbuf2d) use physics_buffer, only: pbuf_get_index, pbuf_set_field use phys_control, only: phys_getopts - use rad_solar_var, only: rad_solar_var_init ! This initializes total solar irradiance use radiation_data, only: rad_data_init use cloud_rad_props, only: cloud_rad_props_init use modal_aer_opt, only: modal_aer_opt_init use rrtmgp_inputs, only: rrtmgp_inputs_init use time_manager, only: is_first_step - use radconstants, only: set_wavenumber_bands, set_irrad_by_band, set_reference_tsi + use radconstants, only: set_wavenumber_bands ! arguments type(physics_buffer_desc), pointer :: pbuf2d(:,:) @@ -492,8 +479,7 @@ subroutine radiation_init(pbuf2d) ! -- needed for the kdist initialization routines type(ty_gas_concs) :: available_gases - integer :: icall, nmodes - logical :: active_calls(0:N_DIAG) + integer :: i, icall, nmodes integer :: nstep ! current timestep number logical :: history_amwg ! output the variables used by the AMWG diag package logical :: history_vdiag ! output the variables used by the AMWG variability diag package @@ -504,7 +490,6 @@ subroutine radiation_init(pbuf2d) integer :: ierr integer :: dtime - real(r8) :: ref_tsi character(len=*), parameter :: sub = 'radiation_init' !----------------------------------------------------------------------- @@ -538,11 +523,20 @@ subroutine radiation_init(pbuf2d) call add_vert_coord('plev_rad', nlay+1, 'Pressures at radiation flux calculations', & 'Pa', plev_rad) - call set_available_gases(active_gases, available_gases) ! gases needed to initialize spectral info + ! Create lowercase version of the gaslist for RRTMGP. The ty_gas_concs objects + ! work with CAM's uppercase names, but other objects that get input from the gas + ! concs objects don't work. + do i = 1, nradgas + gaslist_lc(i) = to_lower(gaslist(i)) + end do + + errmsg = available_gases%init(gaslist_lc) + if (len_trim(errmsg) > 0) then + call endrun(sub//': ERROR: available_gases%init: '//trim(errmsg)) + end if call coefs_init(coefs_lw_file, kdist_lw, available_gases, band2gpt_lw) - call coefs_init(coefs_sw_file, kdist_sw, available_gases, band2gpt_sw, ref_tsi) ! bpm : these now provide band2gpt which should be global - call set_reference_tsi(ref_tsi) + call coefs_init(coefs_sw_file, kdist_sw, available_gases, band2gpt_sw) ! check number of sw/lw bands in gas optics files if (kdist_sw%get_nband() /= nswbands) then @@ -563,25 +557,11 @@ subroutine radiation_init(pbuf2d) call set_wavenumber_bands('sw', kdist_sw%get_nband(), kdist_sw%get_band_lims_wavenumber()) call set_wavenumber_bands('lw', kdist_lw%get_nband(), kdist_lw%get_band_lims_wavenumber()) - call rad_solar_var_init() ! sets the total solar irradiance (I wonder whether this should use kdist information instead of radconstants; alternative use kdist%set_tsi to ensure consistency?) call rrtmgp_inputs_init(ktopcamm, ktopradm, ktopcami, ktopradi) ! this sets these values as module data in rrtmgp_inputs call rad_data_init(pbuf2d) ! initialize output fields for offline driver call cloud_rad_props_init() - ngpt_sw = kdist_sw%get_ngpt() - - ! bpm: set the indices used for diagnostics using specific band: - call get_idx_sw_diag() ! index to sw visible band (441 - 625 nm) - call get_idx_nir_diag() ! index to sw near infrared (778-1240 nm) band - call get_idx_uv_diag() ! index to sw uv (345-441 nm) band - if (docosp) then - sw_cloudsim_band = get_band_index_by_value('sw', 0.67_r8, 'micron') ! rrtmgp band for .67 micron - lw_cloudsim_band = get_band_index_by_value('lw', 10.5_r8, 'micron') - end if - call get_idx_lw_diag() - - if (is_first_step()) then call pbuf_set_field(pbuf2d, qrl_idx, 0._r8) end if @@ -906,7 +886,7 @@ subroutine radiation_tend( & !----------------------------------------------------------------------- ! - ! Driver for radiation computation. + ! CAM driver for radiation computation. ! !----------------------------------------------------------------------- @@ -915,7 +895,6 @@ subroutine radiation_tend( & use cam_control_mod, only: eccen, mvelpp, lambm0, obliqr use shr_orb_mod, only: shr_orb_decl, shr_orb_cosz - use mo_gas_concentrations, only: ty_gas_concs use rrtmgp_inputs, only: rrtmgp_set_state, rrtmgp_set_gases_lw, rrtmgp_set_cloud_lw, & rrtmgp_set_aer_lw, rrtmgp_set_gases_sw, rrtmgp_set_cloud_sw, & rrtmgp_set_aer_sw @@ -936,8 +915,8 @@ subroutine radiation_tend( & use mo_fluxes_byband, only: ty_fluxes_byband - ! use mo_rrtmgp_clr_all_sky, only: rte_lw, rte_sw - use rrtmgp_driver, only: rte_lw, rte_sw + ! RRTMGP drivers for flux calculations. + use rrtmgp_driver, only: rte_lw, rte_sw use radheat, only: radheat_tend @@ -979,8 +958,8 @@ subroutine radiation_tend( & ! chunk_column_index = IdxDay(daylight_column_index) integer :: Nday ! Number of daylight columns integer :: Nnite ! Number of night columns - integer :: IdxDay(pcols) ! Indices of daylight columns -- Dimension is pcols, and is filled from beginning, so idxday(1:nday) are the indices of daylit columns. - integer :: IdxNite(pcols) ! Indices of night columns + integer :: IdxDay(pcols) ! chunk indices of daylight columns + integer :: IdxNite(pcols) ! chunk indices of night columns integer :: itim_old @@ -1016,7 +995,6 @@ subroutine radiation_tend( & real(r8), allocatable :: coszrs_day(:) real(r8), allocatable :: alb_dir(:,:) real(r8), allocatable :: alb_dif(:,:) - real(r8) :: tsi ! cloud radiative parameters are "in cloud" not "in cell" @@ -1074,13 +1052,12 @@ subroutine radiation_tend( & type(ty_optical_props_1scl) :: cloud_lw type(ty_optical_props_2str) :: cloud_sw - ! Irradiance integer :: icall ! index through climate/diagnostic radiation calls - logical :: active_calls(0:N_DIAG) - ! gas vmr + ! gas vmr. Separate objects because SW only does calculations for daylight columns. type(ty_gas_concs) :: gas_concs_lw type(ty_gas_concs) :: gas_concs_sw + ! RRTMGP aerosol objects type(ty_optical_props_1scl) :: aer_lw type(ty_optical_props_2str) :: aer_sw @@ -1264,13 +1241,10 @@ subroutine radiation_tend( & cam_in, & ! input (%lwup, %aldir, %asdir, %aldif, %asdif) ncol, & ! input nlay, & ! input - nlwbands, & ! input - nswbands, & ! input - ngpt_sw, & ! input nday, & ! input idxday, & ! input, [would prefer to truncate as 1:ncol] coszrs, & ! input - kdist_sw, & ! input (from init) ! removed: eccf, & ! input + kdist_sw, & ! input (from init) band2gpt_sw, & ! input (from init), gpoints by band t_sfc, & ! output emis_sfc, & ! output @@ -1282,14 +1256,10 @@ subroutine radiation_tend( & pint_day, & ! output coszrs_day, & ! output alb_dir, & ! output - alb_dif, & ! output - tsi & ! output, total solar irradiance (not scaled) - ) + alb_dif) ! output - !!--> Set TSI used in radiation to the value in the solar forcing file. - !!--> This replaces get_variability() and does same thing. - !!--> The Earth-Sun distance (eccf) provides another scaling, applied later. - errmsg = kdist_sw%set_tsi(tsi) ! scales the TSI but does not change spectral distribution + ! Set TSI used in rrtmgp to the value from CAM's solar forcing file. + errmsg = kdist_sw%set_tsi(sol_tsi) if (len_trim(errmsg) > 0) then call endrun(sub//': ERROR: kdist_sw%set_tsi: '//trim(errmsg)) end if @@ -1468,16 +1438,20 @@ subroutine radiation_tend( & if (write_output) then call radiation_output_cld(lchnk, ncol, rd) end if - ! - ! SHORTWAVE CALCULATION(S) - ! - ! Get the active climate/diagnostic shortwave calculations - call rad_cnst_get_call_list(active_calls) + + !=============================! + ! SHORTWAVE flux calculations ! + !=============================! + + ! initialize object for gas concentrations + errmsg = gas_concs_sw%init(gaslist_lc) + if (len_trim(errmsg) > 0) then + call endrun(sub//': ERROR: gas_concs_sw%init: '//trim(errmsg)) + end if ! The climate (icall==0) calculation must occur last. do icall = N_DIAG, 0, -1 if (active_calls(icall)) then - call set_available_gases(active_gases, gas_concs_sw) ! set gas concentrations call rrtmgp_set_gases_sw( & ! Put gas volume mixing ratio into gas_concs_sw icall, & ! input @@ -1576,9 +1550,10 @@ subroutine radiation_tend( & ! This happens between SW and LW (Why?) call rad_cnst_out(0, state, pbuf) - ! - ! -- LONGWAVE -- - ! + !============================! + ! LONGWAVE flux calculations ! + !============================! + if (dolw) then if (oldcldoptics) then call cloud_rad_props_get_lw(state, pbuf, cld_lw_abs, oldcloud=.true.) @@ -1653,23 +1628,21 @@ subroutine radiation_tend( & nlay, & kdist_lw%get_band_lims_wavenumber(), & name='longwave aerosol optics') - if (len_trim(errmsg) > 0) then - call endrun(sub//': ERROR: aer_lw%init_1scalar: '//trim(errmsg)) + call endrun(sub//': ERROR: aer_lw%alloc_1scalar: '//trim(errmsg)) end if - call rad_cnst_get_call_list(active_calls) ! get list of diagnostic calls + ! initialize object for gas concentrations + errmsg = gas_concs_lw%init(gaslist_lc) + if (len_trim(errmsg) > 0) then + call endrun(sub//': ERROR, gas_concs_lw%init: '//trim(errmsg)) + end if ! The climate (icall==0) calculation must occur last. do icall = N_DIAG, 0, -1 if (active_calls(icall)) then - ! initialize the gas concentrations - call set_available_gases(active_gases, gas_concs_lw) -! errmsg = gas_concs_lw%init(active_gases) -! if (len_trim(errmsg) > 0) then -! call endrun(sub//': ERROR code returned by gas_concs_lw%init: '//trim(errmsg)) -! end if + call rrtmgp_set_gases_lw(icall, state, pbuf, nlay, gas_concs_lw) call aer_rad_props_lw( & ! get absorption optical depth @@ -1703,14 +1676,7 @@ subroutine radiation_tend( & aer_props=aer_lw & ! optional input, (rrtmgp_set_aer_lw) ) ! note inc_flux is an optional input, but as defined in set_rrtmgp_state, it is only for shortwave if (len_trim(errmsg) > 0) then - ! - ! DEBUG -- if we die here, find out why - ! - write(iulog,*) '** [radiation_tend] DIAGNOSE LW CRASH **' - do i = 1,ncol - write(iulog,*) 'ncol = ',ncol,' t_sfc = ',t_sfc(i),' AT LOCATION lat = ', clat(i), ' lon = ', clon(i) - end do - call endrun(sub//': ERROR code returned by rte_lw: '//trim(errmsg)) + call endrun(sub//': ERROR: rte_lw: '//trim(errmsg)) end if ! ! -- longwave output -- @@ -1743,7 +1709,7 @@ subroutine radiation_tend( & if (docosp) then ! initialize and calculate emis emis(:,:) = 0._r8 - emis(:ncol,:) = 1._r8 - exp(-cld_lw_abs(lw_cloudsim_band,:ncol,:)) + emis(:ncol,:) = 1._r8 - exp(-cld_lw_abs(idx_lw_cloudsim,:ncol,:)) call outfld('EMIS', emis, pcols, lchnk) ! compute grid-box mean SW and LW snow optical depth for use by COSP @@ -1756,13 +1722,13 @@ subroutine radiation_tend( & ! Add graupel to snow tau for cosp if (cldfgrau_idx > 0 .and. graupel_in_rad) then - gb_snow_tau(i,k) = snow_tau(sw_cloudsim_band,i,k)*cldfsnow(i,k) + & - grau_tau(sw_cloudsim_band,i,k)*cldfgrau(i,k) - gb_snow_lw(i,k) = snow_lw_abs(lw_cloudsim_band,i,k)*cldfsnow(i,k) + & - grau_lw_abs(lw_cloudsim_band,i,k)*cldfgrau(i,k) + gb_snow_tau(i,k) = snow_tau(idx_sw_cloudsim,i,k)*cldfsnow(i,k) + & + grau_tau(idx_sw_cloudsim,i,k)*cldfgrau(i,k) + gb_snow_lw(i,k) = snow_lw_abs(idx_lw_cloudsim,i,k)*cldfsnow(i,k) + & + grau_lw_abs(idx_lw_cloudsim,i,k)*cldfgrau(i,k) else - gb_snow_tau(i,k) = snow_tau(sw_cloudsim_band,i,k)*cldfsnow(i,k) - gb_snow_lw(i,k) = snow_lw_abs(lw_cloudsim_band,i,k)*cldfsnow(i,k) + gb_snow_tau(i,k) = snow_tau(idx_sw_cloudsim,i,k)*cldfsnow(i,k) + gb_snow_lw(i,k) = snow_lw_abs(idx_lw_cloudsim,i,k)*cldfsnow(i,k) end if end if end do @@ -1778,14 +1744,14 @@ subroutine radiation_tend( & ! N.B.: For snow optical properties, the GRID-BOX MEAN shortwave and longwave ! optical depths are passed. call cospsimulator_intr_run(state, pbuf, cam_in, emis, coszrs, & - cld_swtau_in=cld_tau(sw_cloudsim_band,:,:),& + cld_swtau_in=cld_tau(idx_sw_cloudsim,:,:),& snow_tau_in=gb_snow_tau, snow_emis_in=gb_snow_lw) cosp_cnt(lchnk) = 0 end if end if !!! *** END COSP *** - else ! if (dosw .or. dolw) --> no radiation being done. + else ! --> radiative flux calculations not updated ! convert radiative heating rates from Q*dp to Q for energy conservation ! qrs and qrl are whatever are in pbuf ! since those might have been multiplied by pdel, we actually need to divide by pdel @@ -1848,9 +1814,9 @@ subroutine radiation_tend( & call free_fluxes(flw) call free_fluxes(flwc) -!------------------------------------------------------------------------------- -contains -!------------------------------------------------------------------------------- + !------------------------------------------------------------------------------- + contains + !------------------------------------------------------------------------------- subroutine set_sw_diags() @@ -2255,18 +2221,17 @@ subroutine calc_col_mean(state, mmr_pointer, mean_value) end subroutine calc_col_mean -!=============================================================================== +!========================================================================================= -subroutine coefs_init(coefs_file, kdist, available_gases, band2gpt, tsi_default) +subroutine coefs_init(coefs_file, kdist, available_gases, band2gpt) ! Read data from coefficients file. Initialize the kdist object. + ! available_gases object provides the gas names that CAM provides. ! arguments character(len=*), intent(in) :: coefs_file class(ty_gas_optics_rrtmgp), intent(out) :: kdist - class(ty_gas_concs), intent(in) :: available_gases ! Which gases does the host model have available? - - real(r8), intent(out), optional :: tsi_default ! RRTMGP reference TSI + class(ty_gas_concs), intent(in) :: available_gases ! local variables type(file_desc_t) :: fh ! pio file handle @@ -2302,6 +2267,7 @@ subroutine coefs_init(coefs_file, kdist, available_gases, band2gpt, tsi_default) real(r8), dimension(:,:), allocatable :: totplnk real(r8), dimension(:,:,:,:), allocatable :: planck_frac real(r8), dimension(:), allocatable :: solar_src_quiet, solar_src_facular, solar_src_sunspot ! updated from solar_src + real(r8) :: tsi_default real(r8), dimension(:,:,:), allocatable :: rayl_lower, rayl_upper character(len=32), dimension(:), allocatable :: gas_minor, & identifier_minor, & @@ -2540,15 +2506,6 @@ subroutine coefs_init(coefs_file, kdist, available_gases, band2gpt, tsi_default) if (ierr /= PIO_NOERR) call endrun(sub//': error reading optimal_angle_fit') end if - ! solar_src - ! !bpm -- solar_source is not in file, there are solar_source_[facular, sunspot, quiet] - ! There's a method that adds them together to get solar_source. - ! ierr = pio_inq_varid(fh, 'solar_source', vid) - ! if (ierr == PIO_NOERR) then - ! allocate(solar_src(gpt)) - ! ierr = pio_get_var(fh, vid, solar_src) - ! if (ierr /= PIO_NOERR) call endrun(sub//': error reading solar_source') - ! end if ierr = pio_inq_varid(fh, 'solar_source_quiet', vid) if (ierr == PIO_NOERR) then allocate(solar_src_quiet(gpt)) @@ -2568,7 +2525,6 @@ subroutine coefs_init(coefs_file, kdist, available_gases, band2gpt, tsi_default) if (ierr /= PIO_NOERR) call endrun(sub//': error reading solar_source_sunspot') end if - ! +bpm also need to have tsi_default, mg_default, and sb_default ierr = pio_inq_varid(fh, 'tsi_default', vid) if (ierr == PIO_NOERR) then ierr = pio_get_var(fh, vid, tsi_default) @@ -2836,32 +2792,7 @@ subroutine coefs_init(coefs_file, kdist, available_gases, band2gpt, tsi_default) if (allocated(rayl_upper)) deallocate(rayl_upper) end subroutine coefs_init - - -subroutine set_available_gases(gases, gas_concentrations) - ! This subroutine is based on the E3SM implementation. -bpm - ! For each gas name in gases, initialize that gas in gas_concentrations. - use mo_gas_concentrations, only: ty_gas_concs - use mo_rrtmgp_util_string, only: lower_case - ! Arguments - type(ty_gas_concs), intent(inout) :: gas_concentrations - character(len=*), intent(in) :: gases(:) - ! Local - character(len=32), dimension(size(gases)) :: gases_lowercase - integer :: igas - character(len=128) :: error_msg - ! Initialize with lowercase gas names; we should work in lowercase - ! whenever possible because we cannot trust string comparisons in RRTMGP - ! to be case insensitive ... it *should* work regardless of case. - do igas = 1,size(gases) - gases_lowercase(igas) = trim(lower_case(gases(igas))) - end do - error_msg = gas_concentrations%init(gases_lowercase) - if (len_trim(error_msg) > 0) then - call endrun('Setting available gases. ERROR: '//trim(error_msg)) - end if -end subroutine set_available_gases - +!========================================================================================= subroutine reset_fluxes(fluxes) diff --git a/src/physics/rrtmgp/rrtmgp_inputs.F90 b/src/physics/rrtmgp/rrtmgp_inputs.F90 index 116093add4..6823d5aaa0 100644 --- a/src/physics/rrtmgp/rrtmgp_inputs.F90 +++ b/src/physics/rrtmgp/rrtmgp_inputs.F90 @@ -5,11 +5,6 @@ module rrtmgp_inputs ! RRTMGP. Subset the number of model levels if CAM's top exceeds RRTMGP's ! valid domain. ! -! This code is currently set up to send RRTMGP vertical layers ordered bottom -! to top of model. Although the RRTMGP is supposed to be agnostic about the -! vertical ordering problems have arisen trying to use the top to bottom order -! as used by CAM's infrastructure. -! !-------------------------------------------------------------------------------- use shr_kind_mod, only: r8=>shr_kind_r8 @@ -21,24 +16,20 @@ module rrtmgp_inputs use physics_buffer, only: physics_buffer_desc use camsrfexch, only: cam_in_t -use radconstants, only: get_ref_solar_band_irrad, rad_gas_index -use radconstants, only: nradgas, gaslist, rrtmg_to_rrtmgp_swbands -use rad_solar_var, only: get_variability -use solar_irrad_data, only : do_spctrl_scaling, sol_tsi +use radconstants, only: nswbands, nlwbands, get_sw_spectral_boundaries +use radconstants, only: nradgas, gaslist + use rad_constituents, only: rad_cnst_get_gas use mcica_subcol_gen, only: mcica_subcol_sw, mcica_subcol_lw use mo_gas_concentrations, only: ty_gas_concs -use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp -use mo_optical_props, only: ty_optical_props, ty_optical_props_2str, ty_optical_props_1scl +use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp +use mo_optical_props, only: ty_optical_props_2str, ty_optical_props_1scl -! unneeded use mo_rrtmgp_util_string, only: lower_case -use cam_logfile, only: iulog +use cam_logfile, only: iulog use cam_abortutils, only: endrun -use cam_history, only: outfld ! just for getting ozone VMR above model top. - implicit none private save @@ -71,12 +62,18 @@ module rrtmgp_inputs integer :: ktopcami ! cam index of top interface integer :: ktopradi ! rrtmgp index of interface corresponding to ktopcami +! wavenumber (cm^-1) boundaries of shortwave bands +real(r8) :: sw_low_bounds(nswbands), sw_high_bounds(nswbands) + !================================================================================================== contains !================================================================================================== subroutine rrtmgp_inputs_init(ktcamm, ktradm, ktcami, ktradi) + ! Note that this routine must be called after the calls to set_wavenumber_bands which set + ! the sw/lw band boundaries in the radconstants module. + integer, intent(in) :: ktcamm integer, intent(in) :: ktradm integer, intent(in) :: ktcami @@ -87,27 +84,26 @@ subroutine rrtmgp_inputs_init(ktcamm, ktradm, ktcami, ktradi) ktopcami = ktcami ktopradi = ktradi + call get_sw_spectral_boundaries(sw_low_bounds, sw_high_bounds, 'cm^-1') + end subroutine rrtmgp_inputs_init !================================================================================================== subroutine rrtmgp_set_state( & - pstate, cam_in, ncol, nlay, nlwbands, & - nswbands, ngpt_sw, nday, idxday, coszrs, & - kdist_sw, & ! eccf, & !!! Removing eccf from arguments, as it is not needed here + pstate, cam_in, ncol, nlay, & + nday, idxday, coszrs, & + kdist_sw, & band2gpt_sw, & t_sfc, emis_sfc, t_rad, & pmid_rad, pint_rad, t_day, pmid_day, pint_day, & - coszrs_day, alb_dir, alb_dif, tsi) + coszrs_day, alb_dir, alb_dif) ! arguments type(physics_state), target, intent(in) :: pstate type(cam_in_t), intent(in) :: cam_in integer, intent(in) :: ncol integer, intent(in) :: nlay - integer, intent(in) :: nlwbands - integer, intent(in) :: nswbands - integer, intent(in) :: ngpt_sw integer, intent(in) :: nday integer, intent(in) :: idxday(:) real(r8), intent(in) :: coszrs(:) @@ -127,10 +123,6 @@ subroutine rrtmgp_set_state( & real(r8), intent(out) :: coszrs_day(nday) ! cosine of solar zenith angle real(r8), intent(out) :: alb_dir(nswbands,nday) ! surface albedo, direct radiation real(r8), intent(out) :: alb_dif(nswbands,nday) ! surface albedo, diffuse radiation - ! real(r8), intent(out) :: solin(ncol) ! incident flux at domain top [W/m2] - ! real(r8), intent(out) :: solar_irrad_gpt(nday,ngpt_sw) ! incident flux at domain top per gpoint [W/m2] AT DAYLIT POINTS - ! real(r8), intent(out) :: tsi_scaling_gpt(ngpt_sw) ! scale factor for irradiance by gpoint [fraction] - real(r8), intent(out) :: tsi ! total irradiance W/m2 ! local variables integer :: k, kk, i, iband @@ -139,10 +131,6 @@ subroutine rrtmgp_set_state( & real(r8) :: sfac(nswbands) ! time varying scaling factors due to Solar Spectral ! Irrad at 1 A.U. per band - real(r8) :: wavenumber_limits(2,nswbands) - - ! real(r8) :: toa_flx_by_band(nswbands) ! temporary array of incoming flux by band - ! real(r8) :: toa_flx_by_gpt(ngpt_sw) ! temporary array of incoming flux by gpt character(len=*), parameter :: sub='rrtmgp_set_state' character(len=512) :: errmsg @@ -192,65 +180,16 @@ subroutine rrtmgp_set_state( & coszrs_day(i) = coszrs(idxday(i)) end do - - ! total solar incident radiation - tsi = sol_tsi ! when using sol_tsi from solar_irrad_data, this is read from a file. - - ! TO BE REMOVED - ! We can get TSI from the solar forcing file (above). - ! We can't get the scaling here because we might not have access - ! to RRTMGP's reference irradiance on bands yet (without running kdist%gas_optics). - ! The scaling can be derived in rrtmgp_driver / rte_sw (after %gas_optics provides the toa_flux). - ! call get_ref_solar_band_irrad(solar_band_irrad) - ! call get_variability(sfac) - ! solar_band_irrad = solar_band_irrad(rrtmg_to_rrtmgp_swbands) - ! tsi = sum(solar_band_irrad(:)) ! total TSI integrated across bands, BUT NOT scaled for variability - ! ! convert from irradiance scale factor per band (sfac) to per gpoint - ! ! --> this can then be used in rrtmgp_driver module, rte_sw to scale TOA flux - ! tsi_scaling_gpt = 0.0 - - ! do iband = 1,nswbands - ! tsi_scaling_gpt(band2gpt_sw(1,iband):band2gpt_sw(2,iband)) = sfac(iband) - ! end do - - ! if we had a method to produce toa flux by gpoint, we could make that an output here. - - ! <-- begin: old way of setting albedo hard-wired to 14 SW bands --> - ! ! Surface albedo (band mapping is hardcoded for RRTMG(P) code) - ! ! This mapping assumes nswbands=14. - ! if (nswbands /= 14) & - ! call endrun(sub//': ERROR: albedo band mapping assumes nswbands=14') - - ! do i = 1, nday - ! ! Near-IR bands (1-9 and 14), 820-16000 cm-1, 0.625-12.195 microns - ! alb_dir(1:8,i) = cam_in%aldir(idxday(i)) - ! alb_dif(1:8,i) = cam_in%aldif(idxday(i)) - ! alb_dir(14,i) = cam_in%aldir(idxday(i)) - ! alb_dif(14,i) = cam_in%aldif(idxday(i)) - - ! ! Set band 24 (or, band 9 counting from 1) to use linear average of UV/visible - ! ! and near-IR values, since this band straddles 0.7 microns: - ! alb_dir(9,i) = 0.5_r8*(cam_in%aldir(idxday(i)) + cam_in%asdir(idxday(i))) - ! alb_dif(9,i) = 0.5_r8*(cam_in%aldif(idxday(i)) + cam_in%asdif(idxday(i))) - - ! ! UV/visible bands 25-28 (10-13), 16000-50000 cm-1, 0.200-0.625 micron - ! alb_dir(10:13,i) = cam_in%asdir(idxday(i)) - ! alb_dif(10:13,i) = cam_in%asdif(idxday(i)) - ! enddo - ! <-- end: old way of setting albedo hard-wired to 14 SW bands --> - - ! More flexible way to assign albedo (from E3SM implementation) - ! adapted here to loop over bands and cols b/c cam_in has all cols but albedos are daylit cols - ! We could remove cols loop if we just set albedos for all columns separate from rrtmgp_set_state. - ! Albedos are input as broadband (visible, and near-IR), and we need to map - ! these to appropriate bands. Bands are categorized broadly as "visible" or - ! "infrared" based on wavenumber, so we get the wavenumber limits here - wavenumber_limits = kdist_sw%get_band_lims_wavenumber() + ! Assign albedos to the daylight columns (from E3SM implementation) + ! Albedos are imported from the surface models as broadband (visible, and near-IR), + ! and we need to map these to appropriate narrower bands used in RRTMGP. Bands + ! are categorized broadly as "visible/UV" or "infrared" based on wavenumber. ! Loop over bands, and determine for each band whether it is broadly in the - ! visible or infrared part of the spectrum (visible or "not visible") + ! visible or infrared part of the spectrum based on a dividing line of + ! 0.7 micron, or 14286 cm^-1 do iband = 1,nswbands - if (is_visible(wavenumber_limits(1,iband)) .and. & - is_visible(wavenumber_limits(2,iband))) then + if (is_visible(sw_low_bounds(iband)) .and. & + is_visible(sw_high_bounds(iband))) then ! Entire band is in the visible do i = 1, nday @@ -258,8 +197,8 @@ subroutine rrtmgp_set_state( & alb_dif(iband,i) = cam_in%asdif(idxday(i)) end do - else if (.not.is_visible(wavenumber_limits(1,iband)) .and. & - .not.is_visible(wavenumber_limits(2,iband))) then + else if (.not.is_visible(sw_low_bounds(iband)) .and. & + .not.is_visible(sw_high_bounds(iband))) then ! Entire band is in the longwave (near-infrared) do i = 1, nday alb_dir(iband,i) = cam_in%aldir(idxday(i)) @@ -276,7 +215,6 @@ subroutine rrtmgp_set_state( & end if end do - ! Strictly enforce albedo bounds where (alb_dir < 0) alb_dir = 0.0_r8 @@ -292,19 +230,21 @@ subroutine rrtmgp_set_state( & end where end subroutine rrtmgp_set_state -! -! Function to check if a wavenumber is in the visible or IR +!================================================================================================== + logical function is_visible(wavenumber) + ! Wavenumber is in the visible if it is above the visible threshold + ! wavenumber, and in the infrared if it is below the threshold + ! This function doesn't distinquish between visible and UV. + ! wavenumber in inverse cm (cm^-1) real(r8), intent(in) :: wavenumber ! Threshold between visible and infrared is 0.7 micron, or 14286 cm^-1 real(r8), parameter :: visible_wavenumber_threshold = 14286._r8 ! cm^-1 - ! Wavenumber is in the visible if it is above the visible threshold - ! wavenumber, and in the infrared if it is below the threshold if (wavenumber > visible_wavenumber_threshold) then is_visible = .true. else @@ -313,29 +253,29 @@ logical function is_visible(wavenumber) end function is_visible - !================================================================================================== + function get_molar_mass_ratio(gas_name) result(massratio) ! return the molar mass ratio of dry air to gas based on gas_name character(len=*),intent(in) :: gas_name real(r8) :: massratio select case (trim(gas_name)) - case ('h2o', 'H2O') + case ('H2O') massratio = 1.607793_r8 - case ('co2', 'CO2') + case ('CO2') massratio = 0.658114_r8 - case ('o3', 'O3') + case ('O3') massratio = 0.603428_r8 - case ('ch4', 'CH4') + case ('CH4') massratio = 1.805423_r8 - case ('n2o', 'N2O') + case ('N2O') massratio = 0.658090_r8 - case ('o2', 'O2') + case ('O2') massratio = 0.905140_r8 - case ('cfc11', 'CFC11') + case ('CFC11') massratio = 0.210852_r8 - case ('cfc12', 'CFC12') + case ('CFC12') massratio = 0.239546_r8 case default call endrun("Invalid gas: "//trim(gas_name)) @@ -379,7 +319,7 @@ subroutine rad_gas_get_vmr(icall, gas_name, pstate, pbuf, nlay, numactivecols, g mmr = gas_mmr ! special case: H2O is specific humidity, not mixing ratio. Use r = q/(1-q): - if (gas_name == 'h2o') then + if (gas_name == 'H2O') then mmr = mmr / (1._r8 - mmr) end if @@ -457,7 +397,7 @@ subroutine rad_gas_get_vmr(icall, gas_name, pstate, pbuf, nlay, numactivecols, g errmsg = gas_concs%set_vmr(gas_name, gas_vmr) if (len_trim(errmsg) > 0) then - call endrun(sub//': error setting CO2: '//trim(errmsg)) + call endrun(sub//': ERROR, gas_concs%set_vmr: '//trim(errmsg)) end if deallocate(gas_vmr) diff --git a/src/physics/rrtmgp/slingo.F90 b/src/physics/rrtmgp/slingo.F90 index aedb44bcee..64d614365e 100644 --- a/src/physics/rrtmgp/slingo.F90 +++ b/src/physics/rrtmgp/slingo.F90 @@ -9,7 +9,7 @@ module slingo use ppgrid, only: pcols, pver, pverp use physics_types, only: physics_state use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_get_field, pbuf_old_tim_idx -use radconstants, only: nswbands, nlwbands, idx_sw_diag, ot_length, idx_lw_diag, get_sw_spectral_boundaries +use radconstants, only: nswbands, nlwbands, get_sw_spectral_boundaries use cam_abortutils, only: endrun use cam_history, only: outfld @@ -80,20 +80,6 @@ subroutine slingo_rad_props_init() call cnst_get_ind('CLDLIQ', ixcldliq) call cnst_get_ind('CLDICE', ixcldice) - !call addfld ('CLWPTH_OLD',(/ 'lev' /), 'I','Kg/m2','old In Cloud Liquid Water Path', sampling_seq='rad_lwsw') - !call addfld ('KEXT_OLD',(/ 'lev' /),'I','m^2/kg','old extinction') - !call addfld ('CLDOD_OLD',(/ 'lev' /),'I','1','old liquid OD') - !call addfld ('REL_OLD',(/ 'lev' /),'I','1','old liquid effective radius (liquid)') - - !call addfld ('CLWPTH_NEW',(/ 'lev' /), 'I','Kg/m2','In Cloud Liquid Water Path', sampling_seq='rad_lwsw') - !call addfld ('KEXT_NEW',(/ 'lev' /),'I','m^2/kg','extinction') - !call addfld ('CLDOD_NEW',(/ 'lev' /),'I','1','liquid OD') - - !call addfld('CIWPTH_NEW',(/ 'lev' /), 'I','Kg/m2','In Cloud Ice Water Path', sampling_seq='rad_lwsw') - !call addfld('CIWPTH_OLD',(/ 'lev' /), 'I','Kg/m2','In Cloud Ice Water Path (old)', sampling_seq='rad_lwsw') - - return - end subroutine slingo_rad_props_init !============================================================================== @@ -318,12 +304,6 @@ subroutine slingo_liq_optics_sw(state, pbuf, liq_tau, liq_tau_w, liq_tau_w_g, li end do ! End do k=1,pver end do ! nswbands - !call outfld('CL_OD_SW_OLD',liq_tau(idx_sw_diag,:,:), pcols, lchnk) - !call outfld('REL_OLD',rel(:,:), pcols, lchnk) - !call outfld('CLWPTH_OLD',cliqwp(:,:), pcols, lchnk) - !call outfld('KEXT_OLD',kext(:,:), pcols, lchnk) - - end subroutine slingo_liq_optics_sw subroutine slingo_liq_get_rad_props_lw(state, pbuf, abs_od, oldliqwp) diff --git a/src/physics/simple/radconstants.F90 b/src/physics/simple/radconstants.F90 index b69fac1552..60585713d6 100644 --- a/src/physics/simple/radconstants.F90 +++ b/src/physics/simple/radconstants.F90 @@ -15,8 +15,6 @@ module radconstants integer, parameter, public :: idx_lw_diag = 1 integer, parameter, public :: idx_nir_diag = 1 integer, parameter, public :: idx_uv_diag = 1 -integer, parameter, public :: nrh = 1 -integer, parameter, public :: ot_length = 32 public :: rad_gas_index public :: get_lw_spectral_boundaries From e53e7077e167ce2cb9ac7fea35b9186a816f4466 Mon Sep 17 00:00:00 2001 From: Brian Eaton Date: Mon, 4 Sep 2023 11:35:35 -0400 Subject: [PATCH 131/291] merge cam6_3_125 mod to rrtmg/radiation.F90 to rrtmgp --- src/physics/rrtmgp/radiation.F90 | 20 ++++---------------- 1 file changed, 4 insertions(+), 16 deletions(-) diff --git a/src/physics/rrtmgp/radiation.F90 b/src/physics/rrtmgp/radiation.F90 index 12955ae4ed..2890dec381 100644 --- a/src/physics/rrtmgp/radiation.F90 +++ b/src/physics/rrtmgp/radiation.F90 @@ -20,13 +20,9 @@ module radiation use time_manager, only: get_nstep, is_first_restart_step, & get_curr_calday, get_step_size -use rad_constituents, only: N_DIAG, rad_cnst_get_call_list, & - rad_cnst_get_info, & - rad_cnst_get_gas, & - rad_cnst_out, & - oldcldoptics, & - liqcldoptics, & - icecldoptics +use rad_constituents, only: N_DIAG, rad_cnst_get_call_list, & + rad_cnst_get_gas, rad_cnst_out, oldcldoptics, & + liqcldoptics, icecldoptics use radconstants, only: nswbands, nlwbands, idx_sw_diag, idx_nir_diag, idx_uv_diag, & idx_lw_diag, idx_sw_cloudsim, idx_lw_cloudsim, & @@ -464,7 +460,6 @@ subroutine radiation_init(pbuf2d) use phys_control, only: phys_getopts use radiation_data, only: rad_data_init use cloud_rad_props, only: cloud_rad_props_init - use modal_aer_opt, only: modal_aer_opt_init use rrtmgp_inputs, only: rrtmgp_inputs_init use time_manager, only: is_first_step use radconstants, only: set_wavenumber_bands @@ -479,7 +474,7 @@ subroutine radiation_init(pbuf2d) ! -- needed for the kdist initialization routines type(ty_gas_concs) :: available_gases - integer :: i, icall, nmodes + integer :: i, icall integer :: nstep ! current timestep number logical :: history_amwg ! output the variables used by the AMWG diag package logical :: history_vdiag ! output the variables used by the AMWG variability diag package @@ -584,13 +579,6 @@ subroutine radiation_init(pbuf2d) history_budget_out = history_budget, & history_budget_histfile_num_out = history_budget_histfile_num) - ! Determine whether modal aerosols are affecting the climate, and if so - ! then initialize the modal aerosol optics module - call rad_cnst_get_info(0, nmodes=nmodes) - if (nmodes > 0) then - call modal_aer_opt_init() - end if - ! "irad_always" is number of time steps to execute radiation ! continuously from start of initial OR restart run ! _This gets used in radiation_do_ From d8edb8d8ebb9531cc3d30c2e8d145fcf53df7549 Mon Sep 17 00:00:00 2001 From: Brian Eaton Date: Mon, 4 Sep 2023 20:25:17 -0400 Subject: [PATCH 132/291] mods for compatibility of rrtmgp with cam6_3_125 --- src/physics/cam/aerosol_optics_cam.F90 | 3 ++- src/physics/cam/physpkg.F90 | 11 ++++++----- 2 files changed, 8 insertions(+), 6 deletions(-) diff --git a/src/physics/cam/aerosol_optics_cam.F90 b/src/physics/cam/aerosol_optics_cam.F90 index eb094446c8..a81e1d4701 100644 --- a/src/physics/cam/aerosol_optics_cam.F90 +++ b/src/physics/cam/aerosol_optics_cam.F90 @@ -3,7 +3,8 @@ module aerosol_optics_cam use shr_kind_mod, only: cl => shr_kind_cl use cam_logfile, only: iulog use radconstants, only: nswbands, nlwbands, idx_sw_diag, idx_uv_diag, idx_nir_diag - use radconstants, only: ot_length, get_lw_spectral_boundaries + use radconstants, only: get_lw_spectral_boundaries + use phys_prop, only: ot_length use physics_types,only: physics_state use physics_buffer,only: physics_buffer_desc use ppgrid, only: pcols, pver diff --git a/src/physics/cam/physpkg.F90 b/src/physics/cam/physpkg.F90 index 706b9dcdee..a5ff431d64 100644 --- a/src/physics/cam/physpkg.F90 +++ b/src/physics/cam/physpkg.F90 @@ -853,19 +853,22 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) ! low level, so init it early. Must at least do this before radiation. call wv_sat_init + ! solar irradiance data modules + call solar_data_init() + ! CAM3 prescribed aerosols if (cam3_aero_data_on) call cam3_aero_data_init(phys_state) ! Initialize rad constituents and their properties call rad_cnst_init() + + call radiation_init(pbuf2d) + call aer_rad_props_init() ! initialize carma call carma_init() - ! solar irradiance data modules - call solar_data_init() - ! Prognostic chemistry. call chem_init(phys_state,pbuf2d) @@ -904,8 +907,6 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) endif endif - call radiation_init(pbuf2d) - call cloud_diagnostics_init() call radheat_init(pref_mid) From aaf66d969cf144b2c6203df8512c70bc43a87518 Mon Sep 17 00:00:00 2001 From: Brian Eaton Date: Tue, 5 Sep 2023 10:38:42 -0400 Subject: [PATCH 133/291] fix rrtmgp build-namelist mod; add missing _r8 to aerosol code --- bld/build-namelist | 6 ++++-- src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 | 2 +- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/bld/build-namelist b/bld/build-namelist index bd4949a80c..6d0e6b50fe 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -728,8 +728,10 @@ if ($rad_pkg =~ /rrtmg/ or $chem =~ /waccm/) { # use solar data file as the default for rrtmg and waccm_ma add_default($nl, 'solar_irrad_data_file'); - # restrict this option to just the rrtmg code - if ($rad_pkg eq 'rrtmg') { + + # This option only used by camrt and rrtmg radiation schemes. + # The solar spectral scaling is done internal to RRTMGP code. + if ($rad_pkg ne 'rrtmgp') { add_default($nl, 'solar_htng_spctrl_scl', 'val'=>'.true.'); } diff --git a/src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 b/src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 index a789db0383..e1289a8790 100644 --- a/src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 +++ b/src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 @@ -285,7 +285,7 @@ subroutine lw_props(self, ncol, ilev, iwav, pabs) do icol = 1, ncol crefin(icol) = crefin(icol) + self%watervol(icol,ilev)*self%crefwlw(iwav) - crefin(icol) = crefin(icol)/max(self%wetvol(icol,ilev), 1.e-40) + crefin(icol) = crefin(icol)/max(self%wetvol(icol,ilev), 1.e-40_r8) refr(icol) = real(crefin(icol)) refi(icol) = aimag(crefin(icol)) From 4ced2a81221a7f041058ca314fb1ea4a2339fa73 Mon Sep 17 00:00:00 2001 From: Brian Eaton Date: Wed, 6 Sep 2023 08:59:05 -0400 Subject: [PATCH 134/291] remove extra ktopcam, ktoprad indices --- src/physics/rrtmgp/radconstants.F90 | 5 +- src/physics/rrtmgp/radiation.F90 | 144 ++++++++++++--------------- src/physics/rrtmgp/rrtmgp_inputs.F90 | 74 +++++--------- 3 files changed, 90 insertions(+), 133 deletions(-) diff --git a/src/physics/rrtmgp/radconstants.F90 b/src/physics/rrtmgp/radconstants.F90 index d086d1ce16..175e8e65b4 100644 --- a/src/physics/rrtmgp/radconstants.F90 +++ b/src/physics/rrtmgp/radconstants.F90 @@ -33,9 +33,8 @@ module radconstants ! GASES TREATED BY RADIATION (line spectrae) ! These names are recognized by RRTMGP. They are in the coefficients files as -! lower case strings. These upper case names are used by CAM's namelist and can -! be used to initialize the ty_gas_conc object because the name matching is case -! insensitive. +! lower case strings. These upper case names are used by CAM's namelist and +! rad_constituents module. integer, public, parameter :: gasnamelength = 5 integer, public, parameter :: nradgas = 8 character(len=gasnamelength), public, parameter :: gaslist(nradgas) & diff --git a/src/physics/rrtmgp/radiation.F90 b/src/physics/rrtmgp/radiation.F90 index 2890dec381..eaac53346e 100644 --- a/src/physics/rrtmgp/radiation.F90 +++ b/src/physics/rrtmgp/radiation.F90 @@ -8,7 +8,6 @@ module radiation use shr_kind_mod, only: r8=>shr_kind_r8, cl=>shr_kind_cl use spmd_utils, only: masterproc -use shr_mem_mod, only: shr_mem_getusage use ppgrid, only: pcols, pver, pverp, begchunk, endchunk use ref_pres, only: pref_edge use physics_types, only: physics_state, physics_ptend @@ -28,35 +27,25 @@ module radiation idx_lw_diag, idx_sw_cloudsim, idx_lw_cloudsim, & nradgas, gasnamelength, gaslist -use mo_gas_concentrations, only: ty_gas_concs -use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp +use cospsimulator_intr, only: docosp, cospsimulator_intr_init, & + cospsimulator_intr_run, cosp_nradsteps + +use scamMod, only: scm_crm_mode, single_column, have_cld, cldobs use cam_history, only: addfld, add_default, horiz_only, outfld, hist_fld_active use cam_history_support, only: fillvalue, add_vert_coord use ioFileMod, only: getfil use cam_pio_utils, only: cam_pio_openfile -use pio, only: file_desc_t, & - var_desc_t, & - pio_int, & - PIO_NOERR, & - PIO_INTERNAL_ERROR, & - pio_seterrorhandling, & - PIO_BCAST_ERROR, & - pio_inq_dimlen, & - pio_inq_dimid, & - pio_inq_varid, & - pio_def_var, & - pio_put_var, & - pio_get_var, & - pio_put_att, & - PIO_NOWRITE, & - pio_closefile - -use scamMod, only: scm_crm_mode, single_column, have_cld, cldobs +use pio, only: file_desc_t, var_desc_t, & + pio_int, pio_double, PIO_NOERR, & + pio_seterrorhandling, PIO_BCAST_ERROR, & + pio_inq_dimlen, pio_inq_dimid, pio_inq_varid, & + pio_def_var, pio_put_var, pio_get_var, & + pio_put_att, PIO_NOWRITE, pio_closefile -use cospsimulator_intr, only: docosp, cospsimulator_intr_init, & - cospsimulator_intr_run, cosp_nradsteps +use mo_gas_concentrations, only: ty_gas_concs +use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp use string_utils, only: to_lower use cam_abortutils, only: endrun @@ -205,10 +194,11 @@ module radiation ! extra layer that is added between 1 Pa and the model top. ! 2. If the WACCM model top is above 1 Pa, then RRMTGP only does calculations ! for those model layers that are below 1 Pa. -integer :: ktopcamm ! index in CAM arrays of top layer at which RRTMGP is active -integer :: ktopcami ! index in CAM arrays of top interface at which RRTMGP is active -integer :: ktopradm ! index in RRTMGP arrays of layer corresponding to CAM top layer -integer :: ktopradi ! index in RRTMGP arrays of interface corresponding to CAM top interface +integer :: ktopcam ! Index in CAM arrays of top level (layer or interface) at which RRTMGP is active. +integer :: ktoprad ! Index in RRTMGP arrays of the layer or interface corresponding to CAM's top + ! layer or interface. + ! For CAM's top to bottom indexing, the index of a given layer + ! (midpoint) and the upper interface of that layer, are the same. ! vertical coordinate for output of fluxes on radiation grid real(r8), allocatable, target :: plev_rad(:) @@ -257,16 +247,10 @@ subroutine radiation_readnl(nlfile) character(len=cl) :: rrtmgp_coefs_lw_file, rrtmgp_coefs_sw_file - namelist /radiation_nl/ rrtmgp_coefs_lw_file, & - rrtmgp_coefs_sw_file, & - iradsw, & - iradlw, & - irad_always, & - use_rad_dt_cosz, & - spectralflux, & - use_rad_uniform_angle, & - rad_uniform_angle, & - graupel_in_rad + namelist /radiation_nl/ & + rrtmgp_coefs_lw_file, rrtmgp_coefs_sw_file, iradsw, iradlw, & + irad_always, use_rad_dt_cosz, spectralflux, use_rad_uniform_angle, & + rad_uniform_angle, graupel_in_rad !----------------------------------------------------------------------------- if (masterproc) then @@ -309,7 +293,6 @@ subroutine radiation_readnl(nlfile) call endrun(subroutine_name // ' ERROR - use_rad_uniform_angle is set to .true, but rad_uniform_angle is not set ') end if - ! Set module data coefs_lw_file = rrtmgp_coefs_lw_file coefs_sw_file = rrtmgp_coefs_sw_file @@ -369,7 +352,8 @@ subroutine radiation_register call pbuf_add_field('LD' , 'global',dtype_r8,(/pcols,pverp,nlwbands/), ld_idx) ! longwave downward flux (per band) end if - call rad_data_register() ! if "fixed dynamical heating", this adds 4 fields to physics buffer (needed?) + ! Register fields for offline radiation driver. + call rad_data_register() end subroutine radiation_register @@ -405,6 +389,7 @@ function radiation_do(op, timestep) case default call endrun('radiation_do: unknown operation:'//op) end select + end function radiation_do !================================================================================================ @@ -452,8 +437,7 @@ end function radiation_nextsw_cday subroutine radiation_init(pbuf2d) - ! Initialize the radiation, cloud, and aerosol optics, and solar variability - ! parameterizations. + ! Initialize the radiation and cloud optics. ! Add fields to the history buffer. use physics_buffer, only: pbuf_get_index, pbuf_set_field @@ -499,19 +483,15 @@ subroutine radiation_init(pbuf2d) if (nlay == pverp) then ! Top model interface is below 1 Pa. RRTMGP is active in all model layers plus ! 1 extra layer between model top and 1 Pa. - ktopcamm = 1 - ktopcami = 1 - ktopradm = 2 - ktopradi = 2 + ktopcam = 1 + ktoprad = 2 plev_rad(1) = 1.01_r8 ! Top of extra layer, Pa. plev_rad(2:) = pref_edge else ! nlay < pverp. nlay layers are set by radiation - ktopcamm = pverp - nlay + 1 - ktopcami = pverp - nlay + 1 - ktopradm = 1 - ktopradi = 1 - plev_rad = pref_edge(ktopcami:) + ktopcam = pverp - nlay + 1 + ktoprad = 1 + plev_rad = pref_edge(ktopcam:) end if ! Define a pressure coordinate to allow output of data on the radiation grid. @@ -552,9 +532,11 @@ subroutine radiation_init(pbuf2d) call set_wavenumber_bands('sw', kdist_sw%get_nband(), kdist_sw%get_band_lims_wavenumber()) call set_wavenumber_bands('lw', kdist_lw%get_nband(), kdist_lw%get_band_lims_wavenumber()) - call rrtmgp_inputs_init(ktopcamm, ktopradm, ktopcami, ktopradi) ! this sets these values as module data in rrtmgp_inputs + call rrtmgp_inputs_init(ktopcam, ktoprad) + + ! initialize output fields for offline driver + call rad_data_init(pbuf2d) - call rad_data_init(pbuf2d) ! initialize output fields for offline driver call cloud_rad_props_init() if (is_first_step()) then @@ -588,7 +570,8 @@ subroutine radiation_init(pbuf2d) irad_always = irad_always + nstep end if - if (docosp) call cospsimulator_intr_init + if (docosp) call cospsimulator_intr_init() + allocate(cosp_cnt(begchunk:endchunk)) if (is_first_restart_step()) then cosp_cnt(begchunk:endchunk) = cosp_cnt_init @@ -808,7 +791,7 @@ subroutine radiation_define_restart(file) call pio_seterrorhandling(file, PIO_BCAST_ERROR) - ierr = pio_def_var(file, 'nextsw_cday', pio_int, nextsw_cday_desc) + ierr = pio_def_var(file, 'nextsw_cday', pio_double, nextsw_cday_desc) ierr = pio_put_att(file, nextsw_cday_desc, 'long_name', 'future radiation calday for surface models') if (docosp) then ierr = pio_def_var(File, 'cosp_cnt_init', pio_int, cospcnt_desc) @@ -1835,18 +1818,18 @@ subroutine set_sw_diags() ! fns, fcns, rd are on CAM grid (do not have "extra layer" when it is present.) do i = 1, nday - fns(idxday(i),ktopcami:) = fsw%flux_net(i, ktopradi:) - fcns(idxday(i),ktopcami:) = fswc%flux_net(i,ktopradi:) - fsds(idxday(i)) = fsw%flux_dn(i, nlay+1) - rd%fsdsc(idxday(i)) = fswc%flux_dn(i, nlay+1) - rd%fsutoa(idxday(i)) = fsw%flux_up(i, 1) - rd%fsntoa(idxday(i)) = fsw%flux_net(i, 1) ! net sw flux at TOA (*NOT* the same as fsnt) - rd%fsntoac(idxday(i)) = fswc%flux_net(i, 1) ! net sw clearsky flux at TOA (*NOT* the same as fsntc) - rd%solin(idxday(i)) = fswc%flux_dn(i, 1) - rd%flux_sw_up(idxday(i),ktopcami:) = fsw%flux_up(i,ktopradi:) - rd%flux_sw_dn(idxday(i),ktopcami:) = fsw%flux_dn(i,ktopradi:) - rd%flux_sw_clr_up(idxday(i),ktopcami:) = fswc%flux_up(i,ktopradi:) - rd%flux_sw_clr_dn(idxday(i),ktopcami:) = fswc%flux_dn(i,ktopradi:) + fns(idxday(i),ktopcam:) = fsw%flux_net(i, ktoprad:) + fcns(idxday(i),ktopcam:) = fswc%flux_net(i,ktoprad:) + fsds(idxday(i)) = fsw%flux_dn(i, nlay+1) + rd%fsdsc(idxday(i)) = fswc%flux_dn(i, nlay+1) + rd%fsutoa(idxday(i)) = fsw%flux_up(i, 1) + rd%fsntoa(idxday(i)) = fsw%flux_net(i, 1) ! net sw flux at TOA (*NOT* the same as fsnt) + rd%fsntoac(idxday(i)) = fswc%flux_net(i, 1) ! net sw clearsky flux at TOA (*NOT* the same as fsntc) + rd%solin(idxday(i)) = fswc%flux_dn(i, 1) + rd%flux_sw_up(idxday(i),ktopcam:) = fsw%flux_up(i,ktoprad:) + rd%flux_sw_dn(idxday(i),ktopcam:) = fsw%flux_dn(i,ktoprad:) + rd%flux_sw_clr_up(idxday(i),ktopcam:) = fswc%flux_up(i,ktoprad:) + rd%flux_sw_clr_dn(idxday(i),ktopcam:) = fswc%flux_dn(i,ktoprad:) rd%fsdn(idxday(i),:) = fsw%flux_dn(i,:) rd%fsdnc(idxday(i),:) = fswc%flux_dn(i,:) rd%fsup(idxday(i),:) = fsw%flux_up(i,:) @@ -1877,8 +1860,8 @@ subroutine set_sw_diags() su = 0._r8 sd = 0._r8 do i = 1, nday - su(idxday(i),ktopcami:,:) = fsw%bnd_flux_up(i,ktopradi:,:) - sd(idxday(i),ktopcami:,:) = fsw%bnd_flux_dn(i,ktopradi:,:) + su(idxday(i),ktopcam:,:) = fsw%bnd_flux_up(i,ktoprad:,:) + sd(idxday(i),ktopcam:,:) = fsw%bnd_flux_dn(i,ktoprad:,:) end do end if @@ -1923,21 +1906,20 @@ end subroutine set_sw_diags subroutine set_lw_diags() - ! Transform RRTMGP output for CAM - ! Assumes RRTMGP levels are bottom to top (though it does not care need to be consistent). - ! CAM levels are top to bottom. + ! Set CAM LW diagnostics !---------------------------------------------------------------------------- fnl = 0._r8 fcnl = 0._r8 ! RTE-RRTMGP convention for net is (down - up) **CAM assumes (up - down) !! - fnl(:ncol,ktopcami:) = -1._r8 * flw%flux_net( :, ktopradi:) - fcnl(:ncol,ktopcami:) = -1._r8 * flwc%flux_net( :, ktopradi:) - rd%flux_lw_up(:ncol,ktopcami:) = flw%flux_up( :, ktopradi:) - rd%flux_lw_clr_up(:ncol,ktopcami:) = flwc%flux_up(:, ktopradi:) - rd%flux_lw_dn(:ncol,ktopcami:) = flw%flux_dn( :, ktopradi:) - rd%flux_lw_clr_dn(:ncol,ktopcami:) = flwc%flux_dn(:, ktopradi:) + fnl(:ncol,ktopcam:) = -1._r8 * flw%flux_net( :, ktoprad:) + fcnl(:ncol,ktopcam:) = -1._r8 * flwc%flux_net( :, ktoprad:) + + rd%flux_lw_up(:ncol,ktopcam:) = flw%flux_up( :, ktoprad:) + rd%flux_lw_clr_up(:ncol,ktopcam:) = flwc%flux_up(:, ktoprad:) + rd%flux_lw_dn(:ncol,ktopcam:) = flw%flux_dn( :, ktoprad:) + rd%flux_lw_clr_dn(:ncol,ktopcam:) = flwc%flux_dn(:, ktoprad:) call heating_rate('LW', ncol, fnl, qrl) call heating_rate('LW', ncol, fcnl, rd%qrlc) @@ -1951,8 +1933,8 @@ subroutine set_lw_diags() cam_out%flwds(:ncol) = flw%flux_dn(:, nlay+1) rd%fldsc(:ncol) = flwc%flux_dn(:, nlay+1) - rd%flut(:ncol) = flw%flux_up(:, ktopradi) - rd%flutc(:ncol) = flwc%flux_up(:, ktopradi) + rd%flut(:ncol) = flw%flux_up(:, ktoprad) + rd%flutc(:ncol) = flwc%flux_up(:, ktoprad) rd%fldn(:ncol,:) = flw%flux_dn rd%fldnc(:ncol,:) = flwc%flux_dn @@ -1971,8 +1953,8 @@ subroutine set_lw_diags() if (spectralflux) then lu = 0._r8 ld = 0._r8 - lu(:ncol, ktopcami:, :) = flw%bnd_flux_up(:, ktopradi:, :) - ld(:ncol, ktopcami:, :) = flw%bnd_flux_dn(:, ktopradi:, :) + lu(:ncol, ktopcam:, :) = flw%bnd_flux_up(:, ktoprad:, :) + ld(:ncol, ktopcam:, :) = flw%bnd_flux_dn(:, ktoprad:, :) end if end subroutine set_lw_diags diff --git a/src/physics/rrtmgp/rrtmgp_inputs.F90 b/src/physics/rrtmgp/rrtmgp_inputs.F90 index 6823d5aaa0..cceddfc3ac 100644 --- a/src/physics/rrtmgp/rrtmgp_inputs.F90 +++ b/src/physics/rrtmgp/rrtmgp_inputs.F90 @@ -56,11 +56,10 @@ module rrtmgp_inputs real(r8), parameter :: amdc2 = 0.239546_r8 ! Molecular weight of dry air / CFC12 ! Indices for copying data between cam and rrtmgp arrays -! Assume the rrtmgp vertical index goes bottom to top of atm -integer :: ktopcamm ! cam index of top layer -integer :: ktopradm ! rrtmgp index of layer corresponding to ktopcamm -integer :: ktopcami ! cam index of top interface -integer :: ktopradi ! rrtmgp index of interface corresponding to ktopcami +integer :: ktopcam ! Index in CAM arrays of top level (layer or interface) at which + ! RRTMGP is active. +integer :: ktoprad ! Index in RRTMGP arrays of the layer or interface corresponding + ! to CAM's top layer or interface ! wavenumber (cm^-1) boundaries of shortwave bands real(r8) :: sw_low_bounds(nswbands), sw_high_bounds(nswbands) @@ -69,20 +68,16 @@ module rrtmgp_inputs contains !================================================================================================== -subroutine rrtmgp_inputs_init(ktcamm, ktradm, ktcami, ktradi) +subroutine rrtmgp_inputs_init(ktcam, ktrad) ! Note that this routine must be called after the calls to set_wavenumber_bands which set ! the sw/lw band boundaries in the radconstants module. - integer, intent(in) :: ktcamm - integer, intent(in) :: ktradm - integer, intent(in) :: ktcami - integer, intent(in) :: ktradi + integer, intent(in) :: ktcam + integer, intent(in) :: ktrad - ktopcamm = ktcamm - ktopradm = ktradm - ktopcami = ktcami - ktopradi = ktradi + ktopcam = ktcam + ktoprad = ktrad call get_sw_spectral_boundaries(sw_low_bounds, sw_high_bounds, 'cm^-1') @@ -519,7 +514,7 @@ subroutine rrtmgp_set_cloud_lw(state, nlwbands, cldfrac, c_cld_lw_abs, lwkDist, ! will provide zero optical depths there. cloud_lw%tau = 0.0_r8 do i = 1, ngptlw - cloud_lw%tau(:ncol, ktopradm:, i) = taucmcl(i, :ncol, ktopcamm:) + cloud_lw%tau(:ncol, ktoprad:, i) = taucmcl(i, :ncol, ktopcam:) end do errmsg = cloud_lw%validate() if (len_trim(errmsg) > 0) then @@ -546,7 +541,7 @@ subroutine rrtmgp_set_aer_lw(ncol, nlwbands, aer_lw_abs, aer_lw) ! If there is an extra layer in the radiation then this initialization ! will provide zero optical depths there. aer_lw%tau = 0.0_r8 - aer_lw%tau(:ncol, ktopradm:, :) = aer_lw_abs(:ncol, ktopcamm:, :) + aer_lw%tau(:ncol, ktoprad:, :) = aer_lw_abs(:ncol, ktopcam:, :) errmsg = aer_lw%validate() if (len_trim(errmsg) > 0) then call endrun(sub//': ERROR: aer_lw%validate: '//trim(errmsg)) @@ -602,7 +597,7 @@ subroutine rrtmgp_set_cloud_sw( & real(r8), allocatable :: day_cld_tau_w_g(:,:,:) !-------------------------------------------------------------------------------- ngptsw = kdist_sw%get_ngpt() - nver = pver - ktopcamm + 1 ! number of CAM's layers in radiation calculation. + nver = pver - ktopcam + 1 ! number of CAM's layers in radiation calculation. ! Compute the input quantities needed for the 2-stream optical props ! object. Also subset the vertical levels and the daylight columns @@ -621,10 +616,10 @@ subroutine rrtmgp_set_cloud_sw( & day_cld_tau_w_g(nswbands,nday,nver)) ! get daylit arrays on radiation levels, note: expect idxday to be truncated to size nday - day_cld_tau = c_cld_tau( :, idxday(1:nday), ktopcamm:) - day_cld_tau_w = c_cld_tau_w( :, idxday(1:nday), ktopcamm:) - day_cld_tau_w_g = c_cld_tau_w_g(:, idxday(1:nday), ktopcamm:) - cldf = cldfrac(idxday(1:nday), ktopcamm:) ! daylit cloud fraction on radiation levels + day_cld_tau = c_cld_tau( :, idxday(1:nday), ktopcam:) + day_cld_tau_w = c_cld_tau_w( :, idxday(1:nday), ktopcam:) + day_cld_tau_w_g = c_cld_tau_w_g(:, idxday(1:nday), ktopcam:) + cldf = cldfrac(idxday(1:nday), ktopcam:) ! daylit cloud fraction on radiation levels tauc = merge(day_cld_tau, 0.0_r8, day_cld_tau > 0.0_r8) ! start by setting cloud optical depth, clip @ zero asmc = merge(day_cld_tau_w_g / max(day_cld_tau_w, small_val), 0.0_r8, day_cld_tau_w > 0.0_r8) ! set value of asymmetry ssac = merge(max(day_cld_tau_w, small_val) / max(tauc, small_val), 1.0_r8 , tauc > 0.0_r8) @@ -643,14 +638,14 @@ subroutine rrtmgp_set_cloud_sw( & ! If there is an extra layer in the radiation then this initialization ! will provide the optical properties there. - ! These should be shape (ncol, nlay, ngpt); assign levels using ktopradm+k, should + ! These are shape (ncol, nlay, ngpt) cloud_sw%tau(:,:,:) = 0.0_r8 cloud_sw%ssa(:,:,:) = 1.0_r8 cloud_sw%g(:,:,:) = 0.0_r8 do igpt = 1,ngptsw - cloud_sw%g (:, ktopradm:, igpt) = asmcmcl(igpt, ktopcamm:, :) - cloud_sw%ssa(:, ktopradm:, igpt) = ssacmcl(igpt, ktopcamm:, :) - cloud_sw%tau(:, ktopradm:, igpt) = taucmcl(igpt, ktopcamm:, :) + cloud_sw%g (:, ktoprad:, igpt) = asmcmcl(igpt, ktopcam:, :) + cloud_sw%ssa(:, ktoprad:, igpt) = ssacmcl(igpt, ktopcam:, :) + cloud_sw%tau(:, ktoprad:, igpt) = taucmcl(igpt, ktopcam:, :) end do @@ -714,9 +709,11 @@ subroutine rrtmgp_set_aer_sw( & ! aer_sw is on RAD grid, aer_tau* is on CAM grid ... to make sure they align, use ktop* ! aer_sw has dimensions of (nday, nlay, nswbands) - aer_sw%tau(1:nday, ktopradm:, :) = max(aer_tau(day_cols, ktopcamm:, :), 0._r8) - aer_sw%ssa(1:nday, ktopradm:, :) = merge(aer_tau_w(day_cols, ktopcamm:,:)/aer_tau(day_cols, ktopcamm:, :), 1._r8, aer_tau(day_cols, ktopcamm:, :) > 0._r8) - aer_sw%g( 1:nday, ktopradm:, :) = merge(aer_tau_w_g(day_cols, ktopcamm:, :) / aer_tau_w(day_cols, ktopcamm:, :), 0._r8, aer_tau_w(day_cols, ktopcamm:, :) > 1.e-80_r8) + aer_sw%tau(1:nday, ktoprad:, :) = max(aer_tau(day_cols, ktopcam:, :), 0._r8) + aer_sw%ssa(1:nday, ktoprad:, :) = merge( aer_tau_w(day_cols, ktopcam:,:)/aer_tau(day_cols, ktopcam:, :), & + 1._r8, aer_tau(day_cols, ktopcam:, :) > 0._r8) + aer_sw%g( 1:nday, ktoprad:, :) = merge( aer_tau_w_g(day_cols, ktopcam:, :) / aer_tau_w(day_cols, ktopcam:, :), & + 0._r8, aer_tau_w(day_cols, ktopcam:, :) > 1.e-80_r8) ! impose limits on the components: ! aer_sw%tau = max(aer_sw%tau, 0._r) <-- already imposed @@ -734,25 +731,4 @@ end subroutine rrtmgp_set_aer_sw !================================================================================================== -subroutine expand_and_transpose(ops,arr_in,arr_out) - ! based on version in mo_rte_sw - class(ty_gas_optics_rrtmgp), intent(in) :: ops ! spectral information - real(r8), dimension(:), intent(in ) :: arr_in ! (nband) - real(r8), dimension(:), intent(out) :: arr_out ! (igpt) - ! ------------- - integer :: nband, ngpt - integer :: iband, igpt - integer, dimension(2,ops%get_nband()) :: limits - - nband = ops%get_nband() - ngpt = ops%get_ngpt() - limits = ops%get_band_lims_gpoint() - do iband = 1, nband - do igpt = limits(1, iband), limits(2, iband) - arr_out(igpt) = arr_in(iband) - end do - end do - - end subroutine expand_and_transpose - end module rrtmgp_inputs From 9d433323e6ba563f824715e7218e750541bf6353 Mon Sep 17 00:00:00 2001 From: Brian Eaton Date: Wed, 6 Sep 2023 10:45:15 -0400 Subject: [PATCH 135/291] remove unused arg band2gpt --- src/physics/rrtmgp/radiation.F90 | 98 ++++++++++------------------ src/physics/rrtmgp/rrtmgp_inputs.F90 | 35 ++++------ 2 files changed, 45 insertions(+), 88 deletions(-) diff --git a/src/physics/rrtmgp/radiation.F90 b/src/physics/rrtmgp/radiation.F90 index eaac53346e..e8d6119a4a 100644 --- a/src/physics/rrtmgp/radiation.F90 +++ b/src/physics/rrtmgp/radiation.F90 @@ -207,10 +207,6 @@ module radiation type(ty_gas_optics_rrtmgp) :: kdist_lw type(ty_gas_optics_rrtmgp) :: kdist_sw -! data to go from bands to gpoints -integer, allocatable :: band2gpt_sw(:,:) -integer, allocatable :: band2gpt_lw(:,:) - ! Mapping from RRTMG shortwave bands to RRTMGP. Currently needed to continue using ! the SW optics datasets from RRTMG (even thought there is a slight mismatch in the ! band boundaries of the 2 bands that overlap with the LW bands). @@ -510,8 +506,9 @@ subroutine radiation_init(pbuf2d) call endrun(sub//': ERROR: available_gases%init: '//trim(errmsg)) end if - call coefs_init(coefs_lw_file, kdist_lw, available_gases, band2gpt_lw) - call coefs_init(coefs_sw_file, kdist_sw, available_gases, band2gpt_sw) + ! Read RRTMGP coefficients files and initialize kdist objects. + call coefs_init(coefs_lw_file, available_gases, kdist_lw) + call coefs_init(coefs_sw_file, available_gases, kdist_sw) ! check number of sw/lw bands in gas optics files if (kdist_sw%get_nband() /= nswbands) then @@ -1206,28 +1203,12 @@ subroutine radiation_tend( & alb_dif(nswbands,nday) & ) - - call rrtmgp_set_state( & ! Prepares state variables, daylit columns, albedos for RRTMGP - state, & ! input (%t, %pmid, %pint) - cam_in, & ! input (%lwup, %aldir, %asdir, %aldif, %asdif) - ncol, & ! input - nlay, & ! input - nday, & ! input - idxday, & ! input, [would prefer to truncate as 1:ncol] - coszrs, & ! input - kdist_sw, & ! input (from init) - band2gpt_sw, & ! input (from init), gpoints by band - t_sfc, & ! output - emis_sfc, & ! output - t_rad, & ! output - pmid_rad, & ! output - pint_rad, & ! output - t_day, & ! output - pmid_day, & ! output - pint_day, & ! output - coszrs_day, & ! output - alb_dir, & ! output - alb_dif) ! output + ! Prepares state variables, daylit columns, albedos for RRTMGP + call rrtmgp_set_state( & + state, cam_in, ncol, nlay, nday, & + idxday, coszrs, kdist_sw, t_sfc, emis_sfc, & + t_rad, pmid_rad, pint_rad, t_day, pmid_day, & + pint_day, coszrs_day, alb_dir, alb_dif) ! Set TSI used in rrtmgp to the value from CAM's solar forcing file. errmsg = kdist_sw%set_tsi(sol_tsi) @@ -2193,19 +2174,19 @@ end subroutine calc_col_mean !========================================================================================= -subroutine coefs_init(coefs_file, kdist, available_gases, band2gpt) +subroutine coefs_init(coefs_file, available_gases, kdist) ! Read data from coefficients file. Initialize the kdist object. ! available_gases object provides the gas names that CAM provides. ! arguments character(len=*), intent(in) :: coefs_file - class(ty_gas_optics_rrtmgp), intent(out) :: kdist class(ty_gas_concs), intent(in) :: available_gases + class(ty_gas_optics_rrtmgp), intent(out) :: kdist ! local variables type(file_desc_t) :: fh ! pio file handle - character(len=256) :: locfn ! path to actual file used + character(len=256) :: locfn ! path to file on local storage ! File dimensions integer :: & @@ -2214,7 +2195,7 @@ subroutine coefs_init(coefs_file, kdist, available_gases, band2gpt) bnd, & pressure, & temperature, & - absorber_ext, & ! replaces `major_absorber` + absorber_ext, & pressure_interp, & mixing_fraction, & gpt, & @@ -2226,8 +2207,8 @@ subroutine coefs_init(coefs_file, kdist, available_gases, band2gpt) character(32), dimension(:), allocatable :: gas_names integer, dimension(:,:,:), allocatable :: key_species - integer, dimension(:,:), allocatable, intent(out) :: band2gpt ! -> file : 'bnd_limits_gpt' - real(r8), dimension(:,:), allocatable :: band_lims_wavenum ! -> file : 'bnd_limits_wavenumber' + integer, dimension(:,:), allocatable :: band2gpt + real(r8), dimension(:,:), allocatable :: band_lims_wavenum real(r8), dimension(:), allocatable :: press_ref, temp_ref real(r8) :: press_ref_trop, temp_ref_t, temp_ref_p real(r8), dimension(:,:,:), allocatable :: vmr_ref @@ -2662,35 +2643,22 @@ subroutine coefs_init(coefs_file, kdist, available_gases, band2gpt) ! gas_optics%load() returns a string; a non-empty string indicates an error. ! if (allocated(totplnk) .and. allocated(planck_frac)) then - error_msg = kdist%load(available_gases, gas_names, key_species, & - band2gpt, & - band_lims_wavenum, & - press_ref, & - press_ref_trop, & - temp_ref, & - temp_ref_p, & - temp_ref_t, & - vmr_ref, & - kmajor, & - kminor_lower, & - kminor_upper, & - gas_minor, & - identifier_minor, & - minor_gases_lower, & - minor_gases_upper, & - minor_limits_gpt_lower, & - minor_limits_gpt_upper, & - minor_scales_with_density_lower, & - minor_scales_with_density_upper, & - scaling_gas_lower, & - scaling_gas_upper, & - scale_by_complement_lower, & - scale_by_complement_upper, & - kminor_start_lower, & - kminor_start_upper, & - totplnk, planck_frac, & - rayl_lower, rayl_upper, & - optimal_angle_fit) + error_msg = kdist%load( & + available_gases, gas_names, key_species, & + band2gpt, band_lims_wavenum, & + press_ref, press_ref_trop, temp_ref, & + temp_ref_p, temp_ref_t, vmr_ref, & + kmajor, kminor_lower, kminor_upper, & + gas_minor, identifier_minor, & + minor_gases_lower, minor_gases_upper, & + minor_limits_gpt_lower, minor_limits_gpt_upper, & + minor_scales_with_density_lower, & + minor_scales_with_density_upper, & + scaling_gas_lower, scaling_gas_upper, & + scale_by_complement_lower, scale_by_complement_upper, & + kminor_start_lower, kminor_start_upper, & + totplnk, planck_frac, rayl_lower, rayl_upper, & + optimal_angle_fit) else if (allocated(solar_src_quiet)) then error_msg = kdist%load(available_gases, & gas_names, & @@ -2738,7 +2706,7 @@ subroutine coefs_init(coefs_file, kdist, available_gases, band2gpt) deallocate( & gas_names, key_species, & - band_lims_wavenum, & + band2gpt, band_lims_wavenum, & press_ref, temp_ref, vmr_ref, & kmajor, kminor_lower, kminor_upper, & gas_minor, identifier_minor, & @@ -2751,7 +2719,7 @@ subroutine coefs_init(coefs_file, kdist, available_gases, band2gpt) scale_by_complement_lower, & scale_by_complement_upper, & kminor_start_lower, kminor_start_upper) - ! did not deallocate band2gpt because we want to use it later (changed it to intent(out), bpm) + if (allocated(optimal_angle_fit)) deallocate(optimal_angle_fit) if (allocated(totplnk)) deallocate(totplnk) if (allocated(planck_frac)) deallocate(planck_frac) diff --git a/src/physics/rrtmgp/rrtmgp_inputs.F90 b/src/physics/rrtmgp/rrtmgp_inputs.F90 index cceddfc3ac..ca439a61dc 100644 --- a/src/physics/rrtmgp/rrtmgp_inputs.F90 +++ b/src/physics/rrtmgp/rrtmgp_inputs.F90 @@ -86,27 +86,21 @@ end subroutine rrtmgp_inputs_init !================================================================================================== subroutine rrtmgp_set_state( & - pstate, cam_in, ncol, nlay, & - nday, idxday, coszrs, & - kdist_sw, & - band2gpt_sw, & - t_sfc, emis_sfc, t_rad, & - pmid_rad, pint_rad, t_day, pmid_day, pint_day, & - coszrs_day, alb_dir, alb_dif) + pstate, cam_in, ncol, nlay, nday, & + idxday, coszrs, kdist_sw, t_sfc, emis_sfc, & + t_rad, pmid_rad, pint_rad, t_day, pmid_day, & + pint_day, coszrs_day, alb_dir, alb_dif) ! arguments - type(physics_state), target, intent(in) :: pstate - type(cam_in_t), intent(in) :: cam_in - integer, intent(in) :: ncol - integer, intent(in) :: nlay - integer, intent(in) :: nday - integer, intent(in) :: idxday(:) - real(r8), intent(in) :: coszrs(:) - ! real(r8), intent(in) :: eccf ! Earth orbit eccentricity factor - integer, intent(in) :: band2gpt_sw(:,:) !< (2, nswbands) - + type(physics_state), intent(in) :: pstate ! CAM physics state + type(cam_in_t), intent(in) :: cam_in ! CAM import state + integer, intent(in) :: ncol ! # cols in chunk + integer, intent(in) :: nlay ! # layers in rrtmgp grid + integer, intent(in) :: nday ! # daylight columns + integer, intent(in) :: idxday(:) ! chunk indicies of daylight columns + real(r8), intent(in) :: coszrs(:) ! cosine of solar zenith angle class(ty_gas_optics_rrtmgp), intent(in) :: kdist_sw ! spectral information -!!! CHECK pcols vs ncol !!! + real(r8), intent(out) :: t_sfc(ncol) ! surface temperature [K] real(r8), intent(out) :: emis_sfc(nlwbands,ncol) ! emissivity at surface [] real(r8), intent(out) :: t_rad(ncol,nlay) ! layer midpoint temperatures [K] @@ -122,11 +116,6 @@ subroutine rrtmgp_set_state( & ! local variables integer :: k, kk, i, iband - real(r8) :: solar_band_irrad(nswbands) ! specified solar irradiance in each sw band (per radconstants) - - real(r8) :: sfac(nswbands) ! time varying scaling factors due to Solar Spectral - ! Irrad at 1 A.U. per band - character(len=*), parameter :: sub='rrtmgp_set_state' character(len=512) :: errmsg !-------------------------------------------------------------------------------- From dae6502d255057b071e658d3b2d8c25b83cb2344 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Wed, 6 Sep 2023 11:59:01 -0400 Subject: [PATCH 136/291] Remove unused code in configure and build-namelist Signed-off-by: Lizzie Lundgren --- bld/build-namelist | 4 ---- bld/configure | 11 ----------- 2 files changed, 15 deletions(-) diff --git a/bld/build-namelist b/bld/build-namelist index 6952455a16..f01e6def03 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -2051,10 +2051,6 @@ if ($chem =~ /geoschem/) { my @files; # Datasets - #@files = ( 'soil_erod_file', 'flbc_file', - # 'xs_coef_file','xs_short_file', - # 'xs_long_file', 'rsf_file', - # 'exo_coldens_file', 'sulf_file' ); @files = ( 'soil_erod_file', 'flbc_file' ); foreach my $file (@files) { add_default($nl, $file); diff --git a/bld/configure b/bld/configure index 516fb9cdc0..da7330152a 100755 --- a/bld/configure +++ b/bld/configure @@ -80,7 +80,6 @@ OPTIONS -cpl Coupling framework [mct | nuopc]. Default: mct. -dyn Dynamical core option: [eul | fv | se | fv3 | mpas]. Default: fv. -edit_chem_mech Invokes CAMCHEM_EDITOR to allow the user to edit the chemistry mechanism file - -hemco Switch enables the use of the Harmonized Emissions Component. -hgrid Specify horizontal grid. Use nlatxnlon for spectral grids; dlatxdlon for fv grids (dlat and dlon are the grid cell size in degrees for latitude and longitude respectively); nexnp for @@ -264,7 +263,6 @@ GetOptions( "fv3core_libdir=s" => \$opts{'fv3core_libdir'}, "gmake=s" => \$opts{'gmake'}, "h|help" => \$opts{'help'}, - "hemco" => \$opts{'hemco'}, "hgrid=s" => \$opts{'hgrid'}, "ionosphere=s" => \$opts{'ionosphere'}, "lapack_libdir=s" => \$opts{'lapack_libdir'}, @@ -1574,14 +1572,6 @@ else { $nadv = $cfg_ref->get('nadv'); if ($print>=2) { print "Total advected constituents: $nadv$eol"; } -#----------------------------------------------------------------------------------------------- - -# Harmonized Emissions Component (HEMCO) -if (defined $opts{'hemco'}) { - $cfg_ref->set('hemco', $opts{'hemco'}); -} -my $hemco = $cfg_ref->get('hemco'); - #----------------------------------------------------------------------------------------------- # Makefile configuration ####################################################################### #----------------------------------------------------------------------------------------------- @@ -2112,7 +2102,6 @@ sub write_filepath my $waccm_phys = $cfg_ref->get('waccm_phys'); my $waccmx = $cfg_ref->get('waccmx'); my $ionos = $cfg_ref->get('ionosphere'); - my $hemco = $cfg_ref->get('hemco'); my $carma = $cfg_ref->get('carma'); my $rad = $cfg_ref->get('rad'); my $dyn = $cfg_ref->get('dyn'); From e1a6fd2460a6f78dff174379954df78034ed7d6b Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Wed, 6 Sep 2023 12:02:42 -0400 Subject: [PATCH 137/291] Use shr_kind_cl in GEOS-Chem character declarations; remove SPMD cpp defs This commit also removes some unused lines of code. Signed-off-by: Lizzie Lundgren --- src/chemistry/geoschem/chem_mods.F90 | 16 ++--- src/chemistry/geoschem/chemistry.F90 | 60 ++++++++----------- .../geoschem/geoschem_diagnostics_mod.F90 | 20 +++---- .../geoschem/geoschem_emissions_mod.F90 | 10 ++-- .../geoschem/geoschem_history_mod.F90 | 2 - 5 files changed, 50 insertions(+), 58 deletions(-) diff --git a/src/chemistry/geoschem/chem_mods.F90 b/src/chemistry/geoschem/chem_mods.F90 index 40a8828dbb..2d8a500253 100644 --- a/src/chemistry/geoschem/chem_mods.F90 +++ b/src/chemistry/geoschem/chem_mods.F90 @@ -2,25 +2,27 @@ module chem_mods !-------------------------------------------------------------- ! ... Basic chemistry parameters and arrays !-------------------------------------------------------------- - use shr_kind_mod, only : r8 => shr_kind_r8 + use shr_kind_mod, only : r8 => shr_kind_r8, shr_kind_cl use constituents, only : pcnst implicit none save INTEGER, PARAMETER :: nTracersMax = 267 ! Must be equal to chem_nadv INTEGER :: nTracers - CHARACTER(LEN=255) :: tracerNames(nTracersMax) - CHARACTER(LEN=255) :: tracerLongNames(nTracersMax) REAL(r8) :: ref_MMR(pcnst) + CHARACTER(LEN=shr_kind_cl) :: tracerNames(nTracersMax) + CHARACTER(LEN=shr_kind_cl) :: tracerLongNames(nTracersMax) + ! Index of first constituent INTEGER :: iFirstCnst ! Short-lived species (i.e. not advected) INTEGER, PARAMETER :: nSlsMax = 500 ! UNadvected species only - INTEGER :: nSls - CHARACTER(LEN=255) :: slsNames(nSlsMax) - CHARACTER(LEN=255) :: slsLongnames(nSlsMax) + INTEGER :: nSls + + CHARACTER(LEN=shr_kind_cl) :: slsNames(nSlsMax) + CHARACTER(LEN=shr_kind_cl) :: slsLongnames(nSlsMax) ! Mapping between constituents and GEOS-Chem tracers INTEGER :: map2GC(pcnst) @@ -100,7 +102,7 @@ module chem_mods logical :: frc_from_dataset(max(1,extcnt)) logical :: is_vector logical :: is_scalar - character(len=255), allocatable :: slvd_lst(:) + character(len=shr_kind_cl), allocatable :: slvd_lst(:) ! Mapping between chemical species and GEOS-Chem species/other tracers INTEGER :: map2chm(gas_pcnst) diff --git a/src/chemistry/geoschem/chemistry.F90 b/src/chemistry/geoschem/chemistry.F90 index 59c14be74b..678a64f21d 100644 --- a/src/chemistry/geoschem/chemistry.F90 +++ b/src/chemistry/geoschem/chemistry.F90 @@ -98,7 +98,7 @@ module chemistry CHARACTER(LEN=500) :: speciesDB = 'species_database.yml' ! Location of chemistry input - CHARACTER(LEN=256) :: gc_cheminputs + CHARACTER(LEN=shr_kind_cl) :: gc_cheminputs ! Debugging LOGICAL :: debug = .TRUE. @@ -167,8 +167,8 @@ module chemistry CHARACTER(len=shr_kind_cl) :: h2orates = ' ' ! pathname for greenhouse gas (lyman-alpha H2O loss) ! Strings - CHARACTER(LEN=255) :: ThisLoc - CHARACTER(LEN=255) :: ErrMsg + CHARACTER(LEN=shr_kind_cl) :: ThisLoc + CHARACTER(LEN=shr_kind_cl) :: ErrMsg ! For dry deposition character(len=shr_kind_cl) :: depvel_lnd_file = 'depvel_lnd_file' @@ -874,7 +874,6 @@ subroutine chem_readnl(nlfile) ! Broadcast to all processors !================================================================== -#if defined( SPMD ) CALL MPIBCAST ( nTracers, 1, MPIINT, 0, MPICOM ) CALL MPIBCAST ( tracerNames, LEN(tracerNames(1))*nTracersMax, MPICHAR, 0, MPICOM ) CALL MPIBCAST ( nSls, 1, MPIINT, 0, MPICOM ) @@ -885,7 +884,6 @@ subroutine chem_readnl(nlfile) CALL MPIBCAST (ghg_chem, 1, MPILOG, 0, MPICOM) CALL MPIBCAST (bndtvg, LEN(bndtvg), MPICHAR, 0, MPICOM) CALL MPIBCAST (h2orates, LEN(h2orates), MPICHAR, 0, MPICOM) -#endif IF ( nSls .NE. nSlvd ) THEN write(iulog,'(a,i4)') 'nSlvd in geoschem/chem_mods.F90 does not match # non-advected KPP species. Set nSlvd to ', nSls @@ -1033,8 +1031,8 @@ subroutine chem_init(phys_state, pbuf2d) LOGICAL :: Found ! Strings - CHARACTER(LEN=255) :: historyConfigFile - CHARACTER(LEN=255) :: SpcName + CHARACTER(LEN=shr_kind_cl) :: historyConfigFile + CHARACTER(LEN=shr_kind_cl) :: SpcName ! Objects TYPE(Species), POINTER :: SpcInfo @@ -1274,9 +1272,7 @@ subroutine chem_init(phys_state, pbuf2d) ! Copy the data to a temporary array linozData = REAL(Input_Opt%LINOZ_TPARM, r8) ENDIF -#if defined( SPMD ) CALL MPIBCAST( linozData, nLinoz, MPIR8, 0, MPICOM ) -#endif IF ( .NOT. MasterProc ) THEN Input_Opt%LINOZ_TPARM = REAL(linozData,fp) ENDIF @@ -1810,10 +1806,8 @@ subroutine gc_readnl(nlfile) CALL freeunit(unitn) ENDIF -#ifdef SPMD ! Broadcast namelist variables CALL MPIBCAST(gc_cheminputs, LEN(gc_cheminputs), MPICHAR, 0, MPICOM) -#endif end subroutine !EOC @@ -1995,10 +1989,11 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) REAL(r8) :: eflx(pcols,pver,pcnst) ! 3-D emissions in kg/m2/s ! For GEOS-Chem diagnostics - REAL(r8) :: mmr_tend(state%NCOL,PVER,gas_pcnst) - REAL(r8) :: wk_out(state%NCOL) - LOGICAL :: Found - CHARACTER(LEN=255) :: tagName + REAL(r8) :: mmr_tend(state%NCOL,PVER,gas_pcnst) + REAL(r8) :: wk_out(state%NCOL) + LOGICAL :: Found + + CHARACTER(LEN=shr_kind_cl) :: tagName REAL(r8), PARAMETER :: zlnd = 0.01_r8 ! Roughness length for soil [m] REAL(r8), PARAMETER :: zslnd = 0.0024_r8 ! Roughness length for snow [m] @@ -2030,8 +2025,9 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) ! Calculating SZA REAL(r8) :: Calday - CHARACTER(LEN=255) :: SpcName - CHARACTER(LEN=255) :: Prefix, FieldName + CHARACTER(LEN=shr_kind_cl) :: SpcName + CHARACTER(LEN=shr_kind_cl) :: Prefix, FieldName + LOGICAL :: FND INTEGER :: SpcId TYPE(Species), POINTER :: SpcInfo @@ -4389,9 +4385,9 @@ end subroutine chem_final !=============================================================================== subroutine chem_init_restart(File) - use tracer_cnst, only: init_tracer_cnst_restart - use tracer_srcs, only: init_tracer_srcs_restart - use pio, only : file_desc_t + use tracer_cnst, only : init_tracer_cnst_restart + use tracer_srcs, only : init_tracer_srcs_restart + use pio, only : file_desc_t IMPLICIT NONE @@ -4411,43 +4407,39 @@ end subroutine chem_init_restart !=============================================================================== subroutine chem_write_restart( File ) - use tracer_cnst, only: write_tracer_cnst_restart - use tracer_srcs, only: write_tracer_srcs_restart - !use linoz_data, only: write_linoz_data_restart - use pio, only : file_desc_t + use tracer_cnst, only : write_tracer_cnst_restart + use tracer_srcs, only : write_tracer_srcs_restart + use pio, only : file_desc_t IMPLICIT NONE TYPE(file_desc_t) :: File WRITE(iulog,'(a)') 'chem_write_restart: writing restarts for tracer sources and offline fields' - ! + ! data for offline tracers - ! call write_tracer_cnst_restart(File) call write_tracer_srcs_restart(File) - !call write_linoz_data_restart(File) + end subroutine chem_write_restart !=============================================================================== subroutine chem_read_restart( File ) - use tracer_cnst, only: read_tracer_cnst_restart - use tracer_srcs, only: read_tracer_srcs_restart - !use linoz_data, only: read_linoz_data_restart - use pio, only : file_desc_t + use tracer_cnst, only : read_tracer_cnst_restart + use tracer_srcs, only : read_tracer_srcs_restart + use pio, only : file_desc_t IMPLICIT NONE TYPE(file_desc_t) :: File WRITE(iulog,'(a)') 'GCCALL CHEM_READ_RESTART' - ! + ! data for offline tracers - ! call read_tracer_cnst_restart(File) call read_tracer_srcs_restart(File) - !call read_linoz_data_restart(File) + end subroutine chem_read_restart !================================================================================ diff --git a/src/chemistry/geoschem/geoschem_diagnostics_mod.F90 b/src/chemistry/geoschem/geoschem_diagnostics_mod.F90 index 1b729121f1..f40ca20d92 100644 --- a/src/chemistry/geoschem/geoschem_diagnostics_mod.F90 +++ b/src/chemistry/geoschem/geoschem_diagnostics_mod.F90 @@ -15,7 +15,7 @@ MODULE GeosChem_Diagnostics_Mod ! ! !USES: ! - USE SHR_KIND_MOD, ONLY : r8 => shr_kind_r8 + USE SHR_KIND_MOD, ONLY : r8 => shr_kind_r8, shr_kind_cl USE SHR_CONST_MOD, ONLY : pi => shr_const_pi USE CAM_HISTORY, ONLY : fieldname_len USE CONSTITUENTS, ONLY : pcnst @@ -208,11 +208,11 @@ SUBROUTINE GC_Diagnostics_Init( Input_Opt, State_Chm, State_Met ) ! liquid budgets. ! Strings - CHARACTER(LEN=255) :: SpcName - CHARACTER(LEN=255) :: tagName - CHARACTER(LEN=255) :: ThisLoc - CHARACTER(LEN=255) :: ErrMsg - CHARACTER(LEN=2) :: unit_basename ! Units 'kg' or '1' + CHARACTER(LEN=shr_kind_cl) :: SpcName + CHARACTER(LEN=shr_kind_cl) :: tagName + CHARACTER(LEN=shr_kind_cl) :: ThisLoc + CHARACTER(LEN=shr_kind_cl) :: ErrMsg + CHARACTER(LEN=2) :: unit_basename ! Units 'kg' or '1' ! Objects TYPE(Species), POINTER :: SpcInfo @@ -921,10 +921,10 @@ SUBROUTINE GC_Diagnostics_Calc( Input_Opt, State_Chm, State_Diag, & ! on level edges (T/F) ! Strings - CHARACTER(LEN=255) :: ThisLoc - CHARACTER(LEN=255) :: ErrMsg - CHARACTER(LEN=255) :: SpcName - CHARACTER(LEN=255) :: tagName + CHARACTER(LEN=shr_kind_cl) :: ThisLoc + CHARACTER(LEN=shr_kind_cl) :: ErrMsg + CHARACTER(LEN=shr_kind_cl) :: SpcName + CHARACTER(LEN=shr_kind_cl) :: tagName ! Real REAL(r8) :: wgt diff --git a/src/chemistry/geoschem/geoschem_emissions_mod.F90 b/src/chemistry/geoschem/geoschem_emissions_mod.F90 index 99bc9eff7f..37142e4d5b 100644 --- a/src/chemistry/geoschem/geoschem_emissions_mod.F90 +++ b/src/chemistry/geoschem/geoschem_emissions_mod.F90 @@ -15,7 +15,7 @@ MODULE GeosChem_Emissions_Mod ! ! !USES: ! - USE SHR_KIND_MOD, ONLY : r8 => shr_kind_r8 + USE SHR_KIND_MOD, ONLY : r8 => shr_kind_r8, shr_kind_cl USE SPMD_UTILS, ONLY : MasterProc USE CAM_ABORTUTILS, ONLY : endrun USE CHEM_MODS, ONLY : iFirstCnst @@ -105,8 +105,8 @@ SUBROUTINE GC_Emissions_Init( ) LOGICAL :: history_cesm_forcing ! Strings - CHARACTER(LEN=255) :: SpcName - CHARACTER(LEN=255) :: Description + CHARACTER(LEN=shr_kind_cl) :: SpcName + CHARACTER(LEN=shr_kind_cl) :: Description ! Real REAL(r8) :: MW @@ -339,8 +339,8 @@ SUBROUTINE GC_Emissions_Calc( state, hco_pbuf2d, State_Met, cam_in, eflx, iStep REAL(r8), PARAMETER :: m2km = 1.e-3_r8 ! Strings - CHARACTER(LEN=255) :: SpcName - CHARACTER(LEN=255) :: fldname_ns ! field name HCO_* + CHARACTER(LEN=shr_kind_cl) :: SpcName + CHARACTER(LEN=shr_kind_cl) :: fldname_ns ! field name HCO_* !================================================================= ! GC_Emissions_Calc begins here! diff --git a/src/chemistry/geoschem/geoschem_history_mod.F90 b/src/chemistry/geoschem/geoschem_history_mod.F90 index fb722c44a5..40da3f37dc 100644 --- a/src/chemistry/geoschem/geoschem_history_mod.F90 +++ b/src/chemistry/geoschem/geoschem_history_mod.F90 @@ -27,8 +27,6 @@ MODULE GeosChem_History_Mod USE ErrCode_Mod USE Precision_Mod - USE cam_abortutils, only : endrun - IMPLICIT NONE PRIVATE ! From 0d2ca48e7927fedc61ca6c0c2c4650db4165ae91 Mon Sep 17 00:00:00 2001 From: Brian Eaton Date: Wed, 6 Sep 2023 12:47:14 -0400 Subject: [PATCH 138/291] refactor set_wavenumber_bands --- src/physics/rrtmgp/radconstants.F90 | 119 ++++++++++++++++++---------- src/physics/rrtmgp/radiation.F90 | 31 +++----- 2 files changed, 88 insertions(+), 62 deletions(-) diff --git a/src/physics/rrtmgp/radconstants.F90 b/src/physics/rrtmgp/radconstants.F90 index 175e8e65b4..aa90f2050b 100644 --- a/src/physics/rrtmgp/radconstants.F90 +++ b/src/physics/rrtmgp/radconstants.F90 @@ -3,8 +3,9 @@ module radconstants ! This module contains constants that are specific to the radiative transfer ! code used in the RRTMGP model. -use shr_kind_mod, only: r8 => shr_kind_r8 -use cam_abortutils, only: endrun +use shr_kind_mod, only: r8 => shr_kind_r8 +use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp +use cam_abortutils, only: endrun implicit none private @@ -18,10 +19,12 @@ module radconstants integer, parameter, public :: nlwbands = 16 ! Band limits (set from data in RRTMGP coefficient datasets) -real(r8), allocatable, target :: wavenumber_low_shortwave(:) -real(r8), allocatable, target :: wavenumber_high_shortwave(:) -real(r8), allocatable, target :: wavenumber_low_longwave(:) -real(r8), allocatable, target :: wavenumber_high_longwave(:) +real(r8), target :: wavenumber_low_shortwave(nswbands) +real(r8), target :: wavenumber_high_shortwave(nswbands) +real(r8), target :: wavenumber_low_longwave(nlwbands) +real(r8), target :: wavenumber_high_longwave(nlwbands) + +logical :: wavenumber_boundaries_set = .false. ! These are indices to specific bands for diagnostic output and COSP input. integer, public, protected :: idx_sw_diag = -1 ! band contains 500-nm wave @@ -50,46 +53,68 @@ module radconstants get_band_index_by_value, & rad_gas_index -!=============================================================================== +!========================================================================================= contains -!=============================================================================== +!========================================================================================= -subroutine set_wavenumber_bands(swlw, nbands, values) +subroutine set_wavenumber_bands(kdist_sw, kdist_lw) - ! Set the low and high limits of the wavenumber grid for sw or lw. - ! Values comes from RRTMGP coefficients datasets. - ! Also set band indices for bands containing specific wavelengths. + ! Set the low and high limits of the wavenumber grid for sw and lw. + ! Values comes from RRTMGP coefficients datasets, and are stored in the + ! kdist objects. Also set band indices for bands containing specific wavelengths. - character(*), intent(in) :: swlw ! which bands to set ['sw', 'lw'] - integer, intent(in) :: nbands - real(r8), intent(in) :: values(2,nbands) ! cm-1 + ! Arguments + type(ty_gas_optics_rrtmgp), intent(in) :: kdist_sw + type(ty_gas_optics_rrtmgp), intent(in) :: kdist_lw - select case(swlw) - case ('sw') - allocate(wavenumber_low_shortwave(nbands)) - allocate(wavenumber_high_shortwave(nbands)) - wavenumber_low_shortwave = values(1,:) - wavenumber_high_shortwave = values(2,:) + ! Local variables + real(r8), allocatable :: values(:,:) - idx_sw_diag = get_band_index_by_value('sw', 500.0_r8, 'nm') - idx_nir_diag = get_band_index_by_value('sw', 1000.0_r8, 'nm') - idx_uv_diag = get_band_index_by_value('sw', 400._r8, 'nm') - idx_sw_cloudsim = get_band_index_by_value('sw', 0.67_r8, 'micron') + character(len=128) :: errmsg + character(len=*), parameter :: sub = 'set_wavenumber_bands' + !---------------------------------------------------------------------------- - case ('lw') - allocate(wavenumber_low_longwave(nbands)) - allocate(wavenumber_high_longwave(nbands)) - wavenumber_low_longwave = values(1,:) - wavenumber_high_longwave = values(2,:) + ! Check that number of sw/lw bands in gas optics files matches the parameters. + if (kdist_sw%get_nband() /= nswbands) then + write(errmsg,'(a,i4,a,i4)') 'number of sw bands in file, ', kdist_sw%get_nband(), & + ", doesn't match parameter nswbands= ", nswbands + call endrun(sub//': ERROR: '//trim(errmsg)) + end if + if (kdist_lw%get_nband() /= nlwbands) then + write(errmsg,'(a,i4,a,i4)') 'number of lw bands in file, ', kdist_lw%get_nband(), & + ", doesn't match parameter nlwbands= ", nlwbands + call endrun(sub//': ERROR: '//trim(errmsg)) + end if - idx_lw_diag = get_band_index_by_value('lw', 1000.0_r8, 'cm^-1') - idx_lw_cloudsim = get_band_index_by_value('lw', 10.5_r8, 'micron') + ! SW band bounds in cm^-1 + allocate( values(2,nswbands) ) + values = kdist_sw%get_band_lims_wavenumber() + wavenumber_low_shortwave = values(1,:) + wavenumber_high_shortwave = values(2,:) - end select + ! Indices into specific bands + idx_sw_diag = get_band_index_by_value('sw', 500.0_r8, 'nm') + idx_nir_diag = get_band_index_by_value('sw', 1000.0_r8, 'nm') + idx_uv_diag = get_band_index_by_value('sw', 400._r8, 'nm') + idx_sw_cloudsim = get_band_index_by_value('sw', 0.67_r8, 'micron') + + deallocate(values) + + ! LW band bounds in cm^-1 + allocate( values(2,nlwbands) ) + values = kdist_lw%get_band_lims_wavenumber() + wavenumber_low_longwave = values(1,:) + wavenumber_high_longwave = values(2,:) + + ! Indices into specific bands + idx_lw_diag = get_band_index_by_value('lw', 1000.0_r8, 'cm^-1') + idx_lw_cloudsim = get_band_index_by_value('lw', 10.5_r8, 'micron') + + wavenumber_boundaries_set = .true. end subroutine set_wavenumber_bands -!------------------------------------------------------------------------------ +!========================================================================================= subroutine get_sw_spectral_boundaries(low_boundaries, high_boundaries, units) @@ -98,6 +123,13 @@ subroutine get_sw_spectral_boundaries(low_boundaries, high_boundaries, units) real(r8), intent(out) :: low_boundaries(nswbands), high_boundaries(nswbands) character(*), intent(in) :: units ! requested units + character(len=*), parameter :: sub = 'get_sw_spectral_boundaries' + !---------------------------------------------------------------------------- + + if (.not. wavenumber_boundaries_set) then + call endrun(sub//': ERROR, wavenumber boundaries not set. ') + end if + select case (units) case ('inv_cm','cm^-1','cm-1') low_boundaries = wavenumber_low_shortwave @@ -115,12 +147,12 @@ subroutine get_sw_spectral_boundaries(low_boundaries, high_boundaries, units) low_boundaries = 1._r8/wavenumber_high_shortwave high_boundaries = 1._r8/wavenumber_low_shortwave case default - call endrun('rad_constants.F90: requested spectral units not recognized: '//units) + call endrun(sub//': ERROR, requested spectral units not recognized: '//units) end select end subroutine get_sw_spectral_boundaries -!------------------------------------------------------------------------------ +!========================================================================================= subroutine get_lw_spectral_boundaries(low_boundaries, high_boundaries, units) @@ -129,6 +161,13 @@ subroutine get_lw_spectral_boundaries(low_boundaries, high_boundaries, units) real(r8), intent(out) :: low_boundaries(nlwbands), high_boundaries(nlwbands) character(*), intent(in) :: units ! requested units + character(len=*), parameter :: sub = 'get_lw_spectral_boundaries' + !---------------------------------------------------------------------------- + + if (.not. wavenumber_boundaries_set) then + call endrun(sub//': ERROR, wavenumber boundaries not set. ') + end if + select case (units) case ('inv_cm','cm^-1','cm-1') low_boundaries = wavenumber_low_longwave @@ -146,12 +185,12 @@ subroutine get_lw_spectral_boundaries(low_boundaries, high_boundaries, units) low_boundaries = 1._r8/wavenumber_high_longwave high_boundaries = 1._r8/wavenumber_low_longwave case default - call endrun('get_lw_spectral_boundaries: spectral units not recognized: '//units) + call endrun(sub//': ERROR, requested spectral units not recognized: '//units) end select end subroutine get_lw_spectral_boundaries -!------------------------------------------------------------------------------ +!========================================================================================= integer function rad_gas_index(gasname) @@ -170,7 +209,7 @@ integer function rad_gas_index(gasname) call endrun ("rad_gas_index: can not find gas with name "//gasname) end function rad_gas_index -!------------------------------------------------------------------------------ +!========================================================================================= function get_band_index_by_value(swlw, targetvalue, units) result(ans) @@ -231,6 +270,6 @@ function get_band_index_by_value(swlw, targetvalue, units) result(ans) end function get_band_index_by_value -!------------------------------------------------------------------------------ +!========================================================================================= end module radconstants diff --git a/src/physics/rrtmgp/radiation.F90 b/src/physics/rrtmgp/radiation.F90 index e8d6119a4a..51da2ddbb6 100644 --- a/src/physics/rrtmgp/radiation.F90 +++ b/src/physics/rrtmgp/radiation.F90 @@ -204,8 +204,8 @@ module radiation real(r8), allocatable, target :: plev_rad(:) ! Gas optics objects contain the data read from the coefficients files. -type(ty_gas_optics_rrtmgp) :: kdist_lw type(ty_gas_optics_rrtmgp) :: kdist_sw +type(ty_gas_optics_rrtmgp) :: kdist_lw ! Mapping from RRTMG shortwave bands to RRTMGP. Currently needed to continue using ! the SW optics datasets from RRTMG (even thought there is a slight mismatch in the @@ -305,12 +305,14 @@ subroutine radiation_readnl(nlfile) if (masterproc) then write(iulog,*) 'RRTMGP radiation scheme parameters:' - write(iulog,10) trim(coefs_lw_file), trim(coefs_sw_file), iradsw, iradlw, & - irad_always, use_rad_dt_cosz, spectralflux, graupel_in_rad + write(iulog,10) trim(coefs_lw_file), trim(coefs_sw_file), nlwbands, nswbands, & + iradsw, iradlw, irad_always, use_rad_dt_cosz, spectralflux, graupel_in_rad end if 10 format(' LW coefficents file: ', a/, & ' SW coefficents file: ', a/, & + ' Number of LW bands: ',i5/, & + ' Number of SW bands: ',i5/, & ' Frequency (timesteps) of Shortwave Radiation calc: ',i5/, & ' Frequency (timesteps) of Longwave Radiation calc: ',i5/, & ' SW/LW calc done every timestep for first N steps. N=',i5/, & @@ -507,28 +509,13 @@ subroutine radiation_init(pbuf2d) end if ! Read RRTMGP coefficients files and initialize kdist objects. - call coefs_init(coefs_lw_file, available_gases, kdist_lw) call coefs_init(coefs_sw_file, available_gases, kdist_sw) + call coefs_init(coefs_lw_file, available_gases, kdist_lw) - ! check number of sw/lw bands in gas optics files - if (kdist_sw%get_nband() /= nswbands) then - write(errmsg,'(a,i4,a,i4)') 'number of sw bands in file, ', kdist_sw%get_nband(), & - ", doesn't match parameter nswbands= ", nswbands - call endrun(sub//': ERROR: '//trim(errmsg)) - end if - if (kdist_lw%get_nband() /= nlwbands) then - write(errmsg,'(a,i4,a,i4)') 'number of lw bands in file, ', kdist_lw%get_nband(), & - ", doesn't match parameter nlwbands= ", nlwbands - call endrun(sub//': ERROR: '//trim(errmsg)) - end if - if (masterproc) then - write(iulog, *) sub//': NUMBER SW BANDS: ', nswbands,' NUMBER LW BANDS: ', nlwbands - end if - - ! set the sw/lw band limits in radconstants - call set_wavenumber_bands('sw', kdist_sw%get_nband(), kdist_sw%get_band_lims_wavenumber()) - call set_wavenumber_bands('lw', kdist_lw%get_nband(), kdist_lw%get_band_lims_wavenumber()) + ! Set the sw/lw band boundaries in radconstants + call set_wavenumber_bands(kdist_sw, kdist_lw) + ! The spectral band boundaries need to be set before this init is called. call rrtmgp_inputs_init(ktopcam, ktoprad) ! initialize output fields for offline driver From 2b3abb82d81b1aa0ff5fedf50193a1a4c4c6456c Mon Sep 17 00:00:00 2001 From: Brian Eaton Date: Wed, 6 Sep 2023 16:56:13 -0400 Subject: [PATCH 139/291] refactor rrtmgp_set_state --- src/physics/rrtmgp/radconstants.F90 | 6 +- src/physics/rrtmgp/radiation.F90 | 48 +++++--------- src/physics/rrtmgp/rrtmgp_inputs.F90 | 95 +++++++++++++++------------- 3 files changed, 71 insertions(+), 78 deletions(-) diff --git a/src/physics/rrtmgp/radconstants.F90 b/src/physics/rrtmgp/radconstants.F90 index aa90f2050b..a04cbef23d 100644 --- a/src/physics/rrtmgp/radconstants.F90 +++ b/src/physics/rrtmgp/radconstants.F90 @@ -60,8 +60,10 @@ module radconstants subroutine set_wavenumber_bands(kdist_sw, kdist_lw) ! Set the low and high limits of the wavenumber grid for sw and lw. - ! Values comes from RRTMGP coefficients datasets, and are stored in the - ! kdist objects. Also set band indices for bands containing specific wavelengths. + ! Values come from RRTMGP coefficients datasets, and are stored in the + ! kdist objects. + ! + ! Set band indices for bands containing specific wavelengths. ! Arguments type(ty_gas_optics_rrtmgp), intent(in) :: kdist_sw diff --git a/src/physics/rrtmgp/radiation.F90 b/src/physics/rrtmgp/radiation.F90 index 51da2ddbb6..bb1bb1df32 100644 --- a/src/physics/rrtmgp/radiation.F90 +++ b/src/physics/rrtmgp/radiation.F90 @@ -11,21 +11,27 @@ module radiation use ppgrid, only: pcols, pver, pverp, begchunk, endchunk use ref_pres, only: pref_edge use physics_types, only: physics_state, physics_ptend -use physics_buffer, only: physics_buffer_desc, pbuf_get_field, pbuf_old_tim_idx +use phys_control, only: phys_getopts +use physics_buffer, only: physics_buffer_desc, pbuf_add_field, dtype_r8, pbuf_get_index, & + pbuf_set_field, pbuf_get_field, pbuf_old_tim_idx use camsrfexch, only: cam_out_t, cam_in_t use physconst, only: cappa, cpair, gravit use solar_irrad_data, only: sol_tsi -use time_manager, only: get_nstep, is_first_restart_step, & +use time_manager, only: get_nstep, is_first_step, is_first_restart_step, & get_curr_calday, get_step_size use rad_constituents, only: N_DIAG, rad_cnst_get_call_list, & rad_cnst_get_gas, rad_cnst_out, oldcldoptics, & liqcldoptics, icecldoptics +use rrtmgp_inputs, only: rrtmgp_inputs_init + use radconstants, only: nswbands, nlwbands, idx_sw_diag, idx_nir_diag, idx_uv_diag, & idx_lw_diag, idx_sw_cloudsim, idx_lw_cloudsim, & - nradgas, gasnamelength, gaslist + nradgas, gasnamelength, gaslist, set_wavenumber_bands + +use cloud_rad_props, only: cloud_rad_props_init use cospsimulator_intr, only: docosp, cospsimulator_intr_init, & cospsimulator_intr_run, cosp_nradsteps @@ -35,6 +41,8 @@ module radiation use cam_history, only: addfld, add_default, horiz_only, outfld, hist_fld_active use cam_history_support, only: fillvalue, add_vert_coord +use radiation_data, only: rad_data_register, rad_data_init + use ioFileMod, only: getfil use cam_pio_utils, only: cam_pio_openfile use pio, only: file_desc_t, var_desc_t, & @@ -229,7 +237,6 @@ subroutine radiation_readnl(nlfile) ! Read radiation_nl namelist group. use namelist_utils, only: find_group_name - use units, only: getunit, freeunit use spmd_utils, only: mpicom, mstrid=>masterprocid, mpi_integer, mpi_logical, & mpi_character @@ -250,8 +257,7 @@ subroutine radiation_readnl(nlfile) !----------------------------------------------------------------------------- if (masterproc) then - unitn = getunit() - open( unitn, file=trim(nlfile), status='old' ) + open( newunit=unitn, file=trim(nlfile), status='old' ) call find_group_name(unitn, 'radiation_nl', status=ierr) if (ierr == 0) then read(unitn, radiation_nl, iostat=ierr) @@ -260,7 +266,6 @@ subroutine radiation_readnl(nlfile) end if end if close(unitn) - call freeunit(unitn) end if ! Broadcast namelist variables @@ -326,9 +331,6 @@ end subroutine radiation_readnl subroutine radiation_register - use physics_buffer, only: pbuf_add_field, dtype_r8 - use radiation_data, only: rad_data_register - ! Register radiation fields in the physics buffer call pbuf_add_field('QRS' , 'global',dtype_r8,(/pcols,pver/), qrs_idx) ! shortwave radiative heating rate @@ -438,14 +440,6 @@ subroutine radiation_init(pbuf2d) ! Initialize the radiation and cloud optics. ! Add fields to the history buffer. - use physics_buffer, only: pbuf_get_index, pbuf_set_field - use phys_control, only: phys_getopts - use radiation_data, only: rad_data_init - use cloud_rad_props, only: cloud_rad_props_init - use rrtmgp_inputs, only: rrtmgp_inputs_init - use time_manager, only: is_first_step - use radconstants, only: set_wavenumber_bands - ! arguments type(physics_buffer_desc), pointer :: pbuf2d(:,:) @@ -463,7 +457,7 @@ subroutine radiation_init(pbuf2d) logical :: history_budget ! output tendencies and state variables for CAM4 ! temperature, water vapor, cloud ice and cloud ! liquid budgets. - integer :: history_budget_histfile_num ! output history file number for budget fields + integer :: history_budget_histfile_num ! history file number for budget fields integer :: ierr integer :: dtime @@ -1177,18 +1171,10 @@ subroutine radiation_tend( & if (dosw .or. dolw) then allocate( & - t_sfc(ncol), & - emis_sfc(nlwbands,ncol), & - t_rad(ncol,nlay), & - pmid_rad(ncol,nlay), & - pint_rad(ncol,nlay+1), & - t_day(nday,nlay), & - pmid_day(nday,nlay), & - pint_day(nday,nlay+1), & - coszrs_day(nday), & - alb_dir(nswbands,nday), & - alb_dif(nswbands,nday) & - ) + t_sfc(ncol), emis_sfc(nlwbands,ncol), & + t_rad(ncol,nlay), pmid_rad(ncol,nlay), pint_rad(ncol,nlay+1), & + t_day(nday,nlay), pmid_day(nday,nlay), pint_day(nday,nlay+1), & + coszrs_day(nday), alb_dir(nswbands,nday), alb_dif(nswbands,nday) ) ! Prepares state variables, daylit columns, albedos for RRTMGP call rrtmgp_set_state( & diff --git a/src/physics/rrtmgp/rrtmgp_inputs.F90 b/src/physics/rrtmgp/rrtmgp_inputs.F90 index ca439a61dc..1a1d3da55d 100644 --- a/src/physics/rrtmgp/rrtmgp_inputs.F90 +++ b/src/physics/rrtmgp/rrtmgp_inputs.F90 @@ -10,7 +10,7 @@ module rrtmgp_inputs use shr_kind_mod, only: r8=>shr_kind_r8 use ppgrid, only: pcols, pver, pverp -use physconst, only: stebol +use physconst, only: stebol, pi use physics_types, only: physics_state use physics_buffer, only: physics_buffer_desc @@ -83,16 +83,16 @@ subroutine rrtmgp_inputs_init(ktcam, ktrad) end subroutine rrtmgp_inputs_init -!================================================================================================== +!========================================================================================= subroutine rrtmgp_set_state( & - pstate, cam_in, ncol, nlay, nday, & + state, cam_in, ncol, nlay, nday, & idxday, coszrs, kdist_sw, t_sfc, emis_sfc, & t_rad, pmid_rad, pint_rad, t_day, pmid_day, & pint_day, coszrs_day, alb_dir, alb_dif) ! arguments - type(physics_state), intent(in) :: pstate ! CAM physics state + type(physics_state), intent(in) :: state ! CAM physics state type(cam_in_t), intent(in) :: cam_in ! CAM import state integer, intent(in) :: ncol ! # cols in chunk integer, intent(in) :: nlay ! # layers in rrtmgp grid @@ -116,6 +116,8 @@ subroutine rrtmgp_set_state( & ! local variables integer :: k, kk, i, iband + real(r8) :: tref_min, tref_max, tmin, tmax + character(len=*), parameter :: sub='rrtmgp_set_state' character(len=512) :: errmsg !-------------------------------------------------------------------------------- @@ -124,39 +126,42 @@ subroutine rrtmgp_set_state( & ! Set surface emissivity to 1.0. ! The land model *does* have its own surface emissivity, but is not spectrally resolved. - ! The LW upward flux is calculated with that land emissivity, and the "radiative temperature" t_sfc is derived - ! from that flux. We assume, therefore, that the emissivity is unity to be consistent with t_sfc. + ! The LW upward flux is calculated with that land emissivity, and the "radiative temperature" + ! t_sfc is derived from that flux. We assume, therefore, that the emissivity is unity + ! to be consistent with t_sfc. emis_sfc(:,:) = 1._r8 + ! Assume level ordering is the same for both CAM and RRTMGP (top to bottom) + t_rad(:,ktoprad:) = state%t(:ncol,ktopcam:) + pmid_rad(:,ktoprad:) = state%pmid(:ncol,ktopcam:) + pint_rad(:,ktoprad:) = state%pint(:ncol,ktopcam:) - ! Assume level ordering is the same for both CAM and RAD (top to bottom) - if (nlay == pver) then - t_rad(:ncol, :) = pstate%t(:ncol, :) - pmid_rad(:ncol, :) = pstate%pmid(:ncol, :) - pint_rad(:ncol, :) = pstate%pint(:ncol, :) - else if (nlay < pver) then - t_rad(:ncol, :) = pstate%t(:ncol, pver-nlay+1:pver) - pmid_rad(:ncol, :) = pstate%pmid(:ncol, pver-nlay+1:pver) - pint_rad(:ncol, :) = pstate%pint(:ncol, pver-nlay+1:pverp) - else if (nlay > pver) then - t_rad(:ncol, nlay-pver+1:) = pstate%t(:ncol, :) - pmid_rad(:ncol, nlay-pver+1:) = pstate%pmid(:ncol, :) - pint_rad(:ncol, nlay-pver+1:) = pstate%pint(:ncol, :) + ! Add extra layer values if needed. + if (nlay == pverp) then + t_rad(:,1) = state%t(:ncol,1) + pmid_rad(:,1) = 0.5_r8 * state%pint(:ncol,1) + ! The top reference pressure from the RRTMGP coefficients datasets is 1.005183574463 Pa + ! Set the top of the extra layer just below that. + pint_rad(:,1) = 1.01_r8 end if - - if (nlay == pverp) then - ! add midpoint and top interface values for extra layer - t_rad(:,1) = pstate%t(:ncol,1) - pmid_rad(:,1) = 0.5_r8 * pstate%pint(:ncol,1) - - ! pint_rad(:,nlay+1) = 1.e-2_r8 ! rrtmg value (in hPa?) - pint_rad(:,1) = 1.01_r8 ! in Pa - else if (nlay > pverp) then - call endrun(sub//': ERROR: radiation should not have more layers than CAM has interfaces') + ! Check that the temperatures are within the limits of RRTMGP validity. + tref_min = kdist_sw%get_temp_min() + tref_max = kdist_sw%get_temp_max() + if ( any(t_rad < tref_min) .or. any(t_rad > tref_max) ) then + ! Find out of range value and quit. + do i = 1, ncol + do k = 1, nlay + if ( t_rad(i,k) < tref_min .or. t_rad(i,k) > tref_max ) then + write(errmsg,*) 'temp outside valid range: ', t_rad(i,k), ': column lat=', & + state%lat(i)*180._r8/pi, ': column lon=', state%lon(i)*180._r8/pi, ': level idx=',k + call endrun(sub//': ERROR, '//errmsg) + end if + end do + end do end if - ! properties needed at day columns + ! Construct arrays containing only daylight columns do i = 1, nday t_day(i,:) = t_rad(idxday(i),:) pmid_day(i,:) = pmid_rad(idxday(i),:) @@ -215,7 +220,7 @@ subroutine rrtmgp_set_state( & end subroutine rrtmgp_set_state -!================================================================================================== +!========================================================================================= logical function is_visible(wavenumber) @@ -237,7 +242,7 @@ logical function is_visible(wavenumber) end function is_visible -!================================================================================================== +!========================================================================================= function get_molar_mass_ratio(gas_name) result(massratio) ! return the molar mass ratio of dry air to gas based on gas_name @@ -266,12 +271,12 @@ function get_molar_mass_ratio(gas_name) result(massratio) end select end function get_molar_mass_ratio -subroutine rad_gas_get_vmr(icall, gas_name, pstate, pbuf, nlay, numactivecols, gas_concs, indices) +subroutine rad_gas_get_vmr(icall, gas_name, state, pbuf, nlay, numactivecols, gas_concs, indices) ! provides volume mixing ratio into gas_concs data structure ! Assumes gas_name will be found with rad_cnst_get_gas(). integer, intent(in) :: icall ! index of climate/diagnostic radiation call character(len=*), intent(in) :: gas_name - type(physics_state), target, intent(in) :: pstate + type(physics_state), target, intent(in) :: state type(physics_buffer_desc), pointer :: pbuf(:) integer, intent(in) :: nlay ! number of layers in radiation calculation integer, intent(in) :: numactivecols ! number of columns, ncol for LW, nday for SW @@ -298,7 +303,7 @@ subroutine rad_gas_get_vmr(icall, gas_name, pstate, pbuf, nlay, numactivecols, g allocate(mmr(numactivecols, nlay)) allocate(gas_vmr(numactivecols, nlay)) - call rad_cnst_get_gas(icall, gas_name, pstate, pbuf, gas_mmr) + call rad_cnst_get_gas(icall, gas_name, state, pbuf, gas_mmr) ! copy the gas and actually convert to mmr in case of H2O (specific to mixing ratio) mmr = gas_mmr @@ -352,8 +357,8 @@ subroutine rad_gas_get_vmr(icall, gas_name, pstate, pbuf, nlay, numactivecols, g amdo = get_molar_mass_ratio('O3') do i = 1, numactivecols P_top = 50.0_r8 ! pressure (Pa) at which we assume O3 = 0 in linear decay from CAM top - P_int(i) = pstate%pint(idx(i),1) ! pressure (Pa) at upper interface of CAM - P_mid(i) = pstate%pmid(idx(i),1) ! pressure (Pa) at midpoint of top layer of CAM + P_int(i) = state%pint(idx(i),1) ! pressure (Pa) at upper interface of CAM + P_mid(i) = state%pmid(idx(i),1) ! pressure (Pa) at midpoint of top layer of CAM alpha(i) = 0.0_r8 beta(i) = 0.0_r8 alpha(i) = log(P_int(i)/P_top) @@ -391,7 +396,7 @@ end subroutine rad_gas_get_vmr !================================================================================================== -subroutine rrtmgp_set_gases_lw(icall, pstate, pbuf, nlay, gas_concs) +subroutine rrtmgp_set_gases_lw(icall, state, pbuf, nlay, gas_concs) ! The gases in the LW coefficients file are: ! H2O, CO2, O3, N2O, CO, CH4, O2, N2 @@ -404,7 +409,7 @@ subroutine rrtmgp_set_gases_lw(icall, pstate, pbuf, nlay, gas_concs) ! arguments integer, intent(in) :: icall ! index of climate/diagnostic radiation call - type(physics_state), target, intent(in) :: pstate + type(physics_state), target, intent(in) :: state type(physics_buffer_desc), pointer :: pbuf(:) integer, intent(in) :: nlay type(ty_gas_concs), intent(inout) :: gas_concs @@ -417,17 +422,17 @@ subroutine rrtmgp_set_gases_lw(icall, pstate, pbuf, nlay, gas_concs) integer :: i !-------------------------------------------------------------------------------- - ncol = pstate%ncol - lchnk = pstate%lchnk + ncol = state%ncol + lchnk = state%lchnk do i = 1,nradgas - call rad_gas_get_vmr(icall, gaslist(i), pstate, pbuf, nlay, ncol, gas_concs) + call rad_gas_get_vmr(icall, gaslist(i), state, pbuf, nlay, ncol, gas_concs) end do end subroutine rrtmgp_set_gases_lw !================================================================================================== subroutine rrtmgp_set_gases_sw( & - icall, pstate, pbuf, nlay, nday, & + icall, state, pbuf, nlay, nday, & idxday, gas_concs) ! Return gas_concs with gas volume mixing ratio on DAYLIT columns. @@ -439,7 +444,7 @@ subroutine rrtmgp_set_gases_sw( & ! arguments integer, intent(in) :: icall ! index of climate/diagnostic radiation call - type(physics_state), target, intent(in) :: pstate + type(physics_state), target, intent(in) :: state type(physics_buffer_desc), pointer :: pbuf(:) integer, intent(in) :: nlay integer, intent(in) :: nday @@ -452,7 +457,7 @@ subroutine rrtmgp_set_gases_sw( & ! use the optional argument indices to specify which columns are sunlit do i = 1,nradgas - call rad_gas_get_vmr(icall, gaslist(i), pstate, pbuf, nlay, nday, gas_concs, indices=idxday) + call rad_gas_get_vmr(icall, gaslist(i), state, pbuf, nlay, nday, gas_concs, indices=idxday) end do end subroutine rrtmgp_set_gases_sw From 8b3dff50761b8c8cae8a8b6e38df1b4c1c5e6bb9 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Wed, 6 Sep 2023 12:04:07 -0400 Subject: [PATCH 140/291] Always use ONLY keyword in USE statements This commit also includes reorganizing of all GEOS-Chem interface USE statements so that they are split into three categories: CAM modules, GEOS-Chem interface modules in CAM, and GEOS-Chem modules. They are alphabetized within each section. An extraneous hemco_interface declaration and new line are also removed. --- src/chemistry/geoschem/chemistry.F90 | 607 ++++++++---------- .../geoschem/geoschem_diagnostics_mod.F90 | 201 ++---- .../geoschem/geoschem_emissions_mod.F90 | 215 ++----- .../geoschem/geoschem_history_mod.F90 | 53 +- src/control/cam_comp.F90 | 1 - src/control/runtime_opts.F90 | 4 - 6 files changed, 408 insertions(+), 673 deletions(-) diff --git a/src/chemistry/geoschem/chemistry.F90 b/src/chemistry/geoschem/chemistry.F90 index 678a64f21d..4bf7fbaa67 100644 --- a/src/chemistry/geoschem/chemistry.F90 +++ b/src/chemistry/geoschem/chemistry.F90 @@ -1,81 +1,50 @@ -!================================================================================================ -! This is the "GEOS-Chem" chemistry module. -!================================================================================================ - module chemistry - use shr_kind_mod, only : r8 => shr_kind_r8, shr_kind_cl - use physics_types, only : physics_state, physics_ptend, physics_ptend_init + + ! CAM modules + use cam_abortutils, only : endrun + use cam_logfile, only : iulog + use chem_mods, only : nTracersMax, nTracers, tracerNames + use chem_mods, only : gas_pcnst, adv_mass, ref_MMR, iFirstCnst + use chem_mods, only : nSlsMax, nSls, slsNames, nSlvd, slvd_Lst + use chem_mods, only : nAerMax, nAer, aerNames, aerAdvMass + use chem_mods, only : map2GC, map2GCinv, map2GC_Sls + use chem_mods, only : mapCnst, map2chm, map2MAM4 + use constituents, only : pcnst, cnst_add, cnst_get_ind, cnst_name + use mo_tracname, only : solsym use physics_buffer, only : physics_buffer_desc - use ppgrid, only : begchunk, endchunk, pcols - use ppgrid, only : pver, pverp - use constituents, only : pcnst, cnst_add, cnst_get_ind - use constituents, only : cnst_name + use physics_types, only : physics_state, physics_ptend, physics_ptend_init + use ppgrid, only : begchunk, endchunk, pcols, pver, pverp use shr_const_mod, only : molw_dryair=>SHR_CONST_MWDAIR use shr_drydep_mod, only : nddvels => n_drydep, drydep_list + use shr_kind_mod, only : r8 => shr_kind_r8, shr_kind_cl use spmd_utils, only : MasterProc, myCPU=>Iam, nCPUs=>npes - use cam_logfile, only : iulog use string_utils, only : to_upper - - !-------------------------------------------------------------------- - ! Basic GEOS-Chem modules - !-------------------------------------------------------------------- - USE DiagList_Mod, ONLY : DgnList ! Derived type for diagnostics list - USE TaggedDiagList_Mod, ONLY : TaggedDgnList ! Derived type for tagged diagnostics list - USE Input_Opt_Mod, ONLY : OptInput ! Derived type for Input Options - USE State_Chm_Mod, ONLY : ChmState ! Derived type for Chemistry State object - USE State_Diag_Mod, ONLY : DgnState ! Derived type for Diagnostics State object - USE State_Grid_Mod, ONLY : GrdState ! Derived type for Grid State object - USE State_Met_Mod, ONLY : MetState ! Derived type for Meteorology State object - USE Species_Mod, ONLY : Species ! Derived type for Species object - USE GC_Environment_Mod ! Runtime GEOS-Chem environment - USE ErrCode_Mod ! Error codes for success or failure - USE Error_Mod ! For error checking - USE Precision_Mod, ONLY : fp, f4 ! Flexible precision - - use chem_mods, only : nSlvd, slvd_Lst - - !-------------------------------------------------------------------- - ! GEOS-Chem History exports module - !-------------------------------------------------------------------- - use GeosChem_History_Mod - - !-------------------------------------------------------------------- - ! CAM modules - !-------------------------------------------------------------------- - ! Exit routine in CAM - use cam_abortutils, only : endrun - - use chem_mods, only : nTracersMax - use chem_mods, only : nTracers - use chem_mods, only : gas_pcnst - use chem_mods, only : tracerNames - use chem_mods, only : adv_mass - use chem_mods, only : ref_MMR - use chem_mods, only : iFirstCnst - use chem_mods, only : nSlsMax - use chem_mods, only : nSls - use chem_mods, only : slsNames - use chem_mods, only : nAerMax - use chem_mods, only : nAer - use chem_mods, only : aerNames - use chem_mods, only : aerAdvMass - use chem_mods, only : map2GC, map2GCinv - use chem_mods, only : map2GC_Sls - use chem_mods, only : mapCnst - use chem_mods, only : map2chm - use chem_mods, only : map2MAM4 #if defined( MODAL_AERO ) use modal_aero_data, only : ntot_amode #endif - - use mo_tracname, only : solsym + + ! GEOS-Chem derived types + USE DiagList_Mod, ONLY : DgnList ! Diagnostics list object + use GeosChem_History_Mod, ONLY : HistoryConfigObj ! History diagnostic object + USE Input_Opt_Mod, ONLY : OptInput ! Input Options + USE Species_Mod, ONLY : Species ! Species object + USE State_Chm_Mod, ONLY : ChmState ! Chemistry State object + USE State_Diag_Mod, ONLY : DgnState ! Diagnostics State object + USE State_Grid_Mod, ONLY : GrdState ! Grid State object + USE State_Met_Mod, ONLY : MetState ! Meteorology State object + USE TaggedDiagList_Mod, ONLY : TaggedDgnList ! Ragged diagnostics list + + ! GEOS-Chem utilities + USE ErrCode_Mod, ONLY : GC_SUCCESS, GC_FAILURE + USE ErrCode_Mod, ONLY : GC_Error, GC_CheckVar, GC_Warning + USE Error_Mod, ONLY : Error_Stop + USE Precision_Mod, ONLY : fp, f4 ! Flexible precision IMPLICIT NONE PRIVATE SAVE - ! + ! Public interfaces - ! public :: chem_is ! identify which chemistry is being used public :: chem_register ! register consituents public :: chem_is_active ! returns true if this package is active (ghg_chem=.true.) @@ -88,7 +57,6 @@ module chemistry public :: chem_read_restart public :: chem_init_restart public :: chem_readnl ! read chem namelist - public :: chem_emissions public :: chem_timestep_init @@ -103,20 +71,16 @@ module chemistry ! Debugging LOGICAL :: debug = .TRUE. - !----------------------------- ! Derived type objects - !----------------------------- - TYPE(OptInput) :: Input_Opt ! Input Options object - TYPE(ChmState),ALLOCATABLE :: State_Chm(:) ! Chemistry State object - TYPE(DgnState),ALLOCATABLE :: State_Diag(:) ! Diagnostics State object - TYPE(GrdState),ALLOCATABLE :: State_Grid(:) ! Grid State object - TYPE(MetState),ALLOCATABLE :: State_Met(:) ! Meteorology State object - TYPE(DgnList ) :: Diag_List ! Diagnostics list object - TYPE(TaggedDgnList ) :: TaggedDiag_List ! Tagged diagnostics list object - - TYPE(HistoryConfigObj), POINTER :: HistoryConfig ! HistoryConfig object for History diagn. - - type(physics_buffer_desc), pointer :: hco_pbuf2d(:,:) ! Pointer to 2D pbuf + TYPE(OptInput) :: Input_Opt ! Input Options object + TYPE(ChmState),ALLOCATABLE :: State_Chm(:) ! Chemistry State object + TYPE(DgnState),ALLOCATABLE :: State_Diag(:) ! Diagnostics State object + TYPE(GrdState),ALLOCATABLE :: State_Grid(:) ! Grid State object + TYPE(MetState),ALLOCATABLE :: State_Met(:) ! Meteorology State object + TYPE(DgnList ) :: Diag_List ! Diagnostics list object + TYPE(TaggedDgnList ) :: TaggedDiag_List ! Tagged diagnostics list object + TYPE(HistoryConfigObj), POINTER :: HistoryConfig ! HistoryConfig object for History diagn. + type(physics_buffer_desc), POINTER :: hco_pbuf2d(:,:) ! Pointer to 2D pbuf ! Mimic code in sfcvmr_mod.F90 TYPE :: SfcMrObj @@ -131,7 +95,6 @@ module chemistry ! Field prefix CHARACTER(LEN=63), PARAMETER :: Prefix_SfcVMR = 'VMR_' - ! Indices of critical species in GEOS-Chem INTEGER :: iH2O, iO3, iCO2, iSO4 INTEGER :: iO, iH, iO2 @@ -161,7 +124,6 @@ module chemistry INTEGER :: ixNDrop ! Cloud droplet number index ! ghg - LOGICAL :: ghg_chem = .false. ! .true. => use ghg chem package CHARACTER(len=shr_kind_cl) :: bndtvg = ' ' ! pathname for greenhouse gas loss rate CHARACTER(len=shr_kind_cl) :: h2orates = ' ' ! pathname for greenhouse gas (lyman-alpha H2O loss) @@ -173,16 +135,18 @@ module chemistry ! For dry deposition character(len=shr_kind_cl) :: depvel_lnd_file = 'depvel_lnd_file' -!================================================================================================ + contains -!================================================================================================ + !================================================================================================ + ! function chem_is + !================================================================================================ function chem_is (name) result (chem_name_is) + ! CAM modules use string_utils, only : to_lower character(len=*), intent(in) :: name - logical :: chem_name_is chem_name_is = (( to_lower(name) == 'geoschem' ) .or. & @@ -190,21 +154,17 @@ function chem_is (name) result (chem_name_is) end function chem_is -!================================================================================================ - + !================================================================================================ + ! subroutine chem_register + !================================================================================================ subroutine chem_register + ! CAM modules + use chem_mods, only : drySpc_ndx + use mo_chem_utls, only : get_spc_ndx + use physconst, only : MWDry use physics_buffer, only : pbuf_add_field, dtype_r8 - use PhysConst, only : MWDry use short_lived_species, only : Register_Short_Lived_Species - use State_Grid_Mod, only : Init_State_Grid, Cleanup_State_Grid - use State_Chm_Mod, only : Init_State_Chm, Cleanup_State_Chm - use State_Chm_Mod, only : Ind_ - use Input_Opt_Mod, only : Set_Input_Opt, Cleanup_Input_Opt - - use mo_sim_dat, only : set_sim_dat - use mo_chem_utls, only : get_spc_ndx - use chem_mods, only : drySpc_ndx #if defined( MODAL_AERO ) use aero_model, only : aero_model_register use modal_aero_data, only : nspec_max @@ -212,6 +172,15 @@ subroutine chem_register use modal_aero_data, only : xname_massptr #endif + ! GEOS-Chem interface modules in CAM + use mo_sim_dat, only : set_sim_dat + + ! GEOS-Chem modules + use GC_Environment_Mod, ONLY : GC_Init_Grid + use Input_Opt_Mod, only : Set_Input_Opt, Cleanup_Input_Opt + use State_Chm_Mod, only : Init_State_Chm, Cleanup_State_Chm, Ind_ + use State_Grid_Mod, only : Init_State_Grid, Cleanup_State_Grid + !----------------------------------------------------------------------- ! ! Purpose: register advected constituents for chemistry @@ -515,10 +484,10 @@ subroutine chem_register CALL cnst_get_ind('H2O', cH2O, abort=.True.) CALL cnst_get_ind('H2SO4', cH2SO4, abort=.True.) - !============================================================== + !------------------------------------------------------------ ! Get mapping between dry deposition species and species set - !============================================================== - + !------------------------------------------------------------ + nIgnored = 0 if (debug .and. masterproc) write(iulog,'(a,i4,a)') 'chem_register: looping over gas dry deposition list with ', nddvels, ' species' @@ -622,10 +591,7 @@ subroutine chem_register #endif - !============================================================== ! Print summary - !============================================================== - IF ( MasterProc ) THEN Write(iulog,'(/, a)') '### Summary of GEOS-Chem species (end of chem_register): ' Write(iulog,'( a)') REPEAT( '-', 50 ) @@ -666,24 +632,26 @@ subroutine chem_register end subroutine chem_register -!=============================================================================== - + !================================================================================================ + ! subroutine chem_readnl + !================================================================================================ subroutine chem_readnl(nlfile) + ! CAM modules use cam_abortutils, only : endrun - use units, only : getunit, freeunit + use chem_mods, only : drySpc_ndx + use gas_wetdep_opts, only : gas_wetdep_readnl + use gckpp_Model, only : nSpec, Spc_Names use namelist_utils, only : find_group_name + use mo_lightning, only : lightning_readnl + use units, only : getunit, freeunit #if defined( MODAL_AERO ) use aero_model, only : aero_model_readnl use dust_model, only : dust_readnl #endif - use gas_wetdep_opts, only : gas_wetdep_readnl - use mo_lightning, only : lightning_readnl #ifdef SPMD use mpishorthand #endif - use gckpp_Model, only : nSpec, Spc_Names - use chem_mods, only : drySpc_ndx ! args CHARACTER(LEN=*), INTENT(IN) :: nlfile ! filepath for file containing namelist input @@ -710,9 +678,7 @@ subroutine chem_readnl(nlfile) IF ( IERR .NE. 0 ) CALL ENDRUN('Failed to allocate drySpc_ndx') #if defined( MODAL_AERO_4MODE ) - !============================================================== ! Get names and molar weights of aerosols in MAM4 - !============================================================== nAer = 33 @@ -769,9 +735,9 @@ subroutine chem_readnl(nlfile) Write(iulog,'(/,a,/)') 'Now defining GEOS-Chem tracers and dry deposition mapping...' - !============================================================== + !---------------------------------------------------------- ! Read GEOS-Chem advected species from geoschem_config.yml - !============================================================== + !---------------------------------------------------------- unitn = getunit() @@ -823,11 +789,11 @@ subroutine chem_readnl(nlfile) WRITE(tracerNames(I),'(a,I0.4)') 'GCTRC_', I ENDDO - !============================================================== + !---------------------------------------------------------- ! Now go through the KPP mechanism and add any species not ! implemented by the tracer list in geoschem_config.yml - !============================================================== - + !---------------------------------------------------------- + IF ( nSpec > nSlsMax ) THEN CALL ENDRUN('chem_readnl: too many species - increase nSlsmax') ENDIF @@ -850,8 +816,6 @@ subroutine chem_readnl(nlfile) ENDIF ENDDO - !============================================================== - unitn = getunit() OPEN( unitn, FILE=TRIM(nlfile), STATUS='old', IOSTAT=IERR ) IF (IERR .NE. 0) THEN @@ -870,10 +834,10 @@ subroutine chem_readnl(nlfile) ENDIF - !================================================================== + !---------------------------------------------------------- ! Broadcast to all processors - !================================================================== - + !---------------------------------------------------------- + CALL MPIBCAST ( nTracers, 1, MPIINT, 0, MPICOM ) CALL MPIBCAST ( tracerNames, LEN(tracerNames(1))*nTracersMax, MPICHAR, 0, MPICOM ) CALL MPIBCAST ( nSls, 1, MPIINT, 0, MPICOM ) @@ -900,37 +864,31 @@ subroutine chem_readnl(nlfile) end subroutine chem_readnl -!================================================================================================ - + !================================================================================================ + ! function chem_is_active + !================================================================================================ function chem_is_active() - !----------------------------------------------------------------------- + logical :: chem_is_active - !----------------------------------------------------------------------- chem_is_active = .true. end function chem_is_active -!================================================================================================ - + !================================================================================================ + ! function chem_implements_cnst + !================================================================================================ function chem_implements_cnst(name) - !----------------------------------------------------------------------- - ! ! Purpose: return true if specified constituent is implemented by this package - ! ! Author: B. Eaton - ! - !----------------------------------------------------------------------- + IMPLICIT NONE - !-----------------------------Arguments--------------------------------- CHARACTER(LEN=*), INTENT(IN) :: name ! constituent name LOGICAL :: chem_implements_cnst ! return value - INTEGER :: M chem_implements_cnst = .false. - DO M = 1, gas_pcnst IF (TRIM(solsym(M)) .eq. TRIM(name)) THEN chem_implements_cnst = .true. @@ -940,8 +898,9 @@ function chem_implements_cnst(name) end function chem_implements_cnst -!=============================================================================== - + !================================================================================================ + ! subroutine chem_init + !================================================================================================ subroutine chem_init(phys_state, pbuf2d) !----------------------------------------------------------------------- ! @@ -949,21 +908,24 @@ subroutine chem_init(phys_state, pbuf2d) ! (and declare history variables) ! !----------------------------------------------------------------------- - use physics_buffer, only : physics_buffer_desc, pbuf_get_index - use chem_mods, only : map2GC_dryDep, drySpc_ndx -#ifdef SPMD - use mpishorthand -#endif + ! CAM modules use cam_abortutils, only : endrun - use mo_chem_utls, only : get_spc_ndx - - use Phys_Grid, only : get_Area_All_p - use hycoef, only : ps0, hyai, hybi, hyam - + use chem_mods, only : map2GC_dryDep, drySpc_ndx use gas_wetdep_opts, only : gas_wetdep_method + use hycoef, only : ps0, hyai, hybi, hyam + use mo_chem_utls, only : get_spc_ndx + use mo_ghg_chem, only : ghg_chem_init + use mo_mean_mass, only : init_mean_mass use mo_neu_wetdep, only : neu_wetdep_init - + use mo_setinv, only : setinv_inti + use Phys_Grid, only : get_Area_All_p + use physics_buffer, only : physics_buffer_desc, pbuf_get_index + use tracer_cnst, only : tracer_cnst_init + use tracer_srcs, only : tracer_srcs_init +#ifdef SPMD + use mpishorthand +#endif #if defined( MODAL_AERO ) use aero_model, only : aero_model_init use mo_setsox, only : sox_inti @@ -972,41 +934,32 @@ subroutine chem_init(phys_state, pbuf2d) use modal_aero_data, only : xname_massptr #endif - use Input_Opt_Mod - use State_Chm_Mod - use State_Grid_Mod - use State_Met_Mod + ! GEOS-Chem interface modules in CAM + use geoschem_diagnostics_mod, only : GC_Diagnostics_Init + use geoschem_emissions_mod, only : GC_Emissions_Init + use geoschem_history_mod, only : HistoryExports_SetServices + + ! GEOS-Chem modules + use Chemistry_Mod, only : Init_Chemistry use DiagList_Mod, only : Init_DiagList, Print_DiagList - use TaggedDiagList_Mod, only : Init_TaggedDiagList, Print_TaggedDiagList + use Drydep_Mod, only : depName, Ndvzind + use Error_Mod, only : Init_Error + use GC_Environment_Mod, only : GC_Init_Grid, GC_Init_StateObj + use GC_Environment_Mod, only : GC_Init_Extra, GC_Allocate_All use GC_Grid_Mod, only : SetGridFromCtrEdges - - ! Use GEOS-Chem versions of physical constants - use PhysConstants, only : PI, PI_180, Re - - use Time_Mod, only : Accept_External_Date_Time + use Input_Mod, only : Read_Input_File, Validate_Directories + use Input_Opt_Mod, only : Set_Input_Opt + use isorropiaII_Mod, only : Init_IsorropiaII + use Linear_Chem_Mod, only : Init_Linear_Chem use Linoz_Mod, only : Linoz_Read - - use CMN_Size_Mod - - use Drydep_Mod, only : depName, Ndvzind + use PhysConstants, only : PI, PI_180, Re use Pressure_Mod, only : Accept_External_ApBp - use Chemistry_Mod, only : Init_Chemistry + use State_Chm_Mod, only : Ind_ + use State_Grid_Mod, only : Init_State_Grid, Cleanup_State_Grid + use TaggedDiagList_Mod, only : Init_TaggedDiagList, Print_TaggedDiagList + use Time_Mod, only : Accept_External_Date_Time use Ucx_Mod, only : Init_Ucx - use Linear_Chem_Mod, only : Init_Linear_Chem - use isorropiaII_Mod, only : Init_IsorropiaII - use Input_Mod, only : Read_Input_File - use Input_Mod, only : Validate_Directories - use Olson_Landmap_Mod - use Vdiff_Mod - - use mo_setinv, only : setinv_inti - use mo_mean_mass, only : init_mean_mass - use mo_ghg_chem, only : ghg_chem_init - use tracer_cnst, only : tracer_cnst_init - use tracer_srcs, only : tracer_srcs_init - - use GeosChem_Emissions_Mod, only : GC_Emissions_Init - use GeosChem_Diagnostics_Mod, only : GC_Diagnostics_Init + use Vdiff_Mod, only : Max_PblHt_For_Vdiff TYPE(physics_state), INTENT(IN ) :: phys_state(BEGCHUNK:ENDCHUNK) TYPE(physics_buffer_desc), POINTER, INTENT(INOUT) :: pbuf2d(:,:) @@ -1154,10 +1107,10 @@ subroutine chem_init(phys_state, pbuf2d) Input_Opt%SpcDatabaseFile = TRIM(speciesDB) Input_Opt%FAST_JX_DIR = TRIM(gc_cheminputs)//'FAST_JX/v2020-02/' - !================================================================== + !---------------------------------------------------------- ! CESM-specific input flags - !================================================================== - + !---------------------------------------------------------- + ! onlineAlbedo -> True (use CLM albedo) ! -> False (read monthly-mean albedo from HEMCO) Input_Opt%onlineAlbedo = .true. @@ -1450,13 +1403,13 @@ subroutine chem_init(phys_state, pbuf2d) ENDIF IF ( Input_Opt%LDryD ) THEN - !============================================================== + !---------------------------------------------------------- ! Get mapping between CESM dry deposited species and the ! indices of State_Chm%DryDepVel. This needs to be done after ! Init_Drydep ! Thibaud M. Fritz - 04 Mar 2020 - !============================================================== - + !---------------------------------------------------------- + ALLOCATE(map2GC_dryDep(nddvels), STAT=IERR) IF ( IERR .NE. 0 ) CALL ENDRUN('Failed to allocate map2GC_dryDep') @@ -1695,14 +1648,16 @@ subroutine chem_init(phys_state, pbuf2d) end subroutine chem_init -!=============================================================================== - + !================================================================================================ + ! chem_timestep_init + !================================================================================================ subroutine chem_timestep_init(phys_state, pbuf2d) - use physics_buffer, only : physics_buffer_desc + ! CAM modules use mo_flbc, only : flbc_chk use mo_ghg_chem, only : ghg_chem_timestep_init - + use physics_buffer, only : physics_buffer_desc + TYPE(physics_state), INTENT(IN):: phys_state(begchunk:endchunk) TYPE(physics_buffer_desc), POINTER :: pbuf2d(:,:) @@ -1719,10 +1674,12 @@ subroutine chem_timestep_init(phys_state, pbuf2d) end subroutine chem_timestep_init -!=============================================================================== - - subroutine GC_Update_Timesteps(DT) + !================================================================================================ + ! subroutine gc_update_timesteps + !================================================================================================ + subroutine gc_update_timesteps(DT) + ! GEOS-Chem modules use Time_Mod, only : Set_Timesteps REAL(r8), INTENT(IN) :: DT @@ -1750,47 +1707,25 @@ subroutine GC_Update_Timesteps(DT) DT_MIN_LAST = DT_MIN ENDIF - end subroutine + end subroutine gc_update_timesteps -!=============================================================================== - -!------------------------------------------------------------------------------ -!BOP -! -! !IROUTINE: gc_readnl -! -! !DESCRIPTION: Reads the namelist from cam/src/control/runtime_opts. -!\\ -!\\ -! !INTERFACE: -! + !================================================================================================ + ! subroutine gc_readnl + !================================================================================================ subroutine gc_readnl(nlfile) -! -! !USES: -! + ! Purpose: reads the namelist from cam/src/control/runtime_opts + + ! CAM modules + use mpishorthand use namelist_utils, only: find_group_name use units, only: getunit, freeunit - use mpishorthand -! -! !INPUT PARAMETERS: -! + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input -! -! !REVISION HISTORY: -! 21 Jan 2021 - T.M. Fritz - Initial version -!EOP -!------------------------------------------------------------------------------ -!BOC -! -! !LOCAL VARIABLES: -! integer :: unitn, ierr character(len=*), parameter :: subname = 'gc_readnl' namelist /gc_nl/ gc_cheminputs - !----------------------------------------------------------------------------- - ! Read namelist IF ( MasterProc ) THEN unitn = getunit() @@ -1809,104 +1744,79 @@ subroutine gc_readnl(nlfile) ! Broadcast namelist variables CALL MPIBCAST(gc_cheminputs, LEN(gc_cheminputs), MPICHAR, 0, MPICOM) - end subroutine -!EOC - -!=============================================================================== + end subroutine gc_readnl + !================================================================================================ + ! subroutine chem_timestep_tend + !================================================================================================ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) - use physics_buffer, only : physics_buffer_desc, pbuf_get_field, pbuf_old_tim_idx - use physics_buffer, only : pbuf_get_chunk, pbuf_get_index - use perf_mod, only : t_startf, t_stopf + ! CAM modules use cam_history, only : outfld, hist_fld_active use camsrfexch, only : cam_in_t, cam_out_t - -#ifdef SPMD - use mpishorthand -#endif - - use phys_grid, only : get_ncols_p, get_rlat_all_p, get_rlon_all_p - - use mo_chem_utls, only : get_spc_ndx use chem_mods, only : drySpc_ndx, map2GC_dryDep use chem_mods, only : nfs, indexm, gas_pcnst - use mo_mean_mass, only : set_mean_mass - use mo_setinv, only : setinv + use gas_wetdep_opts, only : gas_wetdep_method + use mo_chem_utls, only : get_spc_ndx use mo_flbc, only : flbc_set use mo_ghg_chem, only : ghg_chem_set_flbc + use mo_mean_mass, only : set_mean_mass use mo_neu_wetdep, only : neu_wetdep_tend - use gas_wetdep_opts, only : gas_wetdep_method + use mo_setinv, only : setinv + use orbit, only : zenith ! For computing SZA + use physics_buffer, only : physics_buffer_desc, pbuf_get_field, pbuf_old_tim_idx + use physics_buffer, only : pbuf_get_chunk, pbuf_get_index + use perf_mod, only : t_startf, t_stopf + use phys_grid, only : get_ncols_p, get_rlat_all_p, get_rlon_all_p + use phys_grid, only : get_area_all_p, get_lat_all_p, get_lon_all_p + use physconst, only : MWDry, Gravit + use rad_constituents, only : rad_cnst_get_info + use short_lived_species, only : get_short_lived_species_gc, set_short_lived_species_gc + use time_manager, only : Get_Curr_Calday, Get_Curr_Date ! For computing SZA + use tropopause, only : Tropopause_findChemTrop, Tropopause_Find + use wv_saturation, only : QSat #if defined( MODAL_AERO ) + use aero_model, only : aero_model_gasaerexch ! Aqueous chemistry and aerosol growth use modal_aero_data, only : ntot_amode, nspec_amode use modal_aero_data, only : nspec_max, nsoa use modal_aero_data, only : lmassptr_amode, numptr_amode use modal_aero_data, only : lptr_so4_a_amode use modal_aero_data, only : lptr2_soa_a_amode, lptr2_soa_g_amode #endif +#ifdef SPMD + use mpishorthand +#endif + + ! GEOS-Chem interface modules in CAM + use GeosChem_Emissions_Mod, only : GC_Emissions_Calc + use GeosChem_Diagnostics_Mod, only : GC_Diagnostics_Calc, wetdep_name, wtrate_name + use GeosChem_History_Mod, only : HistoryExports_SetDataPointers, CopyGCStates2Exports - use Diagnostics_Mod, only : Zero_Diagnostics_StartOfTimestep - use Diagnostics_Mod, only : Set_Diagnostics_EndofTimestep + ! GEOS-Chem modules use Aerosol_Mod, only : Set_AerMass_Diagnostic - use Olson_Landmap_Mod, only : Compute_Olson_Landmap - use Modis_LAI_Mod, only : Compute_XLAI - use CMN_Size_Mod, only : NSURFTYPE - use Drydep_Mod, only : Do_Drydep - use Drydep_Mod, only : DEPNAME, NDVZIND - use Drydep_Mod, only : Update_DryDepFreq - - use Calc_Met_Mod, only : Set_Dry_Surface_Pressure - use Calc_Met_Mod, only : AirQnt - use GC_Grid_Mod, only : SetGridFromCtr - use Pressure_Mod, only : Set_Floating_Pressures - use Pressure_Mod, only : Accept_External_Pedge - use Time_Mod, only : Accept_External_Date_Time - use Toms_Mod, only : Compute_Overhead_O3 + use Calc_Met_Mod, only : Set_Dry_Surface_Pressure, AirQnt use Chemistry_Mod, only : Do_Chemistry - use Wetscav_Mod, only : Setup_Wetscav - use CMN_Size_Mod, only : PTop - use PBL_Mix_Mod, only : Compute_PBL_Height - use UCX_Mod, only : Set_H2O_Trac use CMN_FJX_MOD, only : ZPJ + use CMN_Size_Mod, only : NSURFTYPE, PTop + use Diagnostics_Mod, only : Zero_Diagnostics_StartOfTimestep, Set_Diagnostics_EndofTimestep + use Drydep_Mod, only : Do_Drydep, DEPNAME, NDVZIND, Update_DryDepFreq use FAST_JX_MOD, only : RXN_NO2, RXN_O3_1 - use State_Diag_Mod, only : get_TagInfo - use Unitconv_Mod, only : Convert_Spc_Units - use State_Chm_Mod, only : Ind_ - + use GC_Grid_Mod, only : SetGridFromCtr + use HCO_Interface_GC_Mod,only : Compute_Sflx_For_Vdiff use Linear_Chem_Mod, only : TrID_GC, GC_Bry_TrID, NSCHEM use Linear_Chem_Mod, only : BrPtrDay, BrPtrNight, PLVEC, GMI_OH - - use GeosChem_Emissions_Mod, only : GC_Emissions_Calc - use GeosChem_Diagnostics_Mod, only : GC_Diagnostics_Calc - use GeosChem_Diagnostics_Mod, only : wetdep_name, wtrate_name - - use Tropopause, only : Tropopause_findChemTrop, Tropopause_Find - use HCO_Interface_GC_Mod ! Utility routines for GC-HEMCO interface - - ! For calculating SZA - use Orbit, only : zenith - use Time_Manager, only : Get_Curr_Calday, Get_Curr_Date - - ! Calculating relative humidity - use WV_Saturation, only : QSat - - ! Grid area - use Phys_Grid, only : get_area_all_p, get_lat_all_p, get_lon_all_p - - use short_lived_species, only : get_short_lived_species_gc - use short_lived_species, only : set_short_lived_species_gc - -#if defined( MODAL_AERO ) - ! Aqueous chemistry and aerosol growth - use aero_model, only : aero_model_gasaerexch -#endif - - use rad_constituents, only : rad_cnst_get_info - - ! GEOS-Chem version of physical constants + use Olson_Landmap_Mod, only : Compute_Olson_Landmap + use Modis_LAI_Mod, only : Compute_XLAI + use PBL_Mix_Mod, only : Compute_PBL_Height use PhysConstants, only : PI, PI_180, g0, AVO, Re, g0_100 - ! CAM version of physical constants - use PhysConst, only : MWDry, Gravit + use Pressure_Mod, only : Set_Floating_Pressures, Accept_External_Pedge + use State_Chm_Mod, only : Ind_ + use State_Diag_Mod, only : get_TagInfo + use Time_Mod, only : Accept_External_Date_Time + use Toms_Mod, only : Compute_Overhead_O3 + use UCX_Mod, only : Set_H2O_Trac + use Unitconv_Mod, only : Convert_Spc_Units + use Wetscav_Mod, only : Setup_Wetscav REAL(r8), INTENT(IN) :: dT ! Time step TYPE(physics_state), INTENT(IN) :: state ! Physics State variables @@ -4251,8 +4161,9 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) end subroutine chem_timestep_tend -!=============================================================================== - + !================================================================================================ + ! subroutine chem_init_cnst + !================================================================================================ subroutine chem_init_cnst(name, latvals, lonvals, mask, q) CHARACTER(LEN=*), INTENT(IN) :: name ! constituent name @@ -4283,36 +4194,35 @@ subroutine chem_init_cnst(name, latvals, lonvals, mask, q) end subroutine chem_init_cnst -!=============================================================================== - + !================================================================================================ + ! subroutine chem_final + !================================================================================================ subroutine chem_final + ! CAM modules + use short_lived_species, only : short_lived_species_final + + ! GEOS-Chem interface modules in CAM + use geoschem_emissions_mod, only : GC_Emissions_Final + use geoschem_history_mod, only : Destroy_HistoryConfig + + ! GEOS-Chem modules + use Aerosol_Mod, only : Cleanup_Aerosol + use Carbon_Mod, only : Cleanup_Carbon + use CMN_FJX_Mod, only : Cleanup_CMN_FJX + use Drydep_Mod, only : Cleanup_Drydep + use Dust_Mod, only : Cleanup_Dust + use Error_Mod, only : Cleanup_Error + use Fullchem_Mod, only : Cleanup_FullChem use Input_Opt_Mod, only : Cleanup_Input_Opt + use Linear_Chem_Mod, only : Cleanup_Linear_Chem + use Pressure_Mod, only : Cleanup_Pressure + use Seasalt_Mod, only : Cleanup_Seasalt use State_Chm_Mod, only : Cleanup_State_Chm use State_Diag_Mod, only : Cleanup_State_Diag use State_Grid_Mod, only : Cleanup_State_Grid use State_Met_Mod, only : Cleanup_State_Met - use Error_Mod, only : Cleanup_Error - use Fullchem_Mod, only : Cleanup_FullChem - use Drydep_Mod, only : Cleanup_Drydep - use Carbon_Mod, only : Cleanup_Carbon - use Dust_Mod, only : Cleanup_Dust - use Seasalt_Mod, only : Cleanup_Seasalt - use Aerosol_Mod, only : Cleanup_Aerosol use Sulfate_Mod, only : Cleanup_Sulfate - use Pressure_Mod, only : Cleanup_Pressure - use Linear_Chem_Mod, only : Cleanup_Linear_Chem - - use CMN_FJX_Mod, only : Cleanup_CMN_FJX - -#ifdef BPCH_DIAG - use CMN_O3_Mod, only : Cleanup_CMN_O3 - ! Special: cleans up after NDXX_Setup - use Diag_Mod, only : Cleanup_Diag -#endif - - use GeosChem_Emissions_Mod, only : GC_Emissions_Final - use short_lived_species, only : short_lived_species_final ! Local variables INTEGER :: I, RC @@ -4347,17 +4257,6 @@ subroutine chem_final CALL Error_Stop( ErrMsg, ThisLoc ) ENDIF -#ifdef BPCH_DIAG - CALL Cleanup_Diag - - ! Call extra cleanup routines, from modules in Headers/ - CALL Cleanup_CMN_O3( RC ) - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Error encountered in "Cleanup_CMN_O3"!' - CALL Error_Stop( ErrMsg, ThisLoc ) - ENDIF -#endif - ! Cleanup Input_Opt CALL Cleanup_Input_Opt( Input_Opt, RC ) @@ -4382,12 +4281,15 @@ subroutine chem_final end subroutine chem_final -!=============================================================================== - + !================================================================================================ + ! subroutine chem_init_restart + !================================================================================================ subroutine chem_init_restart(File) + + ! CAM modules + use pio, only : file_desc_t use tracer_cnst, only : init_tracer_cnst_restart use tracer_srcs, only : init_tracer_srcs_restart - use pio, only : file_desc_t IMPLICIT NONE @@ -4404,12 +4306,15 @@ subroutine chem_init_restart(File) end subroutine chem_init_restart -!=============================================================================== - + !================================================================================================ + ! subroutine chem_write_restart + !================================================================================================ subroutine chem_write_restart( File ) + + ! CAM modules + use pio, only : file_desc_t use tracer_cnst, only : write_tracer_cnst_restart use tracer_srcs, only : write_tracer_srcs_restart - use pio, only : file_desc_t IMPLICIT NONE @@ -4423,12 +4328,15 @@ subroutine chem_write_restart( File ) end subroutine chem_write_restart -!=============================================================================== - + !================================================================================================ + ! subroutine chem_read_restart + !================================================================================================ subroutine chem_read_restart( File ) + + ! CAM modules + use pio, only : file_desc_t use tracer_cnst, only : read_tracer_cnst_restart use tracer_srcs, only : read_tracer_srcs_restart - use pio, only : file_desc_t IMPLICIT NONE @@ -4442,34 +4350,27 @@ subroutine chem_read_restart( File ) end subroutine chem_read_restart -!================================================================================ - + !================================================================================================ + ! subroutine chem_emissions + !================================================================================================ subroutine chem_emissions( state, cam_in, pbuf ) - use physics_buffer, only : physics_buffer_desc + ! CAM modules use camsrfexch, only : cam_in_t - - ! Arguments: + use physics_buffer, only : physics_buffer_desc TYPE(physics_state), INTENT(IN) :: state ! Physics state variables TYPE(cam_in_t), INTENT(INOUT) :: cam_in ! import state TYPE(physics_buffer_desc), pointer :: pbuf(:) ! Physics buffer in chunk, for HEMCO INTEGER :: M, N - INTEGER :: LCHNK, nY + INTEGER :: nY LOGICAL :: rootChunk + nY = state%NCOL ! number of atmospheric columns on this chunk + rootChunk = ( MasterProc .and. (state%LCHNK .eq. BEGCHUNK) ) - ! LCHNK: which chunk we have on this process - LCHNK = state%LCHNK - ! NCOL: number of atmospheric columns on this chunk - nY = state%NCOL - rootChunk = ( MasterProc.and.(LCHNK.EQ.BEGCHUNK) ) - - !----------------------------------------------------------------------- ! Reset surface fluxes - !----------------------------------------------------------------------- - DO M = iFirstCnst, pcnst !N = map2chm(M) !IF ( N > 0 ) cam_in%cflx(1:nY,N) = 0.0e+0_r8 @@ -4478,6 +4379,4 @@ subroutine chem_emissions( state, cam_in, pbuf ) end subroutine chem_emissions -!=============================================================================== - end module chemistry diff --git a/src/chemistry/geoschem/geoschem_diagnostics_mod.F90 b/src/chemistry/geoschem/geoschem_diagnostics_mod.F90 index f40ca20d92..9defdf4e58 100644 --- a/src/chemistry/geoschem/geoschem_diagnostics_mod.F90 +++ b/src/chemistry/geoschem/geoschem_diagnostics_mod.F90 @@ -1,44 +1,27 @@ -!------------------------------------------------------------------------------ -! GEOS-Chem chemistry diagnostics interface ! -!------------------------------------------------------------------------------ -!BOP -! -! !MODULE: geoschem_diagnostics_mod.F90 -! -! !DESCRIPTION: Module geoschem\_diagnostics\_mod contains routines which aim to -! diagnose variables from GEOS-Chem -!\\ -!\\ -! !INTERFACE: -! MODULE GeosChem_Diagnostics_Mod -! -! !USES: -! - USE SHR_KIND_MOD, ONLY : r8 => shr_kind_r8, shr_kind_cl - USE SHR_CONST_MOD, ONLY : pi => shr_const_pi - USE CAM_HISTORY, ONLY : fieldname_len - USE CONSTITUENTS, ONLY : pcnst - USE CHEM_MODS, ONLY : gas_pcnst, map2chm - USE CHEM_MODS, ONLY : iFirstCnst - USE MO_TRACNAME, ONLY : solsym - USE SPMD_UTILS, ONLY : MasterProc - USE PPGRID, ONLY : begchunk, pver - USE CAM_LOGFILE, ONLY : iulog - USE STRING_UTILS, ONLY : to_upper - USE Error_Mod ! For error checking - USE ErrCode_Mod ! Error codes for success or failure + + ! CAM modules + use cam_history, only : fieldname_len + use cam_logfile, only : iulog + use chem_mods, only : gas_pcnst, map2chm, iFirstCnst + use constituents, only : pcnst + use mo_tracname, only : solsym + use ppgrid, only : begchunk, pver + use shr_const_mod, only : pi => shr_const_pi + use shr_kind_mod, only : r8 => shr_kind_r8, shr_kind_cl + use spmd_utils, only : MasterProc + use string_utils, only : to_upper + + ! GEOS-Chem modules + use ErrCode_Mod, only : GC_SUCCESS IMPLICIT NONE PRIVATE -! -! !PUBLIC MEMBER FUNCTIONS: -! PUBLIC :: GC_Diagnostics_Init PUBLIC :: GC_Diagnostics_Calc - PUBLIC :: wetdep_name, wtrate_name + PUBLIC :: wetdep_name, wtrate_name, dtchem_name CHARACTER(LEN=fieldname_len) :: srcnam(gas_pcnst) ! Names of source/sink tendencies CHARACTER(LEN=fieldname_len) :: wetdep_name(gas_pcnst) ! Wet deposition tendencies @@ -124,58 +107,34 @@ MODULE GeosChem_Diagnostics_Mod integer :: id_o,id_o2,id_h,id_n2o integer :: id_co2,id_o3,id_oh,id_ho2,id_so4_a1,id_so4_a2,id_so4_a3 integer :: id_num_a2,id_num_a3,id_dst_a3,id_ncl_a3 -! + ! !REVISION HISTORY: ! 28 Oct 2020 - T. M. Fritz - Initial version -!EOP -!------------------------------------------------------------------------------ -!BOC -! + CONTAINS -! -!EOC -!------------------------------------------------------------------------------ -!BOP -! -! !IROUTINE: gc_diagnostics_init -! -! !DESCRIPTION: Subroutine GC\_Diagnostics\_Init declares the variables to -! diagnosethe -!\\ -!\\ -! !INTERFACE: -! + SUBROUTINE GC_Diagnostics_Init( Input_Opt, State_Chm, State_Met ) -! -! !USES: -! - USE Input_Opt_Mod, ONLY : OptInput - USE State_Chm_Mod, ONLY : ChmState - USE State_Met_Mod, ONLY : MetState - USE State_Diag_Mod, ONLY : get_TagInfo - USE Species_Mod, ONLY : Species - USE Registry_Mod, ONLY : MetaRegItem, RegItem - USE State_Chm_Mod, ONLY : Ind_ - USE CONSTITUENTS, ONLY : cnst_name, sflxnam - USE CONSTITUENTS, ONLY : cnst_get_ind - USE CAM_HISTORY, ONLY : addfld, add_default, horiz_only - USE PHYS_CONTROL, ONLY : phys_getopts - USE DRYDEP_MOD, ONLY : depName - USE MO_CHEM_UTLS, ONLY : get_spc_ndx -! -! !INPUT PARAMETERS: -! + + ! CAM modules + use cam_history, only : addfld, add_default, horiz_only + use constituents, only : cnst_name, sflxnam, cnst_get_ind + use mo_chem_utls, only : get_spc_ndx + use phys_control, only : phys_getopts + + ! GEOS-Chem modules + use Input_Opt_Mod, only : OptInput + use State_Chm_Mod, only : ChmState + use State_Met_Mod, only : MetState + use State_Diag_Mod, only : get_TagInfo + use Species_Mod, only : Species + use Registry_Mod, only : MetaRegItem, RegItem + use State_Chm_Mod, only : Ind_ + use DryDep_Mod, only : depName + TYPE(OptInput), INTENT(IN) :: Input_Opt ! Input options TYPE(ChmState), INTENT(IN) :: State_Chm ! Chemistry State object TYPE(MetState), INTENT(IN) :: State_Met ! Meteorology State object -! -! !REVISION HISTORY: -! 20 Oct 2020 - T. M. Fritz - Initial version -!EOP -!------------------------------------------------------------------------------ -!BOC -! - ! Integer + INTEGER :: M, N, K, SM INTEGER :: idx INTEGER :: RC @@ -189,7 +148,6 @@ SUBROUTINE GC_Diagnostics_Init( Input_Opt, State_Chm, State_Met ) INTEGER :: history_budget_histfile_num ! output history file number ! for budget fields - ! Logical LOGICAL :: Found LOGICAL :: compare_uppercase ! Compare upper-case names LOGICAL :: history_aerosol ! Output the MAM aerosol @@ -207,7 +165,6 @@ SUBROUTINE GC_Diagnostics_Init( Input_Opt, State_Chm, State_Met ) ! cloud ice and cloud ! liquid budgets. - ! Strings CHARACTER(LEN=shr_kind_cl) :: SpcName CHARACTER(LEN=shr_kind_cl) :: tagName CHARACTER(LEN=shr_kind_cl) :: ThisLoc @@ -839,56 +796,39 @@ SUBROUTINE GC_Diagnostics_Init( Input_Opt, State_Chm, State_Met ) CALL Addfld( 'CT_H2O_GHG', (/ 'lev' /), 'A','kg/kg/s', 'ghg-chem h2o source/sink' ) - !======================================================================= - ! Cleanup and quit - !======================================================================= + + ! Cleanup Current => NULL() Item => NULL() END SUBROUTINE GC_Diagnostics_Init -!EOC -!------------------------------------------------------------------------------ -!BOP -! -! !IROUTINE: gc_diagnostics_calc -! -! !DESCRIPTION: Subroutine GC\_Diagnostics\_Calc passes the diagnostics variable -! to the CAM History routines -!\\ -!\\ -! !INTERFACE: -! + SUBROUTINE GC_Diagnostics_Calc( Input_Opt, State_Chm, State_Diag, & State_Grid, State_Met, cam_in, state, & mmr_tend, LCHNK ) -! -! !USES: -! - USE Input_Opt_Mod, ONLY : OptInput - USE State_Chm_Mod, ONLY : ChmState - USE State_Met_Mod, ONLY : MetState - USE State_Diag_Mod, ONLY : DgnState - USE State_Diag_Mod, ONLY : get_TagInfo - USE State_Grid_Mod, ONLY : GrdState - USE Species_Mod, ONLY : Species - USE Registry_Mod, ONLY : MetaRegItem, RegItem - USE Registry_Mod, ONLY : Registry_Lookup - USE Registry_Params_Mod - USE PRECISION_MOD - USE CHEM_MODS, ONLY : adv_mass - USE CAM_HISTORY, ONLY : outfld, hist_fld_active - USE CONSTITUENTS, ONLY : cnst_name, sflxnam - USE DRYDEP_MOD, ONLY : depName, Ndvzind - USE CAMSRFEXCH, ONLY : cam_in_t - USE PHYSICS_TYPES, ONLY : physics_state - USE SPMD_UTILS, ONLY : MasterProc - USE PHYSCONST, ONLY : MWDry - USE UCX_MOD, ONLY : GET_STRAT_OPT!, AERFRAC - USE CMN_SIZE_MOD, ONLY : NDUST - USE CMN_FJX_MOD -! -! !INPUT PARAMETERS: -! + + ! CAM modules + use cam_history, only : outfld, hist_fld_active + use camsrfexch, only : cam_in_t + use chem_mods, only : adv_mass + use constituents, only : cnst_name, sflxnam + use physconst, only : MWDry + use physics_types, only : physics_state + use spmd_utils, only : MasterProc + + ! GEOS-Chem modules + use CMN_Size_Mod, only : NDUST + use DryDep_Mod, only : depName, Ndvzind + use Input_Opt_Mod, only : OptInput + use Precision_Mod, only : f8 + use Species_Mod, only : Species + use State_Chm_Mod, only : ChmState + use State_Diag_Mod, only : DgnState, get_TagInfo + use State_Grid_Mod, only : GrdState + use State_Met_Mod, only : MetState + use Registry_Mod, only : MetaRegItem, RegItem, Registry_Lookup + use UCX_Mod, only : GET_STRAT_OPT + TYPE(OptInput), INTENT(IN) :: Input_Opt ! Input options TYPE(ChmState), INTENT(INOUT) :: State_Chm ! Chemistry State object TYPE(DgnState), INTENT(IN) :: State_Diag ! Diag State object @@ -899,13 +839,7 @@ SUBROUTINE GC_Diagnostics_Calc( Input_Opt, State_Chm, State_Diag, & REAL(r8), INTENT(IN) :: mmr_tend(state%ncol,pver,gas_pcnst) ! Net tendency from chemistry in kg/s INTEGER, INTENT(IN) :: LCHNK ! Chunk number -! -! !REVISION HISTORY: -! 20 Oct 2020 - T. M. Fritz - Initial version -!EOP -!------------------------------------------------------------------------------ -!BOC -! + ! Integers INTEGER :: I, J, L, M, N, ND, SM INTEGER :: idx @@ -1428,9 +1362,7 @@ SUBROUTINE GC_Diagnostics_Calc( Input_Opt, State_Chm, State_Diag, & CALL Outfld( TRIM(SpcName), outTmp(:nY,:) , nY, LCHNK ) ENDIF - !======================================================================= - ! Cleanup and quit - !======================================================================= + ! Cleanup Current => NULL() Item => NULL() Ptr0d_8 => NULL() @@ -1439,7 +1371,6 @@ SUBROUTINE GC_Diagnostics_Calc( Input_Opt, State_Chm, State_Diag, & Ptr3d_8 => NULL() END SUBROUTINE GC_Diagnostics_Calc -!EOC -!------------------------------------------------------------------------------ + END MODULE GeosChem_Diagnostics_Mod diff --git a/src/chemistry/geoschem/geoschem_emissions_mod.F90 b/src/chemistry/geoschem/geoschem_emissions_mod.F90 index 37142e4d5b..9d9dfc6bd1 100644 --- a/src/chemistry/geoschem/geoschem_emissions_mod.F90 +++ b/src/chemistry/geoschem/geoschem_emissions_mod.F90 @@ -1,35 +1,21 @@ -!------------------------------------------------------------------------------ -! "GEOS-Chem" chemistry emissions interface ! -!------------------------------------------------------------------------------ -!BOP -! -! !MODULE: geoschem_emissions_mod.F90 -! -! !DESCRIPTION: Module geoschem\_emissions\_mod contains routines which retrieve -! emission fluxes from HEMCO and transfers it back to the CESM-GC interface -!\\ -!\\ -! !INTERFACE: -! +! Module geoschem_emissions_mod contains routines which retrieve +! emission fluxes from HEMCO and transfers it back to the CESM-GC interface +! 07 Oct 2020 - T. M. Fritz - Initial version MODULE GeosChem_Emissions_Mod -! -! !USES: -! - USE SHR_KIND_MOD, ONLY : r8 => shr_kind_r8, shr_kind_cl - USE SPMD_UTILS, ONLY : MasterProc - USE CAM_ABORTUTILS, ONLY : endrun - USE CHEM_MODS, ONLY : iFirstCnst - USE CONSTITUENTS, ONLY : pcnst, cnst_name - USE SHR_MEGAN_MOD, ONLY : shr_megan_mechcomps, shr_megan_mechcomps_n - USE CAM_LOGFILE, ONLY : iulog + + ! CAM modules + use cam_abortutils, only : endrun + use cam_logfile, only : iulog + use chem_mods, only : iFirstCnst + use constituents, only : pcnst, cnst_name + use shr_kind_mod, only : r8 => shr_kind_r8, shr_kind_cl + use shr_megan_mod, only : shr_megan_mechcomps, shr_megan_mechcomps_n + use spmd_utils, only : MasterProc IMPLICIT NONE PRIVATE -! -! !PUBLIC MEMBER FUNCTIONS: -! PUBLIC :: GC_Emissions_Init PUBLIC :: GC_Emissions_Calc PUBLIC :: GC_Emissions_Final @@ -54,47 +40,21 @@ MODULE GeosChem_Emissions_Mod ! Cache for is_extfrc? LOGICAL, ALLOCATABLE :: pcnst_is_extfrc(:) ! no idea why the indexing is not 1:gas_pcnst or why iFirstCnst can be < 0 -! -! !REVISION HISTORY: -! 07 Oct 2020 - T. M. Fritz - Initial version -! 20 Jan 2023 - H.P. Lin - Update for 2D/3D pbuf switches -!EOP -!------------------------------------------------------------------------------ -!BOC -! + CONTAINS -! -!EOC -!------------------------------------------------------------------------------ -!BOP -! -! !IROUTINE: gc_emissions_init -! -! !DESCRIPTION: Subroutine GC\_Emissions\_Init initializes the emissions -! routine -!\\ -!\\ -! !INTERFACE: -! + SUBROUTINE GC_Emissions_Init( ) -! -! !USES: -! - USE PHYSICS_TYPES, ONLY : physics_state - USE CONSTITUENTS, ONLY : cnst_get_ind - USE PHYS_CONTROL, ONLY : phys_getopts - USE MO_CHEM_UTLS, ONLY : get_spc_ndx, get_extfrc_ndx - USE CAM_HISTORY, ONLY : addfld, add_default, horiz_only - USE FIRE_EMISSIONS, ONLY : fire_emissions_init - USE CHEM_MODS, ONLY : adv_mass - USE INFNAN, ONLY : NaN, assignment(=) -! -! !REVISION HISTORY: -! 07 Oct 2020 - T. M. Fritz - Initial version -!EOP -!------------------------------------------------------------------------------ -!BOC -! + + ! CAM modules + use cam_history, only : addfld, add_default, horiz_only + use chem_mods, only : adv_mass + use constituents, only : cnst_get_ind + use fire_emissions, only : fire_emissions_init + use infnan, only : NaN, assignment(=) + use mo_chem_utls, only : get_spc_ndx, get_extfrc_ndx + use phys_control, only : phys_getopts + use physics_types, only : physics_state + ! Integers INTEGER :: IERR INTEGER :: N, II @@ -111,10 +71,6 @@ SUBROUTINE GC_Emissions_Init( ) ! Real REAL(r8) :: MW - !================================================================= - ! GC_Emissions_Init begins here! - !================================================================= - CALL phys_getopts( history_aerosol_out = history_aerosol, & history_chemistry_out = history_chemistry, & history_cesm_forcing_out = history_cesm_forcing ) @@ -247,73 +203,39 @@ SUBROUTINE GC_Emissions_Init( ) enddo END SUBROUTINE GC_Emissions_Init -!EOC -!------------------------------------------------------------------------------ -!BOP -! -! !IROUTINE: gc_emissions_calc -! -! !DESCRIPTION: Subroutine GC\_Emissions\_Calc retrieves emission fluxes -! from HEMCO and returns a 3-D array of emission flux to the CESM-GC -! interface. On top of passing data, this routine handles a number of checks. -!\\ -!\\ -! !INTERFACE: -! + SUBROUTINE GC_Emissions_Calc( state, hco_pbuf2d, State_Met, cam_in, eflx, iStep ) -! -! !USES: -! - USE State_Met_Mod, ONLY : MetState - USE CAMSRFEXCH, ONLY : cam_in_t - USE CONSTITUENTS, ONLY : cnst_get_ind, cnst_mw - USE PHYSICS_TYPES, ONLY : physics_state - USE PHYSICS_BUFFER, ONLY : pbuf_get_index, pbuf_get_chunk - USE PHYSICS_BUFFER, ONLY : physics_buffer_desc, pbuf_get_field - USE PPGRID, ONLY : pcols, pver, begchunk - USE CAM_HISTORY, ONLY : outfld - USE STRING_UTILS, ONLY : to_upper - USE PHYSCONSTANTS, ONLY : PI - - ! Lightning emissions - USE MO_LIGHTNING, ONLY : prod_NO - - ! MEGAN emissions - USE SRF_FIELD_CHECK, ONLY : active_Fall_flxvoc - - ! Fire emissions - USE FIRE_EMISSIONS, ONLY : fire_emissions_srf - USE FIRE_EMISSIONS, ONLY : fire_emissions_vrt - - ! Aerosol emissions - USE AERO_MODEL, ONLY : aero_model_emissions - - ! GEOS-Chem version of physical constants - USE PHYSCONSTANTS, ONLY : AVO - ! CAM version of physical constants - USE PHYSCONST, ONLY : rga, avogad -! -! !INPUT PARAMETERS: -! + ! Subroutine GC_Emissions_Calc retrieves emission fluxes + ! from HEMCO and returns a 3-D array of emission flux to the CESM-GC + ! interface. On top of passing data, this routine handles a number of checks. + + ! CAM modules + use aero_model, only : aero_model_emissions ! Aerosol emissions + use cam_history, only : outfld + use camsrfexch, only : cam_in_t + use constituents, only : cnst_get_ind, cnst_mw + use fire_emissions, only : fire_emissions_srf, fire_emissions_vrt ! Fire emissions + use mo_lightning, only : prod_NO! Lightning emissions + use physconst, only : rga, avogad + use physics_buffer, only : pbuf_get_index, pbuf_get_chunk + use physics_buffer, only : physics_buffer_desc, pbuf_get_field + use physics_types, only : physics_state + use ppgrid, only : pcols, pver, begchunk + use srf_field_check, only : active_Fall_flxvoc ! MEGAN emissions + use string_utils, only : to_upper + + ! GEOS-Chem modules + use PhysConstants, only : AVO, PI + use State_Met_Mod, only : MetState + TYPE(physics_state), INTENT(IN ) :: state ! Physics state variables TYPE(physics_buffer_desc), POINTER, INTENT(IN ) :: hco_pbuf2d(:,:) ! Pointer to 2-D pbuf TYPE(MetState), INTENT(IN ) :: State_Met ! Meteorology State object INTEGER, INTENT(IN ) :: iStep -! -! !OUTPUT PARAMETERS: -! - TYPE(cam_in_t), INTENT(INOUT) :: cam_in ! import state + + TYPE(cam_in_t), INTENT(INOUT) :: cam_in ! import state REAL(r8), INTENT( OUT) :: eflx(pcols,pver,pcnst) ! 3-D emissions in kg/m2/s -! -! !REVISION HISTORY: -! 07 Oct 2020 - T. M. Fritz - Initial version -! 06 Mar 2023 - H.P. Lin - Now emit surface fluxes directly -!EOP -!------------------------------------------------------------------------------ -!BOC -! -! !LOCAL VARIABLES: -! + ! Integers INTEGER :: LCHNK INTEGER :: nY, nZ @@ -342,10 +264,7 @@ SUBROUTINE GC_Emissions_Calc( state, hco_pbuf2d, State_Met, cam_in, eflx, iStep CHARACTER(LEN=shr_kind_cl) :: SpcName CHARACTER(LEN=shr_kind_cl) :: fldname_ns ! field name HCO_* - !================================================================= - ! GC_Emissions_Calc begins here! - !================================================================= - + ! Initialize pointers pbuf_chnk => NULL() pbuf_ik => NULL() @@ -602,34 +521,12 @@ SUBROUTINE GC_Emissions_Calc( state, hco_pbuf2d, State_Met, cam_in, eflx, iStep ! eflx(1:nY,nZ,:) = 0.0e+00_r8 END SUBROUTINE GC_Emissions_Calc -!EOC -!------------------------------------------------------------------------------ -!BOP -! -! !IROUTINE: gc_emissions_final -! -! !DESCRIPTION: Subroutine GC\_Emissions\_Final cleans up the module -!\\ -!\\ -! !INTERFACE: -! + SUBROUTINE GC_Emissions_Final -! -! !REVISION HISTORY: -! 07 Oct 2020 - T. M. Fritz - Initial version -!EOP -!------------------------------------------------------------------------------ -!BOC -! - !================================================================= - ! GC_Emissions_Final begins here! - !================================================================= IF ( ALLOCATED( megan_indices_map ) ) DEALLOCATE( megan_indices_map ) IF ( ALLOCATED( megan_wght_factors ) ) DEALLOCATE( megan_wght_factors ) END SUBROUTINE GC_Emissions_Final -!EOC -!------------------------------------------------------------------------------ -!EOC - END MODULE GeosChem_Emissions_Mod + +END MODULE GeosChem_Emissions_Mod diff --git a/src/chemistry/geoschem/geoschem_history_mod.F90 b/src/chemistry/geoschem/geoschem_history_mod.F90 index 40da3f37dc..ef4c2044e1 100644 --- a/src/chemistry/geoschem/geoschem_history_mod.F90 +++ b/src/chemistry/geoschem/geoschem_history_mod.F90 @@ -22,11 +22,17 @@ MODULE GeosChem_History_Mod ! ! !USES: ! - USE DiagList_Mod - USE TaggedDiagList_Mod - USE ErrCode_Mod - USE Precision_Mod - + ! CAM modules + USE cam_abortutils, ONLY : endrun + + ! GEOS-Chem modules + USE DiagList_Mod, ONLY : DgnItem, DgnList + USE DiagList_Mod, ONLY : Init_DiagList, Print_DiagList + USE ErrCode_Mod, ONLY : GC_SUCCESS, GC_FAILURE, GC_ERROR + USE Precision_Mod, ONLY : fp, f4, f8 + USE TaggedDiagList_Mod, ONLY : TaggedDgnList + USE TaggedDiagList_Mod, ONLY : Init_TaggedDiagList, Print_TaggedDiagList + IMPLICIT NONE PRIVATE ! @@ -201,9 +207,10 @@ SUBROUTINE Init_HistoryExportsList ( am_I_Root, HistoryConfig, RC ) ! ! !USES: ! - USE State_Chm_Mod, ONLY: Get_Metadata_State_Chm - USE State_Diag_Mod, ONLY: Get_Metadata_State_Diag - USE State_Met_Mod, ONLY: Get_Metadata_State_Met + ! GEOS-Chem modules + USE State_Chm_Mod, ONLY : Get_Metadata_State_Chm + USE State_Diag_Mod, ONLY : Get_Metadata_State_Diag + USE State_Met_Mod, ONLY : Get_Metadata_State_Met ! ! !INPUT PARAMETERS: ! @@ -643,8 +650,11 @@ SUBROUTINE HistoryExports_SetServices( am_I_Root, config_file, & ! ! !USES: ! - USE cam_history, only: addfld, add_default, horiz_only - USE Registry_Params_Mod + ! CAM modules + USE cam_history, ONLY : addfld, add_default, horiz_only + + ! GEOS-Chem modules + USE Registry_Params_Mod, ONLY : VLocationCenter, VLocationEdge ! ! !INPUT PARAMETERS: ! @@ -769,12 +779,14 @@ SUBROUTINE CopyGCStates2Exports( am_I_Root, Input_Opt, State_Grid, HistoryConfig ! ! !USES: ! - USE HCO_Interface_GC_Mod, ONLY : HCOI_GC_WriteDiagn - USE Input_Opt_Mod, ONLY : OptInput - USE State_Grid_Mod, ONLY : GrdState - - USE cam_history, ONLY : hist_fld_active, outfld - USE SHR_KIND_MOD, ONLY : shr_kind_r8 + ! CAM modules + USE cam_history, ONLY : hist_fld_active, outfld + USE shr_kind_mod, ONLY : shr_kind_r8 + + ! GEOS-Chem modules + USE HCO_Interface_GC_Mod, ONLY : HCOI_GC_WriteDiagn + USE Input_Opt_Mod, ONLY : OptInput + USE State_Grid_Mod, ONLY : GrdState ! ! !INPUT PARAMETERS: ! @@ -987,14 +999,15 @@ SUBROUTINE HistoryExports_SetDataPointers( am_I_Root, & ! ! !USES: ! + ! CAM modules + USE cam_history, ONLY : hist_fld_active + + ! GEOS-Chem modules USE Registry_Mod, ONLY : Registry_Lookup - USE State_Grid_Mod, ONLY : GrdState USE State_Chm_Mod, ONLY : ChmState USE State_Diag_Mod, ONLY : DgnState + USE State_Grid_Mod, ONLY : GrdState USE State_Met_Mod, ONLY : MetState - USE Registry_Params_Mod - - use cam_history, only: hist_fld_active ! ! !INPUT PARAMETERS: ! diff --git a/src/control/cam_comp.F90 b/src/control/cam_comp.F90 index 3bb1052288..9982df6d2c 100644 --- a/src/control/cam_comp.F90 +++ b/src/control/cam_comp.F90 @@ -80,7 +80,6 @@ subroutine cam_init( & use cam_restart, only: cam_read_restart use stepon, only: stepon_init use ionosphere_interface, only: ionosphere_init - use camsrfexch, only: hub2atm_alloc, atm2hub_alloc use cam_history, only: intht use history_scam, only: scm_intht diff --git a/src/control/runtime_opts.F90 b/src/control/runtime_opts.F90 index f40d24d50f..3f95e1c704 100644 --- a/src/control/runtime_opts.F90 +++ b/src/control/runtime_opts.F90 @@ -105,10 +105,6 @@ subroutine read_namelist(nlfilename, single_column, scmlat, scmlon) use phys_grid_ctem, only: phys_grid_ctem_readnl use mo_lightning, only: lightning_readnl -#if (defined HEMCO_CESM) - use hemco_interface, only: hemco_readnl -#endif - !---------------------------Arguments----------------------------------- character(len=*), intent(in) :: nlfilename From a889343ee9d423b1a70f2b110c8477cde6c019cb Mon Sep 17 00:00:00 2001 From: Brian Eaton Date: Thu, 7 Sep 2023 10:46:06 -0400 Subject: [PATCH 141/291] refactor modified_cloud_fraction --- src/physics/rrtmgp/radiation.F90 | 152 +++++++++++++++---------------- 1 file changed, 72 insertions(+), 80 deletions(-) diff --git a/src/physics/rrtmgp/radiation.F90 b/src/physics/rrtmgp/radiation.F90 index bb1bb1df32..fc66554bd8 100644 --- a/src/physics/rrtmgp/radiation.F90 +++ b/src/physics/rrtmgp/radiation.F90 @@ -162,7 +162,7 @@ module radiation ! initial or restart run logical :: use_rad_dt_cosz = .false. ! if true, use radiation dt for all cosz calculations logical :: spectralflux = .false. ! calculate fluxes (up and down) per band. -logical :: graupel_in_rad = .false. ! graupel in radiation code +logical :: graupel_in_rad = .false. ! graupel in radiation code logical :: use_rad_uniform_angle = .false. ! if true, use the namelist rad_uniform_angle for the coszrs calculation ! active_calls is set by a rad_constituents method after parsing namelist input @@ -227,9 +227,9 @@ module radiation type(var_desc_t) :: cospcnt_desc ! cosp type(var_desc_t) :: nextsw_cday_desc -!=============================================================================== +!========================================================================================= contains -!=============================================================================== +!========================================================================================= subroutine radiation_readnl(nlfile) @@ -517,6 +517,10 @@ subroutine radiation_init(pbuf2d) call cloud_rad_props_init() + cld_idx = pbuf_get_index('CLD') + cldfsnow_idx = pbuf_get_index('CLDFSNOW',errcode=ierr) + cldfgrau_idx = pbuf_get_index('CLDFGRAU',errcode=ierr) + if (is_first_step()) then call pbuf_set_field(pbuf2d, qrl_idx, 0._r8) end if @@ -539,9 +543,8 @@ subroutine radiation_init(pbuf2d) history_budget_out = history_budget, & history_budget_histfile_num_out = history_budget_histfile_num) - ! "irad_always" is number of time steps to execute radiation - ! continuously from start of initial OR restart run - ! _This gets used in radiation_do_ + ! "irad_always" is number of time steps to execute radiation continuously from + ! start of initial OR restart run nstep = get_nstep() if (irad_always > 0) then nstep = get_nstep() @@ -557,7 +560,6 @@ subroutine radiation_init(pbuf2d) cosp_cnt(begchunk:endchunk) = 0 end if - ! Add fields to history buffer call addfld('TOT_CLD_VISTAU', (/ 'lev' /), 'A', '1', & @@ -573,6 +575,17 @@ subroutine radiation_init(pbuf2d) 'Ice in-cloud extinction visible sw optical depth', & sampling_seq='rad_lwsw', flag_xyfill=.true.) + if (cldfsnow_idx > 0) then + call addfld('SNOW_ICLD_VISTAU', (/ 'lev' /), 'A', '1', & + 'Snow in-cloud extinction visible sw optical depth', & + sampling_seq='rad_lwsw', flag_xyfill=.true.) + end if + if (cldfgrau_idx > 0 .and. graupel_in_rad) then + call addfld('GRAU_ICLD_VISTAU', (/ 'lev' /), 'A', '1', & + 'Graupel in-cloud extinction visible sw optical depth', & + sampling_seq='rad_lwsw', flag_xyfill=.true.) + endif + ! get list of active radiation calls call rad_cnst_get_call_list(active_calls) @@ -638,7 +651,7 @@ subroutine radiation_init(pbuf2d) call addfld('FUSC'//diag(icall), (/ 'ilev' /), 'I', 'W/m2', 'Shortwave clear-sky upward flux') call addfld('FDSC'//diag(icall), (/ 'ilev' /), 'I', 'W/m2', 'Shortwave clear-sky downward flux') - ! Fluxes on rrtmgp grid + ! Fluxes on RRTMGP grid call addfld('FSDN'//diag(icall), (/ 'plev_rad' /), 'I', 'W/m2', 'SW downward flux on rrtmgp grid') call addfld('FSDNC'//diag(icall), (/ 'plev_rad' /), 'I', 'W/m2', 'SW downward clear sky flux on rrtmgp grid') call addfld('FSUP'//diag(icall), (/ 'plev_rad' /), 'I', 'W/m2', 'SW upward flux on rrtmgp grid') @@ -662,6 +675,13 @@ subroutine radiation_init(pbuf2d) end if end do + if (scm_crm_mode) then + call add_default('FUS ', 1, ' ') + call add_default('FUSC ', 1, ' ') + call add_default('FDS ', 1, ' ') + call add_default('FDSC ', 1, ' ') + endif + ! Add longwave radiation fields to history master field list. do icall = 0, N_DIAG @@ -721,9 +741,14 @@ subroutine radiation_init(pbuf2d) end if end do - call addfld('EMIS', (/ 'lev' /), 'A', '1', 'Cloud longwave emissivity') ! COSP-related output + call addfld('EMIS', (/ 'lev' /), 'A', '1', 'Cloud longwave emissivity') - ! NOTE: HIRS/MSU diagnostic brightness temperatures are removed. + if (scm_crm_mode) then + call add_default ('FUL ', 1, ' ') + call add_default ('FULC ', 1, ' ') + call add_default ('FDL ', 1, ' ') + call add_default ('FDLC ', 1, ' ') + endif ! Heating rate needed for d(theta)/dt computation call addfld ('HR',(/ 'lev' /), 'A','K/s','Heating rate needed for d(theta)/dt computation') @@ -738,20 +763,6 @@ subroutine radiation_init(pbuf2d) call add_default('FLUT', 3, ' ') end if - cld_idx = pbuf_get_index('CLD') - cldfsnow_idx = pbuf_get_index('CLDFSNOW',errcode=ierr) - cldfgrau_idx = pbuf_get_index('CLDFGRAU',errcode=ierr) - if (cldfsnow_idx > 0) then - call addfld('SNOW_ICLD_VISTAU', (/ 'lev' /), 'A', '1', & - 'Snow in-cloud extinction visible sw optical depth', & - sampling_seq='rad_lwsw', flag_xyfill=.true.) - end if - if (cldfgrau_idx > 0 .and. graupel_in_rad) then - call addfld('GRAU_ICLD_VISTAU', (/ 'lev' /), 'A', '1', & - 'Graupel in-cloud extinction visible sw optical depth', & - sampling_seq='rad_lwsw', flag_xyfill=.true.) - endif - end subroutine radiation_init !=============================================================================== @@ -913,8 +924,8 @@ subroutine radiation_tend( & integer :: itim_old real(r8), pointer :: cld(:,:) ! cloud fraction - real(r8), pointer :: cldfsnow(:,:) ! cloud fraction of just "snow clouds"- whatever they are - real(r8), pointer :: cldfgrau(:,:) ! cloud fraction of just "graupel clouds"- whatever they are + real(r8), pointer :: cldfsnow(:,:) => null() ! cloud fraction of just "snow clouds"- whatever they are + real(r8), pointer :: cldfgrau(:,:) => null() ! cloud fraction of just "graupel clouds"- whatever they are real(r8), pointer :: qrs(:,:) => null() ! shortwave radiative heating rate real(r8), pointer :: qrl(:,:) => null() ! longwave radiative heating rate real(r8), pointer :: fsds(:) ! Surface solar down flux @@ -1011,10 +1022,8 @@ subroutine radiation_tend( & type(ty_optical_props_1scl) :: aer_lw type(ty_optical_props_2str) :: aer_sw - ! Fluxes - ! These are used locally only. SW fluxes are on day columns only. - ! "Output" (i.e. diagnostic) fluxes are provided with rd, fsns, fcns, fnl, fcnl, etc. - ! see set_sw_diags and radiation_output_sw and radiation_output_lw + ! Flux objects contain all fluxes computed by RRTMGP. Includes spectrally resolved and + ! total fluxes for all levels of the RRTMGP grid. type(ty_fluxes_byband) :: fsw, fswc type(ty_fluxes_byband) :: flw, flwc @@ -1024,9 +1033,10 @@ subroutine radiation_tend( & real(r8) :: fcnl(pcols,pverp) ! net clear-sky longwave flux - real(r8) :: emis(pcols,pver) ! Cloud longwave emissivity ! for COSP - real(r8) :: gb_snow_tau(pcols,pver) ! grid-box mean snow_tau ! for COSP - real(r8) :: gb_snow_lw(pcols,pver) ! grid-box mean LW snow optical depth ! for COSP + ! for COSP + real(r8) :: emis(pcols,pver) ! Cloud longwave emissivity + real(r8) :: gb_snow_tau(pcols,pver) ! grid-box mean snow_tau + real(r8) :: gb_snow_lw(pcols,pver) ! grid-box mean LW snow optical depth real(r8) :: ftem(pcols,pver) ! Temporary workspace for outfld variables @@ -1037,9 +1047,6 @@ subroutine radiation_tend( & logical :: conserve_energy = .false. ! Flag to carry (QRS,QRL)*dp across time steps. - integer :: iband - real(r8) :: mem_hw_end, mem_hw_beg, mem_end, mem_beg, temp - !-------------------------------------------------------------------------------------- lchnk = state%lchnk @@ -1095,11 +1102,7 @@ subroutine radiation_tend( & ! Associate pointers to physics buffer fields itim_old = pbuf_old_tim_idx() if (cldfsnow_idx > 0) then - call pbuf_get_field(pbuf, & - cldfsnow_idx, & - cldfsnow, & - start=(/1,1,itim_old/), & - kount=(/pcols,pver,1/) ) + call pbuf_get_field(pbuf, cldfsnow_idx, cldfsnow, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) end if if (cldfgrau_idx > 0 .and. graupel_in_rad) then call pbuf_get_field(pbuf, cldfgrau_idx, cldfgrau, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) @@ -1139,8 +1142,7 @@ subroutine radiation_tend( & ! Find tropopause height if needed for diagnostic output if (hist_fld_active('FSNR') .or. hist_fld_active('FLNR')) then - call tropopause_find(state, troplev, tropP=p_trop, & - primary=TROP_ALG_HYBSTOB, & + call tropopause_find(state, troplev, tropP=p_trop, primary=TROP_ALG_HYBSTOB, & backup=TROP_ALG_CLIMATE) end if @@ -1183,19 +1185,14 @@ subroutine radiation_tend( & t_rad, pmid_rad, pint_rad, t_day, pmid_day, & pint_day, coszrs_day, alb_dir, alb_dif) - ! Set TSI used in rrtmgp to the value from CAM's solar forcing file. + ! Set TSI for RRTMGP to the value from CAM's solar forcing file. errmsg = kdist_sw%set_tsi(sol_tsi) if (len_trim(errmsg) > 0) then call endrun(sub//': ERROR: kdist_sw%set_tsi: '//trim(errmsg)) end if - ! check bounds for temperature -- These are specified in the coefficients file, - ! and RRTMGP will not operate if outside the specified range. - call clipper(t_day, kdist_lw%get_temp_min(), kdist_lw%get_temp_max()) - call clipper(t_rad, kdist_lw%get_temp_min(), kdist_lw%get_temp_max()) - - ! Modify cloud fraction to account for radiatively active snow and/or graupel - call modified_cloud_fraction(cld, cldfsnow, cldfgrau, cldfsnow_idx, cldfgrau_idx, cldfprime) + ! Modified cloud fraction accounts for radiatively active snow and/or graupel + call modified_cloud_fraction(ncol, cld, cldfsnow, cldfgrau, cldfprime) if (dosw) then @@ -1293,10 +1290,6 @@ subroutine radiation_tend( & ! At this point we have cloud optical properties including snow and graupel, ! but they need to be re-ordered from the old RRTMG spectral bands to RRTMGP's - ! - ! Mapping from old RRTMG sw bands to new band ordering in RRTMGP - ! 1. This should be automated to provide generalization to arbitrary spectral grid. - ! 2. This is used for setting cloud and aerosol optical properties, so probably should be put into a different module. c_cld_tau(:,1:ncol,1:pver) = c_cld_tau (rrtmg_to_rrtmgp_swbands, 1:ncol, 1:pver) c_cld_tau_w(:,1:ncol,1:pver) = c_cld_tau_w (rrtmg_to_rrtmgp_swbands, 1:ncol, 1:pver) c_cld_tau_w_g(:,1:ncol,1:pver) = c_cld_tau_w_g(rrtmg_to_rrtmgp_swbands, 1:ncol, 1:pver) @@ -2766,6 +2759,7 @@ subroutine initialize_rrtmgp_fluxes(ncol, nlevels, nbands, fluxes, do_direct) end subroutine initialize_rrtmgp_fluxes +!========================================================================================= subroutine initialize_rrtmgp_cloud_optics_sw(ncol, nlevels, kdist, optics) ! use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp ! module level @@ -2845,31 +2839,29 @@ subroutine free_fluxes(fluxes) if (associated(fluxes%bnd_flux_dn_dir)) deallocate(fluxes%bnd_flux_dn_dir) end subroutine free_fluxes +!========================================================================================= -subroutine modified_cloud_fraction(cld, cldfsnow, cldfgrau, cldfsnow_idx, cldfgrau_idx, cldfprime) - real(r8), pointer :: cld(:,:) ! cloud fraction - real(r8), pointer :: cldfsnow(:,:) ! cloud fraction of just "snow clouds"- whatever they are - real(r8), pointer :: cldfgrau(:,:) ! cloud fraction of just "graupel clouds"- whatever they are - integer, intent(in) :: cldfsnow_idx ! physics buffer index for snow cloud fraction - integer, intent(in) :: cldfgrau_idx ! physics buffer index for graupel cloud fraction - real(r8), intent(inout) :: cldfprime(:,:) ! combined cloud fraction (snow plus regular) - integer :: k,i,ncol,nlev - - ! graupel_in_rad is module data from namelist. - ! pcols is "physics columns" and comes from module data. - ! pver is "physics vertical levels" and comes from module data. +subroutine modified_cloud_fraction(ncol, cld, cldfsnow, cldfgrau, cldfprime) + ! Compute modified cloud fraction, cldfprime. ! 1. initialize as cld - ! 2. check whether to modify for snow, where snow is, use max(cld, cldfsnow) - ! 3. check whether to modify for graupel, where graupel, use max(cldfprime, cldfgrau) - ! -- use cldfprime as it will already be modified for snow if necessary, and equal to cld if not. + ! 2. modify for snow if cldfsnow is available. use max(cld, cldfsnow) + ! 3. modify for graupel if cldfgrau is available and graupel_in_rad is true. + ! use max(cldfprime, cldfgrau) - ncol = size(cld,1) - nlev = size(cld,2) - cldfprime(1:ncol, 1:nlev) = cld(1:ncol, 1:nlev) ! originally nlev here was pver + ! Arguments + integer, intent(in) :: ncol + real(r8), pointer :: cld(:,:) ! cloud fraction + real(r8), pointer :: cldfsnow(:,:) ! cloud fraction of just "snow clouds" + real(r8), pointer :: cldfgrau(:,:) ! cloud fraction of just "graupel clouds" + real(r8), intent(out) :: cldfprime(:,:) ! modified cloud fraction - if (cldfsnow_idx > 0) then - do k = 1, nlev + ! Local variables + integer :: i, k + !---------------------------------------------------------------------------- + + if (associated(cldfsnow)) then + do k = 1, pver do i = 1, ncol cldfprime(i,k) = max(cld(i,k), cldfsnow(i,k)) end do @@ -2878,8 +2870,8 @@ subroutine modified_cloud_fraction(cld, cldfsnow, cldfgrau, cldfsnow_idx, cldfgr cldfprime(:ncol,:) = cld(:ncol,:) end if - if (cldfgrau_idx > 0 .and. graupel_in_rad) then - do k = 1, nlev + if (associated(cldfgrau) .and. graupel_in_rad) then + do k = 1, pver do i = 1, ncol cldfprime(i,k) = max(cldfprime(i,k), cldfgrau(i,k)) end do @@ -2888,9 +2880,8 @@ subroutine modified_cloud_fraction(cld, cldfsnow, cldfgrau, cldfsnow_idx, cldfgr end subroutine modified_cloud_fraction -! -! a simple clipping subroutine -! +!========================================================================================= + elemental subroutine clipper(scalar, minval, maxval) real(r8), intent(inout) :: scalar real(r8), intent(in) :: minval, maxval @@ -2904,6 +2895,7 @@ elemental subroutine clipper(scalar, minval, maxval) end if end subroutine clipper +!========================================================================================= end module radiation From 4752c0ae278f28271e83e1964d2546af93feb027 Mon Sep 17 00:00:00 2001 From: Brian Eaton Date: Thu, 7 Sep 2023 11:52:29 -0400 Subject: [PATCH 142/291] bug fix - pmid_day arg should not have levels reversed --- src/physics/rrtmgp/radiation.F90 | 20 ++++---------------- 1 file changed, 4 insertions(+), 16 deletions(-) diff --git a/src/physics/rrtmgp/radiation.F90 b/src/physics/rrtmgp/radiation.F90 index fc66554bd8..fe8a6665cc 100644 --- a/src/physics/rrtmgp/radiation.F90 +++ b/src/physics/rrtmgp/radiation.F90 @@ -1298,20 +1298,10 @@ subroutine radiation_tend( & ! cloud_sw : cloud optical properties. call initialize_rrtmgp_cloud_optics_sw(nday, nlay, kdist_sw, cloud_sw) - call rrtmgp_set_cloud_sw( & ! the result cloud_sw is gpoints ("quadrature" points) - nswbands, & ! input - nday, & ! input - nlay, & ! input - idxday(1:ncol), & ! input, [require to truncate to 1 to ncol b/c the array is size pcol] - pmid_day(:,nlay:1:-1), & ! input - cldfprime, & ! input - c_cld_tau, & ! input - c_cld_tau_w, & ! input - c_cld_tau_w_g, & ! input - c_cld_tau_w_f, & ! input - kdist_sw, & ! input - cloud_sw & ! inout, outputs %g, %ssa, %tau - ) + call rrtmgp_set_cloud_sw( & + nswbands, nday, nlay, idxday, pmid_day, & + cldfprime, c_cld_tau, c_cld_tau_w, c_cld_tau_w_g, c_cld_tau_w_f, & + kdist_sw, cloud_sw) ! allocate object for aerosol optics errmsg = aer_sw%alloc_2str(nday, nlay, kdist_sw%get_band_lims_wavenumber(), & @@ -1324,8 +1314,6 @@ subroutine radiation_tend( & ! SHORTWAVE DIAGNOSTICS & OUTPUT ! ! cloud optical depth fields for the visible band - ! This uses idx_sw_diag to get a specific band; - ! is hard-coded in radconstants and is correct for RRTMGP ordering. rd%tot_icld_vistau(:ncol,:) = c_cld_tau(idx_sw_diag,:ncol,:) ! should be equal to cloud_sw%tau except ordering rd%liq_icld_vistau(:ncol,:) = liq_tau(idx_sw_diag,:ncol,:) rd%ice_icld_vistau(:ncol,:) = ice_tau(idx_sw_diag,:ncol,:) From ac9e5471bed4e9a0015ab2b59a51dba5b698bbea Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Thu, 7 Sep 2023 09:28:38 -0600 Subject: [PATCH 143/291] rename optional arg compare_uppercase; use spmd_utils and mpi_bcast --- src/chemistry/geoschem/chemistry.F90 | 100 +++++++++++------- .../geoschem/geoschem_diagnostics_mod.F90 | 94 ++++++++-------- src/chemistry/mozart/mo_chem_utls.F90 | 8 +- 3 files changed, 113 insertions(+), 89 deletions(-) diff --git a/src/chemistry/geoschem/chemistry.F90 b/src/chemistry/geoschem/chemistry.F90 index 4bf7fbaa67..2466a80779 100644 --- a/src/chemistry/geoschem/chemistry.F90 +++ b/src/chemistry/geoschem/chemistry.F90 @@ -434,7 +434,7 @@ subroutine chem_register map2GCinv(M) = N ENDIF ! Map constituent onto chemically-active species (aka as indexed in solsym) - M = get_spc_ndx(TRIM(trueName), compare_uppercase=.true.) + M = get_spc_ndx(TRIM(trueName), ignore_case=.true.) IF ( M > 0 ) THEN mapCnst(N) = M ENDIF @@ -496,7 +496,7 @@ subroutine chem_register ! The species names need to be convert to upper case as, ! for instance, BR2 != Br2 - drySpc_ndx(N) = get_spc_ndx( to_upper(drydep_list(N)), compare_uppercase=.true. ) + drySpc_ndx(N) = get_spc_ndx( to_upper(drydep_list(N)), ignore_case=.true. ) if (debug .and. masterproc) write(iulog,'(a,a,a,i4,a,i4)') ' -> species ', trim(drydep_list(N)), ' in dry deposition list at index ', N, ' maps to species in solsym at index ', drySpc_ndx(N) @@ -644,14 +644,13 @@ subroutine chem_readnl(nlfile) use gckpp_Model, only : nSpec, Spc_Names use namelist_utils, only : find_group_name use mo_lightning, only : lightning_readnl + use spmd_utils, only : mpicom, masterprocid, mpi_success + use spmd_utils, only : mpi_character, mpi_integer, mpi_logical use units, only : getunit, freeunit #if defined( MODAL_AERO ) use aero_model, only : aero_model_readnl use dust_model, only : dust_readnl #endif -#ifdef SPMD - use mpishorthand -#endif ! args CHARACTER(LEN=*), INTENT(IN) :: nlfile ! filepath for file containing namelist input @@ -661,6 +660,7 @@ subroutine chem_readnl(nlfile) INTEGER :: UNITN, IERR, RC CHARACTER(LEN=500) :: line CHARACTER(LEN=63) :: substrs(2) + CHARACTER(LEN=*), PARAMETER :: subname = 'chem_readnl' LOGICAL :: validSLS, v_bool ! Assume a successful return until otherwise @@ -837,17 +837,40 @@ subroutine chem_readnl(nlfile) !---------------------------------------------------------- ! Broadcast to all processors !---------------------------------------------------------- - - CALL MPIBCAST ( nTracers, 1, MPIINT, 0, MPICOM ) - CALL MPIBCAST ( tracerNames, LEN(tracerNames(1))*nTracersMax, MPICHAR, 0, MPICOM ) - CALL MPIBCAST ( nSls, 1, MPIINT, 0, MPICOM ) - CALL MPIBCAST ( slsNames, LEN(slsNames(1))*nSlsMax, MPICHAR, 0, MPICOM ) + CALL mpi_bcast(nTracers, 1, mpi_integer, masterprocid, mpicom, ierr) + IF ( ierr /= mpi_success ) then + CALL endrun(subname//': MPI_BCAST ERROR: nTracers') + ENDIF + CALL mpi_bcast(tracerNames, LEN(tracerNames(1))*nTracersMax, mpi_character, masterprocid, mpicom, ierr) + IF ( ierr /= mpi_success ) then + CALL endrun(subname//': MPI_BCAST ERROR: tracerNames') + ENDIF + CALL mpi_bcast(nSls, 1, mpi_integer, masterprocid, mpicom, ierr) + IF ( ierr /= mpi_success ) then + CALL endrun(subname//': MPI_BCAST ERROR: nSls') + ENDIF + CALL mpi_bcast(slsNames, LEN(slsNames(1))*nSlsMax, mpi_character, masterprocid, mpicom, ierr) + IF ( ierr /= mpi_success ) then + CALL endrun(subname//': MPI_BCAST ERROR: slsNames') + ENDIF ! Broadcast namelist variables - CALL MPIBCAST (depvel_lnd_file, LEN(depvel_lnd_file), MPICHAR, 0, MPICOM) - CALL MPIBCAST (ghg_chem, 1, MPILOG, 0, MPICOM) - CALL MPIBCAST (bndtvg, LEN(bndtvg), MPICHAR, 0, MPICOM) - CALL MPIBCAST (h2orates, LEN(h2orates), MPICHAR, 0, MPICOM) + CALL mpi_bcast(depvel_lnd_file, LEN(depvel_lnd_file), mpi_character, masterprocid, mpicom, ierr) + IF ( ierr /= mpi_success ) then + CALL endrun(subname//': MPI_BCAST ERROR: depvel_lnd_file') + ENDIF + CALL mpi_bcast(ghg_chem, 1, mpi_logical, masterprocid, mpicom, ierr) + IF ( ierr /= mpi_success ) then + CALL endrun(subname//': MPI_BCAST ERROR: ghg_chem') + ENDIF + CALL mpi_bcast(bndtvg, LEN(bndtvg), mpi_character, masterprocid, mpicom, ierr) + IF ( ierr /= mpi_success ) then + CALL endrun(subname//': MPI_BCAST ERROR: bndtvg') + ENDIF + CALL mpi_bcast(h2orates, LEN(h2orates), mpi_character, masterprocid, mpicom, ierr) + IF ( ierr /= mpi_success ) then + CALL endrun(subname//': MPI_BCAST ERROR: h2orates') + ENDIF IF ( nSls .NE. nSlvd ) THEN write(iulog,'(a,i4)') 'nSlvd in geoschem/chem_mods.F90 does not match # non-advected KPP species. Set nSlvd to ', nSls @@ -921,11 +944,9 @@ subroutine chem_init(phys_state, pbuf2d) use mo_setinv, only : setinv_inti use Phys_Grid, only : get_Area_All_p use physics_buffer, only : physics_buffer_desc, pbuf_get_index + use spmd_utils, only : mpicom, masterprocid, mpi_real8, mpi_success use tracer_cnst, only : tracer_cnst_init use tracer_srcs, only : tracer_srcs_init -#ifdef SPMD - use mpishorthand -#endif #if defined( MODAL_AERO ) use aero_model, only : aero_model_init use mo_setsox, only : sox_inti @@ -984,8 +1005,9 @@ subroutine chem_init(phys_state, pbuf2d) LOGICAL :: Found ! Strings - CHARACTER(LEN=shr_kind_cl) :: historyConfigFile - CHARACTER(LEN=shr_kind_cl) :: SpcName + CHARACTER(LEN=shr_kind_cl) :: historyConfigFile + CHARACTER(LEN=shr_kind_cl) :: SpcName + CHARACTER(LEN=*), PARAMETER :: subname = 'chem_init' ! Objects TYPE(Species), POINTER :: SpcInfo @@ -1225,7 +1247,10 @@ subroutine chem_init(phys_state, pbuf2d) ! Copy the data to a temporary array linozData = REAL(Input_Opt%LINOZ_TPARM, r8) ENDIF - CALL MPIBCAST( linozData, nLinoz, MPIR8, 0, MPICOM ) + CALL mpi_bcast(linozData, nLinoz, mpi_real8, masterprocid, mpicom, ierr) + IF ( ierr /= mpi_success ) then + CALL endrun(subname//': MPI_BCAST ERROR: linozData') + ENDIF IF ( .NOT. MasterProc ) THEN Input_Opt%LINOZ_TPARM = REAL(linozData,fp) ENDIF @@ -1599,8 +1624,8 @@ subroutine chem_init(phys_state, pbuf2d) ! Free pointer SpcInfo => NULL() - l_H2SO4 = get_spc_ndx('H2SO4', compare_uppercase=.true.) - l_SO4 = get_spc_ndx('SO4', compare_uppercase=.true.) + l_H2SO4 = get_spc_ndx('H2SO4', ignore_case=.true.) + l_SO4 = get_spc_ndx('SO4', ignore_case=.true.) ! Get indices for physical fields in physics buffer NDX_PBLH = pbuf_get_index('pblh' ) @@ -1716,7 +1741,7 @@ subroutine gc_readnl(nlfile) ! Purpose: reads the namelist from cam/src/control/runtime_opts ! CAM modules - use mpishorthand + use spmd_utils, only : mpicom, masterprocid, mpi_character, mpi_success use namelist_utils, only: find_group_name use units, only: getunit, freeunit @@ -1742,7 +1767,10 @@ subroutine gc_readnl(nlfile) ENDIF ! Broadcast namelist variables - CALL MPIBCAST(gc_cheminputs, LEN(gc_cheminputs), MPICHAR, 0, MPICOM) + CALL mpi_bcast(gc_cheminputs, LEN(gc_cheminputs), mpi_character, masterprocid, mpicom, ierr) + IF ( ierr /= mpi_success ) then + CALL endrun(subname//': MPI_BCAST ERROR: gc_cheminputs') + ENDIF end subroutine gc_readnl @@ -1772,6 +1800,7 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) use physconst, only : MWDry, Gravit use rad_constituents, only : rad_cnst_get_info use short_lived_species, only : get_short_lived_species_gc, set_short_lived_species_gc + use spmd_utils, only : masterproc use time_manager, only : Get_Curr_Calday, Get_Curr_Date ! For computing SZA use tropopause, only : Tropopause_findChemTrop, Tropopause_Find use wv_saturation, only : QSat @@ -1783,10 +1812,7 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) use modal_aero_data, only : lptr_so4_a_amode use modal_aero_data, only : lptr2_soa_a_amode, lptr2_soa_g_amode #endif -#ifdef SPMD - use mpishorthand -#endif - + ! GEOS-Chem interface modules in CAM use GeosChem_Emissions_Mod, only : GC_Emissions_Calc use GeosChem_Diagnostics_Mod, only : GC_Diagnostics_Calc, wetdep_name, wtrate_name @@ -3840,10 +3866,10 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) speciesName_2 = 'ASOAN' speciesName_3 = 'SOAIE' speciesName_4 = 'SOAGX' - K1 = get_spc_ndx(TRIM(speciesName_1), compare_uppercase=.true.) - K2 = get_spc_ndx(TRIM(speciesName_2), compare_uppercase=.true.) - K3 = get_spc_ndx(TRIM(speciesName_3), compare_uppercase=.true.) - K4 = get_spc_ndx(TRIM(speciesName_4), compare_uppercase=.true.) + K1 = get_spc_ndx(TRIM(speciesName_1), ignore_case=.true.) + K2 = get_spc_ndx(TRIM(speciesName_2), ignore_case=.true.) + K3 = get_spc_ndx(TRIM(speciesName_3), ignore_case=.true.) + K4 = get_spc_ndx(TRIM(speciesName_4), ignore_case=.true.) bulkMass(:nY,:nZ) = 0.0e+00_r8 DO iBin = 1, 2 DO M = 1, ntot_amode @@ -3877,8 +3903,8 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) speciesName_1 = 'TSOA3' speciesName_2 = 'ASOA3' ENDIF - K1 = get_spc_ndx(TRIM(speciesName_1), compare_uppercase=.true. ) - K2 = get_spc_ndx(TRIM(speciesName_2), compare_uppercase=.true. ) + K1 = get_spc_ndx(TRIM(speciesName_1), ignore_case=.true. ) + K2 = get_spc_ndx(TRIM(speciesName_2), ignore_case=.true. ) bulkMass(:nY,:nZ) = 0.0e+00_r8 DO M = 1, ntot_amode N = lptr2_soa_a_amode(M,iBin) @@ -3899,7 +3925,7 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) ! Now deal with gaseous SOA species ! Deal with lowest two volatility bins - TSOG0 corresponds to SOAG0 and SOAG1 speciesName_1 = 'TSOG0' - K1 = get_spc_ndx(TRIM(speciesName_1), compare_uppercase=.true.) + K1 = get_spc_ndx(TRIM(speciesName_1), ignore_case=.true.) N = lptr2_soa_g_amode(1) P = mapCnst(N) ! current mode other modes (this mapping was verified to be correct.) @@ -3924,8 +3950,8 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) speciesName_1 = 'TSOG3' speciesName_2 = 'ASOG3' ENDIF - K1 = get_spc_ndx(TRIM(speciesName_1), compare_uppercase=.true.) - K2 = get_spc_ndx(TRIM(speciesName_2), compare_uppercase=.true.) + K1 = get_spc_ndx(TRIM(speciesName_1), ignore_case=.true.) + K2 = get_spc_ndx(TRIM(speciesName_2), ignore_case=.true.) IF ( P > 0 .AND. K1 > 0 .AND. K2 > 0 ) vmr1(:nY,:nZ,P) = vmr1(:nY,:nZ,K1) + vmr1(:nY,:nZ,K2) ENDDO diff --git a/src/chemistry/geoschem/geoschem_diagnostics_mod.F90 b/src/chemistry/geoschem/geoschem_diagnostics_mod.F90 index 9defdf4e58..447d2c29cd 100644 --- a/src/chemistry/geoschem/geoschem_diagnostics_mod.F90 +++ b/src/chemistry/geoschem/geoschem_diagnostics_mod.F90 @@ -149,7 +149,6 @@ SUBROUTINE GC_Diagnostics_Init( Input_Opt, State_Chm, State_Met ) ! for budget fields LOGICAL :: Found - LOGICAL :: compare_uppercase ! Compare upper-case names LOGICAL :: history_aerosol ! Output the MAM aerosol ! tendencies LOGICAL :: history_chemistry @@ -197,53 +196,52 @@ SUBROUTINE GC_Diagnostics_Init( Input_Opt, State_Chm, State_Met ) history_scwaccm_forcing_out = history_scwaccm_forcing, & history_dust_out = history_dust ) - compare_uppercase = .true. - - id_no3 = get_spc_ndx( 'NO3', compare_uppercase ) - id_o3 = get_spc_ndx( 'O3', compare_uppercase ) - id_oh = get_spc_ndx( 'OH', compare_uppercase ) - id_ho2 = get_spc_ndx( 'HO2', compare_uppercase ) - id_so4_a1 = get_spc_ndx( 'so4_a1', compare_uppercase ) - id_so4_a2 = get_spc_ndx( 'so4_a2', compare_uppercase ) - id_so4_a3 = get_spc_ndx( 'so4_a3', compare_uppercase ) - id_num_a2 = get_spc_ndx( 'num_a2', compare_uppercase ) - id_num_a3 = get_spc_ndx( 'num_a3', compare_uppercase ) - id_dst_a3 = get_spc_ndx( 'dst_a3', compare_uppercase ) - id_ncl_a3 = get_spc_ndx( 'ncl_a3', compare_uppercase ) - id_co2 = get_spc_ndx( 'CO2', compare_uppercase ) - id_no = get_spc_ndx( 'NO', compare_uppercase ) - id_h = get_spc_ndx( 'H', compare_uppercase ) - id_o = get_spc_ndx( 'O', compare_uppercase ) - id_o2 = get_spc_ndx( 'O2', compare_uppercase ) - id_ch4 = get_spc_ndx( 'CH4', compare_uppercase ) - id_h2o = get_spc_ndx( 'H2O', compare_uppercase ) - id_n2o = get_spc_ndx( 'N2O', compare_uppercase ) - id_cfc11 = get_spc_ndx( 'CFC11', compare_uppercase ) - id_cfc12 = get_spc_ndx( 'CFC12', compare_uppercase ) - - id_bry = get_spc_ndx( 'BRY', compare_uppercase ) - id_cly = get_spc_ndx( 'CLY', compare_uppercase ) - - id_dst01 = get_spc_ndx( 'DST01', compare_uppercase ) - id_dst02 = get_spc_ndx( 'DST02', compare_uppercase ) - id_dst03 = get_spc_ndx( 'DST03', compare_uppercase ) - id_dst04 = get_spc_ndx( 'DST04', compare_uppercase ) - id_sslt01 = get_spc_ndx( 'SSLT01', compare_uppercase ) - id_sslt02 = get_spc_ndx( 'SSLT02', compare_uppercase ) - id_sslt03 = get_spc_ndx( 'SSLT03', compare_uppercase ) - id_sslt04 = get_spc_ndx( 'SSLT04', compare_uppercase ) - id_soa = get_spc_ndx( 'SOA', compare_uppercase ) - id_so4 = get_spc_ndx( 'SO4', compare_uppercase ); id_so4 = -1 ! Don't pick up GEOS-Chem's SO4! - id_oc1 = get_spc_ndx( 'OC1', compare_uppercase ) - id_oc2 = get_spc_ndx( 'OC2', compare_uppercase ) - id_cb1 = get_spc_ndx( 'CB1', compare_uppercase ) - id_cb2 = get_spc_ndx( 'CB2', compare_uppercase ) - id_nh4no3 = get_spc_ndx( 'NH4NO3', compare_uppercase ) - id_soam = get_spc_ndx( 'SOAM', compare_uppercase ) - id_soai = get_spc_ndx( 'SOAI', compare_uppercase ) - id_soat = get_spc_ndx( 'SOAT', compare_uppercase ) - id_soab = get_spc_ndx( 'SOAB', compare_uppercase ) - id_soax = get_spc_ndx( 'SOAX', compare_uppercase ) + id_no3 = get_spc_ndx( 'NO3', ignore_case=.true. ) + id_o3 = get_spc_ndx( 'O3', ignore_case=.true. ) + id_oh = get_spc_ndx( 'OH', ignore_case=.true. ) + id_ho2 = get_spc_ndx( 'HO2', ignore_case=.true. ) + id_so4_a1 = get_spc_ndx( 'so4_a1', ignore_case=.true. ) + id_so4_a2 = get_spc_ndx( 'so4_a2', ignore_case=.true. ) + id_so4_a3 = get_spc_ndx( 'so4_a3', ignore_case=.true. ) + id_num_a2 = get_spc_ndx( 'num_a2', ignore_case=.true. ) + id_num_a3 = get_spc_ndx( 'num_a3', ignore_case=.true. ) + id_dst_a3 = get_spc_ndx( 'dst_a3', ignore_case=.true. ) + id_ncl_a3 = get_spc_ndx( 'ncl_a3', ignore_case=.true. ) + id_co2 = get_spc_ndx( 'CO2', ignore_case=.true. ) + id_no = get_spc_ndx( 'NO', ignore_case=.true. ) + id_h = get_spc_ndx( 'H', ignore_case=.true. ) + id_o = get_spc_ndx( 'O', ignore_case=.true. ) + id_o2 = get_spc_ndx( 'O2', ignore_case=.true. ) + id_ch4 = get_spc_ndx( 'CH4', ignore_case=.true. ) + id_h2o = get_spc_ndx( 'H2O', ignore_case=.true. ) + id_n2o = get_spc_ndx( 'N2O', ignore_case=.true. ) + id_cfc11 = get_spc_ndx( 'CFC11', ignore_case=.true. ) + id_cfc12 = get_spc_ndx( 'CFC12', ignore_case=.true. ) + + id_bry = get_spc_ndx( 'BRY', ignore_case=.true. ) + id_cly = get_spc_ndx( 'CLY', ignore_case=.true. ) + + id_dst01 = get_spc_ndx( 'DST01', ignore_case=.true. ) + id_dst02 = get_spc_ndx( 'DST02', ignore_case=.true. ) + id_dst03 = get_spc_ndx( 'DST03', ignore_case=.true. ) + id_dst04 = get_spc_ndx( 'DST04', ignore_case=.true. ) + id_sslt01 = get_spc_ndx( 'SSLT01', ignore_case=.true. ) + id_sslt02 = get_spc_ndx( 'SSLT02', ignore_case=.true. ) + id_sslt03 = get_spc_ndx( 'SSLT03', ignore_case=.true. ) + id_sslt04 = get_spc_ndx( 'SSLT04', ignore_case=.true. ) + id_soa = get_spc_ndx( 'SOA', ignore_case=.true. ) + !id_so4 = get_spc_ndx( 'SO4', ignore_case=.true. )i + id_so4 = -1 ! Don't pick up GEOS-Chem's SO4! + id_oc1 = get_spc_ndx( 'OC1', ignore_case=.true. ) + id_oc2 = get_spc_ndx( 'OC2', ignore_case=.true. ) + id_cb1 = get_spc_ndx( 'CB1', ignore_case=.true. ) + id_cb2 = get_spc_ndx( 'CB2', ignore_case=.true. ) + id_nh4no3 = get_spc_ndx( 'NH4NO3', ignore_case=.true. ) + id_soam = get_spc_ndx( 'SOAM', ignore_case=.true. ) + id_soai = get_spc_ndx( 'SOAI', ignore_case=.true. ) + id_soat = get_spc_ndx( 'SOAT', ignore_case=.true. ) + id_soab = get_spc_ndx( 'SOAB', ignore_case=.true. ) + id_soax = get_spc_ndx( 'SOAX', ignore_case=.true. ) bulkaero_species(:) = -1 bulkaero_species(1:20) = (/ id_dst01, id_dst02, id_dst03, id_dst04, & diff --git a/src/chemistry/mozart/mo_chem_utls.F90 b/src/chemistry/mozart/mo_chem_utls.F90 index 992e0789e7..d444a89d5e 100644 --- a/src/chemistry/mozart/mo_chem_utls.F90 +++ b/src/chemistry/mozart/mo_chem_utls.F90 @@ -9,7 +9,7 @@ module mo_chem_utls contains - integer function get_spc_ndx( spc_name, compare_uppercase ) + integer function get_spc_ndx( spc_name, ignore_case ) !----------------------------------------------------------------------- ! ... return overall species index associated with spc_name !----------------------------------------------------------------------- @@ -24,7 +24,7 @@ integer function get_spc_ndx( spc_name, compare_uppercase ) ! ... dummy arguments !----------------------------------------------------------------------- character(len=*), intent(in) :: spc_name - logical, intent(in), optional :: compare_uppercase + logical, intent(in), optional :: ignore_case !----------------------------------------------------------------------- ! ... local variables @@ -34,8 +34,8 @@ integer function get_spc_ndx( spc_name, compare_uppercase ) logical :: match convert_to_upper = .false. - if ( present( compare_uppercase ) ) then - convert_to_upper = compare_uppercase + if ( present( ignore_case ) ) then + convert_to_upper = ignore_case endif get_spc_ndx = -1 From 3c9ce1423972cce4d223ee04a8d9e069ee2c023d Mon Sep 17 00:00:00 2001 From: Brian Eaton Date: Thu, 7 Sep 2023 18:48:38 -0400 Subject: [PATCH 144/291] refactor and bug fix in rad_gas_get_vmr --- src/physics/rrtmgp/radiation.F90 | 13 +-- src/physics/rrtmgp/rrtmgp_inputs.F90 | 167 ++++++++++++--------------- 2 files changed, 75 insertions(+), 105 deletions(-) diff --git a/src/physics/rrtmgp/radiation.F90 b/src/physics/rrtmgp/radiation.F90 index fe8a6665cc..f5c468f1c6 100644 --- a/src/physics/rrtmgp/radiation.F90 +++ b/src/physics/rrtmgp/radiation.F90 @@ -1359,15 +1359,10 @@ subroutine radiation_tend( & do icall = N_DIAG, 0, -1 if (active_calls(icall)) then - call rrtmgp_set_gases_sw( & ! Put gas volume mixing ratio into gas_concs_sw - icall, & ! input - state, & ! input ; note: state/pbuf are top-to-bottom - pbuf, & ! input - nlay, & ! input - nday, & ! input - idxday, & ! input [this is full array, but could be 1:nday] - gas_concs_sw & ! inout ; will be bottom-to-top !! concentrations will be size ncol, but only 1:nday should be used - ) + ! Set gas volume mixing ratios for this call in gas_concs_sw. + call rrtmgp_set_gases_sw( & + icall, state, pbuf, nlay, nday, & + idxday, gas_concs_sw) call aer_rad_props_sw( & ! Get aerosol shortwave optical properties icall, & ! input diff --git a/src/physics/rrtmgp/rrtmgp_inputs.F90 b/src/physics/rrtmgp/rrtmgp_inputs.F90 index 1a1d3da55d..600b714141 100644 --- a/src/physics/rrtmgp/rrtmgp_inputs.F90 +++ b/src/physics/rrtmgp/rrtmgp_inputs.F90 @@ -271,119 +271,103 @@ function get_molar_mass_ratio(gas_name) result(massratio) end select end function get_molar_mass_ratio -subroutine rad_gas_get_vmr(icall, gas_name, state, pbuf, nlay, numactivecols, gas_concs, indices) - ! provides volume mixing ratio into gas_concs data structure - ! Assumes gas_name will be found with rad_cnst_get_gas(). - integer, intent(in) :: icall ! index of climate/diagnostic radiation call - character(len=*), intent(in) :: gas_name - type(physics_state), target, intent(in) :: state - type(physics_buffer_desc), pointer :: pbuf(:) - integer, intent(in) :: nlay ! number of layers in radiation calculation - integer, intent(in) :: numactivecols ! number of columns, ncol for LW, nday for SW +!========================================================================================= + +subroutine rad_gas_get_vmr(icall, gas_name, state, pbuf, nlay, numactivecols, gas_concs, idxday) + + ! Set volume mixing ratio in gas_concs data structure. - type(ty_gas_concs), intent(inout) :: gas_concs ! the result is VRM inside gas_concs + integer, intent(in) :: icall ! index of climate/diagnostic radiation call + character(len=*), intent(in) :: gas_name + type(physics_state), target, intent(in) :: state + type(physics_buffer_desc), pointer :: pbuf(:) + integer, intent(in) :: nlay ! number of layers in radiation calculation + integer, intent(in) :: numactivecols ! number of columns, ncol for LW, nday for SW - integer, intent(in), OPTIONAL :: indices(:) ! this would be idxday, providing the indices of the active columns + type(ty_gas_concs), intent(inout) :: gas_concs ! the result is VRM inside gas_concs + + integer, optional, intent(in) :: idxday(:) ! indices of daylight columns in a chunk ! local + integer :: i, idx(numactivecols) real(r8), pointer :: gas_mmr(:,:) real(r8), allocatable :: gas_vmr(:,:) - character(len=128) :: errmsg real(r8), allocatable :: mmr(:,:) - character(len=*), parameter :: sub = 'rad_gas_get_vmr' + real(r8) :: massratio + ! -- for ozone profile above model - real(r8), allocatable :: P_int(:), P_mid(:), alpha(:), beta(:), a(:), b(:), chi_mid(:), chi_0(:), chi_eff(:) - real(r8) :: P_top - integer :: idx(numactivecols) - integer :: i - real(r8) :: alpha_value - real(r8) :: amdo !! alpha_value of ozone + real(r8) :: P_top, P_int, P_mid, alpha, beta, a, b, chi_mid, chi_0, chi_eff + + character(len=128) :: errmsg + character(len=*), parameter :: sub = 'rad_gas_get_vmr' + !---------------------------------------------------------------------------- + ! set the column indices; when idxday is provided (e.g. daylit columns) use them, otherwise just count. + do i = 1, numactivecols + if (present(idxday)) then + idx(i) = idxday(i) + else + idx(i) = i + end if + end do + ! gas_mmr points to a "chunk" in either the state or pbuf objects. That storage is + ! dimensioned (pcols,pver). + call rad_cnst_get_gas(icall, gas_name, state, pbuf, gas_mmr) + + ! Copy into storage for RRTMGP allocate(mmr(numactivecols, nlay)) allocate(gas_vmr(numactivecols, nlay)) - call rad_cnst_get_gas(icall, gas_name, state, pbuf, gas_mmr) - ! copy the gas and actually convert to mmr in case of H2O (specific to mixing ratio) + do i = 1, numactivecols + mmr(i,ktoprad:) = gas_mmr(idx(i),ktopcam:) + end do + + ! If an extra layer is being used, copy mmr from the top layer of CAM to the extra layer. + if (nlay == pverp) then + mmr(:,1) = mmr(:,2) + end if - mmr = gas_mmr ! special case: H2O is specific humidity, not mixing ratio. Use r = q/(1-q): if (gas_name == 'H2O') then mmr = mmr / (1._r8 - mmr) end if ! convert MMR to VMR, multipy by ratio of dry air molar mas to gas molar mass. - alpha_value = get_molar_mass_ratio(gas_name) - - ! set the column indices; when indices is provided (e.g. daylit columns) use them, otherwise just count. - do i = 1,numactivecols - if (present(indices)) then - idx(i) = indices(i) - else - idx(i) = i - end if - end do - - - if (nlay == pver) then - do i = 1,numactivecols - gas_vmr(i, :pver) = mmr(idx(i),:pver) * alpha_value - end do - else if (nlay < pver) then ! radiation calculation doesn't go through atmospheric depth - do i = 1,numactivecols - gas_vmr(i,nlay+1-pver:) = mmr(idx(i),:pver) * alpha_value - end do - else if (nlay > pver) then ! radiation has more layers than atmosphere --> only one extra layer allowed, so could say gas_vmr(:ncol, 2:) = gas_mmr(:ncol, :pver)*amdc - do i = 1,numactivecols - gas_vmr(i,nlay+1-pver:) = mmr(idx(i),:pver) * alpha_value - end do - if (nlay == pverp) then - gas_vmr(:,1) = gas_vmr(:,nlay+1-pver) - else - call endrun(sub//': Radiation can not have more than 1 extra layer.') - end if - end if + massratio = get_molar_mass_ratio(gas_name) + gas_vmr = mmr * massratio - ! special case: O3 + ! special case: Setting O3 in the extra layer: ! - ! """ ! For the purpose of attenuating solar fluxes above the CAM model top, we assume that ozone ! mixing decreases linearly in each column from the value in the top layer of CAM to zero at ! the pressure level set by P_top. P_top has been set to 50 Pa (0.5 hPa) based on model tuning ! to produce temperatures at the top of CAM that are most consistent with WACCM at similar pressure levels. - ! """ + if ((gas_name == 'O3') .and. (nlay == pverp)) then - allocate(P_int(numactivecols), P_mid(numactivecols), alpha(numactivecols), beta(numactivecols), a(numactivecols), b(numactivecols), chi_mid(numactivecols), chi_0(numactivecols), chi_eff(numactivecols)) - amdo = get_molar_mass_ratio('O3') do i = 1, numactivecols - P_top = 50.0_r8 ! pressure (Pa) at which we assume O3 = 0 in linear decay from CAM top - P_int(i) = state%pint(idx(i),1) ! pressure (Pa) at upper interface of CAM - P_mid(i) = state%pmid(idx(i),1) ! pressure (Pa) at midpoint of top layer of CAM - alpha(i) = 0.0_r8 - beta(i) = 0.0_r8 - alpha(i) = log(P_int(i)/P_top) - beta(i) = log(P_mid(i)/P_int(i))/log(P_mid(i)/P_top) + P_top = 50.0_r8 + P_int = state%pint(idx(i),1) ! pressure (Pa) at upper interface of CAM + P_mid = state%pmid(idx(i),1) ! pressure (Pa) at midpoint of top layer of CAM + alpha = 0.0_r8 + beta = 0.0_r8 + alpha = log(P_int/P_top) + beta = log(P_mid/P_int)/log(P_mid/P_top) - a(i) = ( (1._r8 + alpha(i)) * exp(-alpha(i)) - 1._r8 ) / alpha(i) - b(i) = 1._r8 - exp(-alpha(i)) + a = ( (1._r8 + alpha) * exp(-alpha) - 1._r8 ) / alpha + b = 1._r8 - exp(-alpha) - if (alpha(i) .gt. 0) then ! only apply where top level is below 80 km - chi_mid(i) = mmr(i,1)*amdo ! molar mixing ratio of O3 at midpoint of top layer - chi_0(i) = chi_mid(i) / (1._r8 + beta(i)) - chi_eff(i) = chi_0(i) * (a(i) + b(i)) - gas_vmr(i,1) = chi_eff(i) - chi_eff(i) = chi_eff(i) * P_int(i) / amdo / 9.8_r8 ! O3 column above in kg m-2 - chi_eff(i) = chi_eff(i) / 2.1415e-5_r8 ! O3 column above in DU + if (alpha .gt. 0) then ! only apply where top level is below 80 km + chi_mid = gas_vmr(i,1) ! molar mixing ratio of O3 at midpoint of top layer + chi_0 = chi_mid / (1._r8 + beta) + chi_eff = chi_0 * (a + b) + gas_vmr(i,1) = chi_eff + chi_eff = chi_eff * P_int / massratio / 9.8_r8 ! O3 column above in kg m-2 + chi_eff = chi_eff / 2.1415e-5_r8 ! O3 column above in DU end if end do - deallocate(P_int, P_mid, alpha, beta, a, b, chi_mid, chi_0, chi_eff) end if - ! other special cases: - ! N2 and CO: If these are in the gas list, would set them to constants - ! as in E3SM. Currently, these will abort run because they are not found by rad_cnst_get_gas. - ! So while RTE-RRTMGP can cope with them, we do not use them for radiation at this time. - errmsg = gas_concs%set_vmr(gas_name, gas_vmr) if (len_trim(errmsg) > 0) then call endrun(sub//': ERROR, gas_concs%set_vmr: '//trim(errmsg)) @@ -398,9 +382,7 @@ end subroutine rad_gas_get_vmr subroutine rrtmgp_set_gases_lw(icall, state, pbuf, nlay, gas_concs) - ! The gases in the LW coefficients file are: - ! H2O, CO2, O3, N2O, CO, CH4, O2, N2 - ! But we only use the gases in the radconstants module's gaslist. + ! Set gas vmr for the gases in the radconstants module's gaslist. ! The memory management for the gas_concs object is internal. The arrays passed to it ! are copied to the internally allocated memory. Each call to the set_vmr method checks @@ -415,16 +397,12 @@ subroutine rrtmgp_set_gases_lw(icall, state, pbuf, nlay, gas_concs) type(ty_gas_concs), intent(inout) :: gas_concs ! local variables - integer :: ncol - - integer :: lchnk + integer :: i, ncol character(len=*), parameter :: sub = 'rrtmgp_set_gases_lw' - integer :: i !-------------------------------------------------------------------------------- ncol = state%ncol - lchnk = state%lchnk - do i = 1,nradgas + do i = 1, nradgas call rad_gas_get_vmr(icall, gaslist(i), state, pbuf, nlay, ncol, gas_concs) end do end subroutine rrtmgp_set_gases_lw @@ -436,11 +414,7 @@ subroutine rrtmgp_set_gases_sw( & idxday, gas_concs) ! Return gas_concs with gas volume mixing ratio on DAYLIT columns. - - ! The gases in the SW coefficients file are: - ! H2O, CO2, O3, N2O, CO, CH4, O2, N2, CCL4, CFC11, CFC12, CFC22, HFC143a, - ! HFC125, HFC23, HFC32, HFC134a, CF4, NO2 - ! We only use the gases in radconstants gaslist. + ! Set all gases in radconstants gaslist. ! arguments integer, intent(in) :: icall ! index of climate/diagnostic radiation call @@ -452,12 +426,13 @@ subroutine rrtmgp_set_gases_sw( & type(ty_gas_concs), intent(inout) :: gas_concs ! local variables - character(len=*), parameter :: sub = 'rrtmgp_set_gases_sw' integer :: i + character(len=*), parameter :: sub = 'rrtmgp_set_gases_sw' + !---------------------------------------------------------------------------- - ! use the optional argument indices to specify which columns are sunlit + ! use the optional argument idxday to specify which columns are sunlit do i = 1,nradgas - call rad_gas_get_vmr(icall, gaslist(i), state, pbuf, nlay, nday, gas_concs, indices=idxday) + call rad_gas_get_vmr(icall, gaslist(i), state, pbuf, nlay, nday, gas_concs, idxday=idxday) end do end subroutine rrtmgp_set_gases_sw From 9418375f794170cb6d98947252ebd19db82c2bc3 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Thu, 7 Sep 2023 20:02:36 -0600 Subject: [PATCH 145/291] Change modal aerosol species name retrieval method --- src/chemistry/geoschem/chemistry.F90 | 23 +++++++++++--------- src/chemistry/modal_aero/modal_aero_data.F90 | 2 +- 2 files changed, 14 insertions(+), 11 deletions(-) diff --git a/src/chemistry/geoschem/chemistry.F90 b/src/chemistry/geoschem/chemistry.F90 index 2466a80779..f5534a0ee8 100644 --- a/src/chemistry/geoschem/chemistry.F90 +++ b/src/chemistry/geoschem/chemistry.F90 @@ -169,7 +169,7 @@ subroutine chem_register use aero_model, only : aero_model_register use modal_aero_data, only : nspec_max use modal_aero_data, only : ntot_amode, nspec_amode - use modal_aero_data, only : xname_massptr + use rad_constituents, only : rad_cnst_get_info #endif ! GEOS-Chem interface modules in CAM @@ -205,6 +205,7 @@ subroutine chem_register CHARACTER(LEN=128) :: lngName CHARACTER(LEN=64) :: cnstName CHARACTER(LEN=64) :: trueName + CHARACTER(LEN=64) :: aerName LOGICAL :: camout LOGICAL :: ic_from_cam2 LOGICAL :: has_fixed_ubc @@ -539,18 +540,22 @@ subroutine chem_register map2MAM4(:,:) = -1 iSulf(:) = -1 + ! ewl notes: xname_massptr returns a name. The select case subsets characters? e.g. 1:3, 4:5, 5:6. + ! so want to get a name give an L and M. Need anything else??? + DO M = 1, ntot_amode DO L = 1, nspec_amode(M) - SELECT CASE ( to_upper(xname_massptr(L,M)(:3)) ) + call rad_cnst_get_info(0,M,L,spec_name=aername) + SELECT CASE ( to_upper(aername(:3)) ) CASE ( 'BC_' ) - SELECT CASE ( to_upper(xname_massptr(L,M)(4:5)) ) + SELECT CASE ( to_upper(aername(4:5)) ) CASE ( 'A1' ) CALL cnst_get_ind( 'BCPI', map2MAM4(L,M) ) CASE ( 'A4' ) CALL cnst_get_ind( 'BCPO', map2MAM4(L,M) ) END SELECT CASE ( 'DST' ) - SELECT CASE ( to_upper(xname_massptr(L,M)(5:6)) ) + SELECT CASE ( to_upper(aername(5:6)) ) ! DST1 - Dust aerosol, Reff = 0.7 micrometers ! DST2 - Dust aerosol, Reff = 1.4 micrometers ! DST3 - Dust aerosol, Reff = 2.4 micrometers @@ -568,7 +573,7 @@ subroutine chem_register CALL cnst_get_ind( 'SO4', map2MAM4(L,M) ) iSulf(M) = L CASE ( 'NCL' ) - SELECT CASE ( to_upper(xname_massptr(L,M)(5:6)) ) + SELECT CASE ( to_upper(aername(5:6)) ) ! SALA - Fine (0.01-0.05 micros) sea salt aerosol ! SALC - Coarse (0.5-8 micros) sea salt aerosol CASE ( 'A1' ) @@ -579,7 +584,7 @@ subroutine chem_register CALL cnst_get_ind( 'SALC', map2MAM4(L,M) ) END SELECT CASE ( 'POM' ) - SELECT CASE ( to_upper(xname_massptr(L,M)(5:6)) ) + SELECT CASE ( to_upper(aername(5:6)) ) CASE ( 'A1' ) CALL cnst_get_ind( 'OCPI', map2MAM4(L,M) ) CASE ( 'A4' ) @@ -952,7 +957,6 @@ subroutine chem_init(phys_state, pbuf2d) use mo_setsox, only : sox_inti use mo_drydep, only : drydep_inti use modal_aero_data, only : ntot_amode, nspec_amode - use modal_aero_data, only : xname_massptr #endif ! GEOS-Chem interface modules in CAM @@ -2221,10 +2225,9 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) ! mapCnst(constituent index) constituent index chemical tracer index ! lmassptr_amode(SM, M) SM, M constituent index (modal) ! map2GC(bulk constituent index) constituent index (bulk) GEOS-Chem species index (bulk) - ! map2MAM4(SM, M) SM, M (modal) constituent index (bulk) this is a N to 1 operation. + ! map2MAM4(SM, M) SM, M (modal) constituent index (bulk) + ! (map2MAM4 is a N to 1 operation) ! - ! Query functions: - ! xname_massptr(SM, M) SM, M NAME of modal aer (bc_a1, bc_a4, ...) !------------------------------------------------------------------------------------------ binRatio = 0.0e+00_r8 DO M = 1, ntot_amode diff --git a/src/chemistry/modal_aero/modal_aero_data.F90 b/src/chemistry/modal_aero/modal_aero_data.F90 index 6e1fbd5502..15b247584d 100644 --- a/src/chemistry/modal_aero/modal_aero_data.F90 +++ b/src/chemistry/modal_aero/modal_aero_data.F90 @@ -111,7 +111,7 @@ module modal_aero_data logical, public, protected :: soa_multi_species = .false. - character(len=16), public, protected, allocatable :: xname_massptr(:,:) ! names of species in each mode + character(len=16), allocatable :: xname_massptr(:,:) ! names of species in each mode character(len=16), allocatable :: xname_massptrcw(:,:) ! names of cloud-borne species in each mode complex(r8), allocatable :: & From f7e28725897a4575b9069478993f2cd08d9bb9f5 Mon Sep 17 00:00:00 2001 From: Brian Eaton Date: Sat, 9 Sep 2023 17:38:45 -0400 Subject: [PATCH 146/291] refactor rrtmgp_set_aer_sw --- src/physics/rrtmgp/radiation.F90 | 204 ++++++++++++--------------- src/physics/rrtmgp/rrtmgp_inputs.F90 | 63 +++++---- 2 files changed, 127 insertions(+), 140 deletions(-) diff --git a/src/physics/rrtmgp/radiation.F90 b/src/physics/rrtmgp/radiation.F90 index f5c468f1c6..018533c6c7 100644 --- a/src/physics/rrtmgp/radiation.F90 +++ b/src/physics/rrtmgp/radiation.F90 @@ -525,7 +525,6 @@ subroutine radiation_init(pbuf2d) call pbuf_set_field(pbuf2d, qrl_idx, 0._r8) end if - ! Set the radiation timestep for cosz calculations if requested using ! the adjusted iradsw value from radiation if (use_rad_dt_cosz) then @@ -924,8 +923,8 @@ subroutine radiation_tend( & integer :: itim_old real(r8), pointer :: cld(:,:) ! cloud fraction - real(r8), pointer :: cldfsnow(:,:) => null() ! cloud fraction of just "snow clouds"- whatever they are - real(r8), pointer :: cldfgrau(:,:) => null() ! cloud fraction of just "graupel clouds"- whatever they are + real(r8), pointer :: cldfsnow(:,:) => null() ! cloud fraction of just "snow clouds" + real(r8), pointer :: cldfgrau(:,:) => null() ! cloud fraction of just "graupel clouds" real(r8), pointer :: qrs(:,:) => null() ! shortwave radiative heating rate real(r8), pointer :: qrl(:,:) => null() ! longwave radiative heating rate real(r8), pointer :: fsds(:) ! Surface solar down flux @@ -1126,7 +1125,7 @@ subroutine radiation_tend( & call pbuf_get_field(pbuf, ld_idx, ld) end if - ! initialize (and reset) all the fluxes // sw fluxes only on nday columns + ! Allocate the flux arrays and init to zero. call initialize_rrtmgp_fluxes(nday, nlay+1, nswbands, fsw, do_direct=.true.) call initialize_rrtmgp_fluxes(nday, nlay+1, nswbands, fswc, do_direct=.true.) call initialize_rrtmgp_fluxes(ncol, nlay+1, nlwbands, flw) @@ -1196,9 +1195,11 @@ subroutine radiation_tend( & if (dosw) then - ! - ! "--- SET OPTICAL PROPERTIES & DO SHORTWAVE CALCULATION ---" - ! + + !=============================! + ! SHORTWAVE cloud optics ! + !=============================! + if (oldcldoptics) then call ec_ice_optics_sw(state, pbuf, ice_tau, ice_tau_w, ice_tau_w_g, ice_tau_w_f, oldicewp=.false.) call slingo_liq_optics_sw(state, pbuf, liq_tau, liq_tau_w, liq_tau_w_g, liq_tau_w_f, oldliqwp=.false.) @@ -1209,7 +1210,7 @@ subroutine radiation_tend( & case ('mitchell') call get_ice_optics_sw(state, pbuf, ice_tau, ice_tau_w, ice_tau_w_g, ice_tau_w_f) case default - call endrun('iccldoptics must be one either ebertcurry or mitchell') + call endrun('icecldoptics must be one either ebertcurry or mitchell') end select select case (liqcldoptics) @@ -1288,12 +1289,20 @@ subroutine radiation_tend( & end do end if - ! At this point we have cloud optical properties including snow and graupel, - ! but they need to be re-ordered from the old RRTMG spectral bands to RRTMGP's - c_cld_tau(:,1:ncol,1:pver) = c_cld_tau (rrtmg_to_rrtmgp_swbands, 1:ncol, 1:pver) - c_cld_tau_w(:,1:ncol,1:pver) = c_cld_tau_w (rrtmg_to_rrtmgp_swbands, 1:ncol, 1:pver) - c_cld_tau_w_g(:,1:ncol,1:pver) = c_cld_tau_w_g(rrtmg_to_rrtmgp_swbands, 1:ncol, 1:pver) - c_cld_tau_w_f(:,1:ncol,1:pver) = c_cld_tau_w_f(rrtmg_to_rrtmgp_swbands, 1:ncol, 1:pver) + ! cloud optical properties need to be re-ordered from the RRTMG spectral bands + ! (assumed in the optics datasets) to RRTMGP's + ice_tau(:,:ncol,:) = ice_tau(rrtmg_to_rrtmgp_swbands,:ncol,:) + liq_tau(:,:ncol,:) = liq_tau(rrtmg_to_rrtmgp_swbands,:ncol,:) + c_cld_tau(:,:ncol,:) = c_cld_tau(rrtmg_to_rrtmgp_swbands,:ncol,:) + c_cld_tau_w(:,:ncol,:) = c_cld_tau_w(rrtmg_to_rrtmgp_swbands,:ncol,:) + c_cld_tau_w_g(:,:ncol,:) = c_cld_tau_w_g(rrtmg_to_rrtmgp_swbands,:ncol,:) + c_cld_tau_w_f(:,:ncol,:) = c_cld_tau_w_f(rrtmg_to_rrtmgp_swbands,:ncol,:) + if (cldfsnow_idx > 0) then + snow_tau(:,:ncol,:) = snow_tau(rrtmg_to_rrtmgp_swbands,:ncol,:) + end if + if (cldfgrau_idx > 0 .and. graupel_in_rad) then + grau_tau(:,:ncol,:) = grau_tau(rrtmg_to_rrtmgp_swbands,:ncol,:) + end if ! cloud_sw : cloud optical properties. call initialize_rrtmgp_cloud_optics_sw(nday, nlay, kdist_sw, cloud_sw) @@ -1303,18 +1312,11 @@ subroutine radiation_tend( & cldfprime, c_cld_tau, c_cld_tau_w, c_cld_tau_w_g, c_cld_tau_w_f, & kdist_sw, cloud_sw) - ! allocate object for aerosol optics - errmsg = aer_sw%alloc_2str(nday, nlay, kdist_sw%get_band_lims_wavenumber(), & - name='shortwave aerosol optics') - if (len_trim(errmsg) > 0) then - call endrun(sub//': ERROR: aer_sw%alloc_2str: '//trim(errmsg)) - end if - ! ! SHORTWAVE DIAGNOSTICS & OUTPUT ! ! cloud optical depth fields for the visible band - rd%tot_icld_vistau(:ncol,:) = c_cld_tau(idx_sw_diag,:ncol,:) ! should be equal to cloud_sw%tau except ordering + rd%tot_icld_vistau(:ncol,:) = c_cld_tau(idx_sw_diag,:ncol,:) rd%liq_icld_vistau(:ncol,:) = liq_tau(idx_sw_diag,:ncol,:) rd%ice_icld_vistau(:ncol,:) = ice_tau(idx_sw_diag,:ncol,:) if (cldfsnow_idx > 0) then @@ -1345,16 +1347,18 @@ subroutine radiation_tend( & call radiation_output_cld(lchnk, ncol, rd) end if - !=============================! - ! SHORTWAVE flux calculations ! - !=============================! - - ! initialize object for gas concentrations + ! Initialize object for gas concentrations. errmsg = gas_concs_sw%init(gaslist_lc) if (len_trim(errmsg) > 0) then call endrun(sub//': ERROR: gas_concs_sw%init: '//trim(errmsg)) end if + ! Allocate object for aerosol optics. + errmsg = aer_sw%alloc_2str(nday, nlay, kdist_sw%get_band_lims_wavenumber()) + if (len_trim(errmsg) > 0) then + call endrun(sub//': ERROR: aer_sw%alloc_2str: '//trim(errmsg)) + end if + ! The climate (icall==0) calculation must occur last. do icall = N_DIAG, 0, -1 if (active_calls(icall)) then @@ -1364,67 +1368,35 @@ subroutine radiation_tend( & icall, state, pbuf, nlay, nday, & idxday, gas_concs_sw) - call aer_rad_props_sw( & ! Get aerosol shortwave optical properties - icall, & ! input - state, & ! input - pbuf, & ! input pointer - nnite, & ! input - idxnite, & ! input - aer_tau, & ! output - aer_tau_w, & ! output - aer_tau_w_g, & ! output - aer_tau_w_f & ! output - ) - ! NOTE: CAM fields are products tau, tau*ssa, tau*ssa*asy, tau*ssa*asy*fsf - ! but RRTMGP is expecting just the values per band. - ! rrtmgp_set_aer_sw does the division and puts values into aer_sw: - ! aer_sw%g = aer_tau_w_g / aer_taw_w - ! aer_sw%ssa = aer_tau_w / aer_tau - ! aer_sw%tau = aer_tau - ! ** As with cloud above, we need to re-order to account for band differences: - - aer_tau(:, :, :) = aer_tau( :, :, rrtmg_to_rrtmgp_swbands) - aer_tau_w(:, :, :) = aer_tau_w( :, :, rrtmg_to_rrtmgp_swbands) - aer_tau_w_g(:, :, :) = aer_tau_w_g(:, :, rrtmg_to_rrtmgp_swbands) - aer_tau_w_f(:, :, :) = aer_tau_w_f(:, :, rrtmg_to_rrtmgp_swbands) + ! Get aerosol shortwave optical properties. The output optics arrays + ! contain an extra top layer set to zero. + call aer_rad_props_sw( & + icall, state, pbuf, nnite, idxnite, & + aer_tau, aer_tau_w, aer_tau_w_g, aer_tau_w_f) + + ! aerosol optical properties need to be re-ordered from the RRTMG spectral bands, + ! as assumed in the optics datasets, to the RRTMGP band order. + aer_tau(:,:,:) = aer_tau(:,:,rrtmg_to_rrtmgp_swbands) + aer_tau_w(:,:,:) = aer_tau_w(:,:,rrtmg_to_rrtmgp_swbands) + aer_tau_w_g(:,:,:) = aer_tau_w_g(:,:,rrtmg_to_rrtmgp_swbands) + aer_tau_w_f(:,:,:) = aer_tau_w_f(:,:,rrtmg_to_rrtmgp_swbands) ! Convert from the products to individual properties, ! and only provide them on the daylit points. call rrtmgp_set_aer_sw( & - nswbands, & - nday, & - idxday(1:nday), & ! required to truncate to 1:nday - aer_tau, & - aer_tau_w, & - aer_tau_w_g, & - aer_tau_w_f, & - aer_sw) + nday, idxday, aer_tau, aer_tau_w, aer_tau_w_g, & + aer_tau_w_f, aer_sw) - ! Compute SW fluxes + !=============================! + ! SHORTWAVE flux calculations ! + !=============================! - ! check that optical properties are in bounds: - call clipper(cloud_sw%tau, 0._r8, huge(cloud_sw%tau)) - call clipper(cloud_sw%ssa, 0._r8, 1._r8) - call clipper(cloud_sw%g, -1._r8, 1._r8) - - ! inputs are the daylit columns --> output fluxes therefore also on daylit columns. - errmsg = rte_sw( kdist_sw, & ! input (from init) - gas_concs_sw, & ! input, (from rrtmgp_set_gases_sw) - pmid_day, & ! input, (from rrtmgp_set_state) - t_day, & ! input, (from rrtmgp_set_state) - pint_day, & ! input, (from rrtmgp_set_state) - coszrs_day, & ! input, (from rrtmgp_set_state) - alb_dir, & ! input, (from rrtmgp_set_state) - alb_dif, & ! input, (from rrtmgp_set_state) - cloud_sw, & ! input, (from rrtmgp_set_cloud_sw) - fsw, & ! inout - fswc, & ! inout - aer_props=aer_sw, & ! optional input (from rrtmgp_set_aer_sw) - tsi_scaling=eccf & !< optional input, scaling for irradiance - ) - + errmsg = rte_sw( & + kdist_sw, gas_concs_sw, pmid_day, t_day, pint_day, & + coszrs_day, alb_dir, alb_dif, cloud_sw, fsw, & + fswc, aer_props=aer_sw, tsi_scaling=eccf) if (len_trim(errmsg) > 0) then - call endrun(sub//': ERROR code returned by rte_sw: '//trim(errmsg)) + call endrun(sub//': ERROR in rte_sw: '//trim(errmsg)) end if ! ! -- shortwave output -- @@ -1932,7 +1904,6 @@ end subroutine radiation_tend !=============================================================================== - subroutine radiation_output_sw(lchnk, ncol, icall, rd, pbuf, cam_out) ! Dump shortwave radiation information to history buffer. @@ -1961,7 +1932,7 @@ subroutine radiation_output_sw(lchnk, ncol, icall, rd, pbuf, cam_out) call outfld('SOLIN'//diag(icall), rd%solin, pcols, lchnk) - call outfld('QRS'//diag(icall), qrs(:ncol,:)/cpair, ncol, lchnk) ! not sure why ncol instead of pcols, but matches RRTMG version + call outfld('QRS'//diag(icall), qrs(:ncol,:)/cpair, ncol, lchnk) call outfld('QRSC'//diag(icall), rd%qrsc(:ncol,:)/cpair, ncol, lchnk) call outfld('FSNT'//diag(icall), rd%flux_sw_net_top, pcols, lchnk) @@ -2006,7 +1977,6 @@ subroutine radiation_output_sw(lchnk, ncol, icall, rd, pbuf, cam_out) end subroutine radiation_output_sw - !=============================================================================== subroutine radiation_output_cld(lchnk, ncol, rd) @@ -2681,38 +2651,20 @@ end subroutine coefs_init !========================================================================================= -subroutine reset_fluxes(fluxes) - - use mo_fluxes_byband, only: ty_fluxes_byband - type(ty_fluxes_byband), intent(inout) :: fluxes - - ! Reset broadband fluxes - fluxes%flux_up(:,:) = 0._r8 - fluxes%flux_dn(:,:) = 0._r8 - fluxes%flux_net(:,:) = 0._r8 - if (associated(fluxes%flux_dn_dir)) then - fluxes%flux_dn_dir(:,:) = 0._r8 - end if - - ! Reset band-by-band fluxes - fluxes%bnd_flux_up(:,:,:) = 0._r8 - fluxes%bnd_flux_dn(:,:,:) = 0._r8 - fluxes%bnd_flux_net(:,:,:) = 0._r8 - if (associated(fluxes%bnd_flux_dn_dir)) then - fluxes%bnd_flux_dn_dir(:,:,:) = 0._r8 - end if - -end subroutine reset_fluxes +subroutine initialize_rrtmgp_fluxes(ncol, nlevels, nbands, fluxes, do_direct) + ! Allocate flux arrays and set values to zero. -subroutine initialize_rrtmgp_fluxes(ncol, nlevels, nbands, fluxes, do_direct) - ! This closely follows the E3SM implementation. use mo_fluxes_byband, only: ty_fluxes_byband + + ! Arguments integer, intent(in) :: ncol, nlevels, nbands type(ty_fluxes_byband), intent(inout) :: fluxes logical, intent(in), optional :: do_direct + ! Local variables logical :: do_direct_local + !---------------------------------------------------------------------------- if (present(do_direct)) then do_direct_local = .true. @@ -2720,11 +2672,6 @@ subroutine initialize_rrtmgp_fluxes(ncol, nlevels, nbands, fluxes, do_direct) do_direct_local = .false. end if - ! Allocate flux arrays - ! NOTE: fluxes defined at interfaces, so need to either pass nlevels as - ! number of model levels plus one, or allocate as nlevels+1 if nlevels - ! represents number of model levels rather than number of interface levels. - ! Broadband fluxes allocate(fluxes%flux_up(ncol, nlevels)) allocate(fluxes%flux_dn(ncol, nlevels)) @@ -2744,6 +2691,35 @@ end subroutine initialize_rrtmgp_fluxes !========================================================================================= +subroutine reset_fluxes(fluxes) + + ! Reset flux arrays to zero. + + use mo_fluxes_byband, only: ty_fluxes_byband + + type(ty_fluxes_byband), intent(inout) :: fluxes + !---------------------------------------------------------------------------- + + ! Reset broadband fluxes + fluxes%flux_up(:,:) = 0._r8 + fluxes%flux_dn(:,:) = 0._r8 + fluxes%flux_net(:,:) = 0._r8 + if (associated(fluxes%flux_dn_dir)) then + fluxes%flux_dn_dir(:,:) = 0._r8 + end if + + ! Reset band-by-band fluxes + fluxes%bnd_flux_up(:,:,:) = 0._r8 + fluxes%bnd_flux_dn(:,:,:) = 0._r8 + fluxes%bnd_flux_net(:,:,:) = 0._r8 + if (associated(fluxes%bnd_flux_dn_dir)) then + fluxes%bnd_flux_dn_dir(:,:,:) = 0._r8 + end if + +end subroutine reset_fluxes + +!========================================================================================= + subroutine initialize_rrtmgp_cloud_optics_sw(ncol, nlevels, kdist, optics) ! use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp ! module level use mo_optical_props, only: ty_optical_props_2str @@ -2768,6 +2744,7 @@ subroutine initialize_rrtmgp_cloud_optics_sw(ncol, nlevels, kdist, optics) optics%g = 0.0_r8 end subroutine initialize_rrtmgp_cloud_optics_sw +!========================================================================================= subroutine initialize_rrtmgp_cloud_optics_lw(ncol, nlevels, kdist, optics) ! use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp ! module level @@ -2790,6 +2767,7 @@ subroutine initialize_rrtmgp_cloud_optics_lw(ncol, nlevels, kdist, optics) end subroutine initialize_rrtmgp_cloud_optics_lw +!========================================================================================= subroutine free_optics_sw(optics) use mo_optical_props, only: ty_optical_props_2str diff --git a/src/physics/rrtmgp/rrtmgp_inputs.F90 b/src/physics/rrtmgp/rrtmgp_inputs.F90 index 600b714141..04c878fdc3 100644 --- a/src/physics/rrtmgp/rrtmgp_inputs.F90 +++ b/src/physics/rrtmgp/rrtmgp_inputs.F90 @@ -3,8 +3,9 @@ module rrtmgp_inputs !-------------------------------------------------------------------------------- ! Transform data for state inputs from CAM's data structures to those used by ! RRTMGP. Subset the number of model levels if CAM's top exceeds RRTMGP's -! valid domain. -! +! valid domain. Add an extra layer if CAM's top is below 1 Pa. +! The vertical indexing increases from top to bottom of atmosphere in both +! CAM and RRTMGP arrays. !-------------------------------------------------------------------------------- use shr_kind_mod, only: r8=>shr_kind_r8 @@ -94,7 +95,7 @@ subroutine rrtmgp_set_state( & ! arguments type(physics_state), intent(in) :: state ! CAM physics state type(cam_in_t), intent(in) :: cam_in ! CAM import state - integer, intent(in) :: ncol ! # cols in chunk + integer, intent(in) :: ncol ! # cols in CAM chunk integer, intent(in) :: nlay ! # layers in rrtmgp grid integer, intent(in) :: nday ! # daylight columns integer, intent(in) :: idxday(:) ! chunk indicies of daylight columns @@ -131,7 +132,7 @@ subroutine rrtmgp_set_state( & ! to be consistent with t_sfc. emis_sfc(:,:) = 1._r8 - ! Assume level ordering is the same for both CAM and RRTMGP (top to bottom) + ! Level ordering is the same for both CAM and RRTMGP (top to bottom) t_rad(:,ktoprad:) = state%t(:ncol,ktopcam:) pmid_rad(:,ktoprad:) = state%pmid(:ncol,ktopcam:) pint_rad(:,ktoprad:) = state%pint(:ncol,ktopcam:) @@ -149,7 +150,7 @@ subroutine rrtmgp_set_state( & tref_min = kdist_sw%get_temp_min() tref_max = kdist_sw%get_temp_max() if ( any(t_rad < tref_min) .or. any(t_rad > tref_max) ) then - ! Find out of range value and quit. + ! Report out of range value and quit. do i = 1, ncol do k = 1, nlay if ( t_rad(i,k) < tref_min .or. t_rad(i,k) > tref_max ) then @@ -231,7 +232,7 @@ logical function is_visible(wavenumber) ! wavenumber in inverse cm (cm^-1) real(r8), intent(in) :: wavenumber - ! Threshold between visible and infrared is 0.7 micron, or 14286 cm^-1 + ! Set threshold between visible and infrared to 0.7 micron, or 14286 cm^-1 real(r8), parameter :: visible_wavenumber_threshold = 14286._r8 ! cm^-1 if (wavenumber > visible_wavenumber_threshold) then @@ -558,7 +559,7 @@ subroutine rrtmgp_set_cloud_sw( & real(r8), allocatable :: ssacmcl(:,:,:) real(r8), allocatable :: asmcmcl(:,:,:) - character(len=32) :: sub = 'rrtmgp_set_cloud_sw' + character(len=*), parameter :: sub = 'rrtmgp_set_cloud_sw' character(len=128) :: errmsg real(r8) :: small_val = 1.e-80_r8 real(r8), allocatable :: day_cld_tau(:,:,:) @@ -641,18 +642,25 @@ end subroutine rrtmgp_set_cloud_sw !================================================================================================== subroutine rrtmgp_set_aer_sw( & - nswbands, nday, idxday, aer_tau, aer_tau_w, & + nday, idxday, aer_tau, aer_tau_w, & aer_tau_w_g, aer_tau_w_f, aer_sw) ! Load aerosol SW optical properties into the RRTMGP object. ! - ! *** N.B. *** The input optical arrays from CAM are dimensioned in the vertical - ! as 0:pver. The index 0 is for the extra layer used in the radiation - ! calculation. - - - ! arguments - integer, intent(in) :: nswbands + ! CAM fields are products tau, tau*ssa, tau*ssa*asy, tau*ssa*asy*fsf + ! Fields expected by RRTMGP are computed by + ! aer_sw%tau = aer_tau + ! aer_sw%ssa = aer_tau_w / aer_tau + ! aer_sw%g = aer_tau_w_g / aer_taw_w + ! + ! The input optical arrays from CAM are dimensioned in the vertical + ! as 0:pver. The index 0 is for the extra layer used in the radiation + ! calculation. The index ktopcam assumes the CAM vertical indices are + ! in the range 1:pver, so using this index correctly ignores vertical + ! index 0. If an "extra" layer is used in the calculations, it is + ! provided and set in the RRTMGP aerosol object aer_sw. + + ! Arguments integer, intent(in) :: nday integer, intent(in) :: idxday(:) real(r8), intent(in) :: aer_tau (pcols,0:pver,nswbands) ! extinction optical depth @@ -662,30 +670,31 @@ subroutine rrtmgp_set_aer_sw( & type(ty_optical_props_2str), intent(inout) :: aer_sw ! local variables - integer :: ns - integer :: k, kk integer :: i - integer, dimension(nday) :: day_cols + + ! minimum value for aer_tau_w is the same as used in RRTMG code. + real(r8), parameter :: tiny = 1.e-80_r8 + character(len=32) :: sub = 'rrtmgp_set_aer_sw' character(len=128) :: errmsg !-------------------------------------------------------------------------------- + ! If there is an extra layer in the radiation then this initialization ! will provide default values there. aer_sw%tau = 0.0_r8 aer_sw%ssa = 1.0_r8 aer_sw%g = 0.0_r8 - day_cols = idxday(1:nday) - ! aer_sw is on RAD grid, aer_tau* is on CAM grid ... to make sure they align, use ktop* - ! aer_sw has dimensions of (nday, nlay, nswbands) - aer_sw%tau(1:nday, ktoprad:, :) = max(aer_tau(day_cols, ktopcam:, :), 0._r8) - aer_sw%ssa(1:nday, ktoprad:, :) = merge( aer_tau_w(day_cols, ktopcam:,:)/aer_tau(day_cols, ktopcam:, :), & - 1._r8, aer_tau(day_cols, ktopcam:, :) > 0._r8) - aer_sw%g( 1:nday, ktoprad:, :) = merge( aer_tau_w_g(day_cols, ktopcam:, :) / aer_tau_w(day_cols, ktopcam:, :), & - 0._r8, aer_tau_w(day_cols, ktopcam:, :) > 1.e-80_r8) + do i = 1, nday + ! aer_sw arrays have dimensions of (nday,nlay,nswbands) + aer_sw%tau(i,ktoprad:,:) = max(aer_tau(idxday(i),ktopcam:,:), 0._r8) + aer_sw%ssa(i,ktoprad:,:) = merge(aer_tau_w(idxday(i),ktopcam:,:)/aer_tau(idxday(i),ktopcam:,:), & + 1._r8, aer_tau(idxday(i),ktopcam:,:) > 0._r8) + aer_sw%g(i,ktoprad:,:) = merge(aer_tau_w_g(idxday(i),ktopcam:,:)/aer_tau_w(idxday(i),ktopcam:,:), & + 0._r8, aer_tau_w(idxday(i),ktopcam:,:) > tiny) + end do ! impose limits on the components: - ! aer_sw%tau = max(aer_sw%tau, 0._r) <-- already imposed aer_sw%ssa = min(max(aer_sw%ssa, 0._r8), 1._r8) aer_sw%g = min(max(aer_sw%g, -1._r8), 1._r8) ! by clamping the values here, the validate method should be guaranteed to succeed, From 79196ad0c19946cfd0d54ef0ba9c51510eb2ba4f Mon Sep 17 00:00:00 2001 From: Brian Eaton Date: Tue, 12 Sep 2023 09:34:31 -0400 Subject: [PATCH 147/291] refactor sw flux calculation --- src/physics/rrtmgp/radconstants.F90 | 6 ++ src/physics/rrtmgp/radiation.F90 | 93 ++++++++++++++++++++++------- 2 files changed, 76 insertions(+), 23 deletions(-) diff --git a/src/physics/rrtmgp/radconstants.F90 b/src/physics/rrtmgp/radconstants.F90 index a04cbef23d..9aaca3ad1b 100644 --- a/src/physics/rrtmgp/radconstants.F90 +++ b/src/physics/rrtmgp/radconstants.F90 @@ -26,6 +26,9 @@ module radconstants logical :: wavenumber_boundaries_set = .false. +integer, public, protected :: nswgpts ! # SW gpts +integer, public, protected :: nlwgpts ! # LW gpts + ! These are indices to specific bands for diagnostic output and COSP input. integer, public, protected :: idx_sw_diag = -1 ! band contains 500-nm wave integer, public, protected :: idx_nir_diag = -1 ! band contains 1000-nm wave @@ -88,6 +91,9 @@ subroutine set_wavenumber_bands(kdist_sw, kdist_lw) call endrun(sub//': ERROR: '//trim(errmsg)) end if + nswgpts = kdist_sw%get_ngpt() + nlwgpts = kdist_lw%get_ngpt() + ! SW band bounds in cm^-1 allocate( values(2,nswbands) ) values = kdist_sw%get_band_lims_wavenumber() diff --git a/src/physics/rrtmgp/radiation.F90 b/src/physics/rrtmgp/radiation.F90 index 018533c6c7..3a0caba6d3 100644 --- a/src/physics/rrtmgp/radiation.F90 +++ b/src/physics/rrtmgp/radiation.F90 @@ -27,9 +27,10 @@ module radiation use rrtmgp_inputs, only: rrtmgp_inputs_init -use radconstants, only: nswbands, nlwbands, idx_sw_diag, idx_nir_diag, idx_uv_diag, & - idx_lw_diag, idx_sw_cloudsim, idx_lw_cloudsim, & - nradgas, gasnamelength, gaslist, set_wavenumber_bands +use radconstants, only: nswbands, nlwbands, nswgpts, nlwgpts, idx_sw_diag, & + idx_nir_diag, idx_uv_diag, idx_lw_diag, idx_sw_cloudsim, & + idx_lw_cloudsim, nradgas, gasnamelength, gaslist, & + set_wavenumber_bands use cloud_rad_props, only: cloud_rad_props_init @@ -875,7 +876,11 @@ subroutine radiation_tend( & use mo_fluxes_byband, only: ty_fluxes_byband ! RRTMGP drivers for flux calculations. - use rrtmgp_driver, only: rte_lw, rte_sw +!++dbg +! use rrtmgp_driver, only: rte_lw, rte_sw + use rrtmgp_driver, only: rte_lw + use mo_rte_sw, only: rte_sw +!--dbg use radheat, only: radheat_tend @@ -1000,13 +1005,17 @@ subroutine radiation_tend( & real(r8) :: c_cld_tau_w_f(nswbands,pcols,pver) ! combined cloud forward scattered fraction * w * tau real(r8) :: c_cld_lw_abs (nlwbands,pcols,pver) ! combined cloud absorption optics depth (LW) - ! Aerosol radiative properties **N.B.** These are zero-indexed to be on RADIATION GRID (assumes "extra layer" is being added?) + ! Aerosol radiative properties **N.B.** These are zero-indexed to accomodate an "extra layer". + ! If no extra layer then the 0 index is ignored. real(r8) :: aer_tau (pcols,0:pver,nswbands) ! aerosol extinction optical depth real(r8) :: aer_tau_w (pcols,0:pver,nswbands) ! aerosol single scattering albedo * tau real(r8) :: aer_tau_w_g(pcols,0:pver,nswbands) ! aerosol assymetry parameter * w * tau real(r8) :: aer_tau_w_f(pcols,0:pver,nswbands) ! aerosol forward scattered fraction * w * tau real(r8) :: aer_lw_abs (pcols,pver,nlwbands) ! aerosol absorption optics depth (LW) + ! Set vertical indexing in RRTMGP to be the same as CAM (top to bottom). + logical, parameter :: top_at_1 = .true. + ! RRTMGP cloud objects (McICA sampling of cloud optical properties) type(ty_optical_props_1scl) :: cloud_lw type(ty_optical_props_2str) :: cloud_sw @@ -1017,7 +1026,11 @@ subroutine radiation_tend( & type(ty_gas_concs) :: gas_concs_lw type(ty_gas_concs) :: gas_concs_sw - ! RRTMGP aerosol objects + ! Atmosphere optics. This object contains gas optics, aerosol optics, and cloud optics. +! type(ty_optical_props_1scl) :: gas_optics_lw + type(ty_optical_props_2str) :: atm_optics_sw + + ! aerosol optics type(ty_optical_props_1scl) :: aer_lw type(ty_optical_props_2str) :: aer_sw @@ -1031,6 +1044,8 @@ subroutine radiation_tend( & real(r8) :: fnl(pcols,pverp) ! net longwave flux real(r8) :: fcnl(pcols,pverp) ! net clear-sky longwave flux + ! TOA solar flux computed by RRTMGP (on gpts). + real(r8), allocatable :: toa_flux(:,:) ! for COSP real(r8) :: emis(pcols,pver) ! Cloud longwave emissivity @@ -1172,7 +1187,7 @@ subroutine radiation_tend( & if (dosw .or. dolw) then allocate( & - t_sfc(ncol), emis_sfc(nlwbands,ncol), & + t_sfc(ncol), emis_sfc(nlwbands,ncol), toa_flux(nday,nswgpts), & t_rad(ncol,nlay), pmid_rad(ncol,nlay), pint_rad(ncol,nlay+1), & t_day(nday,nlay), pmid_day(nday,nlay), pint_day(nday,nlay+1), & coszrs_day(nday), alb_dir(nswbands,nday), alb_dif(nswbands,nday) ) @@ -1185,7 +1200,7 @@ subroutine radiation_tend( & pint_day, coszrs_day, alb_dir, alb_dif) ! Set TSI for RRTMGP to the value from CAM's solar forcing file. - errmsg = kdist_sw%set_tsi(sol_tsi) + errmsg = kdist_sw%set_tsi(sol_tsi*eccf) if (len_trim(errmsg) > 0) then call endrun(sub//': ERROR: kdist_sw%set_tsi: '//trim(errmsg)) end if @@ -1312,9 +1327,8 @@ subroutine radiation_tend( & cldfprime, c_cld_tau, c_cld_tau_w, c_cld_tau_w_g, c_cld_tau_w_f, & kdist_sw, cloud_sw) - ! - ! SHORTWAVE DIAGNOSTICS & OUTPUT - ! + ! SW cloud diagnostics & output + ! cloud optical depth fields for the visible band rd%tot_icld_vistau(:ncol,:) = c_cld_tau(idx_sw_diag,:ncol,:) rd%liq_icld_vistau(:ncol,:) = liq_tau(idx_sw_diag,:ncol,:) @@ -1353,7 +1367,13 @@ subroutine radiation_tend( & call endrun(sub//': ERROR: gas_concs_sw%init: '//trim(errmsg)) end if - ! Allocate object for aerosol optics. + ! Init and allocate arrays in atm optics object. + errmsg = atm_optics_sw%alloc_2str(nday, nlay, kdist_sw) + if (len_trim(errmsg) > 0) then + call endrun(sub//': ERROR: gas_optics_sw%alloc_2str: '//trim(errmsg)) + end if + + ! Init and allocate arrays in aerosol optics object. errmsg = aer_sw%alloc_2str(nday, nlay, kdist_sw%get_band_lims_wavenumber()) if (len_trim(errmsg) > 0) then call endrun(sub//': ERROR: aer_sw%alloc_2str: '//trim(errmsg)) @@ -1368,8 +1388,15 @@ subroutine radiation_tend( & icall, state, pbuf, nlay, nday, & idxday, gas_concs_sw) - ! Get aerosol shortwave optical properties. The output optics arrays - ! contain an extra top layer set to zero. + ! Init atm_optics_sw with gas optics. Also returns TOA solar flux. + errmsg = kdist_sw%gas_optics( & + pmid_day, pint_day, t_day, gas_concs_sw, atm_optics_sw, & + toa_flux) + if (len_trim(errmsg) > 0) then + call endrun(sub//': ERROR: kdist_sw%gas_optics: '//trim(errmsg)) + end if + + ! Get aerosol shortwave optical properties on CAM grid. call aer_rad_props_sw( & icall, state, pbuf, nnite, idxnite, & aer_tau, aer_tau_w, aer_tau_w_g, aer_tau_w_f) @@ -1390,17 +1417,37 @@ subroutine radiation_tend( & !=============================! ! SHORTWAVE flux calculations ! !=============================! - - errmsg = rte_sw( & - kdist_sw, gas_concs_sw, pmid_day, t_day, pint_day, & - coszrs_day, alb_dir, alb_dif, cloud_sw, fsw, & - fswc, aer_props=aer_sw, tsi_scaling=eccf) + + ! Aerosols are included in the clear sky calculation. + errmsg = aer_sw%increment(atm_optics_sw) if (len_trim(errmsg) > 0) then - call endrun(sub//': ERROR in rte_sw: '//trim(errmsg)) + call endrun(sub//': ERROR in aer_sw%increment: '//trim(errmsg)) + end if + + errmsg = rte_sw(& + atm_optics_sw, top_at_1, coszrs_day, toa_flux, & + alb_dir, alb_dif, fswc) + +! errmsg = rte_sw( & +! kdist_sw, gas_concs_sw, pmid_day, t_day, pint_day, & +! coszrs_day, alb_dir, alb_dif, cloud_sw, fsw, & +! fswc, aer_props=aer_sw, tsi_scaling=eccf) + if (len_trim(errmsg) > 0) then + call endrun(sub//': ERROR in clear-sky rte_sw: '//trim(errmsg)) + end if + + ! Add cloud optics for all-sky calculation + errmsg = cloud_sw%increment(atm_optics_sw) + if (len_trim(errmsg) > 0) then + call endrun(sub//': ERROR in cloud_sw%increment: '//trim(errmsg)) + end if + + errmsg = rte_sw(& + atm_optics_sw, top_at_1, coszrs_day, toa_flux, & + alb_dir, alb_dif, fsw) + if (len_trim(errmsg) > 0) then + call endrun(sub//': ERROR in all-sky rte_sw: '//trim(errmsg)) end if - ! - ! -- shortwave output -- - ! ! Transform RRTMGP outputs to CAM outputs ! - including fsw (W/m2) -> qrs (J/(kgK)) From 7cd5b1a8b7cf9e8bf6ab1011f0a5a469a7d8f6f7 Mon Sep 17 00:00:00 2001 From: Brian Eaton Date: Wed, 13 Sep 2023 09:07:15 -0400 Subject: [PATCH 148/291] refactor setting tsi to fix bug --- src/physics/rrtmgp/radiation.F90 | 92 ++++++++++++-------------------- 1 file changed, 33 insertions(+), 59 deletions(-) diff --git a/src/physics/rrtmgp/radiation.F90 b/src/physics/rrtmgp/radiation.F90 index 3a0caba6d3..a8e0d7b9e0 100644 --- a/src/physics/rrtmgp/radiation.F90 +++ b/src/physics/rrtmgp/radiation.F90 @@ -586,7 +586,6 @@ subroutine radiation_init(pbuf2d) sampling_seq='rad_lwsw', flag_xyfill=.true.) endif - ! get list of active radiation calls call rad_cnst_get_call_list(active_calls) @@ -876,11 +875,8 @@ subroutine radiation_tend( & use mo_fluxes_byband, only: ty_fluxes_byband ! RRTMGP drivers for flux calculations. -!++dbg -! use rrtmgp_driver, only: rte_lw, rte_sw use rrtmgp_driver, only: rte_lw use mo_rte_sw, only: rte_sw -!--dbg use radheat, only: radheat_tend @@ -1044,8 +1040,10 @@ subroutine radiation_tend( & real(r8) :: fnl(pcols,pverp) ! net longwave flux real(r8) :: fcnl(pcols,pverp) ! net clear-sky longwave flux - ! TOA solar flux computed by RRTMGP (on gpts). + ! TOA solar flux on gpts real(r8), allocatable :: toa_flux(:,:) + ! TSI from RRTMGP data + real(r8) :: tsi_ref ! for COSP real(r8) :: emis(pcols,pver) ! Cloud longwave emissivity @@ -1092,11 +1090,13 @@ subroutine radiation_tend( & if (use_rad_uniform_angle) then do i = 1, ncol - coszrs(i) = shr_orb_cosz(calday, clat(i), clon(i), delta, dt_avg, uniform_angle=rad_uniform_angle) + coszrs(i) = shr_orb_cosz(calday, clat(i), clon(i), delta, dt_avg, & + uniform_angle=rad_uniform_angle) end do else do i = 1, ncol - coszrs(i) = shr_orb_cosz(calday, clat(i), clon(i), delta, dt_avg) ! if dt_avg /= 0, it triggers using avg coszrs + ! if dt_avg /= 0, it triggers using avg coszrs + coszrs(i) = shr_orb_cosz(calday, clat(i), clon(i), delta, dt_avg) end do end if @@ -1171,8 +1171,8 @@ subroutine radiation_tend( & ! To avoid non-daylit columns ! from having shortwave heating, we should reset here: if (nday == 0) then - qrs(1:ncol,1:pver) = 0 - rd%qrsc(1:ncol,1:pver) = 0 ! this is what gets turned into QRSC in output (probably not needed here.) + qrs(1:ncol,1:pver) = 0._r8 + rd%qrsc(1:ncol,1:pver) = 0._r8 ! this is what gets turned into QRSC in output (probably not needed here.) dosw = .false. end if @@ -1199,12 +1199,6 @@ subroutine radiation_tend( & t_rad, pmid_rad, pint_rad, t_day, pmid_day, & pint_day, coszrs_day, alb_dir, alb_dif) - ! Set TSI for RRTMGP to the value from CAM's solar forcing file. - errmsg = kdist_sw%set_tsi(sol_tsi*eccf) - if (len_trim(errmsg) > 0) then - call endrun(sub//': ERROR: kdist_sw%set_tsi: '//trim(errmsg)) - end if - ! Modified cloud fraction accounts for radiatively active snow and/or graupel call modified_cloud_fraction(ncol, cld, cldfsnow, cldfgrau, cldfprime) @@ -1396,6 +1390,10 @@ subroutine radiation_tend( & call endrun(sub//': ERROR: kdist_sw%gas_optics: '//trim(errmsg)) end if + ! Scale the solar source + tsi_ref = sum(toa_flux(1,:)) + toa_flux = toa_flux * sol_tsi * eccf / tsi_ref + ! Get aerosol shortwave optical properties on CAM grid. call aer_rad_props_sw( & icall, state, pbuf, nnite, idxnite, & @@ -1427,11 +1425,6 @@ subroutine radiation_tend( & errmsg = rte_sw(& atm_optics_sw, top_at_1, coszrs_day, toa_flux, & alb_dir, alb_dif, fswc) - -! errmsg = rte_sw( & -! kdist_sw, gas_concs_sw, pmid_day, t_day, pint_day, & -! coszrs_day, alb_dir, alb_dif, cloud_sw, fsw, & -! fswc, aer_props=aer_sw, tsi_scaling=eccf) if (len_trim(errmsg) > 0) then call endrun(sub//': ERROR in clear-sky rte_sw: '//trim(errmsg)) end if @@ -1617,8 +1610,6 @@ subroutine radiation_tend( & end if end if ! if (dolw) - ! replaces old "rrtmg_state_destroy" -- deallocates outputs from rrtmgp_set_state() - ! note rd%solin is not being deallocated here, but rd is deallocated after the output stage. deallocate( & t_sfc, emis_sfc, t_rad, pmid_rad, pint_rad, & t_day, pmid_day, pint_day, coszrs_day, alb_dir, & @@ -1627,7 +1618,7 @@ subroutine radiation_tend( & !!! *** BEGIN COSP *** if (docosp) then - ! initialize and calculate emis + emis(:,:) = 0._r8 emis(:ncol,:) = 1._r8 - exp(-cld_lw_abs(idx_lw_cloudsim,:ncol,:)) call outfld('EMIS', emis, pcols, lchnk) @@ -2626,42 +2617,25 @@ subroutine coefs_init(coefs_file, available_gases, kdist) totplnk, planck_frac, rayl_lower, rayl_upper, & optimal_angle_fit) else if (allocated(solar_src_quiet)) then - error_msg = kdist%load(available_gases, & - gas_names, & - key_species, & - band2gpt, & - band_lims_wavenum, & - press_ref, & - press_ref_trop, & - temp_ref, & - temp_ref_p, & - temp_ref_t, & - vmr_ref, & - kmajor, & - kminor_lower, & - kminor_upper, & - gas_minor, & - identifier_minor, & - minor_gases_lower, & - minor_gases_upper, & - minor_limits_gpt_lower, & - minor_limits_gpt_upper, & - minor_scales_with_density_lower, & - minor_scales_with_density_upper, & - scaling_gas_lower, & - scaling_gas_upper, & - scale_by_complement_lower, & - scale_by_complement_upper, & - kminor_start_lower, & - kminor_start_upper, & - solar_src_quiet, & - solar_src_facular, & - solar_src_sunspot, & - tsi_default, & - mg_default, & - sb_default, & - rayl_lower, & - rayl_upper) + error_msg = kdist%load( & + available_gases, gas_names, key_species, & + band2gpt, band_lims_wavenum, & + press_ref, press_ref_trop, temp_ref, & + temp_ref_p, temp_ref_t, vmr_ref, & + kmajor, kminor_lower, kminor_upper, & + gas_minor, identifier_minor, & + minor_gases_lower, minor_gases_upper, & + minor_limits_gpt_lower, minor_limits_gpt_upper, & + minor_scales_with_density_lower, & + minor_scales_with_density_upper, & + scaling_gas_lower, scaling_gas_upper, & + scale_by_complement_lower, & + scale_by_complement_upper, & + kminor_start_lower, & + kminor_start_upper, & + solar_src_quiet, solar_src_facular, solar_src_sunspot, & + tsi_default, mg_default, sb_default, & + rayl_lower, rayl_upper) else error_msg = 'must supply either totplnk and planck_frac, or solar_src_[*]' end if From b1806227d680187c7f1d953161bf0df50c4a2072 Mon Sep 17 00:00:00 2001 From: Brian Eaton Date: Fri, 15 Sep 2023 12:33:31 -0400 Subject: [PATCH 149/291] misc cleanup --- src/physics/rrtmg/cloud_rad_props.F90 | 2 +- src/physics/rrtmgp/cloud_rad_props.F90 | 75 ++++++++------- src/physics/rrtmgp/radiation.F90 | 122 ++++++++++++------------- src/physics/rrtmgp/rrtmgp_inputs.F90 | 3 +- 4 files changed, 101 insertions(+), 101 deletions(-) diff --git a/src/physics/rrtmg/cloud_rad_props.F90 b/src/physics/rrtmg/cloud_rad_props.F90 index c629c38e4b..66376fd1d8 100644 --- a/src/physics/rrtmg/cloud_rad_props.F90 +++ b/src/physics/rrtmg/cloud_rad_props.F90 @@ -7,7 +7,7 @@ module cloud_rad_props use ppgrid, only: pcols, pver, pverp use physics_types, only: physics_state use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_get_field, pbuf_old_tim_idx -use radconstants, only: nswbands, nlwbands, idx_sw_diag, idx_lw_diag +use radconstants, only: nswbands, nlwbands, idx_sw_diag use cam_abortutils, only: endrun use rad_constituents, only: iceopticsfile, liqopticsfile use oldcloud, only: oldcloud_lw, old_liq_get_rad_props_lw, old_ice_get_rad_props_lw, oldcloud_init diff --git a/src/physics/rrtmgp/cloud_rad_props.F90 b/src/physics/rrtmgp/cloud_rad_props.F90 index 1581e04d9a..1ba4f200a3 100644 --- a/src/physics/rrtmgp/cloud_rad_props.F90 +++ b/src/physics/rrtmgp/cloud_rad_props.F90 @@ -24,6 +24,8 @@ module cloud_rad_props public :: & cloud_rad_props_init, & + cloud_rad_props_get_sw, & ! return SW optical props of total bulk aerosols + cloud_rad_props_get_lw, & ! return LW optical props of total bulk aerosols get_ice_optics_sw, & ! return Mitchell SW ice radiative properties ice_cloud_get_rad_props_lw, & ! return Mitchell LW ice radiative properties get_liquid_optics_sw, & ! return Conley SW radiative properties @@ -31,10 +33,8 @@ module cloud_rad_props grau_cloud_get_rad_props_lw, & get_grau_optics_sw, & snow_cloud_get_rad_props_lw, & - get_snow_optics_sw, & - ! NOTE: Are these required, or are they obsolete? - cloud_rad_props_get_sw, & ! return SW optical props of total bulk aerosols (?) - cloud_rad_props_get_lw ! return LW optical props of total bulk aerosols (?) + get_snow_optics_sw + integer :: nmu, nlambda real(r8), allocatable :: g_mu(:) ! mu samples on grid @@ -51,11 +51,18 @@ module cloud_rad_props real(r8), allocatable :: asm_sw_ice(:,:) real(r8), allocatable :: abs_lw_ice(:,:) -! +! ! indexes into pbuf for optical parameters of MG clouds -! - integer :: i_dei, i_mu, i_lambda, i_iciwp, i_iclwp, i_des, i_icswp - integer :: i_degrau, i_icgrauwp +! + integer :: i_dei=0 + integer :: i_mu=0 + integer :: i_lambda=0 + integer :: i_iciwp=0 + integer :: i_iclwp=0 + integer :: i_des=0 + integer :: i_icswp=0 + integer :: i_degrau=0 + integer :: i_icgrauwp=0 ! indexes into constituents for old optics integer :: & @@ -80,8 +87,8 @@ subroutine cloud_rad_props_init() use slingo, only: slingo_rad_props_init use ebert_curry, only: ec_rad_props_init, scalefactor - character(len=256) :: liquidfile - character(len=256) :: icefile + character(len=256) :: liquidfile + character(len=256) :: icefile character(len=256) :: locfn integer :: ncid, dimid, f_nlwbands, f_nswbands, ierr @@ -96,7 +103,7 @@ subroutine cloud_rad_props_init() integer :: err - liquidfile = liqopticsfile + liquidfile = liqopticsfile icefile = iceopticsfile call slingo_rad_props_init @@ -143,12 +150,12 @@ subroutine cloud_rad_props_init() call mpibcast(nlambda, 1, mpiint, 0, mpicom, ierr) #endif - if (.not.allocated(g_mu)) allocate(g_mu(nmu)) - if (.not.allocated(g_lambda)) allocate(g_lambda(nmu,nlambda)) - if (.not.allocated(ext_sw_liq)) allocate(ext_sw_liq(nmu,nlambda,nswbands) ) - if (.not.allocated(ssa_sw_liq)) allocate(ssa_sw_liq(nmu,nlambda,nswbands)) - if (.not.allocated(asm_sw_liq)) allocate(asm_sw_liq(nmu,nlambda,nswbands)) - if (.not.allocated(abs_lw_liq)) allocate(abs_lw_liq(nmu,nlambda,nlwbands)) + allocate(g_mu(nmu)) + allocate(g_lambda(nmu,nlambda)) + allocate(ext_sw_liq(nmu,nlambda,nswbands) ) + allocate(ssa_sw_liq(nmu,nlambda,nswbands)) + allocate(asm_sw_liq(nmu,nlambda,nswbands)) + allocate(abs_lw_liq(nmu,nlambda,nlwbands)) if (masterproc) then call handle_ncerr( nf90_inq_varid(ncid, 'mu', mu_id),& @@ -193,8 +200,8 @@ subroutine cloud_rad_props_init() call mpibcast(abs_lw_liq, nmu*nlambda*nlwbands, mpir8, 0, mpicom, ierr) #endif ! I forgot to convert kext from m^2/Volume to m^2/Kg - ext_sw_liq = ext_sw_liq / 0.9970449e3_r8 - abs_lw_liq = abs_lw_liq / 0.9970449e3_r8 + ext_sw_liq = ext_sw_liq / 0.9970449e3_r8 + abs_lw_liq = abs_lw_liq / 0.9970449e3_r8 ! read ice cloud optics if (masterproc) then @@ -221,11 +228,11 @@ subroutine cloud_rad_props_init() ! call mpibcast(nlwbands, 1, mpiint, 0, mpicom, ierr) #endif - if (.not.allocated(g_d_eff)) allocate(g_d_eff(n_g_d)) - if (.not.allocated(ext_sw_ice)) allocate(ext_sw_ice(n_g_d,nswbands)) - if (.not.allocated(ssa_sw_ice)) allocate(ssa_sw_ice(n_g_d,nswbands)) - if (.not.allocated(asm_sw_ice)) allocate(asm_sw_ice(n_g_d,nswbands)) - if (.not.allocated(abs_lw_ice)) allocate(abs_lw_ice(n_g_d,nlwbands)) + allocate(g_d_eff(n_g_d)) + allocate(ext_sw_ice(n_g_d,nswbands)) + allocate(ssa_sw_ice(n_g_d,nswbands)) + allocate(asm_sw_ice(n_g_d,nswbands)) + allocate(abs_lw_ice(n_g_d,nlwbands)) if (masterproc) then call handle_ncerr( nf90_inq_varid(ncid, 'd_eff', d_id),& @@ -280,7 +287,7 @@ subroutine cloud_rad_props_get_sw(state, pbuf, & tau, tau_w, tau_w_g, tau_w_f,& diagnosticindex, oldliq, oldice) -! return totaled (across all species) layer tau, omega, g, f +! return totaled (across all species) layer tau, omega, g, f ! for all spectral interval for aerosols affecting the climate ! Arguments @@ -355,7 +362,7 @@ end subroutine cloud_rad_props_get_sw subroutine cloud_rad_props_get_lw(state, pbuf, cld_abs_od, diagnosticindex, oldliq, oldice, oldcloud) ! Purpose: Compute cloud longwave absorption optical depth -! cloud_rad_props_get_lw() is called by radlw() +! cloud_rad_props_get_lw() is called by radlw() ! Arguments type(physics_state), intent(in) :: state @@ -385,7 +392,7 @@ subroutine cloud_rad_props_get_lw(state, pbuf, cld_abs_od, diagnosticindex, oldl ncol = state%ncol lchnk = state%lchnk - ! compute optical depths cld_absod + ! compute optical depths cld_absod cld_abs_od = 0._r8 if(present(oldcloud))then @@ -418,8 +425,8 @@ subroutine cloud_rad_props_get_lw(state, pbuf, cld_abs_od, diagnosticindex, oldl else call ice_cloud_get_rad_props_lw(state, pbuf, ice_tau_abs_od) endif - - cld_abs_od(:,1:ncol,:) = liq_tau_abs_od(:,1:ncol,:) + ice_tau_abs_od(:,1:ncol,:) + + cld_abs_od(:,1:ncol,:) = liq_tau_abs_od(:,1:ncol,:) + ice_tau_abs_od(:,1:ncol,:) end subroutine cloud_rad_props_get_lw @@ -444,7 +451,7 @@ subroutine get_snow_optics_sw(state, pbuf, tau, tau_w, tau_w_g, tau_w_f) call interpolate_ice_optics_sw(state%ncol, icswpth, des, tau, tau_w, & tau_w_g, tau_w_f) -end subroutine get_snow_optics_sw +end subroutine get_snow_optics_sw !============================================================================== @@ -474,7 +481,7 @@ subroutine get_grau_optics_sw(state, pbuf, tau, tau_w, tau_w_g, tau_w_f) do k = 1, pver if (tau(idx_sw_diag,i,k).gt.100._r8) then write(iulog,*) 'WARNING: SW Graupel Tau > 100 (i,k,icgrauwpth,degrau,tau):' - write(iulog,*) i,k,icgrauwpth(i,k), degrau(i,k), tau(idx_sw_diag,i,k) + write(iulog,*) i,k,icgrauwpth(i,k), degrau(i,k), tau(idx_sw_diag,i,k) end if enddo enddo @@ -483,7 +490,7 @@ subroutine get_grau_optics_sw(state, pbuf, tau, tau_w, tau_w_g, tau_w_f) call endrun('ERROR: Get_grau_optics_sw called when graupel properties not supported') end if -end subroutine get_grau_optics_sw +end subroutine get_grau_optics_sw !============================================================================== ! Private methods @@ -583,7 +590,7 @@ subroutine get_liquid_optics_sw(state, pbuf, tau, tau_w, tau_w_g, tau_w_f) call pbuf_get_field(pbuf, i_lambda, lamc) call pbuf_get_field(pbuf, i_mu, pgam) call pbuf_get_field(pbuf, i_iclwp, iclwpth) - + do k = 1,pver do i = 1,ncol if(lamc(i,k) > 0._r8) then ! This seems to be clue from microphysics of no cloud @@ -662,7 +669,7 @@ subroutine grau_cloud_get_rad_props_lw(state, pbuf, abs_od) ! This does the same thing as ice_cloud_get_rad_props_lw, except with a ! different water path and effective diameter. - if((i_icgrauwp > 0) .and. (i_degrau > 0)) then + if((i_icgrauwp > 0) .and. (i_degrau > 0)) then call pbuf_get_field(pbuf, i_icgrauwp, icgrauwpth) call pbuf_get_field(pbuf, i_degrau, degrau) diff --git a/src/physics/rrtmgp/radiation.F90 b/src/physics/rrtmgp/radiation.F90 index a8e0d7b9e0..e0d074e904 100644 --- a/src/physics/rrtmgp/radiation.F90 +++ b/src/physics/rrtmgp/radiation.F90 @@ -55,6 +55,9 @@ module radiation use mo_gas_concentrations, only: ty_gas_concs use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp +use mo_optical_props, only: ty_optical_props_1scl, ty_optical_props_2str +use mo_fluxes_byband, only: ty_fluxes_byband + use string_utils, only: to_lower use cam_abortutils, only: endrun @@ -102,9 +105,9 @@ module radiation real(r8) :: fsnrtc(pcols) ! Clear sky near-IR flux absorbed at toa real(r8) :: fsnirtsq(pcols) ! Near-IR flux absorbed at toa >= 0.7 microns - real(r8) :: fsn200(pcols) ! fns interpolated to 200 mb - real(r8) :: fsn200c(pcols) ! fcns interpolated to 200 mb - real(r8) :: fsnr(pcols) ! fns interpolated to tropopause + real(r8) :: fsn200(pcols) ! Net SW flux interpolated to 200 mb + real(r8) :: fsn200c(pcols) ! Net clear-sky SW flux interpolated to 200 mb + real(r8) :: fsnr(pcols) ! Net SW flux interpolated to tropopause real(r8) :: flux_sw_up(pcols,pverp) ! upward shortwave flux on interfaces real(r8) :: flux_sw_clr_up(pcols,pverp) ! upward shortwave clearsky flux @@ -507,7 +510,8 @@ subroutine radiation_init(pbuf2d) call coefs_init(coefs_sw_file, available_gases, kdist_sw) call coefs_init(coefs_lw_file, available_gases, kdist_lw) - ! Set the sw/lw band boundaries in radconstants + ! Set the sw/lw band boundaries in radconstants. Also sets + ! indicies of specific bands for diagnostic output and COSP input. call set_wavenumber_bands(kdist_sw, kdist_lw) ! The spectral band boundaries need to be set before this init is called. @@ -870,10 +874,6 @@ subroutine radiation_tend( & use slingo, only: slingo_liq_get_rad_props_lw, slingo_liq_optics_sw use ebert_curry, only: ec_ice_optics_sw, ec_ice_get_rad_props_lw - use mo_optical_props, only: ty_optical_props, ty_optical_props_2str, ty_optical_props_1scl - - use mo_fluxes_byband, only: ty_fluxes_byband - ! RRTMGP drivers for flux calculations. use rrtmgp_driver, only: rte_lw use mo_rte_sw, only: rte_sw @@ -1035,14 +1035,15 @@ subroutine radiation_tend( & type(ty_fluxes_byband) :: fsw, fswc type(ty_fluxes_byband) :: flw, flwc + ! Arrays for output diagnostics on CAM grid. real(r8) :: fns(pcols,pverp) ! net shortwave flux real(r8) :: fcns(pcols,pverp) ! net clear-sky shortwave flux real(r8) :: fnl(pcols,pverp) ! net longwave flux real(r8) :: fcnl(pcols,pverp) ! net clear-sky longwave flux - ! TOA solar flux on gpts + ! TOA solar flux on RRTMGP g-points real(r8), allocatable :: toa_flux(:,:) - ! TSI from RRTMGP data + ! TSI from RRTMGP data (from sum over g-point representation) real(r8) :: tsi_ref ! for COSP @@ -1199,15 +1200,18 @@ subroutine radiation_tend( & t_rad, pmid_rad, pint_rad, t_day, pmid_day, & pint_day, coszrs_day, alb_dir, alb_dif) + ! Output the mass per layer, and total column burdens for gas and aerosol + ! constituents in the climate list. + call rad_cnst_out(0, state, pbuf) + ! Modified cloud fraction accounts for radiatively active snow and/or graupel call modified_cloud_fraction(ncol, cld, cldfsnow, cldfgrau, cldfprime) - - if (dosw) then + !========================! + ! SHORTWAVE calculations ! + !========================! - !=============================! - ! SHORTWAVE cloud optics ! - !=============================! + if (dosw) then if (oldcldoptics) then call ec_ice_optics_sw(state, pbuf, ice_tau, ice_tau_w, ice_tau_w_g, ice_tau_w_f, oldicewp=.false.) @@ -1368,6 +1372,7 @@ subroutine radiation_tend( & end if ! Init and allocate arrays in aerosol optics object. + errmsg = aer_sw%alloc_2str(nday, nlay, kdist_sw%get_band_lims_wavenumber()) if (len_trim(errmsg) > 0) then call endrun(sub//': ERROR: aer_sw%alloc_2str: '//trim(errmsg)) @@ -1382,7 +1387,8 @@ subroutine radiation_tend( & icall, state, pbuf, nlay, nday, & idxday, gas_concs_sw) - ! Init atm_optics_sw with gas optics. Also returns TOA solar flux. + ! Compute the gas optics (stored in atm_optics_sw). + ! toa_flux is the reference solar source from RRTMGP data. errmsg = kdist_sw%gas_optics( & pmid_day, pint_day, t_day, gas_concs_sw, atm_optics_sw, & toa_flux) @@ -1412,16 +1418,13 @@ subroutine radiation_tend( & nday, idxday, aer_tau, aer_tau_w, aer_tau_w_g, & aer_tau_w_f, aer_sw) - !=============================! - ! SHORTWAVE flux calculations ! - !=============================! - - ! Aerosols are included in the clear sky calculation. + ! Increment the gas optics (in atm_optics_sw) by the aerosol optics in aer_sw. errmsg = aer_sw%increment(atm_optics_sw) if (len_trim(errmsg) > 0) then call endrun(sub//': ERROR in aer_sw%increment: '//trim(errmsg)) end if + ! Compute clear-sky fluxes. errmsg = rte_sw(& atm_optics_sw, top_at_1, coszrs_day, toa_flux, & alb_dir, alb_dif, fswc) @@ -1429,12 +1432,13 @@ subroutine radiation_tend( & call endrun(sub//': ERROR in clear-sky rte_sw: '//trim(errmsg)) end if - ! Add cloud optics for all-sky calculation + ! Increment the aerosol+gas optics (in atm_optics_sw) by the cloud optics in cloud_sw. errmsg = cloud_sw%increment(atm_optics_sw) if (len_trim(errmsg) > 0) then call endrun(sub//': ERROR in cloud_sw%increment: '//trim(errmsg)) end if + ! Compute all-sky fluxes. errmsg = rte_sw(& atm_optics_sw, top_at_1, coszrs_day, toa_flux, & alb_dir, alb_dif, fsw) @@ -1442,8 +1446,7 @@ subroutine radiation_tend( & call endrun(sub//': ERROR in all-sky rte_sw: '//trim(errmsg)) end if - ! Transform RRTMGP outputs to CAM outputs - ! - including fsw (W/m2) -> qrs (J/(kgK)) + ! Transform RRTMGP outputs to CAM outputs and compute heating rates. call set_sw_diags() if (write_output) then @@ -1459,15 +1462,12 @@ subroutine radiation_tend( & end if end if ! if (dosw) - ! Output aerosol mmr - ! This happens between SW and LW (Why?) - call rad_cnst_out(0, state, pbuf) - - !============================! - ! LONGWAVE flux calculations ! - !============================! + !=======================! + ! LONGWAVE calculations ! + !=======================! if (dolw) then + if (oldcldoptics) then call cloud_rad_props_get_lw(state, pbuf, cld_lw_abs, oldcloud=.true.) else @@ -1477,7 +1477,7 @@ subroutine radiation_tend( & case ('mitchell') call ice_cloud_get_rad_props_lw(state, pbuf, ice_lw_abs) case default - call endrun('ERROR: iccldoptics must be one either ebertcurry or mitchell') + call endrun('ERROR: icecldoptics must be one either ebertcurry or mitchell') end select select case (liqcldoptics) @@ -1490,9 +1490,9 @@ subroutine radiation_tend( & end select cld_lw_abs(:,:ncol,:) = liq_lw_abs(:,:ncol,:) + ice_lw_abs(:,:ncol,:) + end if - cld_lw_abs(:,:ncol,:) = liq_lw_abs(:,:ncol,:) + ice_lw_abs(:,:ncol,:) if (cldfsnow_idx > 0) then ! add in snow call snow_cloud_get_rad_props_lw(state, pbuf, snow_lw_abs) @@ -1509,6 +1509,7 @@ subroutine radiation_tend( & else c_cld_lw_abs(:,:ncol,:) = cld_lw_abs(:,:ncol,:) end if + if (cldfgrau_idx > 0 .and. graupel_in_rad) then ! add in graupel call grau_cloud_get_rad_props_lw(state, pbuf, grau_lw_abs) @@ -1527,14 +1528,8 @@ subroutine radiation_tend( & ! cloud_lw : cloud optical properties. call initialize_rrtmgp_cloud_optics_lw(ncol, nlay, kdist_lw, cloud_lw) - call rrtmgp_set_cloud_lw( & ! Sets the LW optical depth (tau) that is passed to RRTMGP - state, & ! input (%ncol, %pmid [top-to-bottom]) - nlwbands, & ! input - cldfprime, & ! input Ordered top-to-bottom - c_cld_lw_abs, & ! input Ordered top-to-bottom - kdist_lw, & ! input (%get_ngpt, and whole object passed to mcica) - cloud_lw & ! inout (%tau is set, and returned bottom-to-top) - ) + call rrtmgp_set_cloud_lw(state, nlwbands, cldfprime, c_cld_lw_abs, kdist_lw, & + cloud_lw) ! initialize/allocate object for aerosol optics errmsg = aer_lw%alloc_1scl(ncol, & @@ -1615,8 +1610,10 @@ subroutine radiation_tend( & t_day, pmid_day, pint_day, coszrs_day, alb_dir, & alb_dif) + !================! + ! COSP simulator ! + !================! - !!! *** BEGIN COSP *** if (docosp) then emis(:,:) = 0._r8 @@ -1659,8 +1656,7 @@ subroutine radiation_tend( & snow_tau_in=gb_snow_tau, snow_emis_in=gb_snow_lw) cosp_cnt(lchnk) = 0 end if - end if - !!! *** END COSP *** + end if ! docosp else ! --> radiative flux calculations not updated ! convert radiative heating rates from Q*dp to Q for energy conservation @@ -1713,8 +1709,11 @@ subroutine radiation_tend( & end if if (.not. present(rd_out)) then + deallocate(rd%fsdn, rd%fsdnc, rd%fsup, rd%fsupc, & + rd%fldn, rd%fldnc, rd%flup, rd%flupc ) deallocate(rd) end if + call free_optics_sw(atm_optics_sw) call free_optics_sw(cloud_sw) call free_optics_sw(aer_sw) call free_fluxes(fsw) @@ -1731,10 +1730,9 @@ subroutine radiation_tend( & subroutine set_sw_diags() - ! Transform RRTMGP output for CAM - ! Uses the fluxes that come out of RRTMGP. - - ! Expects fluxes on day columns, and expands to full columns. + ! Transform RRTMGP output for CAM and compute heating rates. + ! SW fluxes from RRTMGP are on daylight columns only, so expand to + ! full chunks for output to CAM history. integer :: i real(r8), dimension(size(fsw%bnd_flux_dn,1), & @@ -1742,7 +1740,7 @@ subroutine set_sw_diags() size(fsw%bnd_flux_dn,3)) :: flux_dn_diffuse !------------------------------------------------------------------------- - ! Initializing these arrays to 0.0 provides fill in the night columns: + ! Initialize to provide 0.0 values for night columns. fns = 0._r8 ! net sw flux fcns = 0._r8 ! net sw clearsky flux fsds = 0._r8 ! downward sw flux at surface @@ -2676,8 +2674,6 @@ subroutine initialize_rrtmgp_fluxes(ncol, nlevels, nbands, fluxes, do_direct) ! Allocate flux arrays and set values to zero. - use mo_fluxes_byband, only: ty_fluxes_byband - ! Arguments integer, intent(in) :: ncol, nlevels, nbands type(ty_fluxes_byband), intent(inout) :: fluxes @@ -2716,8 +2712,6 @@ subroutine reset_fluxes(fluxes) ! Reset flux arrays to zero. - use mo_fluxes_byband, only: ty_fluxes_byband - type(ty_fluxes_byband), intent(inout) :: fluxes !---------------------------------------------------------------------------- @@ -2742,20 +2736,15 @@ end subroutine reset_fluxes !========================================================================================= subroutine initialize_rrtmgp_cloud_optics_sw(ncol, nlevels, kdist, optics) - ! use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp ! module level - use mo_optical_props, only: ty_optical_props_2str integer, intent(in) :: ncol, nlevels type(ty_gas_optics_rrtmgp), intent(in) :: kdist type(ty_optical_props_2str), intent(out) :: optics - integer :: ngpt character(len=128) :: errmsg character(len=128) :: sub = 'initialize_rrtmgp_cloud_optics_sw' - ! ngpt = kdist%get_ngpt() - - errmsg = optics%alloc_2str(ncol, nlevels, kdist, name='shortwave cloud optics') + errmsg = optics%alloc_2str(ncol, nlevels, kdist) if (len_trim(errmsg) > 0) then call endrun(trim(sub)//': ERROR: optics%alloc_2str: '//trim(errmsg)) end if @@ -2768,8 +2757,6 @@ end subroutine initialize_rrtmgp_cloud_optics_sw !========================================================================================= subroutine initialize_rrtmgp_cloud_optics_lw(ncol, nlevels, kdist, optics) - ! use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp ! module level - use mo_optical_props, only: ty_optical_props_1scl integer, intent(in) :: ncol, nlevels type(ty_gas_optics_rrtmgp), intent(in) :: kdist @@ -2782,7 +2769,7 @@ subroutine initialize_rrtmgp_cloud_optics_lw(ncol, nlevels, kdist, optics) ngpt = kdist%get_ngpt() errmsg =optics%alloc_1scl(ncol, nlevels, kdist, name='longwave cloud optics') if (len_trim(errmsg) > 0) then - call endrun(trim(sub)//': ERROR: optics%init_1scalar: '//trim(errmsg)) + call endrun(trim(sub)//': ERROR: optics%alloc_1scalar: '//trim(errmsg)) end if optics%tau(:ncol, :nlevels, :ngpt) = 0.0 @@ -2791,26 +2778,31 @@ end subroutine initialize_rrtmgp_cloud_optics_lw !========================================================================================= subroutine free_optics_sw(optics) - use mo_optical_props, only: ty_optical_props_2str + type(ty_optical_props_2str), intent(inout) :: optics + if (allocated(optics%tau)) deallocate(optics%tau) if (allocated(optics%ssa)) deallocate(optics%ssa) if (allocated(optics%g)) deallocate(optics%g) call optics%finalize() end subroutine free_optics_sw +!========================================================================================= subroutine free_optics_lw(optics) - use mo_optical_props, only: ty_optical_props_1scl + type(ty_optical_props_1scl), intent(inout) :: optics + if (allocated(optics%tau)) deallocate(optics%tau) call optics%finalize() end subroutine free_optics_lw +!========================================================================================= subroutine free_fluxes(fluxes) - use mo_fluxes_byband, only: ty_fluxes_byband + type(ty_fluxes_byband), intent(inout) :: fluxes + if (associated(fluxes%flux_up)) deallocate(fluxes%flux_up) if (associated(fluxes%flux_dn)) deallocate(fluxes%flux_dn) if (associated(fluxes%flux_net)) deallocate(fluxes%flux_net) diff --git a/src/physics/rrtmgp/rrtmgp_inputs.F90 b/src/physics/rrtmgp/rrtmgp_inputs.F90 index 04c878fdc3..f1dbb659e2 100644 --- a/src/physics/rrtmgp/rrtmgp_inputs.F90 +++ b/src/physics/rrtmgp/rrtmgp_inputs.F90 @@ -1,7 +1,7 @@ module rrtmgp_inputs !-------------------------------------------------------------------------------- -! Transform data for state inputs from CAM's data structures to those used by +! Transform data for inputs from CAM's data structures to those used by ! RRTMGP. Subset the number of model levels if CAM's top exceeds RRTMGP's ! valid domain. Add an extra layer if CAM's top is below 1 Pa. ! The vertical indexing increases from top to bottom of atmosphere in both @@ -80,6 +80,7 @@ subroutine rrtmgp_inputs_init(ktcam, ktrad) ktopcam = ktcam ktoprad = ktrad + ! Initialize the module data containing the SW band boundaries. call get_sw_spectral_boundaries(sw_low_bounds, sw_high_bounds, 'cm^-1') end subroutine rrtmgp_inputs_init From afbeae33a1af0d5b17c394c734b0c696e823a983 Mon Sep 17 00:00:00 2001 From: Brian Eaton Date: Fri, 15 Sep 2023 12:51:47 -0400 Subject: [PATCH 150/291] move files shared by rrtmg and rrtmgp to physics/cam --- .../{rrtmgp => cam}/cloud_rad_props.F90 | 0 src/physics/{rrtmgp => cam}/ebert_curry.F90 | 0 src/physics/{rrtmgp => cam}/oldcloud.F90 | 0 src/physics/{rrtmgp => cam}/slingo.F90 | 0 src/physics/rrtmg/cloud_rad_props.F90 | 849 ------------------ src/physics/rrtmg/ebert_curry.F90 | 408 --------- src/physics/rrtmg/oldcloud.F90 | 643 ------------- src/physics/rrtmg/slingo.F90 | 409 --------- 8 files changed, 2309 deletions(-) rename src/physics/{rrtmgp => cam}/cloud_rad_props.F90 (100%) rename src/physics/{rrtmgp => cam}/ebert_curry.F90 (100%) rename src/physics/{rrtmgp => cam}/oldcloud.F90 (100%) rename src/physics/{rrtmgp => cam}/slingo.F90 (100%) delete mode 100644 src/physics/rrtmg/cloud_rad_props.F90 delete mode 100644 src/physics/rrtmg/ebert_curry.F90 delete mode 100644 src/physics/rrtmg/oldcloud.F90 delete mode 100644 src/physics/rrtmg/slingo.F90 diff --git a/src/physics/rrtmgp/cloud_rad_props.F90 b/src/physics/cam/cloud_rad_props.F90 similarity index 100% rename from src/physics/rrtmgp/cloud_rad_props.F90 rename to src/physics/cam/cloud_rad_props.F90 diff --git a/src/physics/rrtmgp/ebert_curry.F90 b/src/physics/cam/ebert_curry.F90 similarity index 100% rename from src/physics/rrtmgp/ebert_curry.F90 rename to src/physics/cam/ebert_curry.F90 diff --git a/src/physics/rrtmgp/oldcloud.F90 b/src/physics/cam/oldcloud.F90 similarity index 100% rename from src/physics/rrtmgp/oldcloud.F90 rename to src/physics/cam/oldcloud.F90 diff --git a/src/physics/rrtmgp/slingo.F90 b/src/physics/cam/slingo.F90 similarity index 100% rename from src/physics/rrtmgp/slingo.F90 rename to src/physics/cam/slingo.F90 diff --git a/src/physics/rrtmg/cloud_rad_props.F90 b/src/physics/rrtmg/cloud_rad_props.F90 deleted file mode 100644 index 66376fd1d8..0000000000 --- a/src/physics/rrtmg/cloud_rad_props.F90 +++ /dev/null @@ -1,849 +0,0 @@ -module cloud_rad_props - -!------------------------------------------------------------------------------------------------ -!------------------------------------------------------------------------------------------------ - -use shr_kind_mod, only: r8 => shr_kind_r8 -use ppgrid, only: pcols, pver, pverp -use physics_types, only: physics_state -use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_get_field, pbuf_old_tim_idx -use radconstants, only: nswbands, nlwbands, idx_sw_diag -use cam_abortutils, only: endrun -use rad_constituents, only: iceopticsfile, liqopticsfile -use oldcloud, only: oldcloud_lw, old_liq_get_rad_props_lw, old_ice_get_rad_props_lw, oldcloud_init - -use ebert_curry, only: scalefactor -use cam_logfile, only: iulog - -use interpolate_data, only: interp_type, lininterp_init, lininterp, & - extrap_method_bndry, lininterp_finish - -implicit none -private -save - -public :: & - cloud_rad_props_init, & - cloud_rad_props_get_sw, & ! return SW optical props of total bulk aerosols - cloud_rad_props_get_lw, & ! return LW optical props of total bulk aerosols - get_ice_optics_sw, & ! return Mitchell SW ice radiative properties - ice_cloud_get_rad_props_lw, & ! Mitchell LW ice rad props - get_liquid_optics_sw, & ! return Conley SW rad props - liquid_cloud_get_rad_props_lw, & ! return Conley LW rad props - grau_cloud_get_rad_props_lw, & - get_grau_optics_sw, & - snow_cloud_get_rad_props_lw, & - get_snow_optics_sw - - -integer :: nmu, nlambda -real(r8), allocatable :: g_mu(:) ! mu samples on grid -real(r8), allocatable :: g_lambda(:,:) ! lambda scale samples on grid -real(r8), allocatable :: ext_sw_liq(:,:,:) -real(r8), allocatable :: ssa_sw_liq(:,:,:) -real(r8), allocatable :: asm_sw_liq(:,:,:) -real(r8), allocatable :: abs_lw_liq(:,:,:) - -integer :: n_g_d -real(r8), allocatable :: g_d_eff(:) ! radiative effective diameter samples on grid -real(r8), allocatable :: ext_sw_ice(:,:) -real(r8), allocatable :: ssa_sw_ice(:,:) -real(r8), allocatable :: asm_sw_ice(:,:) -real(r8), allocatable :: abs_lw_ice(:,:) - -! -! indexes into pbuf for optical parameters of MG clouds -! - integer :: i_dei=0 - integer :: i_mu=0 - integer :: i_lambda=0 - integer :: i_iciwp=0 - integer :: i_iclwp=0 - integer :: i_des=0 - integer :: i_icswp=0 - integer :: i_degrau=0 - integer :: i_icgrauwp=0 - -! indexes into constituents for old optics - integer :: & - ixcldice, & ! cloud ice water index - ixcldliq ! cloud liquid water index - - -!============================================================================== -contains -!============================================================================== - -subroutine cloud_rad_props_init() - - use netcdf - use spmd_utils, only: masterproc - use ioFileMod, only: getfil - use error_messages, only: handle_ncerr -#if ( defined SPMD ) - use mpishorthand -#endif - use constituents, only: cnst_get_ind - use slingo, only: slingo_rad_props_init - use ebert_curry, only: ec_rad_props_init, scalefactor - - character(len=256) :: liquidfile - character(len=256) :: icefile - character(len=256) :: locfn - - integer :: ncid, dimid, f_nlwbands, f_nswbands, ierr - integer :: vdimids(NF90_MAX_VAR_DIMS), ndims, templen - ! liquid clouds - integer :: mudimid, lambdadimid - integer :: mu_id, lambda_id, ext_sw_liq_id, ssa_sw_liq_id, asm_sw_liq_id, abs_lw_liq_id - - ! ice clouds - integer :: d_dimid ! diameters - integer :: d_id, ext_sw_ice_id, ssa_sw_ice_id, asm_sw_ice_id, abs_lw_ice_id - - integer :: err - - liquidfile = liqopticsfile - icefile = iceopticsfile - - call slingo_rad_props_init - call ec_rad_props_init - call oldcloud_init - - i_dei = pbuf_get_index('DEI',errcode=err) - i_mu = pbuf_get_index('MU',errcode=err) - i_lambda = pbuf_get_index('LAMBDAC',errcode=err) - i_iciwp = pbuf_get_index('ICIWP',errcode=err) - i_iclwp = pbuf_get_index('ICLWP',errcode=err) - i_des = pbuf_get_index('DES',errcode=err) - i_icswp = pbuf_get_index('ICSWP',errcode=err) - i_icgrauwp = pbuf_get_index('ICGRAUWP',errcode=err) ! Available when using MG3 - i_degrau = pbuf_get_index('DEGRAU',errcode=err) ! Available when using MG3 - - ! old optics - call cnst_get_ind('CLDICE', ixcldice) - call cnst_get_ind('CLDLIQ', ixcldliq) - - ! read liquid cloud optics - if(masterproc) then - call getfil( trim(liquidfile), locfn, 0) - call handle_ncerr( nf90_open(locfn, NF90_NOWRITE, ncid), 'liquid optics file missing') - write(iulog,*)' reading liquid cloud optics from file ',locfn - - call handle_ncerr(nf90_inq_dimid( ncid, 'lw_band', dimid), 'getting lw_band dim') - call handle_ncerr(nf90_inquire_dimension( ncid, dimid, len=f_nlwbands), 'getting n lw bands') - if (f_nlwbands /= nlwbands) call endrun('number of lw bands does not match') - - call handle_ncerr(nf90_inq_dimid( ncid, 'sw_band', dimid), 'getting sw_band_dim') - call handle_ncerr(nf90_inquire_dimension( ncid, dimid, len=f_nswbands), 'getting n sw bands') - if (f_nswbands /= nswbands) call endrun('number of sw bands does not match') - - call handle_ncerr(nf90_inq_dimid( ncid, 'mu', mudimid), 'getting mu dim') - call handle_ncerr(nf90_inquire_dimension( ncid, mudimid, len=nmu), 'getting n mu samples') - - call handle_ncerr(nf90_inq_dimid( ncid, 'lambda_scale', lambdadimid), 'getting lambda dim') - call handle_ncerr(nf90_inquire_dimension( ncid, lambdadimid, len=nlambda), 'getting n lambda samples') - endif ! if (masterproc) - -#if ( defined SPMD ) - call mpibcast(nmu, 1, mpiint, 0, mpicom, ierr) - call mpibcast(nlambda, 1, mpiint, 0, mpicom, ierr) -#endif - - allocate(g_mu(nmu)) - allocate(g_lambda(nmu,nlambda)) - allocate(ext_sw_liq(nmu,nlambda,nswbands) ) - allocate(ssa_sw_liq(nmu,nlambda,nswbands)) - allocate(asm_sw_liq(nmu,nlambda,nswbands)) - allocate(abs_lw_liq(nmu,nlambda,nlwbands)) - - if(masterproc) then - call handle_ncerr( nf90_inq_varid(ncid, 'mu', mu_id),& - 'cloud optics mu get') - call handle_ncerr( nf90_get_var(ncid, mu_id, g_mu),& - 'read cloud optics mu values') - - call handle_ncerr( nf90_inq_varid(ncid, 'lambda', lambda_id),& - 'cloud optics lambda get') - call handle_ncerr( nf90_get_var(ncid, lambda_id, g_lambda),& - 'read cloud optics lambda values') - - call handle_ncerr( nf90_inq_varid(ncid, 'k_ext_sw', ext_sw_liq_id),& - 'cloud optics ext_sw_liq get') - call handle_ncerr( nf90_get_var(ncid, ext_sw_liq_id, ext_sw_liq),& - 'read cloud optics ext_sw_liq values') - - call handle_ncerr( nf90_inq_varid(ncid, 'ssa_sw', ssa_sw_liq_id),& - 'cloud optics ssa_sw_liq get') - call handle_ncerr( nf90_get_var(ncid, ssa_sw_liq_id, ssa_sw_liq),& - 'read cloud optics ssa_sw_liq values') - - call handle_ncerr( nf90_inq_varid(ncid, 'asm_sw', asm_sw_liq_id),& - 'cloud optics asm_sw_liq get') - call handle_ncerr( nf90_get_var(ncid, asm_sw_liq_id, asm_sw_liq),& - 'read cloud optics asm_sw_liq values') - - call handle_ncerr( nf90_inq_varid(ncid, 'k_abs_lw', abs_lw_liq_id),& - 'cloud optics abs_lw_liq get') - call handle_ncerr( nf90_get_var(ncid, abs_lw_liq_id, abs_lw_liq),& - 'read cloud optics abs_lw_liq values') - - call handle_ncerr( nf90_close(ncid), 'liquid optics file missing') - endif ! if masterproc - -#if ( defined SPMD ) - call mpibcast(g_mu, nmu, mpir8, 0, mpicom, ierr) - call mpibcast(g_lambda, nmu*nlambda, mpir8, 0, mpicom, ierr) - call mpibcast(ext_sw_liq, nmu*nlambda*nswbands, mpir8, 0, mpicom, ierr) - call mpibcast(ssa_sw_liq, nmu*nlambda*nswbands, mpir8, 0, mpicom, ierr) - call mpibcast(asm_sw_liq, nmu*nlambda*nswbands, mpir8, 0, mpicom, ierr) - call mpibcast(abs_lw_liq, nmu*nlambda*nlwbands, mpir8, 0, mpicom, ierr) -#endif - ! I forgot to convert kext from m^2/Volume to m^2/Kg - ext_sw_liq = ext_sw_liq / 0.9970449e3_r8 - abs_lw_liq = abs_lw_liq / 0.9970449e3_r8 - - ! read ice cloud optics - if(masterproc) then - call getfil( trim(icefile), locfn, 0) - call handle_ncerr( nf90_open(locfn, NF90_NOWRITE, ncid), 'ice optics file missing') - write(iulog,*)' reading ice cloud optics from file ',locfn - - call handle_ncerr(nf90_inq_dimid( ncid, 'lw_band', dimid), 'getting lw_band dim') - call handle_ncerr(nf90_inquire_dimension( ncid, dimid, len=f_nlwbands), 'getting n lw bands') - if (f_nlwbands /= nlwbands) call endrun('number of lw bands does not match') - - call handle_ncerr(nf90_inq_dimid( ncid, 'sw_band', dimid), 'getting sw_band_dim') - call handle_ncerr(nf90_inquire_dimension( ncid, dimid, len=f_nswbands), 'getting n sw bands') - if (f_nswbands /= nswbands) call endrun('number of sw bands does not match') - - call handle_ncerr(nf90_inq_dimid( ncid, 'd_eff', d_dimid), 'getting deff dim') - call handle_ncerr(nf90_inquire_dimension( ncid, d_dimid, len=n_g_d), 'getting n deff samples') - - endif ! if (masterproc) - -#if ( defined SPMD ) - call mpibcast(n_g_d, 1, mpiint, 0, mpicom, ierr) -! call mpibcast(nswbands, 1, mpiint, 0, mpicom, ierr) -! call mpibcast(nlwbands, 1, mpiint, 0, mpicom, ierr) -#endif - - allocate(g_d_eff(n_g_d)) - allocate(ext_sw_ice(n_g_d,nswbands)) - allocate(ssa_sw_ice(n_g_d,nswbands)) - allocate(asm_sw_ice(n_g_d,nswbands)) - allocate(abs_lw_ice(n_g_d,nlwbands)) - - if(masterproc) then - call handle_ncerr( nf90_inq_varid(ncid, 'd_eff', d_id),& - 'cloud optics deff get') - call handle_ncerr( nf90_get_var(ncid, d_id, g_d_eff),& - 'read cloud optics deff values') - - call handle_ncerr( nf90_inq_varid(ncid, 'sw_ext', ext_sw_ice_id),& - 'cloud optics ext_sw_ice get') - call handle_ncerr(nf90_inquire_variable ( ncid, ext_sw_ice_id, ndims=ndims, dimids=vdimids),& - 'checking dimensions of ext_sw_ice') - call handle_ncerr(nf90_inquire_dimension( ncid, vdimids(1), len=templen),& - 'getting first dimension sw_ext') - !write(iulog,*) 'expected length',n_g_d,'actual len',templen - call handle_ncerr(nf90_inquire_dimension( ncid, vdimids(2), len=templen),& - 'getting first dimension sw_ext') - !write(iulog,*) 'expected length',nswbands,'actual len',templen - call handle_ncerr( nf90_get_var(ncid, ext_sw_ice_id, ext_sw_ice),& - 'read cloud optics ext_sw_ice values') - - call handle_ncerr( nf90_inq_varid(ncid, 'sw_ssa', ssa_sw_ice_id),& - 'cloud optics ssa_sw_ice get') - call handle_ncerr( nf90_get_var(ncid, ssa_sw_ice_id, ssa_sw_ice),& - 'read cloud optics ssa_sw_ice values') - - call handle_ncerr( nf90_inq_varid(ncid, 'sw_asm', asm_sw_ice_id),& - 'cloud optics asm_sw_ice get') - call handle_ncerr( nf90_get_var(ncid, asm_sw_ice_id, asm_sw_ice),& - 'read cloud optics asm_sw_ice values') - - call handle_ncerr( nf90_inq_varid(ncid, 'lw_abs', abs_lw_ice_id),& - 'cloud optics abs_lw_ice get') - call handle_ncerr( nf90_get_var(ncid, abs_lw_ice_id, abs_lw_ice),& - 'read cloud optics abs_lw_ice values') - - call handle_ncerr( nf90_close(ncid), 'ice optics file missing') - - endif ! if masterproc -#if ( defined SPMD ) - call mpibcast(g_d_eff, n_g_d, mpir8, 0, mpicom, ierr) - call mpibcast(ext_sw_ice, n_g_d*nswbands, mpir8, 0, mpicom, ierr) - call mpibcast(ssa_sw_ice, n_g_d*nswbands, mpir8, 0, mpicom, ierr) - call mpibcast(asm_sw_ice, n_g_d*nswbands, mpir8, 0, mpicom, ierr) - call mpibcast(abs_lw_ice, n_g_d*nlwbands, mpir8, 0, mpicom, ierr) -#endif - - return - -end subroutine cloud_rad_props_init - -!============================================================================== - -subroutine cloud_rad_props_get_sw(state, pbuf, & - tau, tau_w, tau_w_g, tau_w_f,& - diagnosticindex, oldliq, oldice) - -! return totaled (across all species) layer tau, omega, g, f -! for all spectral interval for aerosols affecting the climate - - ! Arguments - type(physics_state), intent(in) :: state - type(physics_buffer_desc),pointer :: pbuf(:) - integer, optional, intent(in) :: diagnosticindex ! index (if present) to radiation diagnostic information - - real(r8), intent(out) :: tau (nswbands,pcols,pver) ! aerosol extinction optical depth - real(r8), intent(out) :: tau_w (nswbands,pcols,pver) ! aerosol single scattering albedo * tau - real(r8), intent(out) :: tau_w_g(nswbands,pcols,pver) ! aerosol assymetry parameter * tau * w - real(r8), intent(out) :: tau_w_f(nswbands,pcols,pver) ! aerosol forward scattered fraction * tau * w - - logical, optional, intent(in) :: oldliq,oldice - - ! Local variables - - integer :: ncol - integer :: lchnk - integer :: k, i ! lev and daycolumn indices - integer :: iswband ! sw band indices - - ! optical props for each aerosol - real(r8), pointer :: h_ext(:,:) - real(r8), pointer :: h_ssa(:,:) - real(r8), pointer :: h_asm(:,:) - real(r8), pointer :: n_ext(:) - real(r8), pointer :: n_ssa(:) - real(r8), pointer :: n_asm(:) - - ! rad properties for liquid clouds - real(r8) :: liq_tau (nswbands,pcols,pver) ! aerosol extinction optical depth - real(r8) :: liq_tau_w (nswbands,pcols,pver) ! aerosol single scattering albedo * tau - real(r8) :: liq_tau_w_g(nswbands,pcols,pver) ! aerosol assymetry parameter * tau * w - real(r8) :: liq_tau_w_f(nswbands,pcols,pver) ! aerosol forward scattered fraction * tau * w - - ! rad properties for ice clouds - real(r8) :: ice_tau (nswbands,pcols,pver) ! aerosol extinction optical depth - real(r8) :: ice_tau_w (nswbands,pcols,pver) ! aerosol single scattering albedo * tau - real(r8) :: ice_tau_w_g(nswbands,pcols,pver) ! aerosol assymetry parameter * tau * w - real(r8) :: ice_tau_w_f(nswbands,pcols,pver) ! aerosol forward scattered fraction * tau * w - - !----------------------------------------------------------------------------- - - ncol = state%ncol - lchnk = state%lchnk - - ! initialize to conditions that would cause failure - tau (:,:,:) = -100._r8 - tau_w (:,:,:) = -100._r8 - tau_w_g (:,:,:) = -100._r8 - tau_w_f (:,:,:) = -100._r8 - - ! initialize layers to accumulate od's - tau (:,1:ncol,:) = 0._r8 - tau_w (:,1:ncol,:) = 0._r8 - tau_w_g(:,1:ncol,:) = 0._r8 - tau_w_f(:,1:ncol,:) = 0._r8 - - - call get_liquid_optics_sw(state, pbuf, liq_tau, liq_tau_w, liq_tau_w_g, liq_tau_w_f) - - call get_ice_optics_sw (state, pbuf, ice_tau, ice_tau_w, ice_tau_w_g, ice_tau_w_f) - - tau (:,1:ncol,:) = liq_tau (:,1:ncol,:) + ice_tau (:,1:ncol,:) - tau_w (:,1:ncol,:) = liq_tau_w (:,1:ncol,:) + ice_tau_w (:,1:ncol,:) - tau_w_g(:,1:ncol,:) = liq_tau_w_g(:,1:ncol,:) + ice_tau_w_g(:,1:ncol,:) - tau_w_f(:,1:ncol,:) = liq_tau_w_f(:,1:ncol,:) + ice_tau_w_f(:,1:ncol,:) - -end subroutine cloud_rad_props_get_sw -!============================================================================== - -subroutine cloud_rad_props_get_lw(state, pbuf, cld_abs_od, diagnosticindex, oldliq, oldice, oldcloud) - -! Purpose: Compute cloud longwave absorption optical depth -! cloud_rad_props_get_lw() is called by radlw() - - ! Arguments - type(physics_state), intent(in) :: state - type(physics_buffer_desc),pointer:: pbuf(:) - real(r8), intent(out) :: cld_abs_od(nlwbands,pcols,pver) ! [fraction] absorption optical depth, per layer - integer, optional, intent(in) :: diagnosticindex - logical, optional, intent(in) :: oldliq ! use old liquid optics - logical, optional, intent(in) :: oldice ! use old ice optics - logical, optional, intent(in) :: oldcloud ! use old optics for both (b4b) - - ! Local variables - - integer :: bnd_idx ! LW band index - integer :: i ! column index - integer :: k ! lev index - integer :: ncol ! number of columns - integer :: lchnk - - ! rad properties for liquid clouds - real(r8) :: liq_tau_abs_od(nlwbands,pcols,pver) ! liquid cloud absorption optical depth - - ! rad properties for ice clouds - real(r8) :: ice_tau_abs_od(nlwbands,pcols,pver) ! ice cloud absorption optical depth - - !----------------------------------------------------------------------------- - - ncol = state%ncol - lchnk = state%lchnk - - ! compute optical depths cld_absod - cld_abs_od = 0._r8 - - if(present(oldcloud))then - if(oldcloud) then - ! make diagnostic calls to these first to output ice and liq OD's - !call old_liq_get_rad_props_lw(state, pbuf, liq_tau_abs_od, oldliqwp=.false.) - !call old_ice_get_rad_props_lw(state, pbuf, ice_tau_abs_od, oldicewp=.false.) - ! This affects climate (cld_abs_od) - call oldcloud_lw(state,pbuf,cld_abs_od,oldwp=.false.) - return - endif - endif - - if(present(oldliq))then - if(oldliq) then - call old_liq_get_rad_props_lw(state, pbuf, liq_tau_abs_od, oldliqwp=.false.) - else - call liquid_cloud_get_rad_props_lw(state, pbuf, liq_tau_abs_od) - endif - else - call liquid_cloud_get_rad_props_lw(state, pbuf, liq_tau_abs_od) - endif - - if(present(oldice))then - if(oldice) then - call old_ice_get_rad_props_lw(state, pbuf, ice_tau_abs_od, oldicewp=.false.) - else - call ice_cloud_get_rad_props_lw(state, pbuf, ice_tau_abs_od) - endif - else - call ice_cloud_get_rad_props_lw(state, pbuf, ice_tau_abs_od) - endif - - cld_abs_od(:,1:ncol,:) = liq_tau_abs_od(:,1:ncol,:) + ice_tau_abs_od(:,1:ncol,:) - -end subroutine cloud_rad_props_get_lw - -!============================================================================== - -subroutine get_snow_optics_sw(state, pbuf, tau, tau_w, tau_w_g, tau_w_f) - type(physics_state), intent(in) :: state - type(physics_buffer_desc),pointer :: pbuf(:) - - real(r8),intent(out) :: tau (nswbands,pcols,pver) ! extinction optical depth - real(r8),intent(out) :: tau_w (nswbands,pcols,pver) ! single scattering albedo * tau - real(r8),intent(out) :: tau_w_g(nswbands,pcols,pver) ! assymetry parameter * tau * w - real(r8),intent(out) :: tau_w_f(nswbands,pcols,pver) ! forward scattered fraction * tau * w - - real(r8), pointer :: icswpth(:,:), des(:,:) - - ! This does the same thing as get_ice_optics_sw, except with a different - ! water path and effective diameter. - call pbuf_get_field(pbuf, i_icswp, icswpth) - call pbuf_get_field(pbuf, i_des, des) - - call interpolate_ice_optics_sw(state%ncol, icswpth, des, tau, tau_w, & - tau_w_g, tau_w_f) - -end subroutine get_snow_optics_sw - -!============================================================================== - -subroutine get_grau_optics_sw(state, pbuf, tau, tau_w, tau_w_g, tau_w_f) - type(physics_state), intent(in) :: state - type(physics_buffer_desc),pointer :: pbuf(:) - - real(r8),intent(out) :: tau (nswbands,pcols,pver) ! extinction optical depth - real(r8),intent(out) :: tau_w (nswbands,pcols,pver) ! single scattering albedo * tau - real(r8),intent(out) :: tau_w_g(nswbands,pcols,pver) ! assymetry parameter * tau * w - real(r8),intent(out) :: tau_w_f(nswbands,pcols,pver) ! forward scattered fraction * tau * w - - real(r8), pointer :: icgrauwpth(:,:), degrau(:,:) - - integer :: i,k - - ! This does the same thing as get_ice_optics_sw, except with a different - ! water path and effective diameter. - if((i_icgrauwp > 0) .and. (i_degrau > 0)) then - - call pbuf_get_field(pbuf, i_icgrauwp, icgrauwpth) - call pbuf_get_field(pbuf, i_degrau, degrau) - - call interpolate_ice_optics_sw(state%ncol, icgrauwpth, degrau, tau, tau_w, & - tau_w_g, tau_w_f) - do i = 1, pcols - do k = 1, pver - if (tau(idx_sw_diag,i,k).gt.100._r8) then - write(iulog,*) 'WARNING: SW Graupel Tau > 100 (i,k,icgrauwpth,degrau,tau):' - write(iulog,*) i,k,icgrauwpth(i,k), degrau(i,k), tau(idx_sw_diag,i,k) - end if - enddo - enddo - - else - call endrun('ERROR: Get_grau_optics_sw called when graupel properties not supported') - end if - -end subroutine get_grau_optics_sw - -!============================================================================== -! Private methods -!============================================================================== - -subroutine get_ice_optics_sw(state, pbuf, tau, tau_w, tau_w_g, tau_w_f) - type(physics_state), intent(in) :: state - type(physics_buffer_desc),pointer :: pbuf(:) - - real(r8),intent(out) :: tau (nswbands,pcols,pver) ! extinction optical depth - real(r8),intent(out) :: tau_w (nswbands,pcols,pver) ! single scattering albedo * tau - real(r8),intent(out) :: tau_w_g(nswbands,pcols,pver) ! assymetry parameter * tau * w - real(r8),intent(out) :: tau_w_f(nswbands,pcols,pver) ! forward scattered fraction * tau * w - - real(r8), pointer :: iciwpth(:,:), dei(:,:) - - ! Get relevant pbuf fields, and interpolate optical properties from - ! the lookup tables. - call pbuf_get_field(pbuf, i_iciwp, iciwpth) - call pbuf_get_field(pbuf, i_dei, dei) - - call interpolate_ice_optics_sw(state%ncol, iciwpth, dei, tau, tau_w, & - tau_w_g, tau_w_f) - -end subroutine get_ice_optics_sw - -!============================================================================== - -subroutine interpolate_ice_optics_sw(ncol, iciwpth, dei, tau, tau_w, & - tau_w_g, tau_w_f) - - integer, intent(in) :: ncol - real(r8), intent(in) :: iciwpth(pcols,pver) - real(r8), intent(in) :: dei(pcols,pver) - - real(r8),intent(out) :: tau (nswbands,pcols,pver) ! extinction optical depth - real(r8),intent(out) :: tau_w (nswbands,pcols,pver) ! single scattering albedo * tau - real(r8),intent(out) :: tau_w_g(nswbands,pcols,pver) ! assymetry parameter * tau * w - real(r8),intent(out) :: tau_w_f(nswbands,pcols,pver) ! forward scattered fraction * tau * w - - type(interp_type) :: dei_wgts - - integer :: i, k, swband - real(r8) :: ext(nswbands), ssa(nswbands), asm(nswbands) - - do k = 1,pver - do i = 1,ncol - if( iciwpth(i,k) < 1.e-80_r8 .or. dei(i,k) == 0._r8) then - ! if ice water path is too small, OD := 0 - tau (:,i,k) = 0._r8 - tau_w (:,i,k) = 0._r8 - tau_w_g(:,i,k) = 0._r8 - tau_w_f(:,i,k) = 0._r8 - else - ! for each cell interpolate to find weights in g_d_eff grid. - call lininterp_init(g_d_eff, n_g_d, dei(i:i,k), 1, & - extrap_method_bndry, dei_wgts) - ! interpolate into grid and extract radiative properties - do swband = 1, nswbands - call lininterp(ext_sw_ice(:,swband), n_g_d, & - ext(swband:swband), 1, dei_wgts) - call lininterp(ssa_sw_ice(:,swband), n_g_d, & - ssa(swband:swband), 1, dei_wgts) - call lininterp(asm_sw_ice(:,swband), n_g_d, & - asm(swband:swband), 1, dei_wgts) - end do - tau (:,i,k) = iciwpth(i,k) * ext - tau_w (:,i,k) = tau(:,i,k) * ssa - tau_w_g(:,i,k) = tau_w(:,i,k) * asm - tau_w_f(:,i,k) = tau_w_g(:,i,k) * asm - call lininterp_finish(dei_wgts) - endif - enddo - enddo - -end subroutine interpolate_ice_optics_sw - -!============================================================================== - -subroutine get_liquid_optics_sw(state, pbuf, tau, tau_w, tau_w_g, tau_w_f) - type(physics_state), intent(in) :: state - type(physics_buffer_desc),pointer :: pbuf(:) - - real(r8),intent(out) :: tau (nswbands,pcols,pver) ! extinction optical depth - real(r8),intent(out) :: tau_w (nswbands,pcols,pver) ! single scattering albedo * tau - real(r8),intent(out) :: tau_w_g(nswbands,pcols,pver) ! asymetry parameter * tau * w - real(r8),intent(out) :: tau_w_f(nswbands,pcols,pver) ! forward scattered fraction * tau * w - - real(r8), pointer, dimension(:,:) :: lamc, pgam, iclwpth - real(r8), dimension(pcols,pver) :: kext - integer i,k,swband,lchnk,ncol - - lchnk = state%lchnk - ncol = state%ncol - - - call pbuf_get_field(pbuf, i_lambda, lamc) - call pbuf_get_field(pbuf, i_mu, pgam) - call pbuf_get_field(pbuf, i_iclwp, iclwpth) - - do k = 1,pver - do i = 1,ncol - if(lamc(i,k) > 0._r8) then ! This seems to be clue from microphysics of no cloud - call gam_liquid_sw(iclwpth(i,k), lamc(i,k), pgam(i,k), & - tau(1:nswbands,i,k), tau_w(1:nswbands,i,k), tau_w_g(1:nswbands,i,k), tau_w_f(1:nswbands,i,k)) - else - tau(1:nswbands,i,k) = 0._r8 - tau_w(1:nswbands,i,k) = 0._r8 - tau_w_g(1:nswbands,i,k) = 0._r8 - tau_w_f(1:nswbands,i,k) = 0._r8 - endif - enddo - enddo - -end subroutine get_liquid_optics_sw - -!============================================================================== - -subroutine liquid_cloud_get_rad_props_lw(state, pbuf, abs_od) - type(physics_state), intent(in) :: state - type(physics_buffer_desc),pointer :: pbuf(:) - real(r8), intent(out) :: abs_od(nlwbands,pcols,pver) - - integer :: lchnk, ncol - real(r8), pointer, dimension(:,:) :: lamc, pgam, iclwpth - - integer lwband, i, k - - abs_od = 0._r8 - - lchnk = state%lchnk - ncol = state%ncol - - call pbuf_get_field(pbuf, i_lambda, lamc) - call pbuf_get_field(pbuf, i_mu, pgam) - call pbuf_get_field(pbuf, i_iclwp, iclwpth) - - do k = 1,pver - do i = 1,ncol - if(lamc(i,k) > 0._r8) then ! This seems to be the clue for no cloud from microphysics formulation - call gam_liquid_lw(iclwpth(i,k), lamc(i,k), pgam(i,k), abs_od(1:nlwbands,i,k)) - else - abs_od(1:nlwbands,i,k) = 0._r8 - endif - enddo - enddo - -end subroutine liquid_cloud_get_rad_props_lw -!============================================================================== - -subroutine snow_cloud_get_rad_props_lw(state, pbuf, abs_od) - type(physics_state), intent(in) :: state - type(physics_buffer_desc), pointer :: pbuf(:) - real(r8), intent(out) :: abs_od(nlwbands,pcols,pver) - - real(r8), pointer :: icswpth(:,:), des(:,:) - - ! This does the same thing as ice_cloud_get_rad_props_lw, except with a - ! different water path and effective diameter. - call pbuf_get_field(pbuf, i_icswp, icswpth) - call pbuf_get_field(pbuf, i_des, des) - - call interpolate_ice_optics_lw(state%ncol,icswpth, des, abs_od) - -end subroutine snow_cloud_get_rad_props_lw - - -!============================================================================== - -subroutine grau_cloud_get_rad_props_lw(state, pbuf, abs_od) - type(physics_state), intent(in) :: state - type(physics_buffer_desc), pointer :: pbuf(:) - real(r8), intent(out) :: abs_od(nlwbands,pcols,pver) - - real(r8), pointer :: icgrauwpth(:,:), degrau(:,:) - - ! This does the same thing as ice_cloud_get_rad_props_lw, except with a - ! different water path and effective diameter. - if((i_icgrauwp > 0) .and. (i_degrau > 0)) then - call pbuf_get_field(pbuf, i_icgrauwp, icgrauwpth) - call pbuf_get_field(pbuf, i_degrau, degrau) - - call interpolate_ice_optics_lw(state%ncol,icgrauwpth, degrau, abs_od) - else - call endrun('ERROR: Grau_cloud_get_rad_props_lw called when graupel & - &properties not supported') - end if - -end subroutine grau_cloud_get_rad_props_lw - -!============================================================================== - -subroutine ice_cloud_get_rad_props_lw(state, pbuf, abs_od) - type(physics_state), intent(in) :: state - type(physics_buffer_desc), pointer :: pbuf(:) - real(r8), intent(out) :: abs_od(nlwbands,pcols,pver) - - real(r8), pointer :: iciwpth(:,:), dei(:,:) - - ! Get relevant pbuf fields, and interpolate optical properties from - ! the lookup tables. - call pbuf_get_field(pbuf, i_iciwp, iciwpth) - call pbuf_get_field(pbuf, i_dei, dei) - - call interpolate_ice_optics_lw(state%ncol,iciwpth, dei, abs_od) - -end subroutine ice_cloud_get_rad_props_lw - -!============================================================================== - -subroutine interpolate_ice_optics_lw(ncol, iciwpth, dei, abs_od) - - integer, intent(in) :: ncol - real(r8), intent(in) :: iciwpth(pcols,pver) - real(r8), intent(in) :: dei(pcols,pver) - - real(r8),intent(out) :: abs_od(nlwbands,pcols,pver) - - type(interp_type) :: dei_wgts - - integer :: i, k, lwband - real(r8) :: absor(nlwbands) - - do k = 1,pver - do i = 1,ncol - ! if ice water path is too small, OD := 0 - if( iciwpth(i,k) < 1.e-80_r8 .or. dei(i,k) == 0._r8) then - abs_od (:,i,k) = 0._r8 - else - ! for each cell interpolate to find weights in g_d_eff grid. - call lininterp_init(g_d_eff, n_g_d, dei(i:i,k), 1, & - extrap_method_bndry, dei_wgts) - ! interpolate into grid and extract radiative properties - do lwband = 1, nlwbands - call lininterp(abs_lw_ice(:,lwband), n_g_d, & - absor(lwband:lwband), 1, dei_wgts) - enddo - abs_od(:,i,k) = iciwpth(i,k) * absor - where(abs_od(:,i,k) > 50.0_r8) abs_od(:,i,k) = 50.0_r8 - call lininterp_finish(dei_wgts) - endif - enddo - enddo - -end subroutine interpolate_ice_optics_lw - -!============================================================================== - -subroutine gam_liquid_lw(clwptn, lamc, pgam, abs_od) - real(r8), intent(in) :: clwptn ! cloud water liquid path new (in cloud) (in g/m^2)? - real(r8), intent(in) :: lamc ! prognosed value of lambda for cloud - real(r8), intent(in) :: pgam ! prognosed value of mu for cloud - real(r8), intent(out) :: abs_od(1:nlwbands) - - integer :: lwband ! sw band index - - type(interp_type) :: mu_wgts - type(interp_type) :: lambda_wgts - - if (clwptn < 1.e-80_r8) then - abs_od = 0._r8 - return - endif - - call get_mu_lambda_weights(lamc, pgam, mu_wgts, lambda_wgts) - - do lwband = 1, nlwbands - call lininterp(abs_lw_liq(:,:,lwband), nmu, nlambda, & - abs_od(lwband:lwband), 1, mu_wgts, lambda_wgts) - enddo - - abs_od = clwptn * abs_od - - call lininterp_finish(mu_wgts) - call lininterp_finish(lambda_wgts) - -end subroutine gam_liquid_lw - -!============================================================================== - -subroutine gam_liquid_sw(clwptn, lamc, pgam, tau, tau_w, tau_w_g, tau_w_f) - real(r8), intent(in) :: clwptn ! cloud water liquid path new (in cloud) (in g/m^2)? - real(r8), intent(in) :: lamc ! prognosed value of lambda for cloud - real(r8), intent(in) :: pgam ! prognosed value of mu for cloud - real(r8), intent(out) :: tau(1:nswbands), tau_w(1:nswbands), tau_w_f(1:nswbands), tau_w_g(1:nswbands) - - integer :: swband ! sw band index - - real(r8) :: ext(nswbands), ssa(nswbands), asm(nswbands) - - type(interp_type) :: mu_wgts - type(interp_type) :: lambda_wgts - - if (clwptn < 1.e-80_r8) then - tau = 0._r8 - tau_w = 0._r8 - tau_w_g = 0._r8 - tau_w_f = 0._r8 - return - endif - - call get_mu_lambda_weights(lamc, pgam, mu_wgts, lambda_wgts) - - do swband = 1, nswbands - call lininterp(ext_sw_liq(:,:,swband), nmu, nlambda, & - ext(swband:swband), 1, mu_wgts, lambda_wgts) - call lininterp(ssa_sw_liq(:,:,swband), nmu, nlambda, & - ssa(swband:swband), 1, mu_wgts, lambda_wgts) - call lininterp(asm_sw_liq(:,:,swband), nmu, nlambda, & - asm(swband:swband), 1, mu_wgts, lambda_wgts) - enddo - - ! compute radiative properties - tau = clwptn * ext - tau_w = tau * ssa - tau_w_g = tau_w * asm - tau_w_f = tau_w_g * asm - - call lininterp_finish(mu_wgts) - call lininterp_finish(lambda_wgts) - -end subroutine gam_liquid_sw - -!============================================================================== - -subroutine get_mu_lambda_weights(lamc, pgam, mu_wgts, lambda_wgts) - real(r8), intent(in) :: lamc ! prognosed value of lambda for cloud - real(r8), intent(in) :: pgam ! prognosed value of mu for cloud - ! Output interpolation weights. Caller is responsible for freeing these. - type(interp_type), intent(out) :: mu_wgts - type(interp_type), intent(out) :: lambda_wgts - - integer :: ilambda - real(r8) :: g_lambda_interp(nlambda) - - ! Make interpolation weights for mu. - ! (Put pgam in a temporary array for this purpose.) - call lininterp_init(g_mu, nmu, [pgam], 1, extrap_method_bndry, mu_wgts) - - ! Use mu weights to interpolate to a row in the lambda table. - do ilambda = 1, nlambda - call lininterp(g_lambda(:,ilambda), nmu, & - g_lambda_interp(ilambda:ilambda), 1, mu_wgts) - end do - - ! Make interpolation weights for lambda. - call lininterp_init(g_lambda_interp, nlambda, [lamc], 1, & - extrap_method_bndry, lambda_wgts) - -end subroutine get_mu_lambda_weights - -!============================================================================== - -end module cloud_rad_props diff --git a/src/physics/rrtmg/ebert_curry.F90 b/src/physics/rrtmg/ebert_curry.F90 deleted file mode 100644 index 7bca4ce257..0000000000 --- a/src/physics/rrtmg/ebert_curry.F90 +++ /dev/null @@ -1,408 +0,0 @@ -module ebert_curry - -!------------------------------------------------------------------------------------------------ -!------------------------------------------------------------------------------------------------ - -use shr_kind_mod, only: r8 => shr_kind_r8 -use ppgrid, only: pcols, pver, pverp -use physics_types, only: physics_state -use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_get_field, pbuf_old_tim_idx -use radconstants, only: nswbands, nlwbands, idx_sw_diag, idx_lw_diag, get_sw_spectral_boundaries -use cam_abortutils, only: endrun -use cam_history, only: outfld - -implicit none -private -save - -public :: & - ec_rad_props_init, & - cloud_rad_props_get_sw, & ! return SW optical props of total bulk aerosols - cloud_rad_props_get_lw, & ! return LW optical props of total bulk aerosols - ec_ice_optics_sw, & - ec_ice_get_rad_props_lw - - -real(r8), public, parameter:: scalefactor = 1._r8 !500._r8/917._r8 - -! Minimum cloud amount (as a fraction of the grid-box area) to -! distinguish from clear sky -! - real(r8) cldmin - parameter (cldmin = 1.0e-80_r8) -! -! Decimal precision of cloud amount (0 -> preserve full resolution; -! 10^-n -> preserve n digits of cloud amount) -! - real(r8) cldeps - parameter (cldeps = 0.0_r8) - -! -! indexes into pbuf for optical parameters of MG clouds -! - integer :: dei_idx = 0 - integer :: mu_idx = 0 - integer :: lambda_idx = 0 - integer :: iciwp_idx = 0 - integer :: iclwp_idx = 0 - integer :: cld_idx = 0 - integer :: rei_idx = 0 - -! indexes into constituents for old optics - integer :: & - ixcldice, & ! cloud ice water index - ixcldliq ! cloud liquid water index - - -!============================================================================== -contains -!============================================================================== - -subroutine ec_rad_props_init() - -! use cam_history, only: addfld - use netcdf - use spmd_utils, only: masterproc - use ioFileMod, only: getfil - use cam_logfile, only: iulog - use error_messages, only: handle_ncerr -#if ( defined SPMD ) - use mpishorthand -#endif - use constituents, only: cnst_get_ind - - integer :: err - - iciwp_idx = pbuf_get_index('ICIWP',errcode=err) - iclwp_idx = pbuf_get_index('ICLWP',errcode=err) - cld_idx = pbuf_get_index('CLD') - rei_idx = pbuf_get_index('REI') - - ! old optics - call cnst_get_ind('CLDICE', ixcldice) - call cnst_get_ind('CLDLIQ', ixcldliq) - - !call addfld ('CLWPTH_OLD',(/ 'lev' /), 'I','Kg/m2','old In Cloud Liquid Water Path', sampling_seq='rad_lwsw') - !call addfld ('KEXT_OLD',(/ 'lev' /),'I','m^2/kg','old extinction') - !call addfld ('CLDOD_OLD',(/ 'lev' /),'I','1','old liquid OD') - !call addfld ('REL_OLD',(/ 'lev' /),'I','1','old liquid effective radius (liquid)') - - !call addfld ('CLWPTH_NEW',(/ 'lev' /), 'I','Kg/m2','In Cloud Liquid Water Path', sampling_seq='rad_lwsw') - !call addfld ('KEXT_NEW',(/ 'lev' /),'I','m^2/kg','extinction') - !call addfld ('CLDOD_NEW',(/ 'lev' /),'I','1','liquid OD') - - !call addfld('CIWPTH_NEW',(/ 'lev' /), 'I','Kg/m2','In Cloud Ice Water Path', sampling_seq='rad_lwsw') - !call addfld('CIWPTH_OLD',(/ 'lev' /), 'I','Kg/m2','In Cloud Ice Water Path (old)', sampling_seq='rad_lwsw') - - return - -end subroutine ec_rad_props_init - -!============================================================================== - -subroutine cloud_rad_props_get_sw(state, pbuf, & - tau, tau_w, tau_w_g, tau_w_f,& - diagnosticindex, oldliq, oldice) - -! return totaled (across all species) layer tau, omega, g, f -! for all spectral interval for aerosols affecting the climate - - ! Arguments - type(physics_state), intent(in) :: state - type(physics_buffer_desc), pointer :: pbuf(:) - integer, optional, intent(in) :: diagnosticindex ! index (if present) to radiation diagnostic information - - real(r8), intent(out) :: tau (nswbands,pcols,pver) ! aerosol extinction optical depth - real(r8), intent(out) :: tau_w (nswbands,pcols,pver) ! aerosol single scattering albedo * tau - real(r8), intent(out) :: tau_w_g(nswbands,pcols,pver) ! aerosol assymetry parameter * tau * w - real(r8), intent(out) :: tau_w_f(nswbands,pcols,pver) ! aerosol forward scattered fraction * tau * w - - logical, optional, intent(in) :: oldliq,oldice - - ! Local variables - - integer :: ncol - integer :: lchnk - integer :: k, i ! lev and daycolumn indices - integer :: iswband ! sw band indices - - !----------------------------------------------------------------------------- - - ncol = state%ncol - lchnk = state%lchnk - - ! initialize to conditions that would cause failure - tau (:,:,:) = -100._r8 - tau_w (:,:,:) = -100._r8 - tau_w_g (:,:,:) = -100._r8 - tau_w_f (:,:,:) = -100._r8 - - ! initialize layers to accumulate od's - tau (:,1:ncol,:) = 0._r8 - tau_w (:,1:ncol,:) = 0._r8 - tau_w_g(:,1:ncol,:) = 0._r8 - tau_w_f(:,1:ncol,:) = 0._r8 - - - call ec_ice_optics_sw (state, pbuf, tau, tau_w, tau_w_g, tau_w_f, oldicewp=.true.) -! call outfld ('CI_OD_SW_OLD', ice_tau(idx_sw_diag,:,:), pcols, lchnk) - - -end subroutine cloud_rad_props_get_sw -!============================================================================== - -subroutine cloud_rad_props_get_lw(state, pbuf, cld_abs_od, diagnosticindex, oldliq, oldice, oldcloud) - -! Purpose: Compute cloud longwave absorption optical depth -! cloud_rad_props_get_lw() is called by radlw() - - ! Arguments - type(physics_state), intent(in) :: state - type(physics_buffer_desc), pointer :: pbuf(:) - real(r8), intent(out) :: cld_abs_od(nlwbands,pcols,pver) ! [fraction] absorption optical depth, per layer - integer, optional, intent(in) :: diagnosticindex - logical, optional, intent(in) :: oldliq ! use old liquid optics - logical, optional, intent(in) :: oldice ! use old ice optics - logical, optional, intent(in) :: oldcloud ! use old optics for both (b4b) - - ! Local variables - - integer :: bnd_idx ! LW band index - integer :: i ! column index - integer :: k ! lev index - integer :: ncol ! number of columns - integer :: lchnk - - !----------------------------------------------------------------------------- - - ncol = state%ncol - lchnk = state%lchnk - - ! compute optical depths cld_absod - cld_abs_od = 0._r8 - - call ec_ice_get_rad_props_lw(state, pbuf, cld_abs_od, oldicewp=.true.) - !call outfld('CI_OD_LW_OLD', ice_tau_abs_od(idx_lw_diag ,:,:), pcols, lchnk) - -end subroutine cloud_rad_props_get_lw - -!============================================================================== -! Private methods -!============================================================================== - -subroutine ec_ice_optics_sw (state, pbuf, ice_tau, ice_tau_w, ice_tau_w_g, ice_tau_w_f, oldicewp) - - use physconst, only: gravit - - type(physics_state), intent(in) :: state - type(physics_buffer_desc), pointer :: pbuf(:) - - real(r8),intent(out) :: ice_tau (nswbands,pcols,pver) ! extinction optical depth - real(r8),intent(out) :: ice_tau_w (nswbands,pcols,pver) ! single scattering albedo * tau - real(r8),intent(out) :: ice_tau_w_g(nswbands,pcols,pver) ! assymetry parameter * tau * w - real(r8),intent(out) :: ice_tau_w_f(nswbands,pcols,pver) ! forward scattered fraction * tau * w - logical, intent(in) :: oldicewp - - real(r8), pointer, dimension(:,:) :: rei - real(r8), pointer, dimension(:,:) :: cldn - real(r8), pointer, dimension(:,:) :: tmpptr - real(r8), dimension(pcols,pver) :: cicewp - real(r8), dimension(nswbands) :: wavmin - real(r8), dimension(nswbands) :: wavmax - ! - ! ice water coefficients (Ebert and Curry,1992, JGR, 97, 3831-3836) - real(r8) :: abari(4) = & ! a coefficient for extinction optical depth - (/ 3.448e-03_r8, 3.448e-03_r8,3.448e-03_r8,3.448e-03_r8/) - real(r8) :: bbari(4) = & ! b coefficient for extinction optical depth - (/ 2.431_r8 , 2.431_r8 ,2.431_r8 ,2.431_r8 /) - real(r8) :: cbari(4) = & ! c coefficient for single scat albedo - (/ 1.00e-05_r8 , 1.10e-04_r8 ,1.861e-02_r8,.46658_r8 /) - real(r8) :: dbari(4) = & ! d coefficient for single scat albedo - (/ 0.0_r8 , 1.405e-05_r8,8.328e-04_r8,2.05e-05_r8 /) - real(r8) :: ebari(4) = & ! e coefficient for asymmetry parameter - (/ 0.7661_r8 , 0.7730_r8 ,0.794_r8 ,0.9595_r8 /) - real(r8) :: fbari(4) = & ! f coefficient for asymmetry parameter - (/ 5.851e-04_r8, 5.665e-04_r8,7.267e-04_r8,1.076e-04_r8/) - - real(r8) :: abarii ! A coefficient for current spectral band - real(r8) :: bbarii ! B coefficient for current spectral band - real(r8) :: cbarii ! C coefficient for current spectral band - real(r8) :: dbarii ! D coefficient for current spectral band - real(r8) :: ebarii ! E coefficient for current spectral band - real(r8) :: fbarii ! F coefficient for current spectral band - - ! Minimum cloud amount (as a fraction of the grid-box area) to - ! distinguish from clear sky - real(r8), parameter :: cldmin = 1.0e-80_r8 - - ! Decimal precision of cloud amount (0 -> preserve full resolution; - ! 10^-n -> preserve n digits of cloud amount) - real(r8), parameter :: cldeps = 0.0_r8 - - integer :: ns, i, k, indxsl, lchnk, Nday - integer :: itim_old - real(r8) :: tmp1i, tmp2i, tmp3i, g - - Nday = state%ncol - lchnk = state%lchnk - - itim_old = pbuf_old_tim_idx() - call pbuf_get_field(pbuf, cld_idx,cldn, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) - call pbuf_get_field(pbuf, rei_idx,rei) - - if(oldicewp) then - do k=1,pver - do i = 1,Nday - cicewp(i,k) = 1000.0_r8*state%q(i,k,ixcldice)*state%pdel(i,k) /(gravit* max(0.01_r8,cldn(i,k))) - end do - end do - else - if (iciwp_idx<=0) then - call endrun('ec_ice_optics_sw: oldicewp must be set to true since ICIWP was not found in pbuf') - endif - call pbuf_get_field(pbuf, iciwp_idx, tmpptr) - cicewp(1:pcols,1:pver) = 1000.0_r8*tmpptr(1:pcols,1:pver) - endif - - call get_sw_spectral_boundaries(wavmin,wavmax,'microns') - - do ns = 1, nswbands - - if(wavmax(ns) <= 0.7_r8) then - indxsl = 1 - else if(wavmax(ns) <= 1.25_r8) then - indxsl = 2 - else if(wavmax(ns) <= 2.38_r8) then - indxsl = 3 - else if(wavmax(ns) > 2.38_r8) then - indxsl = 4 - end if - - abarii = abari(indxsl) - bbarii = bbari(indxsl) - cbarii = cbari(indxsl) - dbarii = dbari(indxsl) - ebarii = ebari(indxsl) - fbarii = fbari(indxsl) - - do k=1,pver - do i=1,Nday - - ! note that optical properties for ice valid only - ! in range of 13 > rei > 130 micron (Ebert and Curry 92) - if (cldn(i,k) >= cldmin .and. cldn(i,k) >= cldeps) then - tmp1i = abarii + bbarii/max(13._r8,min(scalefactor*rei(i,k),130._r8)) - ice_tau(ns,i,k) = cicewp(i,k)*tmp1i - else - ice_tau(ns,i,k) = 0.0_r8 - endif - - tmp2i = 1._r8 - cbarii - dbarii*min(max(13._r8,scalefactor*rei(i,k)),130._r8) - tmp3i = fbarii*min(max(13._r8,scalefactor*rei(i,k)),130._r8) - ! Do not let single scatter albedo be 1. Delta-eddington solution - ! for non-conservative case has different analytic form from solution - ! for conservative case, and raddedmx is written for non-conservative case. - ice_tau_w(ns,i,k) = ice_tau(ns,i,k) * min(tmp2i,.999999_r8) - g = ebarii + tmp3i - ice_tau_w_g(ns,i,k) = ice_tau_w(ns,i,k) * g - ice_tau_w_f(ns,i,k) = ice_tau_w(ns,i,k) * g * g - - end do ! End do i=1,Nday - end do ! End do k=1,pver - end do ! nswbands - -end subroutine ec_ice_optics_sw -!============================================================================== - -subroutine ec_ice_get_rad_props_lw(state, pbuf, abs_od, oldicewp) - use physconst, only: gravit - - type(physics_state), intent(in) :: state - type(physics_buffer_desc),pointer :: pbuf(:) - real(r8), intent(out) :: abs_od(nlwbands,pcols,pver) - logical, intent(in) :: oldicewp - - real(r8) :: gicewp(pcols,pver) - real(r8) :: gliqwp(pcols,pver) - real(r8) :: cicewp(pcols,pver) - real(r8) :: cliqwp(pcols,pver) - real(r8) :: ficemr(pcols,pver) - real(r8) :: cwp(pcols,pver) - real(r8) :: cldtau(pcols,pver) - - real(r8), pointer, dimension(:,:) :: cldn - real(r8), pointer, dimension(:,:) :: rei - integer :: ncol, itim_old, lwband, i, k, lchnk - - real(r8) :: kabs, kabsi - - real(r8) kabsl ! longwave liquid absorption coeff (m**2/g) - parameter (kabsl = 0.090361_r8) - - real(r8), pointer, dimension(:,:) :: iclwpth, iciwpth - - - ncol = state%ncol - lchnk = state%lchnk - - itim_old = pbuf_old_tim_idx() - call pbuf_get_field(pbuf, rei_idx, rei) - call pbuf_get_field(pbuf, cld_idx, cldn, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) - - - if(oldicewp) then - do k=1,pver - do i = 1,ncol - gicewp(i,k) = state%q(i,k,ixcldice)*state%pdel(i,k)/gravit*1000.0_r8 ! Grid box ice water path. - gliqwp(i,k) = state%q(i,k,ixcldliq)*state%pdel(i,k)/gravit*1000.0_r8 ! Grid box liquid water path. - cicewp(i,k) = gicewp(i,k) / max(0.01_r8,cldn(i,k)) ! In-cloud ice water path. - cliqwp(i,k) = gliqwp(i,k) / max(0.01_r8,cldn(i,k)) ! In-cloud liquid water path. - ficemr(i,k) = state%q(i,k,ixcldice) / & - max(1.e-10_r8,(state%q(i,k,ixcldice)+state%q(i,k,ixcldliq))) - end do - end do - cwp(:ncol,:pver) = cicewp(:ncol,:pver) + cliqwp(:ncol,:pver) - else - if (iclwp_idx<=0 .or. iciwp_idx<=0) then - call endrun('ec_ice_get_rad_props_lw: oldicewp must be set to true since ICIWP and/or ICLWP were not found in pbuf') - endif - call pbuf_get_field(pbuf, iclwp_idx, iclwpth) - call pbuf_get_field(pbuf, iciwp_idx, iciwpth) - do k=1,pver - do i = 1,ncol - cwp(i,k) = 1000.0_r8 *iciwpth(i,k) + 1000.0_r8 *iclwpth(i,k) - ficemr(i,k) = 1000.0_r8*iciwpth(i,k)/(max(1.e-18_r8,cwp(i,k))) - end do - end do - endif - - do k=1,pver - do i=1,ncol - - ! Note from Andrew Conley: - ! Optics for RK no longer supported, This is constructed to get - ! close to bit for bit. Otherwise we could simply use ice water path - !note that optical properties for ice valid only - !in range of 13 > rei > 130 micron (Ebert and Curry 92) - kabsi = 0.005_r8 + 1._r8/min(max(13._r8,scalefactor*rei(i,k)),130._r8) - kabs = kabsi*ficemr(i,k) ! kabsl*(1._r8-ficemr(i,k)) + kabsi*ficemr(i,k) - !emis(i,k) = 1._r8 - exp(-1.66_r8*kabs*clwp(i,k)) - cldtau(i,k) = kabs*cwp(i,k) - end do - end do -! - do lwband = 1,nlwbands - abs_od(lwband,1:ncol,1:pver)=cldtau(1:ncol,1:pver) - enddo - - !if(oldicewp) then - ! call outfld('CIWPTH_OLD',cicewp(:,:)/1000,pcols,lchnk) - !else - ! call outfld('CIWPTH_OLD',iciwpth(:,:),pcols,lchnk) - !endif - !call outfld('CI_OD_LW_OLD',cldtau(:,:),pcols,lchnk) - -end subroutine ec_ice_get_rad_props_lw -!============================================================================== - -end module ebert_curry diff --git a/src/physics/rrtmg/oldcloud.F90 b/src/physics/rrtmg/oldcloud.F90 deleted file mode 100644 index fb0ae4d80e..0000000000 --- a/src/physics/rrtmg/oldcloud.F90 +++ /dev/null @@ -1,643 +0,0 @@ -module oldcloud - -!------------------------------------------------------------------------------------------------ -!------------------------------------------------------------------------------------------------ - -use shr_kind_mod, only: r8 => shr_kind_r8 -use ppgrid, only: pcols, pver, pverp -use physics_types, only: physics_state -use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_old_tim_idx, pbuf_get_field -use radconstants, only: nswbands, nlwbands, idx_sw_diag, idx_lw_diag, get_sw_spectral_boundaries -use cam_abortutils, only: endrun -use cam_history, only: outfld -use rad_constituents, only: iceopticsfile, liqopticsfile -use ebert_curry, only: scalefactor - -implicit none -private -save - -public :: & - oldcloud_init, oldcloud_lw, old_liq_get_rad_props_lw, old_ice_get_rad_props_lw - -integer :: nmu, nlambda -real(r8), allocatable :: g_mu(:) ! mu samples on grid -real(r8), allocatable :: g_lambda(:,:) ! lambda scale samples on grid -real(r8), allocatable :: ext_sw_liq(:,:,:) -real(r8), allocatable :: ssa_sw_liq(:,:,:) -real(r8), allocatable :: asm_sw_liq(:,:,:) -real(r8), allocatable :: abs_lw_liq(:,:,:) - -integer :: n_g_d -real(r8), allocatable :: g_d_eff(:) ! radiative effective diameter samples on grid -real(r8), allocatable :: ext_sw_ice(:,:) -real(r8), allocatable :: ssa_sw_ice(:,:) -real(r8), allocatable :: asm_sw_ice(:,:) -real(r8), allocatable :: abs_lw_ice(:,:) - -! Minimum cloud amount (as a fraction of the grid-box area) to -! distinguish from clear sky -! - real(r8) cldmin - parameter (cldmin = 1.0e-80_r8) -! -! Decimal precision of cloud amount (0 -> preserve full resolution; -! 10^-n -> preserve n digits of cloud amount) -! - real(r8) cldeps - parameter (cldeps = 0.0_r8) - -! -! indexes into pbuf for optical parameters of MG clouds -! - integer :: iciwp_idx = 0 - integer :: iclwp_idx = 0 - integer :: cld_idx = 0 - integer :: rel_idx = 0 - integer :: rei_idx = 0 - -! indexes into constituents for old optics - integer :: & - ixcldice, & ! cloud ice water index - ixcldliq ! cloud liquid water index - - -!============================================================================== -contains -!============================================================================== - -subroutine oldcloud_init() - - use constituents, only: cnst_get_ind - - integer :: err - - iciwp_idx = pbuf_get_index('ICIWP',errcode=err) - iclwp_idx = pbuf_get_index('ICLWP',errcode=err) - cld_idx = pbuf_get_index('CLD') - rel_idx = pbuf_get_index('REL') - rei_idx = pbuf_get_index('REI') - - ! old optics - call cnst_get_ind('CLDICE', ixcldice) - call cnst_get_ind('CLDLIQ', ixcldliq) - - return - -end subroutine oldcloud_init - -!============================================================================== -! Private methods -!============================================================================== - -subroutine old_liquid_optics_sw(state, pbuf, liq_tau, liq_tau_w, liq_tau_w_g, liq_tau_w_f, oldliqwp) - - use physconst, only: gravit - - type(physics_state), intent(in) :: state - type(physics_buffer_desc),pointer :: pbuf(:) - - real(r8),intent(out) :: liq_tau (nswbands,pcols,pver) ! extinction optical depth - real(r8),intent(out) :: liq_tau_w (nswbands,pcols,pver) ! single scattering albedo * tau - real(r8),intent(out) :: liq_tau_w_g(nswbands,pcols,pver) ! assymetry parameter * tau * w - real(r8),intent(out) :: liq_tau_w_f(nswbands,pcols,pver) ! forward scattered fraction * tau * w - logical, intent(in) :: oldliqwp - - real(r8), pointer, dimension(:,:) :: rel - real(r8), pointer, dimension(:,:) :: cldn - real(r8), pointer, dimension(:,:) :: tmpptr - real(r8), dimension(pcols,pver) :: cliqwp - real(r8), dimension(nswbands) :: wavmin - real(r8), dimension(nswbands) :: wavmax - - ! Minimum cloud amount (as a fraction of the grid-box area) to - ! distinguish from clear sky - real(r8), parameter :: cldmin = 1.0e-80_r8 - - ! Decimal precision of cloud amount (0 -> preserve full resolution; - ! 10^-n -> preserve n digits of cloud amount) - real(r8), parameter :: cldeps = 0.0_r8 - - ! A. Slingo's data for cloud particle radiative properties (from 'A GCM - ! Parameterization for the Shortwave Properties of Water Clouds' JAS - ! vol. 46 may 1989 pp 1419-1427) - real(r8) :: abarl(4) = & ! A coefficient for extinction optical depth - (/ 2.817e-02_r8, 2.682e-02_r8,2.264e-02_r8,1.281e-02_r8/) - real(r8) :: bbarl(4) = & ! B coefficient for extinction optical depth - (/ 1.305_r8 , 1.346_r8 ,1.454_r8 ,1.641_r8 /) - real(r8) :: cbarl(4) = & ! C coefficient for single scat albedo - (/-5.62e-08_r8 ,-6.94e-06_r8 ,4.64e-04_r8 ,0.201_r8 /) - real(r8) :: dbarl(4) = & ! D coefficient for single scat albedo - (/ 1.63e-07_r8 , 2.35e-05_r8 ,1.24e-03_r8 ,7.56e-03_r8 /) - real(r8) :: ebarl(4) = & ! E coefficient for asymmetry parameter - (/ 0.829_r8 , 0.794_r8 ,0.754_r8 ,0.826_r8 /) - real(r8) :: fbarl(4) = & ! F coefficient for asymmetry parameter - (/ 2.482e-03_r8, 4.226e-03_r8,6.560e-03_r8,4.353e-03_r8/) - - real(r8) :: abarli ! A coefficient for current spectral band - real(r8) :: bbarli ! B coefficient for current spectral band - real(r8) :: cbarli ! C coefficient for current spectral band - real(r8) :: dbarli ! D coefficient for current spectral band - real(r8) :: ebarli ! E coefficient for current spectral band - real(r8) :: fbarli ! F coefficient for current spectral band - - ! Caution... A. Slingo recommends no less than 4.0 micro-meters nor - ! greater than 20 micro-meters - - integer :: ns, i, k, indxsl, Nday - integer :: lchnk, itim_old - real(r8) :: tmp1l, tmp2l, tmp3l, g - real(r8) :: kext(pcols,pver) - real(r8), pointer, dimension(:,:) :: iclwpth - - Nday = state%ncol - lchnk = state%lchnk - - itim_old = pbuf_old_tim_idx() - call pbuf_get_field(pbuf, cld_idx,cldn, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) - call pbuf_get_field(pbuf, rel_idx,rel) - - if (oldliqwp) then - do k=1,pver - do i = 1,Nday - cliqwp(i,k) = state%q(i,k,ixcldliq)*state%pdel(i,k)/(gravit*max(0.01_r8,cldn(i,k))) - end do - end do - else - if (iclwp_idx<0) then - call endrun('old_liquid_optics_sw: oldliqwp must be set to true since ICLWP was not found in pbuf') - endif - ! The following is the eventual target specification for in cloud liquid water path. - call pbuf_get_field(pbuf, iclwp_idx, tmpptr) - cliqwp = tmpptr - endif - - call get_sw_spectral_boundaries(wavmin,wavmax,'microns') - - do ns = 1, nswbands - ! Set index for cloud particle properties based on the wavelength, - ! according to A. Slingo (1989) equations 1-3: - ! Use index 1 (0.25 to 0.69 micrometers) for visible - ! Use index 2 (0.69 - 1.19 micrometers) for near-infrared - ! Use index 3 (1.19 to 2.38 micrometers) for near-infrared - ! Use index 4 (2.38 to 4.00 micrometers) for near-infrared - if(wavmax(ns) <= 0.7_r8) then - indxsl = 1 - else if(wavmax(ns) <= 1.25_r8) then - indxsl = 2 - else if(wavmax(ns) <= 2.38_r8) then - indxsl = 3 - else if(wavmin(ns) > 2.38_r8) then - indxsl = 4 - end if - - ! Set cloud extinction optical depth, single scatter albedo, - ! asymmetry parameter, and forward scattered fraction: - abarli = abarl(indxsl) - bbarli = bbarl(indxsl) - cbarli = cbarl(indxsl) - dbarli = dbarl(indxsl) - ebarli = ebarl(indxsl) - fbarli = fbarl(indxsl) - - do k=1,pver - do i=1,Nday - - ! note that optical properties for liquid valid only - ! in range of 4.2 > rel > 16 micron (Slingo 89) - if (cldn(i,k) >= cldmin .and. cldn(i,k) >= cldeps) then - tmp1l = abarli + bbarli/min(max(4.2_r8,rel(i,k)),16._r8) - liq_tau(ns,i,k) = 1000._r8*cliqwp(i,k)*tmp1l - else - liq_tau(ns,i,k) = 0.0_r8 - endif - - tmp2l = 1._r8 - cbarli - dbarli*min(max(4.2_r8,rel(i,k)),16._r8) - tmp3l = fbarli*min(max(4.2_r8,rel(i,k)),16._r8) - ! Do not let single scatter albedo be 1. Delta-eddington solution - ! for non-conservative case has different analytic form from solution - ! for conservative case, and raddedmx is written for non-conservative case. - liq_tau_w(ns,i,k) = liq_tau(ns,i,k) * min(tmp2l,.999999_r8) - g = ebarli + tmp3l - liq_tau_w_g(ns,i,k) = liq_tau_w(ns,i,k) * g - liq_tau_w_f(ns,i,k) = liq_tau_w(ns,i,k) * g * g - - end do ! End do i=1,Nday - end do ! End do k=1,pver - end do ! nswbands - - !call outfld('CL_OD_SW_OLD',liq_tau(idx_sw_diag,:,:), pcols, lchnk) - !call outfld('REL_OLD',rel(:,:), pcols, lchnk) - !call outfld('CLWPTH_OLD',cliqwp(:,:), pcols, lchnk) - !call outfld('KEXT_OLD',kext(:,:), pcols, lchnk) - - -end subroutine old_liquid_optics_sw -!============================================================================== - -subroutine old_ice_optics_sw (state, pbuf, ice_tau, ice_tau_w, ice_tau_w_g, ice_tau_w_f, oldicewp) - - use physconst, only: gravit - - type(physics_state), intent(in) :: state - type(physics_buffer_desc),pointer :: pbuf(:) - - real(r8),intent(out) :: ice_tau (nswbands,pcols,pver) ! extinction optical depth - real(r8),intent(out) :: ice_tau_w (nswbands,pcols,pver) ! single scattering albedo * tau - real(r8),intent(out) :: ice_tau_w_g(nswbands,pcols,pver) ! assymetry parameter * tau * w - real(r8),intent(out) :: ice_tau_w_f(nswbands,pcols,pver) ! forward scattered fraction * tau * w - logical, intent(in) :: oldicewp - - real(r8), pointer, dimension(:,:) :: rei - real(r8), pointer, dimension(:,:) :: cldn - real(r8), pointer, dimension(:,:) :: tmpptr - real(r8), dimension(pcols,pver) :: cicewp - real(r8), dimension(nswbands) :: wavmin - real(r8), dimension(nswbands) :: wavmax - ! - ! ice water coefficients (Ebert and Curry,1992, JGR, 97, 3831-3836) - real(r8) :: abari(4) = & ! a coefficient for extinction optical depth - (/ 3.448e-03_r8, 3.448e-03_r8,3.448e-03_r8,3.448e-03_r8/) - real(r8) :: bbari(4) = & ! b coefficient for extinction optical depth - (/ 2.431_r8 , 2.431_r8 ,2.431_r8 ,2.431_r8 /) - real(r8) :: cbari(4) = & ! c coefficient for single scat albedo - (/ 1.00e-05_r8 , 1.10e-04_r8 ,1.861e-02_r8,.46658_r8 /) - real(r8) :: dbari(4) = & ! d coefficient for single scat albedo - (/ 0.0_r8 , 1.405e-05_r8,8.328e-04_r8,2.05e-05_r8 /) - real(r8) :: ebari(4) = & ! e coefficient for asymmetry parameter - (/ 0.7661_r8 , 0.7730_r8 ,0.794_r8 ,0.9595_r8 /) - real(r8) :: fbari(4) = & ! f coefficient for asymmetry parameter - (/ 5.851e-04_r8, 5.665e-04_r8,7.267e-04_r8,1.076e-04_r8/) - - real(r8) :: abarii ! A coefficient for current spectral band - real(r8) :: bbarii ! B coefficient for current spectral band - real(r8) :: cbarii ! C coefficient for current spectral band - real(r8) :: dbarii ! D coefficient for current spectral band - real(r8) :: ebarii ! E coefficient for current spectral band - real(r8) :: fbarii ! F coefficient for current spectral band - - ! Minimum cloud amount (as a fraction of the grid-box area) to - ! distinguish from clear sky - real(r8), parameter :: cldmin = 1.0e-80_r8 - - ! Decimal precision of cloud amount (0 -> preserve full resolution; - ! 10^-n -> preserve n digits of cloud amount) - real(r8), parameter :: cldeps = 0.0_r8 - - integer :: ns, i, k, indxsl, lchnk, Nday - integer :: itim_old - real(r8) :: tmp1i, tmp2i, tmp3i, g - - Nday = state%ncol - lchnk = state%lchnk - - itim_old = pbuf_old_tim_idx() - call pbuf_get_field(pbuf, cld_idx,cldn, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) - call pbuf_get_field(pbuf, rei_idx,rei) - - if(oldicewp) then - do k=1,pver - do i = 1,Nday - cicewp(i,k) = 1000.0_r8*state%q(i,k,ixcldice)*state%pdel(i,k) /(gravit* max(0.01_r8,cldn(i,k))) - end do - end do - else - if (iciwp_idx<=0) then - call endrun('old_ice_optics_sw: oldicewp must be set to true since ICIWP was not found in pbuf') - endif - call pbuf_get_field(pbuf, iciwp_idx, tmpptr) - cicewp(1:pcols,1:pver) = 1000.0_r8*tmpptr - endif - - call get_sw_spectral_boundaries(wavmin,wavmax,'microns') - - do ns = 1, nswbands - - if(wavmax(ns) <= 0.7_r8) then - indxsl = 1 - else if(wavmax(ns) <= 1.25_r8) then - indxsl = 2 - else if(wavmax(ns) <= 2.38_r8) then - indxsl = 3 - else if(wavmin(ns) > 2.38_r8) then - indxsl = 4 - end if - - abarii = abari(indxsl) - bbarii = bbari(indxsl) - cbarii = cbari(indxsl) - dbarii = dbari(indxsl) - ebarii = ebari(indxsl) - fbarii = fbari(indxsl) - - do k=1,pver - do i=1,Nday - - ! note that optical properties for ice valid only - ! in range of 13 > rei > 130 micron (Ebert and Curry 92) - if (cldn(i,k) >= cldmin .and. cldn(i,k) >= cldeps) then - tmp1i = abarii + bbarii/max(13._r8,min(scalefactor*rei(i,k),130._r8)) - ice_tau(ns,i,k) = cicewp(i,k)*tmp1i - else - ice_tau(ns,i,k) = 0.0_r8 - endif - - tmp2i = 1._r8 - cbarii - dbarii*min(max(13._r8,scalefactor*rei(i,k)),130._r8) - tmp3i = fbarii*min(max(13._r8,scalefactor*rei(i,k)),130._r8) - ! Do not let single scatter albedo be 1. Delta-eddington solution - ! for non-conservative case has different analytic form from solution - ! for conservative case, and raddedmx is written for non-conservative case. - ice_tau_w(ns,i,k) = ice_tau(ns,i,k) * min(tmp2i,.999999_r8) - g = ebarii + tmp3i - ice_tau_w_g(ns,i,k) = ice_tau_w(ns,i,k) * g - ice_tau_w_f(ns,i,k) = ice_tau_w(ns,i,k) * g * g - - end do ! End do i=1,Nday - end do ! End do k=1,pver - end do ! nswbands - -end subroutine old_ice_optics_sw -!============================================================================== - -subroutine oldcloud_lw(state,pbuf,cld_abs_od,oldwp) - use physconst, only: gravit - type(physics_state), intent(in) :: state - type(physics_buffer_desc),pointer :: pbuf(:) - real(r8), intent(out) :: cld_abs_od(nlwbands,pcols,pver) ! [fraction] absorption optical depth, per layer - logical,intent(in) :: oldwp ! use old definition of waterpath - - - real(r8) :: gicewp(pcols,pver) - real(r8) :: gliqwp(pcols,pver) - real(r8) :: cicewp(pcols,pver) - real(r8) :: cliqwp(pcols,pver) - real(r8) :: ficemr(pcols,pver) - real(r8) :: cwp(pcols,pver) - real(r8) :: cldtau(pcols,pver) - - real(r8), pointer, dimension(:,:) :: cldn - real(r8), pointer, dimension(:,:) :: rei - integer :: ncol, itim_old, lwband, i, k, lchnk - real(r8), pointer, dimension(:,:) :: iclwpth, iciwpth - - real(r8) :: kabs, kabsi - real(r8) kabsl ! longwave liquid absorption coeff (m**2/g) - parameter (kabsl = 0.090361_r8) - - - - ncol = state%ncol - lchnk = state%lchnk - - itim_old = pbuf_old_tim_idx() - call pbuf_get_field(pbuf, rei_idx, rei) - call pbuf_get_field(pbuf, cld_idx, cldn, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) - - if (oldwp) then - do k=1,pver - do i = 1,ncol - gicewp(i,k) = state%q(i,k,ixcldice)*state%pdel(i,k)/gravit*1000.0_r8 ! Grid box ice water path. - gliqwp(i,k) = state%q(i,k,ixcldliq)*state%pdel(i,k)/gravit*1000.0_r8 ! Grid box liquid water path. - cicewp(i,k) = gicewp(i,k) / max(0.01_r8,cldn(i,k)) ! In-cloud ice water path. - cliqwp(i,k) = gliqwp(i,k) / max(0.01_r8,cldn(i,k)) ! In-cloud liquid water path. - ficemr(i,k) = state%q(i,k,ixcldice) / & - max(1.e-10_r8,(state%q(i,k,ixcldice)+state%q(i,k,ixcldliq))) - end do - end do - cwp(:ncol,:pver) = cicewp(:ncol,:pver) + cliqwp(:ncol,:pver) - else - if (iclwp_idx<=0 .or. iciwp_idx<=0) then - call endrun('oldcloud_lw: oldwp must be set to true since ICIWP and/or ICLWP were not found in pbuf') - endif - call pbuf_get_field(pbuf, iclwp_idx, iclwpth) - call pbuf_get_field(pbuf, iciwp_idx, iciwpth) - do k=1,pver - do i = 1,ncol - cwp(i,k) = 1000.0_r8 *iclwpth(i,k) + 1000.0_r8 *iciwpth(i, k) - ficemr(i,k) = 1000.0_r8 * iciwpth(i,k)/(max(1.e-18_r8,cwp(i,k))) - end do - end do - endif - - do k=1,pver - do i=1,ncol - - !note that optical properties for ice valid only - !in range of 13 > rei > 130 micron (Ebert and Curry 92) - kabsi = 0.005_r8 + 1._r8/min(max(13._r8,scalefactor*rei(i,k)),130._r8) - kabs = kabsl*(1._r8-ficemr(i,k)) + kabsi*ficemr(i,k) - !emis(i,k) = 1._r8 - exp(-1.66_r8*kabs*clwp(i,k)) - cldtau(i,k) = kabs*cwp(i,k) - end do - end do -! - do lwband = 1,nlwbands - cld_abs_od(lwband,1:ncol,1:pver)=cldtau(1:ncol,1:pver) - enddo - -end subroutine oldcloud_lw - -!============================================================================== -subroutine old_liq_get_rad_props_lw(state, pbuf, abs_od, oldliqwp) - use physconst, only: gravit - - type(physics_state), intent(in) :: state - type(physics_buffer_desc),pointer :: pbuf(:) - real(r8), intent(out) :: abs_od(nlwbands,pcols,pver) - logical, intent(in) :: oldliqwp - - real(r8) :: gicewp(pcols,pver) - real(r8) :: gliqwp(pcols,pver) - real(r8) :: cicewp(pcols,pver) - real(r8) :: cliqwp(pcols,pver) - real(r8) :: ficemr(pcols,pver) - real(r8) :: cwp(pcols,pver) - real(r8) :: cldtau(pcols,pver) - - real(r8), pointer, dimension(:,:) :: cldn - real(r8), pointer, dimension(:,:) :: rei - integer :: ncol, itim_old, lwband, i, k, lchnk - - real(r8) :: kabs, kabsi - real(r8) kabsl ! longwave liquid absorption coeff (m**2/g) - parameter (kabsl = 0.090361_r8) - - real(r8), pointer, dimension(:,:) :: iclwpth, iciwpth - - ncol=state%ncol - lchnk = state%lchnk - - itim_old = pbuf_old_tim_idx() - call pbuf_get_field(pbuf, rei_idx, rei) - call pbuf_get_field(pbuf, cld_idx, cldn, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) - - if (oldliqwp) then - do k=1,pver - do i = 1,ncol - gicewp(i,k) = state%q(i,k,ixcldice)*state%pdel(i,k)/gravit*1000.0_r8 ! Grid box ice water path. - gliqwp(i,k) = state%q(i,k,ixcldliq)*state%pdel(i,k)/gravit*1000.0_r8 ! Grid box liquid water path. - cicewp(i,k) = gicewp(i,k) / max(0.01_r8,cldn(i,k)) ! In-cloud ice water path. - cliqwp(i,k) = gliqwp(i,k) / max(0.01_r8,cldn(i,k)) ! In-cloud liquid water path. - ficemr(i,k) = state%q(i,k,ixcldice) / & - max(1.e-10_r8,(state%q(i,k,ixcldice)+state%q(i,k,ixcldliq))) - end do - end do - cwp(:ncol,:pver) = cicewp(:ncol,:pver) + cliqwp(:ncol,:pver) - else - if (iclwp_idx<=0 .or. iciwp_idx<=0) then - call endrun('old_liq_get_rad_props_lw: oldliqwp must be set to true since ICIWP and/or ICLWP were not found in pbuf') - endif - call pbuf_get_field(pbuf, iclwp_idx, iclwpth) - call pbuf_get_field(pbuf, iciwp_idx, iciwpth) - do k=1,pver - do i = 1,ncol - cwp(i,k) = 1000.0_r8 *iclwpth(i,k) + 1000.0_r8 *iciwpth(i, k) - ficemr(i,k) = 1000.0_r8 * iciwpth(i,k)/(max(1.e-18_r8,cwp(i,k))) - end do - end do - endif - - - do k=1,pver - do i=1,ncol - - ! Note from Andrew Conley: - ! Optics for RK no longer supported, This is constructed to get - ! close to bit for bit. Otherwise we could simply use liquid water path - !note that optical properties for ice valid only - !in range of 13 > rei > 130 micron (Ebert and Curry 92) - kabsi = 0.005_r8 + 1._r8/min(max(13._r8,scalefactor*rei(i,k)),130._r8) - kabs = kabsl*(1._r8-ficemr(i,k)) ! + kabsi*ficemr(i,k) - !emis(i,k) = 1._r8 - exp(-1.66_r8*kabs*clwp(i,k)) - cldtau(i,k) = kabs*cwp(i,k) - end do - end do -! - do lwband = 1,nlwbands - abs_od(lwband,1:ncol,1:pver)=cldtau(1:ncol,1:pver) - enddo - - -end subroutine old_liq_get_rad_props_lw -!============================================================================== - -subroutine old_ice_get_rad_props_lw(state, pbuf, abs_od, oldicewp) - use physconst, only: gravit - type(physics_state), intent(in) :: state - type(physics_buffer_desc),pointer :: pbuf(:) - real(r8), intent(out) :: abs_od(nlwbands,pcols,pver) - logical, intent(in) :: oldicewp - - real(r8) :: gicewp(pcols,pver) - real(r8) :: gliqwp(pcols,pver) - real(r8) :: cicewp(pcols,pver) - real(r8) :: cliqwp(pcols,pver) - real(r8) :: ficemr(pcols,pver) - real(r8) :: cwp(pcols,pver) - real(r8) :: cldtau(pcols,pver) - - real(r8), pointer, dimension(:,:) :: cldn - real(r8), pointer, dimension(:,:) :: rei - integer :: ncol, itim_old, lwband, i, k, lchnk - - real(r8) :: kabs, kabsi - - real(r8) kabsl ! longwave liquid absorption coeff (m**2/g) - parameter (kabsl = 0.090361_r8) - - real(r8), pointer, dimension(:,:) :: iclwpth, iciwpth - - - ncol = state%ncol - lchnk = state%lchnk - - itim_old = pbuf_old_tim_idx() - call pbuf_get_field(pbuf, rei_idx, rei) - call pbuf_get_field(pbuf, cld_idx, cldn, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) - - if(oldicewp) then - do k=1,pver - do i = 1,ncol - gicewp(i,k) = state%q(i,k,ixcldice)*state%pdel(i,k)/gravit*1000.0_r8 ! Grid box ice water path. - gliqwp(i,k) = state%q(i,k,ixcldliq)*state%pdel(i,k)/gravit*1000.0_r8 ! Grid box liquid water path. - cicewp(i,k) = gicewp(i,k) / max(0.01_r8,cldn(i,k)) ! In-cloud ice water path. - cliqwp(i,k) = gliqwp(i,k) / max(0.01_r8,cldn(i,k)) ! In-cloud liquid water path. - ficemr(i,k) = state%q(i,k,ixcldice) / & - max(1.e-10_r8,(state%q(i,k,ixcldice)+state%q(i,k,ixcldliq))) - end do - end do - cwp(:ncol,:pver) = cicewp(:ncol,:pver) + cliqwp(:ncol,:pver) - else - if (iclwp_idx<=0 .or. iciwp_idx<=0) then - call endrun('old_ice_get_rad_props_lw: oldicewp must be set to true since ICIWP and/or ICLWP were not found in pbuf') - endif - call pbuf_get_field(pbuf, iclwp_idx, iclwpth) - call pbuf_get_field(pbuf, iciwp_idx, iciwpth) - do k=1,pver - do i = 1,ncol - cwp(i,k) = 1000.0_r8 *iciwpth(i,k) + 1000.0_r8 *iclwpth(i,k) - ficemr(i,k) = 1000.0_r8*iciwpth(i,k)/(max(1.e-18_r8,cwp(i,k))) - end do - end do - endif - - do k=1,pver - do i=1,ncol - - ! Note from Andrew Conley: - ! Optics for RK no longer supported, This is constructed to get - ! close to bit for bit. Otherwise we could simply use ice water path - !note that optical properties for ice valid only - !in range of 13 > rei > 130 micron (Ebert and Curry 92) - kabsi = 0.005_r8 + 1._r8/min(max(13._r8,scalefactor*rei(i,k)),130._r8) - kabs = kabsi*ficemr(i,k) ! kabsl*(1._r8-ficemr(i,k)) + kabsi*ficemr(i,k) - !emis(i,k) = 1._r8 - exp(-1.66_r8*kabs*clwp(i,k)) - cldtau(i,k) = kabs*cwp(i,k) - end do - end do -! - do lwband = 1,nlwbands - abs_od(lwband,1:ncol,1:pver)=cldtau(1:ncol,1:pver) - enddo - - !if(oldicewp) then - ! call outfld('CIWPTH_OLD',cicewp(:,:)/1000,pcols,lchnk) - !else - ! call outfld('CIWPTH_OLD',iciwpth(:,:),pcols,lchnk) - !endif - !call outfld('CI_OD_LW_OLD',cldtau(:,:),pcols,lchnk) - -end subroutine old_ice_get_rad_props_lw -!============================================================================== - -subroutine cloud_total_vis_diag_out(lchnk, nnite, idxnite, tau, radsuffix) - - ! output total aerosol optical depth for the visible band - - use cam_history, only: outfld - use cam_history_support, only : fillvalue - - integer, intent(in) :: lchnk - integer, intent(in) :: nnite ! number of night columns - integer, intent(in) :: idxnite(nnite) ! local column indices of night columns - real(r8), intent(in) :: tau(:,:) - character(len=*), intent(in) :: radsuffix ! identifies whether the radiation call - ! is for the climate calc or a diagnostic calc - - ! Local variables - integer :: i - real(r8) :: tmp(pcols) - !----------------------------------------------------------------------------- - - ! compute total aerosol optical depth output where only daylight columns - tmp(:) = sum(tau(:,:), 2) - do i = 1, nnite - tmp(idxnite(i)) = fillvalue - end do - !call outfld('cloudOD_v'//trim(radsuffix), tmp, pcols, lchnk) - -end subroutine cloud_total_vis_diag_out - -!============================================================================== - -end module oldcloud diff --git a/src/physics/rrtmg/slingo.F90 b/src/physics/rrtmg/slingo.F90 deleted file mode 100644 index b9d68565ec..0000000000 --- a/src/physics/rrtmg/slingo.F90 +++ /dev/null @@ -1,409 +0,0 @@ -module slingo - -!------------------------------------------------------------------------------------------------ -! Implements Slingo Optics for MG/RRTMG for liquid clouds and -! a copy of the old cloud routine for reference -!------------------------------------------------------------------------------------------------ - -use shr_kind_mod, only: r8 => shr_kind_r8 -use ppgrid, only: pcols, pver, pverp -use physics_types, only: physics_state -use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_get_field, pbuf_old_tim_idx -use radconstants, only: nswbands, nlwbands, idx_sw_diag, idx_lw_diag, get_sw_spectral_boundaries -use cam_abortutils, only: endrun -use cam_history, only: outfld - -implicit none -private -save - -public :: & - slingo_rad_props_init, & - cloud_rad_props_get_sw, & ! return SW optical props of total bulk aerosols - cloud_rad_props_get_lw, & ! return LW optical props of total bulk aerosols - slingo_liq_get_rad_props_lw, & - slingo_liq_optics_sw - -! Minimum cloud amount (as a fraction of the grid-box area) to -! distinguish from clear sky -! - real(r8) cldmin - parameter (cldmin = 1.0e-80_r8) -! -! Decimal precision of cloud amount (0 -> preserve full resolution; -! 10^-n -> preserve n digits of cloud amount) -! - real(r8) cldeps - parameter (cldeps = 0.0_r8) - -! -! indexes into pbuf for optical parameters of MG clouds -! - integer :: iclwp_idx = 0 - integer :: iciwp_idx = 0 - integer :: cld_idx = 0 - integer :: rel_idx = 0 - integer :: rei_idx = 0 - -! indexes into constituents for old optics - integer :: & - ixcldliq, & ! cloud liquid water index - ixcldice ! cloud liquid water index - - -!============================================================================== -contains -!============================================================================== - -subroutine slingo_rad_props_init() - -! use cam_history, only: addfld - use netcdf - use spmd_utils, only: masterproc - use ioFileMod, only: getfil - use cam_logfile, only: iulog - use error_messages, only: handle_ncerr -#if ( defined SPMD ) - use mpishorthand -#endif - use constituents, only: cnst_get_ind - - integer :: err - - iciwp_idx = pbuf_get_index('ICIWP',errcode=err) - iclwp_idx = pbuf_get_index('ICLWP',errcode=err) - cld_idx = pbuf_get_index('CLD') - rel_idx = pbuf_get_index('REL') - rei_idx = pbuf_get_index('REI') - - ! old optics - call cnst_get_ind('CLDLIQ', ixcldliq) - call cnst_get_ind('CLDICE', ixcldice) - - !call addfld ('CLWPTH_OLD',(/ 'lev' /), 'I','Kg/m2','old In Cloud Liquid Water Path', sampling_seq='rad_lwsw') - !call addfld ('KEXT_OLD',(/ 'lev' /),'I','m^2/kg','old extinction') - !call addfld ('CLDOD_OLD',(/ 'lev' /),'I','1','old liquid OD') - !call addfld ('REL_OLD',(/ 'lev' /),'I','1','old liquid effective radius (liquid)') - - !call addfld ('CLWPTH_NEW',(/ 'lev' /), 'I','Kg/m2','In Cloud Liquid Water Path', sampling_seq='rad_lwsw') - !call addfld ('KEXT_NEW',(/ 'lev' /),'I','m^2/kg','extinction') - !call addfld ('CLDOD_NEW',(/ 'lev' /),'I','1','liquid OD') - - !call addfld('CIWPTH_NEW',(/ 'lev' /), 'I','Kg/m2','In Cloud Ice Water Path', sampling_seq='rad_lwsw') - !call addfld('CIWPTH_OLD',(/ 'lev' /), 'I','Kg/m2','In Cloud Ice Water Path (old)', sampling_seq='rad_lwsw') - - return - -end subroutine slingo_rad_props_init - -!============================================================================== - -subroutine cloud_rad_props_get_sw(state, pbuf, & - tau, tau_w, tau_w_g, tau_w_f,& - diagnosticindex) - -! return totaled (across all species) layer tau, omega, g, f -! for all spectral interval for aerosols affecting the climate - - ! Arguments - type(physics_state), intent(in) :: state - type(physics_buffer_desc), pointer :: pbuf(:) - integer, optional, intent(in) :: diagnosticindex ! index (if present) to radiation diagnostic information - - real(r8), intent(out) :: tau (nswbands,pcols,pver) ! aerosol extinction optical depth - real(r8), intent(out) :: tau_w (nswbands,pcols,pver) ! aerosol single scattering albedo * tau - real(r8), intent(out) :: tau_w_g(nswbands,pcols,pver) ! aerosol assymetry parameter * tau * w - real(r8), intent(out) :: tau_w_f(nswbands,pcols,pver) ! aerosol forward scattered fraction * tau * w - - ! Local variables - - integer :: ncol - integer :: lchnk - integer :: k, i ! lev and daycolumn indices - integer :: iswband ! sw band indices - - real(r8) :: liq_tau (nswbands,pcols,pver) ! aerosol extinction optical depth - real(r8) :: liq_tau_w (nswbands,pcols,pver) ! aerosol single scattering albedo * tau - real(r8) :: liq_tau_w_g(nswbands,pcols,pver) ! aerosol assymetry parameter * tau * w - real(r8) :: liq_tau_w_f(nswbands,pcols,pver) ! aerosol forward scattered fraction * tau * w - - - !----------------------------------------------------------------------------- - - ncol = state%ncol - lchnk = state%lchnk - - call slingo_liq_optics_sw(state, pbuf, tau, tau_w, tau_w_g, tau_w_f, oldliqwp=.true. ) - -end subroutine cloud_rad_props_get_sw -!============================================================================== - -subroutine cloud_rad_props_get_lw(state, pbuf, cld_abs_od, diagnosticindex, oldliq, oldice, oldcloud) - -! Purpose: Compute cloud longwave absorption optical depth -! cloud_rad_props_get_lw() is called by radlw() - - ! Arguments - type(physics_state), intent(in) :: state - type(physics_buffer_desc), pointer :: pbuf(:) - real(r8), intent(out) :: cld_abs_od(nlwbands,pcols,pver) ! [fraction] absorption optical depth, per layer - integer, optional, intent(in) :: diagnosticindex - logical, optional, intent(in) :: oldliq ! use old liquid optics - logical, optional, intent(in) :: oldice ! use old ice optics - logical, optional, intent(in) :: oldcloud ! use old optics for both (b4b) - - ! Local variables - - integer :: bnd_idx ! LW band index - integer :: i ! column index - integer :: k ! lev index - integer :: ncol ! number of columns - integer :: lchnk - - ! rad properties for liquid clouds - real(r8) :: liq_tau_abs_od(nlwbands,pcols,pver) ! liquid cloud absorption optical depth - - !----------------------------------------------------------------------------- - - ncol = state%ncol - lchnk = state%lchnk - - ! compute optical depths cld_absod - cld_abs_od = 0._r8 - - call slingo_liq_get_rad_props_lw(state, pbuf, liq_tau_abs_od, oldliqwp=.true.) - - cld_abs_od(:,1:ncol,:) = liq_tau_abs_od(:,1:ncol,:) - -end subroutine cloud_rad_props_get_lw - -!============================================================================== -! Private methods -!============================================================================== - - -subroutine slingo_liq_optics_sw(state, pbuf, liq_tau, liq_tau_w, liq_tau_w_g, liq_tau_w_f, oldliqwp) - - use physconst, only: gravit - - type(physics_state), intent(in) :: state - type(physics_buffer_desc), pointer :: pbuf(:) - - real(r8),intent(out) :: liq_tau (nswbands,pcols,pver) ! extinction optical depth - real(r8),intent(out) :: liq_tau_w (nswbands,pcols,pver) ! single scattering albedo * tau - real(r8),intent(out) :: liq_tau_w_g(nswbands,pcols,pver) ! assymetry parameter * tau * w - real(r8),intent(out) :: liq_tau_w_f(nswbands,pcols,pver) ! forward scattered fraction * tau * w - logical, intent(in) :: oldliqwp - - real(r8), pointer, dimension(:,:) :: rel - real(r8), pointer, dimension(:,:) :: cldn - real(r8), pointer, dimension(:,:) :: tmpptr - real(r8), dimension(pcols,pver) :: cliqwp - real(r8), dimension(nswbands) :: wavmin - real(r8), dimension(nswbands) :: wavmax - - ! Minimum cloud amount (as a fraction of the grid-box area) to - ! distinguish from clear sky - real(r8), parameter :: cldmin = 1.0e-80_r8 - - ! Decimal precision of cloud amount (0 -> preserve full resolution; - ! 10^-n -> preserve n digits of cloud amount) - real(r8), parameter :: cldeps = 0.0_r8 - - ! A. Slingo's data for cloud particle radiative properties (from 'A GCM - ! Parameterization for the Shortwave Properties of Water Clouds' JAS - ! vol. 46 may 1989 pp 1419-1427) - real(r8) :: abarl(4) = & ! A coefficient for extinction optical depth - (/ 2.817e-02_r8, 2.682e-02_r8,2.264e-02_r8,1.281e-02_r8/) - real(r8) :: bbarl(4) = & ! B coefficient for extinction optical depth - (/ 1.305_r8 , 1.346_r8 ,1.454_r8 ,1.641_r8 /) - real(r8) :: cbarl(4) = & ! C coefficient for single scat albedo - (/-5.62e-08_r8 ,-6.94e-06_r8 ,4.64e-04_r8 ,0.201_r8 /) - real(r8) :: dbarl(4) = & ! D coefficient for single scat albedo - (/ 1.63e-07_r8 , 2.35e-05_r8 ,1.24e-03_r8 ,7.56e-03_r8 /) - real(r8) :: ebarl(4) = & ! E coefficient for asymmetry parameter - (/ 0.829_r8 , 0.794_r8 ,0.754_r8 ,0.826_r8 /) - real(r8) :: fbarl(4) = & ! F coefficient for asymmetry parameter - (/ 2.482e-03_r8, 4.226e-03_r8,6.560e-03_r8,4.353e-03_r8/) - - real(r8) :: abarli ! A coefficient for current spectral band - real(r8) :: bbarli ! B coefficient for current spectral band - real(r8) :: cbarli ! C coefficient for current spectral band - real(r8) :: dbarli ! D coefficient for current spectral band - real(r8) :: ebarli ! E coefficient for current spectral band - real(r8) :: fbarli ! F coefficient for current spectral band - - ! Caution... A. Slingo recommends no less than 4.0 micro-meters nor - ! greater than 20 micro-meters - - integer :: ns, i, k, indxsl, Nday - integer :: i_rel, lchnk, icld, itim_old - real(r8) :: tmp1l, tmp2l, tmp3l, g - real(r8) :: kext(pcols,pver) - real(r8), pointer, dimension(:,:) :: iclwpth - - Nday = state%ncol - lchnk = state%lchnk - - itim_old = pbuf_old_tim_idx() - call pbuf_get_field(pbuf, cld_idx, cldn, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) - call pbuf_get_field(pbuf, rel_idx, rel) - - if (oldliqwp) then - do k=1,pver - do i = 1,Nday - cliqwp(i,k) = state%q(i,k,ixcldliq)*state%pdel(i,k)/(gravit*max(0.01_r8,cldn(i,k))) - end do - end do - else - if (iclwp_idx<=0) then - call endrun('slingo_liq_optics_sw: oldliqwp must be set to true since ICLWP was not found in pbuf') - endif - ! The following is the eventual target specification for in cloud liquid water path. - call pbuf_get_field(pbuf, iclwp_idx, tmpptr) - cliqwp = tmpptr - endif - - call get_sw_spectral_boundaries(wavmin,wavmax,'microns') - - do ns = 1, nswbands - ! Set index for cloud particle properties based on the wavelength, - ! according to A. Slingo (1989) equations 1-3: - ! Use index 1 (0.25 to 0.69 micrometers) for visible - ! Use index 2 (0.69 - 1.19 micrometers) for near-infrared - ! Use index 3 (1.19 to 2.38 micrometers) for near-infrared - ! Use index 4 (2.38 to 4.00 micrometers) for near-infrared - if(wavmax(ns) <= 0.7_r8) then - indxsl = 1 - else if(wavmax(ns) <= 1.25_r8) then - indxsl = 2 - else if(wavmax(ns) <= 2.38_r8) then - indxsl = 3 - else if(wavmax(ns) > 2.38_r8) then - indxsl = 4 - end if - - ! Set cloud extinction optical depth, single scatter albedo, - ! asymmetry parameter, and forward scattered fraction: - abarli = abarl(indxsl) - bbarli = bbarl(indxsl) - cbarli = cbarl(indxsl) - dbarli = dbarl(indxsl) - ebarli = ebarl(indxsl) - fbarli = fbarl(indxsl) - - do k=1,pver - do i=1,Nday - - ! note that optical properties for liquid valid only - ! in range of 4.2 > rel > 16 micron (Slingo 89) - if (cldn(i,k) >= cldmin .and. cldn(i,k) >= cldeps) then - tmp1l = abarli + bbarli/min(max(4.2_r8,rel(i,k)),16._r8) - liq_tau(ns,i,k) = 1000._r8*cliqwp(i,k)*tmp1l - else - liq_tau(ns,i,k) = 0.0_r8 - endif - - tmp2l = 1._r8 - cbarli - dbarli*min(max(4.2_r8,rel(i,k)),16._r8) - tmp3l = fbarli*min(max(4.2_r8,rel(i,k)),16._r8) - ! Do not let single scatter albedo be 1. Delta-eddington solution - ! for non-conservative case has different analytic form from solution - ! for conservative case, and raddedmx is written for non-conservative case. - liq_tau_w(ns,i,k) = liq_tau(ns,i,k) * min(tmp2l,.999999_r8) - g = ebarli + tmp3l - liq_tau_w_g(ns,i,k) = liq_tau_w(ns,i,k) * g - liq_tau_w_f(ns,i,k) = liq_tau_w(ns,i,k) * g * g - - end do ! End do i=1,Nday - end do ! End do k=1,pver - end do ! nswbands - - !call outfld('CL_OD_SW_OLD',liq_tau(idx_sw_diag,:,:), pcols, lchnk) - !call outfld('REL_OLD',rel(:,:), pcols, lchnk) - !call outfld('CLWPTH_OLD',cliqwp(:,:), pcols, lchnk) - !call outfld('KEXT_OLD',kext(:,:), pcols, lchnk) - - -end subroutine slingo_liq_optics_sw - -subroutine slingo_liq_get_rad_props_lw(state, pbuf, abs_od, oldliqwp) - use physconst, only: gravit - - type(physics_state), intent(in) :: state - type(physics_buffer_desc),pointer :: pbuf(:) - real(r8), intent(out) :: abs_od(nlwbands,pcols,pver) - logical, intent(in) :: oldliqwp - - real(r8) :: gicewp(pcols,pver) - real(r8) :: gliqwp(pcols,pver) - real(r8) :: cicewp(pcols,pver) - real(r8) :: cliqwp(pcols,pver) - real(r8) :: ficemr(pcols,pver) - real(r8) :: cwp(pcols,pver) - real(r8) :: cldtau(pcols,pver) - - real(r8), pointer, dimension(:,:) :: cldn - real(r8), pointer, dimension(:,:) :: rei - integer :: ncol, icld, itim_old, i_rei, lwband, i, k, lchnk - - real(r8) :: kabs, kabsi - real(r8) kabsl ! longwave liquid absorption coeff (m**2/g) - parameter (kabsl = 0.090361_r8) - - real(r8), pointer, dimension(:,:) :: iclwpth, iciwpth - - ncol=state%ncol - lchnk = state%lchnk - - itim_old = pbuf_old_tim_idx() - call pbuf_get_field(pbuf, rei_idx, rei) - call pbuf_get_field(pbuf, cld_idx, cldn, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) - - if (oldliqwp) then - do k=1,pver - do i = 1,ncol - gicewp(i,k) = state%q(i,k,ixcldice)*state%pdel(i,k)/gravit*1000.0_r8 ! Grid box ice water path. - gliqwp(i,k) = state%q(i,k,ixcldliq)*state%pdel(i,k)/gravit*1000.0_r8 ! Grid box liquid water path. - cicewp(i,k) = gicewp(i,k) / max(0.01_r8,cldn(i,k)) ! In-cloud ice water path. - cliqwp(i,k) = gliqwp(i,k) / max(0.01_r8,cldn(i,k)) ! In-cloud liquid water path. - ficemr(i,k) = state%q(i,k,ixcldice) / & - max(1.e-10_r8,(state%q(i,k,ixcldice)+state%q(i,k,ixcldliq))) - end do - end do - cwp(:ncol,:pver) = cicewp(:ncol,:pver) + cliqwp(:ncol,:pver) - else - if (iclwp_idx<=0 .or. iciwp_idx<=0) then - call endrun('slingo_liq_get_rad_props_lw: oldliqwp must be set to true since ICIWP and/or ICLWP were not found in pbuf') - endif - call pbuf_get_field(pbuf, iclwp_idx, iclwpth) - call pbuf_get_field(pbuf, iciwp_idx, iciwpth) - do k=1,pver - do i = 1,ncol - cwp (i,k) = 1000.0_r8 * iclwpth(i,k) + 1000.0_r8 * iciwpth(i, k) - ficemr(i,k) = 1000.0_r8 * iciwpth(i,k)/(max(1.e-18_r8, cwp(i,k))) - end do - end do - endif - - - do k=1,pver - do i=1,ncol - - ! Note from Andrew Conley: - ! Optics for RK no longer supported, This is constructed to get - ! close to bit for bit. Otherwise we could simply use liquid water path - !note that optical properties for ice valid only - !in range of 13 > rei > 130 micron (Ebert and Curry 92) - kabs = kabsl*(1._r8-ficemr(i,k)) - cldtau(i,k) = kabs*cwp(i,k) - end do - end do -! - do lwband = 1,nlwbands - abs_od(lwband,1:ncol,1:pver)=cldtau(1:ncol,1:pver) - enddo - - -end subroutine slingo_liq_get_rad_props_lw - -end module slingo From 4b1dc77d314600c1eb22099cdec0db695dc17e1b Mon Sep 17 00:00:00 2001 From: Brian Eaton Date: Sun, 17 Sep 2023 19:39:07 -0400 Subject: [PATCH 151/291] bugfix for simple models; cleanup in cloud optics code --- src/physics/cam/ebert_curry.F90 | 161 +++------------------------- src/physics/cam/slingo.F90 | 90 +--------------- src/physics/simple/radconstants.F90 | 17 ++- 3 files changed, 30 insertions(+), 238 deletions(-) diff --git a/src/physics/cam/ebert_curry.F90 b/src/physics/cam/ebert_curry.F90 index c04a864ef0..e218b8e7b3 100644 --- a/src/physics/cam/ebert_curry.F90 +++ b/src/physics/cam/ebert_curry.F90 @@ -1,15 +1,14 @@ module ebert_curry -!------------------------------------------------------------------------------------------------ -!------------------------------------------------------------------------------------------------ use shr_kind_mod, only: r8 => shr_kind_r8 -use ppgrid, only: pcols, pver, pverp +use physconst, only: gravit +use ppgrid, only: pcols, pver use physics_types, only: physics_state use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_get_field, pbuf_old_tim_idx +use constituents, only: cnst_get_ind use radconstants, only: nswbands, nlwbands, get_sw_spectral_boundaries use cam_abortutils, only: endrun -use cam_history, only: outfld implicit none private @@ -17,41 +16,21 @@ module ebert_curry public :: & ec_rad_props_init, & - cloud_rad_props_get_sw, & ! return SW optical props of total bulk aerosols - cloud_rad_props_get_lw, & ! return LW optical props of total bulk aerosols ec_ice_optics_sw, & ec_ice_get_rad_props_lw real(r8), public, parameter:: scalefactor = 1._r8 !500._r8/917._r8 -! Minimum cloud amount (as a fraction of the grid-box area) to -! distinguish from clear sky -! - real(r8) cldmin - parameter (cldmin = 1.0e-80_r8) -! -! Decimal precision of cloud amount (0 -> preserve full resolution; -! 10^-n -> preserve n digits of cloud amount) -! - real(r8) cldeps - parameter (cldeps = 0.0_r8) - -! -! indexes into pbuf for optical parameters of MG clouds -! - integer :: dei_idx = 0 - integer :: mu_idx = 0 - integer :: lambda_idx = 0 - integer :: iciwp_idx = 0 - integer :: iclwp_idx = 0 - integer :: cld_idx = 0 - integer :: rei_idx = 0 - -! indexes into constituents for old optics - integer :: & - ixcldice, & ! cloud ice water index - ixcldliq ! cloud liquid water index +! indices into pbuf +integer :: iciwp_idx = 0 +integer :: iclwp_idx = 0 +integer :: cld_idx = 0 +integer :: rei_idx = 0 + +! indices into constituents for old optics +integer :: ixcldice ! cloud ice water index +integer :: ixcldliq ! cloud liquid water index !============================================================================== @@ -60,17 +39,6 @@ module ebert_curry subroutine ec_rad_props_init() -! use cam_history, only: addfld - use netcdf - use spmd_utils, only: masterproc - use ioFileMod, only: getfil - use cam_logfile, only: iulog - use error_messages, only: handle_ncerr -#if ( defined SPMD ) - use mpishorthand -#endif - use constituents, only: cnst_get_ind - integer :: err iciwp_idx = pbuf_get_index('ICIWP',errcode=err) @@ -82,115 +50,13 @@ subroutine ec_rad_props_init() call cnst_get_ind('CLDICE', ixcldice) call cnst_get_ind('CLDLIQ', ixcldliq) - !call addfld ('CLWPTH_OLD',(/ 'lev' /), 'I','Kg/m2','old In Cloud Liquid Water Path', sampling_seq='rad_lwsw') - !call addfld ('KEXT_OLD',(/ 'lev' /),'I','m^2/kg','old extinction') - !call addfld ('CLDOD_OLD',(/ 'lev' /),'I','1','old liquid OD') - !call addfld ('REL_OLD',(/ 'lev' /),'I','1','old liquid effective radius (liquid)') - - !call addfld ('CLWPTH_NEW',(/ 'lev' /), 'I','Kg/m2','In Cloud Liquid Water Path', sampling_seq='rad_lwsw') - !call addfld ('KEXT_NEW',(/ 'lev' /),'I','m^2/kg','extinction') - !call addfld ('CLDOD_NEW',(/ 'lev' /),'I','1','liquid OD') - - !call addfld('CIWPTH_NEW',(/ 'lev' /), 'I','Kg/m2','In Cloud Ice Water Path', sampling_seq='rad_lwsw') - !call addfld('CIWPTH_OLD',(/ 'lev' /), 'I','Kg/m2','In Cloud Ice Water Path (old)', sampling_seq='rad_lwsw') - - return - end subroutine ec_rad_props_init !============================================================================== -subroutine cloud_rad_props_get_sw(state, pbuf, & - tau, tau_w, tau_w_g, tau_w_f,& - diagnosticindex, oldliq, oldice) - -! return totaled (across all species) layer tau, omega, g, f -! for all spectral interval for aerosols affecting the climate - - ! Arguments - type(physics_state), intent(in) :: state - type(physics_buffer_desc), pointer :: pbuf(:) - integer, optional, intent(in) :: diagnosticindex ! index (if present) to radiation diagnostic information - - real(r8), intent(out) :: tau (nswbands,pcols,pver) ! aerosol extinction optical depth - real(r8), intent(out) :: tau_w (nswbands,pcols,pver) ! aerosol single scattering albedo * tau - real(r8), intent(out) :: tau_w_g(nswbands,pcols,pver) ! aerosol assymetry parameter * tau * w - real(r8), intent(out) :: tau_w_f(nswbands,pcols,pver) ! aerosol forward scattered fraction * tau * w - - logical, optional, intent(in) :: oldliq,oldice - - ! Local variables - - integer :: ncol - integer :: lchnk - integer :: k, i ! lev and daycolumn indices - integer :: iswband ! sw band indices - - !----------------------------------------------------------------------------- - - ncol = state%ncol - lchnk = state%lchnk - - ! initialize to conditions that would cause failure - tau (:,:,:) = -100._r8 - tau_w (:,:,:) = -100._r8 - tau_w_g (:,:,:) = -100._r8 - tau_w_f (:,:,:) = -100._r8 - - ! initialize layers to accumulate od's - tau (:,1:ncol,:) = 0._r8 - tau_w (:,1:ncol,:) = 0._r8 - tau_w_g(:,1:ncol,:) = 0._r8 - tau_w_f(:,1:ncol,:) = 0._r8 - - call ec_ice_optics_sw (state, pbuf, tau, tau_w, tau_w_g, tau_w_f, oldicewp=.true.) - -end subroutine cloud_rad_props_get_sw -!============================================================================== - -subroutine cloud_rad_props_get_lw(state, pbuf, cld_abs_od, diagnosticindex, oldliq, oldice, oldcloud) - -! Purpose: Compute cloud longwave absorption optical depth -! cloud_rad_props_get_lw() is called by radlw() - - ! Arguments - type(physics_state), intent(in) :: state - type(physics_buffer_desc), pointer :: pbuf(:) - real(r8), intent(out) :: cld_abs_od(nlwbands,pcols,pver) ! [fraction] absorption optical depth, per layer - integer, optional, intent(in) :: diagnosticindex - logical, optional, intent(in) :: oldliq ! use old liquid optics - logical, optional, intent(in) :: oldice ! use old ice optics - logical, optional, intent(in) :: oldcloud ! use old optics for both (b4b) - - ! Local variables - - integer :: bnd_idx ! LW band index - integer :: i ! column index - integer :: k ! lev index - integer :: ncol ! number of columns - integer :: lchnk - - !----------------------------------------------------------------------------- - - ncol = state%ncol - lchnk = state%lchnk - - ! compute optical depths cld_absod - cld_abs_od = 0._r8 - - call ec_ice_get_rad_props_lw(state, pbuf, cld_abs_od, oldicewp=.true.) - -end subroutine cloud_rad_props_get_lw - -!============================================================================== -! Private methods -!============================================================================== - subroutine ec_ice_optics_sw (state, pbuf, ice_tau, ice_tau_w, ice_tau_w_g, ice_tau_w_f, oldicewp) - use physconst, only: gravit - - type(physics_state), intent(in) :: state + type(physics_state), intent(in) :: state type(physics_buffer_desc), pointer :: pbuf(:) real(r8),intent(out) :: ice_tau (nswbands,pcols,pver) ! extinction optical depth @@ -311,7 +177,6 @@ end subroutine ec_ice_optics_sw !============================================================================== subroutine ec_ice_get_rad_props_lw(state, pbuf, abs_od, oldicewp) - use physconst, only: gravit type(physics_state), intent(in) :: state type(physics_buffer_desc),pointer :: pbuf(:) diff --git a/src/physics/cam/slingo.F90 b/src/physics/cam/slingo.F90 index 64d614365e..98018afa0f 100644 --- a/src/physics/cam/slingo.F90 +++ b/src/physics/cam/slingo.F90 @@ -6,12 +6,12 @@ module slingo !------------------------------------------------------------------------------------------------ use shr_kind_mod, only: r8 => shr_kind_r8 +use physconst, only: gravit use ppgrid, only: pcols, pver, pverp use physics_types, only: physics_state use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_get_field, pbuf_old_tim_idx use radconstants, only: nswbands, nlwbands, get_sw_spectral_boundaries use cam_abortutils, only: endrun -use cam_history, only: outfld implicit none private @@ -19,8 +19,6 @@ module slingo public :: & slingo_rad_props_init, & - cloud_rad_props_get_sw, & ! return SW optical props of total bulk aerosols - cloud_rad_props_get_lw, & ! return LW optical props of total bulk aerosols slingo_liq_get_rad_props_lw, & slingo_liq_optics_sw @@ -84,94 +82,9 @@ end subroutine slingo_rad_props_init !============================================================================== -subroutine cloud_rad_props_get_sw(state, pbuf, & - tau, tau_w, tau_w_g, tau_w_f,& - diagnosticindex) - -! return totaled (across all species) layer tau, omega, g, f -! for all spectral interval for aerosols affecting the climate - - ! Arguments - type(physics_state), intent(in) :: state - type(physics_buffer_desc), pointer :: pbuf(:) - integer, optional, intent(in) :: diagnosticindex ! index (if present) to radiation diagnostic information - - real(r8), intent(out) :: tau (nswbands,pcols,pver) ! aerosol extinction optical depth - real(r8), intent(out) :: tau_w (nswbands,pcols,pver) ! aerosol single scattering albedo * tau - real(r8), intent(out) :: tau_w_g(nswbands,pcols,pver) ! aerosol assymetry parameter * tau * w - real(r8), intent(out) :: tau_w_f(nswbands,pcols,pver) ! aerosol forward scattered fraction * tau * w - - ! Local variables - - integer :: ncol - integer :: lchnk - integer :: k, i ! lev and daycolumn indices - integer :: iswband ! sw band indices - - real(r8) :: liq_tau (nswbands,pcols,pver) ! aerosol extinction optical depth - real(r8) :: liq_tau_w (nswbands,pcols,pver) ! aerosol single scattering albedo * tau - real(r8) :: liq_tau_w_g(nswbands,pcols,pver) ! aerosol assymetry parameter * tau * w - real(r8) :: liq_tau_w_f(nswbands,pcols,pver) ! aerosol forward scattered fraction * tau * w - - - !----------------------------------------------------------------------------- - - ncol = state%ncol - lchnk = state%lchnk - - call slingo_liq_optics_sw(state, pbuf, tau, tau_w, tau_w_g, tau_w_f, oldliqwp=.true. ) - -end subroutine cloud_rad_props_get_sw -!============================================================================== - -subroutine cloud_rad_props_get_lw(state, pbuf, cld_abs_od, diagnosticindex, oldliq, oldice, oldcloud) - -! Purpose: Compute cloud longwave absorption optical depth -! cloud_rad_props_get_lw() is called by radlw() - - ! Arguments - type(physics_state), intent(in) :: state - type(physics_buffer_desc), pointer :: pbuf(:) - real(r8), intent(out) :: cld_abs_od(nlwbands,pcols,pver) ! [fraction] absorption optical depth, per layer - integer, optional, intent(in) :: diagnosticindex - logical, optional, intent(in) :: oldliq ! use old liquid optics - logical, optional, intent(in) :: oldice ! use old ice optics - logical, optional, intent(in) :: oldcloud ! use old optics for both (b4b) - - ! Local variables - - integer :: bnd_idx ! LW band index - integer :: i ! column index - integer :: k ! lev index - integer :: ncol ! number of columns - integer :: lchnk - - ! rad properties for liquid clouds - real(r8) :: liq_tau_abs_od(nlwbands,pcols,pver) ! liquid cloud absorption optical depth - - !----------------------------------------------------------------------------- - - ncol = state%ncol - lchnk = state%lchnk - - ! compute optical depths cld_absod - cld_abs_od = 0._r8 - - call slingo_liq_get_rad_props_lw(state, pbuf, liq_tau_abs_od, oldliqwp=.true.) - - cld_abs_od(:,1:ncol,:) = liq_tau_abs_od(:,1:ncol,:) - -end subroutine cloud_rad_props_get_lw - -!============================================================================== -! Private methods -!============================================================================== - subroutine slingo_liq_optics_sw(state, pbuf, liq_tau, liq_tau_w, liq_tau_w_g, liq_tau_w_f, oldliqwp) - use physconst, only: gravit - type(physics_state), intent(in) :: state type(physics_buffer_desc), pointer :: pbuf(:) @@ -307,7 +220,6 @@ subroutine slingo_liq_optics_sw(state, pbuf, liq_tau, liq_tau_w, liq_tau_w_g, li end subroutine slingo_liq_optics_sw subroutine slingo_liq_get_rad_props_lw(state, pbuf, abs_od, oldliqwp) - use physconst, only: gravit type(physics_state), intent(in) :: state type(physics_buffer_desc),pointer :: pbuf(:) diff --git a/src/physics/simple/radconstants.F90 b/src/physics/simple/radconstants.F90 index 60585713d6..4476dc6669 100644 --- a/src/physics/simple/radconstants.F90 +++ b/src/physics/simple/radconstants.F90 @@ -17,7 +17,7 @@ module radconstants integer, parameter, public :: idx_uv_diag = 1 public :: rad_gas_index -public :: get_lw_spectral_boundaries +public :: get_lw_spectral_boundaries, get_sw_spectral_boundaries integer, public, parameter :: gasnamelength = 1 integer, public, parameter :: nradgas = 1 @@ -37,6 +37,7 @@ integer function rad_gas_index(gasname) end function rad_gas_index !------------------------------------------------------------------------------ + subroutine get_lw_spectral_boundaries(low_boundaries, high_boundaries, units) ! stub should not be called @@ -47,4 +48,18 @@ subroutine get_lw_spectral_boundaries(low_boundaries, high_boundaries, units) end subroutine get_lw_spectral_boundaries +!------------------------------------------------------------------------------ + +subroutine get_sw_spectral_boundaries(low_boundaries, high_boundaries, units) + ! stub should not be called + + real(r8), intent(out) :: low_boundaries(nswbands), high_boundaries(nswbands) + character(*), intent(in) :: units ! requested units + + call endrun('get_sw_spectral_boundaries: ERROR: this is a stub') + +end subroutine get_sw_spectral_boundaries + +!------------------------------------------------------------------------------ + end module radconstants From 1a047e0f4eae8341df80097d633c28740aa6ef04 Mon Sep 17 00:00:00 2001 From: Brian Eaton Date: Tue, 19 Sep 2023 17:36:03 -0400 Subject: [PATCH 152/291] more cleanup in cloud optics code --- src/physics/cam/cloud_rad_props.F90 | 309 +++++++++--------------- src/physics/cam/ebert_curry.F90 | 2 + src/physics/cam/oldcloud.F90 | 355 ++-------------------------- src/physics/cam/slingo.F90 | 39 +-- src/physics/rrtmgp/radiation.F90 | 6 +- 5 files changed, 150 insertions(+), 561 deletions(-) diff --git a/src/physics/cam/cloud_rad_props.F90 b/src/physics/cam/cloud_rad_props.F90 index 1ba4f200a3..1e518a47d7 100644 --- a/src/physics/cam/cloud_rad_props.F90 +++ b/src/physics/cam/cloud_rad_props.F90 @@ -7,16 +7,22 @@ module cloud_rad_props use ppgrid, only: pcols, pver, pverp use physics_types, only: physics_state use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_get_field, pbuf_old_tim_idx +use constituents, only: cnst_get_ind use radconstants, only: nswbands, nlwbands, idx_sw_diag -use cam_abortutils, only: endrun use rad_constituents, only: iceopticsfile, liqopticsfile -use oldcloud, only: oldcloud_lw, old_liq_get_rad_props_lw, old_ice_get_rad_props_lw, oldcloud_init +use oldcloud, only: oldcloud_init, oldcloud_lw, & + old_liq_get_rad_props_lw, old_ice_get_rad_props_lw + -use ebert_curry, only: scalefactor -use cam_logfile, only: iulog +use slingo, only: slingo_rad_props_init +use ebert_curry, only: ec_rad_props_init, scalefactor use interpolate_data, only: interp_type, lininterp_init, lininterp, & - extrap_method_bndry, lininterp_finish + extrap_method_bndry, lininterp_finish + +use cam_logfile, only: iulog +use cam_abortutils, only: endrun + implicit none private @@ -24,16 +30,15 @@ module cloud_rad_props public :: & cloud_rad_props_init, & - cloud_rad_props_get_sw, & ! return SW optical props of total bulk aerosols - cloud_rad_props_get_lw, & ! return LW optical props of total bulk aerosols + cloud_rad_props_get_lw, & ! return LW optical props for old cloud optics get_ice_optics_sw, & ! return Mitchell SW ice radiative properties ice_cloud_get_rad_props_lw, & ! return Mitchell LW ice radiative properties get_liquid_optics_sw, & ! return Conley SW radiative properties liquid_cloud_get_rad_props_lw, & ! return Conley LW radiative properties - grau_cloud_get_rad_props_lw, & - get_grau_optics_sw, & + get_snow_optics_sw, & snow_cloud_get_rad_props_lw, & - get_snow_optics_sw + get_grau_optics_sw, & + grau_cloud_get_rad_props_lw integer :: nmu, nlambda @@ -51,24 +56,21 @@ module cloud_rad_props real(r8), allocatable :: asm_sw_ice(:,:) real(r8), allocatable :: abs_lw_ice(:,:) -! ! indexes into pbuf for optical parameters of MG clouds -! - integer :: i_dei=0 - integer :: i_mu=0 - integer :: i_lambda=0 - integer :: i_iciwp=0 - integer :: i_iclwp=0 - integer :: i_des=0 - integer :: i_icswp=0 - integer :: i_degrau=0 - integer :: i_icgrauwp=0 +integer :: i_dei=0 +integer :: i_mu=0 +integer :: i_lambda=0 +integer :: i_iciwp=0 +integer :: i_iclwp=0 +integer :: i_des=0 +integer :: i_icswp=0 +integer :: i_degrau=0 +integer :: i_icgrauwp=0 ! indexes into constituents for old optics - integer :: & - ixcldice, & ! cloud ice water index - ixcldliq ! cloud liquid water index - +integer :: & + ixcldice, & ! cloud ice water index + ixcldliq ! cloud liquid water index !============================================================================== contains @@ -83,9 +85,6 @@ subroutine cloud_rad_props_init() #if ( defined SPMD ) use mpishorthand #endif - use constituents, only: cnst_get_ind - use slingo, only: slingo_rad_props_init - use ebert_curry, only: ec_rad_props_init, scalefactor character(len=256) :: liquidfile character(len=256) :: icefile @@ -199,7 +198,7 @@ subroutine cloud_rad_props_init() call mpibcast(asm_sw_liq, nmu*nlambda*nswbands, mpir8, 0, mpicom, ierr) call mpibcast(abs_lw_liq, nmu*nlambda*nlwbands, mpir8, 0, mpicom, ierr) #endif - ! I forgot to convert kext from m^2/Volume to m^2/Kg + ! Convert kext from m^2/Volume to m^2/Kg ext_sw_liq = ext_sw_liq / 0.9970449e3_r8 abs_lw_liq = abs_lw_liq / 0.9970449e3_r8 @@ -283,124 +282,34 @@ end subroutine cloud_rad_props_init !============================================================================== -subroutine cloud_rad_props_get_sw(state, pbuf, & - tau, tau_w, tau_w_g, tau_w_f,& - diagnosticindex, oldliq, oldice) - -! return totaled (across all species) layer tau, omega, g, f -! for all spectral interval for aerosols affecting the climate - - ! Arguments - type(physics_state), intent(in) :: state - type(physics_buffer_desc),pointer :: pbuf(:) - integer, optional, intent(in) :: diagnosticindex ! index (if present) to radiation diagnostic information - - real(r8), intent(out) :: tau (nswbands,pcols,pver) ! aerosol extinction optical depth - real(r8), intent(out) :: tau_w (nswbands,pcols,pver) ! aerosol single scattering albedo * tau - real(r8), intent(out) :: tau_w_g(nswbands,pcols,pver) ! aerosol assymetry parameter * tau * w - real(r8), intent(out) :: tau_w_f(nswbands,pcols,pver) ! aerosol forward scattered fraction * tau * w - - logical, optional, intent(in) :: oldliq,oldice - - ! Local variables - - integer :: ncol - integer :: lchnk - integer :: k, i ! lev and daycolumn indices - integer :: iswband ! sw band indices - - ! optical props for each aerosol - real(r8), pointer :: h_ext(:,:) - real(r8), pointer :: h_ssa(:,:) - real(r8), pointer :: h_asm(:,:) - real(r8), pointer :: n_ext(:) - real(r8), pointer :: n_ssa(:) - real(r8), pointer :: n_asm(:) - - ! rad properties for liquid clouds - real(r8) :: liq_tau (nswbands,pcols,pver) ! aerosol extinction optical depth - real(r8) :: liq_tau_w (nswbands,pcols,pver) ! aerosol single scattering albedo * tau - real(r8) :: liq_tau_w_g(nswbands,pcols,pver) ! aerosol assymetry parameter * tau * w - real(r8) :: liq_tau_w_f(nswbands,pcols,pver) ! aerosol forward scattered fraction * tau * w - - ! rad properties for ice clouds - real(r8) :: ice_tau (nswbands,pcols,pver) ! aerosol extinction optical depth - real(r8) :: ice_tau_w (nswbands,pcols,pver) ! aerosol single scattering albedo * tau - real(r8) :: ice_tau_w_g(nswbands,pcols,pver) ! aerosol assymetry parameter * tau * w - real(r8) :: ice_tau_w_f(nswbands,pcols,pver) ! aerosol forward scattered fraction * tau * w - - !----------------------------------------------------------------------------- - - ncol = state%ncol - lchnk = state%lchnk - - ! initialize to conditions that would cause failure - tau (:,:,:) = -100._r8 - tau_w (:,:,:) = -100._r8 - tau_w_g (:,:,:) = -100._r8 - tau_w_f (:,:,:) = -100._r8 - - ! initialize layers to accumulate od's - tau (:,1:ncol,:) = 0._r8 - tau_w (:,1:ncol,:) = 0._r8 - tau_w_g(:,1:ncol,:) = 0._r8 - tau_w_f(:,1:ncol,:) = 0._r8 - - - call get_liquid_optics_sw(state, pbuf, liq_tau, liq_tau_w, liq_tau_w_g, liq_tau_w_f) - - call get_ice_optics_sw (state, pbuf, ice_tau, ice_tau_w, ice_tau_w_g, ice_tau_w_f) - - tau (:,1:ncol,:) = liq_tau (:,1:ncol,:) + ice_tau (:,1:ncol,:) - tau_w (:,1:ncol,:) = liq_tau_w (:,1:ncol,:) + ice_tau_w (:,1:ncol,:) - tau_w_g(:,1:ncol,:) = liq_tau_w_g(:,1:ncol,:) + ice_tau_w_g(:,1:ncol,:) - tau_w_f(:,1:ncol,:) = liq_tau_w_f(:,1:ncol,:) + ice_tau_w_f(:,1:ncol,:) - -end subroutine cloud_rad_props_get_sw -!============================================================================== - -subroutine cloud_rad_props_get_lw(state, pbuf, cld_abs_od, diagnosticindex, oldliq, oldice, oldcloud) +subroutine cloud_rad_props_get_lw(state, pbuf, cld_abs_od, oldliq, oldice, oldcloud) -! Purpose: Compute cloud longwave absorption optical depth -! cloud_rad_props_get_lw() is called by radlw() + ! Purpose: Compute cloud longwave absorption optical depth ! Arguments type(physics_state), intent(in) :: state type(physics_buffer_desc),pointer:: pbuf(:) real(r8), intent(out) :: cld_abs_od(nlwbands,pcols,pver) ! [fraction] absorption optical depth, per layer - integer, optional, intent(in) :: diagnosticindex logical, optional, intent(in) :: oldliq ! use old liquid optics logical, optional, intent(in) :: oldice ! use old ice optics logical, optional, intent(in) :: oldcloud ! use old optics for both (b4b) ! Local variables - - integer :: bnd_idx ! LW band index - integer :: i ! column index - integer :: k ! lev index integer :: ncol ! number of columns - integer :: lchnk ! rad properties for liquid clouds real(r8) :: liq_tau_abs_od(nlwbands,pcols,pver) ! liquid cloud absorption optical depth ! rad properties for ice clouds real(r8) :: ice_tau_abs_od(nlwbands,pcols,pver) ! ice cloud absorption optical depth - !----------------------------------------------------------------------------- ncol = state%ncol - lchnk = state%lchnk - ! compute optical depths cld_absod cld_abs_od = 0._r8 if(present(oldcloud))then if(oldcloud) then - ! make diagnostic calls to these first to output ice and liq OD's - !call old_liq_get_rad_props_lw(state, pbuf, liq_tau_abs_od, oldliqwp=.false.) - !call old_ice_get_rad_props_lw(state, pbuf, ice_tau_abs_od, oldicewp=.false.) - ! This affects climate (cld_abs_od) call oldcloud_lw(state,pbuf,cld_abs_od,oldwp=.false.) return endif @@ -432,6 +341,29 @@ end subroutine cloud_rad_props_get_lw !============================================================================== +subroutine get_ice_optics_sw(state, pbuf, tau, tau_w, tau_w_g, tau_w_f) + type(physics_state), intent(in) :: state + type(physics_buffer_desc),pointer :: pbuf(:) + + real(r8),intent(out) :: tau (nswbands,pcols,pver) ! extinction optical depth + real(r8),intent(out) :: tau_w (nswbands,pcols,pver) ! single scattering albedo * tau + real(r8),intent(out) :: tau_w_g(nswbands,pcols,pver) ! assymetry parameter * tau * w + real(r8),intent(out) :: tau_w_f(nswbands,pcols,pver) ! forward scattered fraction * tau * w + + real(r8), pointer :: iciwpth(:,:), dei(:,:) + + ! Get relevant pbuf fields, and interpolate optical properties from + ! the lookup tables. + call pbuf_get_field(pbuf, i_iciwp, iciwpth) + call pbuf_get_field(pbuf, i_dei, dei) + + call interpolate_ice_optics_sw(state%ncol, iciwpth, dei, tau, tau_w, & + tau_w_g, tau_w_f) + +end subroutine get_ice_optics_sw + +!============================================================================== + subroutine get_snow_optics_sw(state, pbuf, tau, tau_w, tau_w_g, tau_w_f) type(physics_state), intent(in) :: state type(physics_buffer_desc),pointer :: pbuf(:) @@ -492,82 +424,6 @@ subroutine get_grau_optics_sw(state, pbuf, tau, tau_w, tau_w_g, tau_w_f) end subroutine get_grau_optics_sw -!============================================================================== -! Private methods -!============================================================================== - -subroutine get_ice_optics_sw(state, pbuf, tau, tau_w, tau_w_g, tau_w_f) - type(physics_state), intent(in) :: state - type(physics_buffer_desc),pointer :: pbuf(:) - - real(r8),intent(out) :: tau (nswbands,pcols,pver) ! extinction optical depth - real(r8),intent(out) :: tau_w (nswbands,pcols,pver) ! single scattering albedo * tau - real(r8),intent(out) :: tau_w_g(nswbands,pcols,pver) ! assymetry parameter * tau * w - real(r8),intent(out) :: tau_w_f(nswbands,pcols,pver) ! forward scattered fraction * tau * w - - real(r8), pointer :: iciwpth(:,:), dei(:,:) - - ! Get relevant pbuf fields, and interpolate optical properties from - ! the lookup tables. - call pbuf_get_field(pbuf, i_iciwp, iciwpth) - call pbuf_get_field(pbuf, i_dei, dei) - - call interpolate_ice_optics_sw(state%ncol, iciwpth, dei, tau, tau_w, & - tau_w_g, tau_w_f) - -end subroutine get_ice_optics_sw - -!============================================================================== - -subroutine interpolate_ice_optics_sw(ncol, iciwpth, dei, tau, tau_w, & - tau_w_g, tau_w_f) - - integer, intent(in) :: ncol - real(r8), intent(in) :: iciwpth(pcols,pver) - real(r8), intent(in) :: dei(pcols,pver) - - real(r8),intent(out) :: tau (nswbands,pcols,pver) ! extinction optical depth - real(r8),intent(out) :: tau_w (nswbands,pcols,pver) ! single scattering albedo * tau - real(r8),intent(out) :: tau_w_g(nswbands,pcols,pver) ! assymetry parameter * tau * w - real(r8),intent(out) :: tau_w_f(nswbands,pcols,pver) ! forward scattered fraction * tau * w - - type(interp_type) :: dei_wgts - - integer :: i, k, swband - real(r8) :: ext(nswbands), ssa(nswbands), asm(nswbands) - - do k = 1,pver - do i = 1,ncol - if( iciwpth(i,k) < 1.e-80_r8 .or. dei(i,k) == 0._r8) then - ! if ice water path is too small, OD := 0 - tau (:,i,k) = 0._r8 - tau_w (:,i,k) = 0._r8 - tau_w_g(:,i,k) = 0._r8 - tau_w_f(:,i,k) = 0._r8 - else - ! for each cell interpolate to find weights in g_d_eff grid. - call lininterp_init(g_d_eff, n_g_d, dei(i:i,k), 1, & - extrap_method_bndry, dei_wgts) - ! interpolate into grid and extract radiative properties - do swband = 1, nswbands - call lininterp(ext_sw_ice(:,swband), n_g_d, & - ext(swband:swband), 1, dei_wgts) - call lininterp(ssa_sw_ice(:,swband), n_g_d, & - ssa(swband:swband), 1, dei_wgts) - call lininterp(asm_sw_ice(:,swband), n_g_d, & - asm(swband:swband), 1, dei_wgts) - end do - tau (:,i,k) = iciwpth(i,k) * ext - tau_w (:,i,k) = tau(:,i,k) * ssa - tau_w_g(:,i,k) = tau_w(:,i,k) * asm - tau_w_f(:,i,k) = tau_w_g(:,i,k) * asm - call lininterp_finish(dei_wgts) - endif - enddo - enddo - -end subroutine interpolate_ice_optics_sw - !============================================================================== subroutine get_liquid_optics_sw(state, pbuf, tau, tau_w, tau_w_g, tau_w_f) @@ -581,9 +437,8 @@ subroutine get_liquid_optics_sw(state, pbuf, tau, tau_w, tau_w_g, tau_w_f) real(r8), pointer, dimension(:,:) :: lamc, pgam, iclwpth real(r8), dimension(pcols,pver) :: kext - integer i,k,swband,lchnk,ncol + integer i,k,swband, ncol - lchnk = state%lchnk ncol = state%ncol @@ -614,14 +469,13 @@ subroutine liquid_cloud_get_rad_props_lw(state, pbuf, abs_od) type(physics_buffer_desc),pointer :: pbuf(:) real(r8), intent(out) :: abs_od(nlwbands,pcols,pver) - integer :: lchnk, ncol + integer :: ncol real(r8), pointer, dimension(:,:) :: lamc, pgam, iclwpth integer lwband, i, k abs_od = 0._r8 - lchnk = state%lchnk ncol = state%ncol call pbuf_get_field(pbuf, i_lambda, lamc) @@ -699,6 +553,59 @@ subroutine ice_cloud_get_rad_props_lw(state, pbuf, abs_od) end subroutine ice_cloud_get_rad_props_lw +!============================================================================== +! Private methods +!============================================================================== + +subroutine interpolate_ice_optics_sw(ncol, iciwpth, dei, tau, tau_w, & + tau_w_g, tau_w_f) + + integer, intent(in) :: ncol + real(r8), intent(in) :: iciwpth(pcols,pver) + real(r8), intent(in) :: dei(pcols,pver) + + real(r8),intent(out) :: tau (nswbands,pcols,pver) ! extinction optical depth + real(r8),intent(out) :: tau_w (nswbands,pcols,pver) ! single scattering albedo * tau + real(r8),intent(out) :: tau_w_g(nswbands,pcols,pver) ! assymetry parameter * tau * w + real(r8),intent(out) :: tau_w_f(nswbands,pcols,pver) ! forward scattered fraction * tau * w + + type(interp_type) :: dei_wgts + + integer :: i, k, swband + real(r8) :: ext(nswbands), ssa(nswbands), asm(nswbands) + + do k = 1,pver + do i = 1,ncol + if( iciwpth(i,k) < 1.e-80_r8 .or. dei(i,k) == 0._r8) then + ! if ice water path is too small, OD := 0 + tau (:,i,k) = 0._r8 + tau_w (:,i,k) = 0._r8 + tau_w_g(:,i,k) = 0._r8 + tau_w_f(:,i,k) = 0._r8 + else + ! for each cell interpolate to find weights in g_d_eff grid. + call lininterp_init(g_d_eff, n_g_d, dei(i:i,k), 1, & + extrap_method_bndry, dei_wgts) + ! interpolate into grid and extract radiative properties + do swband = 1, nswbands + call lininterp(ext_sw_ice(:,swband), n_g_d, & + ext(swband:swband), 1, dei_wgts) + call lininterp(ssa_sw_ice(:,swband), n_g_d, & + ssa(swband:swband), 1, dei_wgts) + call lininterp(asm_sw_ice(:,swband), n_g_d, & + asm(swband:swband), 1, dei_wgts) + end do + tau (:,i,k) = iciwpth(i,k) * ext + tau_w (:,i,k) = tau(:,i,k) * ssa + tau_w_g(:,i,k) = tau_w(:,i,k) * asm + tau_w_f(:,i,k) = tau_w_g(:,i,k) * asm + call lininterp_finish(dei_wgts) + endif + enddo + enddo + +end subroutine interpolate_ice_optics_sw + !============================================================================== subroutine interpolate_ice_optics_lw(ncol, iciwpth, dei, abs_od) diff --git a/src/physics/cam/ebert_curry.F90 b/src/physics/cam/ebert_curry.F90 index e218b8e7b3..8a47714c19 100644 --- a/src/physics/cam/ebert_curry.F90 +++ b/src/physics/cam/ebert_curry.F90 @@ -174,6 +174,7 @@ subroutine ec_ice_optics_sw (state, pbuf, ice_tau, ice_tau_w, ice_tau_w_g, ice end do ! nswbands end subroutine ec_ice_optics_sw + !============================================================================== subroutine ec_ice_get_rad_props_lw(state, pbuf, abs_od, oldicewp) @@ -257,6 +258,7 @@ subroutine ec_ice_get_rad_props_lw(state, pbuf, abs_od, oldicewp) enddo end subroutine ec_ice_get_rad_props_lw + !============================================================================== end module ebert_curry diff --git a/src/physics/cam/oldcloud.F90 b/src/physics/cam/oldcloud.F90 index 06a91b232e..d34794e4f1 100644 --- a/src/physics/cam/oldcloud.F90 +++ b/src/physics/cam/oldcloud.F90 @@ -7,18 +7,22 @@ module oldcloud use ppgrid, only: pcols, pver, pverp use physics_types, only: physics_state use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_old_tim_idx, pbuf_get_field -use radconstants, only: nswbands, nlwbands, get_sw_spectral_boundaries -use cam_abortutils, only: endrun -use cam_history, only: outfld -use rad_constituents, only: iceopticsfile, liqopticsfile +use constituents, only: cnst_get_ind +use physconst, only: gravit +use radconstants, only: nlwbands use ebert_curry, only: scalefactor +use cam_abortutils, only: endrun + implicit none private save public :: & - oldcloud_init, oldcloud_lw, old_liq_get_rad_props_lw, old_ice_get_rad_props_lw + oldcloud_init, & + oldcloud_lw, & + old_liq_get_rad_props_lw, & + old_ice_get_rad_props_lw integer :: nmu, nlambda real(r8), allocatable :: g_mu(:) ! mu samples on grid @@ -37,29 +41,23 @@ module oldcloud ! Minimum cloud amount (as a fraction of the grid-box area) to ! distinguish from clear sky -! - real(r8) cldmin - parameter (cldmin = 1.0e-80_r8) -! +real(r8), parameter :: cldmin = 1.0e-80_r8 + ! Decimal precision of cloud amount (0 -> preserve full resolution; ! 10^-n -> preserve n digits of cloud amount) -! - real(r8) cldeps - parameter (cldeps = 0.0_r8) - -! -! indexes into pbuf for optical parameters of MG clouds -! - integer :: iciwp_idx = 0 - integer :: iclwp_idx = 0 - integer :: cld_idx = 0 - integer :: rel_idx = 0 - integer :: rei_idx = 0 +real(r8), parameter :: cldeps = 0.0_r8 + +! indexes into pbuf +integer :: iciwp_idx = 0 +integer :: iclwp_idx = 0 +integer :: cld_idx = 0 +integer :: rel_idx = 0 +integer :: rei_idx = 0 ! indexes into constituents for old optics - integer :: & - ixcldice, & ! cloud ice water index - ixcldliq ! cloud liquid water index +integer :: & + ixcldice, & ! cloud ice water index + ixcldliq ! cloud liquid water index !============================================================================== @@ -68,7 +66,6 @@ module oldcloud subroutine oldcloud_init() - use constituents, only: cnst_get_ind integer :: err @@ -86,275 +83,10 @@ subroutine oldcloud_init() end subroutine oldcloud_init -!============================================================================== -! Private methods -!============================================================================== - -subroutine old_liquid_optics_sw(state, pbuf, liq_tau, liq_tau_w, liq_tau_w_g, liq_tau_w_f, oldliqwp) - - use physconst, only: gravit - - type(physics_state), intent(in) :: state - type(physics_buffer_desc),pointer :: pbuf(:) - - real(r8),intent(out) :: liq_tau (nswbands,pcols,pver) ! extinction optical depth - real(r8),intent(out) :: liq_tau_w (nswbands,pcols,pver) ! single scattering albedo * tau - real(r8),intent(out) :: liq_tau_w_g(nswbands,pcols,pver) ! assymetry parameter * tau * w - real(r8),intent(out) :: liq_tau_w_f(nswbands,pcols,pver) ! forward scattered fraction * tau * w - logical, intent(in) :: oldliqwp - - real(r8), pointer, dimension(:,:) :: rel - real(r8), pointer, dimension(:,:) :: cldn - real(r8), pointer, dimension(:,:) :: tmpptr - real(r8), dimension(pcols,pver) :: cliqwp - real(r8), dimension(nswbands) :: wavmin - real(r8), dimension(nswbands) :: wavmax - - ! Minimum cloud amount (as a fraction of the grid-box area) to - ! distinguish from clear sky - real(r8), parameter :: cldmin = 1.0e-80_r8 - - ! Decimal precision of cloud amount (0 -> preserve full resolution; - ! 10^-n -> preserve n digits of cloud amount) - real(r8), parameter :: cldeps = 0.0_r8 - - ! A. Slingo's data for cloud particle radiative properties (from 'A GCM - ! Parameterization for the Shortwave Properties of Water Clouds' JAS - ! vol. 46 may 1989 pp 1419-1427) - real(r8) :: abarl(4) = & ! A coefficient for extinction optical depth - (/ 2.817e-02_r8, 2.682e-02_r8,2.264e-02_r8,1.281e-02_r8/) - real(r8) :: bbarl(4) = & ! B coefficient for extinction optical depth - (/ 1.305_r8 , 1.346_r8 ,1.454_r8 ,1.641_r8 /) - real(r8) :: cbarl(4) = & ! C coefficient for single scat albedo - (/-5.62e-08_r8 ,-6.94e-06_r8 ,4.64e-04_r8 ,0.201_r8 /) - real(r8) :: dbarl(4) = & ! D coefficient for single scat albedo - (/ 1.63e-07_r8 , 2.35e-05_r8 ,1.24e-03_r8 ,7.56e-03_r8 /) - real(r8) :: ebarl(4) = & ! E coefficient for asymmetry parameter - (/ 0.829_r8 , 0.794_r8 ,0.754_r8 ,0.826_r8 /) - real(r8) :: fbarl(4) = & ! F coefficient for asymmetry parameter - (/ 2.482e-03_r8, 4.226e-03_r8,6.560e-03_r8,4.353e-03_r8/) - - real(r8) :: abarli ! A coefficient for current spectral band - real(r8) :: bbarli ! B coefficient for current spectral band - real(r8) :: cbarli ! C coefficient for current spectral band - real(r8) :: dbarli ! D coefficient for current spectral band - real(r8) :: ebarli ! E coefficient for current spectral band - real(r8) :: fbarli ! F coefficient for current spectral band - - ! Caution... A. Slingo recommends no less than 4.0 micro-meters nor - ! greater than 20 micro-meters - - integer :: ns, i, k, indxsl, Nday - integer :: lchnk, itim_old - real(r8) :: tmp1l, tmp2l, tmp3l, g - real(r8) :: kext(pcols,pver) - real(r8), pointer, dimension(:,:) :: iclwpth - - Nday = state%ncol - lchnk = state%lchnk - - itim_old = pbuf_old_tim_idx() - call pbuf_get_field(pbuf, cld_idx,cldn, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) - call pbuf_get_field(pbuf, rel_idx,rel) - - if (oldliqwp) then - do k=1,pver - do i = 1,Nday - cliqwp(i,k) = state%q(i,k,ixcldliq)*state%pdel(i,k)/(gravit*max(0.01_r8,cldn(i,k))) - end do - end do - else - if (iclwp_idx<0) then - call endrun('old_liquid_optics_sw: oldliqwp must be set to true since ICLWP was not found in pbuf') - endif - ! The following is the eventual target specification for in cloud liquid water path. - call pbuf_get_field(pbuf, iclwp_idx, tmpptr) - cliqwp = tmpptr - endif - - call get_sw_spectral_boundaries(wavmin,wavmax,'microns') - - do ns = 1, nswbands - ! Set index for cloud particle properties based on the wavelength, - ! according to A. Slingo (1989) equations 1-3: - ! Use index 1 (0.25 to 0.69 micrometers) for visible - ! Use index 2 (0.69 - 1.19 micrometers) for near-infrared - ! Use index 3 (1.19 to 2.38 micrometers) for near-infrared - ! Use index 4 (2.38 to 4.00 micrometers) for near-infrared - if(wavmax(ns) <= 0.7_r8) then - indxsl = 1 - else if(wavmax(ns) <= 1.25_r8) then - indxsl = 2 - else if(wavmax(ns) <= 2.38_r8) then - indxsl = 3 - else if(wavmin(ns) > 2.38_r8) then - indxsl = 4 - end if - - ! Set cloud extinction optical depth, single scatter albedo, - ! asymmetry parameter, and forward scattered fraction: - abarli = abarl(indxsl) - bbarli = bbarl(indxsl) - cbarli = cbarl(indxsl) - dbarli = dbarl(indxsl) - ebarli = ebarl(indxsl) - fbarli = fbarl(indxsl) - - do k=1,pver - do i=1,Nday - - ! note that optical properties for liquid valid only - ! in range of 4.2 > rel > 16 micron (Slingo 89) - if (cldn(i,k) >= cldmin .and. cldn(i,k) >= cldeps) then - tmp1l = abarli + bbarli/min(max(4.2_r8,rel(i,k)),16._r8) - liq_tau(ns,i,k) = 1000._r8*cliqwp(i,k)*tmp1l - else - liq_tau(ns,i,k) = 0.0_r8 - endif - - tmp2l = 1._r8 - cbarli - dbarli*min(max(4.2_r8,rel(i,k)),16._r8) - tmp3l = fbarli*min(max(4.2_r8,rel(i,k)),16._r8) - ! Do not let single scatter albedo be 1. Delta-eddington solution - ! for non-conservative case has different analytic form from solution - ! for conservative case, and raddedmx is written for non-conservative case. - liq_tau_w(ns,i,k) = liq_tau(ns,i,k) * min(tmp2l,.999999_r8) - g = ebarli + tmp3l - liq_tau_w_g(ns,i,k) = liq_tau_w(ns,i,k) * g - liq_tau_w_f(ns,i,k) = liq_tau_w(ns,i,k) * g * g - - end do ! End do i=1,Nday - end do ! End do k=1,pver - end do ! nswbands - -end subroutine old_liquid_optics_sw -!============================================================================== - -subroutine old_ice_optics_sw (state, pbuf, ice_tau, ice_tau_w, ice_tau_w_g, ice_tau_w_f, oldicewp) - - use physconst, only: gravit - - type(physics_state), intent(in) :: state - type(physics_buffer_desc),pointer :: pbuf(:) - - real(r8),intent(out) :: ice_tau (nswbands,pcols,pver) ! extinction optical depth - real(r8),intent(out) :: ice_tau_w (nswbands,pcols,pver) ! single scattering albedo * tau - real(r8),intent(out) :: ice_tau_w_g(nswbands,pcols,pver) ! assymetry parameter * tau * w - real(r8),intent(out) :: ice_tau_w_f(nswbands,pcols,pver) ! forward scattered fraction * tau * w - logical, intent(in) :: oldicewp - - real(r8), pointer, dimension(:,:) :: rei - real(r8), pointer, dimension(:,:) :: cldn - real(r8), pointer, dimension(:,:) :: tmpptr - real(r8), dimension(pcols,pver) :: cicewp - real(r8), dimension(nswbands) :: wavmin - real(r8), dimension(nswbands) :: wavmax - ! - ! ice water coefficients (Ebert and Curry,1992, JGR, 97, 3831-3836) - real(r8) :: abari(4) = & ! a coefficient for extinction optical depth - (/ 3.448e-03_r8, 3.448e-03_r8,3.448e-03_r8,3.448e-03_r8/) - real(r8) :: bbari(4) = & ! b coefficient for extinction optical depth - (/ 2.431_r8 , 2.431_r8 ,2.431_r8 ,2.431_r8 /) - real(r8) :: cbari(4) = & ! c coefficient for single scat albedo - (/ 1.00e-05_r8 , 1.10e-04_r8 ,1.861e-02_r8,.46658_r8 /) - real(r8) :: dbari(4) = & ! d coefficient for single scat albedo - (/ 0.0_r8 , 1.405e-05_r8,8.328e-04_r8,2.05e-05_r8 /) - real(r8) :: ebari(4) = & ! e coefficient for asymmetry parameter - (/ 0.7661_r8 , 0.7730_r8 ,0.794_r8 ,0.9595_r8 /) - real(r8) :: fbari(4) = & ! f coefficient for asymmetry parameter - (/ 5.851e-04_r8, 5.665e-04_r8,7.267e-04_r8,1.076e-04_r8/) - - real(r8) :: abarii ! A coefficient for current spectral band - real(r8) :: bbarii ! B coefficient for current spectral band - real(r8) :: cbarii ! C coefficient for current spectral band - real(r8) :: dbarii ! D coefficient for current spectral band - real(r8) :: ebarii ! E coefficient for current spectral band - real(r8) :: fbarii ! F coefficient for current spectral band - - ! Minimum cloud amount (as a fraction of the grid-box area) to - ! distinguish from clear sky - real(r8), parameter :: cldmin = 1.0e-80_r8 - - ! Decimal precision of cloud amount (0 -> preserve full resolution; - ! 10^-n -> preserve n digits of cloud amount) - real(r8), parameter :: cldeps = 0.0_r8 - - integer :: ns, i, k, indxsl, lchnk, Nday - integer :: itim_old - real(r8) :: tmp1i, tmp2i, tmp3i, g - - Nday = state%ncol - lchnk = state%lchnk - - itim_old = pbuf_old_tim_idx() - call pbuf_get_field(pbuf, cld_idx,cldn, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) - call pbuf_get_field(pbuf, rei_idx,rei) - - if(oldicewp) then - do k=1,pver - do i = 1,Nday - cicewp(i,k) = 1000.0_r8*state%q(i,k,ixcldice)*state%pdel(i,k) /(gravit* max(0.01_r8,cldn(i,k))) - end do - end do - else - if (iciwp_idx<=0) then - call endrun('old_ice_optics_sw: oldicewp must be set to true since ICIWP was not found in pbuf') - endif - call pbuf_get_field(pbuf, iciwp_idx, tmpptr) - cicewp(1:pcols,1:pver) = 1000.0_r8*tmpptr - endif - - call get_sw_spectral_boundaries(wavmin,wavmax,'microns') - - do ns = 1, nswbands - - if(wavmax(ns) <= 0.7_r8) then - indxsl = 1 - else if(wavmax(ns) <= 1.25_r8) then - indxsl = 2 - else if(wavmax(ns) <= 2.38_r8) then - indxsl = 3 - else if(wavmin(ns) > 2.38_r8) then - indxsl = 4 - end if - - abarii = abari(indxsl) - bbarii = bbari(indxsl) - cbarii = cbari(indxsl) - dbarii = dbari(indxsl) - ebarii = ebari(indxsl) - fbarii = fbari(indxsl) - - do k=1,pver - do i=1,Nday - - ! note that optical properties for ice valid only - ! in range of 13 > rei > 130 micron (Ebert and Curry 92) - if (cldn(i,k) >= cldmin .and. cldn(i,k) >= cldeps) then - tmp1i = abarii + bbarii/max(13._r8,min(scalefactor*rei(i,k),130._r8)) - ice_tau(ns,i,k) = cicewp(i,k)*tmp1i - else - ice_tau(ns,i,k) = 0.0_r8 - endif - - tmp2i = 1._r8 - cbarii - dbarii*min(max(13._r8,scalefactor*rei(i,k)),130._r8) - tmp3i = fbarii*min(max(13._r8,scalefactor*rei(i,k)),130._r8) - ! Do not let single scatter albedo be 1. Delta-eddington solution - ! for non-conservative case has different analytic form from solution - ! for conservative case, and raddedmx is written for non-conservative case. - ice_tau_w(ns,i,k) = ice_tau(ns,i,k) * min(tmp2i,.999999_r8) - g = ebarii + tmp3i - ice_tau_w_g(ns,i,k) = ice_tau_w(ns,i,k) * g - ice_tau_w_f(ns,i,k) = ice_tau_w(ns,i,k) * g * g - - end do ! End do i=1,Nday - end do ! End do k=1,pver - end do ! nswbands - -end subroutine old_ice_optics_sw !============================================================================== subroutine oldcloud_lw(state,pbuf,cld_abs_od,oldwp) - use physconst, only: gravit + type(physics_state), intent(in) :: state type(physics_buffer_desc),pointer :: pbuf(:) real(r8), intent(out) :: cld_abs_od(nlwbands,pcols,pver) ! [fraction] absorption optical depth, per layer @@ -432,8 +164,8 @@ subroutine oldcloud_lw(state,pbuf,cld_abs_od,oldwp) end subroutine oldcloud_lw !============================================================================== + subroutine old_liq_get_rad_props_lw(state, pbuf, abs_od, oldliqwp) - use physconst, only: gravit type(physics_state), intent(in) :: state type(physics_buffer_desc),pointer :: pbuf(:) @@ -513,10 +245,11 @@ subroutine old_liq_get_rad_props_lw(state, pbuf, abs_od, oldliqwp) end subroutine old_liq_get_rad_props_lw + !============================================================================== subroutine old_ice_get_rad_props_lw(state, pbuf, abs_od, oldicewp) - use physconst, only: gravit + type(physics_state), intent(in) :: state type(physics_buffer_desc),pointer :: pbuf(:) real(r8), intent(out) :: abs_od(nlwbands,pcols,pver) @@ -594,43 +327,7 @@ subroutine old_ice_get_rad_props_lw(state, pbuf, abs_od, oldicewp) abs_od(lwband,1:ncol,1:pver)=cldtau(1:ncol,1:pver) enddo - !if(oldicewp) then - ! call outfld('CIWPTH_OLD',cicewp(:,:)/1000,pcols,lchnk) - !else - ! call outfld('CIWPTH_OLD',iciwpth(:,:),pcols,lchnk) - !endif - !call outfld('CI_OD_LW_OLD',cldtau(:,:),pcols,lchnk) - end subroutine old_ice_get_rad_props_lw -!============================================================================== - -subroutine cloud_total_vis_diag_out(lchnk, nnite, idxnite, tau, radsuffix) - - ! output total aerosol optical depth for the visible band - - use cam_history, only: outfld - use cam_history_support, only : fillvalue - - integer, intent(in) :: lchnk - integer, intent(in) :: nnite ! number of night columns - integer, intent(in) :: idxnite(nnite) ! local column indices of night columns - real(r8), intent(in) :: tau(:,:) - character(len=*), intent(in) :: radsuffix ! identifies whether the radiation call - ! is for the climate calc or a diagnostic calc - - ! Local variables - integer :: i - real(r8) :: tmp(pcols) - !----------------------------------------------------------------------------- - - ! compute total aerosol optical depth output where only daylight columns - tmp(:) = sum(tau(:,:), 2) - do i = 1, nnite - tmp(idxnite(i)) = fillvalue - end do - !call outfld('cloudOD_v'//trim(radsuffix), tmp, pcols, lchnk) - -end subroutine cloud_total_vis_diag_out !============================================================================== diff --git a/src/physics/cam/slingo.F90 b/src/physics/cam/slingo.F90 index 98018afa0f..80d42733b2 100644 --- a/src/physics/cam/slingo.F90 +++ b/src/physics/cam/slingo.F90 @@ -24,30 +24,23 @@ module slingo ! Minimum cloud amount (as a fraction of the grid-box area) to ! distinguish from clear sky -! - real(r8) cldmin - parameter (cldmin = 1.0e-80_r8) -! +real(r8), parameter :: cldmin = 1.0e-80_r8 + ! Decimal precision of cloud amount (0 -> preserve full resolution; ! 10^-n -> preserve n digits of cloud amount) -! - real(r8) cldeps - parameter (cldeps = 0.0_r8) +real(r8), parameter :: cldeps = 0.0_r8 -! ! indexes into pbuf for optical parameters of MG clouds -! - integer :: iclwp_idx = 0 - integer :: iciwp_idx = 0 - integer :: cld_idx = 0 - integer :: rel_idx = 0 - integer :: rei_idx = 0 +integer :: iclwp_idx = 0 +integer :: iciwp_idx = 0 +integer :: cld_idx = 0 +integer :: rel_idx = 0 +integer :: rei_idx = 0 ! indexes into constituents for old optics - integer :: & - ixcldliq, & ! cloud liquid water index - ixcldice ! cloud liquid water index - +integer :: & + ixcldliq, & ! cloud liquid water index + ixcldice ! cloud liquid water index !============================================================================== contains @@ -82,7 +75,6 @@ end subroutine slingo_rad_props_init !============================================================================== - subroutine slingo_liq_optics_sw(state, pbuf, liq_tau, liq_tau_w, liq_tau_w_g, liq_tau_w_f, oldliqwp) type(physics_state), intent(in) :: state @@ -101,14 +93,6 @@ subroutine slingo_liq_optics_sw(state, pbuf, liq_tau, liq_tau_w, liq_tau_w_g, li real(r8), dimension(nswbands) :: wavmin real(r8), dimension(nswbands) :: wavmax - ! Minimum cloud amount (as a fraction of the grid-box area) to - ! distinguish from clear sky - real(r8), parameter :: cldmin = 1.0e-80_r8 - - ! Decimal precision of cloud amount (0 -> preserve full resolution; - ! 10^-n -> preserve n digits of cloud amount) - real(r8), parameter :: cldeps = 0.0_r8 - ! A. Slingo's data for cloud particle radiative properties (from 'A GCM ! Parameterization for the Shortwave Properties of Water Clouds' JAS ! vol. 46 may 1989 pp 1419-1427) @@ -295,7 +279,6 @@ subroutine slingo_liq_get_rad_props_lw(state, pbuf, abs_od, oldliqwp) abs_od(lwband,1:ncol,1:pver)=cldtau(1:ncol,1:pver) enddo - end subroutine slingo_liq_get_rad_props_lw end module slingo diff --git a/src/physics/rrtmgp/radiation.F90 b/src/physics/rrtmgp/radiation.F90 index e0d074e904..5d34b6533b 100644 --- a/src/physics/rrtmgp/radiation.F90 +++ b/src/physics/rrtmgp/radiation.F90 @@ -867,9 +867,9 @@ subroutine radiation_tend( & use cloud_rad_props, only: get_ice_optics_sw, ice_cloud_get_rad_props_lw, & get_liquid_optics_sw, liquid_cloud_get_rad_props_lw, & get_snow_optics_sw, snow_cloud_get_rad_props_lw, & - cloud_rad_props_get_lw, & - grau_cloud_get_rad_props_lw, & - get_grau_optics_sw + get_grau_optics_sw, grau_cloud_get_rad_props_lw, & + cloud_rad_props_get_lw + use slingo, only: slingo_liq_get_rad_props_lw, slingo_liq_optics_sw use ebert_curry, only: ec_ice_optics_sw, ec_ice_get_rad_props_lw From 749f90a3c07d95ea5b50b24dd19aaee6d6ee993f Mon Sep 17 00:00:00 2001 From: Brian Eaton Date: Wed, 20 Sep 2023 12:54:26 -0400 Subject: [PATCH 153/291] refactor setting cloud_sw object --- src/physics/rrtmgp/radiation.F90 | 253 +++++++++++++-------------- src/physics/rrtmgp/rrtmgp_inputs.F90 | 196 ++++++++++++--------- 2 files changed, 226 insertions(+), 223 deletions(-) diff --git a/src/physics/rrtmgp/radiation.F90 b/src/physics/rrtmgp/radiation.F90 index 5d34b6533b..40b8ca444b 100644 --- a/src/physics/rrtmgp/radiation.F90 +++ b/src/physics/rrtmgp/radiation.F90 @@ -189,7 +189,8 @@ module radiation integer :: cld_idx = 0 integer :: cldfgrau_idx = 0 -character(len=4) :: diag(0:N_DIAG) =(/' ','_d1 ','_d2 ','_d3 ','_d4 ','_d5 ','_d6 ','_d7 ','_d8 ','_d9 ','_d10'/) +character(len=4) :: diag(0:N_DIAG) =(/' ','_d1 ','_d2 ','_d3 ','_d4 ','_d5 ',& + '_d6 ','_d7 ','_d8 ','_d9 ','_d10'/) ! averaging time interval for zenith angle real(r8) :: dt_avg = 0._r8 @@ -206,10 +207,11 @@ module radiation ! extra layer that is added between 1 Pa and the model top. ! 2. If the WACCM model top is above 1 Pa, then RRMTGP only does calculations ! for those model layers that are below 1 Pa. -integer :: ktopcam ! Index in CAM arrays of top level (layer or interface) at which RRTMGP is active. -integer :: ktoprad ! Index in RRTMGP arrays of the layer or interface corresponding to CAM's top - ! layer or interface. - ! For CAM's top to bottom indexing, the index of a given layer +integer :: ktopcam ! Index in CAM arrays of top level (layer or interface) at which + ! RRTMGP is active. +integer :: ktoprad ! Index in RRTMGP arrays of the layer or interface corresponding + ! to CAM's top layer or interface. + ! Note: for CAM's top to bottom indexing, the index of a given layer ! (midpoint) and the upper interface of that layer, are the same. ! vertical coordinate for output of fluxes on radiation grid @@ -249,11 +251,10 @@ subroutine radiation_readnl(nlfile) ! Local variables integer :: unitn, ierr integer :: dtime ! timestep size - character(len=*), parameter :: subroutine_name = 'radiation_readnl' + character(len=*), parameter :: sub = 'radiation_readnl' character(len=cl) :: rrtmgp_coefs_lw_file, rrtmgp_coefs_sw_file - namelist /radiation_nl/ & rrtmgp_coefs_lw_file, rrtmgp_coefs_sw_file, iradsw, iradlw, & irad_always, use_rad_dt_cosz, spectralflux, use_rad_uniform_angle, & @@ -266,7 +267,7 @@ subroutine radiation_readnl(nlfile) if (ierr == 0) then read(unitn, radiation_nl, iostat=ierr) if (ierr /= 0) then - call endrun(subroutine_name // ':: ERROR reading namelist') + call endrun(sub//': ERROR reading namelist') end if end if close(unitn) @@ -274,28 +275,29 @@ subroutine radiation_readnl(nlfile) ! Broadcast namelist variables call mpi_bcast(rrtmgp_coefs_lw_file, cl, mpi_character, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(subroutine_name//": FATAL: mpi_bcast: rrtmgp_coefs_lw_file") + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: rrtmgp_coefs_lw_file") call mpi_bcast(rrtmgp_coefs_sw_file, cl, mpi_character, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(subroutine_name//": FATAL: mpi_bcast: rrtmgp_coefs_sw_file") + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: rrtmgp_coefs_sw_file") call mpi_bcast(iradsw, 1, mpi_integer, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(subroutine_name//": FATAL: mpi_bcast: iradsw") + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: iradsw") call mpi_bcast(iradlw, 1, mpi_integer, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(subroutine_name//": FATAL: mpi_bcast: iradlw") + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: iradlw") call mpi_bcast(irad_always, 1, mpi_integer, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(subroutine_name//": FATAL: mpi_bcast: irad_always") + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: irad_always") call mpi_bcast(use_rad_dt_cosz, 1, mpi_logical, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(subroutine_name//": FATAL: mpi_bcast: use_rad_dt_cosz") + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: use_rad_dt_cosz") call mpi_bcast(spectralflux, 1, mpi_logical, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(subroutine_name//": FATAL: mpi_bcast: spectralflux") + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: spectralflux") call mpi_bcast(use_rad_uniform_angle, 1, mpi_logical, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(subroutine_name//": FATAL: mpi_bcast: use_rad_uniform_angle") + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: use_rad_uniform_angle") call mpi_bcast(rad_uniform_angle, 1, mpi_logical, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(subroutine_name//": FATAL: mpi_bcast: rad_uniform_angle") + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: rad_uniform_angle") call mpi_bcast(graupel_in_rad, 1, mpi_logical, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(subroutine_name//": FATAL: mpi_bcast: graupel_in_rad") + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: graupel_in_rad") if (use_rad_uniform_angle .and. rad_uniform_angle == -99._r8) then - call endrun(subroutine_name // ' ERROR - use_rad_uniform_angle is set to .true, but rad_uniform_angle is not set ') + call endrun(sub//': ERROR - use_rad_uniform_angle is set to .true,' & + //' but rad_uniform_angle is not set ') end if ! Set module data @@ -348,7 +350,7 @@ subroutine radiation_register call pbuf_add_field('FLNT' , 'global',dtype_r8,(/pcols/), flnt_idx) ! Top-of-model net longwave flux ! If the namelist has been configured for preserving the spectral fluxes, then create - ! physics buffer variables to store the results. + ! physics buffer variables to store the results. This data is accessed by CARMA. if (spectralflux) then call pbuf_add_field('SU' , 'global',dtype_r8,(/pcols,pverp,nswbands/), su_idx) ! shortwave upward flux (per band) call pbuf_add_field('SD' , 'global',dtype_r8,(/pcols,pverp,nswbands/), sd_idx) ! shortwave downward flux (per band) @@ -599,66 +601,72 @@ subroutine radiation_init(pbuf2d) if (active_calls(icall)) then - call addfld('SOLIN'//diag(icall), horiz_only, 'A', 'W/m2', 'Solar insolation', sampling_seq='rad_lwsw') - - call addfld('QRS'//diag(icall), (/ 'lev' /), 'A', 'K/s', 'Solar heating rate', sampling_seq='rad_lwsw') - call addfld('QRSC'//diag(icall), (/ 'lev' /), 'A', 'K/s', 'Clearsky solar heating rate', & - sampling_seq='rad_lwsw') - call addfld('FSNT'//diag(icall), horiz_only, 'A', 'W/m2', 'Net solar flux at top of model', & - sampling_seq='rad_lwsw') - call addfld('FSNTC'//diag(icall), horiz_only, 'A', 'W/m2', 'Clearsky net solar flux at top of model', & - sampling_seq='rad_lwsw') - call addfld('FSNTOA'//diag(icall), horiz_only, 'A', 'W/m2', 'Net solar flux at top of atmosphere', & - sampling_seq='rad_lwsw') - call addfld('FSNTOAC'//diag(icall), horiz_only, 'A', 'W/m2', 'Clearsky net solar flux at top of atmosphere', & - sampling_seq='rad_lwsw') - call addfld('SWCF'//diag(icall), horiz_only, 'A', 'W/m2', 'Shortwave cloud forcing', & - sampling_seq='rad_lwsw') - call addfld('FSUTOA'//diag(icall), horiz_only, 'A', 'W/m2', 'Upwelling solar flux at top of atmosphere', & - sampling_seq='rad_lwsw') - call addfld('FSNIRTOA'//diag(icall), horiz_only, 'A', 'W/m2', & - 'Net near-infrared flux (Nimbus-7 WFOV) at top of atmosphere', sampling_seq='rad_lwsw') - call addfld('FSNRTOAC'//diag(icall), horiz_only, 'A', 'W/m2', & + call addfld('SOLIN'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Solar insolation', sampling_seq='rad_lwsw') + call addfld('QRS'//diag(icall), (/ 'lev' /), 'A', 'K/s', & + 'Solar heating rate', sampling_seq='rad_lwsw') + call addfld('QRSC'//diag(icall), (/ 'lev' /), 'A', 'K/s', & + 'Clearsky solar heating rate', sampling_seq='rad_lwsw') + call addfld('FSNT'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Net solar flux at top of model', sampling_seq='rad_lwsw') + call addfld('FSNTC'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Clearsky net solar flux at top of model', sampling_seq='rad_lwsw') + call addfld('FSNTOA'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Net solar flux at top of atmosphere', sampling_seq='rad_lwsw') + call addfld('FSNTOAC'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Clearsky net solar flux at top of atmosphere', sampling_seq='rad_lwsw') + call addfld('SWCF'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Shortwave cloud forcing', sampling_seq='rad_lwsw') + call addfld('FSUTOA'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Upwelling solar flux at top of atmosphere', sampling_seq='rad_lwsw') + call addfld('FSNIRTOA'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Net near-infrared flux (Nimbus-7 WFOV) at top of atmosphere', sampling_seq='rad_lwsw') + call addfld('FSNRTOAC'//diag(icall), horiz_only, 'A', 'W/m2', & 'Clearsky net near-infrared flux (Nimbus-7 WFOV) at top of atmosphere', sampling_seq='rad_lwsw') - call addfld('FSNRTOAS'//diag(icall), horiz_only, 'A', 'W/m2', & - 'Net near-infrared flux (>= 0.7 microns) at top of atmosphere', sampling_seq='rad_lwsw') - - call addfld('FSN200'//diag(icall), horiz_only, 'A', 'W/m2', 'Net shortwave flux at 200 mb', & - sampling_seq='rad_lwsw') - call addfld('FSN200C'//diag(icall), horiz_only, 'A', 'W/m2', 'Clearsky net shortwave flux at 200 mb', & - sampling_seq='rad_lwsw') - - call addfld('FSNR'//diag(icall), horiz_only, 'A', 'W/m2', 'Net solar flux at tropopause', & - sampling_seq='rad_lwsw') - - call addfld('SOLL'//diag(icall), horiz_only, 'A', 'W/m2', 'Solar downward near infrared direct to surface', & - sampling_seq='rad_lwsw') - call addfld('SOLS'//diag(icall), horiz_only, 'A', 'W/m2', 'Solar downward visible direct to surface', & - sampling_seq='rad_lwsw') - call addfld('SOLLD'//diag(icall), horiz_only, 'A', 'W/m2', 'Solar downward near infrared diffuse to surface', & - sampling_seq='rad_lwsw') - call addfld('SOLSD'//diag(icall), horiz_only, 'A', 'W/m2', 'Solar downward visible diffuse to surface', & - sampling_seq='rad_lwsw') - call addfld('FSNS'//diag(icall), horiz_only, 'A', 'W/m2', 'Net solar flux at surface', & - sampling_seq='rad_lwsw') - call addfld('FSNSC'//diag(icall), horiz_only, 'A', 'W/m2', 'Clearsky net solar flux at surface', & - sampling_seq='rad_lwsw') - - call addfld('FSDS'//diag(icall), horiz_only, 'A', 'W/m2', 'Downwelling solar flux at surface', & - sampling_seq='rad_lwsw') - call addfld('FSDSC'//diag(icall), horiz_only, 'A', 'W/m2', 'Clearsky downwelling solar flux at surface', & - sampling_seq='rad_lwsw') - - call addfld('FUS'//diag(icall), (/ 'ilev' /), 'I', 'W/m2', 'Shortwave upward flux') - call addfld('FDS'//diag(icall), (/ 'ilev' /), 'I', 'W/m2', 'Shortwave downward flux') - call addfld('FUSC'//diag(icall), (/ 'ilev' /), 'I', 'W/m2', 'Shortwave clear-sky upward flux') - call addfld('FDSC'//diag(icall), (/ 'ilev' /), 'I', 'W/m2', 'Shortwave clear-sky downward flux') + call addfld('FSNRTOAS'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Net near-infrared flux (>= 0.7 microns) at top of atmosphere', sampling_seq='rad_lwsw') + call addfld('FSN200'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Net shortwave flux at 200 mb', sampling_seq='rad_lwsw') + call addfld('FSN200C'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Clearsky net shortwave flux at 200 mb', sampling_seq='rad_lwsw') + call addfld('FSNR'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Net solar flux at tropopause', sampling_seq='rad_lwsw') + call addfld('SOLL'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Solar downward near infrared direct to surface', sampling_seq='rad_lwsw') + call addfld('SOLS'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Solar downward visible direct to surface', sampling_seq='rad_lwsw') + call addfld('SOLLD'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Solar downward near infrared diffuse to surface', sampling_seq='rad_lwsw') + call addfld('SOLSD'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Solar downward visible diffuse to surface', sampling_seq='rad_lwsw') + call addfld('FSNS'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Net solar flux at surface', sampling_seq='rad_lwsw') + call addfld('FSNSC'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Clearsky net solar flux at surface', sampling_seq='rad_lwsw') + call addfld('FSDS'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Downwelling solar flux at surface', sampling_seq='rad_lwsw') + call addfld('FSDSC'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Clearsky downwelling solar flux at surface', sampling_seq='rad_lwsw') + + ! Fluxes on CAM grid + call addfld('FUS'//diag(icall), (/ 'ilev' /), 'I', 'W/m2', & + 'Shortwave upward flux', sampling_seq='rad_lwsw') + call addfld('FDS'//diag(icall), (/ 'ilev' /), 'I', 'W/m2', & + 'Shortwave downward flux', sampling_seq='rad_lwsw') + call addfld('FUSC'//diag(icall), (/ 'ilev' /), 'I', 'W/m2', & + 'Shortwave clear-sky upward flux', sampling_seq='rad_lwsw') + call addfld('FDSC'//diag(icall), (/ 'ilev' /), 'I', 'W/m2', & + 'Shortwave clear-sky downward flux', sampling_seq='rad_lwsw') ! Fluxes on RRTMGP grid - call addfld('FSDN'//diag(icall), (/ 'plev_rad' /), 'I', 'W/m2', 'SW downward flux on rrtmgp grid') - call addfld('FSDNC'//diag(icall), (/ 'plev_rad' /), 'I', 'W/m2', 'SW downward clear sky flux on rrtmgp grid') - call addfld('FSUP'//diag(icall), (/ 'plev_rad' /), 'I', 'W/m2', 'SW upward flux on rrtmgp grid') - call addfld('FSUPC'//diag(icall), (/ 'plev_rad' /), 'I', 'W/m2', 'SW upward clear sky flux on rrtmgp grid') + call addfld('FSDN'//diag(icall), (/ 'plev_rad' /), 'I', 'W/m2', & + 'SW downward flux on rrtmgp grid', sampling_seq='rad_lwsw') + call addfld('FSDNC'//diag(icall), (/ 'plev_rad' /), 'I', 'W/m2', & + 'SW downward clear sky flux on rrtmgp grid', sampling_seq='rad_lwsw') + call addfld('FSUP'//diag(icall), (/ 'plev_rad' /), 'I', 'W/m2', & + 'SW upward flux on rrtmgp grid', sampling_seq='rad_lwsw') + call addfld('FSUPC'//diag(icall), (/ 'plev_rad' /), 'I', 'W/m2', & + 'SW upward clear sky flux on rrtmgp grid', sampling_seq='rad_lwsw') if (history_amwg) then call add_default('SOLIN'//diag(icall), 1, ' ') @@ -718,16 +726,26 @@ subroutine radiation_init(pbuf2d) 'Downwelling longwave flux at surface', sampling_seq='rad_lwsw') call addfld('FLDSC'//diag(icall), horiz_only, 'A', 'W/m2', & 'Clearsky Downwelling longwave flux at surface', sampling_seq='rad_lwsw') - call addfld('FUL'//diag(icall), (/ 'ilev' /), 'I', 'W/m2', 'Longwave upward flux') - call addfld('FDL'//diag(icall), (/ 'ilev' /), 'I', 'W/m2', 'Longwave downward flux') - call addfld('FULC'//diag(icall), (/ 'ilev' /), 'I', 'W/m2', 'Longwave clear-sky upward flux') - call addfld('FDLC'//diag(icall), (/ 'ilev' /), 'I', 'W/m2', 'Longwave clear-sky downward flux') + + ! Fluxes on CAM grid + call addfld('FUL'//diag(icall), (/ 'ilev' /), 'I', 'W/m2', & + 'Longwave upward flux', sampling_seq='rad_lwsw') + call addfld('FDL'//diag(icall), (/ 'ilev' /), 'I', 'W/m2', & + 'Longwave downward flux', sampling_seq='rad_lwsw') + call addfld('FULC'//diag(icall), (/ 'ilev' /), 'I', 'W/m2', & + 'Longwave clear-sky upward flux', sampling_seq='rad_lwsw') + call addfld('FDLC'//diag(icall), (/ 'ilev' /), 'I', 'W/m2', & + 'Longwave clear-sky downward flux', sampling_seq='rad_lwsw') ! Fluxes on rrtmgp grid - call addfld('FLDN'//diag(icall), (/ 'plev_rad' /), 'I', 'W/m2', 'LW downward flux on rrtmgp grid') - call addfld('FLDNC'//diag(icall), (/ 'plev_rad' /), 'I', 'W/m2', 'LW downward clear sky flux on rrtmgp grid') - call addfld('FLUP'//diag(icall), (/ 'plev_rad' /), 'I', 'W/m2', 'LW upward flux on rrtmgp grid') - call addfld('FLUPC'//diag(icall), (/ 'plev_rad' /), 'I', 'W/m2', 'LW upward clear sky flux on rrtmgp grid') + call addfld('FLDN'//diag(icall), (/ 'plev_rad' /), 'I', 'W/m2', & + 'LW downward flux on rrtmgp grid', sampling_seq='rad_lwsw') + call addfld('FLDNC'//diag(icall), (/ 'plev_rad' /), 'I', 'W/m2', & + 'LW downward clear sky flux on rrtmgp grid', sampling_seq='rad_lwsw') + call addfld('FLUP'//diag(icall), (/ 'plev_rad' /), 'I', 'W/m2', & + 'LW upward flux on rrtmgp grid', sampling_seq='rad_lwsw') + call addfld('FLUPC'//diag(icall), (/ 'plev_rad' /), 'I', 'W/m2', & + 'LW upward clear sky flux on rrtmgp grid', sampling_seq='rad_lwsw') if (history_amwg) then call add_default('QRL'//diag(icall), 1, ' ') @@ -956,33 +974,32 @@ subroutine radiation_tend( & real(r8), allocatable :: alb_dir(:,:) real(r8), allocatable :: alb_dif(:,:) + ! Forward scattered fraction * tau * w. RRTMGP does not use this property + ! in its 2-stream calculations. No need for separate storage for different cloud types. + real(r8) :: sw_tau_w_f(nswbands,pcols,pver) ! cloud radiative parameters are "in cloud" not "in cell" real(r8) :: ice_tau (nswbands,pcols,pver) ! ice extinction optical depth real(r8) :: ice_tau_w (nswbands,pcols,pver) ! ice single scattering albedo * tau real(r8) :: ice_tau_w_g(nswbands,pcols,pver) ! ice assymetry parameter * tau * w - real(r8) :: ice_tau_w_f(nswbands,pcols,pver) ! ice forward scattered fraction * tau * w real(r8) :: ice_lw_abs (nlwbands,pcols,pver) ! ice absorption optics depth (LW) ! cloud radiative parameters are "in cloud" not "in cell" real(r8) :: liq_tau (nswbands,pcols,pver) ! liquid extinction optical depth real(r8) :: liq_tau_w (nswbands,pcols,pver) ! liquid single scattering albedo * tau real(r8) :: liq_tau_w_g(nswbands,pcols,pver) ! liquid assymetry parameter * tau * w - real(r8) :: liq_tau_w_f(nswbands,pcols,pver) ! liquid forward scattered fraction * tau * w real(r8) :: liq_lw_abs (nlwbands,pcols,pver) ! liquid absorption optics depth (LW) ! cloud radiative parameters are "in cloud" not "in cell" real(r8) :: cld_tau (nswbands,pcols,pver) ! cloud extinction optical depth real(r8) :: cld_tau_w (nswbands,pcols,pver) ! cloud single scattering albedo * tau real(r8) :: cld_tau_w_g(nswbands,pcols,pver) ! cloud assymetry parameter * w * tau - real(r8) :: cld_tau_w_f(nswbands,pcols,pver) ! cloud forward scattered fraction * w * tau real(r8) :: cld_lw_abs (nlwbands,pcols,pver) ! cloud absorption optics depth (LW) ! "snow" cloud radiative parameters are "in cloud" not "in cell" real(r8) :: snow_tau (nswbands,pcols,pver) ! snow extinction optical depth real(r8) :: snow_tau_w (nswbands,pcols,pver) ! snow single scattering albedo * tau real(r8) :: snow_tau_w_g(nswbands,pcols,pver) ! snow assymetry parameter * tau * w - real(r8) :: snow_tau_w_f(nswbands,pcols,pver) ! snow forward scattered fraction * tau * w real(r8) :: snow_lw_abs (nlwbands,pcols,pver)! snow absorption optics depth (LW) ! Add graupel as another snow species. @@ -990,7 +1007,6 @@ subroutine radiation_tend( & real(r8) :: grau_tau (nswbands,pcols,pver) ! graupel extinction optical depth real(r8) :: grau_tau_w (nswbands,pcols,pver) ! graupel single scattering albedo * tau real(r8) :: grau_tau_w_g(nswbands,pcols,pver) ! graupel assymetry parameter * tau * w - real(r8) :: grau_tau_w_f(nswbands,pcols,pver) ! graupel forward scattered fraction * tau * w real(r8) :: grau_lw_abs (nlwbands,pcols,pver)! graupel absorption optics depth (LW) ! combined cloud radiative parameters are "in cloud" not "in cell" @@ -998,7 +1014,6 @@ subroutine radiation_tend( & real(r8) :: c_cld_tau (nswbands,pcols,pver) ! combined cloud extinction optical depth real(r8) :: c_cld_tau_w (nswbands,pcols,pver) ! combined cloud single scattering albedo * tau real(r8) :: c_cld_tau_w_g(nswbands,pcols,pver) ! combined cloud assymetry parameter * w * tau - real(r8) :: c_cld_tau_w_f(nswbands,pcols,pver) ! combined cloud forward scattered fraction * w * tau real(r8) :: c_cld_lw_abs (nlwbands,pcols,pver) ! combined cloud absorption optics depth (LW) ! Aerosol radiative properties **N.B.** These are zero-indexed to accomodate an "extra layer". @@ -1214,23 +1229,23 @@ subroutine radiation_tend( & if (dosw) then if (oldcldoptics) then - call ec_ice_optics_sw(state, pbuf, ice_tau, ice_tau_w, ice_tau_w_g, ice_tau_w_f, oldicewp=.false.) - call slingo_liq_optics_sw(state, pbuf, liq_tau, liq_tau_w, liq_tau_w_g, liq_tau_w_f, oldliqwp=.false.) + call ec_ice_optics_sw(state, pbuf, ice_tau, ice_tau_w, ice_tau_w_g, sw_tau_w_f, oldicewp=.false.) + call slingo_liq_optics_sw(state, pbuf, liq_tau, liq_tau_w, liq_tau_w_g, sw_tau_w_f, oldliqwp=.false.) else select case (icecldoptics) case ('ebertcurry') - call ec_ice_optics_sw(state, pbuf, ice_tau, ice_tau_w, ice_tau_w_g, ice_tau_w_f, oldicewp=.true.) + call ec_ice_optics_sw(state, pbuf, ice_tau, ice_tau_w, ice_tau_w_g, sw_tau_w_f, oldicewp=.true.) case ('mitchell') - call get_ice_optics_sw(state, pbuf, ice_tau, ice_tau_w, ice_tau_w_g, ice_tau_w_f) + call get_ice_optics_sw(state, pbuf, ice_tau, ice_tau_w, ice_tau_w_g, sw_tau_w_f) case default call endrun('icecldoptics must be one either ebertcurry or mitchell') end select select case (liqcldoptics) case ('slingo') - call slingo_liq_optics_sw(state, pbuf, liq_tau, liq_tau_w, liq_tau_w_g, liq_tau_w_f, oldliqwp=.true.) + call slingo_liq_optics_sw(state, pbuf, liq_tau, liq_tau_w, liq_tau_w_g, sw_tau_w_f, oldliqwp=.true.) case ('gammadist') - call get_liquid_optics_sw(state, pbuf, liq_tau, liq_tau_w, liq_tau_w_g, liq_tau_w_f) + call get_liquid_optics_sw(state, pbuf, liq_tau, liq_tau_w, liq_tau_w_g, sw_tau_w_f) case default call endrun('liqcldoptics must be either slingo or gammadist') end select @@ -1239,11 +1254,10 @@ subroutine radiation_tend( & cld_tau(:,:ncol,:) = liq_tau(:,:ncol,:) + ice_tau(:,:ncol,:) cld_tau_w(:,:ncol,:) = liq_tau_w(:,:ncol,:) + ice_tau_w(:,:ncol,:) cld_tau_w_g(:,:ncol,:) = liq_tau_w_g(:,:ncol,:) + ice_tau_w_g(:,:ncol,:) - cld_tau_w_f(:,:ncol,:) = liq_tau_w_f(:,:ncol,:) + ice_tau_w_f(:,:ncol,:) if (cldfsnow_idx > 0) then ! add in snow - call get_snow_optics_sw(state, pbuf, snow_tau, snow_tau_w, snow_tau_w_g, snow_tau_w_f) + call get_snow_optics_sw(state, pbuf, snow_tau, snow_tau_w, snow_tau_w_g, sw_tau_w_f) do i = 1, ncol do k = 1, pver if (cldfprime(i,k) > 0.) then @@ -1256,13 +1270,10 @@ subroutine radiation_tend( & c_cld_tau_w_g(:,i,k) = ( cldfsnow(i,k)*snow_tau_w_g(:,i,k) & + cld(i,k)*cld_tau_w_g(:,i,k) )/cldfprime(i,k) - c_cld_tau_w_f(:,i,k) = ( cldfsnow(i,k)*snow_tau_w_f(:,i,k) & - + cld(i,k)*cld_tau_w_f(:,i,k) )/cldfprime(i,k) else c_cld_tau(:,i,k) = 0._r8 c_cld_tau_w(:,i,k) = 0._r8 c_cld_tau_w_g(:,i,k) = 0._r8 - c_cld_tau_w_f(:,i,k) = 0._r8 end if end do end do @@ -1270,12 +1281,11 @@ subroutine radiation_tend( & c_cld_tau(:,:ncol,:) = cld_tau(:,:ncol,:) c_cld_tau_w(:,:ncol,:) = cld_tau_w(:,:ncol,:) c_cld_tau_w_g(:,:ncol,:) = cld_tau_w_g(:,:ncol,:) - c_cld_tau_w_f(:,:ncol,:) = cld_tau_w_f(:,:ncol,:) end if if (cldfgrau_idx > 0 .and. graupel_in_rad) then ! add in graupel - call get_grau_optics_sw(state, pbuf, grau_tau, grau_tau_w, grau_tau_w_g, grau_tau_w_f) + call get_grau_optics_sw(state, pbuf, grau_tau, grau_tau_w, grau_tau_w_g, sw_tau_w_f) do i = 1, ncol do k = 1, pver @@ -1289,14 +1299,10 @@ subroutine radiation_tend( & c_cld_tau_w_g(:,i,k) = ( cldfgrau(i,k)*grau_tau_w_g(:,i,k) & + cld(i,k)*c_cld_tau_w_g(:,i,k) )/cldfprime(i,k) - - c_cld_tau_w_f(:,i,k) = ( cldfgrau(i,k)*grau_tau_w_f(:,i,k) & - + cld(i,k)*c_cld_tau_w_f(:,i,k) )/cldfprime(i,k) else c_cld_tau(:,i,k) = 0._r8 c_cld_tau_w(:,i,k) = 0._r8 c_cld_tau_w_g(:,i,k) = 0._r8 - c_cld_tau_w_f(:,i,k) = 0._r8 end if end do end do @@ -1309,7 +1315,6 @@ subroutine radiation_tend( & c_cld_tau(:,:ncol,:) = c_cld_tau(rrtmg_to_rrtmgp_swbands,:ncol,:) c_cld_tau_w(:,:ncol,:) = c_cld_tau_w(rrtmg_to_rrtmgp_swbands,:ncol,:) c_cld_tau_w_g(:,:ncol,:) = c_cld_tau_w_g(rrtmg_to_rrtmgp_swbands,:ncol,:) - c_cld_tau_w_f(:,:ncol,:) = c_cld_tau_w_f(rrtmg_to_rrtmgp_swbands,:ncol,:) if (cldfsnow_idx > 0) then snow_tau(:,:ncol,:) = snow_tau(rrtmg_to_rrtmgp_swbands,:ncol,:) end if @@ -1317,13 +1322,10 @@ subroutine radiation_tend( & grau_tau(:,:ncol,:) = grau_tau(rrtmg_to_rrtmgp_swbands,:ncol,:) end if - ! cloud_sw : cloud optical properties. - call initialize_rrtmgp_cloud_optics_sw(nday, nlay, kdist_sw, cloud_sw) - + ! Set cloud optical properties in cloud_sw object. call rrtmgp_set_cloud_sw( & - nswbands, nday, nlay, idxday, pmid_day, & - cldfprime, c_cld_tau, c_cld_tau_w, c_cld_tau_w_g, c_cld_tau_w_f, & - kdist_sw, cloud_sw) + nday, nlay, idxday, pmid_day, cldfprime, & + c_cld_tau, c_cld_tau_w, c_cld_tau_w_g, kdist_sw, cloud_sw) ! SW cloud diagnostics & output @@ -2735,27 +2737,6 @@ end subroutine reset_fluxes !========================================================================================= -subroutine initialize_rrtmgp_cloud_optics_sw(ncol, nlevels, kdist, optics) - - integer, intent(in) :: ncol, nlevels - type(ty_gas_optics_rrtmgp), intent(in) :: kdist - type(ty_optical_props_2str), intent(out) :: optics - - character(len=128) :: errmsg - character(len=128) :: sub = 'initialize_rrtmgp_cloud_optics_sw' - - errmsg = optics%alloc_2str(ncol, nlevels, kdist) - if (len_trim(errmsg) > 0) then - call endrun(trim(sub)//': ERROR: optics%alloc_2str: '//trim(errmsg)) - end if - ! these are all expected to be shape (ncol, nlay, ngpt) - optics%tau = 0.0_r8 - optics%ssa = 1.0_r8 - optics%g = 0.0_r8 -end subroutine initialize_rrtmgp_cloud_optics_sw - -!========================================================================================= - subroutine initialize_rrtmgp_cloud_optics_lw(ncol, nlevels, kdist, optics) integer, intent(in) :: ncol, nlevels diff --git a/src/physics/rrtmgp/rrtmgp_inputs.F90 b/src/physics/rrtmgp/rrtmgp_inputs.F90 index f1dbb659e2..1fc3e30094 100644 --- a/src/physics/rrtmgp/rrtmgp_inputs.F90 +++ b/src/physics/rrtmgp/rrtmgp_inputs.F90 @@ -47,15 +47,6 @@ module rrtmgp_inputs real(r8), parameter :: cldmin = 1.0e-80_r8 ! min cloud fraction -real(r8), parameter :: amdw = 1.607793_r8 ! Molecular weight of dry air / water vapor -real(r8), parameter :: amdc = 0.658114_r8 ! Molecular weight of dry air / carbon dioxide -real(r8), parameter :: amdo = 0.603428_r8 ! Molecular weight of dry air / ozone -real(r8), parameter :: amdm = 1.805423_r8 ! Molecular weight of dry air / methane -real(r8), parameter :: amdn = 0.658090_r8 ! Molecular weight of dry air / nitrous oxide -real(r8), parameter :: amdo2 = 0.905140_r8 ! Molecular weight of dry air / oxygen -real(r8), parameter :: amdc1 = 0.210852_r8 ! Molecular weight of dry air / CFC11 -real(r8), parameter :: amdc2 = 0.239546_r8 ! Molecular weight of dry air / CFC12 - ! Indices for copying data between cam and rrtmgp arrays integer :: ktopcam ! Index in CAM arrays of top level (layer or interface) at which ! RRTMGP is active. @@ -247,30 +238,46 @@ end function is_visible !========================================================================================= function get_molar_mass_ratio(gas_name) result(massratio) + ! return the molar mass ratio of dry air to gas based on gas_name + character(len=*),intent(in) :: gas_name real(r8) :: massratio + ! local variables + real(r8), parameter :: amdw = 1.607793_r8 ! Molecular weight of dry air / water vapor + real(r8), parameter :: amdc = 0.658114_r8 ! Molecular weight of dry air / carbon dioxide + real(r8), parameter :: amdo = 0.603428_r8 ! Molecular weight of dry air / ozone + real(r8), parameter :: amdm = 1.805423_r8 ! Molecular weight of dry air / methane + real(r8), parameter :: amdn = 0.658090_r8 ! Molecular weight of dry air / nitrous oxide + real(r8), parameter :: amdo2 = 0.905140_r8 ! Molecular weight of dry air / oxygen + real(r8), parameter :: amdc1 = 0.210852_r8 ! Molecular weight of dry air / CFC11 + real(r8), parameter :: amdc2 = 0.239546_r8 ! Molecular weight of dry air / CFC12 + + character(len=*), parameter :: sub='get_molar_mass_ratio' + !---------------------------------------------------------------------------- + select case (trim(gas_name)) case ('H2O') - massratio = 1.607793_r8 + massratio = amdw case ('CO2') - massratio = 0.658114_r8 + massratio = amdc case ('O3') - massratio = 0.603428_r8 + massratio = amdo case ('CH4') - massratio = 1.805423_r8 + massratio = amdm case ('N2O') - massratio = 0.658090_r8 + massratio = amdn case ('O2') - massratio = 0.905140_r8 + massratio = amdo2 case ('CFC11') - massratio = 0.210852_r8 + massratio = amdc1 case ('CFC12') - massratio = 0.239546_r8 + massratio = amdc2 case default - call endrun("Invalid gas: "//trim(gas_name)) + call endrun(sub//": Invalid gas: "//trim(gas_name)) end select + end function get_molar_mass_ratio !========================================================================================= @@ -496,61 +503,40 @@ end subroutine rrtmgp_set_cloud_lw !================================================================================================== -subroutine rrtmgp_set_aer_lw(ncol, nlwbands, aer_lw_abs, aer_lw) - - ! Load aerosol optical properties into the RRTMGP object. - - ! arguments - integer, intent(in) :: ncol - integer, intent(in) :: nlwbands - real(r8), intent(in) :: aer_lw_abs(pcols,pver,nlwbands) ! aerosol absorption optics depth (LW) - type(ty_optical_props_1scl), intent(inout) :: aer_lw - character(len=32) :: sub = 'rrtmgp_set_aer_lw' - character(len=128) :: errmsg - - !-------------------------------------------------------------------------------- - ! If there is an extra layer in the radiation then this initialization - ! will provide zero optical depths there. - aer_lw%tau = 0.0_r8 - aer_lw%tau(:ncol, ktoprad:, :) = aer_lw_abs(:ncol, ktopcam:, :) - errmsg = aer_lw%validate() - if (len_trim(errmsg) > 0) then - call endrun(sub//': ERROR: aer_lw%validate: '//trim(errmsg)) - end if -end subroutine rrtmgp_set_aer_lw - -!================================================================================================== - subroutine rrtmgp_set_cloud_sw( & - nswbands, nday, nlay, idxday, pmid, cldfrac, & - c_cld_tau, c_cld_tau_w, c_cld_tau_w_g, c_cld_tau_w_f, kdist_sw, & - cloud_sw) + nday, nlay, idxday, pmid, cldfrac, & + c_cld_tau, c_cld_tau_w, c_cld_tau_w_g, kdist_sw, cloud_sw) ! Create MCICA stochastic arrays for cloud SW optical properties. + ! Initialize optical properties object (cloud_sw) and load with MCICA columns. + ! + ! The input optical properties are on the CAM grid and are represented as products + ! of the extinction optical depth (tau), single scattering albedo (w) and assymetry + ! parameter (g). This routine subsets the input to just the layers and the + ! daylight columns used in the radiation calculation. It also computes the + ! individual properties of tau, w, and g for input to the MCICA routine. ! arguments - integer, intent(in) :: nswbands - integer, intent(in) :: nday - integer, intent(in) :: nlay ! number of layers in rad calc (may include "extra layer") - integer, intent(in) :: idxday(:) + integer, intent(in) :: nday ! number of daylight columns + integer, intent(in) :: nlay ! number of layers in radiation calculation (may include "extra layer") + integer, intent(in) :: idxday(:) ! indices of daylight columns in the chunk + real(r8), intent(in) :: pmid(nday,nlay)! pressure at layer midpoints (Pa) used to seed RNG. - real(r8), intent(in) :: pmid(nday,nlay) ! pressure at layer midpoints (Pa) - real(r8), intent(in) :: cldfrac(pcols,pver) ! combined cloud fraction (snow plus regular) - real(r8), intent(in) :: c_cld_tau (nswbands,pcols,pver) ! combined cloud extinction optical depth - real(r8), intent(in) :: c_cld_tau_w (nswbands,pcols,pver) ! combined cloud single scattering albedo * tau - real(r8), intent(in) :: c_cld_tau_w_g(nswbands,pcols,pver) ! combined cloud assymetry parameter * w * tau - real(r8), intent(in) :: c_cld_tau_w_f(nswbands,pcols,pver) ! combined cloud forward scattered fraction * w * tau + ! cloud fraction and optics are input on the CAM grid + real(r8), intent(in) :: cldfrac(pcols,pver) ! combined cloud fraction + real(r8), intent(in) :: c_cld_tau (nswbands,pcols,pver) ! combined cloud extinction optical depth + real(r8), intent(in) :: c_cld_tau_w (nswbands,pcols,pver) ! combined cloud single scattering albedo * tau + real(r8), intent(in) :: c_cld_tau_w_g(nswbands,pcols,pver) ! combined cloud assymetry parameter * w * tau - class(ty_gas_optics_rrtmgp), intent(in) :: kdist_sw ! shortwave gas optics object - type(ty_optical_props_2str), intent(inout) :: cloud_sw ! cloud optical properties object + class(ty_gas_optics_rrtmgp), intent(in) :: kdist_sw ! shortwave gas optics object + type(ty_optical_props_2str), intent(out) :: cloud_sw ! cloud optical properties object ! local vars integer, parameter :: changeseed = 1 integer :: i, k, kk, ns, igpt integer :: ngptsw - integer :: nver ! nver is the number of cam layers in the SW calc. It - ! does not include the "extra layer". + integer :: nver real(r8), allocatable :: cldf(:,:) real(r8), allocatable :: tauc(:,:,:) @@ -560,20 +546,21 @@ subroutine rrtmgp_set_cloud_sw( & real(r8), allocatable :: ssacmcl(:,:,:) real(r8), allocatable :: asmcmcl(:,:,:) - character(len=*), parameter :: sub = 'rrtmgp_set_cloud_sw' - character(len=128) :: errmsg real(r8) :: small_val = 1.e-80_r8 real(r8), allocatable :: day_cld_tau(:,:,:) real(r8), allocatable :: day_cld_tau_w(:,:,:) real(r8), allocatable :: day_cld_tau_w_g(:,:,:) + + character(len=128) :: errmsg + character(len=*), parameter :: sub = 'rrtmgp_set_cloud_sw' !-------------------------------------------------------------------------------- + + ! number of g-points. This is the number of subcolumns constructed by MCICA. ngptsw = kdist_sw%get_ngpt() - nver = pver - ktopcam + 1 ! number of CAM's layers in radiation calculation. - ! Compute the input quantities needed for the 2-stream optical props - ! object. Also subset the vertical levels and the daylight columns - ! here. But don't reorder the vertical index because the mcica sub-column - ! generator assumes the CAM vertical indexing. + ! number of CAM's layers in radiation calculation. Does not include the "extra layer". + nver = pver - ktopcam + 1 + allocate( & cldf(nday,nver), & tauc(nswbands,nday,nver), & @@ -586,53 +573,63 @@ subroutine rrtmgp_set_cloud_sw( & day_cld_tau_w(nswbands,nday,nver), & day_cld_tau_w_g(nswbands,nday,nver)) - ! get daylit arrays on radiation levels, note: expect idxday to be truncated to size nday + ! Subset the input data so just the daylight columns, and the number of CAM layers in the + ! radiation calculation are used by MCICA to produce subcolumns. + cldf = cldfrac( idxday(1:nday), ktopcam:) day_cld_tau = c_cld_tau( :, idxday(1:nday), ktopcam:) day_cld_tau_w = c_cld_tau_w( :, idxday(1:nday), ktopcam:) day_cld_tau_w_g = c_cld_tau_w_g(:, idxday(1:nday), ktopcam:) - cldf = cldfrac(idxday(1:nday), ktopcam:) ! daylit cloud fraction on radiation levels - tauc = merge(day_cld_tau, 0.0_r8, day_cld_tau > 0.0_r8) ! start by setting cloud optical depth, clip @ zero - asmc = merge(day_cld_tau_w_g / max(day_cld_tau_w, small_val), 0.0_r8, day_cld_tau_w > 0.0_r8) ! set value of asymmetry - ssac = merge(max(day_cld_tau_w, small_val) / max(tauc, small_val), 1.0_r8 , tauc > 0.0_r8) - asmc = merge(asmc, 0.0_r8, tauc > 0.0_r8) ! double-check asymmetry; reset when tauc = 0 + ! Compute the optical properties needed for the 2-stream calculations. These calculations + ! are the same as the RRTMG version. - ! mcica_subcol_sw converts to gpts (e.g., 224 pts instead of 14 bands) - ! inputs (pmid, cldf, tauc, ssac, asmc) and outputs (taucmcl, ssacmcl, asmcmcl) - ! are on the same nver vertical levels - ! output is shape (ngpt, ncol, nver) + ! set cloud optical depth, clip @ zero + tauc = merge(day_cld_tau, 0.0_r8, day_cld_tau > 0.0_r8) + ! set value of asymmetry + asmc = merge(day_cld_tau_w_g / max(day_cld_tau_w, small_val), 0.0_r8, day_cld_tau_w > 0.0_r8) + ! set value of single scattering albedo + ssac = merge(max(day_cld_tau_w, small_val) / max(tauc, small_val), 1.0_r8 , tauc > 0.0_r8) + ! set asymmetry to zero when tauc = 0 + asmc = merge(asmc, 0.0_r8, tauc > 0.0_r8) + + ! MCICA converts from bands to gpts (e.g., 224 g-points instead of 14 bands) call mcica_subcol_sw( & - kdist_sw, nswbands, ngptsw, nday, nlay, nver, changeseed, & - pmid, cldf, tauc, ssac, asmc, & - taucmcl, ssacmcl, asmcmcl) ! 32 + kdist_sw, nswbands, ngptsw, nday, nlay, & + nver, changeseed, pmid, cldf, tauc, & + ssac, asmc, taucmcl, ssacmcl, asmcmcl) + ! Initialize object for SW cloud optical properties. + errmsg = cloud_sw%alloc_2str(nday, nlay, kdist_sw) + if (len_trim(errmsg) > 0) then + call endrun(trim(sub)//': ERROR: cloud_sw%alloc_2str: '//trim(errmsg)) + end if ! If there is an extra layer in the radiation then this initialization ! will provide the optical properties there. - ! These are shape (ncol, nlay, ngpt) - cloud_sw%tau(:,:,:) = 0.0_r8 - cloud_sw%ssa(:,:,:) = 1.0_r8 - cloud_sw%g(:,:,:) = 0.0_r8 + cloud_sw%tau = 0.0_r8 + cloud_sw%ssa = 1.0_r8 + cloud_sw%g = 0.0_r8 + + ! Set the properties on g-points. do igpt = 1,ngptsw cloud_sw%g (:, ktoprad:, igpt) = asmcmcl(igpt, ktopcam:, :) cloud_sw%ssa(:, ktoprad:, igpt) = ssacmcl(igpt, ktopcam:, :) cloud_sw%tau(:, ktoprad:, igpt) = taucmcl(igpt, ktopcam:, :) end do - + ! validate checks the tau > 0, ssa is in range [0,1], and g is in range [-1,1]. errmsg = cloud_sw%validate() if (len_trim(errmsg) > 0) then call endrun(sub//': ERROR: cloud_sw%validate: '//trim(errmsg)) end if ! delta scaling adjusts for forward scattering - ! If delta_scale() is applied, cloud_sw%tau differs from RRTMG implementation going into SW calculation. errmsg = cloud_sw%delta_scale() if (len_trim(errmsg) > 0) then call endrun(sub//': ERROR: cloud_sw%delta_scale: '//trim(errmsg)) end if - ! all information is in cloud_sw, now deallocate + ! All information is in cloud_sw, now deallocate local vars. deallocate( & cldf, tauc, ssac, asmc, & taucmcl, ssacmcl, asmcmcl,& @@ -642,6 +639,31 @@ end subroutine rrtmgp_set_cloud_sw !================================================================================================== +subroutine rrtmgp_set_aer_lw(ncol, nlwbands, aer_lw_abs, aer_lw) + + ! Load aerosol optical properties into the RRTMGP object. + + ! arguments + integer, intent(in) :: ncol + integer, intent(in) :: nlwbands + real(r8), intent(in) :: aer_lw_abs(pcols,pver,nlwbands) ! aerosol absorption optics depth (LW) + type(ty_optical_props_1scl), intent(inout) :: aer_lw + character(len=32) :: sub = 'rrtmgp_set_aer_lw' + character(len=128) :: errmsg + + !-------------------------------------------------------------------------------- + ! If there is an extra layer in the radiation then this initialization + ! will provide zero optical depths there. + aer_lw%tau = 0.0_r8 + aer_lw%tau(:ncol, ktoprad:, :) = aer_lw_abs(:ncol, ktopcam:, :) + errmsg = aer_lw%validate() + if (len_trim(errmsg) > 0) then + call endrun(sub//': ERROR: aer_lw%validate: '//trim(errmsg)) + end if +end subroutine rrtmgp_set_aer_lw + +!================================================================================================== + subroutine rrtmgp_set_aer_sw( & nday, idxday, aer_tau, aer_tau_w, & aer_tau_w_g, aer_tau_w_f, aer_sw) From 4d069dc67f086f08da08482502c75481432212ca Mon Sep 17 00:00:00 2001 From: Brian Eaton Date: Fri, 22 Sep 2023 10:46:44 -0400 Subject: [PATCH 154/291] remove old cloud optics; refactor setting cloud_sw & aer_sw objects --- src/physics/rrtmgp/radiation.F90 | 260 +++------------------ src/physics/rrtmgp/rrtmgp_inputs.F90 | 331 ++++++++++++++++++++------- 2 files changed, 280 insertions(+), 311 deletions(-) diff --git a/src/physics/rrtmgp/radiation.F90 b/src/physics/rrtmgp/radiation.F90 index 40b8ca444b..bd8ec09e05 100644 --- a/src/physics/rrtmgp/radiation.F90 +++ b/src/physics/rrtmgp/radiation.F90 @@ -22,13 +22,13 @@ module radiation get_curr_calday, get_step_size use rad_constituents, only: N_DIAG, rad_cnst_get_call_list, & - rad_cnst_get_gas, rad_cnst_out, oldcldoptics, & - liqcldoptics, icecldoptics + rad_cnst_get_gas, rad_cnst_out + use rrtmgp_inputs, only: rrtmgp_inputs_init -use radconstants, only: nswbands, nlwbands, nswgpts, nlwgpts, idx_sw_diag, & - idx_nir_diag, idx_uv_diag, idx_lw_diag, idx_sw_cloudsim, & +use radconstants, only: nswbands, nlwbands, nswgpts, & + idx_nir_diag, idx_uv_diag, idx_lw_diag, & idx_lw_cloudsim, nradgas, gasnamelength, gaslist, & set_wavenumber_bands @@ -40,7 +40,7 @@ module radiation use scamMod, only: scm_crm_mode, single_column, have_cld, cldobs use cam_history, only: addfld, add_default, horiz_only, outfld, hist_fld_active -use cam_history_support, only: fillvalue, add_vert_coord +use cam_history_support, only: add_vert_coord use radiation_data, only: rad_data_register, rad_data_init @@ -237,7 +237,6 @@ module radiation contains !========================================================================================= - subroutine radiation_readnl(nlfile) ! Read radiation_nl namelist group. @@ -880,18 +879,13 @@ subroutine radiation_tend( & rrtmgp_set_aer_lw, rrtmgp_set_gases_sw, rrtmgp_set_cloud_sw, & rrtmgp_set_aer_sw - use aer_rad_props, only: aer_rad_props_sw, aer_rad_props_lw + use aer_rad_props, only: aer_rad_props_lw - use cloud_rad_props, only: get_ice_optics_sw, ice_cloud_get_rad_props_lw, & - get_liquid_optics_sw, liquid_cloud_get_rad_props_lw, & - get_snow_optics_sw, snow_cloud_get_rad_props_lw, & - get_grau_optics_sw, grau_cloud_get_rad_props_lw, & - cloud_rad_props_get_lw + use cloud_rad_props, only: ice_cloud_get_rad_props_lw, & + liquid_cloud_get_rad_props_lw, & + snow_cloud_get_rad_props_lw, & + grau_cloud_get_rad_props_lw - - use slingo, only: slingo_liq_get_rad_props_lw, slingo_liq_optics_sw - use ebert_curry, only: ec_ice_optics_sw, ec_ice_get_rad_props_lw - ! RRTMGP drivers for flux calculations. use rrtmgp_driver, only: rte_lw use mo_rte_sw, only: rte_sw @@ -924,6 +918,7 @@ subroutine radiation_tend( & integer :: i, k integer :: lchnk, ncol logical :: dosw, dolw + integer :: icall ! loop index for climate/diagnostic radiation calls real(r8) :: calday ! current calendar day real(r8) :: delta ! Solar declination angle in radians @@ -944,6 +939,7 @@ subroutine radiation_tend( & real(r8), pointer :: cld(:,:) ! cloud fraction real(r8), pointer :: cldfsnow(:,:) => null() ! cloud fraction of just "snow clouds" real(r8), pointer :: cldfgrau(:,:) => null() ! cloud fraction of just "graupel clouds" + real(r8) :: cldfprime(pcols,pver) ! combined cloud fraction real(r8), pointer :: qrs(:,:) => null() ! shortwave radiative heating rate real(r8), pointer :: qrl(:,:) => null() ! longwave radiative heating rate real(r8), pointer :: fsds(:) ! Surface solar down flux @@ -974,54 +970,19 @@ subroutine radiation_tend( & real(r8), allocatable :: alb_dir(:,:) real(r8), allocatable :: alb_dif(:,:) - ! Forward scattered fraction * tau * w. RRTMGP does not use this property - ! in its 2-stream calculations. No need for separate storage for different cloud types. - real(r8) :: sw_tau_w_f(nswbands,pcols,pver) + real(r8) :: cld_tau_cloudsim(pcols,pver) ! in-cloud liq+ice optical depth (for COSP) + real(r8) :: snow_tau_cloudsim(pcols,pver)! in-cloud snow optical depth (for COSP) + real(r8) :: grau_tau_cloudsim(pcols,pver)! in-cloud Graupel optical depth (for COSP) - ! cloud radiative parameters are "in cloud" not "in cell" - real(r8) :: ice_tau (nswbands,pcols,pver) ! ice extinction optical depth - real(r8) :: ice_tau_w (nswbands,pcols,pver) ! ice single scattering albedo * tau - real(r8) :: ice_tau_w_g(nswbands,pcols,pver) ! ice assymetry parameter * tau * w real(r8) :: ice_lw_abs (nlwbands,pcols,pver) ! ice absorption optics depth (LW) - - ! cloud radiative parameters are "in cloud" not "in cell" - real(r8) :: liq_tau (nswbands,pcols,pver) ! liquid extinction optical depth - real(r8) :: liq_tau_w (nswbands,pcols,pver) ! liquid single scattering albedo * tau - real(r8) :: liq_tau_w_g(nswbands,pcols,pver) ! liquid assymetry parameter * tau * w real(r8) :: liq_lw_abs (nlwbands,pcols,pver) ! liquid absorption optics depth (LW) - - ! cloud radiative parameters are "in cloud" not "in cell" - real(r8) :: cld_tau (nswbands,pcols,pver) ! cloud extinction optical depth - real(r8) :: cld_tau_w (nswbands,pcols,pver) ! cloud single scattering albedo * tau - real(r8) :: cld_tau_w_g(nswbands,pcols,pver) ! cloud assymetry parameter * w * tau real(r8) :: cld_lw_abs (nlwbands,pcols,pver) ! cloud absorption optics depth (LW) - - ! "snow" cloud radiative parameters are "in cloud" not "in cell" - real(r8) :: snow_tau (nswbands,pcols,pver) ! snow extinction optical depth - real(r8) :: snow_tau_w (nswbands,pcols,pver) ! snow single scattering albedo * tau - real(r8) :: snow_tau_w_g(nswbands,pcols,pver) ! snow assymetry parameter * tau * w real(r8) :: snow_lw_abs (nlwbands,pcols,pver)! snow absorption optics depth (LW) - - ! Add graupel as another snow species. - ! cloud radiative parameters are "in cloud" not "in cell" - real(r8) :: grau_tau (nswbands,pcols,pver) ! graupel extinction optical depth - real(r8) :: grau_tau_w (nswbands,pcols,pver) ! graupel single scattering albedo * tau - real(r8) :: grau_tau_w_g(nswbands,pcols,pver) ! graupel assymetry parameter * tau * w real(r8) :: grau_lw_abs (nlwbands,pcols,pver)! graupel absorption optics depth (LW) - - ! combined cloud radiative parameters are "in cloud" not "in cell" - real(r8) :: cldfprime(pcols,pver) ! combined cloud fraction (snow plus regular) - real(r8) :: c_cld_tau (nswbands,pcols,pver) ! combined cloud extinction optical depth - real(r8) :: c_cld_tau_w (nswbands,pcols,pver) ! combined cloud single scattering albedo * tau - real(r8) :: c_cld_tau_w_g(nswbands,pcols,pver) ! combined cloud assymetry parameter * w * tau real(r8) :: c_cld_lw_abs (nlwbands,pcols,pver) ! combined cloud absorption optics depth (LW) ! Aerosol radiative properties **N.B.** These are zero-indexed to accomodate an "extra layer". ! If no extra layer then the 0 index is ignored. - real(r8) :: aer_tau (pcols,0:pver,nswbands) ! aerosol extinction optical depth - real(r8) :: aer_tau_w (pcols,0:pver,nswbands) ! aerosol single scattering albedo * tau - real(r8) :: aer_tau_w_g(pcols,0:pver,nswbands) ! aerosol assymetry parameter * w * tau - real(r8) :: aer_tau_w_f(pcols,0:pver,nswbands) ! aerosol forward scattered fraction * w * tau real(r8) :: aer_lw_abs (pcols,pver,nlwbands) ! aerosol absorption optics depth (LW) ! Set vertical indexing in RRTMGP to be the same as CAM (top to bottom). @@ -1031,8 +992,6 @@ subroutine radiation_tend( & type(ty_optical_props_1scl) :: cloud_lw type(ty_optical_props_2str) :: cloud_sw - integer :: icall ! index through climate/diagnostic radiation calls - ! gas vmr. Separate objects because SW only does calculations for daylight columns. type(ty_gas_concs) :: gas_concs_lw type(ty_gas_concs) :: gas_concs_sw @@ -1228,134 +1187,14 @@ subroutine radiation_tend( & if (dosw) then - if (oldcldoptics) then - call ec_ice_optics_sw(state, pbuf, ice_tau, ice_tau_w, ice_tau_w_g, sw_tau_w_f, oldicewp=.false.) - call slingo_liq_optics_sw(state, pbuf, liq_tau, liq_tau_w, liq_tau_w_g, sw_tau_w_f, oldliqwp=.false.) - else - select case (icecldoptics) - case ('ebertcurry') - call ec_ice_optics_sw(state, pbuf, ice_tau, ice_tau_w, ice_tau_w_g, sw_tau_w_f, oldicewp=.true.) - case ('mitchell') - call get_ice_optics_sw(state, pbuf, ice_tau, ice_tau_w, ice_tau_w_g, sw_tau_w_f) - case default - call endrun('icecldoptics must be one either ebertcurry or mitchell') - end select - - select case (liqcldoptics) - case ('slingo') - call slingo_liq_optics_sw(state, pbuf, liq_tau, liq_tau_w, liq_tau_w_g, sw_tau_w_f, oldliqwp=.true.) - case ('gammadist') - call get_liquid_optics_sw(state, pbuf, liq_tau, liq_tau_w, liq_tau_w_g, sw_tau_w_f) - case default - call endrun('liqcldoptics must be either slingo or gammadist') - end select - end if - - cld_tau(:,:ncol,:) = liq_tau(:,:ncol,:) + ice_tau(:,:ncol,:) - cld_tau_w(:,:ncol,:) = liq_tau_w(:,:ncol,:) + ice_tau_w(:,:ncol,:) - cld_tau_w_g(:,:ncol,:) = liq_tau_w_g(:,:ncol,:) + ice_tau_w_g(:,:ncol,:) - - if (cldfsnow_idx > 0) then - ! add in snow - call get_snow_optics_sw(state, pbuf, snow_tau, snow_tau_w, snow_tau_w_g, sw_tau_w_f) - do i = 1, ncol - do k = 1, pver - if (cldfprime(i,k) > 0.) then - c_cld_tau(:,i,k) = ( cldfsnow(i,k)*snow_tau(:,i,k) & - + cld(i,k)*cld_tau(:,i,k) )/cldfprime(i,k) - - c_cld_tau_w(:,i,k) = ( cldfsnow(i,k)*snow_tau_w(:,i,k) & - + cld(i,k)*cld_tau_w(:,i,k) )/cldfprime(i,k) - - c_cld_tau_w_g(:,i,k) = ( cldfsnow(i,k)*snow_tau_w_g(:,i,k) & - + cld(i,k)*cld_tau_w_g(:,i,k) )/cldfprime(i,k) - - else - c_cld_tau(:,i,k) = 0._r8 - c_cld_tau_w(:,i,k) = 0._r8 - c_cld_tau_w_g(:,i,k) = 0._r8 - end if - end do - end do - else - c_cld_tau(:,:ncol,:) = cld_tau(:,:ncol,:) - c_cld_tau_w(:,:ncol,:) = cld_tau_w(:,:ncol,:) - c_cld_tau_w_g(:,:ncol,:) = cld_tau_w_g(:,:ncol,:) - end if - - if (cldfgrau_idx > 0 .and. graupel_in_rad) then - ! add in graupel - call get_grau_optics_sw(state, pbuf, grau_tau, grau_tau_w, grau_tau_w_g, sw_tau_w_f) - do i = 1, ncol - do k = 1, pver - - if (cldfprime(i,k) > 0._r8) then - - c_cld_tau(:,i,k) = ( cldfgrau(i,k)*grau_tau(:,i,k) & - + cld(i,k)*c_cld_tau(:,i,k) )/cldfprime(i,k) - - c_cld_tau_w(:,i,k) = ( cldfgrau(i,k)*grau_tau_w(:,i,k) & - + cld(i,k)*c_cld_tau_w(:,i,k) )/cldfprime(i,k) - - c_cld_tau_w_g(:,i,k) = ( cldfgrau(i,k)*grau_tau_w_g(:,i,k) & - + cld(i,k)*c_cld_tau_w_g(:,i,k) )/cldfprime(i,k) - else - c_cld_tau(:,i,k) = 0._r8 - c_cld_tau_w(:,i,k) = 0._r8 - c_cld_tau_w_g(:,i,k) = 0._r8 - end if - end do - end do - end if - - ! cloud optical properties need to be re-ordered from the RRTMG spectral bands - ! (assumed in the optics datasets) to RRTMGP's - ice_tau(:,:ncol,:) = ice_tau(rrtmg_to_rrtmgp_swbands,:ncol,:) - liq_tau(:,:ncol,:) = liq_tau(rrtmg_to_rrtmgp_swbands,:ncol,:) - c_cld_tau(:,:ncol,:) = c_cld_tau(rrtmg_to_rrtmgp_swbands,:ncol,:) - c_cld_tau_w(:,:ncol,:) = c_cld_tau_w(rrtmg_to_rrtmgp_swbands,:ncol,:) - c_cld_tau_w_g(:,:ncol,:) = c_cld_tau_w_g(rrtmg_to_rrtmgp_swbands,:ncol,:) - if (cldfsnow_idx > 0) then - snow_tau(:,:ncol,:) = snow_tau(rrtmg_to_rrtmgp_swbands,:ncol,:) - end if - if (cldfgrau_idx > 0 .and. graupel_in_rad) then - grau_tau(:,:ncol,:) = grau_tau(rrtmg_to_rrtmgp_swbands,:ncol,:) - end if - ! Set cloud optical properties in cloud_sw object. call rrtmgp_set_cloud_sw( & - nday, nlay, idxday, pmid_day, cldfprime, & - c_cld_tau, c_cld_tau_w, c_cld_tau_w_g, kdist_sw, cloud_sw) - - ! SW cloud diagnostics & output - - ! cloud optical depth fields for the visible band - rd%tot_icld_vistau(:ncol,:) = c_cld_tau(idx_sw_diag,:ncol,:) - rd%liq_icld_vistau(:ncol,:) = liq_tau(idx_sw_diag,:ncol,:) - rd%ice_icld_vistau(:ncol,:) = ice_tau(idx_sw_diag,:ncol,:) - if (cldfsnow_idx > 0) then - rd%snow_icld_vistau(:ncol,:) = snow_tau(idx_sw_diag,:ncol,:) - endif - if (cldfgrau_idx > 0 .and. graupel_in_rad) then - rd%grau_icld_vistau(:ncol,:) = grau_tau(idx_sw_diag,:ncol,:) - endif - - ! multiply by total cloud fraction to get gridbox value - rd%tot_cld_vistau(:ncol,:) = c_cld_tau(idx_sw_diag,:ncol,:)*cldfprime(:ncol,:) - - ! add fillvalue for night columns - do i = 1, Nnite - rd%tot_cld_vistau(IdxNite(i),:) = fillvalue - rd%tot_icld_vistau(IdxNite(i),:) = fillvalue - rd%liq_icld_vistau(IdxNite(i),:) = fillvalue - rd%ice_icld_vistau(IdxNite(i),:) = fillvalue - if (cldfsnow_idx > 0) then - rd%snow_icld_vistau(IdxNite(i),:) = fillvalue - end if - if (cldfgrau_idx > 0 .and. graupel_in_rad) then - rd%grau_icld_vistau(IdxNite(i),:) = fillvalue - end if - end do + state, pbuf, nlay, nday, idxday, & + nnite, idxnite, pmid_day, cld, cldfsnow, & + cldfgrau, cldfprime, graupel_in_rad, kdist_sw, cloud_sw, & + rd%tot_cld_vistau, rd%tot_icld_vistau, rd%liq_icld_vistau, & + rd%ice_icld_vistau, rd%snow_icld_vistau, rd%grau_icld_vistau, & + cld_tau_cloudsim, snow_tau_cloudsim, grau_tau_cloudsim ) if (write_output) then call radiation_output_cld(lchnk, ncol, rd) @@ -1374,7 +1213,6 @@ subroutine radiation_tend( & end if ! Init and allocate arrays in aerosol optics object. - errmsg = aer_sw%alloc_2str(nday, nlay, kdist_sw%get_band_lims_wavenumber()) if (len_trim(errmsg) > 0) then call endrun(sub//': ERROR: aer_sw%alloc_2str: '//trim(errmsg)) @@ -1402,23 +1240,9 @@ subroutine radiation_tend( & tsi_ref = sum(toa_flux(1,:)) toa_flux = toa_flux * sol_tsi * eccf / tsi_ref - ! Get aerosol shortwave optical properties on CAM grid. - call aer_rad_props_sw( & - icall, state, pbuf, nnite, idxnite, & - aer_tau, aer_tau_w, aer_tau_w_g, aer_tau_w_f) - - ! aerosol optical properties need to be re-ordered from the RRTMG spectral bands, - ! as assumed in the optics datasets, to the RRTMGP band order. - aer_tau(:,:,:) = aer_tau(:,:,rrtmg_to_rrtmgp_swbands) - aer_tau_w(:,:,:) = aer_tau_w(:,:,rrtmg_to_rrtmgp_swbands) - aer_tau_w_g(:,:,:) = aer_tau_w_g(:,:,rrtmg_to_rrtmgp_swbands) - aer_tau_w_f(:,:,:) = aer_tau_w_f(:,:,rrtmg_to_rrtmgp_swbands) - - ! Convert from the products to individual properties, - ! and only provide them on the daylit points. + ! Set SW aerosol optical properties in the aer_sw object. call rrtmgp_set_aer_sw( & - nday, idxday, aer_tau, aer_tau_w, aer_tau_w_g, & - aer_tau_w_f, aer_sw) + icall, state, pbuf, nday, idxday, nnite, idxnite, aer_sw) ! Increment the gas optics (in atm_optics_sw) by the aerosol optics in aer_sw. errmsg = aer_sw%increment(atm_optics_sw) @@ -1470,30 +1294,12 @@ subroutine radiation_tend( & if (dolw) then - if (oldcldoptics) then - call cloud_rad_props_get_lw(state, pbuf, cld_lw_abs, oldcloud=.true.) - else - select case (icecldoptics) - case ('ebertcurry') - call ec_ice_get_rad_props_lw(state, pbuf, ice_lw_abs, oldicewp=.true.) - case ('mitchell') - call ice_cloud_get_rad_props_lw(state, pbuf, ice_lw_abs) - case default - call endrun('ERROR: icecldoptics must be one either ebertcurry or mitchell') - end select - - select case (liqcldoptics) - case ('slingo') - call slingo_liq_get_rad_props_lw(state, pbuf, liq_lw_abs, oldliqwp=.true.) - case ('gammadist') - call liquid_cloud_get_rad_props_lw(state, pbuf, liq_lw_abs) - case default - call endrun('ERROR: liqcldoptics must be either slingo or gammadist') - end select - - cld_lw_abs(:,:ncol,:) = liq_lw_abs(:,:ncol,:) + ice_lw_abs(:,:ncol,:) + call ice_cloud_get_rad_props_lw(state, pbuf, ice_lw_abs) + + call liquid_cloud_get_rad_props_lw(state, pbuf, liq_lw_abs) + + cld_lw_abs(:,:ncol,:) = liq_lw_abs(:,:ncol,:) + ice_lw_abs(:,:ncol,:) - end if if (cldfsnow_idx > 0) then ! add in snow @@ -1632,12 +1438,12 @@ subroutine radiation_tend( & ! Add graupel to snow tau for cosp if (cldfgrau_idx > 0 .and. graupel_in_rad) then - gb_snow_tau(i,k) = snow_tau(idx_sw_cloudsim,i,k)*cldfsnow(i,k) + & - grau_tau(idx_sw_cloudsim,i,k)*cldfgrau(i,k) + gb_snow_tau(i,k) = snow_tau_cloudsim(i,k)*cldfsnow(i,k) + & + grau_tau_cloudsim(i,k)*cldfgrau(i,k) gb_snow_lw(i,k) = snow_lw_abs(idx_lw_cloudsim,i,k)*cldfsnow(i,k) + & - grau_lw_abs(idx_lw_cloudsim,i,k)*cldfgrau(i,k) + grau_lw_abs(idx_lw_cloudsim,i,k)*cldfgrau(i,k) else - gb_snow_tau(i,k) = snow_tau(idx_sw_cloudsim,i,k)*cldfsnow(i,k) + gb_snow_tau(i,k) = snow_tau_cloudsim(i,k)*cldfsnow(i,k) gb_snow_lw(i,k) = snow_lw_abs(idx_lw_cloudsim,i,k)*cldfsnow(i,k) end if end if @@ -1654,7 +1460,7 @@ subroutine radiation_tend( & ! N.B.: For snow optical properties, the GRID-BOX MEAN shortwave and longwave ! optical depths are passed. call cospsimulator_intr_run(state, pbuf, cam_in, emis, coszrs, & - cld_swtau_in=cld_tau(idx_sw_cloudsim,:,:),& + cld_swtau_in=cld_tau_cloudsim,& snow_tau_in=gb_snow_tau, snow_emis_in=gb_snow_lw) cosp_cnt(lchnk) = 0 end if diff --git a/src/physics/rrtmgp/rrtmgp_inputs.F90 b/src/physics/rrtmgp/rrtmgp_inputs.F90 index 1fc3e30094..f076f4c1e0 100644 --- a/src/physics/rrtmgp/rrtmgp_inputs.F90 +++ b/src/physics/rrtmgp/rrtmgp_inputs.F90 @@ -17,17 +17,26 @@ module rrtmgp_inputs use physics_buffer, only: physics_buffer_desc use camsrfexch, only: cam_in_t -use radconstants, only: nswbands, nlwbands, get_sw_spectral_boundaries +use radconstants, only: nswbands, nlwbands, nswgpts, get_sw_spectral_boundaries, & + idx_sw_diag, idx_sw_cloudsim use radconstants, only: nradgas, gaslist use rad_constituents, only: rad_cnst_get_gas +use cloud_rad_props, only: get_liquid_optics_sw, liquid_cloud_get_rad_props_lw, & + get_ice_optics_sw, ice_cloud_get_rad_props_lw, & + get_snow_optics_sw, snow_cloud_get_rad_props_lw, & + get_grau_optics_sw, grau_cloud_get_rad_props_lw + use mcica_subcol_gen, only: mcica_subcol_sw, mcica_subcol_lw +use aer_rad_props, only: aer_rad_props_sw, aer_rad_props_lw + use mo_gas_concentrations, only: ty_gas_concs use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp use mo_optical_props, only: ty_optical_props_2str, ty_optical_props_1scl +use cam_history_support, only: fillvalue use cam_logfile, only: iulog use cam_abortutils, only: endrun @@ -45,7 +54,10 @@ module rrtmgp_inputs rrtmgp_set_aer_lw, & rrtmgp_set_aer_sw -real(r8), parameter :: cldmin = 1.0e-80_r8 ! min cloud fraction + +! This value is to match the arbitrary small value used in RRTMG to decide +! when a quantity is effectively zero. +real(r8), parameter :: tiny = 1.0e-80_r8 ! Indices for copying data between cam and rrtmgp arrays integer :: ktopcam ! Index in CAM arrays of top level (layer or interface) at which @@ -56,6 +68,12 @@ module rrtmgp_inputs ! wavenumber (cm^-1) boundaries of shortwave bands real(r8) :: sw_low_bounds(nswbands), sw_high_bounds(nswbands) +! Mapping from RRTMG shortwave bands to RRTMGP. Currently needed to continue using +! the SW optics datasets from RRTMG (even thought there is a slight mismatch in the +! band boundaries of the 2 bands that overlap with the LW bands). +integer, parameter, dimension(14) :: rrtmg_to_rrtmgp_swbands = & + [ 14, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13 ] + !================================================================================================== contains !================================================================================================== @@ -504,40 +522,77 @@ end subroutine rrtmgp_set_cloud_lw !================================================================================================== subroutine rrtmgp_set_cloud_sw( & - nday, nlay, idxday, pmid, cldfrac, & - c_cld_tau, c_cld_tau_w, c_cld_tau_w_g, kdist_sw, cloud_sw) + state, pbuf, nlay, nday, idxday, & + nnite, idxnite, pmid, cld, cldfsnow, & + cldfgrau, cldfprime, graupel_in_rad, kdist_sw, cloud_sw, & + tot_cld_vistau, tot_icld_vistau, liq_icld_vistau, ice_icld_vistau, snow_icld_vistau, & + grau_icld_vistau, cld_tau_cloudsim, snow_tau_cloudsim, grau_tau_cloudsim) + ! Compute combined cloud optical properties. ! Create MCICA stochastic arrays for cloud SW optical properties. ! Initialize optical properties object (cloud_sw) and load with MCICA columns. - ! - ! The input optical properties are on the CAM grid and are represented as products - ! of the extinction optical depth (tau), single scattering albedo (w) and assymetry - ! parameter (g). This routine subsets the input to just the layers and the - ! daylight columns used in the radiation calculation. It also computes the - ! individual properties of tau, w, and g for input to the MCICA routine. ! arguments - integer, intent(in) :: nday ! number of daylight columns + type(physics_state), target, intent(in) :: state + type(physics_buffer_desc), pointer :: pbuf(:) integer, intent(in) :: nlay ! number of layers in radiation calculation (may include "extra layer") - integer, intent(in) :: idxday(:) ! indices of daylight columns in the chunk + integer, intent(in) :: nday ! number of daylight columns + integer, intent(in) :: idxday(pcols) ! indices of daylight columns in the chunk + integer, intent(in) :: nnite ! number of night columns + integer, intent(in) :: idxnite(pcols) ! indices of night columns in the chunk + real(r8), intent(in) :: pmid(nday,nlay)! pressure at layer midpoints (Pa) used to seed RNG. - ! cloud fraction and optics are input on the CAM grid - real(r8), intent(in) :: cldfrac(pcols,pver) ! combined cloud fraction - real(r8), intent(in) :: c_cld_tau (nswbands,pcols,pver) ! combined cloud extinction optical depth - real(r8), intent(in) :: c_cld_tau_w (nswbands,pcols,pver) ! combined cloud single scattering albedo * tau - real(r8), intent(in) :: c_cld_tau_w_g(nswbands,pcols,pver) ! combined cloud assymetry parameter * w * tau + real(r8), pointer :: cld(:,:) ! cloud fraction (liq+ice) + real(r8), pointer :: cldfsnow(:,:) ! cloud fraction of just "snow clouds" + real(r8), pointer :: cldfgrau(:,:) ! cloud fraction of just "graupel clouds" + real(r8), intent(in) :: cldfprime(pcols,pver) ! combined cloud fraction + logical, intent(in) :: graupel_in_rad ! graupel in radiation code class(ty_gas_optics_rrtmgp), intent(in) :: kdist_sw ! shortwave gas optics object - type(ty_optical_props_2str), intent(out) :: cloud_sw ! cloud optical properties object - - ! local vars + type(ty_optical_props_2str), intent(out) :: cloud_sw ! SW cloud optical properties object + + ! Diagnostic outputs + real(r8), intent(out) :: tot_cld_vistau(pcols,pver) ! gbx total cloud optical depth + real(r8), intent(out) :: tot_icld_vistau(pcols,pver) ! in-cld total cloud optical depth + real(r8), intent(out) :: liq_icld_vistau(pcols,pver) ! in-cld liq cloud optical depth + real(r8), intent(out) :: ice_icld_vistau(pcols,pver) ! in-cld ice cloud optical depth + real(r8), intent(out) :: snow_icld_vistau(pcols,pver) ! snow in-cloud visible sw optical depth + real(r8), intent(out) :: grau_icld_vistau(pcols,pver) ! Graupel in-cloud visible sw optical depth + real(r8), intent(out) :: cld_tau_cloudsim(pcols,pver) ! in-cloud liq+ice optical depth (for COSP) + real(r8), intent(out) :: snow_tau_cloudsim(pcols,pver)! in-cloud snow optical depth (for COSP) + real(r8), intent(out) :: grau_tau_cloudsim(pcols,pver)! in-cloud Graupel optical depth (for COSP) + + ! Local variables + + integer :: i, k, ncol + integer :: igpt, nver integer, parameter :: changeseed = 1 - integer :: i, k, kk, ns, igpt - integer :: ngptsw - integer :: nver - + ! cloud radiative parameters are "in cloud" not "in cell" + real(r8) :: ice_tau (nswbands,pcols,pver) ! ice extinction optical depth + real(r8) :: ice_tau_w (nswbands,pcols,pver) ! ice single scattering albedo * tau + real(r8) :: ice_tau_w_g(nswbands,pcols,pver) ! ice assymetry parameter * tau * w + real(r8) :: liq_tau (nswbands,pcols,pver) ! liquid extinction optical depth + real(r8) :: liq_tau_w (nswbands,pcols,pver) ! liquid single scattering albedo * tau + real(r8) :: liq_tau_w_g(nswbands,pcols,pver) ! liquid assymetry parameter * tau * w + real(r8) :: cld_tau (nswbands,pcols,pver) ! cloud extinction optical depth + real(r8) :: cld_tau_w (nswbands,pcols,pver) ! cloud single scattering albedo * tau + real(r8) :: cld_tau_w_g(nswbands,pcols,pver) ! cloud assymetry parameter * w * tau + real(r8) :: snow_tau (nswbands,pcols,pver) ! snow extinction optical depth + real(r8) :: snow_tau_w (nswbands,pcols,pver) ! snow single scattering albedo * tau + real(r8) :: snow_tau_w_g(nswbands,pcols,pver) ! snow assymetry parameter * tau * w + real(r8) :: grau_tau (nswbands,pcols,pver) ! graupel extinction optical depth + real(r8) :: grau_tau_w (nswbands,pcols,pver) ! graupel single scattering albedo * tau + real(r8) :: grau_tau_w_g(nswbands,pcols,pver) ! graupel assymetry parameter * tau * w + real(r8) :: c_cld_tau (nswbands,pcols,pver) ! combined cloud extinction optical depth + real(r8) :: c_cld_tau_w (nswbands,pcols,pver) ! combined cloud single scattering albedo * tau + real(r8) :: c_cld_tau_w_g(nswbands,pcols,pver) ! combined cloud assymetry parameter * w * tau + + ! RRTMGP does not use this property in its 2-stream calculations. + real(r8) :: sw_tau_w_f(nswbands,pcols,pver) ! Forward scattered fraction * tau * w. + + ! Arrays for converting from CAM chunks to RRTMGP inputs. real(r8), allocatable :: cldf(:,:) real(r8), allocatable :: tauc(:,:,:) real(r8), allocatable :: ssac(:,:,:) @@ -545,8 +600,6 @@ subroutine rrtmgp_set_cloud_sw( & real(r8), allocatable :: taucmcl(:,:,:) real(r8), allocatable :: ssacmcl(:,:,:) real(r8), allocatable :: asmcmcl(:,:,:) - - real(r8) :: small_val = 1.e-80_r8 real(r8), allocatable :: day_cld_tau(:,:,:) real(r8), allocatable :: day_cld_tau_w(:,:,:) real(r8), allocatable :: day_cld_tau_w_g(:,:,:) @@ -555,27 +608,128 @@ subroutine rrtmgp_set_cloud_sw( & character(len=*), parameter :: sub = 'rrtmgp_set_cloud_sw' !-------------------------------------------------------------------------------- - ! number of g-points. This is the number of subcolumns constructed by MCICA. - ngptsw = kdist_sw%get_ngpt() + ncol = state%ncol + + ! Combine the cloud optical properties. These calculations are done on CAM "chunks". + + ! gammadist liquid optics + call get_liquid_optics_sw(state, pbuf, liq_tau, liq_tau_w, liq_tau_w_g, sw_tau_w_f) + ! Mitchell ice optics + call get_ice_optics_sw(state, pbuf, ice_tau, ice_tau_w, ice_tau_w_g, sw_tau_w_f) + + cld_tau(:,:ncol,:) = liq_tau(:,:ncol,:) + ice_tau(:,:ncol,:) + cld_tau_w(:,:ncol,:) = liq_tau_w(:,:ncol,:) + ice_tau_w(:,:ncol,:) + cld_tau_w_g(:,:ncol,:) = liq_tau_w_g(:,:ncol,:) + ice_tau_w_g(:,:ncol,:) + + ! add in snow + if (associated(cldfsnow)) then + call get_snow_optics_sw(state, pbuf, snow_tau, snow_tau_w, snow_tau_w_g, sw_tau_w_f) + do i = 1, ncol + do k = 1, pver + if (cldfprime(i,k) > 0.) then + c_cld_tau(:,i,k) = ( cldfsnow(i,k)*snow_tau(:,i,k) & + + cld(i,k)*cld_tau(:,i,k) )/cldfprime(i,k) + c_cld_tau_w(:,i,k) = ( cldfsnow(i,k)*snow_tau_w(:,i,k) & + + cld(i,k)*cld_tau_w(:,i,k) )/cldfprime(i,k) + c_cld_tau_w_g(:,i,k) = ( cldfsnow(i,k)*snow_tau_w_g(:,i,k) & + + cld(i,k)*cld_tau_w_g(:,i,k) )/cldfprime(i,k) + else + c_cld_tau(:,i,k) = 0._r8 + c_cld_tau_w(:,i,k) = 0._r8 + c_cld_tau_w_g(:,i,k) = 0._r8 + end if + end do + end do + else + c_cld_tau(:,:ncol,:) = cld_tau(:,:ncol,:) + c_cld_tau_w(:,:ncol,:) = cld_tau_w(:,:ncol,:) + c_cld_tau_w_g(:,:ncol,:) = cld_tau_w_g(:,:ncol,:) + end if + + ! add in graupel + if (associated(cldfgrau) .and. graupel_in_rad) then + call get_grau_optics_sw(state, pbuf, grau_tau, grau_tau_w, grau_tau_w_g, sw_tau_w_f) + do i = 1, ncol + do k = 1, pver + if (cldfprime(i,k) > 0._r8) then + c_cld_tau(:,i,k) = ( cldfgrau(i,k)*grau_tau(:,i,k) & + + cld(i,k)*c_cld_tau(:,i,k) )/cldfprime(i,k) + c_cld_tau_w(:,i,k) = ( cldfgrau(i,k)*grau_tau_w(:,i,k) & + + cld(i,k)*c_cld_tau_w(:,i,k) )/cldfprime(i,k) + c_cld_tau_w_g(:,i,k) = ( cldfgrau(i,k)*grau_tau_w_g(:,i,k) & + + cld(i,k)*c_cld_tau_w_g(:,i,k) )/cldfprime(i,k) + else + c_cld_tau(:,i,k) = 0._r8 + c_cld_tau_w(:,i,k) = 0._r8 + c_cld_tau_w_g(:,i,k) = 0._r8 + end if + end do + end do + end if + + ! cloud optical properties need to be re-ordered from the RRTMG spectral bands + ! (assumed in the optics datasets) to RRTMGP's + ice_tau(:,:ncol,:) = ice_tau(rrtmg_to_rrtmgp_swbands,:ncol,:) + liq_tau(:,:ncol,:) = liq_tau(rrtmg_to_rrtmgp_swbands,:ncol,:) + c_cld_tau(:,:ncol,:) = c_cld_tau(rrtmg_to_rrtmgp_swbands,:ncol,:) + c_cld_tau_w(:,:ncol,:) = c_cld_tau_w(rrtmg_to_rrtmgp_swbands,:ncol,:) + c_cld_tau_w_g(:,:ncol,:) = c_cld_tau_w_g(rrtmg_to_rrtmgp_swbands,:ncol,:) + if (associated(cldfsnow)) then + snow_tau(:,:ncol,:) = snow_tau(rrtmg_to_rrtmgp_swbands,:ncol,:) + end if + if (associated(cldfgrau) .and. graupel_in_rad) then + grau_tau(:,:ncol,:) = grau_tau(rrtmg_to_rrtmgp_swbands,:ncol,:) + end if + + ! Set arrays for diagnostic output. + ! cloud optical depth fields for the visible band + tot_icld_vistau(:ncol,:) = c_cld_tau(idx_sw_diag,:ncol,:) + liq_icld_vistau(:ncol,:) = liq_tau(idx_sw_diag,:ncol,:) + ice_icld_vistau(:ncol,:) = ice_tau(idx_sw_diag,:ncol,:) + if (associated(cldfsnow)) then + snow_icld_vistau(:ncol,:) = snow_tau(idx_sw_diag,:ncol,:) + endif + if (associated(cldfgrau) .and. graupel_in_rad) then + grau_icld_vistau(:ncol,:) = grau_tau(idx_sw_diag,:ncol,:) + endif + + ! multiply by total cloud fraction to get gridbox value + tot_cld_vistau(:ncol,:) = c_cld_tau(idx_sw_diag,:ncol,:)*cldfprime(:ncol,:) + + ! overwrite night columns with fillvalue + do i = 1, Nnite + tot_cld_vistau(IdxNite(i),:) = fillvalue + tot_icld_vistau(IdxNite(i),:) = fillvalue + liq_icld_vistau(IdxNite(i),:) = fillvalue + ice_icld_vistau(IdxNite(i),:) = fillvalue + if (associated(cldfsnow)) then + snow_icld_vistau(IdxNite(i),:) = fillvalue + end if + if (associated(cldfgrau) .and. graupel_in_rad) then + grau_icld_vistau(IdxNite(i),:) = fillvalue + end if + end do + + ! Cloud optics for COSP + cld_tau_cloudsim = cld_tau(idx_sw_cloudsim,:,:) + snow_tau_cloudsim = snow_tau(idx_sw_cloudsim,:,:) + grau_tau_cloudsim = grau_tau(idx_sw_cloudsim,:,:) ! number of CAM's layers in radiation calculation. Does not include the "extra layer". - nver = pver - ktopcam + 1 + nver = pver - ktopcam + 1 allocate( & - cldf(nday,nver), & - tauc(nswbands,nday,nver), & - ssac(nswbands,nday,nver), & - asmc(nswbands,nday,nver), & - taucmcl(ngptsw,nday,nver), & - ssacmcl(ngptsw,nday,nver), & - asmcmcl(ngptsw,nday,nver), & - day_cld_tau(nswbands,nday,nver), & - day_cld_tau_w(nswbands,nday,nver), & - day_cld_tau_w_g(nswbands,nday,nver)) - - ! Subset the input data so just the daylight columns, and the number of CAM layers in the + cldf(nday,nver), & + day_cld_tau(nswbands,nday,nver), & + day_cld_tau_w(nswbands,nday,nver), & + day_cld_tau_w_g(nswbands,nday,nver), & + tauc(nswbands,nday,nver), taucmcl(nswgpts,nday,nver), & + ssac(nswbands,nday,nver), ssacmcl(nswgpts,nday,nver), & + asmc(nswbands,nday,nver), asmcmcl(nswgpts,nday,nver) ) + + ! Subset "chunk" data so just the daylight columns, and the number of CAM layers in the ! radiation calculation are used by MCICA to produce subcolumns. - cldf = cldfrac( idxday(1:nday), ktopcam:) + cldf = cldfprime( idxday(1:nday), ktopcam:) day_cld_tau = c_cld_tau( :, idxday(1:nday), ktopcam:) day_cld_tau_w = c_cld_tau_w( :, idxday(1:nday), ktopcam:) day_cld_tau_w_g = c_cld_tau_w_g(:, idxday(1:nday), ktopcam:) @@ -586,15 +740,15 @@ subroutine rrtmgp_set_cloud_sw( & ! set cloud optical depth, clip @ zero tauc = merge(day_cld_tau, 0.0_r8, day_cld_tau > 0.0_r8) ! set value of asymmetry - asmc = merge(day_cld_tau_w_g / max(day_cld_tau_w, small_val), 0.0_r8, day_cld_tau_w > 0.0_r8) + asmc = merge(day_cld_tau_w_g / max(day_cld_tau_w, tiny), 0.0_r8, day_cld_tau_w > 0.0_r8) ! set value of single scattering albedo - ssac = merge(max(day_cld_tau_w, small_val) / max(tauc, small_val), 1.0_r8 , tauc > 0.0_r8) + ssac = merge(max(day_cld_tau_w, tiny) / max(tauc, tiny), 1.0_r8 , tauc > 0.0_r8) ! set asymmetry to zero when tauc = 0 asmc = merge(asmc, 0.0_r8, tauc > 0.0_r8) ! MCICA converts from bands to gpts (e.g., 224 g-points instead of 14 bands) call mcica_subcol_sw( & - kdist_sw, nswbands, ngptsw, nday, nlay, & + kdist_sw, nswbands, nswgpts, nday, nlay, & nver, changeseed, pmid, cldf, tauc, & ssac, asmc, taucmcl, ssacmcl, asmcmcl) @@ -611,13 +765,13 @@ subroutine rrtmgp_set_cloud_sw( & cloud_sw%g = 0.0_r8 ! Set the properties on g-points. - do igpt = 1,ngptsw + do igpt = 1,nswgpts cloud_sw%g (:, ktoprad:, igpt) = asmcmcl(igpt, ktopcam:, :) cloud_sw%ssa(:, ktoprad:, igpt) = ssacmcl(igpt, ktopcam:, :) cloud_sw%tau(:, ktoprad:, igpt) = taucmcl(igpt, ktopcam:, :) end do - ! validate checks the tau > 0, ssa is in range [0,1], and g is in range [-1,1]. + ! validate checks that: tau > 0, ssa is in range [0,1], and g is in range [-1,1]. errmsg = cloud_sw%validate() if (len_trim(errmsg) > 0) then call endrun(sub//': ERROR: cloud_sw%validate: '//trim(errmsg)) @@ -665,69 +819,78 @@ end subroutine rrtmgp_set_aer_lw !================================================================================================== subroutine rrtmgp_set_aer_sw( & - nday, idxday, aer_tau, aer_tau_w, & - aer_tau_w_g, aer_tau_w_f, aer_sw) + icall, state, pbuf, nday, idxday, nnite, idxnite, aer_sw) ! Load aerosol SW optical properties into the RRTMGP object. - ! - ! CAM fields are products tau, tau*ssa, tau*ssa*asy, tau*ssa*asy*fsf - ! Fields expected by RRTMGP are computed by - ! aer_sw%tau = aer_tau - ! aer_sw%ssa = aer_tau_w / aer_tau - ! aer_sw%g = aer_tau_w_g / aer_taw_w - ! - ! The input optical arrays from CAM are dimensioned in the vertical - ! as 0:pver. The index 0 is for the extra layer used in the radiation - ! calculation. The index ktopcam assumes the CAM vertical indices are - ! in the range 1:pver, so using this index correctly ignores vertical - ! index 0. If an "extra" layer is used in the calculations, it is - ! provided and set in the RRTMGP aerosol object aer_sw. ! Arguments - integer, intent(in) :: nday - integer, intent(in) :: idxday(:) - real(r8), intent(in) :: aer_tau (pcols,0:pver,nswbands) ! extinction optical depth - real(r8), intent(in) :: aer_tau_w (pcols,0:pver,nswbands) ! single scattering albedo * tau - real(r8), intent(in) :: aer_tau_w_g(pcols,0:pver,nswbands) ! asymmetry parameter * w * tau - real(r8), intent(in) :: aer_tau_w_f(pcols,0:pver,nswbands) ! forward scattered fraction * w * tau + integer, intent(in) :: icall + type(physics_state), target, intent(in) :: state + type(physics_buffer_desc), pointer :: pbuf(:) + integer, intent(in) :: nday + integer, intent(in) :: idxday(:) + integer, intent(in) :: nnite ! number of night columns + integer, intent(in) :: idxnite(pcols) ! indices of night columns in the chunk + type(ty_optical_props_2str), intent(inout) :: aer_sw ! local variables - integer :: i + integer :: i, k, ib - ! minimum value for aer_tau_w is the same as used in RRTMG code. - real(r8), parameter :: tiny = 1.e-80_r8 - - character(len=32) :: sub = 'rrtmgp_set_aer_sw' + ! The optical arrays dimensioned in the vertical as 0:pver. + ! The index 0 is for the extra layer used in the radiation + ! calculation. The index ktopcam assumes the CAM vertical indices are + ! in the range 1:pver, so using this index correctly ignores vertical + ! index 0. If an "extra" layer is used in the calculations, it is + ! provided and set in the RRTMGP aerosol object aer_sw. + real(r8) :: aer_tau (pcols,0:pver,nswbands) ! extinction optical depth + real(r8) :: aer_tau_w (pcols,0:pver,nswbands) ! single scattering albedo * tau + real(r8) :: aer_tau_w_g(pcols,0:pver,nswbands) ! asymmetry parameter * w * tau + real(r8) :: aer_tau_w_f(pcols,0:pver,nswbands) ! forward scattered fraction * w * tau + ! aer_tau_w_f is not used by RRTMGP. + character(len=*), parameter :: sub = 'rrtmgp_set_aer_sw' character(len=128) :: errmsg !-------------------------------------------------------------------------------- + ! Get aerosol shortwave optical properties. + call aer_rad_props_sw( & + icall, state, pbuf, nnite, idxnite, & + aer_tau, aer_tau_w, aer_tau_w_g, aer_tau_w_f) + + ! aerosol optical properties need to be re-ordered from the RRTMG spectral bands + ! (as assumed in the optics datasets) to the RRTMGP band order. + aer_tau(:,:,:) = aer_tau( :,:,rrtmg_to_rrtmgp_swbands) + aer_tau_w(:,:,:) = aer_tau_w( :,:,rrtmg_to_rrtmgp_swbands) + aer_tau_w_g(:,:,:) = aer_tau_w_g(:,:,rrtmg_to_rrtmgp_swbands) + ! If there is an extra layer in the radiation then this initialization - ! will provide default values there. + ! will provide default values. aer_sw%tau = 0.0_r8 aer_sw%ssa = 1.0_r8 aer_sw%g = 0.0_r8 + ! CAM fields are products tau, tau*ssa, tau*ssa*asy + ! Fields expected by RRTMGP are computed by + ! aer_sw%tau = aer_tau + ! aer_sw%ssa = aer_tau_w / aer_tau + ! aer_sw%g = aer_tau_w_g / aer_taw_w + ! aer_sw arrays have dimensions of (nday,nlay,nswbands) + do i = 1, nday - ! aer_sw arrays have dimensions of (nday,nlay,nswbands) + ! set aerosol optical depth, clip to zero aer_sw%tau(i,ktoprad:,:) = max(aer_tau(idxday(i),ktopcam:,:), 0._r8) + ! set value of single scattering albedo aer_sw%ssa(i,ktoprad:,:) = merge(aer_tau_w(idxday(i),ktopcam:,:)/aer_tau(idxday(i),ktopcam:,:), & 1._r8, aer_tau(idxday(i),ktopcam:,:) > 0._r8) + ! set value of asymmetry aer_sw%g(i,ktoprad:,:) = merge(aer_tau_w_g(idxday(i),ktopcam:,:)/aer_tau_w(idxday(i),ktopcam:,:), & 0._r8, aer_tau_w(idxday(i),ktopcam:,:) > tiny) end do - ! impose limits on the components: + ! impose limits on the components aer_sw%ssa = min(max(aer_sw%ssa, 0._r8), 1._r8) - aer_sw%g = min(max(aer_sw%g, -1._r8), 1._r8) - ! by clamping the values here, the validate method should be guaranteed to succeed, - ! but we're also saying that any errors in the method to this point are being swept aside. - ! We might want to check for out-of-bounds values and report them in the log file. + aer_sw%g = min(max(aer_sw%g, -1._r8), 1._r8) - errmsg = aer_sw%validate() - if (len_trim(errmsg) > 0) then - call endrun(sub//': ERROR: aer_sw%validate: '//trim(errmsg)) - end if end subroutine rrtmgp_set_aer_sw !================================================================================================== From b7f0039da88eac6cbdaf1483be5bee0cced06760 Mon Sep 17 00:00:00 2001 From: Brian Eaton Date: Mon, 25 Sep 2023 12:01:01 -0400 Subject: [PATCH 155/291] refactor SW treatment of no daylight columns in chunk --- src/physics/rrtmgp/radiation.F90 | 177 ++++++++++++----------- src/physics/rrtmgp/rrtmgp_inputs.F90 | 207 ++++++++++++++------------- 2 files changed, 204 insertions(+), 180 deletions(-) diff --git a/src/physics/rrtmgp/radiation.F90 b/src/physics/rrtmgp/radiation.F90 index bd8ec09e05..c7d305f371 100644 --- a/src/physics/rrtmgp/radiation.F90 +++ b/src/physics/rrtmgp/radiation.F90 @@ -91,8 +91,6 @@ module radiation real(r8) :: qrsc(pcols,pver) - real(r8) :: flux_sw_net_top(pcols) ! net shortwave flux at top (FSNT) - real(r8) :: fsnsc(pcols) ! Clear sky surface abs solar flux real(r8) :: fsntc(pcols) ! Clear sky total column abs solar flux real(r8) :: fsdsc(pcols) ! Clear sky surface downwelling solar flux @@ -1145,19 +1143,11 @@ subroutine radiation_tend( & ! and would get whatever is in pbuf for qrl / qrs. ! To avoid non-daylit columns ! from having shortwave heating, we should reset here: - if (nday == 0) then - qrs(1:ncol,1:pver) = 0._r8 - rd%qrsc(1:ncol,1:pver) = 0._r8 ! this is what gets turned into QRSC in output (probably not needed here.) - dosw = .false. - end if - - ! On first time step, do we need to initialize the heating rates in pbuf? - ! what about on a restart? - if (get_nstep() == 0) then - qrs = 0._r8 - qrl = 0._r8 - end if - +! if (nday == 0) then +! qrs(1:ncol,1:pver) = 0._r8 +! rd%qrsc(1:ncol,1:pver) = 0._r8 ! this is what gets turned into QRSC in output (probably not needed here.) +! dosw = .false. +! end if if (dosw .or. dolw) then @@ -1200,76 +1190,91 @@ subroutine radiation_tend( & call radiation_output_cld(lchnk, ncol, rd) end if - ! Initialize object for gas concentrations. - errmsg = gas_concs_sw%init(gaslist_lc) - if (len_trim(errmsg) > 0) then - call endrun(sub//': ERROR: gas_concs_sw%init: '//trim(errmsg)) - end if + ! If no daylight columns, can't create empty RRTMGP objects + if (nday > 0) then - ! Init and allocate arrays in atm optics object. - errmsg = atm_optics_sw%alloc_2str(nday, nlay, kdist_sw) - if (len_trim(errmsg) > 0) then - call endrun(sub//': ERROR: gas_optics_sw%alloc_2str: '//trim(errmsg)) - end if + ! Initialize object for gas concentrations. + errmsg = gas_concs_sw%init(gaslist_lc) + if (len_trim(errmsg) > 0) then + call endrun(sub//': ERROR: gas_concs_sw%init: '//trim(errmsg)) + end if + + ! Init and allocate arrays in atm optics object. + errmsg = atm_optics_sw%alloc_2str(nday, nlay, kdist_sw) + if (len_trim(errmsg) > 0) then + call endrun(sub//': ERROR: gas_optics_sw%alloc_2str: '//trim(errmsg)) + end if + + ! Init and allocate arrays in aerosol optics object. + errmsg = aer_sw%alloc_2str(nday, nlay, kdist_sw%get_band_lims_wavenumber()) + if (len_trim(errmsg) > 0) then + call endrun(sub//': ERROR: aer_sw%alloc_2str: '//trim(errmsg)) + end if - ! Init and allocate arrays in aerosol optics object. - errmsg = aer_sw%alloc_2str(nday, nlay, kdist_sw%get_band_lims_wavenumber()) - if (len_trim(errmsg) > 0) then - call endrun(sub//': ERROR: aer_sw%alloc_2str: '//trim(errmsg)) end if ! The climate (icall==0) calculation must occur last. do icall = N_DIAG, 0, -1 if (active_calls(icall)) then - ! Set gas volume mixing ratios for this call in gas_concs_sw. - call rrtmgp_set_gases_sw( & - icall, state, pbuf, nlay, nday, & - idxday, gas_concs_sw) + if (nday > 0) then - ! Compute the gas optics (stored in atm_optics_sw). - ! toa_flux is the reference solar source from RRTMGP data. - errmsg = kdist_sw%gas_optics( & - pmid_day, pint_day, t_day, gas_concs_sw, atm_optics_sw, & - toa_flux) - if (len_trim(errmsg) > 0) then - call endrun(sub//': ERROR: kdist_sw%gas_optics: '//trim(errmsg)) - end if + ! Set gas volume mixing ratios for this call in gas_concs_sw. + call rrtmgp_set_gases_sw( & + icall, state, pbuf, nlay, nday, & + idxday, gas_concs_sw) + + ! Compute the gas optics (stored in atm_optics_sw). + ! toa_flux is the reference solar source from RRTMGP data. + errmsg = kdist_sw%gas_optics( & + pmid_day, pint_day, t_day, gas_concs_sw, atm_optics_sw, & + toa_flux) + if (len_trim(errmsg) > 0) then + call endrun(sub//': ERROR: kdist_sw%gas_optics: '//trim(errmsg)) + end if - ! Scale the solar source - tsi_ref = sum(toa_flux(1,:)) - toa_flux = toa_flux * sol_tsi * eccf / tsi_ref + ! Scale the solar source + tsi_ref = sum(toa_flux(1,:)) + toa_flux = toa_flux * sol_tsi * eccf / tsi_ref + + end if ! Set SW aerosol optical properties in the aer_sw object. + ! This call made even when no daylight columns because it does some + ! diagnostic aerosol output. call rrtmgp_set_aer_sw( & icall, state, pbuf, nday, idxday, nnite, idxnite, aer_sw) - ! Increment the gas optics (in atm_optics_sw) by the aerosol optics in aer_sw. - errmsg = aer_sw%increment(atm_optics_sw) - if (len_trim(errmsg) > 0) then - call endrun(sub//': ERROR in aer_sw%increment: '//trim(errmsg)) - end if + if (nday > 0) then - ! Compute clear-sky fluxes. - errmsg = rte_sw(& - atm_optics_sw, top_at_1, coszrs_day, toa_flux, & - alb_dir, alb_dif, fswc) - if (len_trim(errmsg) > 0) then - call endrun(sub//': ERROR in clear-sky rte_sw: '//trim(errmsg)) - end if + ! Increment the gas optics (in atm_optics_sw) by the aerosol optics in aer_sw. + errmsg = aer_sw%increment(atm_optics_sw) + if (len_trim(errmsg) > 0) then + call endrun(sub//': ERROR in aer_sw%increment: '//trim(errmsg)) + end if - ! Increment the aerosol+gas optics (in atm_optics_sw) by the cloud optics in cloud_sw. - errmsg = cloud_sw%increment(atm_optics_sw) - if (len_trim(errmsg) > 0) then - call endrun(sub//': ERROR in cloud_sw%increment: '//trim(errmsg)) - end if + ! Compute clear-sky fluxes. + errmsg = rte_sw(& + atm_optics_sw, top_at_1, coszrs_day, toa_flux, & + alb_dir, alb_dif, fswc) + if (len_trim(errmsg) > 0) then + call endrun(sub//': ERROR in clear-sky rte_sw: '//trim(errmsg)) + end if + + ! Increment the aerosol+gas optics (in atm_optics_sw) by the cloud optics in cloud_sw. + errmsg = cloud_sw%increment(atm_optics_sw) + if (len_trim(errmsg) > 0) then + call endrun(sub//': ERROR in cloud_sw%increment: '//trim(errmsg)) + end if + + ! Compute all-sky fluxes. + errmsg = rte_sw(& + atm_optics_sw, top_at_1, coszrs_day, toa_flux, & + alb_dir, alb_dif, fsw) + if (len_trim(errmsg) > 0) then + call endrun(sub//': ERROR in all-sky rte_sw: '//trim(errmsg)) + end if - ! Compute all-sky fluxes. - errmsg = rte_sw(& - atm_optics_sw, top_at_1, coszrs_day, toa_flux, & - alb_dir, alb_dif, fsw) - if (len_trim(errmsg) > 0) then - call endrun(sub//': ERROR in all-sky rte_sw: '//trim(errmsg)) end if ! Transform RRTMGP outputs to CAM outputs and compute heating rates. @@ -1549,20 +1554,31 @@ subroutine set_sw_diags() !------------------------------------------------------------------------- ! Initialize to provide 0.0 values for night columns. - fns = 0._r8 ! net sw flux - fcns = 0._r8 ! net sw clearsky flux - fsds = 0._r8 ! downward sw flux at surface - rd%fsdsc = 0._r8 ! downward sw clearsky flux at surface - rd%fsutoa = 0._r8 ! upward sw flux at TOA - rd%fsntoa = 0._r8 ! net sw at TOA - rd%fsntoac = 0._r8 ! net sw clearsky flux at TOA - rd%solin = 0._r8 ! solar irradiance at TOA + fns = 0._r8 ! net sw flux + fcns = 0._r8 ! net sw clearsky flux + fsds = 0._r8 ! downward sw flux at surface + rd%fsdsc = 0._r8 ! downward sw clearsky flux at surface + rd%fsutoa = 0._r8 ! upward sw flux at TOA + rd%fsntoa = 0._r8 ! net sw at TOA + rd%fsntoac = 0._r8 ! net sw clearsky flux at TOA + rd%solin = 0._r8 ! solar irradiance at TOA + rd%flux_sw_up = 0._r8 + rd%flux_sw_dn = 0._r8 + rd%flux_sw_clr_up = 0._r8 + rd%flux_sw_clr_dn = 0._r8 + rd%fsdn = 0._r8 rd%fsdnc = 0._r8 rd%fsup = 0._r8 rd%fsupc = 0._r8 - ! fns, fcns, rd are on CAM grid (do not have "extra layer" when it is present.) + qrs = 0._r8 + fsns = 0._r8 + fsnt = 0._r8 + rd%qrsc = 0._r8 + rd%fsnsc = 0._r8 + rd%fsntc = 0._r8 + do i = 1, nday fns(idxday(i),ktopcam:) = fsw%flux_net(i, ktoprad:) fcns(idxday(i),ktopcam:) = fswc%flux_net(i,ktoprad:) @@ -1576,18 +1592,19 @@ subroutine set_sw_diags() rd%flux_sw_dn(idxday(i),ktopcam:) = fsw%flux_dn(i,ktoprad:) rd%flux_sw_clr_up(idxday(i),ktopcam:) = fswc%flux_up(i,ktoprad:) rd%flux_sw_clr_dn(idxday(i),ktopcam:) = fswc%flux_dn(i,ktoprad:) + rd%fsdn(idxday(i),:) = fsw%flux_dn(i,:) rd%fsdnc(idxday(i),:) = fswc%flux_dn(i,:) rd%fsup(idxday(i),:) = fsw%flux_up(i,:) rd%fsupc(idxday(i),:) = fswc%flux_up(i,:) end do + ! Compute heating rate as a dry static energy tendency. call heating_rate('SW', ncol, fns, qrs) call heating_rate('SW', ncol, fcns, rd%qrsc) fsns(:ncol) = fns(:ncol,pverp) ! net sw flux at surface fsnt(:ncol) = fns(:ncol,1) ! net sw flux at top-of-model (w/o extra layer) - rd%flux_sw_net_top(:ncol) = fns(:ncol, 1) rd%fsnsc(:ncol) = fcns(:ncol,pverp) ! net sw clearsky flux at surface rd%fsntc(:ncol) = fcns(:ncol,1) ! net sw clearsky flux at top @@ -1614,7 +1631,6 @@ subroutine set_sw_diags() ! Export surface fluxes ! sols(pcols) Direct solar rad on surface (< 0.7) ! soll(pcols) Direct solar rad on surface (>= 0.7) - ! RRTMG: Near-IR bands (1-9 and 14), 820-16000 cm-1, 0.625-12.195 microns ! RRTMGP: Near-IR bands (1-10), 820-16000 cm-1, 0.625-12.195 microns ! Put half of band 10 in each of the UV/visible and near-IR values, ! since this band straddles 0.7 microns: @@ -1630,8 +1646,6 @@ subroutine set_sw_diags() flux_dn_diffuse = fsw%bnd_flux_dn - fsw%bnd_flux_dn_dir do i = 1, nday - ! These use hard-coded indexes assuming default RRTMGP sw bands - ! Should be generalized to use specified frequencies. cam_out%soll(idxday(i)) = sum(fsw%bnd_flux_dn_dir(i,nlay+1,1:9)) & + 0.5_r8 * fsw%bnd_flux_dn_dir(i,nlay+1,10) @@ -1643,7 +1657,6 @@ subroutine set_sw_diags() cam_out%solsd(idxday(i)) = 0.5_r8 * flux_dn_diffuse(i, nlay+1, 10) & + sum(flux_dn_diffuse(i,nlay+1,11:14)) - end do end subroutine set_sw_diags @@ -1779,7 +1792,7 @@ subroutine radiation_output_sw(lchnk, ncol, icall, rd, pbuf, cam_out) call outfld('QRS'//diag(icall), qrs(:ncol,:)/cpair, ncol, lchnk) call outfld('QRSC'//diag(icall), rd%qrsc(:ncol,:)/cpair, ncol, lchnk) - call outfld('FSNT'//diag(icall), rd%flux_sw_net_top, pcols, lchnk) + call outfld('FSNT'//diag(icall), fsnt, pcols, lchnk) call outfld('FSNTC'//diag(icall), rd%fsntc, pcols, lchnk) call outfld('FSNTOA'//diag(icall), rd%fsntoa, pcols, lchnk) call outfld('FSNTOAC'//diag(icall), rd%fsntoac, pcols, lchnk) diff --git a/src/physics/rrtmgp/rrtmgp_inputs.F90 b/src/physics/rrtmgp/rrtmgp_inputs.F90 index f076f4c1e0..fc6c5d4c4e 100644 --- a/src/physics/rrtmgp/rrtmgp_inputs.F90 +++ b/src/physics/rrtmgp/rrtmgp_inputs.F90 @@ -715,79 +715,84 @@ subroutine rrtmgp_set_cloud_sw( & snow_tau_cloudsim = snow_tau(idx_sw_cloudsim,:,:) grau_tau_cloudsim = grau_tau(idx_sw_cloudsim,:,:) - ! number of CAM's layers in radiation calculation. Does not include the "extra layer". - nver = pver - ktopcam + 1 - - allocate( & - cldf(nday,nver), & - day_cld_tau(nswbands,nday,nver), & - day_cld_tau_w(nswbands,nday,nver), & - day_cld_tau_w_g(nswbands,nday,nver), & - tauc(nswbands,nday,nver), taucmcl(nswgpts,nday,nver), & - ssac(nswbands,nday,nver), ssacmcl(nswgpts,nday,nver), & - asmc(nswbands,nday,nver), asmcmcl(nswgpts,nday,nver) ) - - ! Subset "chunk" data so just the daylight columns, and the number of CAM layers in the - ! radiation calculation are used by MCICA to produce subcolumns. - cldf = cldfprime( idxday(1:nday), ktopcam:) - day_cld_tau = c_cld_tau( :, idxday(1:nday), ktopcam:) - day_cld_tau_w = c_cld_tau_w( :, idxday(1:nday), ktopcam:) - day_cld_tau_w_g = c_cld_tau_w_g(:, idxday(1:nday), ktopcam:) - - ! Compute the optical properties needed for the 2-stream calculations. These calculations - ! are the same as the RRTMG version. - - ! set cloud optical depth, clip @ zero - tauc = merge(day_cld_tau, 0.0_r8, day_cld_tau > 0.0_r8) - ! set value of asymmetry - asmc = merge(day_cld_tau_w_g / max(day_cld_tau_w, tiny), 0.0_r8, day_cld_tau_w > 0.0_r8) - ! set value of single scattering albedo - ssac = merge(max(day_cld_tau_w, tiny) / max(tauc, tiny), 1.0_r8 , tauc > 0.0_r8) - ! set asymmetry to zero when tauc = 0 - asmc = merge(asmc, 0.0_r8, tauc > 0.0_r8) - - ! MCICA converts from bands to gpts (e.g., 224 g-points instead of 14 bands) - call mcica_subcol_sw( & - kdist_sw, nswbands, nswgpts, nday, nlay, & - nver, changeseed, pmid, cldf, tauc, & - ssac, asmc, taucmcl, ssacmcl, asmcmcl) + ! if no daylight columns the cloud_sw object isn't initialized + if (nday > 0) then + + ! number of CAM's layers in radiation calculation. Does not include the "extra layer". + nver = pver - ktopcam + 1 + + allocate( & + cldf(nday,nver), & + day_cld_tau(nswbands,nday,nver), & + day_cld_tau_w(nswbands,nday,nver), & + day_cld_tau_w_g(nswbands,nday,nver), & + tauc(nswbands,nday,nver), taucmcl(nswgpts,nday,nver), & + ssac(nswbands,nday,nver), ssacmcl(nswgpts,nday,nver), & + asmc(nswbands,nday,nver), asmcmcl(nswgpts,nday,nver) ) + + ! Subset "chunk" data so just the daylight columns, and the number of CAM layers in the + ! radiation calculation are used by MCICA to produce subcolumns. + cldf = cldfprime( idxday(1:nday), ktopcam:) + day_cld_tau = c_cld_tau( :, idxday(1:nday), ktopcam:) + day_cld_tau_w = c_cld_tau_w( :, idxday(1:nday), ktopcam:) + day_cld_tau_w_g = c_cld_tau_w_g(:, idxday(1:nday), ktopcam:) + + ! Compute the optical properties needed for the 2-stream calculations. These calculations + ! are the same as the RRTMG version. + + ! set cloud optical depth, clip @ zero + tauc = merge(day_cld_tau, 0.0_r8, day_cld_tau > 0.0_r8) + ! set value of asymmetry + asmc = merge(day_cld_tau_w_g / max(day_cld_tau_w, tiny), 0.0_r8, day_cld_tau_w > 0.0_r8) + ! set value of single scattering albedo + ssac = merge(max(day_cld_tau_w, tiny) / max(tauc, tiny), 1.0_r8 , tauc > 0.0_r8) + ! set asymmetry to zero when tauc = 0 + asmc = merge(asmc, 0.0_r8, tauc > 0.0_r8) + + ! MCICA converts from bands to gpts (e.g., 224 g-points instead of 14 bands) + call mcica_subcol_sw( & + kdist_sw, nswbands, nswgpts, nday, nlay, & + nver, changeseed, pmid, cldf, tauc, & + ssac, asmc, taucmcl, ssacmcl, asmcmcl) - ! Initialize object for SW cloud optical properties. - errmsg = cloud_sw%alloc_2str(nday, nlay, kdist_sw) - if (len_trim(errmsg) > 0) then - call endrun(trim(sub)//': ERROR: cloud_sw%alloc_2str: '//trim(errmsg)) - end if + ! Initialize object for SW cloud optical properties. + errmsg = cloud_sw%alloc_2str(nday, nlay, kdist_sw) + if (len_trim(errmsg) > 0) then + call endrun(trim(sub)//': ERROR: cloud_sw%alloc_2str: '//trim(errmsg)) + end if - ! If there is an extra layer in the radiation then this initialization - ! will provide the optical properties there. - cloud_sw%tau = 0.0_r8 - cloud_sw%ssa = 1.0_r8 - cloud_sw%g = 0.0_r8 - - ! Set the properties on g-points. - do igpt = 1,nswgpts - cloud_sw%g (:, ktoprad:, igpt) = asmcmcl(igpt, ktopcam:, :) - cloud_sw%ssa(:, ktoprad:, igpt) = ssacmcl(igpt, ktopcam:, :) - cloud_sw%tau(:, ktoprad:, igpt) = taucmcl(igpt, ktopcam:, :) - end do + ! If there is an extra layer in the radiation then this initialization + ! will provide the optical properties there. + cloud_sw%tau = 0.0_r8 + cloud_sw%ssa = 1.0_r8 + cloud_sw%g = 0.0_r8 + + ! Set the properties on g-points. + do igpt = 1,nswgpts + cloud_sw%g (:, ktoprad:, igpt) = asmcmcl(igpt, ktopcam:, :) + cloud_sw%ssa(:, ktoprad:, igpt) = ssacmcl(igpt, ktopcam:, :) + cloud_sw%tau(:, ktoprad:, igpt) = taucmcl(igpt, ktopcam:, :) + end do - ! validate checks that: tau > 0, ssa is in range [0,1], and g is in range [-1,1]. - errmsg = cloud_sw%validate() - if (len_trim(errmsg) > 0) then - call endrun(sub//': ERROR: cloud_sw%validate: '//trim(errmsg)) - end if + ! validate checks that: tau > 0, ssa is in range [0,1], and g is in range [-1,1]. + errmsg = cloud_sw%validate() + if (len_trim(errmsg) > 0) then + call endrun(sub//': ERROR: cloud_sw%validate: '//trim(errmsg)) + end if - ! delta scaling adjusts for forward scattering - errmsg = cloud_sw%delta_scale() - if (len_trim(errmsg) > 0) then - call endrun(sub//': ERROR: cloud_sw%delta_scale: '//trim(errmsg)) - end if + ! delta scaling adjusts for forward scattering + errmsg = cloud_sw%delta_scale() + if (len_trim(errmsg) > 0) then + call endrun(sub//': ERROR: cloud_sw%delta_scale: '//trim(errmsg)) + end if + + ! All information is in cloud_sw, now deallocate local vars. + deallocate( & + cldf, tauc, ssac, asmc, & + taucmcl, ssacmcl, asmcmcl,& + day_cld_tau, day_cld_tau_w, day_cld_tau_w_g ) - ! All information is in cloud_sw, now deallocate local vars. - deallocate( & - cldf, tauc, ssac, asmc, & - taucmcl, ssacmcl, asmcmcl,& - day_cld_tau, day_cld_tau_w, day_cld_tau_w_g ) + end if end subroutine rrtmgp_set_cloud_sw @@ -853,43 +858,49 @@ subroutine rrtmgp_set_aer_sw( & !-------------------------------------------------------------------------------- ! Get aerosol shortwave optical properties. + ! Make outfld calls for aerosol optical property diagnostics. call aer_rad_props_sw( & icall, state, pbuf, nnite, idxnite, & aer_tau, aer_tau_w, aer_tau_w_g, aer_tau_w_f) - ! aerosol optical properties need to be re-ordered from the RRTMG spectral bands - ! (as assumed in the optics datasets) to the RRTMGP band order. - aer_tau(:,:,:) = aer_tau( :,:,rrtmg_to_rrtmgp_swbands) - aer_tau_w(:,:,:) = aer_tau_w( :,:,rrtmg_to_rrtmgp_swbands) - aer_tau_w_g(:,:,:) = aer_tau_w_g(:,:,rrtmg_to_rrtmgp_swbands) + ! The aer_sw object is only initialized if nday > 0. + if (nday > 0) then + + ! aerosol optical properties need to be re-ordered from the RRTMG spectral bands + ! (as assumed in the optics datasets) to the RRTMGP band order. + aer_tau(:,:,:) = aer_tau( :,:,rrtmg_to_rrtmgp_swbands) + aer_tau_w(:,:,:) = aer_tau_w( :,:,rrtmg_to_rrtmgp_swbands) + aer_tau_w_g(:,:,:) = aer_tau_w_g(:,:,rrtmg_to_rrtmgp_swbands) - ! If there is an extra layer in the radiation then this initialization - ! will provide default values. - aer_sw%tau = 0.0_r8 - aer_sw%ssa = 1.0_r8 - aer_sw%g = 0.0_r8 - - ! CAM fields are products tau, tau*ssa, tau*ssa*asy - ! Fields expected by RRTMGP are computed by - ! aer_sw%tau = aer_tau - ! aer_sw%ssa = aer_tau_w / aer_tau - ! aer_sw%g = aer_tau_w_g / aer_taw_w - ! aer_sw arrays have dimensions of (nday,nlay,nswbands) + ! If there is an extra layer in the radiation then this initialization + ! will provide default values. + aer_sw%tau = 0.0_r8 + aer_sw%ssa = 1.0_r8 + aer_sw%g = 0.0_r8 + + ! CAM fields are products tau, tau*ssa, tau*ssa*asy + ! Fields expected by RRTMGP are computed by + ! aer_sw%tau = aer_tau + ! aer_sw%ssa = aer_tau_w / aer_tau + ! aer_sw%g = aer_tau_w_g / aer_taw_w + ! aer_sw arrays have dimensions of (nday,nlay,nswbands) + + do i = 1, nday + ! set aerosol optical depth, clip to zero + aer_sw%tau(i,ktoprad:,:) = max(aer_tau(idxday(i),ktopcam:,:), 0._r8) + ! set value of single scattering albedo + aer_sw%ssa(i,ktoprad:,:) = merge(aer_tau_w(idxday(i),ktopcam:,:)/aer_tau(idxday(i),ktopcam:,:), & + 1._r8, aer_tau(idxday(i),ktopcam:,:) > 0._r8) + ! set value of asymmetry + aer_sw%g(i,ktoprad:,:) = merge(aer_tau_w_g(idxday(i),ktopcam:,:)/aer_tau_w(idxday(i),ktopcam:,:), & + 0._r8, aer_tau_w(idxday(i),ktopcam:,:) > tiny) + end do - do i = 1, nday - ! set aerosol optical depth, clip to zero - aer_sw%tau(i,ktoprad:,:) = max(aer_tau(idxday(i),ktopcam:,:), 0._r8) - ! set value of single scattering albedo - aer_sw%ssa(i,ktoprad:,:) = merge(aer_tau_w(idxday(i),ktopcam:,:)/aer_tau(idxday(i),ktopcam:,:), & - 1._r8, aer_tau(idxday(i),ktopcam:,:) > 0._r8) - ! set value of asymmetry - aer_sw%g(i,ktoprad:,:) = merge(aer_tau_w_g(idxday(i),ktopcam:,:)/aer_tau_w(idxday(i),ktopcam:,:), & - 0._r8, aer_tau_w(idxday(i),ktopcam:,:) > tiny) - end do + ! impose limits on the components + aer_sw%ssa = min(max(aer_sw%ssa, 0._r8), 1._r8) + aer_sw%g = min(max(aer_sw%g, -1._r8), 1._r8) - ! impose limits on the components - aer_sw%ssa = min(max(aer_sw%ssa, 0._r8), 1._r8) - aer_sw%g = min(max(aer_sw%g, -1._r8), 1._r8) + end if end subroutine rrtmgp_set_aer_sw From 8f232dc6a5ba8cc9be7d7a0c0dede0cae1008162 Mon Sep 17 00:00:00 2001 From: Cheryl Craig Date: Tue, 26 Sep 2023 17:41:35 -0600 Subject: [PATCH 156/291] Remove ZM microphysics and cleanup for CCPP conversion --- Externals_CAM.cfg | 4 +- bld/build-namelist | 1 - bld/configure | 6 + bld/namelist_files/namelist_defaults_cam.xml | 1 - bld/namelist_files/namelist_definition.xml | 6 - src/physics/cam/clubb_intr.F90 | 1104 ++-- src/physics/cam/convect_shallow.F90 | 129 +- src/physics/cam/macrop_driver.F90 | 190 +- src/physics/cam/zm_conv.F90 | 4825 ------------------ src/physics/cam/zm_conv_intr.F90 | 623 +-- src/physics/cam/zm_microphysics.F90 | 2455 --------- src/physics/spcam/crmclouds_camaerosols.F90 | 12 +- 12 files changed, 739 insertions(+), 8617 deletions(-) delete mode 100644 src/physics/cam/zm_conv.F90 delete mode 100644 src/physics/cam/zm_microphysics.F90 diff --git a/Externals_CAM.cfg b/Externals_CAM.cfg index 7b246381a9..43a8228a0c 100644 --- a/Externals_CAM.cfg +++ b/Externals_CAM.cfg @@ -55,9 +55,9 @@ tag = ALI_ARMS_v1.0.0 required = True [atmos_phys] -tag = atmos_phys0_00_011 +tag = 7883a29d4c protocol = git -repo_url = https://github.com/NCAR/atmospheric_physics +repo_url = https://github.com/cacraigucar/atmospheric_physics required = True local_path = src/atmos_phys diff --git a/bld/build-namelist b/bld/build-namelist index efd42d4949..017f373ba1 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -3474,7 +3474,6 @@ if (!$simple_phys) { add_default($nl, 'zmconv_ke'); add_default($nl, 'zmconv_ke_lnd'); add_default($nl, 'zmconv_org'); - add_default($nl, 'zmconv_microp'); add_default($nl, 'zmconv_num_cin'); add_default($nl, 'zmconv_dmpdz'); add_default($nl, 'zmconv_tiedke_add'); diff --git a/bld/configure b/bld/configure index 262ac38e6d..a9bb065076 100755 --- a/bld/configure +++ b/bld/configure @@ -1802,6 +1802,9 @@ if ($usr_cppdefs and $print>=2) { print "Commandline CPP definitions: \'$usr_cpp # the CPP definitions that were explicitly set in the defaults file or by the user on the commandline. my $cfg_cppdefs = ' '; +# Turn on CCPP "OLD_CAM" +$cfg_cppdefs .= " -DOLD_CAM"; + # Building for perturbation growth tests if ($pergro eq "ON") { $cfg_cppdefs .= " -DPERGRO"; } @@ -2246,6 +2249,9 @@ sub write_filepath # in the list of filepaths. print $fh "$camsrcdir/src/physics/cam\n"; + #Add the CCPP'ized subdirectories + print $fh "$camsrcdir/src/atmos_phys/zm\n"; + # Dynamics package and test utilities print $fh "$camsrcdir/src/dynamics/$dyn\n"; if($dyn eq 'se') { diff --git a/bld/namelist_files/namelist_defaults_cam.xml b/bld/namelist_files/namelist_defaults_cam.xml index 6b583ff69d..fde4087686 100644 --- a/bld/namelist_files/namelist_defaults_cam.xml +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -2767,7 +2767,6 @@ .false. .true. - .false. 5 1 1 diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index 98364b80fe..1e27699dd2 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -3197,12 +3197,6 @@ if -zmconv_org is set in configure. Default: .false., unless -zmconv_org set in configure - -Turn on convective microphysics -Default: .false. - - The number of negative buoyancy regions that are allowed before the convection top and CAPE calculations are completed. diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index 07444cbfa3..c9f9a312a1 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -4,31 +4,30 @@ module clubb_intr ! Module to interface CAM with Cloud Layers Unified by Bi-normals (CLUBB), developed ! ! by the University of Wisconsin Milwaukee Group (UWM). ! ! ! - ! CLUBB replaces the exisiting turbulence, shallow convection, and macrophysics in CAM5 ! - ! ! + ! CLUBB replaces the exisiting turbulence, shallow convection, and macrophysics in CAM5 ! + ! ! ! Lastly, a implicit diffusion solver is called, and tendencies retrieved by ! ! differencing the diffused and initial states. ! - ! ! + ! ! ! Calling sequence: ! ! ! !---------------------------Code history-------------------------------------------------------------- ! - ! Authors: P. Bogenschutz, C. Craig, A. Gettelman ! - ! Modified by: K Thayer-Calder ! - ! ! + ! Authors: P. Bogenschutz, C. Craig, A. Gettelman ! + ! Modified by: K Thayer-Calder ! + ! ! !----------------------------------------------------------------------------------------------------- ! - use shr_kind_mod, only: r8=>shr_kind_r8 + use shr_kind_mod, only: r8=>shr_kind_r8 use ppgrid, only: pver, pverp, pcols, begchunk, endchunk use phys_control, only: phys_getopts use physconst, only: cpair, gravit, rga, latvap, latice, zvir, rh2o, karman use air_composition, only: rairv, cpairv use cam_history_support, only: max_fieldname_len - use spmd_utils, only: masterproc + use spmd_utils, only: masterproc use constituents, only: pcnst, cnst_add use pbl_utils, only: calc_ustar, calc_obklen - use ref_pres, only: top_lev => trop_cloud_top_lev - use zm_conv_intr, only: zmconv_microp + use ref_pres, only: top_lev => trop_cloud_top_lev #ifdef CLUBB_SGS use clubb_api_module, only: pdf_parameter, implicit_coefs_terms use clubb_api_module, only: clubb_config_flags_type, grid, stats, nu_vertical_res_dep @@ -46,7 +45,7 @@ module clubb_intr stats_rad_zt(pcols), & ! stats_rad_zt grid stats_rad_zm(pcols), & ! stats_rad_zm grid stats_sfc(pcols) ! stats_sfc - + !$omp threadprivate(stats_zt, stats_zm, stats_rad_zt, stats_rad_zm, stats_sfc) #endif @@ -64,7 +63,7 @@ module clubb_intr stats_init_clubb, & stats_zt, stats_zm, stats_sfc, & stats_rad_zt, stats_rad_zm, & - stats_end_timestep_clubb, & + stats_end_timestep_clubb, & #endif clubb_readnl, & clubb_init_cnst, & @@ -90,7 +89,7 @@ module clubb_intr integer, parameter :: & grid_type = 3, & ! The 2 option specifies stretched thermodynamic levels hydromet_dim = 0 ! The hydromet array in SAM-CLUBB is currently 0 elements - + ! Even though sclr_dim is set to 0, the dimension here is set to 1 to prevent compiler errors ! See github ticket larson-group/cam#133 for details real(r8), parameter, dimension(1) :: & @@ -102,28 +101,28 @@ module clubb_intr theta0 = 300._r8, & ! Reference temperature [K] ts_nudge = 86400._r8, & ! Time scale for u/v nudging (not used) [s] p0_clubb = 100000._r8 - - integer, parameter :: & + + integer, parameter :: & sclr_dim = 0 ! Higher-order scalars, set to zero real(r8), parameter :: & wp3_const = 1._r8 ! Constant to add to wp3 when moments are advected - - real(r8), parameter :: & + + real(r8), parameter :: & wpthlp_const = 10.0_r8 ! Constant to add to wpthlp when moments are advected - - real(r8), parameter :: & + + real(r8), parameter :: & wprtp_const = 0.01_r8 ! Constant to add to wprtp when moments are advected - - real(r8), parameter :: & + + real(r8), parameter :: & rtpthlp_const = 0.01_r8 ! Constant to add to rtpthlp when moments are advected - + real(r8), parameter :: unset_r8 = huge(1.0_r8) integer, parameter :: unset_i = huge(1) - ! Commonly used temperature for the melting temp of ice crystals [K] - real(r8), parameter :: meltpt_temp = 268.15_r8 - + ! Commonly used temperature for the melting temp of ice crystals [K] + real(r8), parameter :: meltpt_temp = 268.15_r8 + real(r8) :: clubb_timestep = unset_r8 ! Default CLUBB timestep, unless overwriten by namelist real(r8) :: clubb_rnevap_effic = unset_r8 @@ -179,7 +178,7 @@ module clubb_intr real(r8) :: clubb_detliq_rad = unset_r8 real(r8) :: clubb_detice_rad = unset_r8 real(r8) :: clubb_detphase_lowtemp = unset_r8 - + integer :: & clubb_iiPDF_type, & ! Selected option for the two-component normal ! (double Gaussian) PDF type to use for the w, rt, @@ -191,7 +190,7 @@ module clubb_intr clubb_tridiag_solve_method = unset_i ! Specifier for method to solve tri-diagonal systems - + logical :: & clubb_l_use_precip_frac, & ! Flag to use precipitation fraction in KK microphysics. The ! precipitation fraction is automatically set to 1 when this @@ -254,8 +253,8 @@ module clubb_intr ! that is linearized in terms of wp3. ! (Requires ADG1 PDF and clubb_l_standard_term_ta). clubb_l_godunov_upwind_wpxp_ta, & ! This flag determines whether we want to use an upwind - ! differencing approximation rather than a centered - ! differencing for turbulent advection terms. + ! differencing approximation rather than a centered + ! differencing for turbulent advection terms. ! It affects wpxp only. clubb_l_godunov_upwind_xpyp_ta, & ! This flag determines whether we want to use an upwind ! differencing approximation rather than a centered @@ -305,16 +304,16 @@ module clubb_intr clubb_l_mono_flux_lim_um, & ! Flag to turn on monotonic flux limiter for um clubb_l_mono_flux_lim_vm, & ! Flag to turn on monotonic flux limiter for vm clubb_l_mono_flux_lim_spikefix, & ! Flag to implement monotonic flux limiter code that - ! eliminates spurious drying tendencies at model top + ! eliminates spurious drying tendencies at model top clubb_l_intr_sfc_flux_smooth = .false. ! Add a locally calculated roughness to upwp and vpwp sfc fluxes ! Constant parameters logical, parameter, private :: & l_implemented = .true., & ! Implemented in a host model (always true) l_host_applies_sfc_fluxes = .false. ! Whether the host model applies the surface fluxes - + logical, parameter, private :: & - apply_to_heat = .false. ! Apply WACCM energy fixer to heat or not (.true. = yes (duh)) + apply_to_heat = .false. ! Apply WACCM energy fixer to heat or not (.true. = yes (duh)) logical :: lq(pcnst) logical :: prog_modal_aero @@ -326,8 +325,8 @@ module clubb_intr integer :: history_budget_histfile_num integer :: edsclr_dim ! Number of scalars to transport in CLUBB integer :: offset - -! define physics buffer indicies here + +! define physics buffer indicies here integer :: & wp2_idx, & ! vertical velocity variances wp3_idx, & ! third moment of vertical velocity @@ -386,8 +385,8 @@ module clubb_intr naai_idx, & ! ice number concentration prer_evap_idx, & ! rain evaporation rate qrl_idx, & ! longwave cooling rate - radf_idx, & - qsatfac_idx, & ! subgrid cloud water saturation scaling factor + radf_idx, & + qsatfac_idx, & ! subgrid cloud water saturation scaling factor ice_supersat_idx, & ! ice cloud fraction for SILHS rcm_idx, & ! Cloud water mixing ratio for SILHS ztodt_idx ! physics timestep for SILHS @@ -407,7 +406,7 @@ module clubb_intr pdf_zm_varnce_w_2_idx, & pdf_zm_mixt_frac_idx - integer, public :: & + integer, public :: & ixthlp2 = 0, & ixwpthlp = 0, & ixwprtp = 0, & @@ -426,7 +425,7 @@ module clubb_intr dnlfzm_idx = -1, & ! ZM detrained convective cloud water num concen. dnifzm_idx = -1 ! ZM detrained convective cloud ice num concen. - ! Output arrays for CLUBB statistics + ! Output arrays for CLUBB statistics real(r8), allocatable, dimension(:,:,:) :: out_zt, out_zm, out_radzt, out_radzm, out_sfc character(len=16) :: eddy_scheme ! Default set in phys_control.F90 @@ -440,14 +439,14 @@ module clubb_intr #ifdef CLUBB_SGS type(pdf_parameter), target, allocatable, public, protected :: & pdf_params_chnk(:) ! PDF parameters (thermo. levs.) [units vary] - + type(pdf_parameter), target, allocatable :: pdf_params_zm_chnk(:) ! PDF parameters on momentum levs. [units vary] - + type(implicit_coefs_terms), target, allocatable :: pdf_implicit_coefs_terms_chnk(:) ! PDF impl. coefs. & expl. terms [units vary] #endif contains - + ! =============================================================================== ! ! ! ! =============================================================================== ! @@ -466,12 +465,12 @@ subroutine clubb_register_cam( ) ! Register physics buffer fields and constituents ! !------------------------------------------------ ! - ! Add CLUBB fields to pbuf + ! Add CLUBB fields to pbuf use physics_buffer, only: pbuf_add_field, dtype_r8, dyn_time_lvls use subcol_utils, only: subcol_get_scheme - + call phys_getopts( eddy_scheme_out = eddy_scheme, & - deep_scheme_out = deep_scheme, & + deep_scheme_out = deep_scheme, & history_budget_out = history_budget, & history_budget_histfile_num_out = history_budget_histfile_num ) subcol_scheme = subcol_get_scheme() @@ -486,7 +485,7 @@ subroutine clubb_register_cam( ) cnst_names =(/'THLP2 ','RTP2 ','RTPTHLP','WPTHLP ','WPRTP ','WP2 ','WP3 ','UP2 ','VP2 '/) do_cnst=.true. ! If CLUBB moments are advected, do not output them automatically which is typically done. Some moments - ! need a constant added to them before they are advected, thus this would corrupt the output. + ! need a constant added to them before they are advected, thus this would corrupt the output. ! Users should refer to the "XXXX_CLUBB" (THLP2_CLUBB for instance) output variables for these moments call cnst_add(trim(cnst_names(1)),0._r8,0._r8,0._r8,ixthlp2,longname='second moment vertical velocity',cam_outfld=.false.) call cnst_add(trim(cnst_names(2)),0._r8,0._r8,0._r8,ixrtp2,longname='second moment rtp',cam_outfld=.false.) @@ -516,7 +515,7 @@ subroutine clubb_register_cam( ) call pbuf_add_field('CMELIQ', 'physpkg',dtype_r8, (/pcols,pver/), cmeliq_idx) call pbuf_add_field('QSATFAC', 'physpkg',dtype_r8, (/pcols,pver/), qsatfac_idx) - + call pbuf_add_field('WP2_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), wp2_idx) call pbuf_add_field('WP3_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), wp3_idx) call pbuf_add_field('WPTHLP_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), wpthlp_idx) @@ -525,7 +524,7 @@ subroutine clubb_register_cam( ) call pbuf_add_field('RTP2_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), rtp2_idx) call pbuf_add_field('THLP2_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), thlp2_idx) call pbuf_add_field('UP2_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), up2_idx) - call pbuf_add_field('VP2_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), vp2_idx) + call pbuf_add_field('VP2_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), vp2_idx) call pbuf_add_field('RTP3', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), rtp3_idx) call pbuf_add_field('THLP3', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), thlp3_idx) @@ -571,7 +570,7 @@ subroutine clubb_register_cam( ) call pbuf_add_field('pdf_zm_var_w_2', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), pdf_zm_varnce_w_2_idx) call pbuf_add_field('pdf_zm_mixt_frac', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), pdf_zm_mixt_frac_idx) -#endif +#endif end subroutine clubb_register_cam ! =============================================================================== ! @@ -595,14 +594,14 @@ function clubb_implements_cnst(name) end function clubb_implements_cnst - + ! =============================================================================== ! ! ! ! =============================================================================== ! subroutine clubb_init_cnst(name, latvals, lonvals, mask, q) #ifdef CLUBB_SGS - use clubb_api_module, only: w_tol_sqd, rt_tol, thl_tol + use clubb_api_module, only: w_tol_sqd, rt_tol, thl_tol #endif !----------------------------------------------------------------------- ! @@ -675,7 +674,7 @@ subroutine clubb_init_cnst(name, latvals, lonvals, mask, q) end subroutine clubb_init_cnst - + ! =============================================================================== ! ! ! ! =============================================================================== ! @@ -689,7 +688,7 @@ subroutine clubb_readnl(nlfile) use spmd_utils, only: mpicom, mstrid=>masterprocid, mpi_logical, mpi_real8, & mpi_integer use clubb_mf, only: clubb_mf_readnl - + use clubb_api_module, only: & set_default_clubb_config_flags_api, & ! Procedure(s) initialize_clubb_config_flags_type_api, & @@ -702,7 +701,7 @@ subroutine clubb_readnl(nlfile) character(len=*), parameter :: sub = 'clubb_readnl' - logical :: clubb_history = .false., clubb_rad_history = .false. ! Stats enabled (T/F) + logical :: clubb_history = .false., clubb_rad_history = .false. ! Stats enabled (T/F) logical :: clubb_cloudtop_cooling = .false., clubb_rainevap_turb = .false. integer :: iunit, read_status, ierr @@ -740,7 +739,7 @@ subroutine clubb_readnl(nlfile) clubb_C_invrs_tau_N2_wpxp, & clubb_C_invrs_tau_N2_xp2, & clubb_c_K1, & - clubb_c_K10, & + clubb_c_K10, & clubb_c_K10h, & clubb_c_K2, & clubb_c_K8, & @@ -806,16 +805,16 @@ subroutine clubb_readnl(nlfile) clubb_tridiag_solve_method, & clubb_up2_sfc_coef, & clubb_wpxp_L_thresh - + !----- Begin Code ----- - ! Determine if we want clubb_history to be output + ! Determine if we want clubb_history to be output clubb_history = .false. ! Initialize to false l_stats = .false. ! Initialize to false l_output_rad_files = .false. ! Initialize to false do_cldcool = .false. ! Initialize to false do_rainturb = .false. ! Initialize to false - + ! Initialize namelist variables to clubb defaults call set_default_clubb_config_flags_api( clubb_iiPDF_type, & ! Out clubb_ipdf_call_placement, & ! Out @@ -963,7 +962,7 @@ subroutine clubb_readnl(nlfile) call mpi_bcast(clubb_c_K10, 1, mpi_real8, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_c_K10") call mpi_bcast(clubb_c_K10h, 1, mpi_real8, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_c_K10h") + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_c_K10h") call mpi_bcast(clubb_beta, 1, mpi_real8, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_beta") call mpi_bcast(clubb_C2rt, 1, mpi_real8, mstrid, mpicom, ierr) @@ -1011,21 +1010,21 @@ subroutine clubb_readnl(nlfile) call mpi_bcast(clubb_do_energyfix, 1, mpi_logical, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_do_energyfix") call mpi_bcast(clubb_C_invrs_tau_bkgnd, 1, mpi_real8, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C_invrs_tau_bkgnd") + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C_invrs_tau_bkgnd") call mpi_bcast(clubb_C_invrs_tau_sfc, 1, mpi_real8, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C_invrs_tau_sfc") + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C_invrs_tau_sfc") call mpi_bcast(clubb_C_invrs_tau_shear, 1, mpi_real8, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C_invrs_tau_shear") + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C_invrs_tau_shear") call mpi_bcast(clubb_C_invrs_tau_N2, 1, mpi_real8, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C_invrs_tau_N2") + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C_invrs_tau_N2") call mpi_bcast(clubb_C_invrs_tau_N2_wp2, 1, mpi_real8, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C_invrs_tau_N2_wp2") + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C_invrs_tau_N2_wp2") call mpi_bcast(clubb_C_invrs_tau_N2_xp2, 1, mpi_real8, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C_invrs_tau_N2_xp2") + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C_invrs_tau_N2_xp2") call mpi_bcast(clubb_C_invrs_tau_N2_wpxp, 1, mpi_real8, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C_invrs_tau_N2_wpxp") + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C_invrs_tau_N2_wpxp") call mpi_bcast(clubb_C_invrs_tau_N2_clear_wp3, 1, mpi_real8, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C_invrs_tau_N2_clear_wp3") + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C_invrs_tau_N2_clear_wp3") call mpi_bcast(clubb_lmin_coef, 1, mpi_real8, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_lmin_coef") call mpi_bcast(clubb_skw_max_mag, 1, mpi_real8, mstrid, mpicom, ierr) @@ -1124,10 +1123,10 @@ subroutine clubb_readnl(nlfile) ! Overwrite defaults if they are true if (clubb_history) l_stats = .true. - if (clubb_rad_history) l_output_rad_files = .true. + if (clubb_rad_history) l_output_rad_files = .true. if (clubb_cloudtop_cooling) do_cldcool = .true. if (clubb_rainevap_turb) do_rainturb = .true. - + ! Check that all namelists have been set if(clubb_timestep == unset_r8) call endrun(sub//": FATAL: clubb_timestep is not set") if(clubb_rnevap_effic == unset_r8) call endrun(sub//": FATAL:clubb_rnevap_effic is not set") @@ -1187,7 +1186,7 @@ subroutine clubb_readnl(nlfile) if(clubb_detphase_lowtemp == unset_r8) call endrun(sub//": FATAL: clubb_detphase_lowtemp not set") if(clubb_penta_solve_method == unset_i) call endrun(sub//": FATAL: clubb_penta_solve_method not set") if(clubb_tridiag_solve_method == unset_i) call endrun(sub//": FATAL: clubb_tridiag_solve_method not set") - if(clubb_detphase_lowtemp >= meltpt_temp) & + if(clubb_detphase_lowtemp >= meltpt_temp) & call endrun(sub//": ERROR: clubb_detphase_lowtemp must be less than 268.15 K") call initialize_clubb_config_flags_type_api( clubb_iiPDF_type, & ! In @@ -1237,7 +1236,7 @@ subroutine clubb_readnl(nlfile) clubb_l_e3sm_config, & ! In clubb_l_vary_convect_depth, & ! In clubb_l_use_tke_in_wp3_pr_turb_term, & ! In - clubb_l_use_tke_in_wp2_wp3_K_dfsn, & ! In + clubb_l_use_tke_in_wp2_wp3_K_dfsn, & ! In clubb_l_smooth_Heaviside_tau_wpxp, & ! In clubb_l_enable_relaxed_clipping, & ! In clubb_l_linearize_pbl_winds, & ! In @@ -1332,7 +1331,7 @@ subroutine clubb_ini_cam(pbuf2d) #ifdef CLUBB_SGS real(kind=time_precision) :: dum1, dum2, dum3 - + ! The similar name to clubb_history is unfortunate... logical :: history_amwg, history_clubb @@ -1387,10 +1386,10 @@ subroutine clubb_ini_cam(pbuf2d) pdf_implicit_coefs_terms_chnk(begchunk:endchunk) ) ! ----------------------------------------------------------------- ! - ! Determine how many constituents CLUBB will transport. Note that - ! CLUBB does not transport aerosol consituents. Therefore, need to + ! Determine how many constituents CLUBB will transport. Note that + ! CLUBB does not transport aerosol consituents. Therefore, need to ! determine how many aerosols constituents there are and subtract that - ! off of pcnst (the total consituents) + ! off of pcnst (the total consituents) ! ----------------------------------------------------------------- ! call phys_getopts(prog_modal_aero_out=prog_modal_aero, & @@ -1398,7 +1397,7 @@ subroutine clubb_ini_cam(pbuf2d) history_clubb_out=history_clubb) ! Select variables to apply tendencies back to CAM - + ! Initialize all consituents to true to start lq(1:pcnst) = .true. edsclr_dim = pcnst @@ -1412,12 +1411,12 @@ subroutine clubb_ini_cam(pbuf2d) 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. 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) @@ -1425,7 +1424,7 @@ subroutine clubb_ini_cam(pbuf2d) 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. @@ -1449,7 +1448,7 @@ subroutine clubb_ini_cam(pbuf2d) l_stats_samp = .false. l_grads = .false. - ! Overwrite defaults if needbe + ! Overwrite defaults if needbe if (l_stats) l_stats_samp = .true. ! Define physics buffers indexes @@ -1458,7 +1457,7 @@ subroutine clubb_ini_cam(pbuf2d) ast_idx = pbuf_get_index('AST') ! Stratiform cloud fraction alst_idx = pbuf_get_index('ALST') ! Liquid stratiform cloud fraction aist_idx = pbuf_get_index('AIST') ! Ice stratiform cloud fraction - qlst_idx = pbuf_get_index('QLST') ! Physical in-stratus LWC + qlst_idx = pbuf_get_index('QLST') ! Physical in-stratus LWC qist_idx = pbuf_get_index('QIST') ! Physical in-stratus IWC dp_frac_idx = pbuf_get_index('DP_FRAC') ! Deep convection cloud fraction icwmrdp_idx = pbuf_get_index('ICWMRDP') ! In-cloud deep convective mixing ratio @@ -1480,26 +1479,19 @@ subroutine clubb_ini_cam(pbuf2d) iiedsclr_thl = -1 iiedsclr_CO2 = -1 - if (zmconv_microp) then - dlfzm_idx = pbuf_get_index('DLFZM') - difzm_idx = pbuf_get_index('DIFZM') - dnlfzm_idx = pbuf_get_index('DNLFZM') - dnifzm_idx = pbuf_get_index('DNIFZM') - end if - ! ----------------------------------------------------------------- ! ! Define number of tracers for CLUBB to diffuse - ! ----------------------------------------------------------------- ! - + ! ----------------------------------------------------------------- ! + if (clubb_l_do_expldiff_rtm_thlm) then offset = 2 ! diffuse temperature and moisture explicitly - edsclr_dim = edsclr_dim + offset + edsclr_dim = edsclr_dim + offset endif - + ! ----------------------------------------------------------------- ! ! Setup CLUBB core ! ----------------------------------------------------------------- ! - + ! Read in parameters for CLUBB. Just read in default values call set_default_parameters_api( & C1, C1b, C1c, C2rt, C2thl, C2rtthl, & @@ -1603,7 +1595,7 @@ subroutine clubb_ini_cam(pbuf2d) clubb_params(iC_invrs_tau_N2_xp2) = clubb_C_invrs_tau_N2_xp2 clubb_params(iC_invrs_tau_N2_wpxp) = clubb_C_invrs_tau_N2_wpxp clubb_params(iC_invrs_tau_N2_clear_wp3) = clubb_C_invrs_tau_N2_clear_wp3 - + ! Set up CLUBB core. Note that some of these inputs are overwritten ! when clubb_tend_cam is called. The reason is that heights can change ! at each time step, which is why dummy arrays are read in here for heights @@ -1650,12 +1642,12 @@ subroutine clubb_ini_cam(pbuf2d) ! ----------------------------------------------------------------- ! ! Initialize eddy diffusivity module - + ntop_eddy = 1 ! if >1, must be <= nbot_molec nbot_eddy = pver ! currently always pver - + call init_hb_diff( gravit, cpair, ntop_eddy, nbot_eddy, pref_mid, karman, eddy_scheme ) - + ! ----------------------------------------------------------------- ! ! Add output fields for the history files ! ----------------------------------------------------------------- ! @@ -1683,7 +1675,7 @@ subroutine clubb_ini_cam(pbuf2d) call addfld ('WPRCP_CLUBB', (/ 'ilev' /), 'A', 'W/m2', 'Liquid Water Flux') call addfld ('CLOUDFRAC_CLUBB', (/ 'lev' /), 'A', 'fraction', 'Cloud Fraction') call addfld ('RCMINLAYER_CLUBB', (/ 'lev' /), 'A', 'kg/kg', 'Cloud Water in Layer') - call addfld ('CLOUDCOVER_CLUBB', (/ 'lev' /), 'A', 'fraction', 'Cloud Cover') + call addfld ('CLOUDCOVER_CLUBB', (/ 'lev' /), 'A', 'fraction', 'Cloud Cover') call addfld ('WPTHVP_CLUBB', (/ 'ilev' /), 'A', 'W/m2', 'Buoyancy Flux') call addfld ('RVMTEND_CLUBB', (/ 'lev' /), 'A', 'kg/kg /s', 'Water vapor tendency') call addfld ('STEND_CLUBB', (/ 'lev' /), 'A', 'J/(kg s)', 'Static energy tendency') @@ -1692,7 +1684,7 @@ subroutine clubb_ini_cam(pbuf2d) call addfld ('UTEND_CLUBB', (/ 'lev' /), 'A', 'm/s /s', 'U-wind Tendency') call addfld ('VTEND_CLUBB', (/ 'lev' /), 'A', 'm/s /s', 'V-wind Tendency') call addfld ('ZT_CLUBB', (/ 'lev' /), 'A', 'm', 'Thermodynamic Heights') - call addfld ('ZM_CLUBB', (/ 'ilev' /), 'A', 'm', 'Momentum Heights') + call addfld ('ZM_CLUBB', (/ 'ilev' /), 'A', 'm', 'Momentum Heights') call addfld ('UM_CLUBB', (/ 'lev' /), 'A', 'm/s', 'Zonal Wind') call addfld ('VM_CLUBB', (/ 'lev' /), 'A', 'm/s', 'Meridional Wind') call addfld ('WM_ZT_CLUBB', (/ 'lev' /), 'A', 'm/s', 'Vertical Velocity') @@ -1710,8 +1702,8 @@ subroutine clubb_ini_cam(pbuf2d) call addfld ('FQTENDICE', (/ 'lev' /), 'A', 'fraction', 'Frequency of Ice Saturation Adjustment') call addfld ('DPDLFLIQ', (/ 'lev' /), 'A', 'kg/kg/s', 'Detrained liquid water from deep convection') - call addfld ('DPDLFICE', (/ 'lev' /), 'A', 'kg/kg/s', 'Detrained ice from deep convection') - call addfld ('DPDLFT', (/ 'lev' /), 'A', 'K/s', 'T-tendency due to deep convective detrainment') + call addfld ('DPDLFICE', (/ 'lev' /), 'A', 'kg/kg/s', 'Detrained ice from deep convection') + call addfld ('DPDLFT', (/ 'lev' /), 'A', 'K/s', 'T-tendency due to deep convective detrainment') call addfld ('RELVAR', (/ 'lev' /), 'A', '-', 'Relative cloud water variance') call addfld ('CLUBB_GRID_SIZE', horiz_only, 'A', 'm', 'Horizontal grid box size seen by CLUBB') @@ -1751,7 +1743,7 @@ subroutine clubb_ini_cam(pbuf2d) call addfld ( 'edmf_S_AWV' , (/ 'ilev' /), 'A', 'm2/s2' , 'Sum of a_i*w_i*v_i (EDMF)' ) call addfld ( 'edmf_thlflx' , (/ 'ilev' /), 'A', 'W/m2' , 'thl flux (EDMF)' ) call addfld ( 'edmf_qtflx' , (/ 'ilev' /), 'A', 'W/m2' , 'qt flux (EDMF)' ) - end if + end if ! Initialize statistics, below are dummy variables dum1 = 300._r8 @@ -1759,13 +1751,13 @@ subroutine clubb_ini_cam(pbuf2d) dum3 = 300._r8 if (l_stats) then - + do i=1, pcols call stats_init_clubb( .true., dum1, dum2, & nlev+1, nlev+1, nlev+1, dum3, & stats_zt(i), stats_zm(i), stats_sfc(i), & stats_rad_zt(i), stats_rad_zm(i)) - end do + end do allocate(out_zt(pcols,pverp,stats_zt(1)%num_output_fields)) allocate(out_zm(pcols,pverp,stats_zm(1)%num_output_fields)) @@ -1775,12 +1767,12 @@ subroutine clubb_ini_cam(pbuf2d) allocate(out_radzm(pcols,pverp,stats_rad_zm(1)%num_output_fields)) endif - + ! ----------------------------------------------------------------- ! ! Make all of this output default, this is not CLUBB history ! ----------------------------------------------------------------- ! - - if (clubb_do_adv .or. history_clubb) then + + if (clubb_do_adv .or. history_clubb) then call add_default('RELVAR', 1, ' ') call add_default('RHO_CLUBB', 1, ' ') call add_default('UP2_CLUBB', 1, ' ') @@ -1813,14 +1805,14 @@ subroutine clubb_ini_cam(pbuf2d) call add_default('UTEND_CLUBB', 1, ' ') call add_default('VTEND_CLUBB', 1, ' ') call add_default('ZT_CLUBB', 1, ' ') - call add_default('ZM_CLUBB', 1, ' ') + call add_default('ZM_CLUBB', 1, ' ') call add_default('UM_CLUBB', 1, ' ') call add_default('VM_CLUBB', 1, ' ') call add_default('WM_ZT_CLUBB', 1, ' ') call add_default('PBLH', 1, ' ') call add_default('CONCLD', 1, ' ') endif - + if (history_amwg) then call add_default('PBLH', 1, ' ') end if @@ -1849,10 +1841,10 @@ subroutine clubb_ini_cam(pbuf2d) call add_default( 'edmf_qtflx' , 1, ' ') end if - if (history_budget) then + if (history_budget) then call add_default('DPDLFLIQ', history_budget_histfile_num, ' ') call add_default('DPDLFICE', history_budget_histfile_num, ' ') - call add_default('DPDLFT', history_budget_histfile_num, ' ') + call add_default('DPDLFT', history_budget_histfile_num, ' ') call add_default('STEND_CLUBB', history_budget_histfile_num, ' ') call add_default('RCMTEND_CLUBB', history_budget_histfile_num, ' ') call add_default('RIMTEND_CLUBB', history_budget_histfile_num, ' ') @@ -1860,7 +1852,7 @@ subroutine clubb_ini_cam(pbuf2d) call add_default('UTEND_CLUBB', history_budget_histfile_num, ' ') call add_default('VTEND_CLUBB', history_budget_histfile_num, ' ') endif - + ! --------------- ! ! First step? ! @@ -1879,12 +1871,12 @@ subroutine clubb_ini_cam(pbuf2d) call pbuf_set_field(pbuf2d, thlp2_idx, thl_tol**2) call pbuf_set_field(pbuf2d, up2_idx, w_tol_sqd) call pbuf_set_field(pbuf2d, vp2_idx, w_tol_sqd) - + call pbuf_set_field(pbuf2d, rtp3_idx, 0.0_r8) call pbuf_set_field(pbuf2d, thlp3_idx, 0.0_r8) call pbuf_set_field(pbuf2d, up3_idx, 0.0_r8) call pbuf_set_field(pbuf2d, vp3_idx, 0.0_r8) - + call pbuf_set_field(pbuf2d, upwp_idx, 0.0_r8) call pbuf_set_field(pbuf2d, vpwp_idx, 0.0_r8) call pbuf_set_field(pbuf2d, wpthvp_idx, 0.0_r8) @@ -1922,10 +1914,10 @@ subroutine clubb_ini_cam(pbuf2d) call pbuf_set_field(pbuf2d, pdf_zm_mixt_frac_idx, 0.0_r8) endif - + ! The following is physpkg, so it needs to be initialized every time call pbuf_set_field(pbuf2d, fice_idx, 0.0_r8) - + ! --------------- ! ! End ! ! Initialization ! @@ -1933,19 +1925,19 @@ subroutine clubb_ini_cam(pbuf2d) #endif end subroutine clubb_ini_cam - - + + ! =============================================================================== ! ! ! ! =============================================================================== ! subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & - cmfmc, cam_in, & + cmfmc, cam_in, & macmic_it, cld_macmic_num_steps,dlf, det_s, det_ice) !------------------------------------------------------------------------------- - ! Description: Provide tendencies of shallow convection, turbulence, and + ! Description: Provide tendencies of shallow convection, turbulence, and ! macrophysics from CLUBB to CAM - ! + ! ! Author: Cheryl Craig, March 2011 ! Modifications: Pete Bogenschutz, March 2011 and onward ! Origin: Based heavily on UWM clubb_init.F90 @@ -1961,12 +1953,12 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & use constituents, only: cnst_get_ind, cnst_type use camsrfexch, only: cam_in_t - use time_manager, only: is_first_step + use time_manager, only: is_first_step use cam_abortutils, only: endrun use cam_logfile, only: iulog use tropopause, only: tropopause_findChemTrop use time_manager, only: get_nstep, is_first_restart_step - + #ifdef CLUBB_SGS use hb_diff, only: pblintd use scamMOD, only: single_column,scm_clubb_iop_name @@ -2005,13 +1997,13 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & use macrop_driver, only: liquid_macro_tend use clubb_mf, only: integrate_mf - + use perf_mod #endif implicit none - + ! ---------------------------------------------------- ! ! Input Auguments ! ! ---------------------------------------------------- ! @@ -2023,11 +2015,11 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & real(r8), intent(in) :: cmfmc(pcols,pverp) ! convective mass flux--m sub c [kg/m2/s] integer, intent(in) :: cld_macmic_num_steps ! number of mac-mic iterations integer, intent(in) :: macmic_it ! number of mac-mic iterations - + ! ---------------------------------------------------- ! ! Input-Output Auguments ! ! ---------------------------------------------------- ! - + type(physics_buffer_desc), pointer :: pbuf(:) ! ---------------------------------------------------- ! @@ -2036,11 +2028,11 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & type(physics_ptend), intent(out) :: ptend_all ! package tendencies - ! These two variables are needed for energy check + ! These two variables are needed for energy check real(r8), intent(out) :: det_s(pcols) ! Integral of detrained static energy from ice real(r8), intent(out) :: det_ice(pcols) ! Integral of detrained ice for energy check - + ! ---------------------------------------------------- ! ! Local Variables ! ! ---------------------------------------------------- ! @@ -2049,26 +2041,26 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & type(physics_state) :: state1 ! Local copy of state variable type(physics_ptend) :: ptend_loc ! Local tendency from processes, added up to return as ptend_all - + integer :: i, j, k, t, ixind, nadv integer :: ixcldice, ixcldliq, ixnumliq, ixnumice, ixq integer :: itim_old integer :: ncol, lchnk ! # of columns, and chunk identifier integer :: err_code ! Diagnostic, for if some calculation goes amiss. - integer :: icnt + integer :: icnt logical :: lq2(pcnst) integer :: iter - + integer :: clubbtop(pcols) - + real(r8) :: frac_limit, ic_limit - real(r8) :: dtime ! CLUBB time step [s] - real(r8) :: zt_out(pcols,pverp) ! output for the thermo CLUBB grid [m] + real(r8) :: dtime ! CLUBB time step [s] + real(r8) :: zt_out(pcols,pverp) ! output for the thermo CLUBB grid [m] real(r8) :: zi_out(pcols,pverp) ! output for momentum CLUBB grid [m] real(r8) :: ubar ! surface wind [m/s] - real(r8) :: ustar ! surface stress [m/s] + real(r8) :: ustar ! surface stress [m/s] real(r8) :: z0 ! roughness height [m] real(r8) :: bflx22(pcols) ! Variable for buoyancy flux for pbl [K m/s] real(r8) :: qclvar(pcols,pverp) ! cloud water variance [kg^2/kg^2] @@ -2088,7 +2080,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & upwp_sfc_pert, & ! perturbed u'w' at surface [m^2/s^2] vpwp_sfc_pert, & ! perturbed v'w' at surface [m^2/s^2] grid_dx, grid_dy ! CAM grid [m] - + real(r8), dimension(state%ncol,sclr_dim) :: & wpsclrp_sfc ! Scalar flux at surface [{units vary} m/s] @@ -2099,7 +2091,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! NOTE: THESE VARIABLS SHOULD NOT BE USED IN PBUF OR OUTFLD (HISTORY) SUBROUTINES real(r8), dimension(state%ncol,pverp+1-top_lev) :: & thlm_forcing, & ! theta_l forcing (thermodynamic levels) [K/s] - rtm_forcing, & ! r_t forcing (thermodynamic levels) [(kg/kg)/s] + rtm_forcing, & ! r_t forcing (thermodynamic levels) [(kg/kg)/s] um_forcing, & ! u wind forcing (thermodynamic levels) [m/s/s] vm_forcing, & ! v wind forcing (thermodynamic levels) [m/s/s] wprtp_forcing, & @@ -2174,7 +2166,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & rcm_in_layer_out, & ! CLUBB output of in-cloud liq. wat. mix. ratio [kg/kg] cloud_cover_out, & ! CLUBB output of in-cloud cloud fraction [fraction] invrs_tau_zm_out, & ! CLUBB output of 1 divided by time-scale [1/s] - rtp2_mc_out, & ! total water tendency from rain evap + rtp2_mc_out, & ! total water tendency from rain evap thlp2_mc_out, & ! thetal tendency from rain evap wprtp_mc_out, & wpthlp_mc_out, & @@ -2205,7 +2197,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & sclrprtp, & ! sclr'rt' (momentum levels) [{units vary} (kg/kg)] sclrpthlp, & ! sclr'thlp' (momentum levels) [{units vary} (K)] wpsclrp ! w'sclr' (momentum levels) [{units vary} m/s] - + real(r8), dimension(state%ncol,pverp,sclr_dim) :: & sclrpthvp_inout ! sclr'th_v' (momentum levels) [{units vary} (K)] @@ -2250,7 +2242,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & real(r8) :: pdfp_rtp2(pcols, pverp) ! Calculated R-tot variance from pdf_params [kg^2/kg^2] real(r8) :: rtp2_zt_out(pcols, pverp) ! CLUBB R-tot variance on thermo levs [kg^2/kg^2] real(r8) :: thl2_zt_out(pcols, pverp) ! CLUBB Theta-l variance on thermo levs - real(r8) :: wp2_zt_out(pcols, pverp) + real(r8) :: wp2_zt_out(pcols, pverp) real(r8) :: dlf_liq_out(pcols, pverp) ! Detrained liquid water from ZM [kg/kg/s] real(r8) :: dlf_ice_out(pcols, pverp) ! Detrained ice water from ZM [kg/kg/s] real(r8) :: wm_zt_out(pcols, pverp) ! CLUBB mean W on thermo levs output [m/s] @@ -2280,7 +2272,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! ---------------------------------------------------- ! ! Pointers ! ! ---------------------------------------------------- ! - + real(r8), pointer, dimension(:,:) :: wp2 ! vertical velocity variance [m^2/s^2] real(r8), pointer, dimension(:,:) :: wp3 ! third moment of vertical velocity [m^3/s^3] real(r8), pointer, dimension(:,:) :: wpthlp ! turbulent flux of thetal [m/s K] @@ -2330,16 +2322,16 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & real(r8), pointer, dimension(:,:) :: qlst ! Physical in-stratus LWC [kg/kg] real(r8), pointer, dimension(:,:) :: qist ! Physical in-stratus IWC [kg/kg] real(r8), pointer, dimension(:,:) :: deepcu ! deep convection cloud fraction [fraction] - real(r8), pointer, dimension(:,:) :: shalcu ! shallow convection cloud fraction [fraction] + real(r8), pointer, dimension(:,:) :: shalcu ! shallow convection cloud fraction [fraction] real(r8), pointer, dimension(:,:) :: khzm ! CLUBB's eddy diffusivity of heat/moisture on momentum (i.e. interface) levels [m^2/s] real(r8), pointer, dimension(:) :: pblh ! planetary boundary layer height [m] real(r8), pointer, dimension(:,:) :: tke ! turbulent kinetic energy [m^2/s^2] real(r8), pointer, dimension(:,:) :: dp_icwmr ! deep convection in cloud mixing ratio [kg/kg] - real(r8), pointer, dimension(:,:) :: ice_supersat_frac ! Cloud fraction of ice clouds (pverp)[fraction] + real(r8), pointer, dimension(:,:) :: ice_supersat_frac ! Cloud fraction of ice clouds (pverp)[fraction] real(r8), pointer, dimension(:,:) :: relvar ! relative cloud water variance [-] real(r8), pointer, dimension(:,:) :: accre_enhan ! accretion enhancement factor [-] real(r8), pointer, dimension(:,:) :: naai - real(r8), pointer, dimension(:,:) :: cmeliq + real(r8), pointer, dimension(:,:) :: cmeliq real(r8), pointer, dimension(:,:) :: cmfmc_sh ! Shallow convective mass flux--m subc (pcols,pverp) [kg/m2/s/] real(r8), pointer, dimension(:,:) :: qsatfac @@ -2421,13 +2413,13 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & intrinsic :: max character(len=*), parameter :: subr='clubb_tend_cam' - + type(grid) :: gr integer :: begin_height, end_height - + type(nu_vertical_res_dep) :: nu_vert_res_dep ! Vertical resolution dependent nu values real(r8) :: lmin - + #endif det_s(:) = 0.0_r8 det_ice(:) = 0.0_r8 @@ -2448,7 +2440,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & pdfp_rtp2 = 0._r8 wm_zt_out = 0._r8 - temp2d = 0._r8 + temp2d = 0._r8 temp2dp = 0._r8 dl_rad = clubb_detliq_rad @@ -2459,7 +2451,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ic_limit = 1.e-12_r8 inv_rh2o = 1._r8/rh2o - if (clubb_do_adv) then + if (clubb_do_adv) then apply_const = 1._r8 ! Initialize to one, only if CLUBB's moments are advected else apply_const = 0._r8 ! Never want this if CLUBB's moments are not advected @@ -2496,7 +2488,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Determine time step of physics buffer itim_old = pbuf_old_tim_idx() - ! Establish associations between pointers and physics buffer fields + ! Establish associations between pointers and physics buffer fields call pbuf_get_field(pbuf, wp2_idx, wp2, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) call pbuf_get_field(pbuf, wp3_idx, wp3, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) call pbuf_get_field(pbuf, wpthlp_idx, wpthlp, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) @@ -2541,7 +2533,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call pbuf_get_field(pbuf, rtm_idx, rtm, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) call pbuf_get_field(pbuf, um_idx, um, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) call pbuf_get_field(pbuf, vm_idx, vm, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - + call pbuf_get_field(pbuf, tke_idx, tke) call pbuf_get_field(pbuf, qrl_idx, qrl) call pbuf_get_field(pbuf, radf_idx, radf_clubb) @@ -2575,13 +2567,13 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call pbuf_get_field(pbuf, wprtp_mc_zt_idx, wprtp_mc_zt) call pbuf_get_field(pbuf, wpthlp_mc_zt_idx, wpthlp_mc_zt) call pbuf_get_field(pbuf, rtpthlp_mc_zt_idx, rtpthlp_mc_zt) - + ! Allocate pdf_params only if they aren't allocated already. if ( .not. allocated(pdf_params_chnk(lchnk)%mixt_frac) ) then call init_pdf_params_api( pverp+1-top_lev, ncol, pdf_params_chnk(lchnk) ) call init_pdf_params_api( pverp+1-top_lev, ncol, pdf_params_zm_chnk(lchnk) ) end if - + if ( .not. allocated(pdf_implicit_coefs_terms_chnk(lchnk)%coef_wp4_implicit) ) then call init_pdf_implicit_coefs_terms_api( pverp+1-top_lev, ncol, sclr_dim, & pdf_implicit_coefs_terms_chnk(lchnk) ) @@ -2589,15 +2581,15 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Initialize the apply_const variable (note special logic is due to eularian backstepping) if (clubb_do_adv .and. (is_first_step() .or. all(wpthlp(1:ncol,1:pver) == 0._r8))) then - apply_const = 0._r8 ! On first time through do not remove constant - ! from moments since it has not been added yet + apply_const = 0._r8 ! On first time through do not remove constant + ! from moments since it has not been added yet endif ! Set the ztodt timestep in pbuf for SILHS ztodtptr(:) = 1.0_r8*hdtime ! Define the grid box size. CLUBB needs this information to determine what - ! the maximum length scale should be. This depends on the column for + ! the maximum length scale should be. This depends on the column for ! variable mesh grids and lat-lon grids if (single_column) then ! If single column specify grid box size to be something @@ -2605,7 +2597,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & grid_dx(:) = 100000._r8 grid_dy(:) = 100000._r8 else - + call grid_size(state1, grid_dx, grid_dy) end if @@ -2620,11 +2612,11 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & lq2(1) = .TRUE. lq2(ixcldice) = .TRUE. lq2(ixnumice) = .TRUE. - + latsub = latvap + latice - + call physics_ptend_init(ptend_loc, state%psetcols, 'iceadj', ls=.true., lq=lq2 ) - + stend(:ncol,:)=0._r8 qvtend(:ncol,:)=0._r8 qitend(:ncol,:)=0._r8 @@ -2638,9 +2630,9 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! update local copy of state with the tendencies ptend_loc%q(:ncol,top_lev:pver,1)=qvtend(:ncol,top_lev:pver) - ptend_loc%q(:ncol,top_lev:pver,ixcldice)=qitend(:ncol,top_lev:pver) + ptend_loc%q(:ncol,top_lev:pver,ixcldice)=qitend(:ncol,top_lev:pver) ptend_loc%q(:ncol,top_lev:pver,ixnumice)=initend(:ncol,top_lev:pver) - ptend_loc%s(:ncol,top_lev:pver)=stend(:ncol,top_lev:pver) + ptend_loc%s(:ncol,top_lev:pver)=stend(:ncol,top_lev:pver) ! Add the ice tendency to the output tendency call physics_ptend_sum(ptend_loc, ptend_all, ncol) @@ -2654,56 +2646,56 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call outfld( 'QVTENDICE', qvtend, pcols, lchnk ) call outfld( 'QITENDICE', qitend, pcols, lchnk ) call outfld( 'NITENDICE', initend, pcols, lchnk ) - + endif ! Determine CLUBB time step and make it sub-step friendly - ! For now we want CLUBB time step to be 5 min since that is + ! For now we want CLUBB time step to be 5 min since that is ! what has been scientifically validated. However, there are certain - ! instances when a 5 min time step will not be possible (based on + ! instances when a 5 min time step will not be possible (based on ! host model time step or on macro-micro sub-stepping - dtime = clubb_timestep - - ! Now check to see if dtime is greater than the host model - ! (or sub stepped) time step. If it is, then simply - ! set it equal to the host (or sub step) time step. + dtime = clubb_timestep + + ! Now check to see if dtime is greater than the host model + ! (or sub stepped) time step. If it is, then simply + ! set it equal to the host (or sub step) time step. ! This section is mostly to deal with small host model - ! time steps (or small sub-steps) + ! time steps (or small sub-steps) if (dtime > hdtime) then dtime = hdtime endif - + ! Now check to see if CLUBB time step divides evenly into ! the host model time step. If not, force it to divide evenly. ! We also want it to be 5 minutes or less. This section is ! mainly for host model time steps that are not evenly divisible - ! by 5 minutes + ! by 5 minutes if (mod(hdtime,dtime) .ne. 0) then dtime = hdtime/2._r8 - do while (dtime > clubb_timestep) + do while (dtime > clubb_timestep) dtime = dtime/2._r8 end do - endif + endif ! If resulting host model time step and CLUBB time step do not divide evenly - ! into each other, have model throw a fit. + ! into each other, have model throw a fit. if (mod(hdtime,dtime) .ne. 0) then call endrun(subr//': CLUBB time step and HOST time step NOT compatible') endif - - ! determine number of timesteps CLUBB core should be advanced, - ! host time step divided by CLUBB time step + + ! determine number of timesteps CLUBB core should be advanced, + ! host time step divided by CLUBB time step nadv = max(hdtime/dtime,1._r8) - - ! Initialize forcings for transported scalars to zero + + ! Initialize forcings for transported scalars to zero sclrm_forcing(:,:,:) = 0._r8 edsclrm_forcing(:,:,:) = 0._r8 sclrm(:,:,:) = 0._r8 - + ! Compute inverse exner function consistent with CLUBB's definition, which uses a constant - ! surface pressure. CAM's exner (in state) does not. Therefore, for consistent - ! treatment with CLUBB code, anytime exner is needed to treat CLUBB variables + ! surface pressure. CAM's exner (in state) does not. Therefore, for consistent + ! treatment with CLUBB code, anytime exner is needed to treat CLUBB variables ! (such as thlm), use "inv_exner_clubb" otherwise use the exner in state do k=1,pver do i=1,ncol @@ -2717,8 +2709,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & inv_exner_clubb_surf(i) = 1._r8/((state1%pmid(i,pver)/p0_clubb)**(rairv(i,pver,lchnk)/cpairv(i,pver,lchnk))) enddo - ! At each CLUBB call, initialize mean momentum and thermo CLUBB state - ! from the CAM state + ! At each CLUBB call, initialize mean momentum and thermo CLUBB state + ! from the CAM state do k=1,pver ! loop over levels do i=1,ncol ! loop over columns @@ -2731,11 +2723,11 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & * inv_exner_clubb(i,k) if (clubb_do_adv) then - if (macmic_it == 1) then + if (macmic_it == 1) then - ! Note that some of the moments below can be positive or negative. - ! Remove a constant that was added to prevent dynamics from clipping - ! them to prevent dynamics from making them positive. + ! Note that some of the moments below can be positive or negative. + ! Remove a constant that was added to prevent dynamics from clipping + ! them to prevent dynamics from making them positive. thlp2(i,k) = state1%q(i,k,ixthlp2) rtp2(i,k) = state1%q(i,k,ixrtp2) rtpthlp(i,k) = state1%q(i,k,ixrtpthlp) - (rtpthlp_const*apply_const) @@ -2750,23 +2742,23 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & enddo enddo - + if (clubb_do_adv) then - ! If not last step of macmic loop then set apply_const back to - ! zero to prevent output from being corrupted. - if (macmic_it == cld_macmic_num_steps) then - apply_const = 1._r8 + ! If not last step of macmic loop then set apply_const back to + ! zero to prevent output from being corrupted. + if (macmic_it == cld_macmic_num_steps) then + apply_const = 1._r8 else apply_const = 0._r8 endif - endif + endif rtm(1:ncol,pverp) = rtm(1:ncol,pver) um(1:ncol,pverp) = state1%u(1:ncol,pver) vm(1:ncol,pverp) = state1%v(1:ncol,pver) thlm(1:ncol,pverp) = thlm(1:ncol,pver) - - if (clubb_do_adv) then + + if (clubb_do_adv) then thlp2(1:ncol,pverp) = thlp2(1:ncol,pver) rtp2(1:ncol,pverp) = rtp2(1:ncol,pver) rtpthlp(1:ncol,pverp) = rtpthlp(1:ncol,pver) @@ -2778,7 +2770,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & vp2(1:ncol,pverp) = vp2(1:ncol,pver) endif - ! Compute virtual potential temperature, which is needed for CLUBB + ! Compute virtual potential temperature, which is needed for CLUBB do k=1,pver do i=1,ncol thv(i,k) = state1%t(i,k)*inv_exner_clubb(i,k)*(1._r8+zvir*state1%q(i,k,ixq)& @@ -2816,24 +2808,24 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & mf_thlflx_output(:,:) = 0._r8 mf_qtflx_output(:,:) = 0._r8 end if - + call t_startf("clubb_tend_cam_i_loop") ! Determine Coriolis force at given latitude. This is never used ! when CLUBB is implemented in a host model, therefore just set ! to zero. - fcor(:) = 0._r8 + fcor(:) = 0._r8 ! Define the CLUBB momentum grid (in height, units of m) do k=1, nlev+1 - do i=1, ncol + do i=1, ncol zi_g(i,k) = state1%zi(i,pverp-k+1)-state1%zi(i,pver+1) - end do + end do end do ! Define the CLUBB thermodynamic grid (in units of m) do k=1, nlev - do i=1, ncol + do i=1, ncol zt_g(i,k+1) = state1%zm(i,pver-k+1)-state1%zi(i,pver+1) end do end do @@ -2843,18 +2835,18 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & dz_g(i,k) = state1%zi(i,k)-state1%zi(i,k+1) ! compute thickness end do end do - - ! Thermodynamic ghost point is below surface + + ! Thermodynamic ghost point is below surface do i=1, ncol zt_g(i,1) = -1._r8*zt_g(i,2) end do - + do i=1, ncol ! Set the elevation of the surface sfc_elevation(i) = state1%zi(i,pver+1) end do - ! Compute thermodynamic stuff needed for CLUBB on thermo levels. + ! Compute thermodynamic stuff needed for CLUBB on thermo levels. ! Inputs for the momentum levels are set below setup_clubb core do k=1,nlev do i=1, ncol @@ -2863,7 +2855,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & invrs_rho_ds_zt(i,k+1) = 1._r8/(rho_ds_zt(i,k+1)) ! full state (moist) variables - p_in_Pa(i,k+1) = state1%pmid(i,pver-k+1) + p_in_Pa(i,k+1) = state1%pmid(i,pver-k+1) exner(i,k+1) = 1._r8/inv_exner_clubb(i,pver-k+1) thv(i,k+1) = state1%t(i,pver-k+1)*inv_exner_clubb(i,pver-k+1)*(1._r8+zvir*state1%q(i,pver-k+1,ixq) & -state1%q(i,pver-k+1,ixcldliq)) @@ -2872,13 +2864,13 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! exception - setting this to moist thv thv_ds_zt(i,k+1) = thv(i,k+1) - rfrzm(i,k+1) = state1%q(i,pver-k+1,ixcldice) + rfrzm(i,k+1) = state1%q(i,pver-k+1,ixcldice) radf(i,k+1) = radf_clubb(i,pver-k+1) qrl_clubb(i,k+1) = qrl(i,pver-k+1)/(cpairv(i,k,lchnk)*state1%pdeldry(i,pver-k+1)) end do end do - - ! Compute mean w wind on thermo grid, convert from omega to w + + ! Compute mean w wind on thermo grid, convert from omega to w do k=1,nlev do i=1,ncol wm_zt(i,k+1) = -1._r8*(state1%omega(i,pver-k+1)-state1%omega(i,pver))/(rho_zt(i,k+1)*gravit) @@ -2900,8 +2892,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & qrl_clubb(i,1) = qrl_clubb(i,2) wm_zt(i,1) = wm_zt(i,2) end do - - + + ! ------------------------------------------------- ! ! Begin case specific code for SCAM cases. ! ! This section of code block is NOT called in ! @@ -2919,21 +2911,21 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Compute surface wind (ubar) ubar = sqrt(um(1,pver)**2+vm(1,pver)**2) if (ubar < 0.25_r8) ubar = 0.25_r8 - + ! Below denotes case specifics for surface momentum ! and thermodynamic fluxes, depending on the case - ! Define ustar (based on case, if not variable) + ! Define ustar (based on case, if not variable) ustar = 0.25_r8 ! Initialize ustar in case no case - + if(trim(scm_clubb_iop_name) == 'BOMEX_5day') then ustar = 0.28_r8 endif - + if(trim(scm_clubb_iop_name) == 'ATEX_48hr') then ustar = 0.30_r8 endif - + if(trim(scm_clubb_iop_name) == 'RICO_3day') then ustar = 0.28_r8 endif @@ -2941,23 +2933,23 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & if(trim(scm_clubb_iop_name) == 'arm97' .or. trim(scm_clubb_iop_name) == 'gate' .or. & trim(scm_clubb_iop_name) == 'toga' .or. trim(scm_clubb_iop_name) == 'mpace' .or. & trim(scm_clubb_iop_name) == 'ARM_CC') then - + bflx22(1) = (gravit/theta0)*wpthlp_sfc(1) - ustar = diag_ustar(zt_g(1,2),bflx22(1),ubar,zo(1)) + ustar = diag_ustar(zt_g(1,2),bflx22(1),ubar,zo(1)) endif - - ! Compute the surface momentum fluxes, if this is a SCAM simulation + + ! Compute the surface momentum fluxes, if this is a SCAM simulation upwp_sfc(1) = -um(1,pver)*ustar**2/ubar vpwp_sfc(1) = -vm(1,pver)*ustar**2/ubar - + end if - ! Define surface sources for transported variables for diffusion, will + ! Define surface sources for transported variables for diffusion, will ! be zero as these tendencies are done in vertical_diffusion do ixind=1,edsclr_dim do i=1,ncol wpedsclrp_sfc(i,ixind) = 0._r8 - end do + end do end do ! Set stats output and increment equal to CLUBB and host dt @@ -2966,10 +2958,10 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & stats_nsamp = nint(stats_tsamp/dtime) stats_nout = nint(stats_tout/dtime) - - ! Heights need to be set at each timestep. Therefore, recall - ! setup_grid and setup_parameters for this. - + + ! Heights need to be set at each timestep. Therefore, recall + ! setup_grid and setup_parameters for this. + ! Set-up CLUBB core at each CLUBB call because heights can change ! Important note: do not make any calls that use CLUBB grid-height ! operators (such as zt2zm_api, etc.) until AFTER the @@ -3002,7 +2994,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & vm_ref(:,:) = 0.0_r8 ug(:,:) = 0.0_r8 vg(:,:) = 0.0_r8 - + ! Add forcings for SILHS covariance contributions rtp2_forcing = zt2zm_api( pverp+1-top_lev, ncol, gr, rtp2_mc_zt(1:ncol,:) ) thlp2_forcing = zt2zm_api( pverp+1-top_lev, ncol, gr, thlp2_mc_zt(1:ncol,:) ) @@ -3016,7 +3008,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & wprtp_mc_zt(:,:) = 0.0_r8 wpthlp_mc_zt(:,:) = 0.0_r8 rtpthlp_mc_zt(:,:) = 0.0_r8 - + ! Compute some inputs from the thermodynamic grid ! to the momentum grid @@ -3025,9 +3017,9 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & invrs_rho_ds_zm = zt2zm_api( pverp+1-top_lev, ncol, gr, invrs_rho_ds_zt ) thv_ds_zm = zt2zm_api( pverp+1-top_lev, ncol, gr, thv_ds_zt ) wm_zm = zt2zm_api( pverp+1-top_lev, ncol, gr, wm_zt ) - + ! Surface fluxes provided by host model - do i=1,ncol + do i=1,ncol wpthlp_sfc(i) = cam_in%shf(i)/(cpairv(i,pver,lchnk)*rho_ds_zm(i,1)) ! Sensible heat flux wpthlp_sfc(i) = wpthlp_sfc(i)*inv_exner_clubb_surf(i) ! Potential temperature flux wprtp_sfc(i) = cam_in%cflx(i,1)/rho_ds_zm(i,1) ! Moisture flux @@ -3043,7 +3035,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call calc_ustar( state1%t(i,pver), state1%pmid(i,pver), cam_in%wsx(i), cam_in%wsy(i), & rrho(i), ustar ) - + upwp_sfc(i) = -state1%u(i,pver)*ustar**2/ubar vpwp_sfc(i) = -state1%v(i,pver)*ustar**2/ubar end do @@ -3057,12 +3049,12 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Perturbed winds are not used in CAM upwp_sfc_pert = 0.0_r8 vpwp_sfc_pert = 0.0_r8 - + ! Need to flip arrays around for CLUBB core do k=1,nlev+1 do i=1,ncol - um_in(i,k) = um(i,pverp-k+1) - vm_in(i,k) = vm(i,pverp-k+1) + um_in(i,k) = um(i,pverp-k+1) + vm_in(i,k) = vm(i,pverp-k+1) upwp_in(i,k) = upwp(i,pverp-k+1) vpwp_in(i,k) = vpwp(i,pverp-k+1) wpthvp_in(i,k) = wpthvp(i,pverp-k+1) @@ -3121,13 +3113,13 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & vm_pert_inout = 0.0_r8 upwp_pert_inout = 0.0_r8 vpwp_pert_inout = 0.0_r8 - + do k=2,nlev+1 do i=1,ncol pre_in(i,k) = prer_evap(i,pverp-k+1) end do end do - + do i=1,ncol pre_in(i,1) = pre_in(i,2) end do @@ -3135,7 +3127,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do i=1,ncol rcm_inout(i,1) = rcm_inout(i,2) end do - + ! Initialize these to prevent crashing behavior do k=1,nlev+1 do i=1,ncol @@ -3162,7 +3154,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do end do end do - + do ixind=1, hydromet_dim do k=1, nlev+1 do i=1, ncol @@ -3177,7 +3169,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! pressure,exner on momentum grid needed for mass flux calc. if (do_clubb_mf) then - + do k=1,pver do i=1,ncol kappa_zt(i,k+1) = (rairv(i,pver-k+1,lchnk)/cpairv(i,pver-k+1,lchnk)) @@ -3185,7 +3177,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & invrs_exner_zt(i,k+1) = inv_exner_clubb(i,pver-k+1) end do end do - + do i=1,ncol kappa_zt(i,1) = kappa_zt(i,2) qc_zt(i,1) = qc_zt(i,2) @@ -3193,21 +3185,21 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do kappa_zm(1:ncol,:) = zt2zm_api(pverp+1-top_lev, ncol, gr, kappa_zt(1:ncol,:)) - + do k=1,pverp do i=1,ncol p_in_Pa_zm(i,k) = state1%pint(i,pverp-k+1) invrs_exner_zm(i,k) = 1._r8/((p_in_Pa_zm(i,k)/p0_clubb)**(kappa_zm(i,k))) end do end do - + end if - - + + if (clubb_do_adv) then if (macmic_it == 1) then - - wp2_in = zt2zm_api(pverp+1-top_lev, ncol, gr, wp2_in ) + + wp2_in = zt2zm_api(pverp+1-top_lev, ncol, gr, wp2_in ) wpthlp_in = zt2zm_api(pverp+1-top_lev, ncol, gr, wpthlp_in ) wprtp_in = zt2zm_api(pverp+1-top_lev, ncol, gr, wprtp_in ) up2_in = zt2zm_api(pverp+1-top_lev, ncol, gr, up2_in ) @@ -3225,49 +3217,49 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & vp2_in(i,k) = max(w_tol_sqd,vp2_in(i,k)) end do end do - + end if end if - ! Do the same for tracers + ! Do the same for tracers icnt=0 do ixind=1,pcnst - if (lq(ixind)) then - + if (lq(ixind)) then + icnt = icnt+1 - + do k=1,nlev do i=1,ncol edsclr_in(i,k+1,icnt) = state1%q(i,pver-k+1,ixind) end do end do - + do i=1,ncol edsclr_in(i,1,icnt) = edsclr_in(i,2,icnt) end do - + end if end do - - if (clubb_l_do_expldiff_rtm_thlm) then + + if (clubb_l_do_expldiff_rtm_thlm) then do k=1,nlev do i=1, ncol edsclr_in(i,k+1,icnt+1) = thlm(i,pver-k+1) edsclr_in(i,k+1,icnt+2) = rtm(i,pver-k+1) end do end do - + do i=1, ncol edsclr_in(i,1,icnt+1) = edsclr_in(i,2,icnt+1) - edsclr_in(i,1,icnt+2) = edsclr_in(i,2,icnt+2) + edsclr_in(i,1,icnt+2) = edsclr_in(i,2,icnt+2) end do - + endif do t=1,nadv ! do needed number of "sub" timesteps for each CAM step - + ! Increment the statistics then being stats timestep if (l_stats) then call stats_begin_timestep_api(t, stats_nsamp, stats_nout) @@ -3277,18 +3269,18 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !###################### CALL MF DIAGNOSTIC PLUMES ###################### !####################################################################### if (do_clubb_mf) then - + do k=2,pverp do i=1, ncol dzt(i,k) = zi_g(i,k) - zi_g(i,k-1) end do end do - + do i=1, ncol dzt(i,1) = dzt(i,2) invrs_dzt(i,:) = 1._r8/dzt(i,:) end do - + rtm_zm_in(1:ncol,:) = zt2zm_api( pverp+1-top_lev, ncol, gr, rtm_in(1:ncol,:) ) thlm_zm_in(1:ncol,:) = zt2zm_api( pverp+1-top_lev, ncol, gr, thlm_in(1:ncol,:) ) @@ -3317,19 +3309,19 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & rtm_forcing(i,1) = 0._r8 thlm_forcing(i,1)= 0._r8 end do - + do k=2,pverp do i=1, ncol rtm_forcing(i,k) = rtm_forcing(i,k) - invrs_rho_ds_zt(i,k) * invrs_dzt(i,k) * & ((rho_ds_zm(i,k) * mf_qtflx(i,k)) - (rho_ds_zm(i,k-1) * mf_qtflx(i,k-1))) - + thlm_forcing(i,k) = thlm_forcing(i,k) - invrs_rho_ds_zt(i,k) * invrs_dzt(i,k) * & ((rho_ds_zm(i,k) * mf_thlflx(i,k)) - (rho_ds_zm(i,k-1) * mf_thlflx(i,k-1))) end do end do end if - + ! Advance CLUBB CORE one timestep in the future call advance_clubb_core_api( gr, pverp+1-top_lev, ncol, & l_implemented, dtime, fcor, sfc_elevation, hydromet_dim, & @@ -3371,7 +3363,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & wprcp_out, w_up_in_cloud_out, w_down_in_cloud_out, & cloudy_updraft_frac_out, cloudy_downdraft_frac_out, & rcm_in_layer_out, cloud_cover_out, invrs_tau_zm_out ) - + ! Note that CLUBB does not produce an error code specific to any column, and ! one value only for the entire chunk if ( err_code == clubb_fatal_error ) then @@ -3380,15 +3372,15 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & write(fstderr,*) "LON: Range:", state1%lon(1), " -- ", state1%lon(ncol) call endrun(subr//': Fatal error in CLUBB library') end if - + if (do_rainturb) then - + do k=1,nlev+1 do i=1,ncol - rvm_in(i,k) = rtm_in(i,k) - rcm_inout(i,k) + rvm_in(i,k) = rtm_in(i,k) - rcm_inout(i,k) end do end do - + call update_xp2_mc_api( gr, nlev+1, ncol, dtime, cloud_frac_inout, & rcm_inout, rvm_in, thlm_in, wm_zt, & exner, pre_in, pdf_params_chnk(lchnk), & @@ -3400,35 +3392,35 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do i=1,ncol dum1 = (1._r8 - cam_in%landfrac(i)) - ! update turbulent moments based on rain evaporation + ! update turbulent moments based on rain evaporation rtp2_in(i,k) = rtp2_in(i,k) + clubb_rnevap_effic * dum1 * rtp2_mc_out(i,k) * dtime - thlp2_in(i,k) = thlp2_in(i,k) + clubb_rnevap_effic * dum1 * thlp2_mc_out(i,k) * dtime + thlp2_in(i,k) = thlp2_in(i,k) + clubb_rnevap_effic * dum1 * thlp2_mc_out(i,k) * dtime wprtp_in(i,k) = wprtp_in(i,k) + clubb_rnevap_effic * dum1 * wprtp_mc_out(i,k) * dtime wpthlp_in(i,k) = wpthlp_in(i,k) + clubb_rnevap_effic * dum1 * wpthlp_mc_out(i,k) * dtime end do end do - - end if - + + end if + if (do_cldcool) then - + rcm_out_zm = zt2zm_api(pverp+1-top_lev, ncol, gr, rcm_inout ) qrl_zm = zt2zm_api(pverp+1-top_lev, ncol, gr, qrl_clubb ) thlp2_rad_out(:,:) = 0._r8 - + do i=1, ncol call calculate_thlp2_rad_api(nlev+1, rcm_out_zm(i,:), thlprcp_out(i,:), qrl_zm(i,:), clubb_params, & thlp2_rad_out(i,:)) end do - + do i=1, ncol thlp2_in(i,:) = thlp2_in(i,:) + thlp2_rad_out(i,:) * dtime thlp2_in(i,:) = max(thl_tol**2,thlp2_in(i,:)) end do - + end if - + ! Check to see if stats should be output, here stats are read into ! output arrays to make them conformable to CAM output if (l_stats) then @@ -3441,16 +3433,16 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & enddo ! end time loop if (clubb_do_adv) then - if (macmic_it == cld_macmic_num_steps) then - - wp2_in = zm2zt_api( pverp+1-top_lev, ncol, gr, wp2_in ) + if (macmic_it == cld_macmic_num_steps) then + + wp2_in = zm2zt_api( pverp+1-top_lev, ncol, gr, wp2_in ) wpthlp_in = zm2zt_api( pverp+1-top_lev, ncol, gr, wpthlp_in ) wprtp_in = zm2zt_api( pverp+1-top_lev, ncol, gr, wprtp_in ) up2_in = zm2zt_api( pverp+1-top_lev, ncol, gr, up2_in ) vp2_in = zm2zt_api( pverp+1-top_lev, ncol, gr, vp2_in ) thlp2_in = zm2zt_api( pverp+1-top_lev, ncol, gr, thlp2_in ) rtp2_in = zm2zt_api( pverp+1-top_lev, ncol, gr, rtp2_in ) - rtpthlp_in = zm2zt_api( pverp+1-top_lev, ncol, gr, rtpthlp_in ) + rtpthlp_in = zm2zt_api( pverp+1-top_lev, ncol, gr, rtpthlp_in ) do k=1,nlev+1 do i=1, ncol @@ -3461,16 +3453,16 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & vp2_in(i,k) = max(w_tol_sqd, vp2_in(i,k)) end do end do - + end if end if - + ! Convert RTP2 and THLP2 to thermo grid for output rtp2_zt = zm2zt_api( pverp+1-top_lev, ncol, gr, rtp2_in ) thl2_zt = zm2zt_api( pverp+1-top_lev, ncol, gr, thlp2_in ) wp2_zt = zm2zt_api( pverp+1-top_lev, ncol, gr, wp2_in ) - ! Arrays need to be "flipped" to CAM grid + ! Arrays need to be "flipped" to CAM grid do k=1, nlev+1 do i=1, ncol um(i,pverp-k+1) = um_in(i,k) @@ -3526,18 +3518,18 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & rtp2_zt_out(i,pverp-k+1) = rtp2_zt(i,k) thl2_zt_out(i,pverp-k+1) = thl2_zt(i,k) wp2_zt_out(i,pverp-k+1) = wp2_zt(i,k) - + end do end do do k=1, nlev+1 do i=1, ncol - + mean_rt = pdf_params_chnk(lchnk)%mixt_frac(i,k) & * pdf_params_chnk(lchnk)%rt_1(i,k) & + ( 1.0_r8 - pdf_params_chnk(lchnk)%mixt_frac(i,k) ) & * pdf_params_chnk(lchnk)%rt_2(i,k) - + pdfp_rtp2(i,pverp-k+1) = pdf_params_chnk(lchnk)%mixt_frac(i,k) & * ( ( pdf_params_chnk(lchnk)%rt_1(i,k) - mean_rt )**2 & + pdf_params_chnk(lchnk)%varnce_rt_1(i,k) ) & @@ -3603,18 +3595,18 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & khzm(i,k) = 0._r8 qclvar(i,k) = 2._r8 end do - end do + end do ! enforce zero tracer tendencies above the top_lev level -- no change icnt=0 do ixind=1,pcnst - if (lq(ixind)) then + if (lq(ixind)) then icnt=icnt+1 - + do i=1, ncol edsclr_out(i,:top_lev-1,icnt) = state1%q(i,:top_lev-1,ixind) end do - + end if end do @@ -3632,7 +3624,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do ! Section below is concentrated on energy fixing for conservation. - ! because CLUBB and CAM's thermodynamic variables are different. + ! because CLUBB and CAM's thermodynamic variables are different. ! Initialize clubbtop to top_lev, for finding the highlest level CLUBB is ! active for informing where to apply the energy fixer. @@ -3640,16 +3632,16 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & clubbtop(i) = top_lev do while ((rtp2(i,clubbtop(i)) <= 1.e-15_r8 .and. rcm(i,clubbtop(i)) == 0._r8) .and. clubbtop(i) < pver) clubbtop(i) = clubbtop(i) + 1 - end do + end do end do - + ! Compute integrals for static energy, kinetic energy, water vapor, and liquid water ! after CLUBB is called. This is for energy conservation purposes. se_a(:) = 0._r8 ke_a(:) = 0._r8 wv_a(:) = 0._r8 wl_a(:) = 0._r8 - + do k=1,pver do i=1, ncol se_a(i) = se_a(i) + clubb_s(i,k)*state1%pdel(i,k)*rga @@ -3657,14 +3649,14 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & wv_a(i) = wv_a(i) + (rtm(i,k)-rcm(i,k))*state1%pdeldry(i,k)*rga wl_a(i) = wl_a(i) + (rcm(i,k))*state1%pdeldry(i,k)*rga end do - end do - + end do + ! Do the same as above, but for before CLUBB was called. se_b(:) = 0._r8 ke_b(:) = 0._r8 wv_b(:) = 0._r8 - wl_b(:) = 0._r8 - + wl_b(:) = 0._r8 + do k=1, pver do i=1, ncol se_b(i) = se_b(i) + state1%s(i,k)*state1%pdel(i,k)*rga @@ -3673,23 +3665,23 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & wl_b(i) = wl_b(i) + state1%q(i,k,ixcldliq)*state1%pdeldry(i,k)*rga end do end do - - + + do i=1, ncol ! Based on these integrals, compute the total energy before and after CLUBB call te_a(i) = se_a(i) + ke_a(i) + (latvap+latice) * wv_a(i) + latice * wl_a(i) te_b(i) = se_b(i) + ke_b(i) + (latvap+latice) * wv_b(i) + latice * wl_b(i) - + ! Take into account the surface fluxes of heat and moisture ! Use correct qflux from cam_in, not lhf/latvap as was done previously - te_b(i) = te_b(i) + (cam_in%shf(i)+cam_in%cflx(i,1)*(latvap+latice)) * hdtime + te_b(i) = te_b(i) + (cam_in%shf(i)+cam_in%cflx(i,1)*(latvap+latice)) * hdtime ! Compute the disbalance of total energy, over depth where CLUBB is active se_dis(i) = (te_a(i) - te_b(i))/(state1%pint(i,pverp)-state1%pint(i,clubbtop(i))) end do ! Fix the total energy coming out of CLUBB so it achieves energy conservation. - ! Apply this fixer throughout the column evenly, but only at layers where + ! Apply this fixer throughout the column evenly, but only at layers where ! CLUBB is active. ! ! NOTE: The energy fixer seems to cause the climate to change significantly @@ -3705,7 +3697,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do endif - + ! Now compute the tendencies of CLUBB to CAM, note that pverp is the ghost point ! for all variables and therefore is never called in this loop do k=1, pver @@ -3719,17 +3711,17 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do end do - - + + if (clubb_do_adv) then if (macmic_it == cld_macmic_num_steps) then - + do k=1, pver do i=1, ncol - ! Here add a constant to moments which can be either positive or + ! Here add a constant to moments which can be either positive or ! negative. This is to prevent clipping when dynamics tries to - ! make all constituents positive + ! make all constituents positive wp3(i,k) = wp3(i,k) + wp3_const rtpthlp(i,k) = rtpthlp(i,k) + rtpthlp_const wpthlp(i,k) = wpthlp(i,k) + wpthlp_const @@ -3738,18 +3730,18 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ptend_loc%q(i,k,ixthlp2) = (thlp2(i,k) - state1%q(i,k,ixthlp2)) / hdtime ! THLP Variance ptend_loc%q(i,k,ixrtp2) = (rtp2(i,k) - state1%q(i,k,ixrtp2)) / hdtime ! RTP Variance ptend_loc%q(i,k,ixrtpthlp) = (rtpthlp(i,k) - state1%q(i,k,ixrtpthlp)) / hdtime ! RTP THLP covariance - ptend_loc%q(i,k,ixwpthlp) = (wpthlp(i,k) - state1%q(i,k,ixwpthlp)) / hdtime ! WPTHLP + ptend_loc%q(i,k,ixwpthlp) = (wpthlp(i,k) - state1%q(i,k,ixwpthlp)) / hdtime ! WPTHLP ptend_loc%q(i,k,ixwprtp) = (wprtp(i,k) - state1%q(i,k,ixwprtp)) / hdtime ! WPRTP ptend_loc%q(i,k,ixwp2) = (wp2(i,k) - state1%q(i,k,ixwp2)) / hdtime ! WP2 ptend_loc%q(i,k,ixwp3) = (wp3(i,k) - state1%q(i,k,ixwp3)) / hdtime ! WP3 ptend_loc%q(i,k,ixup2) = (up2(i,k) - state1%q(i,k,ixup2)) / hdtime ! UP2 ptend_loc%q(i,k,ixvp2) = (vp2(i,k) - state1%q(i,k,ixvp2)) / hdtime ! VP2 - + end do end do - + else - + do k=1, pver do i=1, ncol ptend_loc%q(i,k,ixthlp2) = 0._r8 @@ -3760,16 +3752,16 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ptend_loc%q(i,k,ixwp2) = 0._r8 ptend_loc%q(i,k,ixwp3) = 0._r8 ptend_loc%q(i,k,ixup2) = 0._r8 - ptend_loc%q(i,k,ixvp2) = 0._r8 + ptend_loc%q(i,k,ixvp2) = 0._r8 end do end do - + end if end if - + ! Apply tendencies to ice mixing ratio, liquid and ice number, and aerosol constituents. - ! Loading up this array doesn't mean the tendencies are applied. + ! Loading up this array doesn't mean the tendencies are applied. ! edsclr_out is compressed with just the constituents being used, ptend and state are not compressed icnt=0 do ixind=1,pcnst @@ -3780,17 +3772,17 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & (ixind /= ixrtpthlp) .and. (ixind /= ixwpthlp) .and.& (ixind /= ixwprtp) .and. (ixind /= ixwp2) .and.& (ixind /= ixwp3) .and. (ixind /= ixup2) .and. (ixind /= ixvp2) ) then - + do k=1, pver do i=1, ncol - ptend_loc%q(i,k,ixind) = (edsclr_out(i,k,icnt)-state1%q(i,k,ixind))/hdtime ! transported constituents + ptend_loc%q(i,k,ixind) = (edsclr_out(i,k,icnt)-state1%q(i,k,ixind))/hdtime ! transported constituents end do end do - + end if end if end do - + call t_stopf("clubb_tend_cam_i_loop") call outfld('KVH_CLUBB', khzm, pcols, lchnk) @@ -3799,7 +3791,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call outfld('ELEAK_CLUBB', eleak, pcols, lchnk) call outfld('TFIX_CLUBB', se_dis, pcols, lchnk) - ! Add constant to ghost point so that output is not corrupted + ! Add constant to ghost point so that output is not corrupted if (clubb_do_adv) then if (macmic_it == cld_macmic_num_steps) then wp3(:,pverp) = wp3(:,pverp) + wp3_const @@ -3807,7 +3799,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & wpthlp(:,pverp) = wpthlp(:,pverp) + wpthlp_const wprtp(:,pverp) = wprtp(:,pverp) + wprtp_const end if - end if + end if ! ------------------------------------------------- ! ! End column computation of CLUBB, begin to apply ! @@ -3833,32 +3825,32 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call physics_ptend_sum(ptend_loc,ptend_all,ncol) call physics_update(state1,ptend_loc,hdtime) - - ! Due to the order of operation of CLUBB, which closes on liquid first, - ! then advances it's predictive equations second, this can lead to - ! RHliq > 1 directly before microphysics is called. Therefore, we use - ! ice_macro_tend to enforce RHliq <= 1 everywhere before microphysics is called. - + + ! Due to the order of operation of CLUBB, which closes on liquid first, + ! then advances it's predictive equations second, this can lead to + ! RHliq > 1 directly before microphysics is called. Therefore, we use + ! ice_macro_tend to enforce RHliq <= 1 everywhere before microphysics is called. + if (clubb_do_liqsupersat) then - + ! -------------------------------------- ! ! Ice Saturation Adjustment Computation ! ! -------------------------------------- ! - + latsub = latvap + latice lq2(:) = .FALSE. lq2(ixq) = .TRUE. lq2(ixcldliq) = .TRUE. lq2(ixnumliq) = .TRUE. - + call physics_ptend_init(ptend_loc, state%psetcols, 'iceadj', ls=.true., lq=lq2 ) - + stend(:ncol,:)=0._r8 qvtend(:ncol,:)=0._r8 qctend(:ncol,:)=0._r8 inctend(:ncol,:)=0._r8 - + call liquid_macro_tend(npccn(1:ncol,top_lev:pver), state1%t(1:ncol,top_lev:pver), & state1%pmid(1:ncol,top_lev:pver), state1%q(1:ncol,top_lev:pver,ixq), & state1%q(1:ncol,top_lev:pver,ixcldliq), state1%q(1:ncol,top_lev:pver,ixnumliq), & @@ -3870,13 +3862,13 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ptend_loc%q(:ncol,top_lev:pver,ixcldliq)=qctend(:ncol,top_lev:pver) ptend_loc%q(:ncol,top_lev:pver,ixnumliq)=inctend(:ncol,top_lev:pver) ptend_loc%s(:ncol,top_lev:pver)=stend(:ncol,top_lev:pver) - + ! Add the ice tendency to the output tendency call physics_ptend_sum(ptend_loc, ptend_all, ncol) - + ! ptend_loc is reset to zero by this call call physics_update(state1, ptend_loc, hdtime) - + ! Write output for tendencies: ! oufld: QVTENDICE,QCTENDICE,NCTENDICE,FQTENDICE temp2d(:ncol,:pver) = stend(:ncol,:pver)/cpairv(:ncol,:pver,lchnk) @@ -3884,25 +3876,25 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call outfld( 'QVTENDICE', qvtend, pcols, lchnk ) call outfld( 'QCTENDICE', qctend, pcols, lchnk ) call outfld( 'NCTENDICE', inctend, pcols, lchnk ) - + where(qctend .ne. 0._r8) fqtend = 1._r8 elsewhere fqtend = 0._r8 end where - + call outfld( 'FQTENDICE', fqtend, pcols, lchnk ) end if - + ! ------------------------------------------------------------ ! ! The rest of the code deals with diagnosing variables ! ! for microphysics/radiation computation and macrophysics ! ! ------------------------------------------------------------ ! - - ! --------------------------------------------------------------------------------- ! + + ! --------------------------------------------------------------------------------- ! ! COMPUTE THE ICE CLOUD DETRAINMENT ! ! Detrainment of convective condensate into the environment or stratiform cloud ! - ! --------------------------------------------------------------------------------- ! + ! --------------------------------------------------------------------------------- ! ! Initialize the shallow convective detrainment rate, will always be zero dlf2(:,:) = 0.0_r8 @@ -3917,13 +3909,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call physics_ptend_init(ptend_loc,state%psetcols, 'clubb', ls=.true., lq=lqice) - if (zmconv_microp) then - call pbuf_get_field(pbuf, dlfzm_idx, dlfzm) - call pbuf_get_field(pbuf, difzm_idx, difzm) - call pbuf_get_field(pbuf, dnlfzm_idx, dnlfzm) - call pbuf_get_field(pbuf, dnifzm_idx, dnifzm) - end if - do k=1,pver do i=1,ncol if( state1%t(i,k) > meltpt_temp ) then @@ -3931,35 +3916,24 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & elseif ( state1%t(i,k) < dt_low ) then dum1 = 1.0_r8 else - dum1 = ( meltpt_temp - state1%t(i,k) ) / ( meltpt_temp - dt_low ) + dum1 = ( meltpt_temp - state1%t(i,k) ) / ( meltpt_temp - dt_low ) endif - if (zmconv_microp) then - ptend_loc%q(i,k,ixcldliq) = dlfzm(i,k) + dlf2(i,k) * ( 1._r8 - dum1 ) - ptend_loc%q(i,k,ixcldice) = difzm(i,k) + dlf2(i,k) * dum1 - - ptend_loc%q(i,k,ixnumliq) = dnlfzm(i,k) + 3._r8 * ( dlf2(i,k) * ( 1._r8 - dum1 ) ) & - / (4._r8*3.14_r8*dl_rad**3*997._r8) ! Shallow Convection - ptend_loc%q(i,k,ixnumice) = dnifzm(i,k) + 3._r8 * ( dlf2(i,k) * dum1 ) & - / (4._r8*3.14_r8*di_rad**3*500._r8) ! Shallow Convection - ptend_loc%s(i,k) = dlf2(i,k) * dum1 * latice - else - - ptend_loc%q(i,k,ixcldliq) = dlf(i,k) * ( 1._r8 - dum1 ) - ptend_loc%q(i,k,ixcldice) = dlf(i,k) * dum1 - ptend_loc%q(i,k,ixnumliq) = 3._r8 * ( max(0._r8, ( dlf(i,k) - dlf2(i,k) )) * ( 1._r8 - dum1 ) ) & + ptend_loc%q(i,k,ixcldliq) = dlf(i,k) * ( 1._r8 - dum1 ) + ptend_loc%q(i,k,ixcldice) = dlf(i,k) * dum1 + ptend_loc%q(i,k,ixnumliq) = 3._r8 * ( max(0._r8, ( dlf(i,k) - dlf2(i,k) )) * ( 1._r8 - dum1 ) ) & / (4._r8*3.14_r8*dl_rad**3*997._r8) + & ! Deep Convection 3._r8 * ( dlf2(i,k) * ( 1._r8 - dum1 ) ) & - / (4._r8*3.14_r8*10.e-6_r8**3*997._r8) ! Shallow Convection - ptend_loc%q(i,k,ixnumice) = 3._r8 * ( max(0._r8, ( dlf(i,k) - dlf2(i,k) )) * dum1 ) & + / (4._r8*3.14_r8*10.e-6_r8**3*997._r8) ! Shallow Convection + ptend_loc%q(i,k,ixnumice) = 3._r8 * ( max(0._r8, ( dlf(i,k) - dlf2(i,k) )) * dum1 ) & / (4._r8*3.14_r8*di_rad**3*500._r8) + & ! Deep Convection 3._r8 * ( dlf2(i,k) * dum1 ) & / (4._r8*3.14_r8*50.e-6_r8**3*500._r8) ! Shallow Convection - ptend_loc%s(i,k) = dlf(i,k) * dum1 * latice + ptend_loc%s(i,k) = dlf(i,k) * dum1 * latice + + dlf_liq_out(i,k) = dlf(i,k) * ( 1._r8 - dum1 ) + dlf_ice_out(i,k) = dlf(i,k) * dum1 - dlf_liq_out(i,k) = dlf(i,k) * ( 1._r8 - dum1 ) - dlf_ice_out(i,k) = dlf(i,k) * dum1 - end if ! convert moist dlf tendencies to dry ptend_loc%q(i,k,ixcldliq) = ptend_loc%q(i,k,ixcldliq)*state1%pdel(i,k)/state1%pdeldry(i,k) ptend_loc%q(i,k,ixcldice) = ptend_loc%q(i,k,ixcldice)*state1%pdel(i,k)/state1%pdeldry(i,k) @@ -3971,20 +3945,20 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & det_ice(i) = det_ice(i) - ptend_loc%q(i,k,ixcldice)*state1%pdeldry(i,k)*rga enddo enddo - + det_ice(:ncol) = det_ice(:ncol)/1000._r8 ! divide by density of water ! output moist basis to be consistent with history variable definition - temp2d(:ncol,:pver) = ptend_loc%q(:ncol,:pver,ixcldliq)*state1%pdeldry(:ncol,:pver)/state1%pdel(:ncol,:pver) + temp2d(:ncol,:pver) = ptend_loc%q(:ncol,:pver,ixcldliq)*state1%pdeldry(:ncol,:pver)/state1%pdel(:ncol,:pver) call outfld( 'DPDLFLIQ', temp2d, pcols, lchnk) ! output moist basis to be consistent with history variable definition temp2d(:ncol,:pver) = ptend_loc%q(:ncol,:pver,ixcldice)*state1%pdeldry(:ncol,:pver)/state1%pdel(:ncol,:pver) call outfld( 'DPDLFICE', temp2d, pcols, lchnk) - + temp2d(:ncol,:pver) = ptend_loc%s(:ncol,:pver)/cpairv(:ncol,:pver, lchnk) call outfld( 'DPDLFT', temp2d, pcols, lchnk) - + call outfld( 'DETNLIQTND', ptend_loc%q(:,:,ixnumliq),pcols, lchnk ) call physics_ptend_sum(ptend_loc,ptend_all,ncol) @@ -4011,19 +3985,19 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & else relvarmax = 10.0_r8 endif - + relvar(:,:) = relvarmax ! default - if (deep_scheme .ne. 'CLUBB_SGS') then + if (deep_scheme .ne. 'CLUBB_SGS') then where (rcm(:ncol,:pver) /= 0 .and. qclvar(:ncol,:pver) /= 0) & relvar(:ncol,:pver) = min(relvarmax,max(0.001_r8,rcm(:ncol,:pver)**2/qclvar(:ncol,:pver))) endif - + ! ------------------------------------------------- ! ! Optional Accretion enhancement factor ! - ! ------------------------------------------------- ! + ! ------------------------------------------------- ! accre_enhan(:ncol,:pver) = 1._r8 - + ! ------------------------------------------------- ! ! Diagnose some output variables ! ! ------------------------------------------------- ! @@ -4049,7 +4023,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & sl_output(i,k) = cpairv(i,k,lchnk)*state1%t(i,k)+gravit*state1%zm(i,k)-latvap*state1%q(i,k,ixcldliq) enddo enddo - + do k=1,pverp do i=1,ncol wpthlp_output(i,k) = (wpthlp(i,k)-(apply_const*wpthlp_const))*rho(i,k)*cpair ! liquid water potential temperature flux @@ -4063,53 +4037,53 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end if enddo enddo - - ! --------------------------------------------------------------------------------- ! + + ! --------------------------------------------------------------------------------- ! ! Diagnose some quantities that are computed in macrop_tend here. ! ! These are inputs required for the microphysics calculation. ! ! ! ! FIRST PART COMPUTES THE STRATIFORM CLOUD FRACTION FROM CLUBB CLOUD FRACTION ! - ! --------------------------------------------------------------------------------- ! - - ! initialize variables + ! --------------------------------------------------------------------------------- ! + + ! initialize variables alst(:,:) = 0.0_r8 - qlst(:,:) = 0.0_r8 - + qlst(:,:) = 0.0_r8 + do k=1,pver do i=1,ncol - alst(i,k) = cloud_frac(i,k) + alst(i,k) = cloud_frac(i,k) qlst(i,k) = rcm(i,k)/max(0.01_r8,alst(i,k)) ! Incloud stratus condensate mixing ratio enddo enddo - - ! --------------------------------------------------------------------------------- ! + + ! --------------------------------------------------------------------------------- ! ! THIS PART COMPUTES CONVECTIVE AND DEEP CONVECTIVE CLOUD FRACTION ! - ! --------------------------------------------------------------------------------- ! - + ! --------------------------------------------------------------------------------- ! + deepcu(:,:) = 0.0_r8 shalcu(:,:) = 0.0_r8 - + do k=1,pver-1 do i=1,ncol - ! diagnose the deep convective cloud fraction, as done in macrophysics based on the - ! deep convective mass flux, read in from pbuf. Since shallow convection is never + ! diagnose the deep convective cloud fraction, as done in macrophysics based on the + ! deep convective mass flux, read in from pbuf. Since shallow convection is never ! called, the shallow convective mass flux will ALWAYS be zero, ensuring that this cloud - ! fraction is purely from deep convection scheme. + ! fraction is purely from deep convection scheme. deepcu(i,k) = max(0.0_r8,min(dp1*log(1.0_r8+dp2*(cmfmc(i,k+1)-cmfmc_sh(i,k+1))),0.6_r8)) shalcu(i,k) = 0._r8 - + if (deepcu(i,k) <= frac_limit .or. dp_icwmr(i,k) < ic_limit) then deepcu(i,k) = 0._r8 endif - - ! using the deep convective cloud fraction, and CLUBB cloud fraction (variable + + ! using the deep convective cloud fraction, and CLUBB cloud fraction (variable ! "cloud_frac"), compute the convective cloud fraction. This follows the formulation - ! found in macrophysics code. Assumes that convective cloud is all nonstratiform cloud + ! found in macrophysics code. Assumes that convective cloud is all nonstratiform cloud ! from CLUBB plus the deep convective cloud fraction concld(i,k) = min(cloud_frac(i,k)-alst(i,k)+deepcu(i,k),0.80_r8) enddo enddo - + if (single_column) then if (trim(scm_clubb_iop_name) == 'ATEX_48hr' .or. & trim(scm_clubb_iop_name) == 'BOMEX_5day' .or. & @@ -4117,20 +4091,20 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & trim(scm_clubb_iop_name) == 'DYCOMSrf02_06hr' .or. & trim(scm_clubb_iop_name) == 'RICO_3day' .or. & trim(scm_clubb_iop_name) == 'ARM_CC') then - + deepcu(:,:) = 0.0_r8 concld(:,:) = 0.0_r8 - - endif + + endif endif - - ! --------------------------------------------------------------------------------- ! + + ! --------------------------------------------------------------------------------- ! ! COMPUTE THE ICE CLOUD FRACTION PORTION ! ! use the aist_vector function to compute the ice cloud fraction ! - ! --------------------------------------------------------------------------------- ! + ! --------------------------------------------------------------------------------- ! aist(:,:top_lev-1) = 0._r8 - qsatfac(:, :) = 0._r8 ! Zero out entire profile in case qsatfac is left undefined in aist_vector below + qsatfac(:, :) = 0._r8 ! Zero out entire profile in case qsatfac is left undefined in aist_vector below do k = top_lev, pver @@ -4159,37 +4133,37 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & qsatfac_out=qsatfac(:,k), rhmini_in=rhmini, rhmaxi_in=rhmaxi) endif enddo - - ! --------------------------------------------------------------------------------- ! + + ! --------------------------------------------------------------------------------- ! ! THIS PART COMPUTES THE LIQUID STRATUS FRACTION ! ! ! ! For now leave the computation of ice stratus fraction from macrop_driver intact ! - ! because CLUBB does nothing with ice. Here I simply overwrite the liquid stratus ! + ! because CLUBB does nothing with ice. Here I simply overwrite the liquid stratus ! ! fraction that was coded in macrop_driver ! - ! --------------------------------------------------------------------------------- ! - + ! --------------------------------------------------------------------------------- ! + ! Recompute net stratus fraction using maximum over-lapping assumption, as done ! in macrophysics code, using alst computed above and aist read in from physics buffer - + do k=1,pver do i=1,ncol ast(i,k) = max(alst(i,k),aist(i,k)) - qist(i,k) = state1%q(i,k,ixcldice)/max(0.01_r8,aist(i,k)) + qist(i,k) = state1%q(i,k,ixcldice)/max(0.01_r8,aist(i,k)) enddo enddo - - ! Probably need to add deepcu cloud fraction to the cloud fraction array, else would just - ! be outputting the shallow convective cloud fraction + + ! Probably need to add deepcu cloud fraction to the cloud fraction array, else would just + ! be outputting the shallow convective cloud fraction do k=1,pver do i=1,ncol cloud_frac(i,k) = min(ast(i,k)+deepcu(i,k),1.0_r8) enddo enddo - - ! --------------------------------------------------------------------------------- ! + + ! --------------------------------------------------------------------------------- ! ! DIAGNOSE THE PBL DEPTH ! ! this is needed for aerosol code ! - ! --------------------------------------------------------------------------------- ! + ! --------------------------------------------------------------------------------- ! do i=1,ncol do k=1,pver !use local exner since state%exner is not a proper exner @@ -4198,7 +4172,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & thv(i,k) = th(i,k)*(1.0_r8+zvir*state1%q(i,k,ixq) - state1%q(i,k,ixcldliq)) enddo enddo - + ! diagnose surface friction and obukhov length (inputs to diagnose PBL depth) rrho(1:ncol) = (rga)*(state1%pdel(1:ncol,pver)/dz_g(1:ncol,pver)) call calc_ustar( ncol, state1%t(1:ncol,pver), state1%pmid(1:ncol,pver), cam_in%wsx(1:ncol), cam_in%wsy(1:ncol), & @@ -4207,10 +4181,10 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call calc_obklen( ncol, th(1:ncol,pver), thv(1:ncol,pver), cam_in%cflx(1:ncol,1), cam_in%shf(1:ncol), & rrho(1:ncol), ustar2(1:ncol), kinheat(1:ncol), kinwat(1:ncol), kbfs(1:ncol), & obklen(1:ncol)) - + dummy2(:) = 0._r8 dummy3(:) = 0._r8 - + where (kbfs(:ncol) == -0.0_r8) kbfs(:ncol) = 0.0_r8 ! Compute PBL depth according to Holtslag-Boville Scheme @@ -4220,14 +4194,14 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Output the PBL depth call outfld('PBLH', pblh, pcols, lchnk) - + ! Assign the first pver levels of cloud_frac back to cld cld(:,1:pver) = cloud_frac(:,1:pver) - ! --------------------------------------------------------------------------------- ! + ! --------------------------------------------------------------------------------- ! ! END CLOUD FRACTION DIAGNOSIS, begin to store variables back into buffer ! - ! --------------------------------------------------------------------------------- ! - + ! --------------------------------------------------------------------------------- ! + ! Output calls of variables goes here call outfld( 'RELVAR', relvar, pcols, lchnk ) call outfld( 'RHO_CLUBB', rho(:,1:pver), pcols, lchnk ) @@ -4271,7 +4245,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call outfld( 'CLUBB_GRID_SIZE', grid_dx, pcols, lchnk ) call outfld( 'QSATFAC', qsatfac, pcols, lchnk) - + ! --------------------------------------------------------------- ! ! Writing state variables after EDMF scheme for detailed analysis ! ! --------------------------------------------------------------- ! @@ -4300,44 +4274,44 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end if ! Output CLUBB history here - if (l_stats) then - + if (l_stats) then + do j=1,stats_zt(1)%num_output_fields - + temp1 = trim(stats_zt(1)%file%grid_avg_var(j)%name) sub = temp1 if (len(temp1) > max_fieldname_len) sub = temp1(1:max_fieldname_len) - + call outfld(trim(sub), out_zt(:,:,j), pcols, lchnk ) enddo - + do j=1,stats_zm(1)%num_output_fields - + temp1 = trim(stats_zm(1)%file%grid_avg_var(j)%name) sub = temp1 if (len(temp1) > max_fieldname_len) sub = temp1(1:max_fieldname_len) - + call outfld(trim(sub),out_zm(:,:,j), pcols, lchnk) enddo - if (l_output_rad_files) then + if (l_output_rad_files) then do j=1,stats_rad_zt(1)%num_output_fields call outfld(trim(stats_rad_zt(1)%file%grid_avg_var(j)%name), out_radzt(:,:,j), pcols, lchnk) enddo - + do j=1,stats_rad_zm(1)%num_output_fields call outfld(trim(stats_rad_zm(1)%file%grid_avg_var(j)%name), out_radzm(:,:,j), pcols, lchnk) enddo endif - + do j=1,stats_sfc(1)%num_output_fields call outfld(trim(stats_sfc(1)%file%grid_avg_var(j)%name), out_sfc(:,:,j), pcols, lchnk) enddo - + endif - + call t_stopf("clubb_tend_cam") - + return #endif end subroutine clubb_tend_cam @@ -4371,7 +4345,7 @@ subroutine clubb_emissions_cam (state, cam_in, ptend) ! --------------- ! ! Local Variables ! ! --------------- ! - integer :: m, ncol + integer :: m, ncol logical :: lq(pcnst) ! ----------------------- ! @@ -4395,7 +4369,7 @@ subroutine clubb_emissions_cam (state, cam_in, ptend) endif end do - end subroutine clubb_emissions_cam + end subroutine clubb_emissions_cam ! =============================================================================== ! ! ! @@ -4403,12 +4377,12 @@ end subroutine clubb_emissions_cam ! Saturation adjustment for ice ! Add ice mass if supersaturated -subroutine ice_macro_tend(naai,t,p,qv,qi,ni,xxls,deltat,stend,qvtend,qitend,nitend,vlen) +subroutine ice_macro_tend(naai,t,p,qv,qi,ni,xxls,deltat,stend,qvtend,qitend,nitend,vlen) use wv_sat_methods, only: wv_sat_qsat_ice integer, intent(in) :: vlen - real(r8), dimension(vlen), intent(in) :: naai !Activated number of ice nuclei + real(r8), dimension(vlen), intent(in) :: naai !Activated number of ice nuclei real(r8), dimension(vlen), intent(in) :: t !temperature (k) real(r8), dimension(vlen), intent(in) :: p !pressure (pa) real(r8), dimension(vlen), intent(in) :: qv !water vapor mixing ratio @@ -4416,11 +4390,11 @@ subroutine ice_macro_tend(naai,t,p,qv,qi,ni,xxls,deltat,stend,qvtend,qitend,nite real(r8), dimension(vlen), intent(in) :: ni !ice number concentration real(r8), intent(in) :: xxls !latent heat of freezing real(r8), intent(in) :: deltat !timestep - real(r8), dimension(vlen), intent(out) :: stend ! 'temperature' tendency + real(r8), dimension(vlen), intent(out) :: stend ! 'temperature' tendency real(r8), dimension(vlen), intent(out) :: qvtend !vapor tendency real(r8), dimension(vlen), intent(out) :: qitend !ice mass tendency - real(r8), dimension(vlen), intent(out) :: nitend !ice number tendency - + real(r8), dimension(vlen), intent(out) :: nitend !ice number tendency + real(r8) :: ESI(vlen) real(r8) :: QSI(vlen) integer :: i @@ -4443,7 +4417,7 @@ subroutine ice_macro_tend(naai,t,p,qv,qi,ni,xxls,deltat,stend,qvtend,qitend,nite qitend(i) = (qv(i)-QSI(i))/deltat qvtend(i) = 0._r8 - qitend(i) stend(i) = qitend(i) * xxls ! moist static energy tend...[J/kg/s] ! - + ! if ice exists (more than 1 L-1) and there is condensation, do not add to number (= growth), else, add 10um ice if (ni(i) < 1.e3_r8 .and. (qi(i)+qitend(i)*deltat) > 1.e-18_r8) then nitend(i) = nitend(i) + 3._r8 * qitend(i)/(4._r8*3.14_r8* 10.e-6_r8**3*997._r8) @@ -4477,7 +4451,7 @@ end subroutine ice_macro_tend ! Code writen March, 1999 by Bjorn Stevens ! -real(r8) function diag_ustar( z, bflx, wnd, z0 ) +real(r8) function diag_ustar( z, bflx, wnd, z0 ) use shr_const_mod, only : shr_const_karman, shr_const_pi, shr_const_g @@ -4546,59 +4520,59 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & ! Description: Initializes the statistics saving functionality of ! the CLUBB model. This is for purpose of CAM-CLUBB interface. Here ! the traditional stats_init of CLUBB is not called, as it is not compatible - ! with CAM output. - + ! with CAM output. + !----------------------------------------------------------------------- use clubb_api_module, only: & - ztscr01, & - ztscr02, & - ztscr03, & - ztscr04, & - ztscr05, & - ztscr06, & - ztscr07, & - ztscr08, & - ztscr09, & - ztscr10, & - ztscr11, & - ztscr12, & - ztscr13, & - ztscr14, & - ztscr15, & - ztscr16, & - ztscr17, & - ztscr18, & - ztscr19, & - ztscr20, & + ztscr01, & + ztscr02, & + ztscr03, & + ztscr04, & + ztscr05, & + ztscr06, & + ztscr07, & + ztscr08, & + ztscr09, & + ztscr10, & + ztscr11, & + ztscr12, & + ztscr13, & + ztscr14, & + ztscr15, & + ztscr16, & + ztscr17, & + ztscr18, & + ztscr19, & + ztscr20, & ztscr21 use clubb_api_module, only: & - zmscr01, & - zmscr02, & - zmscr03, & - zmscr04, & - zmscr05, & - zmscr06, & - zmscr07, & - zmscr08, & - zmscr09, & - zmscr10, & - zmscr11, & - zmscr12, & - zmscr13, & - zmscr14, & + zmscr01, & + zmscr02, & + zmscr03, & + zmscr04, & + zmscr05, & + zmscr06, & + zmscr07, & + zmscr08, & + zmscr09, & + zmscr10, & + zmscr11, & + zmscr12, & + zmscr13, & + zmscr14, & zmscr15, & zmscr16, & zmscr17, & l_stats, & - l_output_rad_files, & - stats_tsamp, & - stats_tout, & - l_stats_samp, & - l_stats_last, & - l_netcdf, & + l_output_rad_files, & + stats_tsamp, & + stats_tout, & + l_stats_samp, & + l_stats_last, & + l_netcdf, & l_grads use clubb_api_module, only: time_precision, & ! @@ -4620,16 +4594,16 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & logical, intent(in) :: l_stats_in ! Stats on? T/F - real(kind=time_precision), intent(in) :: & + real(kind=time_precision), intent(in) :: & stats_tsamp_in, & ! Sampling interval [s] stats_tout_in ! Output interval [s] integer, intent(in) :: nnzp ! Grid points in the vertical [count] - integer, intent(in) :: nnrad_zt ! Grid points in the radiation grid [count] + integer, intent(in) :: nnrad_zt ! Grid points in the radiation grid [count] integer, intent(in) :: nnrad_zm ! Grid points in the radiation grid [count] real(kind=time_precision), intent(in) :: delt ! Timestep (dtmain in CLUBB) [s] - + ! Output Variables type (stats), intent(out) :: stats_zt, & ! stats_zt grid stats_zm, & ! stats_zm grid @@ -4650,11 +4624,11 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & character(len=var_length), dimension(nvarmax_rad_zm) :: clubb_vars_rad_zm ! Variables on the radiation levels character(len=var_length), dimension(nvarmax_sfc) :: clubb_vars_sfc ! Variables at the model surface - namelist /clubb_stats_nl/ & - clubb_vars_zt, & + namelist /clubb_stats_nl/ & + clubb_vars_zt, & clubb_vars_zm, & clubb_vars_rad_zt, & - clubb_vars_rad_zm, & + clubb_vars_rad_zm, & clubb_vars_sfc ! Local Variables @@ -4672,7 +4646,7 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & ! Set stats_variables variables with inputs from calling subroutine l_stats = l_stats_in - + stats_tsamp = stats_tsamp_in stats_tout = stats_tout_in @@ -4690,7 +4664,7 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & clubb_vars_rad_zm = '' clubb_vars_sfc = '' - ! Read variables to compute from the namelist + ! Read variables to compute from the namelist if (masterproc) then iunit= getunit() open(unit=iunit,file="atm_in",status='old') @@ -4737,8 +4711,8 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & ! Initialize zt (mass points) i = 1 - do while ( ichar(clubb_vars_zt(i)(1:1)) /= 0 .and. & - len_trim(clubb_vars_zt(i)) /= 0 .and. & + do while ( ichar(clubb_vars_zt(i)(1:1)) /= 0 .and. & + len_trim(clubb_vars_zt(i)) /= 0 .and. & i <= nvarmax_zt ) i = i + 1 enddo @@ -4822,8 +4796,8 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & ! Initialize zm (momentum points) i = 1 - do while ( ichar(clubb_vars_zm(i)(1:1)) /= 0 .and. & - len_trim(clubb_vars_zm(i)) /= 0 .and. & + do while ( ichar(clubb_vars_zm(i)(1:1)) /= 0 .and. & + len_trim(clubb_vars_zm(i)) /= 0 .and. & i <= nvarmax_zm ) i = i + 1 end do @@ -4897,10 +4871,10 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & ! Initialize rad_zt (radiation points) if (l_output_rad_files) then - + i = 1 - do while ( ichar(clubb_vars_rad_zt(i)(1:1)) /= 0 .and. & - len_trim(clubb_vars_rad_zt(i)) /= 0 .and. & + do while ( ichar(clubb_vars_rad_zt(i)(1:1)) /= 0 .and. & + len_trim(clubb_vars_rad_zt(i)) /= 0 .and. & i <= nvarmax_rad_zt ) i = i + 1 end do @@ -4933,10 +4907,10 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & stats_rad_zt ) ! Initialize rad_zm (radiation points) - + i = 1 - do while ( ichar(clubb_vars_rad_zm(i)(1:1)) /= 0 .and. & - len_trim(clubb_vars_rad_zm(i)) /= 0 .and. & + do while ( ichar(clubb_vars_rad_zm(i)(1:1)) /= 0 .and. & + len_trim(clubb_vars_rad_zm(i)) /= 0 .and. & i <= nvarmax_rad_zm ) i = i + 1 end do @@ -4964,7 +4938,7 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & allocate( stats_rad_zm%file%grid_avg_var( stats_rad_zm%num_output_fields ) ) allocate( stats_rad_zm%file%z( stats_rad_zm%kk ) ) - + call stats_init_rad_zm_api( clubb_vars_rad_zm, l_error, & stats_rad_zm ) end if ! l_output_rad_files @@ -4973,8 +4947,8 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & ! Initialize sfc (surface point) i = 1 - do while ( ichar(clubb_vars_sfc(i)(1:1)) /= 0 .and. & - len_trim(clubb_vars_sfc(i)) /= 0 .and. & + do while ( ichar(clubb_vars_sfc(i)(1:1)) /= 0 .and. & + len_trim(clubb_vars_sfc(i)) /= 0 .and. & i <= nvarmax_sfc ) i = i + 1 end do @@ -5016,58 +4990,58 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & ! Now call add fields if (first_call) then - + do i = 1, stats_zt%num_output_fields - + temp1 = trim(stats_zt%file%grid_avg_var(i)%name) sub = temp1 if (len(temp1) > max_fieldname_len) sub = temp1(1:max_fieldname_len) - + call addfld(trim(sub),(/ 'ilev' /),& 'A',trim(stats_zt%file%grid_avg_var(i)%units),trim(stats_zt%file%grid_avg_var(i)%description)) enddo - + do i = 1, stats_zm%num_output_fields - + temp1 = trim(stats_zm%file%grid_avg_var(i)%name) sub = temp1 if (len(temp1) > max_fieldname_len) sub = temp1(1:max_fieldname_len) - + call addfld(trim(sub),(/ 'ilev' /),& 'A',trim(stats_zm%file%grid_avg_var(i)%units),trim(stats_zm%file%grid_avg_var(i)%description)) enddo - if (l_output_rad_files) then + if (l_output_rad_files) then do i = 1, stats_rad_zt%num_output_fields call addfld(trim(stats_rad_zt%file%grid_avg_var(i)%name),(/ 'ilev' /),& 'A',trim(stats_rad_zt%file%grid_avg_var(i)%units),trim(stats_rad_zt%file%grid_avg_var(i)%description)) enddo - + do i = 1, stats_rad_zm%num_output_fields call addfld(trim(stats_rad_zm%file%grid_avg_var(i)%name),(/ 'ilev' /),& 'A',trim(stats_rad_zm%file%grid_avg_var(i)%units),trim(stats_rad_zm%file%grid_avg_var(i)%description)) enddo endif - + do i = 1, stats_sfc%num_output_fields call addfld(trim(stats_sfc%file%grid_avg_var(i)%name),horiz_only,& 'A',trim(stats_sfc%file%grid_avg_var(i)%units),trim(stats_sfc%file%grid_avg_var(i)%description)) enddo - + end if return - end subroutine stats_init_clubb - + end subroutine stats_init_clubb + #endif ! =============================================================================== ! ! ! ! =============================================================================== ! -#ifdef CLUBB_SGS +#ifdef CLUBB_SGS subroutine stats_end_timestep_clubb(thecol, stats_zt, stats_zm, stats_rad_zt, stats_rad_zm, stats_sfc, & out_zt, out_zm, out_radzt, out_radzm, out_sfc) !----------------------------------------------------------------------- @@ -5082,8 +5056,8 @@ subroutine stats_end_timestep_clubb(thecol, stats_zt, stats_zm, stats_rad_zt, st use clubb_api_module, only: & fstderr, & ! Constant(s) - l_stats_last, & - stats_tsamp, & + l_stats_last, & + stats_tsamp, & stats_tout, & l_output_rad_files, & clubb_at_least_debug_level_api ! Procedure(s) @@ -5093,14 +5067,14 @@ subroutine stats_end_timestep_clubb(thecol, stats_zt, stats_zm, stats_rad_zt, st implicit none integer :: thecol - + ! Input Variables type (stats), intent(inout) :: stats_zt, & ! stats_zt grid stats_zm, & ! stats_zm grid stats_rad_zt, & ! stats_rad_zt grid stats_rad_zm, & ! stats_rad_zm grid stats_sfc ! stats_sfc - + ! Inout variables real(r8), intent(inout) :: out_zt(:,:,:) ! (pcols,pverp,stats_zt%num_output_fields) real(r8), intent(inout) :: out_zm(:,:,:) ! (pcols,pverp,stats_zt%num_output_fields) @@ -5131,36 +5105,36 @@ subroutine stats_end_timestep_clubb(thecol, stats_zt, stats_zm, stats_rad_zt, st end if call stats_avg( stats_sfc%kk, stats_sfc%num_output_fields, stats_sfc%accum_field_values, stats_sfc%accum_num_samples ) - ! Here we are not outputting the data, rather reading the stats into + ! Here we are not outputting the data, rather reading the stats into ! arrays which are conformable to CAM output. Also, the data is "flipped" - ! in the vertical level to be the same as CAM output. + ! in the vertical level to be the same as CAM output. do i = 1, stats_zt%num_output_fields - do k = 1, stats_zt%kk + do k = 1, stats_zt%kk out_zt(thecol,pverp-k+1,i) = stats_zt%accum_field_values(1,1,k,i) if(is_nan(out_zt(thecol,k,i))) out_zt(thecol,k,i) = 0.0_r8 - enddo + enddo enddo do i = 1, stats_zm%num_output_fields - do k = 1, stats_zt%kk + do k = 1, stats_zt%kk out_zm(thecol,pverp-k+1,i) = stats_zm%accum_field_values(1,1,k,i) if(is_nan(out_zm(thecol,k,i))) out_zm(thecol,k,i) = 0.0_r8 - enddo + enddo enddo - if (l_output_rad_files) then + if (l_output_rad_files) then do i = 1, stats_rad_zt%num_output_fields - do k = 1, stats_rad_zt%kk + do k = 1, stats_rad_zt%kk out_radzt(thecol,pverp-k+1,i) = stats_rad_zt%accum_field_values(1,1,k,i) if(is_nan(out_radzt(thecol,k,i))) out_radzt(thecol,k,i) = 0.0_r8 - enddo + enddo enddo - + do i = 1, stats_rad_zm%num_output_fields - do k = 1, stats_rad_zm%kk + do k = 1, stats_rad_zm%kk out_radzm(thecol,pverp-k+1,i) = stats_rad_zm%accum_field_values(1,1,k,i) if(is_nan(out_radzm(thecol,k,i))) out_radzm(thecol,k,i) = 0.0_r8 - enddo + enddo enddo ! Fill in values above the CLUBB top. @@ -5170,9 +5144,9 @@ subroutine stats_end_timestep_clubb(thecol, stats_zt, stats_zm, stats_rad_zt, st out_radzm(thecol,:top_lev-1,:) = 0.0_r8 endif ! l_output_rad_files - + do i = 1, stats_sfc%num_output_fields - out_sfc(thecol,1,i) = stats_sfc%accum_field_values(1,1,1,i) + out_sfc(thecol,1,i) = stats_sfc%accum_field_values(1,1,1,i) if(is_nan(out_sfc(thecol,1,i))) out_sfc(thecol,1,i) = 0.0_r8 enddo @@ -5193,14 +5167,14 @@ subroutine stats_end_timestep_clubb(thecol, stats_zt, stats_zm, stats_rad_zt, st return end subroutine stats_end_timestep_clubb -#endif - +#endif + ! =============================================================================== ! ! ! ! =============================================================================== ! #ifdef CLUBB_SGS - + !----------------------------------------------------------------------- subroutine stats_zero( kk, num_output_fields, x, n, l_in_update ) @@ -5234,14 +5208,14 @@ subroutine stats_zero( kk, num_output_fields, x, n, l_in_update ) return end subroutine stats_zero - + #endif ! =============================================================================== ! ! ! ! =============================================================================== ! - + #ifdef CLUBB_SGS !----------------------------------------------------------------------- subroutine stats_avg( kk, num_output_fields, x, n ) @@ -5289,7 +5263,7 @@ subroutine grid_size(state, grid_dx, grid_dy) use shr_const_mod, only: shr_const_pi use physics_types, only: physics_state - + type(physics_state), intent(in) :: state real(r8), intent(out) :: grid_dx(state%ncol), grid_dy(state%ncol) ! CAM grid [m] @@ -5304,17 +5278,17 @@ subroutine grid_size(state, grid_dx, grid_dy) do i=1,state%ncol column_area = get_area_p(state%lchnk,i) degree = sqrt(column_area)*(180._r8/shr_const_pi) - + ! Now find meters per degree latitude ! Below equation finds distance between two points on an ellipsoid, derived from expansion - ! taking into account ellipsoid using World Geodetic System (WGS84) reference + ! taking into account ellipsoid using World Geodetic System (WGS84) reference mpdeglat = earth_ellipsoid1 - earth_ellipsoid2 * cos(2._r8*state%lat(i)) + earth_ellipsoid3 * cos(4._r8*state%lat(i)) grid_dx(i) = mpdeglat * degree grid_dy(i) = grid_dx(i) ! Assume these are the same - enddo + enddo - end subroutine grid_size + end subroutine grid_size #endif - + end module clubb_intr diff --git a/src/physics/cam/convect_shallow.F90 b/src/physics/cam/convect_shallow.F90 index 0fa7e3b83d..4f0844fd24 100644 --- a/src/physics/cam/convect_shallow.F90 +++ b/src/physics/cam/convect_shallow.F90 @@ -13,25 +13,25 @@ module convect_shallow use shr_kind_mod, only : r8=>shr_kind_r8 use physconst, only : cpair, zvir use ppgrid, only : pver, pcols, pverp - use zm_conv, only : zm_conv_evap + use zm_conv_evap_mod, only : zm_conv_evap_run use cam_history, only : outfld, addfld, horiz_only use cam_logfile, only : iulog use phys_control, only : phys_getopts implicit none - private + private save public :: & convect_shallow_register, & ! Register fields in physics buffer convect_shallow_init, & ! Initialize shallow module convect_shallow_tend, & ! Return tendencies - convect_shallow_use_shfrc ! + convect_shallow_use_shfrc ! ! The following namelist variable controls which shallow convection package is used. ! 'Hack' = Hack shallow convection (default) ! 'UW' = UW shallow convection by Sungsu Park and Christopher S. Bretherton - ! 'UNICON' = General Convection Model by Sungsu Park + ! 'UNICON' = General Convection Model by Sungsu Park ! 'off' = No shallow convection character(len=16) :: shallow_scheme ! Default set in phys_control.F90, use namelist to change @@ -40,16 +40,16 @@ module convect_shallow logical :: history_budget ! Output tendencies and state variables for CAM4 T, qv, ql, qi integer :: history_budget_histfile_num ! output history file number for budget fields - ! Physics buffer indices - integer :: icwmrsh_idx = 0 - integer :: rprdsh_idx = 0 - integer :: rprdtot_idx = 0 - integer :: cldtop_idx = 0 - integer :: cldbot_idx = 0 - integer :: cush_idx = 0 + ! Physics buffer indices + integer :: icwmrsh_idx = 0 + integer :: rprdsh_idx = 0 + integer :: rprdtot_idx = 0 + integer :: cldtop_idx = 0 + integer :: cldbot_idx = 0 + integer :: cush_idx = 0 integer :: nevapr_shcu_idx = 0 - integer :: shfrc_idx = 0 - integer :: cld_idx = 0 + integer :: shfrc_idx = 0 + integer :: cld_idx = 0 integer :: concld_idx = 0 integer :: rprddp_idx = 0 integer :: tke_idx = 0 @@ -84,9 +84,9 @@ subroutine convect_shallow_register use physics_buffer, only : pbuf_add_field, dtype_r8, dyn_time_lvls use phys_control, only: use_gw_convect_sh use unicon_cam, only: unicon_cam_register - + call phys_getopts( shallow_scheme_out = shallow_scheme, microp_scheme_out = microp_scheme) - + ! SPCAM registers its own fields if (shallow_scheme == 'SPCAM') return @@ -95,7 +95,7 @@ subroutine convect_shallow_register call pbuf_add_field('RPRDTOT', 'physpkg' ,dtype_r8,(/pcols,pver/), rprdtot_idx ) call pbuf_add_field('CLDTOP', 'physpkg' ,dtype_r8,(/pcols,1/), cldtop_idx ) call pbuf_add_field('CLDBOT', 'physpkg' ,dtype_r8,(/pcols,1/), cldbot_idx ) - call pbuf_add_field('cush', 'global' ,dtype_r8,(/pcols,dyn_time_lvls/), cush_idx ) + call pbuf_add_field('cush', 'global' ,dtype_r8,(/pcols,dyn_time_lvls/), cush_idx ) call pbuf_add_field('NEVAPR_SHCU','physpkg' ,dtype_r8,(/pcols,pver/), nevapr_shcu_idx ) call pbuf_add_field('PREC_SH', 'physpkg' ,dtype_r8,(/pcols/), prec_sh_idx ) call pbuf_add_field('SNOW_SH', 'physpkg' ,dtype_r8,(/pcols/), snow_sh_idx ) @@ -110,16 +110,16 @@ subroutine convect_shallow_register endif ! shallow interface gbm flux_convective_cloud_rain+snow (kg/m2/s) - call pbuf_add_field('SH_FLXPRC','physpkg',dtype_r8,(/pcols,pverp/),sh_flxprc_idx) + call pbuf_add_field('SH_FLXPRC','physpkg',dtype_r8,(/pcols,pverp/),sh_flxprc_idx) ! shallow interface gbm flux_convective_cloud_snow (kg/m2/s) - call pbuf_add_field('SH_FLXSNW','physpkg',dtype_r8,(/pcols,pverp/),sh_flxsnw_idx) + call pbuf_add_field('SH_FLXSNW','physpkg',dtype_r8,(/pcols,pverp/),sh_flxsnw_idx) ! shallow gbm cloud liquid water (kg/kg) - call pbuf_add_field('SH_CLDLIQ','physpkg',dtype_r8,(/pcols,pver/),sh_cldliq_idx) + call pbuf_add_field('SH_CLDLIQ','physpkg',dtype_r8,(/pcols,pver/),sh_cldliq_idx) ! shallow gbm cloud ice water (kg/kg) - call pbuf_add_field('SH_CLDICE','physpkg',dtype_r8,(/pcols,pver/),sh_cldice_idx) + call pbuf_add_field('SH_CLDICE','physpkg',dtype_r8,(/pcols,pver/),sh_cldice_idx) ! If gravity waves from shallow convection are on, output this field. if (use_gw_convect_sh) then @@ -154,7 +154,7 @@ subroutine convect_shallow_init(pref_edge, pbuf2d) use spmd_utils, only : masterproc use cam_abortutils, only : endrun use phys_control, only : cam_physpkg_is - + use physics_buffer, only : pbuf_get_index, physics_buffer_desc, pbuf_set_field real(r8), intent(in) :: pref_edge(plevp) ! Reference pressures at interfaces @@ -163,7 +163,7 @@ subroutine convect_shallow_init(pref_edge, pbuf2d) integer limcnv ! Top interface level limit for convection integer k character(len=16) :: eddy_scheme - + ! SPCAM does its own convection if (shallow_scheme == 'SPCAM') return @@ -221,7 +221,7 @@ subroutine convect_shallow_init(pref_edge, pbuf2d) call addfld( 'PCLDBOT', horiz_only, 'A', '1', 'Pressure of cloud base' ) call addfld( 'FREQSH', horiz_only, 'A', 'fraction', 'Fractional occurance of shallow convection' ) - + call addfld( 'HKFLXPRC', (/ 'ilev' /), 'A', 'kg/m2/s', 'Flux of precipitation from HK convection' ) call addfld( 'HKFLXSNW', (/ 'ilev' /), 'A', 'kg/m2/s', 'Flux of snow from HK convection' ) call addfld( 'HKNTPRPD', (/ 'lev' /), 'A', 'kg/kg/s', 'Net precipitation production from HK convection' ) @@ -286,7 +286,7 @@ subroutine convect_shallow_init(pref_edge, pbuf2d) if( masterproc ) then write(iulog,*) 'MFINTI: Convection will be capped at intfc ', limcnv, ' which is ', pref_edge(limcnv), ' pascals' end if - + call mfinti( rair, cpair, gravit, latvap, rhoh2o, limcnv) ! Get args from inti.F90 case('UW') ! Park and Bretherton shallow convection scheme @@ -346,7 +346,7 @@ end function convect_shallow_use_shfrc !=============================================================================== ! subroutine convect_shallow_tend( ztodt , cmfmc , & - qc , qc2 , rliq , rliq2 , & + qc , qc2 , rliq , rliq2 , & state , ptend_all, pbuf, cam_in) use physics_buffer, only : physics_buffer_desc, pbuf_get_field, pbuf_set_field, pbuf_old_tim_idx @@ -357,7 +357,7 @@ subroutine convect_shallow_tend( ztodt , cmfmc , & use physics_types, only : physics_ptend_dealloc use physics_types, only : physics_ptend_sum use camsrfexch, only : cam_in_t - + use constituents, only : pcnst, cnst_get_ind, cnst_get_type_byind use hk_conv, only : cmfmca use uwshcu, only : compute_uwshcu_inv @@ -365,7 +365,7 @@ subroutine convect_shallow_tend( ztodt , cmfmc , & use time_manager, only : get_nstep use wv_saturation, only : qsat - use physconst, only : latice, latvap, rhoh2o + use physconst, only : latice, latvap, rhoh2o, tmelt, gravit use spmd_utils, only : iam implicit none @@ -381,7 +381,7 @@ subroutine convect_shallow_tend( ztodt , cmfmc , & real(r8), intent(out) :: rliq2(pcols) ! Vertically-integrated reserved cloud condensate [ m/s ] real(r8), intent(out) :: qc2(pcols,pver) ! Same as qc but only from shallow convection scheme - + real(r8), intent(inout) :: cmfmc(pcols,pverp) ! Moist deep + shallow convection cloud mass flux [ kg/s/m2 ] real(r8), intent(inout) :: qc(pcols,pver) ! dq/dt due to export of cloud water into environment by shallow @@ -392,7 +392,7 @@ subroutine convect_shallow_tend( ztodt , cmfmc , & ! --------------- ! - ! Local Variables ! + ! Local Variables ! ! --------------- ! integer :: i, k, m integer :: n, x @@ -432,7 +432,7 @@ subroutine convect_shallow_tend( ztodt , cmfmc , & real(r8) :: pcnb(pcols) ! Bottom pressure level of shallow + deep convective activity real(r8) :: cmfsl(pcols,pverp ) ! Convective flux of liquid water static energy real(r8) :: cmflq(pcols,pverp ) ! Convective flux of total water in energy unit - + real(r8) :: ftem_preCu(pcols,pver) ! Saturation vapor pressure after shallow Cu convection real(r8) :: tem2(pcols,pver) ! Saturation specific humidity and RH real(r8) :: t_preCu(pcols,pver) ! Temperature after shallow Cu convection @@ -442,7 +442,7 @@ subroutine convect_shallow_tend( ztodt , cmfmc , & real(r8) :: icwmr_UW(pcols,pver) ! In-cloud Cumulus LWC [ kg/m2 ] real(r8) :: icimr_UW(pcols,pver) ! In-cloud Cumulus IWC [ kg/m2 ] real(r8) :: ptend_tracer(pcols,pver,pcnst) ! Tendencies of tracers - real(r8) :: sum1, sum2, sum3, pdelx + real(r8) :: sum1, sum2, sum3, pdelx real(r8) :: landfracdum(pcols) real(r8), dimension(pcols,pver) :: sl, qt, slv @@ -476,14 +476,14 @@ subroutine convect_shallow_tend( ztodt , cmfmc , & type(unicon_out_t) :: unicon_out ! ----------------------- ! - ! Main Computation Begins ! + ! Main Computation Begins ! ! ----------------------- ! zero = 0._r8 nstep = get_nstep() lchnk = state%lchnk ncol = state%ncol - + call physics_state_copy( state, state1 ) ! Copy state to local state1. ! Associate pointers with physics buffer fields @@ -553,7 +553,7 @@ subroutine convect_shallow_tend( ztodt , cmfmc , & snow = 0._r8 case('Hack') ! Hack scheme - + lq(:) = .TRUE. call physics_ptend_init( ptend_loc, state%psetcols, 'cmfmca', ls=.true., lq=lq ) ! Initialize local ptend type @@ -565,7 +565,7 @@ subroutine convect_shallow_tend( ztodt , cmfmc , & state%rpdel , state%zm , tpert , qpert , state%phis , & pblh , state%t , state%q , ptend_loc%s , ptend_loc%q , & cmfmc2 , rprdsh , cmfsl , cmflq , precc , & - qc2 , cnt2 , cnb2 , icwmr , rliq2 , & + qc2 , cnt2 , cnb2 , icwmr , rliq2 , & state%pmiddry, state%pdeldry, state%rpdeldry ) case('UW') ! UW shallow convection scheme @@ -576,7 +576,7 @@ subroutine convect_shallow_tend( ztodt , cmfmc , & ! Initialize local ptend type lq(:) = .TRUE. - call physics_ptend_init( ptend_loc, state%psetcols, 'UWSHCU', ls=.true., lu=.true., lv=.true., lq=lq ) + call physics_ptend_init( ptend_loc, state%psetcols, 'UWSHCU', ls=.true., lu=.true., lv=.true., lq=lq ) call pbuf_get_field(pbuf, cush_idx, cush ,(/1,itim_old/), (/pcols,1/)) call pbuf_get_field(pbuf, tke_idx, tke) @@ -587,7 +587,7 @@ subroutine convect_shallow_tend( ztodt , cmfmc , & call pbuf_get_field(pbuf, sh_e_ed_ratio_idx, sh_e_ed_ratio) call compute_uwshcu_inv( pcols , pver , ncol , pcnst , ztodt , & - state%pint, state%zi, state%pmid , state%zm , state%pdel , & + state%pint, state%zi, state%pmid , state%zm , state%pdel , & state%u , state%v , state%q(:,:,1) , state%q(:,:,ixcldliq), state%q(:,:,ixcldice), & state%t , state%s , state%q(:,:,:) , & tke , cld , concld , pblh , cush , & @@ -606,14 +606,14 @@ subroutine convect_shallow_tend( ztodt , cmfmc , & ! In addition, define 'icwmr' which includes both liquid and ice. ! ! --------------------------------------------------------------------- ! - icwmr(:ncol,:) = iccmr_UW(:ncol,:) + icwmr(:ncol,:) = iccmr_UW(:ncol,:) rprdsh(:ncol,:) = rprdsh(:ncol,:) + cmfdqs(:ncol,:) do m = 4, pcnst ptend_loc%q(:ncol,:pver,m) = ptend_tracer(:ncol,:pver,m) enddo ! Conservation check - + ! do i = 1, ncol ! do m = 1, pcnst ! sum1 = 0._r8 @@ -626,8 +626,8 @@ subroutine convect_shallow_tend( ztodt , cmfmc , & ! pdelx = state%pdeldry(i,k) ! endif ! sum1 = sum1 + state%q(i,k,m)*pdelx - ! sum2 = sum2 +(state%q(i,k,m)+ptend_loc%q(i,k,m)*ztodt)*pdelx - ! sum3 = sum3 + ptend_loc%q(i,k,m)*pdelx + ! sum2 = sum2 +(state%q(i,k,m)+ptend_loc%q(i,k,m)*ztodt)*pdelx + ! sum3 = sum3 + ptend_loc%q(i,k,m)*pdelx ! enddo ! if( m .gt. 3 .and. abs(sum1) .gt. 1.e-13_r8 .and. abs(sum2-sum1)/sum1 .gt. 1.e-12_r8 ) then !! if( m .gt. 3 .and. abs(sum3) .gt. 1.e-13_r8 ) then @@ -671,7 +671,7 @@ subroutine convect_shallow_tend( ztodt , cmfmc , & end select - ! --------------------------------------------------------! + ! --------------------------------------------------------! ! Calculate fractional occurance of shallow convection ! ! --------------------------------------------------------! @@ -696,7 +696,7 @@ subroutine convect_shallow_tend( ztodt , cmfmc , & ! -------------------------------------------------------------- ! ! 'cnt2' & 'cnb2' are from shallow, 'cnt' & 'cnb' are from deep ! - ! 'cnt2' & 'cnb2' are the interface indices of cloud top & base: ! + ! 'cnt2' & 'cnb2' are the interface indices of cloud top & base: ! ! cnt2 = float(kpen) ! ! cnb2 = float(krel - 1) ! ! Note that indices decreases with height. ! @@ -707,28 +707,28 @@ subroutine convect_shallow_tend( ztodt , cmfmc , & if( cnb2(i) > cnb(i)) cnb(i) = cnb2(i) if( cnb(i) == 1._r8 ) cnb(i) = cnt(i) pcnt(i) = state%pmid(i,int(cnt(i))) - pcnb(i) = state%pmid(i,int(cnb(i))) + pcnb(i) = state%pmid(i,int(cnb(i))) end do - + ! ----------------------------------------------- ! ! This quantity was previously known as CMFDQR. ! ! Now CMFDQR is the shallow rain production only. ! ! ----------------------------------------------- ! - + call pbuf_set_field(pbuf, rprdtot_idx, rprdsh(:ncol,:pver) + rprddp(:ncol,:pver), start=(/1,1/), kount=(/ncol,pver/)) - - ! ----------------------------------------------------------------------- ! + + ! ----------------------------------------------------------------------- ! ! Add shallow reserved cloud condensate to deep reserved cloud condensate ! ! qc [ kg/kg/s] , rliq [ m/s ] ! ! ----------------------------------------------------------------------- ! qc(:ncol,:pver) = qc(:ncol,:pver) + qc2(:ncol,:pver) - rliq(:ncol) = rliq(:ncol) + rliq2(:ncol) + rliq(:ncol) = rliq(:ncol) + rliq2(:ncol) ! ---------------------------------------------------------------------------- ! ! Output new partition of cloud condensate variables, as well as precipitation ! - ! ---------------------------------------------------------------------------- ! + ! ---------------------------------------------------------------------------- ! if( microp_scheme == 'MG' ) then call cnst_get_ind( 'NUMLIQ', ixnumliq ) @@ -752,12 +752,12 @@ subroutine convect_shallow_tend( ztodt , cmfmc , & call outfld( 'CLDTOP' , cnt , pcols , lchnk ) call outfld( 'CLDBOT' , cnb , pcols , lchnk ) call outfld( 'PCLDTOP', pcnt , pcols , lchnk ) - call outfld( 'PCLDBOT', pcnb , pcols , lchnk ) + call outfld( 'PCLDBOT', pcnb , pcols , lchnk ) call outfld( 'FREQSH' , freqsh , pcols , lchnk ) if( shallow_scheme .eq. 'UW' ) then call outfld( 'CBMF' , cbmf , pcols , lchnk ) - call outfld( 'UWFLXPRC', flxprec , pcols , lchnk ) + call outfld( 'UWFLXPRC', flxprec , pcols , lchnk ) call outfld( 'UWFLXSNW' , flxsnow , pcols , lchnk ) endif @@ -795,8 +795,8 @@ subroutine convect_shallow_tend( ztodt , cmfmc , & call outfld( 't_pre_Cu ', state1%t , pcols, lchnk ) call outfld( 'rh_pre_Cu ', ftem_preCu , pcols, lchnk ) - ! ----------------------------------------------- ! - ! Update physics state type state1 with ptend_loc ! + ! ----------------------------------------------- ! + ! Update physics state type state1 with ptend_loc ! ! ----------------------------------------------- ! call physics_update( state1, ptend_loc, ztodt ) @@ -827,8 +827,8 @@ subroutine convect_shallow_tend( ztodt , cmfmc , & call outfld( 't_aft_Cu ', state1%t , pcols, lchnk ) call outfld( 'rh_aft_Cu ', ftem , pcols, lchnk ) - tten(:ncol,:) = ( state1%t(:ncol,:pver) - t_preCu(:ncol,:) ) / ztodt - rhten(:ncol,:) = ( ftem(:ncol,:) - ftem_preCu(:ncol,:) ) / ztodt + tten(:ncol,:) = ( state1%t(:ncol,:pver) - t_preCu(:ncol,:) ) / ztodt + rhten(:ncol,:) = ( ftem(:ncol,:) - ftem_preCu(:ncol,:) ) / ztodt call outfld( 'tten_Cu ', tten , pcols, lchnk ) call outfld( 'rhten_Cu ', rhten , pcols, lchnk ) @@ -837,7 +837,7 @@ subroutine convect_shallow_tend( ztodt , cmfmc , & ! ------------------------------------------------------------------------ ! ! UW-Shallow Cumulus scheme includes ! ! evaporation physics inside in it. So when 'shallow_scheme = UW', we must ! - ! NOT perform below 'zm_conv_evap'. ! + ! NOT perform below 'zm_conv_evap_run'. ! ! ------------------------------------------------------------------------ ! if( shallow_scheme .eq. 'Hack' ) then @@ -855,7 +855,7 @@ subroutine convect_shallow_tend( ztodt , cmfmc , & lq(1) = .TRUE. lq(2:) = .FALSE. - call physics_ptend_init(ptend_loc, state1%psetcols, 'zm_conv_evap', ls=.true., lq=lq) + call physics_ptend_init(ptend_loc, state1%psetcols, 'zm_conv_evap_run', ls=.true., lq=lq) call pbuf_get_field(pbuf, sh_flxprc_idx, flxprec ) call pbuf_get_field(pbuf, sh_flxsnw_idx, flxsnow ) @@ -866,17 +866,18 @@ subroutine convect_shallow_tend( ztodt , cmfmc , & sh_cldliq(:ncol,:) = 0._r8 sh_cldice(:ncol,:) = 0._r8 - call zm_conv_evap( state1%ncol, state1%lchnk, & + call zm_conv_evap_run( state1%ncol, pcols, pver, pverp, & + gravit, latice, latvap, tmelt, & state1%t, state1%pmid, state1%pdel, state1%q(:pcols,:pver,1), & landfracdum, & - ptend_loc%s, tend_s_snwprd, tend_s_snwevmlt, & + ptend_loc%s, tend_s_snwprd, tend_s_snwevmlt, & ptend_loc%q(:pcols,:pver,1), & rprdsh, cld, ztodt, & precc, snow, ntprprd, ntsnprd , flxprec, flxsnow ) - ! ------------------------------------------ ! - ! record history variables from zm_conv_evap ! - ! ------------------------------------------ ! + ! ---------------------------------------------- ! + ! record history variables from zm_conv_evap_run ! + ! ---------------------------------------------- ! evapcsh(:ncol,:pver) = ptend_loc%q(:ncol,:pver,1) @@ -894,7 +895,7 @@ subroutine convect_shallow_tend( ztodt , cmfmc , & call outfld( 'HKNTSNPD' , ntsnprd , pcols, lchnk ) call outfld( 'HKEIHEAT' , ptend_loc%s , pcols, lchnk ) - ! ---------------------------------------------------------------- ! + ! ---------------------------------------------------------------- ! ! Add tendency from this process to tend from other processes here ! ! ---------------------------------------------------------------- ! diff --git a/src/physics/cam/macrop_driver.F90 b/src/physics/cam/macrop_driver.F90 index 3e7c276b3c..092848dd0e 100644 --- a/src/physics/cam/macrop_driver.F90 +++ b/src/physics/cam/macrop_driver.F90 @@ -6,7 +6,7 @@ module macrop_driver ! Provides the CAM interface to the prognostic cloud macrophysics ! ! Author: Andrew Gettelman, Cheryl Craig October 2010 - ! Origin: modified from stratiform.F90 elements + ! Origin: modified from stratiform.F90 elements ! (Boville 2002, Coleman 2004, Park 2009, Kay 2010) !------------------------------------------------------------------------------------------------------- @@ -22,7 +22,6 @@ module macrop_driver use perf_mod, only: t_startf, t_stopf use cam_logfile, only: iulog use cam_abortutils, only: endrun - use zm_conv_intr, only: zmconv_microp implicit none private @@ -42,12 +41,12 @@ module macrop_driver ! Private Module Parameters ! ! ------------------------- ! - ! 'cu_det_st' : If .true. (.false.), detrain cumulus liquid condensate into the pre-existing liquid stratus - ! (environment) without (with) macrophysical evaporation. If there is no pre-esisting stratus, + ! 'cu_det_st' : If .true. (.false.), detrain cumulus liquid condensate into the pre-existing liquid stratus + ! (environment) without (with) macrophysical evaporation. If there is no pre-esisting stratus, ! evaporate cumulus liquid condensate. This option only influences the treatment of cumulus ! liquid condensate, not cumulus ice condensate. - logical, parameter :: cu_det_st = .false. + logical, parameter :: cu_det_st = .false. ! Parameters used for selecting generalized critical RH for liquid and ice stratus integer :: rhminl_opt = 0 @@ -79,11 +78,11 @@ module macrop_driver ast_idx, &! stratiform cloud fraction index in physics buffer aist_idx, &! ice stratiform cloud fraction index in physics buffer alst_idx, &! liquid stratiform cloud fraction index in physics buffer - qist_idx, &! ice stratiform in-cloud IWC - qlst_idx, &! liquid stratiform in-cloud LWC + qist_idx, &! ice stratiform in-cloud IWC + qlst_idx, &! liquid stratiform in-cloud LWC concld_idx, &! concld index in physics buffer - fice_idx, & - cmeliq_idx, & + fice_idx, & + cmeliq_idx, & shfrc_idx integer :: & @@ -98,8 +97,8 @@ module macrop_driver qtl_flx_idx = -1, &! overbar(w'qtl' where qtl = qv + ql) from the PBL scheme qti_flx_idx = -1, &! overbar(w'qti' where qti = qv + qi) from the PBL scheme cmfr_det_idx = -1, &! detrained convective mass flux from UNICON - qlr_det_idx = -1, &! detrained convective ql from UNICON - qir_det_idx = -1, &! detrained convective qi from UNICON + qlr_det_idx = -1, &! detrained convective ql from UNICON + qir_det_idx = -1, &! detrained convective qi from UNICON cmfmc_sh_idx = -1 contains @@ -166,7 +165,7 @@ subroutine macrop_driver_register ! ! !---------------------------------------------------------------------- ! - + use physics_buffer, only : pbuf_add_field, dtype_r8, dyn_time_lvls !----------------------------------------------------------------------- @@ -203,12 +202,12 @@ subroutine macrop_driver_init(pbuf2d) !-------------------------------------------- ! ! ! ! Initialize the cloud water parameterization ! - ! ! + ! ! !-------------------------------------------- ! use physics_buffer, only : pbuf_get_index use cam_history, only: addfld, add_default use convect_shallow, only: convect_shallow_use_shfrc - + type(physics_buffer_desc), pointer :: pbuf2d(:,:) logical :: history_aerosol ! Output the MAM aerosol tendencies @@ -234,7 +233,7 @@ subroutine macrop_driver_init(pbuf2d) if( convect_shallow_use_shfrc() ) then use_shfrc = .true. shfrc_idx = pbuf_get_index('shfrc') - else + else use_shfrc = .false. endif @@ -269,7 +268,7 @@ subroutine macrop_driver_init(pbuf2d) call addfld ('CLDST', (/ 'lev' /), 'A', 'fraction', 'Stratus cloud fraction' ) call addfld ('CONCLD', (/ 'lev' /), 'A', 'fraction', 'Convective cloud cover' ) - + call addfld ('CLR_LIQ', (/ 'lev' /), 'A', 'fraction', 'Clear sky fraction for liquid stratus' ) call addfld ('CLR_ICE', (/ 'lev' /), 'A', 'fraction', 'Clear sky fraction for ice stratus' ) @@ -299,7 +298,7 @@ subroutine macrop_driver_init(pbuf2d) call add_default ('MACPDQ ', history_budget_histfile_num, ' ') call add_default ('MACPDLIQ ', history_budget_histfile_num, ' ') call add_default ('MACPDICE ', history_budget_histfile_num, ' ') - + call add_default ('CLDVAPADJ', history_budget_histfile_num, ' ') call add_default ('CLDLIQLIM', history_budget_histfile_num, ' ') call add_default ('CLDLIQDET', history_budget_histfile_num, ' ') @@ -328,14 +327,6 @@ subroutine macrop_driver_init(pbuf2d) CC_qlst_idx = pbuf_get_index('CC_qlst') cmfmc_sh_idx = pbuf_get_index('CMFMC_SH') - if (zmconv_microp) then - dlfzm_idx = pbuf_get_index('DLFZM') - difzm_idx = pbuf_get_index('DIFZM') - dnlfzm_idx = pbuf_get_index('DNLFZM') - dnifzm_idx = pbuf_get_index('DNIFZM') - end if - - if (rhminl_opt > 0 .or. rhmini_opt > 0) then cmfr_det_idx = pbuf_get_index('cmfr_det', istat) if (istat < 0) call endrun(subname//': macrop option requires cmfr_det in pbuf') @@ -361,7 +352,7 @@ subroutine macrop_driver_init(pbuf2d) end if end if - ! Init pbuf fields. Note that the fields CLD, CONCLD, QCWAT, LCWAT, + ! Init pbuf fields. Note that the fields CLD, CONCLD, QCWAT, LCWAT, ! ICCWAT, and TCWAT are initialized in phys_inidat. if (is_first_step()) then call pbuf_set_field(pbuf2d, ast_idx, 0._r8) @@ -392,13 +383,13 @@ subroutine macrop_driver_tend( & pbuf, & det_s, det_ice) - !-------------------------------------------------------- ! - ! ! + !-------------------------------------------------------- ! + ! ! ! Purpose: ! ! ! ! Interface to detrain, cloud fraction and ! ! cloud macrophysics subroutines ! - ! ! + ! ! ! Author: A. Gettelman, C. Craig, Oct 2010 ! ! based on stratiform_tend by D.B. Coleman 4/2010 ! ! ! @@ -438,7 +429,7 @@ subroutine macrop_driver_tend( & real(r8), intent(in) :: zdu(pcols,pver) ! Detrainment rate from deep convection - ! These two variables are needed for energy check + ! These two variables are needed for energy check real(r8), intent(out) :: det_s(pcols) ! Integral of detrained static energy from ice real(r8), intent(out) :: det_ice(pcols) ! Integral of detrained ice for energy check @@ -525,13 +516,13 @@ subroutine macrop_driver_tend( & real(r8) ltend(pcols,pver) ! Cloud liquid water tendencies real(r8) fice(pcols,pver) ! Fractional ice content within cloud real(r8) fsnow(pcols,pver) ! Fractional snow production - real(r8) homoo(pcols,pver) - real(r8) qcreso(pcols,pver) - real(r8) prcio(pcols,pver) - real(r8) praio(pcols,pver) + real(r8) homoo(pcols,pver) + real(r8) qcreso(pcols,pver) + real(r8) prcio(pcols,pver) + real(r8) praio(pcols,pver) real(r8) qireso(pcols,pver) real(r8) ftem(pcols,pver) - real(r8) pracso (pcols,pver) + real(r8) pracso (pcols,pver) real(r8) dpdlfliq(pcols,pver) real(r8) dpdlfice(pcols,pver) real(r8) shdlfliq(pcols,pver) @@ -575,11 +566,11 @@ subroutine macrop_driver_tend( & real(r8) qi_inout(pcols,pver) real(r8) concld_old(pcols,pver) - ! Note that below 'clr_old' is defined using 'alst_old' not 'ast_old' for full consistency with the - ! liquid condensation process which is using 'alst' not 'ast'. + ! Note that below 'clr_old' is defined using 'alst_old' not 'ast_old' for full consistency with the + ! liquid condensation process which is using 'alst' not 'ast'. ! For microconsistency use 'concld_old', since 'alst_old' was computed using 'concld_old'. ! Since convective updraft fractional area is small, it does not matter whether 'concld' or 'concld_old' is used. - ! Note also that 'clri_old' is defined using 'ast_old' since current microphysics is operating on 'ast_old' + ! Note also that 'clri_old' is defined using 'ast_old' since current microphysics is operating on 'ast_old' real(r8) clrw_old(pcols,pver) ! (1 - concld_old - alst_old) real(r8) clri_old(pcols,pver) ! (1 - concld_old - ast_old) @@ -669,7 +660,7 @@ subroutine macrop_driver_tend( & dlf_ni(:,:) = 0._r8 ! ------------------------------------- ! - ! From here, process computation begins ! + ! From here, process computation begins ! ! ------------------------------------- ! ! ----------------------------------------------------------------------------- ! @@ -689,23 +680,16 @@ subroutine macrop_driver_tend( & ! If convection scheme can handle this internally, this step is not necssary. ! (2) Assuming a certain effective droplet radius, computes number concentration ! of detrained convective cloud liquid and ice. - ! (3) If 'cu_det_st = .true' ('false'), detrain convective cloud 'liquid' into + ! (3) If 'cu_det_st = .true' ('false'), detrain convective cloud 'liquid' into ! the pre-existing 'liquid' stratus ( mean environment ). The former does ! not involve any macrophysical evaporation while the latter does. This is - ! a kind of 'targetted' deposition. Then, force in-stratus LWC to be bounded + ! a kind of 'targetted' deposition. Then, force in-stratus LWC to be bounded ! by qcst_min and qcst_max in mmacro_pcond. - ! (4) In contrast to liquid, convective ice is detrained into the environment + ! (4) In contrast to liquid, convective ice is detrained into the environment ! and involved in the sublimation. Similar bounds as liquid stratus are imposed. ! This is the key procesure generating upper-level cirrus clouds. ! The unit of dlf : [ kg/kg/s ] - if (zmconv_microp) then - call pbuf_get_field(pbuf, dlfzm_idx, dlfzm) - call pbuf_get_field(pbuf, difzm_idx, difzm) - call pbuf_get_field(pbuf, dnlfzm_idx, dnlfzm) - call pbuf_get_field(pbuf, dnifzm_idx, dnifzm) - end if - det_s(:) = 0._r8 det_ice(:) = 0._r8 @@ -729,57 +713,43 @@ subroutine macrop_driver_tend( & ! If detrainment was done elsewhere, still update the variables used for output ! assuming that the temperature split between liquid and ice is the same as assumed ! here. - if (zmconv_microp) then - ptend_loc%q(i,k,ixcldliq) = dlfzm(i,k) + dlf2(i,k) * ( 1._r8 - dum1 ) - ptend_loc%q(i,k,ixcldice) = difzm(i,k) + dlf2(i,k) * dum1 - - ptend_loc%q(i,k,ixnumliq) = dnlfzm(i,k) + 3._r8 * ( dlf2(i,k) * ( 1._r8 - dum1 ) ) & - / (4._r8*3.14_r8*10.e-6_r8**3*997._r8) ! Shallow Convection - ptend_loc%q(i,k,ixnumice) = dnifzm(i,k) + 3._r8 * ( dlf2(i,k) * dum1 ) & - / (4._r8*3.14_r8*50.e-6_r8**3*500._r8) ! Shallow Convection - ptend_loc%s(i,k) = dlf2(i,k) * dum1 * latice - - else - if (do_detrain) then + if (do_detrain) then ptend_loc%q(i,k,ixcldliq) = dlf(i,k) * ( 1._r8 - dum1 ) ptend_loc%q(i,k,ixcldice) = dlf(i,k) * dum1 ! dum2 = dlf(i,k) * ( 1._r8 - dum1 ) ptend_loc%q(i,k,ixnumliq) = 3._r8 * ( max(0._r8, ( dlf(i,k) - dlf2(i,k) )) * ( 1._r8 - dum1 ) ) / & (4._r8*3.14_r8* 8.e-6_r8**3*997._r8) + & ! Deep Convection 3._r8 * ( dlf2(i,k) * ( 1._r8 - dum1 ) ) / & - (4._r8*3.14_r8*10.e-6_r8**3*997._r8) ! Shallow Convection + (4._r8*3.14_r8*10.e-6_r8**3*997._r8) ! Shallow Convection ! dum2 = dlf(i,k) * dum1 ptend_loc%q(i,k,ixnumice) = 3._r8 * ( max(0._r8, ( dlf(i,k) - dlf2(i,k) )) * dum1 ) / & (4._r8*3.14_r8*25.e-6_r8**3*500._r8) + & ! Deep Convection 3._r8 * ( dlf2(i,k) * dum1 ) / & (4._r8*3.14_r8*50.e-6_r8**3*500._r8) ! Shallow Convection ptend_loc%s(i,k) = dlf(i,k) * dum1 * latice - else + else ptend_loc%q(i,k,ixcldliq) = 0._r8 ptend_loc%q(i,k,ixcldice) = 0._r8 ptend_loc%q(i,k,ixnumliq) = 0._r8 ptend_loc%q(i,k,ixnumice) = 0._r8 ptend_loc%s(i,k) = 0._r8 - end if - - end if ! Only rliq is saved from deep convection, which is the reserved liquid. We need to keep ! track of the integrals of ice and static energy that is effected from conversion to ice ! so that the energy checker doesn't complain. det_s(i) = det_s(i) + ptend_loc%s(i,k)*state_loc%pdel(i,k)/gravit - det_ice(i) = det_ice(i) - ptend_loc%q(i,k,ixcldice)*state_loc%pdel(i,k)/gravit + det_ice(i) = det_ice(i) - ptend_loc%q(i,k,ixcldice)*state_loc%pdel(i,k)/gravit ! Targetted detrainment of convective liquid water either directly into the - ! existing liquid stratus or into the environment. + ! existing liquid stratus or into the environment. if( cu_det_st ) then dlf_T(i,k) = ptend_loc%s(i,k)/cpair dlf_qv(i,k) = 0._r8 dlf_ql(i,k) = ptend_loc%q(i,k,ixcldliq) dlf_qi(i,k) = ptend_loc%q(i,k,ixcldice) dlf_nl(i,k) = ptend_loc%q(i,k,ixnumliq) - dlf_ni(i,k) = ptend_loc%q(i,k,ixnumice) + dlf_ni(i,k) = ptend_loc%q(i,k,ixnumice) ptend_loc%q(i,k,ixcldliq) = 0._r8 ptend_loc%q(i,k,ixcldice) = 0._r8 ptend_loc%q(i,k,ixnumliq) = 0._r8 @@ -792,15 +762,9 @@ subroutine macrop_driver_tend( & dpdlft (i,k) = 0._r8 shdlft (i,k) = 0._r8 else - if (zmconv_microp) then - dpdlfliq(i,k) = dlfzm(i,k) - dpdlfice(i,k) = difzm(i,k) - dpdlft (i,k) = 0._r8 - else - dpdlfliq(i,k) = ( dlf(i,k) - dlf2(i,k) ) * ( 1._r8 - dum1 ) - dpdlfice(i,k) = ( dlf(i,k) - dlf2(i,k) ) * ( dum1 ) - dpdlft (i,k) = ( dlf(i,k) - dlf2(i,k) ) * dum1 * latice/cpair - end if + dpdlfliq(i,k) = ( dlf(i,k) - dlf2(i,k) ) * ( 1._r8 - dum1 ) + dpdlfice(i,k) = ( dlf(i,k) - dlf2(i,k) ) * ( dum1 ) + dpdlft (i,k) = ( dlf(i,k) - dlf2(i,k) ) * dum1 * latice/cpair shdlfliq(i,k) = dlf2(i,k) * ( 1._r8 - dum1 ) shdlfice(i,k) = dlf2(i,k) * ( dum1 ) @@ -833,7 +797,7 @@ subroutine macrop_driver_tend( & ! -------------------------------------- ! ! ----------------------------------------------------------------------------- ! - ! Treatment of cloud fraction in CAM4 and CAM5 differs ! + ! Treatment of cloud fraction in CAM4 and CAM5 differs ! ! (1) CAM4 ! ! . Cumulus AMT = Deep Cumulus AMT ( empirical fcn of mass flux ) + ! ! Shallow Cumulus AMT ( empirical fcn of mass flux ) ! @@ -846,7 +810,7 @@ subroutine macrop_driver_tend( & ! . Stratus AMT = fcn of environmental-mean RH ( no Stability Stratus ) ! ! . Cumulus and Stratus are non-overlapped with higher priority on Cumulus ! ! . Cumulus ( both Deep and Shallow ) has its own LWC and IWC. ! - ! ----------------------------------------------------------------------------- ! + ! ----------------------------------------------------------------------------- ! concld_old(:ncol,top_lev:pver) = concld(:ncol,top_lev:pver) @@ -862,22 +826,22 @@ subroutine macrop_driver_tend( & clri_old(:ncol,:top_lev-1) = 0._r8 do k = top_lev, pver do i = 1, ncol - clrw_old(i,k) = max( 0._r8, min( 1._r8, 1._r8 - concld(i,k) - alst(i,k) ) ) - clri_old(i,k) = max( 0._r8, min( 1._r8, 1._r8 - concld(i,k) - ast(i,k) ) ) + clrw_old(i,k) = max( 0._r8, min( 1._r8, 1._r8 - concld(i,k) - alst(i,k) ) ) + clri_old(i,k) = max( 0._r8, min( 1._r8, 1._r8 - concld(i,k) - ast(i,k) ) ) end do end do if( use_shfrc ) then call pbuf_get_field(pbuf, shfrc_idx, shfrc ) - else + else allocate(shfrc(pcols,pver)) shfrc(:,:) = 0._r8 endif - ! CAM5 only uses 'concld' output from the below subroutine. + ! CAM5 only uses 'concld' output from the below subroutine. ! Stratus ('ast' = max(alst,aist)) and total cloud fraction ('cld = ast + concld') - ! will be computed using this updated 'concld' in the stratiform macrophysics - ! scheme (mmacro_pcond) later below. + ! will be computed using this updated 'concld' in the stratiform macrophysics + ! scheme (mmacro_pcond) later below. call t_startf("cldfrc") @@ -901,7 +865,7 @@ subroutine macrop_driver_tend( & rdtime = 1._r8/dtime ! Define fractional amount of stratus condensate and precipitation in ice phase. - ! This uses a ramp ( -30 ~ -10 for fice, -5 ~ 0 for fsnow ). + ! This uses a ramp ( -30 ~ -10 for fice, -5 ~ 0 for fsnow ). ! The ramp within convective cloud may be different call cldfrc_fice( ncol, state_loc%t, fice, fsnow ) @@ -918,7 +882,7 @@ subroutine macrop_driver_tend( & ! Initialize local physics_ptend object again call physics_ptend_init(ptend_loc, state%psetcols, 'macro_park', & - ls=.true., lq=lq ) + ls=.true., lq=lq ) ! --------------------------------- ! ! Liquid Macrop_Driver Macrophysics ! @@ -932,9 +896,9 @@ subroutine macrop_driver_tend( & nc(:ncol,top_lev:pver) = state_loc%q(:ncol,top_lev:pver,ixnumliq) ni(:ncol,top_lev:pver) = state_loc%q(:ncol,top_lev:pver,ixnumice) - ! In CAM5, 'microphysical forcing' ( CC_... ) and 'the other advective forcings' ( ttend, ... ) + ! In CAM5, 'microphysical forcing' ( CC_... ) and 'the other advective forcings' ( ttend, ... ) ! are separately provided into the prognostic microp_driver macrophysics scheme. This is an - ! attempt to resolve in-cloud and out-cloud forcings. + ! attempt to resolve in-cloud and out-cloud forcings. if( get_nstep() .le. 1 ) then tcwat(:ncol,top_lev:pver) = state_loc%t(:ncol,top_lev:pver) @@ -958,7 +922,7 @@ subroutine macrop_driver_tend( & CC_qlst(:ncol,:) = 0._r8 else ttend(:ncol,top_lev:pver) = ( state_loc%t(:ncol,top_lev:pver) - tcwat(:ncol,top_lev:pver)) * rdtime & - - CC_T(:ncol,top_lev:pver) + - CC_T(:ncol,top_lev:pver) qtend(:ncol,top_lev:pver) = ( state_loc%q(:ncol,top_lev:pver,1) - qcwat(:ncol,top_lev:pver)) * rdtime & - CC_qv(:ncol,top_lev:pver) ltend(:ncol,top_lev:pver) = ( qc(:ncol,top_lev:pver) + qi(:ncol,top_lev:pver) - lcwat(:ncol,top_lev:pver) ) * rdtime & @@ -972,7 +936,7 @@ subroutine macrop_driver_tend( & endif lmitend(:ncol,top_lev:pver) = ltend(:ncol,top_lev:pver) - itend(:ncol,top_lev:pver) - t_inout(:ncol,top_lev:pver) = tcwat(:ncol,top_lev:pver) + t_inout(:ncol,top_lev:pver) = tcwat(:ncol,top_lev:pver) qv_inout(:ncol,top_lev:pver) = qcwat(:ncol,top_lev:pver) ql_inout(:ncol,top_lev:pver) = lcwat(:ncol,top_lev:pver) - iccwat(:ncol,top_lev:pver) qi_inout(:ncol,top_lev:pver) = iccwat(:ncol,top_lev:pver) @@ -982,20 +946,20 @@ subroutine macrop_driver_tend( & ! Liquid Microp_Driver Macrophysics. ! The main roles of this subroutines are ! (1) compute net condensation rate of stratiform liquid ( cmeliq ) - ! (2) compute liquid stratus and ice stratus fractions. + ! (2) compute liquid stratus and ice stratus fractions. ! Note 'ttend...' are advective tendencies except microphysical process while - ! 'CC...' are microphysical tendencies. + ! 'CC...' are microphysical tendencies. call mmacro_pcond( lchnk, ncol, dtime, state_loc%pmid, state_loc%pdel, & - t_inout, qv_inout, ql_inout, qi_inout, nl_inout, ni_inout, & + t_inout, qv_inout, ql_inout, qi_inout, nl_inout, ni_inout, & ttend, qtend, lmitend, itend, nltend, nitend, & - CC_T, CC_qv, CC_ql, CC_qi, CC_nl, CC_ni, CC_qlst, & + CC_T, CC_qv, CC_ql, CC_qi, CC_nl, CC_ni, CC_qlst, & dlf_T, dlf_qv, dlf_ql, dlf_qi, dlf_nl, dlf_ni, & concld_old, concld, clrw_old, clri_old, landfrac, snowh, & tke, qtl_flx, qti_flx, cmfr_det, qlr_det, qir_det, & tlat, qvlat, qcten, qiten, ncten, niten, & cmeliq, qvadj, qladj, qiadj, qllim, qilim, & - cld, alst, aist, qlst, qist, do_cldice ) + cld, alst, aist, qlst, qist, do_cldice ) ! Copy of concld/fice to put in physics buffer ! Below are used only for convective cloud. @@ -1021,20 +985,20 @@ subroutine macrop_driver_tend( & ! Check to make sure that the macrophysics code is respecting the flags that control ! whether cldwat should be prognosing cloud ice and cloud liquid or not. - if ((.not. do_cldice) .and. (qiten(i,k) /= 0.0_r8)) then + if ((.not. do_cldice) .and. (qiten(i,k) /= 0.0_r8)) then call endrun("macrop_driver:ERROR - "// & "Cldwat is configured not to prognose cloud ice, but mmacro_pcond has ice mass tendencies.") end if - if ((.not. do_cldice) .and. (niten(i,k) /= 0.0_r8)) then + if ((.not. do_cldice) .and. (niten(i,k) /= 0.0_r8)) then call endrun("macrop_driver:ERROR -"// & " Cldwat is configured not to prognose cloud ice, but mmacro_pcond has ice number tendencies.") end if - if ((.not. do_cldliq) .and. (qcten(i,k) /= 0.0_r8)) then + if ((.not. do_cldliq) .and. (qcten(i,k) /= 0.0_r8)) then call endrun("macrop_driver:ERROR - "// & "Cldwat is configured not to prognose cloud liquid, but mmacro_pcond has liquid mass tendencies.") end if - if ((.not. do_cldliq) .and. (ncten(i,k) /= 0.0_r8)) then + if ((.not. do_cldliq) .and. (ncten(i,k) /= 0.0_r8)) then call endrun("macrop_driver:ERROR - "// & "Cldwat is configured not to prognose cloud liquid, but mmacro_pcond has liquid number tendencies.") end if @@ -1064,7 +1028,7 @@ subroutine macrop_driver_tend( & call outfld( 'ICECLDF ', aist, pcols, lchnk ) call outfld( 'LIQCLDF ', alst, pcols, lchnk ) - call outfld( 'AST', ast, pcols, lchnk ) + call outfld( 'AST', ast, pcols, lchnk ) call outfld( 'CONCLD ', concld, pcols, lchnk ) call outfld( 'CLDST ', cldst, pcols, lchnk ) @@ -1075,7 +1039,7 @@ subroutine macrop_driver_tend( & ! calculations and outfld calls for CLDLIQSTR, CLDICESTR, CLDLIQCON, CLDICECON for CFMIP ! initialize local variables - mr_ccliq = 0._r8 !! not seen by radiation, so setting to 0 + mr_ccliq = 0._r8 !! not seen by radiation, so setting to 0 mr_ccice = 0._r8 !! not seen by radiation, so setting to 0 mr_lsliq = 0._r8 mr_lsice = 0._r8 @@ -1098,7 +1062,7 @@ subroutine macrop_driver_tend( & call outfld( 'CLDICECON ', mr_ccice, pcols, lchnk ) ! ------------------------------------------------- ! - ! Save equilibrium state variables for macrophysics ! + ! Save equilibrium state variables for macrophysics ! ! at the next time step ! ! ------------------------------------------------- ! cldsice = 0._r8 @@ -1125,7 +1089,7 @@ end subroutine macrop_driver_tend ! With CLUBB, we are seeing relative humidity with respect to water ! greater than 1. This should not be happening and is not what the ! microphsyics expects from the macrophysics. As a work around while -! this issue is investigated in CLUBB, this routine will enfornce a +! this issue is investigated in CLUBB, this routine will enfornce a ! maximum RHliq of 1 everywhere in the atmosphere. Any excess water will ! be converted into cloud drops. subroutine liquid_macro_tend(npccn,t,p,qv,qc,nc,xxlv,deltat,stend,qvtend,qctend,nctend,vlen) @@ -1136,7 +1100,7 @@ subroutine liquid_macro_tend(npccn,t,p,qv,qc,nc,xxlv,deltat,stend,qvtend,qctend, use cldfrc2m, only: rhmini_const, rhmaxi_const integer, intent(in) :: vlen - real(r8), dimension(vlen), intent(in) :: npccn !Activated number of cloud condensation nuclei + real(r8), dimension(vlen), intent(in) :: npccn !Activated number of cloud condensation nuclei real(r8), dimension(vlen), intent(in) :: t !temperature (k) real(r8), dimension(vlen), intent(in) :: p !pressure (pa) real(r8), dimension(vlen), intent(in) :: qv !water vapor mixing ratio @@ -1144,18 +1108,18 @@ subroutine liquid_macro_tend(npccn,t,p,qv,qc,nc,xxlv,deltat,stend,qvtend,qctend, real(r8), dimension(vlen), intent(in) :: nc !liquid number concentration real(r8), intent(in) :: xxlv !latent heat of vaporization real(r8), intent(in) :: deltat !timestep - real(r8), dimension(vlen), intent(out) :: stend ! 'temperature' tendency + real(r8), dimension(vlen), intent(out) :: stend ! 'temperature' tendency real(r8), dimension(vlen), intent(out) :: qvtend !vapor tendency real(r8), dimension(vlen), intent(out) :: qctend !liquid mass tendency - real(r8), dimension(vlen), intent(out) :: nctend !liquid number tendency + real(r8), dimension(vlen), intent(out) :: nctend !liquid number tendency real(r8) :: ESL(vlen) real(r8) :: QSL(vlen) - real(r8) :: drop_size_param + real(r8) :: drop_size_param integer :: i drop_size_param = 3._r8/(4._r8*3.14_r8*6.e-6_r8**3*rhow) - + do i = 1, vlen stend(i) = 0._r8 qvtend(i) = 0._r8 @@ -1164,18 +1128,18 @@ subroutine liquid_macro_tend(npccn,t,p,qv,qc,nc,xxlv,deltat,stend,qvtend,qctend, end do ! calculate qsatl from t,p,q - !$acc data copyin(t,p) copyout(ESL,QSL) + !$acc data copyin(t,p) copyout(ESL,QSL) call wv_sat_qsat_water_vect(t, p, ESL, QSL, vlen) !$acc end data do i = 1, vlen ! Don't allow supersaturation with respect to liquid. if (qv(i) > QSL(i)) then - + qctend(i) = (qv(i) - QSL(i)) / deltat qvtend(i) = 0._r8 - qctend(i) stend(i) = qctend(i) * xxlv ! moist static energy tend...[J/kg/s] ! - + ! If drops exists (more than 1 L-1) and there is condensation, ! do not add to number (= growth), otherwise add 6um drops. ! diff --git a/src/physics/cam/zm_conv.F90 b/src/physics/cam/zm_conv.F90 deleted file mode 100644 index 6305f6ba6d..0000000000 --- a/src/physics/cam/zm_conv.F90 +++ /dev/null @@ -1,4825 +0,0 @@ -module zm_conv - -!--------------------------------------------------------------------------------- -! Purpose: -! -! Interface from Zhang-McFarlane convection scheme, includes evaporation of convective -! precip from the ZM scheme -! -! Apr 2006: RBN: Code added to perform a dilute ascent for closure of the CM mass flux -! based on an entraining plume a la Raymond and Blythe (1992) -! -! Author: Byron Boville, from code in tphysbc -! -!--------------------------------------------------------------------------------- - use shr_kind_mod, only: r8 => shr_kind_r8 - use spmd_utils, only: masterproc - use ppgrid, only: pcols, pver, pverp - use cloud_fraction, only: cldfrc_fice - use physconst, only: cpair, epsilo, gravit, latice, latvap, tmelt, rair, & - cpwv, cpliq, rh2o - use cam_abortutils, only: endrun - use cam_logfile, only: iulog - use zm_microphysics, only: zm_mphy, zm_aero_t, zm_conv_t - use cam_history, only: outfld - - implicit none - - save - private ! Make default type private to the module -! -! PUBLIC: interfaces -! - public zm_convi ! ZM schemea - public zm_convr ! ZM schemea - public zm_conv_evap ! evaporation of precip from ZM schemea - public convtran ! convective transport - public momtran ! convective momentum transport - -! -! Private data -! - real(r8) rl ! wg latent heat of vaporization. - real(r8) cpres ! specific heat at constant pressure in j/kg-degk. - real(r8) :: capelmt ! namelist configurable: - ! threshold value for cape for deep convection. - real(r8) :: ke ! Tunable evaporation efficiency set from namelist input zmconv_ke - real(r8) :: ke_lnd - real(r8) :: c0_lnd ! set from namelist input zmconv_c0_lnd - real(r8) :: c0_ocn ! set from namelist input zmconv_c0_ocn - integer :: num_cin ! set from namelist input zmconv_num_cin - ! The number of negative buoyancy regions that are allowed - ! before the convection top and CAPE calculations are completed. - logical :: zm_org - real(r8) tau ! convective time scale - real(r8),parameter :: c1 = 6.112_r8 - real(r8),parameter :: c2 = 17.67_r8 - real(r8),parameter :: c3 = 243.5_r8 - real(r8) :: tfreez - real(r8) :: eps1 - real(r8) :: momcu - real(r8) :: momcd - - logical :: zmconv_microp - - logical :: no_deep_pbl ! default = .false. - ! no_deep_pbl = .true. eliminates deep convection entirely within PBL - - -!moved from moistconvection.F90 - real(r8) :: rgrav ! reciprocal of grav - real(r8) :: rgas ! gas constant for dry air - real(r8) :: grav ! = gravit - real(r8) :: cp ! = cpres = cpair - - integer limcnv ! top interface level limit for convection - - logical :: lparcel_pbl ! Switch to turn on mixing of parcel MSE air, and picking launch level to be the top of the PBL. - - - real(r8) :: tiedke_add ! namelist configurable - real(r8) :: dmpdz_param ! namelist configurable - -contains - - -subroutine zm_convi(limcnv_in, zmconv_c0_lnd, zmconv_c0_ocn, zmconv_ke, zmconv_ke_lnd, & - zmconv_momcu, zmconv_momcd, zmconv_num_cin, zmconv_org, & - zmconv_microp_in, no_deep_pbl_in, zmconv_tiedke_add, & - zmconv_capelmt, zmconv_dmpdz, zmconv_parcel_pbl, zmconv_tau) - - integer, intent(in) :: limcnv_in ! top interface level limit for convection - integer, intent(in) :: zmconv_num_cin ! Number negative buoyancy regions that are allowed - ! before the convection top and CAPE calculations are completed. - real(r8),intent(in) :: zmconv_c0_lnd - real(r8),intent(in) :: zmconv_c0_ocn - real(r8),intent(in) :: zmconv_ke - real(r8),intent(in) :: zmconv_ke_lnd - real(r8),intent(in) :: zmconv_momcu - real(r8),intent(in) :: zmconv_momcd - logical :: zmconv_org - logical, intent(in) :: zmconv_microp_in - logical, intent(in) :: no_deep_pbl_in ! no_deep_pbl = .true. eliminates ZM convection entirely within PBL - real(r8),intent(in) :: zmconv_tiedke_add - real(r8),intent(in) :: zmconv_capelmt - real(r8),intent(in) :: zmconv_dmpdz - logical, intent(in) :: zmconv_parcel_pbl ! Should the parcel properties include PBL mixing? - real(r8),intent(in) :: zmconv_tau - - ! Initialization of ZM constants - limcnv = limcnv_in - tfreez = tmelt - eps1 = epsilo - rl = latvap - cpres = cpair - rgrav = 1.0_r8/gravit - rgas = rair - grav = gravit - cp = cpres - - c0_lnd = zmconv_c0_lnd - c0_ocn = zmconv_c0_ocn - num_cin = zmconv_num_cin - ke = zmconv_ke - ke_lnd = zmconv_ke_lnd - zm_org = zmconv_org - momcu = zmconv_momcu - momcd = zmconv_momcd - - zmconv_microp = zmconv_microp_in - - tiedke_add = zmconv_tiedke_add - capelmt = zmconv_capelmt - dmpdz_param = zmconv_dmpdz - no_deep_pbl = no_deep_pbl_in - lparcel_pbl = zmconv_parcel_pbl - - tau = zmconv_tau - - if ( masterproc ) then - write(iulog,*) 'tuning parameters zm_convi: tau',tau - write(iulog,*) 'tuning parameters zm_convi: c0_lnd',c0_lnd, ', c0_ocn', c0_ocn - write(iulog,*) 'tuning parameters zm_convi: num_cin', num_cin - write(iulog,*) 'tuning parameters zm_convi: ke',ke - write(iulog,*) 'tuning parameters zm_convi: no_deep_pbl',no_deep_pbl - write(iulog,*) 'tuning parameters zm_convi: zm_capelmt', capelmt - write(iulog,*) 'tuning parameters zm_convi: zm_dmpdz', dmpdz_param - write(iulog,*) 'tuning parameters zm_convi: zm_tiedke_add', tiedke_add - write(iulog,*) 'tuning parameters zm_convi: zm_parcel_pbl', lparcel_pbl - endif - - if (masterproc) write(iulog,*)'**** ZM: DILUTE Buoyancy Calculation ****' - -end subroutine zm_convi - - - -subroutine zm_convr(lchnk ,ncol , & - t ,qh ,prec ,jctop ,jcbot , & - pblh ,zm ,geos ,zi ,qtnd , & - heat ,pap ,paph ,dpp , & - delt ,mcon ,cme ,cape , & - tpert ,dlf ,pflx ,zdu ,rprd , & - mu ,md ,du ,eu ,ed , & - dp ,dsubcld ,jt ,maxg ,ideep , & - ql ,rliq ,landfrac, & - org ,orgt ,org2d , & - dif ,dnlf ,dnif ,conv , & - aero , rice) -!----------------------------------------------------------------------- -! -! Purpose: -! Main driver for zhang-mcfarlane convection scheme -! -! Method: -! performs deep convective adjustment based on mass-flux closure -! algorithm. -! -! Author:guang jun zhang, m.lazare, n.mcfarlane. CAM Contact: P. Rasch -! -! This is contributed code not fully standardized by the CAM core group. -! All variables have been typed, where most are identified in comments -! The current procedure will be reimplemented in a subsequent version -! of the CAM where it will include a more straightforward formulation -! and will make use of the standard CAM nomenclature -! -!----------------------------------------------------------------------- - use phys_control, only: cam_physpkg_is - -! -! ************************ index of variables ********************** -! -! wg * alpha array of vertical differencing used (=1. for upstream). -! w * cape convective available potential energy. -! wg * capeg gathered convective available potential energy. -! c * capelmt threshold value for cape for deep convection. -! ic * cpres specific heat at constant pressure in j/kg-degk. -! i * dpp -! ic * delt length of model time-step in seconds. -! wg * dp layer thickness in mbs (between upper/lower interface). -! wg * dqdt mixing ratio tendency at gathered points. -! wg * dsdt dry static energy ("temp") tendency at gathered points. -! wg * dudt u-wind tendency at gathered points. -! wg * dvdt v-wind tendency at gathered points. -! wg * dsubcld layer thickness in mbs between lcl and maxi. -! ic * grav acceleration due to gravity in m/sec2. -! wg * du detrainment in updraft. specified in mid-layer -! wg * ed entrainment in downdraft. -! wg * eu entrainment in updraft. -! wg * hmn moist static energy. -! wg * hsat saturated moist static energy. -! w * ideep holds position of gathered points vs longitude index. -! ic * pver number of model levels. -! wg * j0 detrainment initiation level index. -! wg * jd downdraft initiation level index. -! ic * jlatpr gaussian latitude index for printing grids (if needed). -! wg * jt top level index of deep cumulus convection. -! w * lcl base level index of deep cumulus convection. -! wg * lclg gathered values of lcl. -! w * lel index of highest theoretical convective plume. -! wg * lelg gathered values of lel. -! w * lon index of onset level for deep convection. -! w * maxi index of level with largest moist static energy. -! wg * maxg gathered values of maxi. -! wg * mb cloud base mass flux. -! wg * mc net upward (scaled by mb) cloud mass flux. -! wg * md downward cloud mass flux (positive up). -! wg * mu upward cloud mass flux (positive up). specified -! at interface -! ic * msg number of missing moisture levels at the top of model. -! w * p grid slice of ambient mid-layer pressure in mbs. -! i * pblt row of pbl top indices. -! w * pcpdh scaled surface pressure. -! w * pf grid slice of ambient interface pressure in mbs. -! wg * pg grid slice of gathered values of p. -! w * q grid slice of mixing ratio. -! wg * qd grid slice of mixing ratio in downdraft. -! wg * qg grid slice of gathered values of q. -! i/o * qh grid slice of specific humidity. -! w * qh0 grid slice of initial specific humidity. -! wg * qhat grid slice of upper interface mixing ratio. -! wg * ql grid slice of cloud liquid water. -! wg * qs grid slice of saturation mixing ratio. -! w * qstp grid slice of parcel temp. saturation mixing ratio. -! wg * qstpg grid slice of gathered values of qstp. -! wg * qu grid slice of mixing ratio in updraft. -! ic * rgas dry air gas constant. -! wg * rl latent heat of vaporization. -! w * s grid slice of scaled dry static energy (t+gz/cp). -! wg * sd grid slice of dry static energy in downdraft. -! wg * sg grid slice of gathered values of s. -! wg * shat grid slice of upper interface dry static energy. -! wg * su grid slice of dry static energy in updraft. -! i/o * t -! o * jctop row of top-of-deep-convection indices passed out. -! O * jcbot row of base of cloud indices passed out. -! wg * tg grid slice of gathered values of t. -! w * tl row of parcel temperature at lcl. -! wg * tlg grid slice of gathered values of tl. -! w * tp grid slice of parcel temperatures. -! wg * tpg grid slice of gathered values of tp. -! i/o * u grid slice of u-wind (real). -! wg * ug grid slice of gathered values of u. -! i/o * utg grid slice of u-wind tendency (real). -! i/o * v grid slice of v-wind (real). -! w * va work array re-used by called subroutines. -! wg * vg grid slice of gathered values of v. -! i/o * vtg grid slice of v-wind tendency (real). -! i * w grid slice of diagnosed large-scale vertical velocity. -! w * z grid slice of ambient mid-layer height in metres. -! w * zf grid slice of ambient interface height in metres. -! wg * zfg grid slice of gathered values of zf. -! wg * zg grid slice of gathered values of z. -! -!----------------------------------------------------------------------- -! -! multi-level i/o fields: -! i => input arrays. -! i/o => input/output arrays. -! w => work arrays. -! wg => work arrays operating only on gathered points. -! ic => input data constants. -! c => data constants pertaining to subroutine itself. -! -! input arguments -! - integer, intent(in) :: lchnk ! chunk identifier - integer, intent(in) :: ncol ! number of atmospheric columns - - real(r8), intent(in) :: t(pcols,pver) ! grid slice of temperature at mid-layer. - real(r8), intent(in) :: qh(pcols,pver) ! grid slice of specific humidity. - real(r8), intent(in) :: pap(pcols,pver) - real(r8), intent(in) :: paph(pcols,pver+1) - real(r8), intent(in) :: dpp(pcols,pver) ! local sigma half-level thickness (i.e. dshj). - real(r8), intent(in) :: zm(pcols,pver) - real(r8), intent(in) :: geos(pcols) - real(r8), intent(in) :: zi(pcols,pver+1) - real(r8), intent(in) :: pblh(pcols) - real(r8), intent(in) :: tpert(pcols) - real(r8), intent(in) :: landfrac(pcols) ! RBN Landfrac - - type(zm_conv_t), intent(inout) :: conv - type(zm_aero_t), intent(inout) :: aero ! aerosol object. intent(inout) because the - ! gathered arrays are set here - ! before passing object - ! to microphysics -! output arguments -! - real(r8), intent(out) :: qtnd(pcols,pver) ! specific humidity tendency (kg/kg/s) - real(r8), intent(out) :: heat(pcols,pver) ! heating rate (dry static energy tendency, W/kg) - real(r8), intent(out) :: mcon(pcols,pverp) - real(r8), intent(out) :: dlf(pcols,pver) ! scattrd version of the detraining cld h2o tend - real(r8), intent(out) :: pflx(pcols,pverp) ! scattered precip flux at each level - real(r8), intent(out) :: cme(pcols,pver) - real(r8), intent(out) :: cape(pcols) ! w convective available potential energy. - real(r8), intent(out) :: zdu(pcols,pver) - real(r8), intent(out) :: rprd(pcols,pver) ! rain production rate - real(r8), intent(out) :: dif(pcols,pver) ! detrained convective cloud ice mixing ratio. - real(r8), intent(out) :: dnlf(pcols,pver) ! detrained convective cloud water num concen. - real(r8), intent(out) :: dnif(pcols,pver) ! detrained convective cloud ice num concen. - -! move these vars from local storage to output so that convective -! transports can be done in outside of conv_cam. - real(r8), intent(out) :: mu(pcols,pver) - real(r8), intent(out) :: eu(pcols,pver) - real(r8), intent(out) :: du(pcols,pver) - real(r8), intent(out) :: md(pcols,pver) - real(r8), intent(out) :: ed(pcols,pver) - real(r8), intent(out) :: dp(pcols,pver) ! wg layer thickness in mbs (between upper/lower interface). - real(r8), intent(out) :: dsubcld(pcols) ! wg layer thickness in mbs between lcl and maxi. - real(r8), intent(out) :: jctop(pcols) ! o row of top-of-deep-convection indices passed out. - real(r8), intent(out) :: jcbot(pcols) ! o row of base of cloud indices passed out. - real(r8), intent(out) :: prec(pcols) - real(r8), intent(out) :: rliq(pcols) ! reserved liquid (not yet in cldliq) for energy integrals - real(r8), intent(out) :: rice(pcols) ! reserved ice (not yet in cldce) for energy integrals - - integer, intent(out) :: ideep(pcols) ! column indices of gathered points - - type(zm_conv_t) :: loc_conv - - real(r8), pointer :: org(:,:) ! Only used if zm_org is true - real(r8), pointer :: orgt(:,:) ! Only used if zm_org is true - real(r8), pointer :: org2d(:,:) ! Only used if zm_org is true - - real(r8) zs(pcols) - real(r8) dlg(pcols,pver) ! gathrd version of the detraining cld h2o tend - real(r8) pflxg(pcols,pverp) ! gather precip flux at each level - real(r8) cug(pcols,pver) ! gathered condensation rate - - real(r8) evpg(pcols,pver) ! gathered evap rate of rain in downdraft - real(r8) orgavg(pcols) - real(r8) dptot(pcols) - real(r8) mumax(pcols) - integer jt(pcols) ! wg top level index of deep cumulus convection. - integer maxg(pcols) ! wg gathered values of maxi. - integer lengath -! diagnostic field used by chem/wetdep codes - real(r8) ql(pcols,pver) ! wg grid slice of cloud liquid water. -! - real(r8) pblt(pcols) ! i row of pbl top indices. - - - - -! -!----------------------------------------------------------------------- -! -! general work fields (local variables): -! - real(r8) q(pcols,pver) ! w grid slice of mixing ratio. - real(r8) p(pcols,pver) ! w grid slice of ambient mid-layer pressure in mbs. - real(r8) z(pcols,pver) ! w grid slice of ambient mid-layer height in metres. - real(r8) s(pcols,pver) ! w grid slice of scaled dry static energy (t+gz/cp). - real(r8) tp(pcols,pver) ! w grid slice of parcel temperatures. - real(r8) zf(pcols,pver+1) ! w grid slice of ambient interface height in metres. - real(r8) pf(pcols,pver+1) ! w grid slice of ambient interface pressure in mbs. - real(r8) qstp(pcols,pver) ! w grid slice of parcel temp. saturation mixing ratio. - - real(r8) tl(pcols) ! w row of parcel temperature at lcl. - - integer lcl(pcols) ! w base level index of deep cumulus convection. - integer lel(pcols) ! w index of highest theoretical convective plume. - integer lon(pcols) ! w index of onset level for deep convection. - integer maxi(pcols) ! w index of level with largest moist static energy. - - real(r8) precip -! -! gathered work fields: -! - real(r8) qg(pcols,pver) ! wg grid slice of gathered values of q. - real(r8) tg(pcols,pver) ! w grid slice of temperature at interface. - real(r8) pg(pcols,pver) ! wg grid slice of gathered values of p. - real(r8) zg(pcols,pver) ! wg grid slice of gathered values of z. - real(r8) sg(pcols,pver) ! wg grid slice of gathered values of s. - real(r8) tpg(pcols,pver) ! wg grid slice of gathered values of tp. - real(r8) zfg(pcols,pver+1) ! wg grid slice of gathered values of zf. - real(r8) qstpg(pcols,pver) ! wg grid slice of gathered values of qstp. - real(r8) ug(pcols,pver) ! wg grid slice of gathered values of u. - real(r8) vg(pcols,pver) ! wg grid slice of gathered values of v. - real(r8) cmeg(pcols,pver) - - real(r8) rprdg(pcols,pver) ! wg gathered rain production rate - real(r8) capeg(pcols) ! wg gathered convective available potential energy. - real(r8) tlg(pcols) ! wg grid slice of gathered values of tl. - real(r8) landfracg(pcols) ! wg grid slice of landfrac - - integer lclg(pcols) ! wg gathered values of lcl. - integer lelg(pcols) -! -! work fields arising from gathered calculations. -! - real(r8) dqdt(pcols,pver) ! wg mixing ratio tendency at gathered points. - real(r8) dsdt(pcols,pver) ! wg dry static energy ("temp") tendency at gathered points. -! real(r8) alpha(pcols,pver) ! array of vertical differencing used (=1. for upstream). - real(r8) sd(pcols,pver) ! wg grid slice of dry static energy in downdraft. - real(r8) qd(pcols,pver) ! wg grid slice of mixing ratio in downdraft. - real(r8) mc(pcols,pver) ! wg net upward (scaled by mb) cloud mass flux. - real(r8) qhat(pcols,pver) ! wg grid slice of upper interface mixing ratio. - real(r8) qu(pcols,pver) ! wg grid slice of mixing ratio in updraft. - real(r8) su(pcols,pver) ! wg grid slice of dry static energy in updraft. - real(r8) qs(pcols,pver) ! wg grid slice of saturation mixing ratio. - real(r8) shat(pcols,pver) ! wg grid slice of upper interface dry static energy. - real(r8) hmn(pcols,pver) ! wg moist static energy. - real(r8) hsat(pcols,pver) ! wg saturated moist static energy. - real(r8) qlg(pcols,pver) - real(r8) dudt(pcols,pver) ! wg u-wind tendency at gathered points. - real(r8) dvdt(pcols,pver) ! wg v-wind tendency at gathered points. -! real(r8) ud(pcols,pver) -! real(r8) vd(pcols,pver) - - - - - - - - real(r8) qldeg(pcols,pver) ! cloud liquid water mixing ratio for detrainment (kg/kg) - real(r8) mb(pcols) ! wg cloud base mass flux. - - integer jlcl(pcols) - integer j0(pcols) ! wg detrainment initiation level index. - integer jd(pcols) ! wg downdraft initiation level index. - - real(r8) delt ! length of model time-step in seconds. - - integer i - integer ii - integer k, kk, l, m - - integer msg ! ic number of missing moisture levels at the top of model. - real(r8) qdifr - real(r8) sdifr - - real(r8), parameter :: dcon = 25.e-6_r8 - real(r8), parameter :: mucon = 5.3_r8 - real(r8) negadq - logical doliq - - -! -!--------------------------Data statements------------------------------ - -! -! Set internal variable "msg" (convection limit) to "limcnv-1" -! - msg = limcnv - 1 -! -! initialize necessary arrays. -! zero out variables not used in cam -! - - if (zm_org) then - orgt(:,:) = 0._r8 - end if - - qtnd(:,:) = 0._r8 - heat(:,:) = 0._r8 - mcon(:,:) = 0._r8 - rliq(:ncol) = 0._r8 - rice(:ncol) = 0._r8 - - if (zmconv_microp) then - allocate( & - loc_conv%frz(pcols,pver), & - loc_conv%sprd(pcols,pver), & - loc_conv%wu(pcols,pver), & - loc_conv%qi(pcols,pver), & - loc_conv%qliq(pcols,pver), & - loc_conv%qice(pcols,pver), & - loc_conv%qrain(pcols,pver), & - loc_conv%qsnow(pcols,pver), & - loc_conv%di(pcols,pver), & - loc_conv%dnl(pcols,pver), & - loc_conv%dni(pcols,pver), & - loc_conv%qnl(pcols,pver), & - loc_conv%qni(pcols,pver), & - loc_conv%qnr(pcols,pver), & - loc_conv%qns(pcols,pver), & - loc_conv%qide(pcols,pver), & - loc_conv%qncde(pcols,pver), & - loc_conv%qnide(pcols,pver), & - loc_conv%autolm(pcols,pver), & - loc_conv%accrlm(pcols,pver), & - loc_conv%bergnm(pcols,pver), & - loc_conv%fhtimm(pcols,pver), & - loc_conv%fhtctm(pcols,pver), & - loc_conv%fhmlm(pcols,pver), & - loc_conv%hmpim(pcols,pver), & - loc_conv%accslm(pcols,pver), & - loc_conv%dlfm(pcols,pver), & - loc_conv%cmel(pcols,pver), & - loc_conv%autoln(pcols,pver), & - loc_conv%accrln(pcols,pver), & - loc_conv%bergnn(pcols,pver), & - loc_conv%fhtimn(pcols,pver), & - loc_conv%fhtctn(pcols,pver), & - loc_conv%fhmln(pcols,pver), & - loc_conv%accsln(pcols,pver), & - loc_conv%activn(pcols,pver), & - loc_conv%dlfn(pcols,pver), & - loc_conv%autoim(pcols,pver), & - loc_conv%accsim(pcols,pver), & - loc_conv%difm(pcols,pver), & - loc_conv%cmei(pcols,pver), & - loc_conv%nuclin(pcols,pver), & - loc_conv%autoin(pcols,pver), & - loc_conv%accsin(pcols,pver), & - loc_conv%hmpin(pcols,pver), & - loc_conv%difn(pcols,pver), & - loc_conv%trspcm(pcols,pver), & - loc_conv%trspcn(pcols,pver), & - loc_conv%trspim(pcols,pver), & - loc_conv%trspin(pcols,pver), & - loc_conv%lambdadpcu(pcols,pver), & - loc_conv%mudpcu(pcols,pver), & - loc_conv%dcape(pcols) ) - end if - -! -! initialize convective tendencies -! - prec(:ncol) = 0._r8 - do k = 1,pver - do i = 1,ncol - dqdt(i,k) = 0._r8 - dsdt(i,k) = 0._r8 - dudt(i,k) = 0._r8 - dvdt(i,k) = 0._r8 - pflx(i,k) = 0._r8 - pflxg(i,k) = 0._r8 - cme(i,k) = 0._r8 - rprd(i,k) = 0._r8 - zdu(i,k) = 0._r8 - ql(i,k) = 0._r8 - qlg(i,k) = 0._r8 - dlf(i,k) = 0._r8 - dlg(i,k) = 0._r8 - qldeg(i,k) = 0._r8 - - dif(i,k) = 0._r8 - dnlf(i,k) = 0._r8 - dnif(i,k) = 0._r8 - - end do - end do - - if (zmconv_microp) then - do k = 1,pver - do i = 1,ncol - loc_conv%qliq(i,k) = 0._r8 - loc_conv%qice(i,k) = 0._r8 - loc_conv%di(i,k) = 0._r8 - loc_conv%qrain(i,k)= 0._r8 - loc_conv%qsnow(i,k)= 0._r8 - loc_conv%dnl(i,k) = 0._r8 - loc_conv%dni(i,k) = 0._r8 - loc_conv%wu(i,k) = 0._r8 - loc_conv%qnl(i,k) = 0._r8 - loc_conv%qni(i,k) = 0._r8 - loc_conv%qnr(i,k) = 0._r8 - loc_conv%qns(i,k) = 0._r8 - loc_conv%frz(i,k) = 0._r8 - loc_conv%sprd(i,k) = 0._r8 - loc_conv%qide(i,k) = 0._r8 - loc_conv%qncde(i,k) = 0._r8 - loc_conv%qnide(i,k) = 0._r8 - - loc_conv%autolm(i,k) = 0._r8 - loc_conv%accrlm(i,k) = 0._r8 - loc_conv%bergnm(i,k) = 0._r8 - loc_conv%fhtimm(i,k) = 0._r8 - loc_conv%fhtctm(i,k) = 0._r8 - loc_conv%fhmlm (i,k) = 0._r8 - loc_conv%hmpim (i,k) = 0._r8 - loc_conv%accslm(i,k) = 0._r8 - loc_conv%dlfm (i,k) = 0._r8 - - loc_conv%autoln(i,k) = 0._r8 - loc_conv%accrln(i,k) = 0._r8 - loc_conv%bergnn(i,k) = 0._r8 - loc_conv%fhtimn(i,k) = 0._r8 - loc_conv%fhtctn(i,k) = 0._r8 - loc_conv%fhmln (i,k) = 0._r8 - loc_conv%accsln(i,k) = 0._r8 - loc_conv%activn(i,k) = 0._r8 - loc_conv%dlfn (i,k) = 0._r8 - loc_conv%cmel (i,k) = 0._r8 - - loc_conv%autoim(i,k) = 0._r8 - loc_conv%accsim(i,k) = 0._r8 - loc_conv%difm (i,k) = 0._r8 - loc_conv%cmei (i,k) = 0._r8 - - loc_conv%nuclin(i,k) = 0._r8 - loc_conv%autoin(i,k) = 0._r8 - loc_conv%accsin(i,k) = 0._r8 - loc_conv%hmpin (i,k) = 0._r8 - loc_conv%difn (i,k) = 0._r8 - - loc_conv%trspcm(i,k) = 0._r8 - loc_conv%trspcn(i,k) = 0._r8 - loc_conv%trspim(i,k) = 0._r8 - loc_conv%trspin(i,k) = 0._r8 - - conv%qi(i,k) = 0._r8 - conv%frz(i,k) = 0._r8 - conv%sprd(i,k) = 0._r8 - conv%qi(i,k) = 0._r8 - conv%qliq(i,k) = 0._r8 - conv%qice(i,k) = 0._r8 - conv%qnl(i,k) = 0._r8 - conv%qni(i,k) = 0._r8 - conv%qnr(i,k) = 0._r8 - conv%qns(i,k) = 0._r8 - conv%qrain(i,k) = 0._r8 - conv%qsnow(i,k) = 0._r8 - conv%wu(i,k) = 0._r8 - - conv%autolm(i,k) = 0._r8 - conv%accrlm(i,k) = 0._r8 - conv%bergnm(i,k) = 0._r8 - conv%fhtimm(i,k) = 0._r8 - conv%fhtctm(i,k) = 0._r8 - conv%fhmlm (i,k) = 0._r8 - conv%hmpim (i,k) = 0._r8 - conv%accslm(i,k) = 0._r8 - conv%dlfm (i,k) = 0._r8 - - conv%autoln(i,k) = 0._r8 - conv%accrln(i,k) = 0._r8 - conv%bergnn(i,k) = 0._r8 - conv%fhtimn(i,k) = 0._r8 - conv%fhtctn(i,k) = 0._r8 - conv%fhmln (i,k) = 0._r8 - conv%accsln(i,k) = 0._r8 - conv%activn(i,k) = 0._r8 - conv%dlfn (i,k) = 0._r8 - conv%cmel (i,k) = 0._r8 - - conv%autoim(i,k) = 0._r8 - conv%accsim(i,k) = 0._r8 - conv%difm (i,k) = 0._r8 - conv%cmei (i,k) = 0._r8 - - conv%nuclin(i,k) = 0._r8 - conv%autoin(i,k) = 0._r8 - conv%accsin(i,k) = 0._r8 - conv%hmpin (i,k) = 0._r8 - conv%difn (i,k) = 0._r8 - - conv%trspcm(i,k) = 0._r8 - conv%trspcn(i,k) = 0._r8 - conv%trspim(i,k) = 0._r8 - conv%trspin(i,k) = 0._r8 - - end do - end do - - conv%lambdadpcu = (mucon + 1._r8)/dcon - conv%mudpcu = mucon - loc_conv%lambdadpcu = conv%lambdadpcu - loc_conv%mudpcu = conv%mudpcu - - end if - - do i = 1,ncol - pflx(i,pverp) = 0 - pflxg(i,pverp) = 0 - end do -! - do i = 1,ncol - pblt(i) = pver - dsubcld(i) = 0._r8 - - - jctop(i) = pver - jcbot(i) = 1 - - end do - - if (zmconv_microp) then - do i = 1,ncol - conv%dcape(i) = 0._r8 - loc_conv%dcape(i) = 0._r8 - end do - end if - - if (zm_org) then -! compute vertical average here - orgavg(:) = 0._r8 - dptot(:) = 0._r8 - - do k = 1, pver - do i = 1,ncol - if (org(i,k) .gt. 0) then - orgavg(i) = orgavg(i)+dpp(i,k)*org(i,k) - dptot(i) = dptot(i)+dpp(i,k) - endif - enddo - enddo - - do i = 1,ncol - if (dptot(i) .gt. 0) then - orgavg(i) = orgavg(i)/dptot(i) - endif - enddo - - do k = 1, pver - do i = 1, ncol - org2d(i,k) = orgavg(i) - enddo - enddo - - endif - -! -! calculate local pressure (mbs) and height (m) for both interface -! and mid-layer locations. -! - do i = 1,ncol - zs(i) = geos(i)*rgrav - pf(i,pver+1) = paph(i,pver+1)*0.01_r8 - zf(i,pver+1) = zi(i,pver+1) + zs(i) - end do - do k = 1,pver - do i = 1,ncol - p(i,k) = pap(i,k)*0.01_r8 - pf(i,k) = paph(i,k)*0.01_r8 - z(i,k) = zm(i,k) + zs(i) - zf(i,k) = zi(i,k) + zs(i) - end do - end do -! - do k = pver - 1,msg + 1,-1 - do i = 1,ncol - if (abs(z(i,k)-zs(i)-pblh(i)) < (zf(i,k)-zf(i,k+1))*0.5_r8) pblt(i) = k - end do - end do -! -! store incoming specific humidity field for subsequent calculation -! of precipitation (through change in storage). -! define dry static energy (normalized by cp). -! - do k = 1,pver - do i = 1,ncol - q(i,k) = qh(i,k) - s(i,k) = t(i,k) + (grav/cpres)*z(i,k) - tp(i,k)=0.0_r8 - shat(i,k) = s(i,k) - qhat(i,k) = q(i,k) - end do - end do - - do i = 1,ncol - capeg(i) = 0._r8 - lclg(i) = 1 - lelg(i) = pver - maxg(i) = 1 - tlg(i) = 400._r8 - dsubcld(i) = 0._r8 - end do - - if( cam_physpkg_is('cam3')) then - - ! For cam3 physics package, call non-dilute - - call buoyan(lchnk ,ncol , & - q ,t ,p ,z ,pf , & - tp ,qstp ,tl ,rl ,cape , & - pblt ,lcl ,lel ,lon ,maxi , & - rgas ,grav ,cpres ,msg , & - tpert ) - else - - ! Evaluate Tparcel, qs(Tparcel), buoyancy and CAPE, - ! lcl, lel, parcel launch level at index maxi()=hmax - - call buoyan_dilute(lchnk ,ncol , & - q ,t ,p ,z ,pf , & - tp ,qstp ,tl ,rl ,cape , & - pblt ,lcl ,lel ,lon ,maxi , & - rgas ,grav ,cpres ,msg , & - zi ,zs ,tpert , org2d , landfrac) - end if - -! -! determine whether grid points will undergo some deep convection -! (ideep=1) or not (ideep=0), based on values of cape,lcl,lel -! (require cape.gt. 0 and lel capelmt) then - lengath = lengath + 1 - ideep(lengath) = i - end if - end do - - if (lengath.eq.0) return -! -! obtain gathered arrays necessary for ensuing calculations. -! - do k = 1,pver - do i = 1,lengath - dp(i,k) = 0.01_r8*dpp(ideep(i),k) - qg(i,k) = q(ideep(i),k) - tg(i,k) = t(ideep(i),k) - pg(i,k) = p(ideep(i),k) - zg(i,k) = z(ideep(i),k) - sg(i,k) = s(ideep(i),k) - tpg(i,k) = tp(ideep(i),k) - zfg(i,k) = zf(ideep(i),k) - qstpg(i,k) = qstp(ideep(i),k) - ug(i,k) = 0._r8 - vg(i,k) = 0._r8 - end do - end do - - if (zmconv_microp) then - - if (aero%scheme == 'modal') then - - do m = 1, aero%nmodes - - do k = 1,pver - do i = 1,lengath - aero%numg_a(i,k,m) = aero%num_a(m)%val(ideep(i),k) - aero%dgnumg(i,k,m) = aero%dgnum(m)%val(ideep(i),k) - end do - end do - - do l = 1, aero%nspec(m) - do k = 1,pver - do i = 1,lengath - aero%mmrg_a(i,k,l,m) = aero%mmr_a(l,m)%val(ideep(i),k) - end do - end do - end do - - end do - - else if (aero%scheme == 'bulk') then - - do m = 1, aero%nbulk - do k = 1,pver - do i = 1,lengath - aero%mmrg_bulk(i,k,m) = aero%mmr_bulk(m)%val(ideep(i),k) - end do - end do - end do - - end if - - end if - -! - do i = 1,lengath - zfg(i,pver+1) = zf(ideep(i),pver+1) - end do - do i = 1,lengath - capeg(i) = cape(ideep(i)) - lclg(i) = lcl(ideep(i)) - lelg(i) = lel(ideep(i)) - maxg(i) = maxi(ideep(i)) - tlg(i) = tl(ideep(i)) - landfracg(i) = landfrac(ideep(i)) - end do -! -! calculate sub-cloud layer pressure "thickness" for use in -! closure and tendency routines. -! - do k = msg + 1,pver - do i = 1,lengath - if (k >= maxg(i)) then - dsubcld(i) = dsubcld(i) + dp(i,k) - end if - end do - end do -! -! define array of factors (alpha) which defines interfacial -! values, as well as interfacial values for (q,s) used in -! subsequent routines. -! - do k = msg + 2,pver - do i = 1,lengath -! alpha(i,k) = 0.5 - sdifr = 0._r8 - qdifr = 0._r8 - if (sg(i,k) > 0._r8 .or. sg(i,k-1) > 0._r8) & - sdifr = abs((sg(i,k)-sg(i,k-1))/max(sg(i,k-1),sg(i,k))) - if (qg(i,k) > 0._r8 .or. qg(i,k-1) > 0._r8) & - qdifr = abs((qg(i,k)-qg(i,k-1))/max(qg(i,k-1),qg(i,k))) - if (sdifr > 1.E-6_r8) then - shat(i,k) = log(sg(i,k-1)/sg(i,k))*sg(i,k-1)*sg(i,k)/(sg(i,k-1)-sg(i,k)) - else - shat(i,k) = 0.5_r8* (sg(i,k)+sg(i,k-1)) - end if - if (qdifr > 1.E-6_r8) then - qhat(i,k) = log(qg(i,k-1)/qg(i,k))*qg(i,k-1)*qg(i,k)/(qg(i,k-1)-qg(i,k)) - else - qhat(i,k) = 0.5_r8* (qg(i,k)+qg(i,k-1)) - end if - end do - end do -! -! obtain cloud properties. -! - - call cldprp(lchnk , & - qg ,tg ,ug ,vg ,pg , & - zg ,sg ,mu ,eu ,du , & - md ,ed ,sd ,qd ,mc , & - qu ,su ,zfg ,qs ,hmn , & - hsat ,shat ,qlg , & - cmeg ,maxg ,lelg ,jt ,jlcl , & - maxg ,j0 ,jd ,rl ,lengath , & - rgas ,grav ,cpres ,msg , & - pflxg ,evpg ,cug ,rprdg ,limcnv ,landfracg , & - qldeg ,aero ,loc_conv,qhat ) - - if (zmconv_microp) then - do i = 1,lengath - capeg(i) = capeg(i)+ loc_conv%dcape(i) - end do - end if - -! -! convert detrainment from units of "1/m" to "1/mb". -! - - do k = msg + 1,pver - do i = 1,lengath - du (i,k) = du (i,k)* (zfg(i,k)-zfg(i,k+1))/dp(i,k) - eu (i,k) = eu (i,k)* (zfg(i,k)-zfg(i,k+1))/dp(i,k) - ed (i,k) = ed (i,k)* (zfg(i,k)-zfg(i,k+1))/dp(i,k) - cug (i,k) = cug (i,k)* (zfg(i,k)-zfg(i,k+1))/dp(i,k) - cmeg (i,k) = cmeg (i,k)* (zfg(i,k)-zfg(i,k+1))/dp(i,k) - rprdg(i,k) = rprdg(i,k)* (zfg(i,k)-zfg(i,k+1))/dp(i,k) - evpg (i,k) = evpg (i,k)* (zfg(i,k)-zfg(i,k+1))/dp(i,k) - end do - end do - - if (zmconv_microp) then - do k = msg + 1,pver - do i = 1,lengath - loc_conv%sprd(i,k) = loc_conv%sprd(i,k)* (zfg(i,k)-zfg(i,k+1))/dp(i,k) - loc_conv%frz (i,k) = loc_conv%frz (i,k)* (zfg(i,k)-zfg(i,k+1))/dp(i,k) - end do - end do - end if - - call closure(lchnk , & - qg ,tg ,pg ,zg ,sg , & - tpg ,qs ,qu ,su ,mc , & - du ,mu ,md ,qd ,sd , & - qhat ,shat ,dp ,qstpg ,zfg , & - qlg ,dsubcld ,mb ,capeg ,tlg , & - lclg ,lelg ,jt ,maxg ,1 , & - lengath ,rgas ,grav ,cpres ,rl , & - msg ,capelmt ) -! -! limit cloud base mass flux to theoretical upper bound. -! - do i=1,lengath - mumax(i) = 0 - end do - do k=msg + 2,pver - do i=1,lengath - mumax(i) = max(mumax(i), mu(i,k)/dp(i,k)) - end do - end do - - do i=1,lengath - if (mumax(i) > 0._r8) then - mb(i) = min(mb(i),0.5_r8/(delt*mumax(i))) - else - mb(i) = 0._r8 - endif - end do - ! If no_deep_pbl = .true., don't allow convection entirely - ! within PBL (suggestion of Bjorn Stevens, 8-2000) - - if (no_deep_pbl) then - do i=1,lengath - if (zm(ideep(i),jt(i)) < pblh(ideep(i))) mb(i) = 0 - end do - end if - - if (zmconv_microp) then - do k=msg+1,pver - do i=1,lengath - loc_conv%sprd(i,k) = loc_conv%sprd(i,k)*mb(i) - loc_conv%frz (i,k) = loc_conv%frz (i,k)*mb(i) - end do - end do - end if - - do k=msg+1,pver - do i=1,lengath - mu (i,k) = mu (i,k)*mb(i) - md (i,k) = md (i,k)*mb(i) - mc (i,k) = mc (i,k)*mb(i) - du (i,k) = du (i,k)*mb(i) - eu (i,k) = eu (i,k)*mb(i) - ed (i,k) = ed (i,k)*mb(i) - cmeg (i,k) = cmeg (i,k)*mb(i) - rprdg(i,k) = rprdg(i,k)*mb(i) - cug (i,k) = cug (i,k)*mb(i) - evpg (i,k) = evpg (i,k)*mb(i) - pflxg(i,k+1)= pflxg(i,k+1)*mb(i)*100._r8/grav - - - if ( zmconv_microp .and. mb(i).eq.0._r8) then - qlg (i,k) = 0._r8 - loc_conv%qliq (i,k) = 0._r8 - loc_conv%qice (i,k) = 0._r8 - loc_conv%qrain(i,k) = 0._r8 - loc_conv%qsnow(i,k) = 0._r8 - loc_conv%wu(i,k) = 0._r8 - loc_conv%qnl (i,k) = 0._r8 - loc_conv%qni (i,k) = 0._r8 - loc_conv%qnr (i,k) = 0._r8 - loc_conv%qns (i,k) = 0._r8 - - loc_conv%autolm(i,k) = 0._r8 - loc_conv%accrlm(i,k) = 0._r8 - loc_conv%bergnm(i,k) = 0._r8 - loc_conv%fhtimm(i,k) = 0._r8 - loc_conv%fhtctm(i,k) = 0._r8 - loc_conv%fhmlm (i,k) = 0._r8 - loc_conv%hmpim (i,k) = 0._r8 - loc_conv%accslm(i,k) = 0._r8 - loc_conv%dlfm (i,k) = 0._r8 - - loc_conv%autoln(i,k) = 0._r8 - loc_conv%accrln(i,k) = 0._r8 - loc_conv%bergnn(i,k) = 0._r8 - loc_conv%fhtimn(i,k) = 0._r8 - loc_conv%fhtctn(i,k) = 0._r8 - loc_conv%fhmln (i,k) = 0._r8 - loc_conv%accsln(i,k) = 0._r8 - loc_conv%activn(i,k) = 0._r8 - loc_conv%dlfn (i,k) = 0._r8 - loc_conv%cmel (i,k) = 0._r8 - - loc_conv%autoim(i,k) = 0._r8 - loc_conv%accsim(i,k) = 0._r8 - loc_conv%difm (i,k) = 0._r8 - loc_conv%cmei (i,k) = 0._r8 - - loc_conv%nuclin(i,k) = 0._r8 - loc_conv%autoin(i,k) = 0._r8 - loc_conv%accsin(i,k) = 0._r8 - loc_conv%hmpin (i,k) = 0._r8 - loc_conv%difn (i,k) = 0._r8 - - loc_conv%trspcm(i,k) = 0._r8 - loc_conv%trspcn(i,k) = 0._r8 - loc_conv%trspim(i,k) = 0._r8 - loc_conv%trspin(i,k) = 0._r8 - end if - end do - end do -! -! compute temperature and moisture changes due to convection. -! - call q1q2_pjr(lchnk , & - dqdt ,dsdt ,qg ,qs ,qu , & - su ,du ,qhat ,shat ,dp , & - mu ,md ,sd ,qd ,qldeg , & - dsubcld ,jt ,maxg ,1 ,lengath , & - cpres ,rl ,msg , & - dlg ,evpg ,cug , & - loc_conv ) -! -! gather back temperature and mixing ratio. -! - - if (zmconv_microp) then - do k = msg + 1,pver - do i = 1,lengath - if (dqdt(i,k)*2._r8*delt+qg(i,k)<0._r8) then - negadq = (dqdt(i,k)+0.5_r8*qg(i,k)/delt)/0.9999_r8 - dqdt(i,k) = dqdt(i,k)-negadq - - do kk=k,jt(i),-1 - if (negadq<0._r8) then - if (rprdg(i,kk)> -negadq*dp(i,k)/dp(i,kk)) then - dsdt(i,k) = dsdt(i,k) + negadq*rl/cpres - if (rprdg(i,kk)>loc_conv%sprd(i,kk)) then - if(rprdg(i,kk)-loc_conv%sprd(i,kk)<-negadq*dp(i,k)/dp(i,kk)) then - dsdt(i,k) = dsdt(i,k) + (negadq+ (rprdg(i,kk)-loc_conv%sprd(i,kk))*dp(i,kk)/dp(i,k))*latice/cpres - loc_conv%sprd(i,kk) = negadq*dp(i,k)/dp(i,kk)+rprdg(i,kk) - end if - else - loc_conv%sprd(i,kk) = loc_conv%sprd(i,kk)+negadq*dp(i,k)/dp(i,kk) - dsdt(i,k) = dsdt(i,k) + negadq*latice/cpres - end if - rprdg(i,kk) = rprdg(i,kk)+negadq*dp(i,k)/dp(i,kk) - negadq = 0._r8 - else - negadq = rprdg(i,kk)*dp(i,kk)/dp(i,k)+negadq - dsdt(i,k) = dsdt(i,k) - rprdg(i,kk)*rl/cpres*dp(i,kk)/dp(i,k) - if (rprdg(i,kk)>loc_conv%sprd(i,kk)) then - dsdt(i,k) = dsdt(i,k) - loc_conv%sprd(i,kk)*latice/cpres*dp(i,kk)/dp(i,k) - loc_conv%sprd(i,kk) = 0._r8 - else - dsdt(i,k) = dsdt(i,k) -rprdg(i,kk)*latice/cpres*dp(i,kk)/dp(i,k) - loc_conv%sprd(i,kk)= loc_conv%sprd(i,kk)- rprdg(i,kk) - end if - rprdg(i,kk) = 0._r8 - end if - - if (dlg(i,kk)>loc_conv%di(i,kk)) then - doliq= .true. - else - doliq= .false. - end if - - if (negadq<0._r8) then - if (doliq) then - if (dlg(i,kk)> -negadq*dp(i,k)/dp(i,kk)) then - dsdt(i,k) = dsdt(i,k) + negadq*rl/cpres - loc_conv%dnl(i,kk) = loc_conv%dnl(i,kk)*(1._r8+negadq*dp(i,k)/dp(i,kk)/dlg(i,kk)) - dlg(i,kk) = dlg(i,kk)+negadq*dp(i,k)/dp(i,kk) - negadq = 0._r8 - else - negadq = negadq + dlg(i,kk)*dp(i,kk)/dp(i,k) - dsdt(i,k) = dsdt(i,k) - dlg(i,kk)*dp(i,kk)/dp(i,k)*rl/cpres - dlg(i,kk) = 0._r8 - loc_conv%dnl(i,kk) = 0._r8 - end if - else - if (loc_conv%di(i,kk)> -negadq*dp(i,k)/dp(i,kk)) then - dsdt(i,k) = dsdt(i,k) + negadq*(rl+latice)/cpres - loc_conv%dni(i,kk) = loc_conv%dni(i,kk)*(1._r8+negadq*dp(i,k)/dp(i,kk)/loc_conv%di(i,kk)) - loc_conv%di(i,kk) = loc_conv%di(i,kk)+negadq*dp(i,k)/dp(i,kk) - negadq = 0._r8 - else - negadq = negadq + loc_conv%di(i,kk)*dp(i,kk)/dp(i,k) - dsdt(i,k) = dsdt(i,k) - loc_conv%di(i,kk)*dp(i,kk)/dp(i,k)*(rl+latice)/cpres - loc_conv%di(i,kk) = 0._r8 - loc_conv%dni(i,kk) = 0._r8 - end if - doliq= .false. - end if - end if - if (negadq<0._r8 .and. doliq ) then - if (dlg(i,kk)> -negadq*dp(i,k)/dp(i,kk)) then - dsdt(i,k) = dsdt(i,k) + negadq*rl/cpres - loc_conv%dnl(i,kk) = loc_conv%dnl(i,kk)*(1._r8+negadq*dp(i,k)/dp(i,kk)/dlg(i,kk)) - dlg(i,kk) = dlg(i,kk)+negadq*dp(i,k)/dp(i,kk) - negadq = 0._r8 - else - negadq = negadq + dlg(i,kk)*dp(i,kk)/dp(i,k) - dsdt(i,k) = dsdt(i,k) - dlg(i,kk)*dp(i,kk)/dp(i,k)*rl/cpres - dlg(i,kk) = 0._r8 - loc_conv%dnl(i,kk) = 0._r8 - end if - end if - - end if - end do - - if (negadq<0._r8) then - dqdt(i,k) = dqdt(i,k) + negadq - end if - - end if - end do - end do - end if - - do k = msg + 1,pver - do i = 1,lengath -! -! q is updated to compute net precip. -! - q(ideep(i),k) = qh(ideep(i),k) + 2._r8*delt*dqdt(i,k) - qtnd(ideep(i),k) = dqdt (i,k) - cme (ideep(i),k) = cmeg (i,k) - rprd(ideep(i),k) = rprdg(i,k) - zdu (ideep(i),k) = du (i,k) - mcon(ideep(i),k) = mc (i,k) - heat(ideep(i),k) = dsdt (i,k)*cpres - dlf (ideep(i),k) = dlg (i,k) - pflx(ideep(i),k) = pflxg(i,k) - ql (ideep(i),k) = qlg (i,k) - end do - end do - - if (zmconv_microp) then - do k = msg + 1,pver - do i = 1,lengath - dif (ideep(i),k) = loc_conv%di (i,k) - dnlf(ideep(i),k) = loc_conv%dnl (i,k) - dnif(ideep(i),k) = loc_conv%dni (i,k) - - conv%qi (ideep(i),k) = loc_conv%qice(i,k) - conv%frz(ideep(i),k) = loc_conv%frz(i,k)*latice/cpres - conv%sprd(ideep(i),k) = loc_conv%sprd(i,k) - conv%wu (ideep(i),k) = loc_conv%wu (i,k) - conv%qliq(ideep(i),k) = loc_conv%qliq (i,k) - conv%qice(ideep(i),k) = loc_conv%qice (i,k) - conv%qrain(ideep(i),k) = loc_conv%qrain (i,k) - conv%qsnow(ideep(i),k) = loc_conv%qsnow (i,k) - conv%qnl(ideep(i),k) = loc_conv%qnl(i,k) - conv%qni(ideep(i),k) = loc_conv%qni(i,k) - conv%qnr(ideep(i),k) = loc_conv%qnr(i,k) - conv%qns(ideep(i),k) = loc_conv%qns(i,k) - - conv%autolm(ideep(i),k) = loc_conv%autolm(i,k) - conv%accrlm(ideep(i),k) = loc_conv%accrlm(i,k) - conv%bergnm(ideep(i),k) = loc_conv%bergnm(i,k) - conv%fhtimm(ideep(i),k) = loc_conv%fhtimm(i,k) - conv%fhtctm(ideep(i),k) = loc_conv%fhtctm(i,k) - conv%fhmlm (ideep(i),k) = loc_conv%fhmlm (i,k) - conv%hmpim (ideep(i),k) = loc_conv%hmpim (i,k) - conv%accslm(ideep(i),k) = loc_conv%accslm(i,k) - conv%dlfm (ideep(i),k) = loc_conv%dlfm (i,k) - - conv%autoln(ideep(i),k) = loc_conv%autoln(i,k) - conv%accrln(ideep(i),k) = loc_conv%accrln(i,k) - conv%bergnn(ideep(i),k) = loc_conv%bergnn(i,k) - conv%fhtimn(ideep(i),k) = loc_conv%fhtimn(i,k) - conv%fhtctn(ideep(i),k) = loc_conv%fhtctn(i,k) - conv%fhmln (ideep(i),k) = loc_conv%fhmln (i,k) - conv%accsln(ideep(i),k) = loc_conv%accsln(i,k) - conv%activn(ideep(i),k) = loc_conv%activn(i,k) - conv%dlfn (ideep(i),k) = loc_conv%dlfn (i,k) - conv%cmel (ideep(i),k) = loc_conv%cmel (i,k) - - conv%autoim(ideep(i),k) = loc_conv%autoim(i,k) - conv%accsim(ideep(i),k) = loc_conv%accsim(i,k) - conv%difm (ideep(i),k) = loc_conv%difm (i,k) - conv%cmei (ideep(i),k) = loc_conv%cmei (i,k) - - conv%nuclin(ideep(i),k) = loc_conv%nuclin(i,k) - conv%autoin(ideep(i),k) = loc_conv%autoin(i,k) - conv%accsin(ideep(i),k) = loc_conv%accsin(i,k) - conv%hmpin (ideep(i),k) = loc_conv%hmpin (i,k) - conv%difn (ideep(i),k) = loc_conv%difn (i,k) - - conv%trspcm(ideep(i),k) = loc_conv%trspcm(i,k) - conv%trspcn(ideep(i),k) = loc_conv%trspcn(i,k) - conv%trspim(ideep(i),k) = loc_conv%trspim(i,k) - conv%trspin(ideep(i),k) = loc_conv%trspin(i,k) - conv%lambdadpcu(ideep(i),k) = loc_conv%lambdadpcu(i,k) - conv%mudpcu(ideep(i),k) = loc_conv%mudpcu(i,k) - - end do - end do - - do k = msg + 1,pver - do i = 1,ncol - - !convert it from units of "kg/kg" to "g/m3" - - if(k.lt.pver) then - conv%qice (i,k) = 0.5_r8*(conv%qice(i,k)+conv%qice(i,k+1)) - conv%qliq (i,k) = 0.5_r8*(conv%qliq(i,k)+conv%qliq(i,k+1)) - conv%qrain (i,k) = 0.5_r8*(conv%qrain(i,k)+conv%qrain(i,k+1)) - conv%qsnow (i,k) = 0.5_r8*(conv%qsnow(i,k)+conv%qsnow(i,k+1)) - conv%qni (i,k) = 0.5_r8*(conv%qni(i,k)+conv%qni(i,k+1)) - conv%qnl (i,k) = 0.5_r8*(conv%qnl(i,k)+conv%qnl(i,k+1)) - conv%qnr (i,k) = 0.5_r8*(conv%qnr(i,k)+conv%qnr(i,k+1)) - conv%qns (i,k) = 0.5_r8*(conv%qns(i,k)+conv%qns(i,k+1)) - conv%wu(i,k) = 0.5_r8*(conv%wu(i,k)+conv%wu(i,k+1)) - end if - - if (t(i,k).gt. 273.15_r8 .and. t(i,k-1).le.273.15_r8) then - conv%qice (i,k-1) = conv%qice (i,k-1) + conv%qice (i,k) - conv%qice (i,k) = 0._r8 - conv%qni (i,k-1) = conv%qni (i,k-1) + conv%qni (i,k) - conv%qni (i,k) = 0._r8 - conv%qsnow (i,k-1) = conv%qsnow (i,k-1) + conv%qsnow (i,k) - conv%qsnow (i,k) = 0._r8 - conv%qns (i,k-1) = conv%qns (i,k-1) + conv%qns (i,k) - conv%qns (i,k) = 0._r8 - end if - - conv%qice (i,k) = conv%qice(i,k) * pap(i,k)/t(i,k)/rgas *1000._r8 - conv%qliq (i,k) = conv%qliq(i,k) * pap(i,k)/t(i,k)/rgas *1000._r8 - conv%qrain (i,k) = conv%qrain(i,k) * pap(i,k)/t(i,k)/rgas *1000._r8 - conv%qsnow (i,k) = conv%qsnow(i,k) * pap(i,k)/t(i,k)/rgas *1000._r8 - conv%qni (i,k) = conv%qni(i,k) * pap(i,k)/t(i,k)/rgas - conv%qnl (i,k) = conv%qnl(i,k) * pap(i,k)/t(i,k)/rgas - conv%qnr (i,k) = conv%qnr(i,k) * pap(i,k)/t(i,k)/rgas - conv%qns (i,k) = conv%qns(i,k) * pap(i,k)/t(i,k)/rgas - end do - end do - end if - -! - do i = 1,lengath - jctop(ideep(i)) = jt(i) - jcbot(ideep(i)) = maxg(i) - pflx(ideep(i),pverp) = pflxg(i,pverp) - end do - - if (zmconv_microp) then - do i = 1,lengath - conv%dcape(ideep(i)) = loc_conv%dcape(i) - end do - end if - -! Compute precip by integrating change in water vapor minus detrained cloud water - do k = pver,msg + 1,-1 - do i = 1,ncol - prec(i) = prec(i) - dpp(i,k)* (q(i,k)-qh(i,k)) - dpp(i,k)*(dlf(i,k)+dif(i,k))*2._r8*delt - end do - end do - -! obtain final precipitation rate in m/s. - do i = 1,ncol - prec(i) = rgrav*max(prec(i),0._r8)/ (2._r8*delt)/1000._r8 - end do - -! Compute reserved liquid (not yet in cldliq) for energy integrals. -! Treat rliq as flux out bottom, to be added back later. - do k = 1, pver - do i = 1, ncol - rliq(i) = rliq(i) + (dlf(i,k)+dif(i,k))*dpp(i,k)/gravit - rice(i) = rice(i) + dif(i,k)*dpp(i,k)/gravit - end do - end do - rliq(:ncol) = rliq(:ncol) /1000._r8 - rice(:ncol) = rice(:ncol) /1000._r8 - - if (zmconv_microp) then - deallocate( & - loc_conv%frz, & - loc_conv%sprd, & - loc_conv%wu, & - loc_conv%qi, & - loc_conv%qliq, & - loc_conv%qice, & - loc_conv%qrain, & - loc_conv%qsnow, & - loc_conv%di, & - loc_conv%dnl, & - loc_conv%dni, & - loc_conv%qnl, & - loc_conv%qni, & - loc_conv%qnr, & - loc_conv%qns, & - loc_conv%qide, & - loc_conv%qncde, & - loc_conv%qnide, & - loc_conv%autolm, & - loc_conv%accrlm, & - loc_conv%bergnm, & - loc_conv%fhtimm, & - loc_conv%fhtctm, & - loc_conv%fhmlm, & - loc_conv%hmpim, & - loc_conv%accslm, & - loc_conv%dlfm, & - loc_conv%cmel, & - loc_conv%autoln, & - loc_conv%accrln, & - loc_conv%bergnn, & - loc_conv%fhtimn, & - loc_conv%fhtctn, & - loc_conv%fhmln, & - loc_conv%accsln, & - loc_conv%activn, & - loc_conv%dlfn, & - loc_conv%autoim, & - loc_conv%accsim, & - loc_conv%difm, & - loc_conv%cmei, & - loc_conv%nuclin, & - loc_conv%autoin, & - loc_conv%accsin, & - loc_conv%hmpin, & - loc_conv%difn, & - loc_conv%trspcm, & - loc_conv%trspcn, & - loc_conv%trspim, & - loc_conv%trspin, & - loc_conv%lambdadpcu, & - loc_conv%mudpcu, & - loc_conv%dcape ) - end if - - return -end subroutine zm_convr - -!=============================================================================== -subroutine zm_conv_evap(ncol,lchnk, & - t,pmid,pdel,q, & - landfrac, & - tend_s, tend_s_snwprd, tend_s_snwevmlt, tend_q, & - prdprec, cldfrc, deltat, & - prec, snow, ntprprd, ntsnprd, flxprec, flxsnow, prdsnow) - - -!----------------------------------------------------------------------- -! Compute tendencies due to evaporation of rain from ZM scheme -!-- -! Compute the total precipitation and snow fluxes at the surface. -! Add in the latent heat of fusion for snow formation and melt, since it not dealt with -! in the Zhang-MacFarlane parameterization. -! Evaporate some of the precip directly into the environment using a Sundqvist type algorithm -!----------------------------------------------------------------------- - - use wv_saturation, only: qsat - use phys_grid, only: get_rlat_all_p - -!------------------------------Arguments-------------------------------- - integer,intent(in) :: ncol, lchnk ! number of columns and chunk index - real(r8),intent(in), dimension(pcols,pver) :: t ! temperature (K) - real(r8),intent(in), dimension(pcols,pver) :: pmid ! midpoint pressure (Pa) - real(r8),intent(in), dimension(pcols,pver) :: pdel ! layer thickness (Pa) - real(r8),intent(in), dimension(pcols,pver) :: q ! water vapor (kg/kg) - real(r8),intent(in), dimension(pcols) :: landfrac - real(r8),intent(inout), dimension(pcols,pver) :: tend_s ! heating rate (J/kg/s) - real(r8),intent(inout), dimension(pcols,pver) :: tend_q ! water vapor tendency (kg/kg/s) - real(r8),intent(out ), dimension(pcols,pver) :: tend_s_snwprd ! Heating rate of snow production - real(r8),intent(out ), dimension(pcols,pver) :: tend_s_snwevmlt ! Heating rate of evap/melting of snow - - - - real(r8), intent(in ) :: prdprec(pcols,pver)! precipitation production (kg/ks/s) - real(r8), intent(in ) :: cldfrc(pcols,pver) ! cloud fraction - real(r8), intent(in ) :: deltat ! time step - - real(r8), intent(inout) :: prec(pcols) ! Convective-scale preciptn rate - real(r8), intent(out) :: snow(pcols) ! Convective-scale snowfall rate - - real(r8), optional, intent(in), allocatable :: prdsnow(:,:) ! snow production (kg/ks/s) - -! -!---------------------------Local storage------------------------------- - - real(r8) :: es (pcols,pver) ! Saturation vapor pressure - real(r8) :: fice (pcols,pver) ! ice fraction in precip production - real(r8) :: fsnow_conv(pcols,pver) ! snow fraction in precip production - real(r8) :: qs (pcols,pver) ! saturation specific humidity - real(r8),intent(out) :: flxprec(pcols,pverp) ! Convective-scale flux of precip at interfaces (kg/m2/s) - real(r8),intent(out) :: flxsnow(pcols,pverp) ! Convective-scale flux of snow at interfaces (kg/m2/s) - real(r8),intent(out) :: ntprprd(pcols,pver) ! net precip production in layer - real(r8),intent(out) :: ntsnprd(pcols,pver) ! net snow production in layer - real(r8) :: work1 ! temp variable (pjr) - real(r8) :: work2 ! temp variable (pjr) - - real(r8) :: evpvint(pcols) ! vertical integral of evaporation - real(r8) :: evpprec(pcols) ! evaporation of precipitation (kg/kg/s) - real(r8) :: evpsnow(pcols) ! evaporation of snowfall (kg/kg/s) - real(r8) :: snowmlt(pcols) ! snow melt tendency in layer - real(r8) :: flxsntm(pcols) ! flux of snow into layer, after melting - - real(r8) :: kemask - real(r8) :: evplimit ! temp variable for evaporation limits - real(r8) :: rlat(pcols) - real(r8) :: dum - real(r8) :: omsm - - integer :: i,k ! longitude,level indices - logical :: old_snow - - -!----------------------------------------------------------------------- - - ! If prdsnow is passed in and allocated, then use it in the calculation, otherwise - ! use the old snow calculation - old_snow=.true. - if (present(prdsnow)) then - if (allocated(prdsnow)) then - old_snow=.false. - end if - end if - -! convert input precip to kg/m2/s - prec(:ncol) = prec(:ncol)*1000._r8 - -! determine saturation vapor pressure - do k = 1,pver - call qsat(t(1:ncol,k), pmid(1:ncol,k), es(1:ncol,k), qs(1:ncol,k), ncol) - end do -! determine ice fraction in rain production (use cloud water parameterization fraction at present) - call cldfrc_fice(ncol, t, fice, fsnow_conv) - -! zero the flux integrals on the top boundary - flxprec(:ncol,1) = 0._r8 - flxsnow(:ncol,1) = 0._r8 - evpvint(:ncol) = 0._r8 - omsm=0.9999_r8 - - do k = 1, pver - do i = 1, ncol - -! Melt snow falling into layer, if necessary. - if( old_snow ) then - if (t(i,k) > tmelt) then - flxsntm(i) = 0._r8 - snowmlt(i) = flxsnow(i,k) * gravit/ pdel(i,k) - else - flxsntm(i) = flxsnow(i,k) - snowmlt(i) = 0._r8 - end if - else - ! make sure melting snow doesn't reduce temperature below threshold - if (t(i,k) > tmelt) then - dum = -latice/cpres*flxsnow(i,k)*gravit/pdel(i,k)*deltat - if (t(i,k) + dum .le. tmelt) then - dum = (t(i,k)-tmelt)*cpres/latice/deltat - dum = dum/(flxsnow(i,k)*gravit/pdel(i,k)) - dum = max(0._r8,dum) - dum = min(1._r8,dum) - else - dum = 1._r8 - end if - dum = dum*omsm - flxsntm(i) = flxsnow(i,k)*(1.0_r8-dum) - snowmlt(i) = dum*flxsnow(i,k)*gravit/ pdel(i,k) - else - flxsntm(i) = flxsnow(i,k) - snowmlt(i) = 0._r8 - end if - end if - -! relative humidity depression must be > 0 for evaporation - evplimit = max(1._r8 - q(i,k)/qs(i,k), 0._r8) - - if (zm_org) then - kemask = ke * (1._r8 - landfrac(i)) + ke_lnd * landfrac(i) - else - kemask = ke - endif - -! total evaporation depends on flux in the top of the layer -! flux prec is the net production above layer minus evaporation into environmet - evpprec(i) = kemask * (1._r8 - cldfrc(i,k)) * evplimit * sqrt(flxprec(i,k)) -!********************************************************** -!! evpprec(i) = 0. ! turn off evaporation for now -!********************************************************** - -! Don't let evaporation supersaturate layer (approx). Layer may already be saturated. -! Currently does not include heating/cooling change to qs - evplimit = max(0._r8, (qs(i,k)-q(i,k)) / deltat) - -! Don't evaporate more than is falling into the layer - do not evaporate rain formed -! in this layer but if precip production is negative, remove from the available precip -! Negative precip production occurs because of evaporation in downdrafts. -!!$ evplimit = flxprec(i,k) * gravit / pdel(i,k) + min(prdprec(i,k), 0.) - evplimit = min(evplimit, flxprec(i,k) * gravit / pdel(i,k)) - -! Total evaporation cannot exceed input precipitation - evplimit = min(evplimit, (prec(i) - evpvint(i)) * gravit / pdel(i,k)) - - evpprec(i) = min(evplimit, evpprec(i)) - if( .not.old_snow ) then - evpprec(i) = max(0._r8, evpprec(i)) - evpprec(i) = evpprec(i)*omsm - end if - - -! evaporation of snow depends on snow fraction of total precipitation in the top after melting - if (flxprec(i,k) > 0._r8) then -! evpsnow(i) = evpprec(i) * flxsntm(i) / flxprec(i,k) -! prevent roundoff problems - work1 = min(max(0._r8,flxsntm(i)/flxprec(i,k)),1._r8) - evpsnow(i) = evpprec(i) * work1 - else - evpsnow(i) = 0._r8 - end if - -! vertically integrated evaporation - evpvint(i) = evpvint(i) + evpprec(i) * pdel(i,k)/gravit - -! net precip production is production - evaporation - ntprprd(i,k) = prdprec(i,k) - evpprec(i) -! net snow production is precip production * ice fraction - evaporation - melting -!pjrworks ntsnprd(i,k) = prdprec(i,k)*fice(i,k) - evpsnow(i) - snowmlt(i) -!pjrwrks2 ntsnprd(i,k) = prdprec(i,k)*fsnow_conv(i,k) - evpsnow(i) - snowmlt(i) -! the small amount added to flxprec in the work1 expression has been increased from -! 1e-36 to 8.64e-11 (1e-5 mm/day). This causes the temperature based partitioning -! scheme to be used for small flxprec amounts. This is to address error growth problems. - - if( old_snow ) then - if (flxprec(i,k).gt.0._r8) then - work1 = min(max(0._r8,flxsnow(i,k)/flxprec(i,k)),1._r8) - else - work1 = 0._r8 - endif - - work2 = max(fsnow_conv(i,k), work1) - if (snowmlt(i).gt.0._r8) work2 = 0._r8 -! work2 = fsnow_conv(i,k) - ntsnprd(i,k) = prdprec(i,k)*work2 - evpsnow(i) - snowmlt(i) - tend_s_snwprd (i,k) = prdprec(i,k)*work2*latice - tend_s_snwevmlt(i,k) = - ( evpsnow(i) + snowmlt(i) )*latice - else - ntsnprd(i,k) = prdsnow(i,k) - min(flxsnow(i,k)*gravit/pdel(i,k), evpsnow(i)+snowmlt(i)) - tend_s_snwprd (i,k) = prdsnow(i,k)*latice - tend_s_snwevmlt(i,k) = -min(flxsnow(i,k)*gravit/pdel(i,k), evpsnow(i)+snowmlt(i) )*latice - end if - -! precipitation fluxes - flxprec(i,k+1) = flxprec(i,k) + ntprprd(i,k) * pdel(i,k)/gravit - flxsnow(i,k+1) = flxsnow(i,k) + ntsnprd(i,k) * pdel(i,k)/gravit - -! protect against rounding error - flxprec(i,k+1) = max(flxprec(i,k+1), 0._r8) - flxsnow(i,k+1) = max(flxsnow(i,k+1), 0._r8) -! more protection (pjr) -! flxsnow(i,k+1) = min(flxsnow(i,k+1), flxprec(i,k+1)) - -! heating (cooling) and moistening due to evaporation -! - latent heat of vaporization for precip production has already been accounted for -! - snow is contained in prec - if( old_snow ) then - tend_s(i,k) =-evpprec(i)*latvap + ntsnprd(i,k)*latice - else - tend_s(i,k) =-evpprec(i)*latvap + tend_s_snwevmlt(i,k) - end if - tend_q(i,k) = evpprec(i) - end do - end do - -! set output precipitation rates (m/s) - prec(:ncol) = flxprec(:ncol,pver+1) / 1000._r8 - snow(:ncol) = flxsnow(:ncol,pver+1) / 1000._r8 - -!********************************************************** -!!$ tend_s(:ncol,:) = 0. ! turn heating off -!********************************************************** - - end subroutine zm_conv_evap - - - -subroutine convtran(lchnk , & - doconvtran,q ,ncnst ,mu ,md , & - du ,eu ,ed ,dp ,dsubcld , & - jt ,mx ,ideep ,il1g ,il2g , & - nstep ,fracis ,dqdt ,dpdry ,dt) -!----------------------------------------------------------------------- -! -! Purpose: -! Convective transport of trace species -! -! Mixing ratios may be with respect to either dry or moist air -! -! Method: -! -! -! -! Author: P. Rasch -! -!----------------------------------------------------------------------- - use shr_kind_mod, only: r8 => shr_kind_r8 - use constituents, only: cnst_get_type_byind - use ppgrid - - implicit none -!----------------------------------------------------------------------- -! -! Input arguments -! - integer, intent(in) :: lchnk ! chunk identifier - integer, intent(in) :: ncnst ! number of tracers to transport - logical, intent(in) :: doconvtran(ncnst) ! flag for doing convective transport - real(r8), intent(in) :: q(pcols,pver,ncnst) ! Tracer array including moisture - real(r8), intent(in) :: mu(pcols,pver) ! Mass flux up - real(r8), intent(in) :: md(pcols,pver) ! Mass flux down - real(r8), intent(in) :: du(pcols,pver) ! Mass detraining from updraft - real(r8), intent(in) :: eu(pcols,pver) ! Mass entraining from updraft - real(r8), intent(in) :: ed(pcols,pver) ! Mass entraining from downdraft - real(r8), intent(in) :: dp(pcols,pver) ! Delta pressure between interfaces - real(r8), intent(in) :: dsubcld(pcols) ! Delta pressure from cloud base to sfc - real(r8), intent(in) :: fracis(pcols,pver,ncnst) ! fraction of tracer that is insoluble - - integer, intent(in) :: jt(pcols) ! Index of cloud top for each column - integer, intent(in) :: mx(pcols) ! Index of cloud top for each column - integer, intent(in) :: ideep(pcols) ! Gathering array - integer, intent(in) :: il1g ! Gathered min lon indices over which to operate - integer, intent(in) :: il2g ! Gathered max lon indices over which to operate - integer, intent(in) :: nstep ! Time step index - - real(r8), intent(in) :: dpdry(pcols,pver) ! Delta pressure between interfaces - - real(r8), intent(in) :: dt ! 2 delta t (model time increment) - -! input/output - - real(r8), intent(out) :: dqdt(pcols,pver,ncnst) ! Tracer tendency array - -!--------------------------Local Variables------------------------------ - - integer i ! Work index - integer k ! Work index - integer kbm ! Highest altitude index of cloud base - integer kk ! Work index - integer kkp1 ! Work index - integer km1 ! Work index - integer kp1 ! Work index - integer ktm ! Highest altitude index of cloud top - integer m ! Work index - - real(r8) cabv ! Mix ratio of constituent above - real(r8) cbel ! Mix ratio of constituent below - real(r8) cdifr ! Normalized diff between cabv and cbel - real(r8) chat(pcols,pver) ! Mix ratio in env at interfaces - real(r8) cond(pcols,pver) ! Mix ratio in downdraft at interfaces - real(r8) const(pcols,pver) ! Gathered tracer array - real(r8) fisg(pcols,pver) ! gathered insoluble fraction of tracer - real(r8) conu(pcols,pver) ! Mix ratio in updraft at interfaces - real(r8) dcondt(pcols,pver) ! Gathered tend array - real(r8) small ! A small number - real(r8) mbsth ! Threshold for mass fluxes - real(r8) mupdudp ! A work variable - real(r8) minc ! A work variable - real(r8) maxc ! A work variable - real(r8) fluxin ! A work variable - real(r8) fluxout ! A work variable - real(r8) netflux ! A work variable - - real(r8) dutmp(pcols,pver) ! Mass detraining from updraft - real(r8) eutmp(pcols,pver) ! Mass entraining from updraft - real(r8) edtmp(pcols,pver) ! Mass entraining from downdraft - real(r8) dptmp(pcols,pver) ! Delta pressure between interfaces - real(r8) total(pcols) - real(r8) negadt,qtmp - -!----------------------------------------------------------------------- -! - small = 1.e-36_r8 -! mbsth is the threshold below which we treat the mass fluxes as zero (in mb/s) - mbsth = 1.e-15_r8 - -! Find the highest level top and bottom levels of convection - ktm = pver - kbm = pver - do i = il1g, il2g - ktm = min(ktm,jt(i)) - kbm = min(kbm,mx(i)) - end do - -! Loop ever each constituent - do m = 2, ncnst - if (doconvtran(m)) then - - if (cnst_get_type_byind(m).eq.'dry') then - do k = 1,pver - do i =il1g,il2g - dptmp(i,k) = dpdry(i,k) - dutmp(i,k) = du(i,k)*dp(i,k)/dpdry(i,k) - eutmp(i,k) = eu(i,k)*dp(i,k)/dpdry(i,k) - edtmp(i,k) = ed(i,k)*dp(i,k)/dpdry(i,k) - end do - end do - else - do k = 1,pver - do i =il1g,il2g - dptmp(i,k) = dp(i,k) - dutmp(i,k) = du(i,k) - eutmp(i,k) = eu(i,k) - edtmp(i,k) = ed(i,k) - end do - end do - endif -! dptmp = dp - -! Gather up the constituent and set tend to zero - do k = 1,pver - do i =il1g,il2g - const(i,k) = q(ideep(i),k,m) - fisg(i,k) = fracis(ideep(i),k,m) - end do - end do - -! From now on work only with gathered data - -! Interpolate environment tracer values to interfaces - do k = 1,pver - km1 = max(1,k-1) - do i = il1g, il2g - minc = min(const(i,km1),const(i,k)) - maxc = max(const(i,km1),const(i,k)) - if (minc < 0) then - cdifr = 0._r8 - else - cdifr = abs(const(i,k)-const(i,km1))/max(maxc,small) - endif - -! If the two layers differ significantly use a geometric averaging -! procedure - if (cdifr > 1.E-6_r8) then - cabv = max(const(i,km1),maxc*1.e-12_r8) - cbel = max(const(i,k),maxc*1.e-12_r8) - chat(i,k) = log(cabv/cbel)/(cabv-cbel)*cabv*cbel - - else ! Small diff, so just arithmetic mean - chat(i,k) = 0.5_r8* (const(i,k)+const(i,km1)) - end if - -! Provisional up and down draft values - conu(i,k) = chat(i,k) - cond(i,k) = chat(i,k) - -! provisional tends - dcondt(i,k) = 0._r8 - - end do - end do - -! Do levels adjacent to top and bottom - k = 2 - km1 = 1 - kk = pver - do i = il1g,il2g - mupdudp = mu(i,kk) + dutmp(i,kk)*dptmp(i,kk) - if (mupdudp > mbsth) then - conu(i,kk) = (+eutmp(i,kk)*fisg(i,kk)*const(i,kk)*dptmp(i,kk))/mupdudp - endif - if (md(i,k) < -mbsth) then - cond(i,k) = (-edtmp(i,km1)*fisg(i,km1)*const(i,km1)*dptmp(i,km1))/md(i,k) - endif - end do - -! Updraft from bottom to top - do kk = pver-1,1,-1 - kkp1 = min(pver,kk+1) - do i = il1g,il2g - mupdudp = mu(i,kk) + dutmp(i,kk)*dptmp(i,kk) - if (mupdudp > mbsth) then - conu(i,kk) = ( mu(i,kkp1)*conu(i,kkp1)+eutmp(i,kk)*fisg(i,kk)* & - const(i,kk)*dptmp(i,kk) )/mupdudp - endif - end do - end do - -! Downdraft from top to bottom - do k = 3,pver - km1 = max(1,k-1) - do i = il1g,il2g - if (md(i,k) < -mbsth) then - cond(i,k) = ( md(i,km1)*cond(i,km1)-edtmp(i,km1)*fisg(i,km1)*const(i,km1) & - *dptmp(i,km1) )/md(i,k) - endif - end do - end do - - - do k = ktm,pver - km1 = max(1,k-1) - kp1 = min(pver,k+1) - do i = il1g,il2g - -! version 1 hard to check for roundoff errors -! dcondt(i,k) = -! $ +(+mu(i,kp1)* (conu(i,kp1)-chat(i,kp1)) -! $ -mu(i,k)* (conu(i,k)-chat(i,k)) -! $ +md(i,kp1)* (cond(i,kp1)-chat(i,kp1)) -! $ -md(i,k)* (cond(i,k)-chat(i,k)) -! $ )/dp(i,k) - -! version 2 hard to limit fluxes -! fluxin = mu(i,kp1)*conu(i,kp1) + mu(i,k)*chat(i,k) -! $ -(md(i,k) *cond(i,k) + md(i,kp1)*chat(i,kp1)) -! fluxout = mu(i,k)*conu(i,k) + mu(i,kp1)*chat(i,kp1) -! $ -(md(i,kp1)*cond(i,kp1) + md(i,k)*chat(i,k)) - -! version 3 limit fluxes outside convection to mass in appropriate layer -! these limiters are probably only safe for positive definite quantitities -! it assumes that mu and md already satify a courant number limit of 1 - fluxin = mu(i,kp1)*conu(i,kp1)+ mu(i,k)*min(chat(i,k),const(i,km1)) & - -(md(i,k) *cond(i,k) + md(i,kp1)*min(chat(i,kp1),const(i,kp1))) - fluxout = mu(i,k)*conu(i,k) + mu(i,kp1)*min(chat(i,kp1),const(i,k)) & - -(md(i,kp1)*cond(i,kp1) + md(i,k)*min(chat(i,k),const(i,k))) - - netflux = fluxin - fluxout - if (abs(netflux) < max(fluxin,fluxout)*1.e-12_r8) then - netflux = 0._r8 - endif - dcondt(i,k) = netflux/dptmp(i,k) - end do - end do -! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -! - do k = kbm,pver - km1 = max(1,k-1) - do i = il1g,il2g - if (k == mx(i)) then - -! version 1 -! dcondt(i,k) = (1./dsubcld(i))* -! $ (-mu(i,k)*(conu(i,k)-chat(i,k)) -! $ -md(i,k)*(cond(i,k)-chat(i,k)) -! $ ) - -! version 2 -! fluxin = mu(i,k)*chat(i,k) - md(i,k)*cond(i,k) -! fluxout = mu(i,k)*conu(i,k) - md(i,k)*chat(i,k) -! version 3 - fluxin = mu(i,k)*min(chat(i,k),const(i,km1)) - md(i,k)*cond(i,k) - fluxout = mu(i,k)*conu(i,k) - md(i,k)*min(chat(i,k),const(i,k)) - - netflux = fluxin - fluxout - if (abs(netflux) < max(fluxin,fluxout)*1.e-12_r8) then - netflux = 0._r8 - endif -! dcondt(i,k) = netflux/dsubcld(i) - dcondt(i,k) = netflux/dptmp(i,k) - else if (k > mx(i)) then -! dcondt(i,k) = dcondt(i,k-1) - dcondt(i,k) = 0._r8 - end if - end do - end do - - if (zmconv_microp) then - do i = il1g,il2g - do k = jt(i),mx(i) - if (dcondt(i,k)*dt+const(i,k)<0._r8) then - negadt = dcondt(i,k)+const(i,k)/dt - dcondt(i,k) = -const(i,k)/dt - do kk= k+1, mx(i) - if (negadt<0._r8 .and. dcondt(i,kk)*dt+const(i,kk)>0._r8 ) then - qtmp = dcondt(i,kk)+negadt*dptmp(i,k)/dptmp(i,kk) - if (qtmp*dt+const(i,kk)>0._r8) then - dcondt(i,kk)= qtmp - negadt=0._r8 - else - negadt= negadt+(const(i,kk)/dt+dcondt(i,kk))*dptmp(i,kk)/dptmp(i,k) - dcondt(i,kk)= -const(i,kk)/dt - end if - - end if - end do - do kk= k-1, jt(i), -1 - if (negadt<0._r8 .and. dcondt(i,kk)*dt+const(i,kk)>0._r8 ) then - qtmp = dcondt(i,kk)+negadt*dptmp(i,k)/dptmp(i,kk) - if (qtmp*dt+const(i,kk)>0._r8) then - dcondt(i,kk)= qtmp - negadt=0._r8 - else - negadt= negadt+(const(i,kk)/dt+dcondt(i,kk))*dptmp(i,kk)/dptmp(i,k) - dcondt(i,kk)= -const(i,kk)/dt - end if - end if - end do - - if (negadt<0._r8) then - dcondt(i,k) = dcondt(i,k) + negadt - end if - end if - end do - end do - end if - - -! Initialize to zero everywhere, then scatter tendency back to full array - dqdt(:,:,m) = 0._r8 - do k = 1,pver - kp1 = min(pver,k+1) - do i = il1g,il2g - dqdt(ideep(i),k,m) = dcondt(i,k) - end do - end do - - end if ! for doconvtran - - end do - - return -end subroutine convtran - -!========================================================================================= - -subroutine momtran(lchnk, ncol, & - domomtran,q ,ncnst ,mu ,md , & - du ,eu ,ed ,dp ,dsubcld , & - jt ,mx ,ideep ,il1g ,il2g , & - nstep ,dqdt ,pguall ,pgdall, icwu, icwd, dt, seten ) -!----------------------------------------------------------------------- -! -! Purpose: -! Convective transport of momentum -! -! Mixing ratios may be with respect to either dry or moist air -! -! Method: -! Based on the convtran subroutine by P. Rasch -! -! -! Author: J. Richter and P. Rasch -! -!----------------------------------------------------------------------- - use shr_kind_mod, only: r8 => shr_kind_r8 - use constituents, only: cnst_get_type_byind - use ppgrid - - implicit none -!----------------------------------------------------------------------- -! -! Input arguments -! - integer, intent(in) :: lchnk ! chunk identifier - integer, intent(in) :: ncol ! number of atmospheric columns - integer, intent(in) :: ncnst ! number of tracers to transport - logical, intent(in) :: domomtran(ncnst) ! flag for doing convective transport - real(r8), intent(in) :: q(pcols,pver,ncnst) ! Wind array - real(r8), intent(in) :: mu(pcols,pver) ! Mass flux up - real(r8), intent(in) :: md(pcols,pver) ! Mass flux down - real(r8), intent(in) :: du(pcols,pver) ! Mass detraining from updraft - real(r8), intent(in) :: eu(pcols,pver) ! Mass entraining from updraft - real(r8), intent(in) :: ed(pcols,pver) ! Mass entraining from downdraft - real(r8), intent(in) :: dp(pcols,pver) ! Delta pressure between interfaces - real(r8), intent(in) :: dsubcld(pcols) ! Delta pressure from cloud base to sfc - real(r8), intent(in) :: dt ! time step in seconds : 2*delta_t - - integer, intent(in) :: jt(pcols) ! Index of cloud top for each column - integer, intent(in) :: mx(pcols) ! Index of cloud top for each column - integer, intent(in) :: ideep(pcols) ! Gathering array - integer, intent(in) :: il1g ! Gathered min lon indices over which to operate - integer, intent(in) :: il2g ! Gathered max lon indices over which to operate - integer, intent(in) :: nstep ! Time step index - - - -! input/output - - real(r8), intent(out) :: dqdt(pcols,pver,ncnst) ! Tracer tendency array - -!--------------------------Local Variables------------------------------ - - integer i ! Work index - integer k ! Work index - integer kbm ! Highest altitude index of cloud base - integer kk ! Work index - integer kkp1 ! Work index - integer kkm1 ! Work index - integer km1 ! Work index - integer kp1 ! Work index - integer ktm ! Highest altitude index of cloud top - integer m ! Work index - integer ii ! Work index - - real(r8) cabv ! Mix ratio of constituent above - real(r8) cbel ! Mix ratio of constituent below - real(r8) cdifr ! Normalized diff between cabv and cbel - real(r8) chat(pcols,pver) ! Mix ratio in env at interfaces - real(r8) cond(pcols,pver) ! Mix ratio in downdraft at interfaces - real(r8) const(pcols,pver) ! Gathered wind array - real(r8) conu(pcols,pver) ! Mix ratio in updraft at interfaces - real(r8) dcondt(pcols,pver) ! Gathered tend array - real(r8) mbsth ! Threshold for mass fluxes - real(r8) mupdudp ! A work variable - real(r8) minc ! A work variable - real(r8) maxc ! A work variable - real(r8) fluxin ! A work variable - real(r8) fluxout ! A work variable - real(r8) netflux ! A work variable - - real(r8) sum ! sum - real(r8) sum2 ! sum2 - - real(r8) mududp(pcols,pver) ! working variable - real(r8) mddudp(pcols,pver) ! working variable - - real(r8) pgu(pcols,pver) ! Pressure gradient term for updraft - real(r8) pgd(pcols,pver) ! Pressure gradient term for downdraft - - real(r8),intent(out) :: pguall(pcols,pver,ncnst) ! Apparent force from updraft PG - real(r8),intent(out) :: pgdall(pcols,pver,ncnst) ! Apparent force from downdraft PG - - real(r8),intent(out) :: icwu(pcols,pver,ncnst) ! In-cloud winds in updraft - real(r8),intent(out) :: icwd(pcols,pver,ncnst) ! In-cloud winds in downdraft - - real(r8),intent(out) :: seten(pcols,pver) ! Dry static energy tendency - real(r8) gseten(pcols,pver) ! Gathered dry static energy tendency - - real(r8) mflux(pcols,pverp,ncnst) ! Gathered momentum flux - - real(r8) wind0(pcols,pver,ncnst) ! gathered wind before time step - real(r8) windf(pcols,pver,ncnst) ! gathered wind after time step - real(r8) fkeb, fket, ketend_cons, ketend, utop, ubot, vtop, vbot, gset2 - - -!----------------------------------------------------------------------- -! - -! Initialize outgoing fields - pguall(:,:,:) = 0.0_r8 - pgdall(:,:,:) = 0.0_r8 -! Initialize in-cloud winds to environmental wind - icwu(:ncol,:,:) = q(:ncol,:,:) - icwd(:ncol,:,:) = q(:ncol,:,:) - -! Initialize momentum flux and final winds - mflux(:,:,:) = 0.0_r8 - wind0(:,:,:) = 0.0_r8 - windf(:,:,:) = 0.0_r8 - -! Initialize dry static energy - - seten(:,:) = 0.0_r8 - gseten(:,:) = 0.0_r8 - -! mbsth is the threshold below which we treat the mass fluxes as zero (in mb/s) - mbsth = 1.e-15_r8 - -! Find the highest level top and bottom levels of convection - ktm = pver - kbm = pver - do i = il1g, il2g - ktm = min(ktm,jt(i)) - kbm = min(kbm,mx(i)) - end do - -! Loop ever each wind component - do m = 1, ncnst !start at m = 1 to transport momentum - if (domomtran(m)) then - -! Gather up the winds and set tend to zero - do k = 1,pver - do i =il1g,il2g - const(i,k) = q(ideep(i),k,m) - wind0(i,k,m) = const(i,k) - end do - end do - - -! From now on work only with gathered data - -! Interpolate winds to interfaces - - do k = 1,pver - km1 = max(1,k-1) - do i = il1g, il2g - - ! use arithmetic mean - chat(i,k) = 0.5_r8* (const(i,k)+const(i,km1)) - -! Provisional up and down draft values - conu(i,k) = chat(i,k) - cond(i,k) = chat(i,k) - -! provisional tends - dcondt(i,k) = 0._r8 - - end do - end do - - -! -! Pressure Perturbation Term -! - - !Top boundary: assume mu is zero - - k=1 - pgu(:il2g,k) = 0.0_r8 - pgd(:il2g,k) = 0.0_r8 - - do k=2,pver-1 - km1 = max(1,k-1) - kp1 = min(pver,k+1) - do i = il1g,il2g - - !interior points - - mududp(i,k) = ( mu(i,k) * (const(i,k)- const(i,km1))/dp(i,km1) & - + mu(i,kp1) * (const(i,kp1) - const(i,k))/dp(i,k)) - - pgu(i,k) = - momcu * 0.5_r8 * mududp(i,k) - - - mddudp(i,k) = ( md(i,k) * (const(i,k)- const(i,km1))/dp(i,km1) & - + md(i,kp1) * (const(i,kp1) - const(i,k))/dp(i,k)) - - pgd(i,k) = - momcd * 0.5_r8 * mddudp(i,k) - - - end do - end do - - ! bottom boundary - k = pver - km1 = max(1,k-1) - do i=il1g,il2g - - mududp(i,k) = mu(i,k) * (const(i,k)- const(i,km1))/dp(i,km1) - pgu(i,k) = - momcu * mududp(i,k) - - mddudp(i,k) = md(i,k) * (const(i,k)- const(i,km1))/dp(i,km1) - - pgd(i,k) = - momcd * mddudp(i,k) - - end do - - -! -! In-cloud velocity calculations -! - -! Do levels adjacent to top and bottom - k = 2 - km1 = 1 - kk = pver - kkm1 = max(1,kk-1) - do i = il1g,il2g - mupdudp = mu(i,kk) + du(i,kk)*dp(i,kk) - if (mupdudp > mbsth) then - - conu(i,kk) = (+eu(i,kk)*const(i,kk)*dp(i,kk)+pgu(i,kk)*dp(i,kk))/mupdudp - endif - if (md(i,k) < -mbsth) then - cond(i,k) = (-ed(i,km1)*const(i,km1)*dp(i,km1))-pgd(i,km1)*dp(i,km1)/md(i,k) - endif - - - end do - - - -! Updraft from bottom to top - do kk = pver-1,1,-1 - kkm1 = max(1,kk-1) - kkp1 = min(pver,kk+1) - do i = il1g,il2g - mupdudp = mu(i,kk) + du(i,kk)*dp(i,kk) - if (mupdudp > mbsth) then - - conu(i,kk) = ( mu(i,kkp1)*conu(i,kkp1)+eu(i,kk)* & - const(i,kk)*dp(i,kk)+pgu(i,kk)*dp(i,kk))/mupdudp - endif - end do - - end do - - -! Downdraft from top to bottom - do k = 3,pver - km1 = max(1,k-1) - do i = il1g,il2g - if (md(i,k) < -mbsth) then - - cond(i,k) = ( md(i,km1)*cond(i,km1)-ed(i,km1)*const(i,km1) & - *dp(i,km1)-pgd(i,km1)*dp(i,km1) )/md(i,k) - - endif - end do - end do - - - sum = 0._r8 - sum2 = 0._r8 - - - do k = ktm,pver - km1 = max(1,k-1) - kp1 = min(pver,k+1) - do i = il1g,il2g - ii = ideep(i) - -! version 1 hard to check for roundoff errors - dcondt(i,k) = & - +(mu(i,kp1)* (conu(i,kp1)-chat(i,kp1)) & - -mu(i,k)* (conu(i,k)-chat(i,k)) & - +md(i,kp1)* (cond(i,kp1)-chat(i,kp1)) & - -md(i,k)* (cond(i,k)-chat(i,k)) & - )/dp(i,k) - - end do - end do - - ! dcont for bottom layer - ! - do k = kbm,pver - km1 = max(1,k-1) - do i = il1g,il2g - if (k == mx(i)) then - - ! version 1 - dcondt(i,k) = (1._r8/dp(i,k))* & - (-mu(i,k)*(conu(i,k)-chat(i,k)) & - -md(i,k)*(cond(i,k)-chat(i,k)) & - ) - end if - end do - end do - -! Initialize to zero everywhere, then scatter tendency back to full array - dqdt(:,:,m) = 0._r8 - - do k = 1,pver - do i = il1g,il2g - ii = ideep(i) - dqdt(ii,k,m) = dcondt(i,k) - ! Output apparent force on the mean flow from pressure gradient - pguall(ii,k,m) = -pgu(i,k) - pgdall(ii,k,m) = -pgd(i,k) - icwu(ii,k,m) = conu(i,k) - icwd(ii,k,m) = cond(i,k) - end do - end do - - ! Calculate momentum flux in units of mb*m/s2 - - do k = ktm,pver - do i = il1g,il2g - ii = ideep(i) - mflux(i,k,m) = & - -mu(i,k)* (conu(i,k)-chat(i,k)) & - -md(i,k)* (cond(i,k)-chat(i,k)) - end do - end do - - - ! Calculate winds at the end of the time step - - do k = ktm,pver - do i = il1g,il2g - ii = ideep(i) - km1 = max(1,k-1) - kp1 = k+1 - windf(i,k,m) = const(i,k) - (mflux(i,kp1,m) - mflux(i,k,m)) * dt /dp(i,k) - - end do - end do - - end if ! for domomtran - end do - - ! Need to add an energy fix to account for the dissipation of kinetic energy - ! Formulation follows from Boville and Bretherton (2003) - ! formulation by PJR - - do k = ktm,pver - km1 = max(1,k-1) - kp1 = min(pver,k+1) - do i = il1g,il2g - - ii = ideep(i) - - ! calculate the KE fluxes at top and bot of layer - ! based on a discrete approximation to b&b eq(35) F_KE = u*F_u + v*F_v at interface - utop = (wind0(i,k,1)+wind0(i,km1,1))/2._r8 - vtop = (wind0(i,k,2)+wind0(i,km1,2))/2._r8 - ubot = (wind0(i,kp1,1)+wind0(i,k,1))/2._r8 - vbot = (wind0(i,kp1,2)+wind0(i,k,2))/2._r8 - fket = utop*mflux(i,k,1) + vtop*mflux(i,k,2) ! top of layer - fkeb = ubot*mflux(i,k+1,1) + vbot*mflux(i,k+1,2) ! bot of layer - - ! divergence of these fluxes should give a conservative redistribution of KE - ketend_cons = (fket-fkeb)/dp(i,k) - - ! tendency in kinetic energy resulting from the momentum transport - ketend = ((windf(i,k,1)**2 + windf(i,k,2)**2) - (wind0(i,k,1)**2 + wind0(i,k,2)**2))*0.5_r8/dt - - ! the difference should be the dissipation - gset2 = ketend_cons - ketend - gseten(i,k) = gset2 - - end do - - end do - - ! Scatter dry static energy to full array - do k = 1,pver - do i = il1g,il2g - ii = ideep(i) - seten(ii,k) = gseten(i,k) - - end do - end do - - return -end subroutine momtran - -!========================================================================================= - -subroutine buoyan(lchnk ,ncol , & - q ,t ,p ,z ,pf , & - tp ,qstp ,tl ,rl ,cape , & - pblt ,lcl ,lel ,lon ,mx , & - rd ,grav ,cp ,msg , & - tpert ) -!----------------------------------------------------------------------- -! -! Purpose: -! -! -! Method: -! -! -! -! Author: -! This is contributed code not fully standardized by the CCM core group. -! The documentation has been enhanced to the degree that we are able. -! Reviewed: P. Rasch, April 1996 -! -!----------------------------------------------------------------------- - implicit none -!----------------------------------------------------------------------- -! -! input arguments -! - integer, intent(in) :: lchnk ! chunk identifier - integer, intent(in) :: ncol ! number of atmospheric columns - - real(r8), intent(in) :: q(pcols,pver) ! spec. humidity - real(r8), intent(in) :: t(pcols,pver) ! temperature - real(r8), intent(in) :: p(pcols,pver) ! pressure - real(r8), intent(in) :: z(pcols,pver) ! height - real(r8), intent(in) :: pf(pcols,pver+1) ! pressure at interfaces - real(r8), intent(in) :: pblt(pcols) ! index of pbl depth - real(r8), intent(in) :: tpert(pcols) ! perturbation temperature by pbl processes - -! -! output arguments -! - real(r8), intent(out) :: tp(pcols,pver) ! parcel temperature - real(r8), intent(out) :: qstp(pcols,pver) ! saturation mixing ratio of parcel - real(r8), intent(out) :: tl(pcols) ! parcel temperature at lcl - real(r8), intent(out) :: cape(pcols) ! convective aval. pot. energy. - integer lcl(pcols) ! - integer lel(pcols) ! - integer lon(pcols) ! level of onset of deep convection - integer mx(pcols) ! level of max moist static energy -! -!--------------------------Local Variables------------------------------ -! - real(r8) capeten(pcols,num_cin) ! provisional value of cape - real(r8) tv(pcols,pver) ! - real(r8) tpv(pcols,pver) ! - real(r8) buoy(pcols,pver) - - real(r8) a1(pcols) - real(r8) a2(pcols) - real(r8) estp(pcols) - real(r8) pl(pcols) - real(r8) plexp(pcols) - real(r8) hmax(pcols) - real(r8) hmn(pcols) - real(r8) y(pcols) - - logical plge600(pcols) - integer knt(pcols) - integer lelten(pcols,num_cin) - - real(r8) cp - real(r8) e - real(r8) grav - - integer i - integer k - integer msg - integer n - - real(r8) rd - real(r8) rl -! -!----------------------------------------------------------------------- -! - do n = 1,num_cin - do i = 1,ncol - lelten(i,n) = pver - capeten(i,n) = 0._r8 - end do - end do -! - do i = 1,ncol - lon(i) = pver - knt(i) = 0 - lel(i) = pver - mx(i) = lon(i) - cape(i) = 0._r8 - hmax(i) = 0._r8 - end do - - tp(:ncol,:) = t(:ncol,:) - qstp(:ncol,:) = q(:ncol,:) - -!!! RBN - Initialize tv and buoy for output. -!!! tv=tv : tpv=tpv : qstp=q : buoy=0. - tv(:ncol,:) = t(:ncol,:) *(1._r8+1.608_r8*q(:ncol,:))/ (1._r8+q(:ncol,:)) - tpv(:ncol,:) = tv(:ncol,:) - buoy(:ncol,:) = 0._r8 - -! -! set "launching" level(mx) to be at maximum moist static energy. -! search for this level stops at planetary boundary layer top. -! - do k = pver,msg + 1,-1 - do i = 1,ncol - hmn(i) = cp*t(i,k) + grav*z(i,k) + rl*q(i,k) - if (k >= nint(pblt(i)) .and. k <= lon(i) .and. hmn(i) > hmax(i)) then - hmax(i) = hmn(i) - mx(i) = k - end if - end do - end do - -! - do i = 1,ncol - lcl(i) = mx(i) - e = p(i,mx(i))*q(i,mx(i))/ (eps1+q(i,mx(i))) - tl(i) = 2840._r8/ (3.5_r8*log(t(i,mx(i)))-log(e)-4.805_r8) + 55._r8 - if (tl(i) < t(i,mx(i))) then - plexp(i) = (1._r8/ (0.2854_r8* (1._r8-0.28_r8*q(i,mx(i))))) - pl(i) = p(i,mx(i))* (tl(i)/t(i,mx(i)))**plexp(i) - else - tl(i) = t(i,mx(i)) - pl(i) = p(i,mx(i)) - end if - end do - -! -! calculate lifting condensation level (lcl). -! - do k = pver,msg + 2,-1 - do i = 1,ncol - if (k <= mx(i) .and. (p(i,k) > pl(i) .and. p(i,k-1) <= pl(i))) then - lcl(i) = k - 1 - end if - end do - end do -! -! if lcl is above the nominal level of non-divergence (600 mbs), -! no deep convection is permitted (ensuing calculations -! skipped and cape retains initialized value of zero). -! - do i = 1,ncol - plge600(i) = pl(i).ge.600._r8 - end do -! -! initialize parcel properties in sub-cloud layer below lcl. -! - do k = pver,msg + 1,-1 - do i=1,ncol - if (k > lcl(i) .and. k <= mx(i) .and. plge600(i)) then - tv(i,k) = t(i,k)* (1._r8+1.608_r8*q(i,k))/ (1._r8+q(i,k)) - qstp(i,k) = q(i,mx(i)) - tp(i,k) = t(i,mx(i))* (p(i,k)/p(i,mx(i)))**(0.2854_r8* (1._r8-0.28_r8*q(i,mx(i)))) -! -! buoyancy is increased by 0.5 k as in tiedtke -! -!-jjh tpv (i,k)=tp(i,k)*(1.+1.608*q(i,mx(i)))/ -!-jjh 1 (1.+q(i,mx(i))) - tpv(i,k) = (tp(i,k)+tpert(i))*(1._r8+1.608_r8*q(i,mx(i)))/ (1._r8+q(i,mx(i))) - buoy(i,k) = tpv(i,k) - tv(i,k) + tiedke_add - end if - end do - end do - -! -! define parcel properties at lcl (i.e. level immediately above pl). -! - do k = pver,msg + 1,-1 - do i=1,ncol - if (k == lcl(i) .and. plge600(i)) then - tv(i,k) = t(i,k)* (1._r8+1.608_r8*q(i,k))/ (1._r8+q(i,k)) - qstp(i,k) = q(i,mx(i)) - tp(i,k) = tl(i)* (p(i,k)/pl(i))**(0.2854_r8* (1._r8-0.28_r8*qstp(i,k))) -! estp(i) =exp(21.656_r8 - 5418._r8/tp(i,k)) -! use of different formulas for es has about 1 g/kg difference -! in qs at t= 300k, and 0.02 g/kg at t=263k, with the formula -! above giving larger qs. - call qsat_hPa(tp(i,k), p(i,k), estp(i), qstp(i,k)) - a1(i) = cp / rl + qstp(i,k) * (1._r8+ qstp(i,k) / eps1) * rl * eps1 / & - (rd * tp(i,k) ** 2) - a2(i) = .5_r8* (qstp(i,k)* (1._r8+2._r8/eps1*qstp(i,k))* & - (1._r8+qstp(i,k)/eps1)*eps1**2*rl*rl/ & - (rd**2*tp(i,k)**4)-qstp(i,k)* & - (1._r8+qstp(i,k)/eps1)*2._r8*eps1*rl/ & - (rd*tp(i,k)**3)) - a1(i) = 1._r8/a1(i) - a2(i) = -a2(i)*a1(i)**3 - y(i) = q(i,mx(i)) - qstp(i,k) - tp(i,k) = tp(i,k) + a1(i)*y(i) + a2(i)*y(i)**2 - call qsat_hPa(tp(i,k), p(i,k), estp(i), qstp(i,k)) -! -! buoyancy is increased by 0.5 k in cape calculation. -! dec. 9, 1994 -!-jjh tpv(i,k) =tp(i,k)*(1.+1.608*qstp(i,k))/(1.+q(i,mx(i))) -! - tpv(i,k) = (tp(i,k)+tpert(i))* (1._r8+1.608_r8*qstp(i,k)) / (1._r8+q(i,mx(i))) - buoy(i,k) = tpv(i,k) - tv(i,k) + tiedke_add - end if - end do - end do -! -! main buoyancy calculation. -! - do k = pver - 1,msg + 1,-1 - do i=1,ncol - if (k < lcl(i) .and. plge600(i)) then - tv(i,k) = t(i,k)* (1._r8+1.608_r8*q(i,k))/ (1._r8+q(i,k)) - qstp(i,k) = qstp(i,k+1) - tp(i,k) = tp(i,k+1)* (p(i,k)/p(i,k+1))**(0.2854_r8* (1._r8-0.28_r8*qstp(i,k))) - call qsat_hPa(tp(i,k), p(i,k), estp(i), qstp(i,k)) - a1(i) = cp/rl + qstp(i,k)* (1._r8+qstp(i,k)/eps1)*rl*eps1/ (rd*tp(i,k)**2) - a2(i) = .5_r8* (qstp(i,k)* (1._r8+2._r8/eps1*qstp(i,k))* & - (1._r8+qstp(i,k)/eps1)*eps1**2*rl*rl/ & - (rd**2*tp(i,k)**4)-qstp(i,k)* & - (1._r8+qstp(i,k)/eps1)*2._r8*eps1*rl/ & - (rd*tp(i,k)**3)) - a1(i) = 1._r8/a1(i) - a2(i) = -a2(i)*a1(i)**3 - y(i) = qstp(i,k+1) - qstp(i,k) - tp(i,k) = tp(i,k) + a1(i)*y(i) + a2(i)*y(i)**2 - call qsat_hPa(tp(i,k), p(i,k), estp(i), qstp(i,k)) -!-jjh tpv(i,k) =tp(i,k)*(1.+1.608*qstp(i,k))/ -!jt (1.+q(i,mx(i))) - tpv(i,k) = (tp(i,k)+tpert(i))* (1._r8+1.608_r8*qstp(i,k))/(1._r8+q(i,mx(i))) - buoy(i,k) = tpv(i,k) - tv(i,k) + tiedke_add - end if - end do - end do - -! - do k = msg + 2,pver - do i = 1,ncol - if (k < lcl(i) .and. plge600(i)) then - if (buoy(i,k+1) > 0._r8 .and. buoy(i,k) <= 0._r8) then - knt(i) = min(5,knt(i) + 1) - lelten(i,knt(i)) = k - end if - end if - end do - end do -! -! calculate convective available potential energy (cape). -! - do n = 1,5 - do k = msg + 1,pver - do i = 1,ncol - if (plge600(i) .and. k <= mx(i) .and. k > lelten(i,n)) then - capeten(i,n) = capeten(i,n) + rd*buoy(i,k)*log(pf(i,k+1)/pf(i,k)) - end if - end do - end do - end do -! -! find maximum cape from all possible tentative capes from -! one sounding, -! and use it as the final cape, april 26, 1995 -! - do n = 1,5 - do i = 1,ncol - if (capeten(i,n) > cape(i)) then - cape(i) = capeten(i,n) - lel(i) = lelten(i,n) - end if - end do - end do -! -! put lower bound on cape for diagnostic purposes. -! - do i = 1,ncol - cape(i) = max(cape(i), 0._r8) - end do -! - return -end subroutine buoyan - -subroutine cldprp(lchnk , & - q ,t ,u ,v ,p , & - z ,s ,mu ,eu ,du , & - md ,ed ,sd ,qd ,mc , & - qu ,su ,zf ,qst ,hmn , & - hsat ,shat ,ql , & - cmeg ,jb ,lel ,jt ,jlcl , & - mx ,j0 ,jd ,rl ,il2g , & - rd ,grav ,cp ,msg , & - pflx ,evp ,cu ,rprd ,limcnv ,landfrac, & - qcde ,aero ,loc_conv,qhat ) - -!----------------------------------------------------------------------- -! -! Purpose: -! -! -! Method: -! may 09/91 - guang jun zhang, m.lazare, n.mcfarlane. -! original version cldprop. -! -! Author: See above, modified by P. Rasch -! This is contributed code not fully standardized by the CCM core group. -! -! this code is very much rougher than virtually anything else in the CCM -! there are debug statements left strewn about and code segments disabled -! these are to facilitate future development. We expect to release a -! cleaner code in a future release -! -! the documentation has been enhanced to the degree that we are able -! -!----------------------------------------------------------------------- - - implicit none - -!------------------------------------------------------------------------------ -! -! Input arguments -! - integer, intent(in) :: lchnk ! chunk identifier - - real(r8), intent(in) :: q(pcols,pver) ! spec. humidity of env - real(r8), intent(in) :: t(pcols,pver) ! temp of env - real(r8), intent(in) :: p(pcols,pver) ! pressure of env - real(r8), intent(in) :: z(pcols,pver) ! height of env - real(r8), intent(in) :: s(pcols,pver) ! normalized dry static energy of env - real(r8), intent(in) :: zf(pcols,pverp) ! height of interfaces - real(r8), intent(in) :: u(pcols,pver) ! zonal velocity of env - real(r8), intent(in) :: v(pcols,pver) ! merid. velocity of env - - real(r8), intent(in) :: landfrac(pcols) ! RBN Landfrac - - integer, intent(in) :: jb(pcols) ! updraft base level - integer, intent(in) :: lel(pcols) ! updraft launch level - integer, intent(out) :: jt(pcols) ! updraft plume top - integer, intent(out) :: jlcl(pcols) ! updraft lifting cond level - integer, intent(in) :: mx(pcols) ! updraft base level (same is jb) - integer, intent(out) :: j0(pcols) ! level where updraft begins detraining - integer, intent(out) :: jd(pcols) ! level of downdraft - integer, intent(in) :: limcnv ! convection limiting level - integer, intent(in) :: il2g !CORE GROUP REMOVE - integer, intent(in) :: msg ! missing moisture vals (always 0) - real(r8), intent(in) :: rl ! latent heat of vap - real(r8), intent(in) :: shat(pcols,pver) ! interface values of dry stat energy - real(r8), intent(in) :: qhat(pcols,pver) ! wg grid slice of upper interface mixing ratio. - type(zm_aero_t), intent(in) :: aero ! aerosol object - -! -! output -! - real(r8), intent(out) :: rprd(pcols,pver) ! rate of production of precip at that layer - real(r8), intent(out) :: du(pcols,pver) ! detrainement rate of updraft - real(r8), intent(out) :: ed(pcols,pver) ! entrainment rate of downdraft - real(r8), intent(out) :: eu(pcols,pver) ! entrainment rate of updraft - real(r8), intent(out) :: hmn(pcols,pver) ! moist stat energy of env - real(r8), intent(out) :: hsat(pcols,pver) ! sat moist stat energy of env - real(r8), intent(out) :: mc(pcols,pver) ! net mass flux - real(r8), intent(out) :: md(pcols,pver) ! downdraft mass flux - real(r8), intent(out) :: mu(pcols,pver) ! updraft mass flux - real(r8), intent(out) :: pflx(pcols,pverp) ! precipitation flux thru layer - real(r8), intent(out) :: qd(pcols,pver) ! spec humidity of downdraft - real(r8), intent(out) :: ql(pcols,pver) ! liq water of updraft - real(r8), intent(out) :: qst(pcols,pver) ! saturation mixing ratio of env. - real(r8), intent(out) :: qu(pcols,pver) ! spec hum of updraft - real(r8), intent(out) :: sd(pcols,pver) ! normalized dry stat energy of downdraft - real(r8), intent(out) :: su(pcols,pver) ! normalized dry stat energy of updraft - real(r8), intent(out) :: qcde(pcols,pver) ! cloud water mixing ratio for detrainment (kg/kg) - - type(zm_conv_t) :: loc_conv - - real(r8) rd ! gas constant for dry air - real(r8) grav ! gravity - real(r8) cp ! heat capacity of dry air - -! -! Local workspace -! - real(r8) gamma(pcols,pver) - real(r8) dz(pcols,pver) - real(r8) iprm(pcols,pver) - real(r8) hu(pcols,pver) - real(r8) hd(pcols,pver) - real(r8) eps(pcols,pver) - real(r8) f(pcols,pver) - real(r8) k1(pcols,pver) - real(r8) i2(pcols,pver) - real(r8) ihat(pcols,pver) - real(r8) i3(pcols,pver) - real(r8) idag(pcols,pver) - real(r8) i4(pcols,pver) - real(r8) qsthat(pcols,pver) - real(r8) hsthat(pcols,pver) - real(r8) gamhat(pcols,pver) - real(r8) cu(pcols,pver) - real(r8) evp(pcols,pver) - real(r8) cmeg(pcols,pver) - real(r8) qds(pcols,pver) -! RBN For c0mask - real(r8) c0mask(pcols) - - real(r8) hmin(pcols) - real(r8) expdif(pcols) - real(r8) expnum(pcols) - real(r8) ftemp(pcols) - real(r8) eps0(pcols) - real(r8) rmue(pcols) - real(r8) zuef(pcols) - real(r8) zdef(pcols) - real(r8) epsm(pcols) - real(r8) ratmjb(pcols) - real(r8) est(pcols) - real(r8) totpcp(pcols) - real(r8) totevp(pcols) - real(r8) alfa(pcols) - real(r8) ql1 - real(r8) tu - real(r8) estu - real(r8) qstu - - real(r8) small - real(r8) mdt - - real(r8) fice(pcols,pver) ! ice fraction in precip production - real(r8) tug(pcols,pver) - - real(r8) tvuo(pcols,pver) ! updraft virtual T w/o freezing heating - real(r8) tvu(pcols,pver) ! updraft virtual T with freezing heating - real(r8) totfrz(pcols) - real(r8) frz (pcols,pver) ! rate of freezing - integer jto(pcols) ! updraft plume old top - integer tmplel(pcols) - - integer iter, itnum - integer m - - integer khighest - integer klowest - integer kount - integer i,k - - logical doit(pcols) - logical done(pcols) -! -!------------------------------------------------------------------------------ -! - if (zmconv_microp) then - loc_conv%autolm(:il2g,:) = 0._r8 - loc_conv%accrlm(:il2g,:) = 0._r8 - loc_conv%bergnm(:il2g,:) = 0._r8 - loc_conv%fhtimm(:il2g,:) = 0._r8 - loc_conv%fhtctm(:il2g,:) = 0._r8 - loc_conv%fhmlm (:il2g,:) = 0._r8 - loc_conv%hmpim (:il2g,:) = 0._r8 - loc_conv%accslm(:il2g,:) = 0._r8 - loc_conv%dlfm (:il2g,:) = 0._r8 - - loc_conv%autoln(:il2g,:) = 0._r8 - loc_conv%accrln(:il2g,:) = 0._r8 - loc_conv%bergnn(:il2g,:) = 0._r8 - loc_conv%fhtimn(:il2g,:) = 0._r8 - loc_conv%fhtctn(:il2g,:) = 0._r8 - loc_conv%fhmln (:il2g,:) = 0._r8 - loc_conv%accsln(:il2g,:) = 0._r8 - loc_conv%activn(:il2g,:) = 0._r8 - loc_conv%dlfn (:il2g,:) = 0._r8 - - loc_conv%autoim(:il2g,:) = 0._r8 - loc_conv%accsim(:il2g,:) = 0._r8 - loc_conv%difm (:il2g,:) = 0._r8 - - loc_conv%nuclin(:il2g,:) = 0._r8 - loc_conv%autoin(:il2g,:) = 0._r8 - loc_conv%accsin(:il2g,:) = 0._r8 - loc_conv%hmpin (:il2g,:) = 0._r8 - loc_conv%difn (:il2g,:) = 0._r8 - - loc_conv%trspcm(:il2g,:) = 0._r8 - loc_conv%trspcn(:il2g,:) = 0._r8 - loc_conv%trspim(:il2g,:) = 0._r8 - loc_conv%trspin(:il2g,:) = 0._r8 - - loc_conv%dcape (:il2g) = 0._r8 - - end if - - do i = 1,il2g - ftemp(i) = 0._r8 - expnum(i) = 0._r8 - expdif(i) = 0._r8 - c0mask(i) = c0_ocn * (1._r8-landfrac(i)) + c0_lnd * landfrac(i) - end do -! -!jr Change from msg+1 to 1 to prevent blowup -! - do k = 1,pver - do i = 1,il2g - dz(i,k) = zf(i,k) - zf(i,k+1) - end do - end do - -! -! initialize many output and work variables to zero -! - pflx(:il2g,1) = 0 - - do k = 1,pver - do i = 1,il2g - k1(i,k) = 0._r8 - i2(i,k) = 0._r8 - i3(i,k) = 0._r8 - i4(i,k) = 0._r8 - mu(i,k) = 0._r8 - f(i,k) = 0._r8 - eps(i,k) = 0._r8 - eu(i,k) = 0._r8 - du(i,k) = 0._r8 - ql(i,k) = 0._r8 - cu(i,k) = 0._r8 - evp(i,k) = 0._r8 - cmeg(i,k) = 0._r8 - qds(i,k) = q(i,k) - md(i,k) = 0._r8 - ed(i,k) = 0._r8 - sd(i,k) = s(i,k) - qd(i,k) = q(i,k) - mc(i,k) = 0._r8 - qu(i,k) = q(i,k) - su(i,k) = s(i,k) - call qsat_hPa(t(i,k), p(i,k), est(i), qst(i,k)) - - if ( p(i,k)-est(i) <= 0._r8 ) then - qst(i,k) = 1.0_r8 - end if - - gamma(i,k) = qst(i,k)*(1._r8 + qst(i,k)/eps1)*eps1*rl/(rd*t(i,k)**2)*rl/cp - hmn(i,k) = cp*t(i,k) + grav*z(i,k) + rl*q(i,k) - hsat(i,k) = cp*t(i,k) + grav*z(i,k) + rl*qst(i,k) - hu(i,k) = hmn(i,k) - hd(i,k) = hmn(i,k) - rprd(i,k) = 0._r8 - - fice(i,k) = 0._r8 - tug(i,k) = 0._r8 - qcde(i,k) = 0._r8 - tvuo(i,k) = (shat(i,k) - grav/cp*zf(i,k))*(1._r8 + 0.608_r8*qhat(i,k)) - tvu(i,k) = tvuo(i,k) - frz(i,k) = 0._r8 - - end do - end do - if (zmconv_microp) then - do k = 1,pver - do i = 1,il2g - loc_conv%sprd(i,k) = 0._r8 - loc_conv%wu(i,k) = 0._r8 - loc_conv%cmel(i,k) = 0._r8 - loc_conv%cmei(i,k) = 0._r8 - loc_conv%qliq(i,k) = 0._r8 - loc_conv%qice(i,k) = 0._r8 - loc_conv%qnl(i,k) = 0._r8 - loc_conv%qni(i,k) = 0._r8 - loc_conv%qide(i,k) = 0._r8 - loc_conv%qncde(i,k) = 0._r8 - loc_conv%qnide(i,k) = 0._r8 - loc_conv%qnr(i,k) = 0._r8 - loc_conv%qns(i,k) = 0._r8 - loc_conv%qrain(i,k)= 0._r8 - loc_conv%qsnow(i,k)= 0._r8 - loc_conv%frz(i,k) = 0._r8 - end do - end do - end if -! -!jr Set to zero things which make this routine blow up -! - do k=1,msg - do i=1,il2g - rprd(i,k) = 0._r8 - end do - end do -! -! interpolate the layer values of qst, hsat and gamma to -! layer interfaces -! - do k = 1, msg+1 - do i = 1,il2g - hsthat(i,k) = hsat(i,k) - qsthat(i,k) = qst(i,k) - gamhat(i,k) = gamma(i,k) - end do - end do - do i = 1,il2g - totpcp(i) = 0._r8 - totevp(i) = 0._r8 - end do - do k = msg + 2,pver - do i = 1,il2g - if (abs(qst(i,k-1)-qst(i,k)) > 1.E-6_r8) then - qsthat(i,k) = log(qst(i,k-1)/qst(i,k))*qst(i,k-1)*qst(i,k)/ (qst(i,k-1)-qst(i,k)) - else - qsthat(i,k) = qst(i,k) - end if - hsthat(i,k) = cp*shat(i,k) + rl*qsthat(i,k) - if (abs(gamma(i,k-1)-gamma(i,k)) > 1.E-6_r8) then - gamhat(i,k) = log(gamma(i,k-1)/gamma(i,k))*gamma(i,k-1)*gamma(i,k)/ & - (gamma(i,k-1)-gamma(i,k)) - else - gamhat(i,k) = gamma(i,k) - end if - end do - end do -! -! initialize cloud top to highest plume top. -!jr changed hard-wired 4 to limcnv+1 (not to exceed pver) -! - jt(:) = pver - do i = 1,il2g - jt(i) = max(lel(i),limcnv+1) - jt(i) = min(jt(i),pver) - jd(i) = pver - jlcl(i) = lel(i) - hmin(i) = 1.E6_r8 - end do -! -! find the level of minimum hsat, where detrainment starts -! - - do k = msg + 1,pver - do i = 1,il2g - if (hsat(i,k) <= hmin(i) .and. k >= jt(i) .and. k <= jb(i)) then - hmin(i) = hsat(i,k) - j0(i) = k - end if - end do - end do - do i = 1,il2g - j0(i) = min(j0(i),jb(i)-2) - j0(i) = max(j0(i),jt(i)+2) -! -! Fix from Guang Zhang to address out of bounds array reference -! - j0(i) = min(j0(i),pver) - end do -! -! Initialize certain arrays inside cloud -! - do k = msg + 1,pver - do i = 1,il2g - if (k >= jt(i) .and. k <= jb(i)) then - hu(i,k) = hmn(i,mx(i)) + cp*tiedke_add - su(i,k) = s(i,mx(i)) + tiedke_add - end if - end do - end do -! -! ********************************************************* -! compute taylor series for approximate eps(z) below -! ********************************************************* -! - do k = pver - 1,msg + 1,-1 - do i = 1,il2g - if (k < jb(i) .and. k >= jt(i)) then - k1(i,k) = k1(i,k+1) + (hmn(i,mx(i))-hmn(i,k))*dz(i,k) - ihat(i,k) = 0.5_r8* (k1(i,k+1)+k1(i,k)) - i2(i,k) = i2(i,k+1) + ihat(i,k)*dz(i,k) - idag(i,k) = 0.5_r8* (i2(i,k+1)+i2(i,k)) - i3(i,k) = i3(i,k+1) + idag(i,k)*dz(i,k) - iprm(i,k) = 0.5_r8* (i3(i,k+1)+i3(i,k)) - i4(i,k) = i4(i,k+1) + iprm(i,k)*dz(i,k) - end if - end do - end do -! -! re-initialize hmin array for ensuing calculation. -! - do i = 1,il2g - hmin(i) = 1.E6_r8 - end do - do k = msg + 1,pver - do i = 1,il2g - if (k >= j0(i) .and. k <= jb(i) .and. hmn(i,k) <= hmin(i)) then - hmin(i) = hmn(i,k) - expdif(i) = hmn(i,mx(i)) - hmin(i) - end if - end do - end do -! -! ********************************************************* -! compute approximate eps(z) using above taylor series -! ********************************************************* -! - do k = msg + 2,pver - do i = 1,il2g - expnum(i) = 0._r8 - ftemp(i) = 0._r8 - if (k < jt(i) .or. k >= jb(i)) then - k1(i,k) = 0._r8 - expnum(i) = 0._r8 - else - expnum(i) = hmn(i,mx(i)) - (hsat(i,k-1)*(zf(i,k)-z(i,k)) + & - hsat(i,k)* (z(i,k-1)-zf(i,k)))/(z(i,k-1)-z(i,k)) - end if - if ((expdif(i) > 100._r8 .and. expnum(i) > 0._r8) .and. & - k1(i,k) > expnum(i)*dz(i,k)) then - ftemp(i) = expnum(i)/k1(i,k) - f(i,k) = ftemp(i) + i2(i,k)/k1(i,k)*ftemp(i)**2 + & - (2._r8*i2(i,k)**2-k1(i,k)*i3(i,k))/k1(i,k)**2* & - ftemp(i)**3 + (-5._r8*k1(i,k)*i2(i,k)*i3(i,k)+ & - 5._r8*i2(i,k)**3+k1(i,k)**2*i4(i,k))/ & - k1(i,k)**3*ftemp(i)**4 - f(i,k) = max(f(i,k),0._r8) - f(i,k) = min(f(i,k),0.0002_r8) - end if - end do - end do - do i = 1,il2g - if (j0(i) < jb(i)) then - if (f(i,j0(i)) < 1.E-6_r8 .and. f(i,j0(i)+1) > f(i,j0(i))) j0(i) = j0(i) + 1 - end if - end do - do k = msg + 2,pver - do i = 1,il2g - if (k >= jt(i) .and. k <= j0(i)) then - f(i,k) = max(f(i,k),f(i,k-1)) - end if - end do - end do - do i = 1,il2g - eps0(i) = f(i,j0(i)) - eps(i,jb(i)) = eps0(i) - end do -! -! This is set to match the Rasch and Kristjansson paper -! - do k = pver,msg + 1,-1 - do i = 1,il2g - if (k >= j0(i) .and. k <= jb(i)) then - eps(i,k) = f(i,j0(i)) - end if - end do - end do - do k = pver,msg + 1,-1 - do i = 1,il2g - if (k < j0(i) .and. k >= jt(i)) eps(i,k) = f(i,k) - end do - end do - - if (zmconv_microp) then - itnum = 2 - else - itnum = 1 - end if - - do iter=1, itnum - - if (zmconv_microp) then - do k = pver,msg + 1,-1 - do i = 1,il2g - cu(i,k) = 0._r8 - loc_conv%qliq(i,k) = 0._r8 - loc_conv%qice(i,k) = 0._r8 - ql(i,k) = 0._r8 - loc_conv%frz(i,k) = 0._r8 - end do - end do - do i = 1,il2g - totpcp(i) = 0._r8 - hu(i,jb(i)) = hmn(i,jb(i)) + cp*tiedke_add - end do - - end if - -! -! specify the updraft mass flux mu, entrainment eu, detrainment du -! and moist static energy hu. -! here and below mu, eu,du, md and ed are all normalized by mb -! - do i = 1,il2g - if (eps0(i) > 0._r8) then - mu(i,jb(i)) = 1._r8 - eu(i,jb(i)) = mu(i,jb(i))/dz(i,jb(i)) - end if - if (zmconv_microp) then - tmplel(i) = lel(i) - else - tmplel(i) = jt(i) - end if - end do - do k = pver,msg + 1,-1 - do i = 1,il2g - if (eps0(i) > 0._r8 .and. (k >= tmplel(i) .and. k < jb(i))) then - zuef(i) = zf(i,k) - zf(i,jb(i)) - rmue(i) = (1._r8/eps0(i))* (exp(eps(i,k+1)*zuef(i))-1._r8)/zuef(i) - mu(i,k) = (1._r8/eps0(i))* (exp(eps(i,k )*zuef(i))-1._r8)/zuef(i) - eu(i,k) = (rmue(i)-mu(i,k+1))/dz(i,k) - du(i,k) = (rmue(i)-mu(i,k))/dz(i,k) - end if - end do - end do - - khighest = pverp - klowest = 1 - do i=1,il2g - khighest = min(khighest,lel(i)) - klowest = max(klowest,jb(i)) - end do - do k = klowest-1,khighest,-1 - do i = 1,il2g - if (k <= jb(i)-1 .and. k >= lel(i) .and. eps0(i) > 0._r8) then - if (mu(i,k) < 0.02_r8) then - hu(i,k) = hmn(i,k) - mu(i,k) = 0._r8 - eu(i,k) = 0._r8 - du(i,k) = mu(i,k+1)/dz(i,k) - else - if (zmconv_microp) then - hu(i,k) = (mu(i,k+1)*hu(i,k+1) + dz(i,k)*(eu(i,k)*hmn(i,k) + & - latice*frz(i,k)))/(mu(i,k)+ dz(i,k)*du(i,k)) - else - hu(i,k) = mu(i,k+1)/mu(i,k)*hu(i,k+1) + & - dz(i,k)/mu(i,k)* (eu(i,k)*hmn(i,k)- du(i,k)*hsat(i,k)) - end if - end if - end if - end do - end do -! -! reset cloud top index beginning from two layers above the -! cloud base (i.e. if cloud is only one layer thick, top is not reset -! - do i=1,il2g - doit(i) = .true. - totfrz(i)= 0._r8 - do k = pver,msg + 1,-1 - totfrz(i)= totfrz(i)+ frz(i,k)*dz(i,k) - end do - end do - do k=klowest-2,khighest-1,-1 - do i=1,il2g - if (doit(i) .and. k <= jb(i)-2 .and. k >= lel(i)-1) then - if (hu(i,k) <= hsthat(i,k) .and. hu(i,k+1) > hsthat(i,k+1) & - .and. mu(i,k) >= 0.02_r8) then - if (hu(i,k)-hsthat(i,k) < -2000._r8) then - jt(i) = k + 1 - doit(i) = .false. - else - jt(i) = k - doit(i) = .false. - end if - else if ( (hu(i,k) > hu(i,jb(i)) .and. totfrz(i)<=0._r8) .or. mu(i,k) < 0.02_r8) then - jt(i) = k + 1 - doit(i) = .false. - end if - end if - end do - end do - - if (iter == 1) jto(:) = jt(:) - - do k = pver,msg + 1,-1 - do i = 1,il2g - if (k >= lel(i) .and. k <= jt(i) .and. eps0(i) > 0._r8) then - mu(i,k) = 0._r8 - eu(i,k) = 0._r8 - du(i,k) = 0._r8 - hu(i,k) = hmn(i,k) - end if - if (k == jt(i) .and. eps0(i) > 0._r8) then - du(i,k) = mu(i,k+1)/dz(i,k) - eu(i,k) = 0._r8 - mu(i,k) = 0._r8 - end if - end do - end do - - do i = 1,il2g - done(i) = .false. - end do - kount = 0 - do k = pver,msg + 2,-1 - do i = 1,il2g - if (k == jb(i) .and. eps0(i) > 0._r8) then - qu(i,k) = q(i,mx(i)) - su(i,k) = (hu(i,k)-rl*qu(i,k))/cp - end if - if (( .not. done(i) .and. k > jt(i) .and. k < jb(i)) .and. eps0(i) > 0._r8) then - su(i,k) = mu(i,k+1)/mu(i,k)*su(i,k+1) + & - dz(i,k)/mu(i,k)* (eu(i,k)-du(i,k))*s(i,k) - qu(i,k) = mu(i,k+1)/mu(i,k)*qu(i,k+1) + dz(i,k)/mu(i,k)* (eu(i,k)*q(i,k)- & - du(i,k)*qst(i,k)) - tu = su(i,k) - grav/cp*zf(i,k) - call qsat_hPa(tu, (p(i,k)+p(i,k-1))/2._r8, estu, qstu) - if (qu(i,k) >= qstu) then - jlcl(i) = k - kount = kount + 1 - done(i) = .true. - end if - end if - end do - if (kount >= il2g) goto 690 - end do -690 continue - do k = msg + 2,pver - do i = 1,il2g - if ((k > jt(i) .and. k <= jlcl(i)) .and. eps0(i) > 0._r8) then - su(i,k) = shat(i,k) + (hu(i,k)-hsthat(i,k))/(cp* (1._r8+gamhat(i,k))) - qu(i,k) = qsthat(i,k) + gamhat(i,k)*(hu(i,k)-hsthat(i,k))/ & - (rl* (1._r8+gamhat(i,k))) - end if - end do - end do - -! compute condensation in updraft - if (zmconv_microp) then - tmplel(:il2g) = jlcl(:il2g)+1 - else - tmplel(:il2g) = jb(:il2g) - end if - - do k = pver,msg + 2,-1 - do i = 1,il2g - if (k >= jt(i) .and. k < tmplel(i) .and. eps0(i) > 0._r8) then - if (zmconv_microp) then - cu(i,k) = ((mu(i,k)*su(i,k)-mu(i,k+1)*su(i,k+1))/ & - dz(i,k)- eu(i,k)*s(i,k)+du(i,k)*su(i,k))/(rl/cp) & - - latice*frz(i,k)/rl - else - - cu(i,k) = ((mu(i,k)*su(i,k)-mu(i,k+1)*su(i,k+1))/ & - dz(i,k)- (eu(i,k)-du(i,k))*s(i,k))/(rl/cp) - end if - if (k == jt(i)) cu(i,k) = 0._r8 - cu(i,k) = max(0._r8,cu(i,k)) - end if - end do - end do - - - if (zmconv_microp) then - - tug(:il2g,:) = t(:il2g,:) - fice(:,:) = 0._r8 - - do k = pver, msg+2, -1 - do i = 1, il2g - tug(i,k) = su(i,k) - grav/cp*zf(i,k) - end do - end do - - do k = 1, pver-1 - do i = 1, il2g - - if (tug(i,k+1) > 273.15_r8) then - ! If warmer than tmax then water phase - fice(i,k) = 0._r8 - - else if (tug(i,k+1) < 233.15_r8) then - ! If colder than tmin then ice phase - fice(i,k) = 1._r8 - - else - ! Otherwise mixed phase, with ice fraction decreasing linearly - ! from tmin to tmax - fice(i,k) =(273.15_r8 - tug(i,k+1)) / 40._r8 - end if - end do - end do - - do k = 1, pver - do i = 1,il2g - loc_conv%cmei(i,k) = cu(i,k)* fice(i,k) - loc_conv%cmel(i,k) = cu(i,k) * (1._r8-fice(i,k)) - end do - end do - - call zm_mphy(su, qu, mu, du, eu, loc_conv%cmel, loc_conv%cmei, zf, p, t, q, & - eps0, jb, jt, jlcl, msg, il2g, grav, cp, rd, aero, gamhat, & - loc_conv%qliq, loc_conv%qice, loc_conv%qnl, loc_conv%qni, qcde, loc_conv%qide, & - loc_conv%qncde, loc_conv%qnide, rprd, loc_conv%sprd, frz, & - loc_conv%wu, loc_conv%qrain, loc_conv%qsnow, loc_conv%qnr, loc_conv%qns, & - loc_conv%autolm, loc_conv%accrlm, loc_conv%bergnm, loc_conv%fhtimm, loc_conv%fhtctm, & - loc_conv%fhmlm, loc_conv%hmpim, loc_conv%accslm, loc_conv%dlfm, loc_conv%autoln, & - loc_conv%accrln, loc_conv%bergnn, loc_conv%fhtimn, loc_conv%fhtctn, & - loc_conv%fhmln, loc_conv%accsln, loc_conv%activn, loc_conv%dlfn, loc_conv%autoim, & - loc_conv%accsim, loc_conv%difm, loc_conv%nuclin, loc_conv%autoin, & - loc_conv%accsin, loc_conv%hmpin, loc_conv%difn, loc_conv%trspcm, loc_conv%trspcn, & - loc_conv%trspim, loc_conv%trspin, loc_conv%lambdadpcu, loc_conv%mudpcu ) - - - do k = pver,msg + 2,-1 - do i = 1,il2g - ql(i,k) = loc_conv%qliq(i,k)+ loc_conv%qice(i,k) - loc_conv%frz(i,k) = frz(i,k) - end do - end do - - do i = 1,il2g - if (iter == 2 .and. jt(i)> jto(i)) then - do k = jt(i), jto(i), -1 - loc_conv%frz(i,k) = 0.0_r8 - cu(i,k)=0.0_r8 - end do - end if - end do - - - do k = pver,msg + 2,-1 - do i = 1,il2g - if (k >= jt(i) .and. k < jb(i) .and. eps0(i) > 0._r8 .and. mu(i,k) >= 0.0_r8) then - totpcp(i) = totpcp(i) + dz(i,k)*(cu(i,k)-du(i,k)*(qcde(i,k+1)+loc_conv%qide(i,k+1) )) - end if - end do - end do - - do k = msg + 2,pver - do i = 1,il2g - if ((k > jt(i) .and. k <= jlcl(i)) .and. eps0(i) > 0._r8) then - if (iter == 1) tvuo(i,k)= (su(i,k) - grav/cp*zf(i,k))*(1._r8+0.608_r8*qu(i,k)) - if (iter == 2 .and. k > max(jt(i),jto(i)) ) then - tvu(i,k) = (su(i,k) - grav/cp*zf(i,k))*(1._r8 +0.608_r8*qu(i,k)) - loc_conv%dcape(i) = loc_conv%dcape(i)+ rd*(tvu(i,k)-tvuo(i,k))*log(p(i,k)/p(i,k-1)) - end if - end if - end do - end do - - else ! no convective microphysics - -! compute condensed liquid, rain production rate -! accumulate total precipitation (condensation - detrainment of liquid) -! Note ql1 = ql(k) + rprd(k)*dz(k)/mu(k) -! The differencing is somewhat strange (e.g. du(i,k)*ql(i,k+1)) but is -! consistently applied. -! mu, ql are interface quantities -! cu, du, eu, rprd are midpoint quantites - - do k = pver,msg + 2,-1 - do i = 1,il2g - rprd(i,k) = 0._r8 - if (k >= jt(i) .and. k < jb(i) .and. eps0(i) > 0._r8 .and. mu(i,k) >= 0.0_r8) then - if (mu(i,k) > 0._r8) then - ql1 = 1._r8/mu(i,k)* (mu(i,k+1)*ql(i,k+1)- & - dz(i,k)*du(i,k)*ql(i,k+1)+dz(i,k)*cu(i,k)) - ql(i,k) = ql1/ (1._r8+dz(i,k)*c0mask(i)) - else - ql(i,k) = 0._r8 - end if - totpcp(i) = totpcp(i) + dz(i,k)*(cu(i,k)-du(i,k)*ql(i,k+1)) - rprd(i,k) = c0mask(i)*mu(i,k)*ql(i,k) - qcde(i,k) = ql(i,k) - - if (zmconv_microp) then - loc_conv%qide(i,k) = 0._r8 - loc_conv%qncde(i,k) = 0._r8 - loc_conv%qnide(i,k) = 0._r8 - loc_conv%sprd(i,k) = 0._r8 - end if - - end if - end do - end do -! - end if ! zmconv_microp - - end do !iter -! -! specify downdraft properties (no downdrafts if jd.ge.jb). -! scale down downward mass flux profile so that net flux -! (up-down) at cloud base in not negative. -! - do i = 1,il2g -! -! in normal downdraft strength run alfa=0.2. In test4 alfa=0.1 -! - alfa(i) = 0.1_r8 - jt(i) = min(jt(i),jb(i)-1) - jd(i) = max(j0(i),jt(i)+1) - jd(i) = min(jd(i),jb(i)) - hd(i,jd(i)) = hmn(i,jd(i)-1) - if (jd(i) < jb(i) .and. eps0(i) > 0._r8) then - epsm(i) = eps0(i) - md(i,jd(i)) = -alfa(i)*epsm(i)/eps0(i) - end if - end do - do k = msg + 1,pver - do i = 1,il2g - if ((k > jd(i) .and. k <= jb(i)) .and. eps0(i) > 0._r8) then - zdef(i) = zf(i,jd(i)) - zf(i,k) - md(i,k) = -alfa(i)/ (2._r8*eps0(i))*(exp(2._r8*epsm(i)*zdef(i))-1._r8)/zdef(i) - end if - end do - end do - - do k = msg + 1,pver - do i = 1,il2g - if ((k >= jt(i) .and. k <= jb(i)) .and. eps0(i) > 0._r8 .and. jd(i) < jb(i)) then - ratmjb(i) = min(abs(mu(i,jb(i))/md(i,jb(i))),1._r8) - md(i,k) = md(i,k)*ratmjb(i) - end if - end do - end do - - small = 1.e-20_r8 - do k = msg + 1,pver - do i = 1,il2g - if ((k >= jt(i) .and. k <= pver) .and. eps0(i) > 0._r8) then - ed(i,k-1) = (md(i,k-1)-md(i,k))/dz(i,k-1) - mdt = min(md(i,k),-small) - hd(i,k) = (md(i,k-1)*hd(i,k-1) - dz(i,k-1)*ed(i,k-1)*hmn(i,k-1))/mdt - end if - end do - end do -! -! calculate updraft and downdraft properties. -! - do k = msg + 2,pver - do i = 1,il2g - if ((k >= jd(i) .and. k <= jb(i)) .and. eps0(i) > 0._r8 .and. jd(i) < jb(i)) then - qds(i,k) = qsthat(i,k) + gamhat(i,k)*(hd(i,k)-hsthat(i,k))/ & - (rl*(1._r8 + gamhat(i,k))) - end if - end do - end do - - do i = 1,il2g - qd(i,jd(i)) = qds(i,jd(i)) - sd(i,jd(i)) = (hd(i,jd(i)) - rl*qd(i,jd(i)))/cp - end do -! - do k = msg + 2,pver - do i = 1,il2g - if (k >= jd(i) .and. k < jb(i) .and. eps0(i) > 0._r8) then - qd(i,k+1) = qds(i,k+1) - evp(i,k) = -ed(i,k)*q(i,k) + (md(i,k)*qd(i,k)-md(i,k+1)*qd(i,k+1))/dz(i,k) - evp(i,k) = max(evp(i,k),0._r8) - mdt = min(md(i,k+1),-small) - if (zmconv_microp) then - evp(i,k) = min(evp(i,k),rprd(i,k)) - end if - sd(i,k+1) = ((rl/cp*evp(i,k)-ed(i,k)*s(i,k))*dz(i,k) + md(i,k)*sd(i,k))/mdt - totevp(i) = totevp(i) - dz(i,k)*ed(i,k)*q(i,k) - end if - end do - end do - do i = 1,il2g -!*guang totevp(i) = totevp(i) + md(i,jd(i))*q(i,jd(i)-1) - - totevp(i) = totevp(i) + md(i,jd(i))*qd(i,jd(i)) - md(i,jb(i))*qd(i,jb(i)) - end do -!!$ if (.true.) then - if (.false.) then - do i = 1,il2g - k = jb(i) - if (eps0(i) > 0._r8) then - evp(i,k) = -ed(i,k)*q(i,k) + (md(i,k)*qd(i,k))/dz(i,k) - evp(i,k) = max(evp(i,k),0._r8) - totevp(i) = totevp(i) - dz(i,k)*ed(i,k)*q(i,k) - end if - end do - endif - - do i = 1,il2g - totpcp(i) = max(totpcp(i),0._r8) - totevp(i) = max(totevp(i),0._r8) - end do -! - do k = msg + 2,pver - do i = 1,il2g - if (totevp(i) > 0._r8 .and. totpcp(i) > 0._r8) then - md(i,k) = md (i,k)*min(1._r8, totpcp(i)/(totevp(i)+totpcp(i))) - ed(i,k) = ed (i,k)*min(1._r8, totpcp(i)/(totevp(i)+totpcp(i))) - evp(i,k) = evp(i,k)*min(1._r8, totpcp(i)/(totevp(i)+totpcp(i))) - else - md(i,k) = 0._r8 - ed(i,k) = 0._r8 - evp(i,k) = 0._r8 - end if -! cmeg is the cloud water condensed - rain water evaporated -! rprd is the cloud water converted to rain - (rain evaporated) - cmeg(i,k) = cu(i,k) - evp(i,k) - rprd(i,k) = rprd(i,k)-evp(i,k) - end do - end do - -! compute the net precipitation flux across interfaces - pflx(:il2g,1) = 0._r8 - do k = 2,pverp - do i = 1,il2g - pflx(i,k) = pflx(i,k-1) + rprd(i,k-1)*dz(i,k-1) - end do - end do -! - do k = msg + 1,pver - do i = 1,il2g - mc(i,k) = mu(i,k) + md(i,k) - end do - end do -! - return -end subroutine cldprp - -subroutine closure(lchnk , & - q ,t ,p ,z ,s , & - tp ,qs ,qu ,su ,mc , & - du ,mu ,md ,qd ,sd , & - qhat ,shat ,dp ,qstp ,zf , & - ql ,dsubcld ,mb ,cape ,tl , & - lcl ,lel ,jt ,mx ,il1g , & - il2g ,rd ,grav ,cp ,rl , & - msg ,capelmt ) -!----------------------------------------------------------------------- -! -! Purpose: -! -! -! Method: -! -! -! -! Author: G. Zhang and collaborators. CCM contact:P. Rasch -! This is contributed code not fully standardized by the CCM core group. -! -! this code is very much rougher than virtually anything else in the CCM -! We expect to release cleaner code in a future release -! -! the documentation has been enhanced to the degree that we are able -! -!----------------------------------------------------------------------- - -! -!-----------------------------Arguments--------------------------------- -! - integer, intent(in) :: lchnk ! chunk identifier - - real(r8), intent(inout) :: q(pcols,pver) ! spec humidity - real(r8), intent(inout) :: t(pcols,pver) ! temperature - real(r8), intent(inout) :: p(pcols,pver) ! pressure (mb) - real(r8), intent(inout) :: mb(pcols) ! cloud base mass flux - real(r8), intent(in) :: z(pcols,pver) ! height (m) - real(r8), intent(in) :: s(pcols,pver) ! normalized dry static energy - real(r8), intent(in) :: tp(pcols,pver) ! parcel temp - real(r8), intent(in) :: qs(pcols,pver) ! sat spec humidity - real(r8), intent(in) :: qu(pcols,pver) ! updraft spec. humidity - real(r8), intent(in) :: su(pcols,pver) ! normalized dry stat energy of updraft - real(r8), intent(in) :: mc(pcols,pver) ! net convective mass flux - real(r8), intent(in) :: du(pcols,pver) ! detrainment from updraft - real(r8), intent(in) :: mu(pcols,pver) ! mass flux of updraft - real(r8), intent(in) :: md(pcols,pver) ! mass flux of downdraft - real(r8), intent(in) :: qd(pcols,pver) ! spec. humidity of downdraft - real(r8), intent(in) :: sd(pcols,pver) ! dry static energy of downdraft - real(r8), intent(in) :: qhat(pcols,pver) ! environment spec humidity at interfaces - real(r8), intent(in) :: shat(pcols,pver) ! env. normalized dry static energy at intrfcs - real(r8), intent(in) :: dp(pcols,pver) ! pressure thickness of layers - real(r8), intent(in) :: qstp(pcols,pver) ! spec humidity of parcel - real(r8), intent(in) :: zf(pcols,pver+1) ! height of interface levels - real(r8), intent(in) :: ql(pcols,pver) ! liquid water mixing ratio - - real(r8), intent(in) :: cape(pcols) ! available pot. energy of column - real(r8), intent(in) :: tl(pcols) - real(r8), intent(in) :: dsubcld(pcols) ! thickness of subcloud layer - - integer, intent(in) :: lcl(pcols) ! index of lcl - integer, intent(in) :: lel(pcols) ! index of launch leve - integer, intent(in) :: jt(pcols) ! top of updraft - integer, intent(in) :: mx(pcols) ! base of updraft -! -!--------------------------Local variables------------------------------ -! - real(r8) dtpdt(pcols,pver) - real(r8) dqsdtp(pcols,pver) - real(r8) dtmdt(pcols,pver) - real(r8) dqmdt(pcols,pver) - real(r8) dboydt(pcols,pver) - real(r8) thetavp(pcols,pver) - real(r8) thetavm(pcols,pver) - - real(r8) dtbdt(pcols),dqbdt(pcols),dtldt(pcols) - real(r8) beta - real(r8) capelmt - real(r8) cp - real(r8) dadt(pcols) - real(r8) debdt - real(r8) dltaa - real(r8) eb - real(r8) grav - - integer i - integer il1g - integer il2g - integer k, kmin, kmax - integer msg - - real(r8) rd - real(r8) rl -! change of subcloud layer properties due to convection is -! related to cumulus updrafts and downdrafts. -! mc(z)=f(z)*mb, mub=betau*mb, mdb=betad*mb are used -! to define betau, betad and f(z). -! note that this implies all time derivatives are in effect -! time derivatives per unit cloud-base mass flux, i.e. they -! have units of 1/mb instead of 1/sec. -! - do i = il1g,il2g - mb(i) = 0._r8 - eb = p(i,mx(i))*q(i,mx(i))/ (eps1+q(i,mx(i))) - dtbdt(i) = (1._r8/dsubcld(i))* (mu(i,mx(i))*(shat(i,mx(i))-su(i,mx(i)))+ & - md(i,mx(i))* (shat(i,mx(i))-sd(i,mx(i)))) - dqbdt(i) = (1._r8/dsubcld(i))* (mu(i,mx(i))*(qhat(i,mx(i))-qu(i,mx(i)))+ & - md(i,mx(i))* (qhat(i,mx(i))-qd(i,mx(i)))) - debdt = eps1*p(i,mx(i))/ (eps1+q(i,mx(i)))**2*dqbdt(i) - dtldt(i) = -2840._r8* (3.5_r8/t(i,mx(i))*dtbdt(i)-debdt/eb)/ & - (3.5_r8*log(t(i,mx(i)))-log(eb)-4.805_r8)**2 - end do -! -! dtmdt and dqmdt are cumulus heating and drying. -! - do k = msg + 1,pver - do i = il1g,il2g - dtmdt(i,k) = 0._r8 - dqmdt(i,k) = 0._r8 - end do - end do -! - do k = msg + 1,pver - 1 - do i = il1g,il2g - if (k == jt(i)) then - dtmdt(i,k) = (1._r8/dp(i,k))*(mu(i,k+1)* (su(i,k+1)-shat(i,k+1)- & - rl/cp*ql(i,k+1))+md(i,k+1)* (sd(i,k+1)-shat(i,k+1))) - dqmdt(i,k) = (1._r8/dp(i,k))*(mu(i,k+1)* (qu(i,k+1)- & - qhat(i,k+1)+ql(i,k+1))+md(i,k+1)*(qd(i,k+1)-qhat(i,k+1))) - end if - end do - end do -! - beta = 0._r8 - do k = msg + 1,pver - 1 - do i = il1g,il2g - if (k > jt(i) .and. k < mx(i)) then - dtmdt(i,k) = (mc(i,k)* (shat(i,k)-s(i,k))+mc(i,k+1)* (s(i,k)-shat(i,k+1)))/ & - dp(i,k) - rl/cp*du(i,k)*(beta*ql(i,k)+ (1-beta)*ql(i,k+1)) -! dqmdt(i,k)=(mc(i,k)*(qhat(i,k)-q(i,k)) -! 1 +mc(i,k+1)*(q(i,k)-qhat(i,k+1)))/dp(i,k) -! 2 +du(i,k)*(qs(i,k)-q(i,k)) -! 3 +du(i,k)*(beta*ql(i,k)+(1-beta)*ql(i,k+1)) - - dqmdt(i,k) = (mu(i,k+1)* (qu(i,k+1)-qhat(i,k+1)+cp/rl* (su(i,k+1)-s(i,k)))- & - mu(i,k)* (qu(i,k)-qhat(i,k)+cp/rl*(su(i,k)-s(i,k)))+md(i,k+1)* & - (qd(i,k+1)-qhat(i,k+1)+cp/rl*(sd(i,k+1)-s(i,k)))-md(i,k)* & - (qd(i,k)-qhat(i,k)+cp/rl*(sd(i,k)-s(i,k))))/dp(i,k) + & - du(i,k)* (beta*ql(i,k)+(1-beta)*ql(i,k+1)) - end if - end do - end do -! - do k = msg + 1,pver - do i = il1g,il2g - if (k >= lel(i) .and. k <= lcl(i)) then - thetavp(i,k) = tp(i,k)* (1000._r8/p(i,k))** (rd/cp)*(1._r8+1.608_r8*qstp(i,k)-q(i,mx(i))) - thetavm(i,k) = t(i,k)* (1000._r8/p(i,k))** (rd/cp)*(1._r8+0.608_r8*q(i,k)) - dqsdtp(i,k) = qstp(i,k)* (1._r8+qstp(i,k)/eps1)*eps1*rl/(rd*tp(i,k)**2) -! -! dtpdt is the parcel temperature change due to change of -! subcloud layer properties during convection. -! - dtpdt(i,k) = tp(i,k)/ (1._r8+rl/cp* (dqsdtp(i,k)-qstp(i,k)/tp(i,k)))* & - (dtbdt(i)/t(i,mx(i))+rl/cp* (dqbdt(i)/tl(i)-q(i,mx(i))/ & - tl(i)**2*dtldt(i))) -! -! dboydt is the integrand of cape change. -! - dboydt(i,k) = ((dtpdt(i,k)/tp(i,k)+1._r8/(1._r8+1.608_r8*qstp(i,k)-q(i,mx(i)))* & - (1.608_r8 * dqsdtp(i,k) * dtpdt(i,k) -dqbdt(i))) - (dtmdt(i,k)/t(i,k)+0.608_r8/ & - (1._r8+0.608_r8*q(i,k))*dqmdt(i,k)))*grav*thetavp(i,k)/thetavm(i,k) - end if - end do - end do -! - do k = msg + 1,pver - do i = il1g,il2g - if (k > lcl(i) .and. k < mx(i)) then - thetavp(i,k) = tp(i,k)* (1000._r8/p(i,k))** (rd/cp)*(1._r8+0.608_r8*q(i,mx(i))) - thetavm(i,k) = t(i,k)* (1000._r8/p(i,k))** (rd/cp)*(1._r8+0.608_r8*q(i,k)) -! -! dboydt is the integrand of cape change. -! - dboydt(i,k) = (dtbdt(i)/t(i,mx(i))+0.608_r8/ (1._r8+0.608_r8*q(i,mx(i)))*dqbdt(i)- & - dtmdt(i,k)/t(i,k)-0.608_r8/ (1._r8+0.608_r8*q(i,k))*dqmdt(i,k))* & - grav*thetavp(i,k)/thetavm(i,k) - end if - end do - end do - -! -! buoyant energy change is set to 2/3*excess cape per 3 hours -! - dadt(il1g:il2g) = 0._r8 - kmin = minval(lel(il1g:il2g)) - kmax = maxval(mx(il1g:il2g)) - 1 - do k = kmin, kmax - do i = il1g,il2g - if ( k >= lel(i) .and. k <= mx(i) - 1) then - dadt(i) = dadt(i) + dboydt(i,k)* (zf(i,k)-zf(i,k+1)) - endif - end do - end do - do i = il1g,il2g - dltaa = -1._r8* (cape(i)-capelmt) - if (dadt(i) /= 0._r8) mb(i) = max(dltaa/tau/dadt(i),0._r8) - end do -! - return -end subroutine closure - -subroutine q1q2_pjr(lchnk , & - dqdt ,dsdt ,q ,qs ,qu , & - su ,du ,qhat ,shat ,dp , & - mu ,md ,sd ,qd ,ql , & - dsubcld ,jt ,mx ,il1g ,il2g , & - cp ,rl ,msg , & - dl ,evp ,cu , & - loc_conv) - - - implicit none - -!----------------------------------------------------------------------- -! -! Purpose: -! -! -! Method: -! -! -! -! Author: phil rasch dec 19 1995 -! -!----------------------------------------------------------------------- - - - real(r8), intent(in) :: cp - - integer, intent(in) :: lchnk ! chunk identifier - integer, intent(in) :: il1g - integer, intent(in) :: il2g - integer, intent(in) :: msg - - real(r8), intent(in) :: q(pcols,pver) - real(r8), intent(in) :: qs(pcols,pver) - real(r8), intent(in) :: qu(pcols,pver) - real(r8), intent(in) :: su(pcols,pver) - real(r8), intent(in) :: du(pcols,pver) - real(r8), intent(in) :: qhat(pcols,pver) - real(r8), intent(in) :: shat(pcols,pver) - real(r8), intent(in) :: dp(pcols,pver) - real(r8), intent(in) :: mu(pcols,pver) - real(r8), intent(in) :: md(pcols,pver) - real(r8), intent(in) :: sd(pcols,pver) - real(r8), intent(in) :: qd(pcols,pver) - real(r8), intent(in) :: ql(pcols,pver) - real(r8), intent(in) :: evp(pcols,pver) - real(r8), intent(in) :: cu(pcols,pver) - real(r8), intent(in) :: dsubcld(pcols) - - real(r8),intent(out) :: dqdt(pcols,pver),dsdt(pcols,pver) - real(r8),intent(out) :: dl(pcols,pver) - - type(zm_conv_t) :: loc_conv - - integer kbm - integer ktm - integer jt(pcols) - integer mx(pcols) -! -! work fields: -! - integer i - integer k - - real(r8) emc - real(r8) rl -!------------------------------------------------------------------- - do k = msg + 1,pver - do i = il1g,il2g - dsdt(i,k) = 0._r8 - dqdt(i,k) = 0._r8 - dl(i,k) = 0._r8 - end do - end do - - if (zmconv_microp) then - do k = msg + 1,pver - do i = il1g,il2g - loc_conv%di(i,k) = 0._r8 - loc_conv%dnl(i,k) = 0._r8 - loc_conv%dni(i,k) = 0._r8 - end do - end do - end if -! -! find the highest level top and bottom levels of convection -! - ktm = pver - kbm = pver - do i = il1g, il2g - ktm = min(ktm,jt(i)) - kbm = min(kbm,mx(i)) - end do - - do k = ktm,pver-1 - do i = il1g,il2g - emc = -cu (i,k) & ! condensation in updraft - +evp(i,k) ! evaporating rain in downdraft - - dsdt(i,k) = -rl/cp*emc & - + (+mu(i,k+1)* (su(i,k+1)-shat(i,k+1)) & - -mu(i,k)* (su(i,k)-shat(i,k)) & - +md(i,k+1)* (sd(i,k+1)-shat(i,k+1)) & - -md(i,k)* (sd(i,k)-shat(i,k)) & - )/dp(i,k) - - if (zmconv_microp) dsdt(i,k) = dsdt(i,k) + latice/cp*loc_conv%frz(i,k) - - dqdt(i,k) = emc + & - (+mu(i,k+1)* (qu(i,k+1)-qhat(i,k+1)) & - -mu(i,k)* (qu(i,k)-qhat(i,k)) & - +md(i,k+1)* (qd(i,k+1)-qhat(i,k+1)) & - -md(i,k)* (qd(i,k)-qhat(i,k)) & - )/dp(i,k) - - dl(i,k) = du(i,k)*ql(i,k+1) - - if (zmconv_microp) then - loc_conv%di(i,k) = du(i,k)*loc_conv%qide(i,k+1) - loc_conv%dnl(i,k) = du(i,k)*loc_conv%qncde(i,k+1) - loc_conv%dni(i,k) = du(i,k)*loc_conv%qnide(i,k+1) - end if - - end do - end do - -! - do k = kbm,pver - do i = il1g,il2g - if (k == mx(i)) then - dsdt(i,k) = (1._r8/dsubcld(i))* & - (-mu(i,k)* (su(i,k)-shat(i,k)) & - -md(i,k)* (sd(i,k)-shat(i,k)) & - ) - dqdt(i,k) = (1._r8/dsubcld(i))* & - (-mu(i,k)*(qu(i,k)-qhat(i,k)) & - -md(i,k)*(qd(i,k)-qhat(i,k)) & - ) - else if (k > mx(i)) then - dsdt(i,k) = dsdt(i,k-1) - dqdt(i,k) = dqdt(i,k-1) - end if - end do - end do -! - return -end subroutine q1q2_pjr - -subroutine buoyan_dilute(lchnk ,ncol , & - q ,t ,p ,z ,pf , & - tp ,qstp ,tl ,rl ,cape , & - pblt ,lcl ,lel ,lon ,mx , & - rd ,grav ,cp ,msg , & - zi ,zs ,tpert ,org , landfrac) -!----------------------------------------------------------------------- -! -! Purpose: -! Calculates CAPE the lifting condensation level and the convective top -! where buoyancy is first -ve. -! -! Method: Calculates the parcel temperature based on a simple constant -! entraining plume model. CAPE is integrated from buoyancy. -! 09/09/04 - Simplest approach using an assumed entrainment rate for -! testing (dmpdp). -! 08/04/05 - Swap to convert dmpdz to dmpdp -! -! SCAM Logical Switches - DILUTE:RBN - Now Disabled -! --------------------- -! switch(1) = .T. - Uses the dilute parcel calculation to obtain tendencies. -! switch(2) = .T. - Includes entropy/q changes due to condensate loss and freezing. -! switch(3) = .T. - Adds the PBL Tpert for the parcel temperature at all levels. -! -! References: -! Raymond and Blythe (1992) JAS -! -! Author: -! Richard Neale - September 2004 -! -!----------------------------------------------------------------------- - implicit none -!----------------------------------------------------------------------- -! -! input arguments -! - integer, intent(in) :: lchnk ! chunk identifier - integer, intent(in) :: ncol ! number of atmospheric columns - - real(r8), intent(in) :: q(pcols,pver) ! spec. humidity - real(r8), intent(in) :: t(pcols,pver) ! temperature - real(r8), intent(in) :: p(pcols,pver) ! pressure - real(r8), intent(in) :: z(pcols,pver) ! height - real(r8), intent(in) :: pf(pcols,pver+1) ! pressure at interfaces - real(r8), intent(in) :: pblt(pcols) ! index of pbl depth - real(r8), intent(in) :: tpert(pcols) ! perturbation temperature by pbl processes - -! Use z interface/surface relative values for PBL parcel calculations. - real(r8), intent(in) :: zi(pcols,pver+1) - real(r8), intent(in) :: zs(pcols) - -! -! output arguments -! - real(r8), intent(out) :: tp(pcols,pver) ! parcel temperature - real(r8), intent(out) :: qstp(pcols,pver) ! saturation mixing ratio of parcel (only above lcl, just q below). - real(r8), intent(out) :: tl(pcols) ! parcel temperature at lcl - real(r8), intent(out) :: cape(pcols) ! convective aval. pot. energy. - integer lcl(pcols) ! - integer lel(pcols) ! - integer lon(pcols) ! level of onset of deep convection - integer mx(pcols) ! level of max moist static energy - - real(r8), pointer :: org(:,:) ! organization parameter - real(r8), intent(in) :: landfrac(pcols) -! -!--------------------------Local Variables------------------------------ -! - real(r8) capeten(pcols,5) ! provisional value of cape - real(r8) tv(pcols,pver) ! - real(r8) tpv(pcols,pver) ! - real(r8) buoy(pcols,pver) - - real(r8) a1(pcols) - real(r8) a2(pcols) - real(r8) estp(pcols) - real(r8) pl(pcols) - real(r8) plexp(pcols) - real(r8) hmax(pcols) - real(r8) hmn(pcols) - real(r8) y(pcols) - - logical plge600(pcols) - integer knt(pcols) - integer lelten(pcols,5) - - - - -! Parcel property variables - - real(r8) :: hmn_lev(pcols,pver) ! Vertical profile of moist static energy for each column - real(r8) :: dp_lev(pcols,pver) ! Level dpressure between interfaces - real(r8) :: hmn_zdp(pcols,pver) ! Integrals of hmn_lev*dp_lev at each level - real(r8) :: q_zdp(pcols,pver) ! Integrals of q*dp_lev at each level - real(r8) :: dp_zfrac ! Fraction of vertical grid box below mixing top (usually pblt) - real(r8) :: parcel_dz(pcols) ! Depth of parcel mixing (usually parcel_hscale*parcel_dz) - real(r8) :: parcel_ztop(pcols) ! Height of parcel mixing (usually parcel_ztop+zm(nlev)) - real(r8) :: parcel_dp(pcols) ! Pressure integral over parcel mixing depth (usually pblt) - real(r8) :: parcel_hdp(pcols) ! Pressure*MSE integral over parcel mixing depth (usually pblt) - real(r8) :: parcel_qdp(pcols) ! Pressure*q integral over parcel mixing depth (usually pblt) - real(r8) :: pbl_dz(pcols) ! Previously diagnosed PBL height - real(r8) :: hpar(pcols) ! Initial MSE of the parcel - real(r8) :: qpar(pcols) ! Initial humidity of the parcel - real(r8) :: ql(pcols) ! Initial parcel humidity (for ientropy routine) - integer :: ipar ! Index for top of parcel mixing/launch level. - - - - - real(r8) cp - real(r8) e - real(r8) grav - - integer i - integer k - integer msg - integer n - - real(r8) rd - real(r8) rl - - -! Scaling of PBL height to give parcel mixing length for lparcel_pbl=True - - real(r8), parameter :: parcel_hscale = 0.5_r8 - - -! -!----------------------------------------------------------------------- -! - do n = 1,5 - do i = 1,ncol - lelten(i,n) = pver - capeten(i,n) = 0._r8 - end do - end do -! - do i = 1,ncol - lon(i) = pver - knt(i) = 0 - lel(i) = pver - mx(i) = lon(i) - cape(i) = 0._r8 - hmax(i) = 0._r8 - pbl_dz(i) = z(i,nint(pblt(i)))-zs(i) ! mid-point z (zm) reference to PBL depth - parcel_dz(i) = max(zi(i,pver),parcel_hscale*pbl_dz(i)) ! PBL mixing depth [parcel_hscale*Boundary, but no thinner than zi(i,pver)] - parcel_ztop(i) = parcel_dz(i)+zs(i) ! PBL mixing height ztop this is wrt zs=0 - parcel_hdp(i) = 0._r8 - parcel_dp(i) = 0._r8 - parcel_qdp(i) = 0._r8 - hpar(i) = 0._r8 - qpar(i) = 0._r8 - end do - - tp(:ncol,:) = t(:ncol,:) - qstp(:ncol,:) = q(:ncol,:) - hmn_lev(:ncol,:) = 0._r8 - - - -!!! Initialize tv and buoy for output. -!!! tv=tv : tpv=tpv : qstp=q : buoy=0. - tv(:ncol,:) = t(:ncol,:) *(1._r8+1.608_r8*q(:ncol,:))/ (1._r8+q(:ncol,:)) - tpv(:ncol,:) = tv(:ncol,:) - buoy(:ncol,:) = 0._r8 - - -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! Mix the parcel over a certain dp or dz and take the launch level as the top level -! of this mixing region and the parcel properties as this mixed value -! Should be well mixed by other processes in the very near PBL. -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - - -if (lparcel_pbl) then - -! Vertical profile of MSE and pressure weighted of the same. - hmn_lev(:ncol,1:pver) = cp*t(:ncol,1:pver) + grav*z(:ncol,1:pver) + rl*q(:ncol,1:pver) - dp_lev(:ncol,1:pver) = pf(:ncol,2:pver+1)-pf(:ncol,1:pver) - hmn_zdp(:ncol,1:pver) = hmn_lev(:ncol,1:pver)*dp_lev(:ncol,1:pver) - q_zdp(:ncol,1:pver) = q(:ncol,1:pver)*dp_lev(:ncol,1:pver) - - -! Mix profile over vertical length scale of 0.5*PBLH. - - do i = 1,ncol ! Loop columns - do k = pver,msg + 1,-1 - - if (zi(i,k+1)<= parcel_dz(i)) then ! Has to be relative to near-surface layer center elevation - ipar = k - - if (k == pver) then ! Always at least the full depth of lowest model layer. - dp_zfrac = 1._r8 - else - ! Fraction of grid cell depth (mostly 1, except when parcel_ztop is in between levels. - dp_zfrac = min(1._r8,(parcel_dz(i)-zi(i,k+1))/(zi(i,k)-zi(i,k+1))) - end if - - parcel_hdp(i) = parcel_hdp(i)+hmn_zdp(i,k)*dp_zfrac ! Sum parcel profile up to a certain level. - parcel_qdp(i) = parcel_qdp(i)+q_zdp(i,k)*dp_zfrac ! Sum parcel profile up to a certain level. - parcel_dp(i) = parcel_dp(i)+dp_lev(i,k)*dp_zfrac ! SUM dp's for weighting of parcel_hdp - - end if - end do - hpar(i) = parcel_hdp(i)/parcel_dp(i) - qpar(i) = parcel_qdp(i)/parcel_dp(i) - mx(i) = ipar - end do - -else ! Default method finding level of MSE maximum (nlev sensitive though) - ! - ! set "launching" level(mx) to be at maximum moist static energy. - ! search for this level stops at planetary boundary layer top. - ! - do k = pver,msg + 1,-1 - do i = 1,ncol - hmn(i) = cp*t(i,k) + grav*z(i,k) + rl*q(i,k) - if (k >= nint(pblt(i)) .and. k <= lon(i) .and. hmn(i) > hmax(i)) then - hmax(i) = hmn(i) - mx(i) = k - end if - end do - end do - -end if ! Default method of determining parcel launch properties. - - - - - -! LCL dilute calculation - initialize to mx(i) -! Determine lcl in parcel_dilute and get pl,tl after parcel_dilute -! Original code actually sets LCL as level above wher condensate forms. -! Therefore in parcel_dilute lcl(i) will be at first level where qsmix < qtmix. - -if (lparcel_pbl) then - -! For parcel dilute need to invert hpar and qpar. -! Now need to supply ql(i) as it is mixed parcel version, just q(i,max(i)) in default - - do i = 1,ncol ! Initialise LCL variables. - lcl(i) = mx(i) - tl(i) = (hpar(i)-rl*qpar(i)-grav*parcel_ztop(i))/cp - ql(i) = qpar(i) - pl(i) = p(i,mx(i)) - end do - -else - - do i = 1,ncol - lcl(i) = mx(i) - tl(i) = t(i,mx(i)) - ql(i) = q(i,mx(i)) - pl(i) = p(i,mx(i)) - end do - -end if ! Mixed parcel properties - - - -! -! main buoyancy calculation. -! -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!!! DILUTE PLUME CALCULATION USING ENTRAINING PLUME !!! -!!! RBN 9/9/04 !!! - - call parcel_dilute(lchnk, ncol, msg, mx, p, t, q, & - tpert, tp, tpv, qstp, pl, tl, ql, lcl, & - org, landfrac) - - -! If lcl is above the nominal level of non-divergence (600 mbs), -! no deep convection is permitted (ensuing calculations -! skipped and cape retains initialized value of zero). -! - do i = 1,ncol - plge600(i) = pl(i).ge.600._r8 ! Just change to always allow buoy calculation. - end do - -! -! Main buoyancy calculation. -! - do k = pver,msg + 1,-1 - do i=1,ncol - if (k <= mx(i) .and. plge600(i)) then ! Define buoy from launch level to cloud top. - tv(i,k) = t(i,k)* (1._r8+1.608_r8*q(i,k))/ (1._r8+q(i,k)) - buoy(i,k) = tpv(i,k) - tv(i,k) + tiedke_add ! +0.5K or not? - else - qstp(i,k) = q(i,k) - tp(i,k) = t(i,k) - tpv(i,k) = tv(i,k) - endif - end do - end do - - - -!------------------------------------------------------------------------------- - -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - - -! - do k = msg + 2,pver - do i = 1,ncol - if (k < lcl(i) .and. plge600(i)) then - if (buoy(i,k+1) > 0._r8 .and. buoy(i,k) <= 0._r8) then - knt(i) = min(num_cin,knt(i) + 1) - lelten(i,knt(i)) = k - end if - end if - end do - end do -! -! calculate convective available potential energy (cape). -! - do n = 1,num_cin - do k = msg + 1,pver - do i = 1,ncol - if (plge600(i) .and. k <= mx(i) .and. k > lelten(i,n)) then - capeten(i,n) = capeten(i,n) + rd*buoy(i,k)*log(pf(i,k+1)/pf(i,k)) - end if - end do - end do - end do -! -! find maximum cape from all possible tentative capes from -! one sounding, -! and use it as the final cape, april 26, 1995 -! - do n = 1,num_cin - do i = 1,ncol - if (capeten(i,n) > cape(i)) then - cape(i) = capeten(i,n) - lel(i) = lelten(i,n) - end if - end do - end do -! -! put lower bound on cape for diagnostic purposes. -! - do i = 1,ncol - cape(i) = max(cape(i), 0._r8) - end do -! - return -end subroutine buoyan_dilute - -subroutine parcel_dilute (lchnk, ncol, msg, klaunch, p, t, q, & - tpert, tp, tpv, qstp, pl, tl, ql, lcl, & - org, landfrac) - -! Routine to determine -! 1. Tp - Parcel temperature -! 2. qstp - Saturated mixing ratio at the parcel temperature. - -!-------------------- -implicit none -!-------------------- - -integer, intent(in) :: lchnk -integer, intent(in) :: ncol -integer, intent(in) :: msg - -integer, intent(in), dimension(pcols) :: klaunch(pcols) - -real(r8), intent(in), dimension(pcols,pver) :: p -real(r8), intent(in), dimension(pcols,pver) :: t -real(r8), intent(in), dimension(pcols,pver) :: q -real(r8), intent(in), dimension(pcols) :: tpert ! PBL temperature perturbation. - -real(r8), intent(inout), dimension(pcols,pver) :: tp ! Parcel temp. -real(r8), intent(inout), dimension(pcols,pver) :: qstp ! Parcel water vapour (sat value above lcl). -real(r8), intent(inout), dimension(pcols) :: tl ! Actual temp of LCL. -real(r8), intent(inout), dimension(pcols) :: ql ! Actual humidity of LCL -real(r8), intent(inout), dimension(pcols) :: pl ! Actual pressure of LCL. - -integer, intent(inout), dimension(pcols) :: lcl ! Lifting condesation level (first model level with saturation). - -real(r8), intent(out), dimension(pcols,pver) :: tpv ! Define tpv within this routine. - -real(r8), pointer, dimension(:,:) :: org -real(r8), intent(in), dimension(pcols) :: landfrac -!-------------------- - -! Have to be careful as s is also dry static energy. - - -! If we are to retain the fact that CAM loops over grid-points in the internal -! loop then we need to dimension sp,atp,mp,xsh2o with ncol. - - -real(r8) tmix(pcols,pver) ! Tempertaure of the entraining parcel. -real(r8) qtmix(pcols,pver) ! Total water of the entraining parcel. -real(r8) qsmix(pcols,pver) ! Saturated mixing ratio at the tmix. -real(r8) smix(pcols,pver) ! Entropy of the entraining parcel. -real(r8) xsh2o(pcols,pver) ! Precipitate lost from parcel. -real(r8) ds_xsh2o(pcols,pver) ! Entropy change due to loss of condensate. -real(r8) ds_freeze(pcols,pver) ! Entropy change sue to freezing of precip. -real(r8) dmpdz2d(pcols,pver) ! variable detrainment rate - -real(r8) mp(pcols) ! Parcel mass flux. -real(r8) qtp(pcols) ! Parcel total water. -real(r8) sp(pcols) ! Parcel entropy. - -real(r8) sp0(pcols) ! Parcel launch entropy. -real(r8) qtp0(pcols) ! Parcel launch total water. -real(r8) mp0(pcols) ! Parcel launch relative mass flux. - -real(r8) lwmax ! Maximum condesate that can be held in cloud before rainout. -real(r8) dmpdp ! Parcel fractional mass entrainment rate (/mb). -!real(r8) dmpdpc ! In cloud parcel mass entrainment rate (/mb). -real(r8) dmpdz ! Parcel fractional mass entrainment rate (/m) -real(r8) dpdz,dzdp ! Hydrstatic relation and inverse of. -real(r8) senv ! Environmental entropy at each grid point. -real(r8) qtenv ! Environmental total water " " ". -real(r8) penv ! Environmental total pressure " " ". -real(r8) tenv ! Environmental total temperature " " ". -real(r8) new_s ! Hold value for entropy after condensation/freezing adjustments. -real(r8) new_q ! Hold value for total water after condensation/freezing adjustments. -real(r8) dp ! Layer thickness (center to center) -real(r8) tfguess ! First guess for entropy inversion - crucial for efficiency! -real(r8) tscool ! Super cooled temperature offset (in degC) (eg -35). - -real(r8) qxsk, qxskp1 ! LCL excess water (k, k+1) -real(r8) dsdp, dqtdp, dqxsdp ! LCL s, qt, p gradients (k, k+1) -real(r8) slcl,qtlcl,qslcl ! LCL s, qt, qs values. -real(r8) org2rkm, org2Tpert -real(r8) dmpdz_lnd, dmpdz_mask - -integer rcall ! Number of ientropy call for errors recording -integer nit_lheat ! Number of iterations for condensation/freezing loop. -integer i,k,ii ! Loop counters. - -!====================================================================== -! SUMMARY -! -! 9/9/04 - Assumes parcel is initiated from level of maxh (klaunch) -! and entrains at each level with a specified entrainment rate. -! -! 15/9/04 - Calculates lcl(i) based on k where qsmix is first < qtmix. -! -!====================================================================== -! -! Set some values that may be changed frequently. -! - -if (zm_org) then - org2rkm = 10._r8 - org2Tpert = 0._r8 -endif -nit_lheat = 2 ! iterations for ds,dq changes from condensation freezing. -dmpdz=dmpdz_param ! Entrainment rate. (-ve for /m) -dmpdz_lnd=-1.e-3_r8 -!dmpdpc = 3.e-2_r8 ! In cloud entrainment rate (/mb). -lwmax = 1.e-3_r8 ! Need to put formula in for this. -tscool = 0.0_r8 ! Temp at which water loading freezes in the cloud. - -qtmix=0._r8 -smix=0._r8 - -qtenv = 0._r8 -senv = 0._r8 -tenv = 0._r8 -penv = 0._r8 - -qtp0 = 0._r8 -sp0 = 0._r8 -mp0 = 0._r8 - -qtp = 0._r8 -sp = 0._r8 -mp = 0._r8 - -new_q = 0._r8 -new_s = 0._r8 - -! **** Begin loops **** - -do k = pver, msg+1, -1 - do i=1,ncol - -! Initialize parcel values at launch level. - - if (k == klaunch(i)) then - - if (lparcel_pbl) then ! Modifcations to parcel properties if lparcel_pbl set. - - qtp0(i) = ql(i) ! Parcel launch q (PBL mixed value). - sp0(i) = entropy(tl(i),pl(i),qtp0(i)) ! Parcel launch entropy could be a mixed parcel. - - else - - qtp0(i) = q(i,k) ! Parcel launch total water (assuming subsaturated) - sp0(i) = entropy(t(i,k),p(i,k),qtp0(i)) ! Parcel launch entropy. - - end if - - mp0(i) = 1._r8 ! Parcel launch relative mass (i.e. 1 parcel stays 1 parcel for dmpdp=0, undilute). - smix(i,k) = sp0(i) - qtmix(i,k) = qtp0(i) - tfguess = t(i,k) - rcall = 1 - call ientropy (rcall,i,lchnk,smix(i,k),p(i,k),qtmix(i,k),tmix(i,k),qsmix(i,k),tfguess) - end if - -! Entraining levels - - if (k < klaunch(i)) then - -! Set environmental values for this level. - - dp = (p(i,k)-p(i,k+1)) ! In -ve mb as p decreasing with height - difference between center of layers. - qtenv = 0.5_r8*(q(i,k)+q(i,k+1)) ! Total water of environment. - tenv = 0.5_r8*(t(i,k)+t(i,k+1)) - penv = 0.5_r8*(p(i,k)+p(i,k+1)) - - senv = entropy(tenv,penv,qtenv) ! Entropy of environment. - -! Determine fractional entrainment rate /pa given value /m. - - dpdz = -(penv*grav)/(rgas*tenv) ! in mb/m since p in mb. - dzdp = 1._r8/dpdz ! in m/mb - if (zm_org) then - dmpdz_mask = landfrac(i) * dmpdz_lnd + (1._r8 - landfrac(i)) * dmpdz - dmpdp = (dmpdz_mask/(1._r8+org(i,k)*org2rkm))*dzdp ! /mb Fractional entrainment - else - dmpdp = dmpdz*dzdp - endif - -! Sum entrainment to current level -! entrains q,s out of intervening dp layers, in which linear variation is assumed -! so really it entrains the mean of the 2 stored values. - - sp(i) = sp(i) - dmpdp*dp*senv - qtp(i) = qtp(i) - dmpdp*dp*qtenv - mp(i) = mp(i) - dmpdp*dp - -! Entrain s and qt to next level. - - smix(i,k) = (sp0(i) + sp(i)) / (mp0(i) + mp(i)) - qtmix(i,k) = (qtp0(i) + qtp(i)) / (mp0(i) + mp(i)) - -! Invert entropy from s and q to determine T and saturation-capped q of mixture. -! t(i,k) used as a first guess so that it converges faster. - - tfguess = tmix(i,k+1) - rcall = 2 - call ientropy(rcall,i,lchnk,smix(i,k),p(i,k),qtmix(i,k),tmix(i,k),qsmix(i,k),tfguess) - -! -! Determine if this is lcl of this column if qsmix <= qtmix. -! FIRST LEVEL where this happens on ascending. - - if (qsmix(i,k) <= qtmix(i,k) .and. qsmix(i,k+1) > qtmix(i,k+1)) then - lcl(i) = k - qxsk = qtmix(i,k) - qsmix(i,k) - qxskp1 = qtmix(i,k+1) - qsmix(i,k+1) - dqxsdp = (qxsk - qxskp1)/dp - pl(i) = p(i,k+1) - qxskp1/dqxsdp ! pressure level of actual lcl. - dsdp = (smix(i,k) - smix(i,k+1))/dp - dqtdp = (qtmix(i,k) - qtmix(i,k+1))/dp - slcl = smix(i,k+1) + dsdp* (pl(i)-p(i,k+1)) - qtlcl = qtmix(i,k+1) + dqtdp*(pl(i)-p(i,k+1)) - - tfguess = tmix(i,k) - rcall = 3 - call ientropy (rcall,i,lchnk,slcl,pl(i),qtlcl,tl(i),qslcl,tfguess) - -! write(iulog,*)' ' -! write(iulog,*)' p',p(i,k+1),pl(i),p(i,lcl(i)) -! write(iulog,*)' t',tmix(i,k+1),tl(i),tmix(i,lcl(i)) -! write(iulog,*)' s',smix(i,k+1),slcl,smix(i,lcl(i)) -! write(iulog,*)'qt',qtmix(i,k+1),qtlcl,qtmix(i,lcl(i)) -! write(iulog,*)'qs',qsmix(i,k+1),qslcl,qsmix(i,lcl(i)) - - endif -! - end if ! k < klaunch - - - end do ! Levels loop -end do ! Columns loop - -!!!!!!!!!!!!!!!!!!!!!!!!!!END ENTRAINMENT LOOP!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -!! Could stop now and test with this as it will provide some estimate of buoyancy -!! without the effects of freezing/condensation taken into account for tmix. - -!! So we now have a profile of entropy and total water of the entraining parcel -!! Varying with height from the launch level klaunch parcel=environment. To the -!! top allowed level for the existence of convection. - -!! Now we have to adjust these values such that the water held in vaopor is < or -!! = to qsmix. Therefore, we assume that the cloud holds a certain amount of -!! condensate (lwmax) and the rest is rained out (xsh2o). This, obviously -!! provides latent heating to the mixed parcel and so this has to be added back -!! to it. But does this also increase qsmix as well? Also freezing processes - - -xsh2o = 0._r8 -ds_xsh2o = 0._r8 -ds_freeze = 0._r8 - -!!!!!!!!!!!!!!!!!!!!!!!!!PRECIPITATION/FREEZING LOOP!!!!!!!!!!!!!!!!!!!!!!!!!! -!! Iterate solution twice for accuracy - - - -do k = pver, msg+1, -1 - do i=1,ncol - -! Initialize variables at k=klaunch - - if (k == klaunch(i)) then - -! Set parcel values at launch level assume no liquid water. - - tp(i,k) = tmix(i,k) - qstp(i,k) = q(i,k) - if (zm_org) then - tpv(i,k) = (tp(i,k) + (org2Tpert*org(i,k)+tpert(i))) * (1._r8+1.608_r8*qstp(i,k)) / (1._r8+qstp(i,k)) - else - tpv(i,k) = (tp(i,k) + tpert(i)) * (1._r8+1.608_r8*qstp(i,k)) / (1._r8+qstp(i,k)) - endif - - end if - - if (k < klaunch(i)) then - -! Initiaite loop if switch(2) = .T. - RBN:DILUTE - TAKEN OUT BUT COULD BE RETURNED LATER. - -! Iterate nit_lheat times for s,qt changes. - - do ii=0,nit_lheat-1 - -! Rain (xsh2o) is excess condensate, bar LWMAX (Accumulated loss from qtmix). - - xsh2o(i,k) = max (0._r8, qtmix(i,k) - qsmix(i,k) - lwmax) - -! Contribution to ds from precip loss of condensate (Accumulated change from smix).(-ve) - - ds_xsh2o(i,k) = ds_xsh2o(i,k+1) - cpliq * log (tmix(i,k)/tfreez) * max(0._r8,(xsh2o(i,k)-xsh2o(i,k+1))) -! -! Entropy of freezing: latice times amount of water involved divided by T. -! - - if (tmix(i,k) <= tfreez+tscool .and. ds_freeze(i,k+1) == 0._r8) then ! One off freezing of condensate. - ds_freeze(i,k) = (latice/tmix(i,k)) * max(0._r8,qtmix(i,k)-qsmix(i,k)-xsh2o(i,k)) ! Gain of LH - end if - - if (tmix(i,k) <= tfreez+tscool .and. ds_freeze(i,k+1) /= 0._r8) then ! Continual freezing of additional condensate. - ds_freeze(i,k) = ds_freeze(i,k+1)+(latice/tmix(i,k)) * max(0._r8,(qsmix(i,k+1)-qsmix(i,k))) - end if - -! Adjust entropy and accordingly to sum of ds (be careful of signs). - - new_s = smix(i,k) + ds_xsh2o(i,k) + ds_freeze(i,k) - -! Adjust liquid water and accordingly to xsh2o. - - new_q = qtmix(i,k) - xsh2o(i,k) - -! Invert entropy to get updated Tmix and qsmix of parcel. - - tfguess = tmix(i,k) - rcall =4 - call ientropy (rcall,i,lchnk,new_s, p(i,k), new_q, tmix(i,k), qsmix(i,k), tfguess) - - end do ! Iteration loop for freezing processes. - -! tp - Parcel temp is temp of mixture. -! tpv - Parcel v. temp should be density temp with new_q total water. - - tp(i,k) = tmix(i,k) - -! tpv = tprho in the presence of condensate (i.e. when new_q > qsmix) - - if (new_q > qsmix(i,k)) then ! Super-saturated so condensate present - reduces buoyancy. - qstp(i,k) = qsmix(i,k) - else ! Just saturated/sub-saturated - no condensate virtual effects. - qstp(i,k) = new_q - end if - - if (zm_org) then - tpv(i,k) = (tp(i,k)+(org2Tpert*org(i,k)+tpert(i)))* (1._r8+1.608_r8*qstp(i,k)) / (1._r8+ new_q) - else - tpv(i,k) = (tp(i,k)+tpert(i))* (1._r8+1.608_r8*qstp(i,k)) / (1._r8+ new_q) - endif - - end if ! k < klaunch - - end do ! Loop for columns - -end do ! Loop for vertical levels. - - -return -end subroutine parcel_dilute - -!----------------------------------------------------------------------------------------- -real(r8) function entropy(TK,p,qtot) -!----------------------------------------------------------------------------------------- -! -! TK(K),p(mb),qtot(kg/kg) -! from Raymond and Blyth 1992 -! - real(r8), intent(in) :: p,qtot,TK - real(r8) :: qv,qst,e,est,L - real(r8), parameter :: pref = 1000._r8 - -L = rl - (cpliq - cpwv)*(TK-tfreez) ! T IN CENTIGRADE - -call qsat_hPa(TK, p, est, qst) - -qv = min(qtot,qst) ! Partition qtot into vapor part only. -e = qv*p / (eps1 +qv) - -entropy = (cpres + qtot*cpliq)*log( TK/tfreez) - rgas*log( (p-e)/pref ) + & - L*qv/TK - qv*rh2o*log(qv/qst) - -end FUNCTION entropy - -! -!----------------------------------------------------------------------------------------- -SUBROUTINE ientropy (rcall,icol,lchnk,s,p,qt,T,qst,Tfg) -!----------------------------------------------------------------------------------------- -! -! p(mb), Tfg/T(K), qt/qv(kg/kg), s(J/kg). -! Inverts entropy, pressure and total water qt -! for T and saturated vapor mixing ratio -! - - use phys_grid, only: get_rlon_p, get_rlat_p - - integer, intent(in) :: icol, lchnk, rcall - real(r8), intent(in) :: s, p, Tfg, qt - real(r8), intent(out) :: qst, T - real(r8) :: est, this_lat,this_lon - real(r8) :: a,b,c,d,ebr,fa,fb,fc,pbr,qbr,rbr,sbr,tol1,xm,tol - integer :: i - - logical :: converged - - ! Max number of iteration loops. - integer, parameter :: LOOPMAX = 100 - real(r8), parameter :: EPS = 3.e-8_r8 - - converged = .false. - - ! Invert the entropy equation -- use Brent's method - ! Brent, R. P. Ch. 3-4 in Algorithms for Minimization Without Derivatives. Englewood Cliffs, NJ: Prentice-Hall, 1973. - - T = Tfg ! Better first guess based on Tprofile from conv. - - a = Tfg-10 !low bracket - b = Tfg+10 !high bracket - - fa = entropy(a, p, qt) - s - fb = entropy(b, p, qt) - s - - c=b - fc=fb - tol=0.001_r8 - - converge: do i=0, LOOPMAX - if ((fb > 0.0_r8 .and. fc > 0.0_r8) .or. & - (fb < 0.0_r8 .and. fc < 0.0_r8)) then - c=a - fc=fa - d=b-a - ebr=d - end if - if (abs(fc) < abs(fb)) then - a=b - b=c - c=a - fa=fb - fb=fc - fc=fa - end if - - tol1=2.0_r8*EPS*abs(b)+0.5_r8*tol - xm=0.5_r8*(c-b) - converged = (abs(xm) <= tol1 .or. fb == 0.0_r8) - if (converged) exit converge - - if (abs(ebr) >= tol1 .and. abs(fa) > abs(fb)) then - sbr=fb/fa - if (a == c) then - pbr=2.0_r8*xm*sbr - qbr=1.0_r8-sbr - else - qbr=fa/fc - rbr=fb/fc - pbr=sbr*(2.0_r8*xm*qbr*(qbr-rbr)-(b-a)*(rbr-1.0_r8)) - qbr=(qbr-1.0_r8)*(rbr-1.0_r8)*(sbr-1.0_r8) - end if - if (pbr > 0.0_r8) qbr=-qbr - pbr=abs(pbr) - if (2.0_r8*pbr < min(3.0_r8*xm*qbr-abs(tol1*qbr),abs(ebr*qbr))) then - ebr=d - d=pbr/qbr - else - d=xm - ebr=d - end if - else - d=xm - ebr=d - end if - a=b - fa=fb - b=b+merge(d,sign(tol1,xm), abs(d) > tol1 ) - - fb = entropy(b, p, qt) - s - - end do converge - - T = b - call qsat_hPa(T, p, est, qst) - - if (.not. converged) then - this_lat = get_rlat_p(lchnk, icol)*57.296_r8 - this_lon = get_rlon_p(lchnk, icol)*57.296_r8 - write(iulog,*) '*** ZM_CONV: IENTROPY: Failed and about to exit, info follows ****' - write(iulog,100) 'ZM_CONV: IENTROPY. Details: call#,lchnk,icol= ',rcall,lchnk,icol, & - ' lat: ',this_lat,' lon: ',this_lon, & - ' P(mb)= ', p, ' Tfg(K)= ', Tfg, ' qt(g/kg) = ', 1000._r8*qt, & - ' qst(g/kg) = ', 1000._r8*qst,', s(J/kg) = ',s - call endrun('**** ZM_CONV IENTROPY: Tmix did not converge ****') - end if - -100 format (A,I1,I4,I4,7(A,F6.2)) - -end SUBROUTINE ientropy - -! Wrapper for qsat_water that does translation between Pa and hPa -! qsat_water uses Pa internally, so get it right, need to pass in Pa. -! Afterward, set es back to hPa. -subroutine qsat_hPa(t, p, es, qm) - use wv_saturation, only: qsat_water - - ! Inputs - real(r8), intent(in) :: t ! Temperature (K) - real(r8), intent(in) :: p ! Pressure (hPa) - ! Outputs - real(r8), intent(out) :: es ! Saturation vapor pressure (hPa) - real(r8), intent(out) :: qm ! Saturation mass mixing ratio - ! (vapor mass over dry mass, kg/kg) - - call qsat_water(t, p*100._r8, es, qm) - - es = es*0.01_r8 - -end subroutine qsat_hPa - -end module zm_conv diff --git a/src/physics/cam/zm_conv_intr.F90 b/src/physics/cam/zm_conv_intr.F90 index 48e8d5e932..2e44af000e 100644 --- a/src/physics/cam/zm_conv_intr.F90 +++ b/src/physics/cam/zm_conv_intr.F90 @@ -8,11 +8,13 @@ module zm_conv_intr ! January 2010 modified by J. Kay to add COSP simulator fields to physics buffer !--------------------------------------------------------------------------------- use shr_kind_mod, only: r8=>shr_kind_r8 - use physconst, only: cpair + use physconst, only: cpair, epsilo, gravit, latvap, tmelt, rair use ppgrid, only: pver, pcols, pverp, begchunk, endchunk - use zm_conv, only: zm_conv_evap, zm_convr, convtran, momtran - - use zm_microphysics, only: zm_aero_t, zm_conv_t + use zm_conv_evap_mod, only: zm_conv_evap_run + use zm_convr_mod, only: zm_convr_init, zm_convr_run + use zm_conv_convtran_mod, only: zm_conv_convtran_run + use zm_conv_momtran_mod, only: zm_conv_momtran_run + use rad_constituents, only: rad_cnst_get_info, rad_cnst_get_mode_num, rad_cnst_get_aer_mmr, & rad_cnst_get_aer_props, rad_cnst_get_mode_props !, & use ndrop_bam, only: ndrop_bam_init @@ -36,7 +38,6 @@ module zm_conv_intr zm_conv_tend, &! return tendencies zm_conv_tend_2 ! return tendencies - public :: zmconv_microp integer ::& ! indices for fields in the physics buffer zm_mu_idx, & @@ -73,7 +74,6 @@ module zm_conv_intr ! before the convection top and CAPE calculations are completed. logical :: zmconv_org ! Parameterization for sub-grid scale convective organization for the ZM deep ! convective scheme based on Mapes and Neale (2011) - logical :: zmconv_microp = .false. ! switch for microphysics real(r8) :: zmconv_dmpdz = unset_r8 ! Parcel fractional mass entrainment rate real(r8) :: zmconv_tiedke_add = unset_r8 ! Convective parcel temperature perturbation real(r8) :: zmconv_capelmt = unset_r8 ! Triggering thereshold for ZM convection @@ -92,8 +92,6 @@ module zm_conv_intr integer :: nmodes integer :: nbulk - type(zm_aero_t), allocatable :: aero(:) ! object contains information about the aerosols - !========================================================================================= contains !========================================================================================= @@ -156,15 +154,6 @@ subroutine zm_conv_register ! convective mass fluxes call pbuf_add_field('CMFMC_DP', 'physpkg', dtype_r8, (/pcols,pverp/), mconzm_idx) - if (zmconv_microp) then - ! Only add the number conc fields if the microphysics is active. - - ! detrained convective cloud water num concen. - call pbuf_add_field('DNLFZM', 'physpkg', dtype_r8, (/pcols,pver/), dnlfzm_idx) - ! detrained convective cloud ice num concen. - call pbuf_add_field('DNIFZM', 'physpkg', dtype_r8, (/pcols,pver/), dnifzm_idx) - end if - if (zmconv_org) then call cnst_add('ZM_ORG',0._r8,0._r8,0._r8,ixorg,longname='organization parameter') endif @@ -187,7 +176,7 @@ subroutine zm_conv_readnl(nlfile) namelist /zmconv_nl/ zmconv_c0_lnd, zmconv_c0_ocn, zmconv_num_cin, & zmconv_ke, zmconv_ke_lnd, zmconv_org, & - zmconv_momcu, zmconv_momcd, zmconv_microp, & + zmconv_momcu, zmconv_momcd, & zmconv_dmpdz, zmconv_tiedke_add, zmconv_capelmt, & zmconv_parcel_pbl, zmconv_tau !----------------------------------------------------------------------------- @@ -224,8 +213,6 @@ subroutine zm_conv_readnl(nlfile) if (ierr /= 0) call endrun("zm_conv_readnl: FATAL: mpi_bcast: zmconv_momcd") call mpi_bcast(zmconv_org, 1, mpi_logical, masterprocid, mpicom, ierr) if (ierr /= 0) call endrun("zm_conv_readnl: FATAL: mpi_bcast: zmconv_org") - call mpi_bcast(zmconv_microp, 1, mpi_logical, masterprocid, mpicom, ierr) - if (ierr /= 0) call endrun("zm_conv_readnl: FATAL: mpi_bcast: zmconv_microp") call mpi_bcast(zmconv_dmpdz, 1, mpi_real8, masterprocid, mpicom, ierr) if (ierr /= 0) call endrun("zm_conv_readnl: FATAL: mpi_bcast: zmconv_dmpdz") call mpi_bcast(zmconv_tiedke_add, 1, mpi_real8, masterprocid, mpicom, ierr) @@ -233,7 +220,7 @@ subroutine zm_conv_readnl(nlfile) call mpi_bcast(zmconv_capelmt, 1, mpi_real8, masterprocid, mpicom, ierr) if (ierr /= 0) call endrun("zm_conv_readnl: FATAL: mpi_bcast: zmconv_capelmt") call mpi_bcast(zmconv_parcel_pbl, 1, mpi_logical, masterprocid, mpicom, ierr) - if (ierr /= 0) call endrun("zm_conv_readnl: FATAL: mpi_bcast: zmconv_parcel_pbl") + if (ierr /= 0) call endrun("zm_conv_readnl: FATAL: mpi_bcast: zmconv_parcel_pbl") call mpi_bcast(zmconv_tau, 1, mpi_real8, masterprocid, mpicom, ierr) if (ierr /= 0) call endrun("zm_conv_readnl: FATAL: mpi_bcast: zmconv_tau") @@ -249,7 +236,7 @@ subroutine zm_conv_init(pref_edge) use cam_history, only: addfld, add_default, horiz_only use ppgrid, only: pcols, pver - use zm_conv, only: zm_convi + use zm_convr_mod, only: zm_convr_init use pmgrid, only: plev,plevp use spmd_utils, only: masterproc use phys_control, only: phys_deepconv_pbl, phys_getopts, cam_physpkg_is @@ -259,6 +246,8 @@ subroutine zm_conv_init(pref_edge) real(r8),intent(in) :: pref_edge(plevp) ! reference pressures at interfaces + character(len=512) :: errmsg + integer :: errflg logical :: no_deep_pbl ! if true, no deep convection in PBL integer limcnv ! top interface level limit for convection @@ -268,12 +257,6 @@ subroutine zm_conv_init(pref_edge) ! liquid budgets. integer :: history_budget_histfile_num ! output history file number for budget fields -! Allocate the basic aero structure outside the zmconv_microp logical -! This allows the aero structure to be passed -! Note that all of the arrays inside this structure are conditionally allocated - - allocate(aero(begchunk:endchunk)) - ! ! Register fields with the output buffer ! @@ -344,10 +327,6 @@ subroutine zm_conv_init(pref_edge) call add_default('ZMMTT ', history_budget_histfile_num, ' ') end if - if (zmconv_microp) then - call add_default ('DIFZM', 1, ' ') - call add_default ('DLFZM', 1, ' ') - end if ! ! Limit deep convection to regions below 40 mb ! Note this calculation is repeated in the shallow convection interface @@ -371,16 +350,16 @@ subroutine zm_conv_init(pref_edge) end if no_deep_pbl = phys_deepconv_pbl() - call zm_convi(limcnv,zmconv_c0_lnd, zmconv_c0_ocn, zmconv_ke, zmconv_ke_lnd, & +!CACNOTE - Need to check errflg and report errors + call zm_convr_init(cpair, epsilo, gravit, latvap, tmelt, rair, & + limcnv,zmconv_c0_lnd, zmconv_c0_ocn, zmconv_ke, zmconv_ke_lnd, & zmconv_momcu, zmconv_momcd, zmconv_num_cin, zmconv_org, & - zmconv_microp, no_deep_pbl, zmconv_tiedke_add, & - zmconv_capelmt, zmconv_dmpdz,zmconv_parcel_pbl, zmconv_tau) + no_deep_pbl, zmconv_tiedke_add, & + zmconv_capelmt, zmconv_dmpdz,zmconv_parcel_pbl, zmconv_tau, errmsg, errflg) cld_idx = pbuf_get_index('CLD') fracis_idx = pbuf_get_index('FRACIS') - if (zmconv_microp) call zm_conv_micro_init() - end subroutine zm_conv_init !========================================================================================= !subroutine zm_conv_tend(state, ptend, tdt) @@ -402,7 +381,8 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , & use physics_buffer, only : pbuf_get_field, physics_buffer_desc, pbuf_old_tim_idx use constituents, only: pcnst, cnst_get_ind, cnst_is_convtran1 use check_energy, only: check_energy_chng - use physconst, only: gravit + use physconst, only: gravit, latice, latvap, tmelt, cpwv, cpliq, rh2o + use phys_control, only: cam_physpkg_is ! Arguments @@ -426,8 +406,8 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , & ! Local variables - - type(zm_conv_t) :: conv + character(len=512) :: errmsg + integer :: errflg integer :: i,k,l,m integer :: ilon ! global longitude index of a column @@ -515,57 +495,6 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , & ncol = state%ncol nstep = get_nstep() - if (zmconv_microp) then - allocate( & - conv%qi(pcols,pver), & - conv%qliq(pcols,pver), & - conv%qice(pcols,pver), & - conv%wu(pcols,pver), & - conv%sprd(pcols,pver), & - conv%qrain(pcols,pver), & - conv%qsnow(pcols,pver), & - conv%qnl(pcols,pver), & - conv%qni(pcols,pver), & - conv%qnr(pcols,pver), & - conv%qns(pcols,pver), & - conv%frz(pcols,pver), & - conv%autolm(pcols,pver), & - conv%accrlm(pcols,pver), & - conv%bergnm(pcols,pver), & - conv%fhtimm(pcols,pver), & - conv%fhtctm(pcols,pver), & - conv%fhmlm (pcols,pver), & - conv%hmpim (pcols,pver), & - conv%accslm(pcols,pver), & - conv%dlfm (pcols,pver), & - conv%autoln(pcols,pver), & - conv%accrln(pcols,pver), & - conv%bergnn(pcols,pver), & - conv%fhtimn(pcols,pver), & - conv%fhtctn(pcols,pver), & - conv%fhmln (pcols,pver), & - conv%accsln(pcols,pver), & - conv%activn(pcols,pver), & - conv%dlfn (pcols,pver), & - conv%autoim(pcols,pver), & - conv%accsim(pcols,pver), & - conv%difm (pcols,pver), & - conv%nuclin(pcols,pver), & - conv%autoin(pcols,pver), & - conv%accsin(pcols,pver), & - conv%hmpin (pcols,pver), & - conv%difn (pcols,pver), & - conv%cmel (pcols,pver), & - conv%cmei (pcols,pver), & - conv%trspcm(pcols,pver), & - conv%trspcn(pcols,pver), & - conv%trspim(pcols,pver), & - conv%trspin(pcols,pver), & - conv%lambdadpcu(pcols,pver), & - conv%mudpcu(pcols,pver), & - conv%dcape(pcols) ) - end if - ftem = 0._r8 mu_out(:,:) = 0._r8 md_out(:,:) = 0._r8 @@ -578,7 +507,7 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , & if (zmconv_org) then lq(ixorg) = .TRUE. endif - call physics_ptend_init(ptend_loc, state%psetcols, 'zm_convr', ls=.true., lq=lq)! initialize local ptend type + call physics_ptend_init(ptend_loc, state%psetcols, 'zm_convr_run', ls=.true., lq=lq)! initialize local ptend type ! ! Associate pointers with physics buffer fields @@ -608,45 +537,12 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , & call pbuf_get_field(pbuf, difzm_idx, dif) call pbuf_get_field(pbuf, mconzm_idx, mconzm) - if (zmconv_microp) then - call pbuf_get_field(pbuf, dnlfzm_idx, dnlf) - call pbuf_get_field(pbuf, dnifzm_idx, dnif) - else - allocate(dnlf(pcols,pver), dnif(pcols,pver)) - end if - - if (zmconv_microp) then - - if (nmodes > 0) then - - ! Associate pointers with the modes and species that affect the climate - ! (list 0) - - do m = 1, nmodes - call rad_cnst_get_mode_num(0, m, 'a', state, pbuf, aero(lchnk)%num_a(m)%val) - call pbuf_get_field(pbuf, dgnum_idx, aero(lchnk)%dgnum(m)%val, start=(/1,1,m/), kount=(/pcols,pver,1/)) - - do l = 1, aero(lchnk)%nspec(m) - call rad_cnst_get_aer_mmr(0, m, l, 'a', state, pbuf, aero(lchnk)%mmr_a(l,m)%val) - end do - end do - - else if (nbulk > 0) then - - ! Associate pointers with the bulk aerosols that affect the climate - ! (list 0) - - do m = 1, nbulk - call rad_cnst_get_aer_mmr(0, m, state, pbuf, aero(lchnk)%mmr_bulk(m)%val) - end do - - end if - end if + allocate(dnlf(pcols,pver), dnif(pcols,pver)) ! ! Begin with Zhang-McFarlane (1996) convection parameterization ! - call t_startf ('zm_convr') + call t_startf ('zm_convr_run') if (zmconv_org) then allocate(zm_org2d(pcols,pver)) @@ -654,7 +550,10 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , & orgt => ptend_loc%q(:,:,ixorg) endif - call zm_convr( lchnk ,ncol , & +!CACNOTE - Need to check errflg and report errors + call zm_convr_run( ncol , pcols, pver, & + pverp, gravit ,latice ,cpwv ,cpliq ,& + rh2o,& state%t ,state%q(:,:,1), prec ,jctop ,jcbot , & pblh ,state%zm ,state%phis ,state%zi ,ptend_loc%q(:,:,1) , & ptend_loc%s , state%pmid ,state%pint ,state%pdel , & @@ -664,8 +563,8 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , & dp, dsubcld, jt, maxg, ideep, & ql, rliq, landfrac, & org, orgt, zm_org2d, & - dif, dnlf, dnif, conv, & - aero(lchnk), rice) + dif, dnlf, dnif, & + rice, errmsg, errflg) lengath = count(ideep > 0) @@ -702,13 +601,11 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , & ftem(:ncol,:pver) = ptend_loc%s(:ncol,:pver)/cpair call outfld('ZMDT ',ftem ,pcols ,lchnk ) call outfld('ZMDQ ',ptend_loc%q(1,1,1) ,pcols ,lchnk ) - call t_stopf ('zm_convr') + call t_stopf ('zm_convr_run') call outfld('DIFZM' ,dif ,pcols, lchnk) call outfld('DLFZM' ,dlf ,pcols, lchnk) - if (zmconv_microp) call zm_conv_micro_outfld(conv, dnif, dnlf, lchnk, ncol) - pcont(:ncol) = state%ps(:ncol) pconb(:ncol) = state%ps(:ncol) do i = 1,lengath @@ -735,9 +632,9 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , & if (zmconv_org) then lq(ixorg) = .TRUE. endif - call physics_ptend_init(ptend_loc, state1%psetcols, 'zm_conv_evap', ls=.true., lq=lq) + call physics_ptend_init(ptend_loc, state1%psetcols, 'zm_conv_evap_run', ls=.true., lq=lq) - call t_startf ('zm_conv_evap') + call t_startf ('zm_conv_evap_run') ! ! Determine the phase of the precipitation produced and add latent heat of fusion ! Evaporate some of the precip directly into the environment (Sundqvist) @@ -752,12 +649,13 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , & dp_cldliq(:ncol,:) = 0._r8 dp_cldice(:ncol,:) = 0._r8 - call zm_conv_evap(state1%ncol,state1%lchnk, & + call zm_conv_evap_run(state1%ncol, pcols, pver, pverp, & + gravit, latice, latvap, tmelt, & state1%t,state1%pmid,state1%pdel,state1%q(:pcols,:pver,1), & landfrac, & ptend_loc%s, tend_s_snwprd, tend_s_snwevmlt, ptend_loc%q(:pcols,:pver,1), & rprd, cld, ztodt, & - prec, snow, ntprprd, ntsnprd , flxprec, flxsnow, conv%sprd) + prec, snow, ntprprd, ntsnprd , flxprec, flxsnow) evapcdp(:ncol,:pver) = ptend_loc%q(:ncol,:pver,1) @@ -768,7 +666,7 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , & endif ! -! Write out variables from zm_conv_evap +! Write out variables from zm_conv_evap_run ! ftem(:ncol,:pver) = ptend_loc%s(:ncol,:pver)/cpair call outfld('EVAPTZM ',ftem ,pcols ,lchnk ) @@ -786,7 +684,7 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , & call outfld('PRECCDZM ',prec, pcols ,lchnk ) - call t_stopf ('zm_conv_evap') + call t_stopf ('zm_conv_evap_run') call outfld('PRECZ ', prec , pcols, lchnk) @@ -801,7 +699,7 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , & if ( .not. cam_physpkg_is('cam3')) then - call physics_ptend_init(ptend_loc, state1%psetcols, 'momtran', ls=.true., lu=.true., lv=.true.) + call physics_ptend_init(ptend_loc, state1%psetcols, 'zm_conv_momtran_run', ls=.true., lu=.true., lv=.true.) winds(:ncol,:pver,1) = state1%u(:ncol,:pver) winds(:ncol,:pver,2) = state1%v(:ncol,:pver) @@ -809,13 +707,13 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , & l_windt(1) = .true. l_windt(2) = .true. - call t_startf ('momtran') - call momtran (lchnk, ncol, & + call t_startf ('zm_conv_momtran_run') + call zm_conv_momtran_run (ncol, pcols, pver, pverp, & l_windt,winds, 2, mu, md, & du, eu, ed, dp, dsubcld, & jt, maxg, ideep, 1, lengath, & nstep, wind_tends, pguall, pgdall, icwu, icwd, ztodt, seten ) - call t_stopf ('momtran') + call t_stopf ('zm_conv_momtran_run') ptend_loc%u(:ncol,:pver) = wind_tends(:ncol,:pver,1) ptend_loc%v(:ncol,:pver) = wind_tends(:ncol,:pver,2) @@ -863,7 +761,7 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , & fake_dpdry(:,:) = 0._r8 call t_startf ('convtran1') - call convtran (lchnk, & + call zm_conv_convtran_run (pcols, pver, & ptend_loc%lq,state1%q, pcnst, mu, md, & du, eu, ed, dp, dsubcld, & jt,maxg, ideep, 1, lengath, & @@ -883,61 +781,7 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , & deallocate(zm_org2d) end if - if (zmconv_microp) then - deallocate( & - conv%qi, & - conv%qliq, & - conv%qice, & - conv%wu, & - conv%sprd, & - conv%qrain, & - conv%qsnow, & - conv%qnl, & - conv%qni, & - conv%qnr, & - conv%qns, & - conv%frz, & - conv%autolm, & - conv%accrlm, & - conv%bergnm, & - conv%fhtimm, & - conv%fhtctm, & - conv%fhmlm , & - conv%hmpim , & - conv%accslm, & - conv%dlfm , & - conv%autoln, & - conv%accrln, & - conv%bergnn, & - conv%fhtimn, & - conv%fhtctn, & - conv%fhmln , & - conv%accsln, & - conv%activn, & - conv%dlfn , & - conv%autoim, & - conv%accsim, & - conv%difm , & - conv%nuclin, & - conv%autoin, & - conv%accsin, & - conv%hmpin , & - conv%difn , & - conv%cmel , & - conv%cmei , & - conv%trspcm, & - conv%trspcn, & - conv%trspim, & - conv%trspin, & - conv%lambdadpcu, & - conv%mudpcu, & - conv%dcape ) - - else - - deallocate(dnlf, dnif) - - end if + deallocate(dnlf, dnif) end subroutine zm_conv_tend !========================================================================================= @@ -1008,7 +852,7 @@ subroutine zm_conv_tend_2( state, ptend, ztodt, pbuf) end do call t_startf ('convtran2') - call convtran (lchnk, & + call zm_conv_convtran_run (pcols, pver, & ptend%lq,state%q, pcnst, mu, md, & du, eu, ed, dp, dsubcld, & jt, maxg, ideep, 1, lengath, & @@ -1020,384 +864,5 @@ end subroutine zm_conv_tend_2 !========================================================================================= -subroutine zm_conv_micro_init() - - use cam_history, only: addfld, add_default, horiz_only - use ppgrid, only: pcols, pver - use pmgrid, only: plev,plevp - use phys_control, only: cam_physpkg_is - use physics_buffer, only: pbuf_get_index - use zm_microphysics, only: zm_mphyi - - implicit none - - integer :: i - - ! - ! Register fields with the output buffer - ! - call addfld ('ICIMRDP', (/ 'lev' /), 'A','kg/kg', 'Deep Convection in-cloud ice mixing ratio ') - call addfld ('CLDLIQZM',(/ 'lev' /), 'A','g/m3' ,'Cloud liquid water - ZM convection') - call addfld ('CLDICEZM',(/ 'lev' /), 'A','g/m3' ,'Cloud ice water - ZM convection') - call addfld ('CLIQSNUM',(/ 'lev' /), 'A','1' ,'Cloud liquid water sample number - ZM convection') - call addfld ('CICESNUM',(/ 'lev' /), 'A','1' ,'Cloud ice water sample number - ZM convection') - call addfld ('QRAINZM' ,(/ 'lev' /), 'A','g/m3' ,'rain water - ZM convection') - call addfld ('QSNOWZM' ,(/ 'lev' /), 'A','g/m3' ,'snow - ZM convection') - call addfld ('CRAINNUM',(/ 'lev' /), 'A','1' ,'Cloud rain water sample number - ZM convection') - call addfld ('CSNOWNUM',(/ 'lev' /), 'A','1' ,'Cloud snow sample number - ZM convection') - - call addfld ('DNIFZM' ,(/ 'lev' /), 'A','1/kg/s ' ,'Detrained ice water num concen from ZM convection') - call addfld ('DNLFZM' ,(/ 'lev' /), 'A','1/kg/s ' ,'Detrained liquid water num concen from ZM convection') - call addfld ('WUZM' ,(/ 'lev' /), 'A','m/s' ,'vertical velocity - ZM convection') - call addfld ('WUZMSNUM',(/ 'lev' /), 'A','1' ,'vertical velocity sample number - ZM convection') - - call addfld ('QNLZM',(/ 'lev' /), 'A','1/m3' ,'Cloud liquid water number concen - ZM convection') - call addfld ('QNIZM',(/ 'lev' /), 'A','1/m3' ,'Cloud ice number concen - ZM convection') - call addfld ('QNRZM',(/ 'lev' /), 'A','1/m3' ,'Cloud rain water number concen - ZM convection') - call addfld ('QNSZM',(/ 'lev' /), 'A','1/m3' ,'Cloud snow number concen - ZM convection') - - call addfld ('FRZZM',(/ 'lev' /), 'A','1/s' ,'mass tendency due to freezing - ZM convection') - - call addfld ('AUTOL_M' ,(/ 'lev' /), 'A','kg/kg/m' ,'mass tendency due to autoconversion of droplets to rain') - call addfld ('ACCRL_M' ,(/ 'lev' /), 'A','kg/kg/m' ,'mass tendency due to accretion of droplets by rain') - call addfld ('BERGN_M' ,(/ 'lev' /), 'A','kg/kg/m' ,'mass tendency due to Bergeron process') - call addfld ('FHTIM_M' ,(/ 'lev' /), 'A','kg/kg/m' ,'mass tendency due to immersion freezing') - call addfld ('FHTCT_M' ,(/ 'lev' /), 'A','kg/kg/m' ,'mass tendency due to contact freezing') - call addfld ('FHML_M' ,(/ 'lev' /), 'A','kg/kg/m' ,'mass tendency due to homogeneous freezing of droplet') - call addfld ('HMPI_M' ,(/ 'lev' /), 'A','kg/kg/m' ,'mass tendency due to HM process') - call addfld ('ACCSL_M' ,(/ 'lev' /), 'A','kg/kg/m' ,'mass tendency due to accretion of droplet by snow') - call addfld ('DLF_M' ,(/ 'lev' /), 'A','kg/kg/m' ,'mass tendency due to detrainment of droplet') - call addfld ('COND_M' ,(/ 'lev' /), 'A','kg/kg/m' ,'mass tendency due to condensation') - - call addfld ('AUTOL_N' ,(/ 'lev' /), 'A','1/kg/m' ,'num tendency due to autoconversion of droplets to rain') - call addfld ('ACCRL_N' ,(/ 'lev' /), 'A','1/kg/m' ,'num tendency due to accretion of droplets by rain') - call addfld ('BERGN_N' ,(/ 'lev' /), 'A','1/kg/m' ,'num tendency due to Bergeron process') - call addfld ('FHTIM_N' ,(/ 'lev' /), 'A','1/kg/m' ,'num tendency due to immersion freezing') - call addfld ('FHTCT_N' ,(/ 'lev' /), 'A','1/kg/m' ,'num tendency due to contact freezing') - call addfld ('FHML_N' ,(/ 'lev' /), 'A','1/kg/m' ,'num tendency due to homogeneous freezing of droplet') - call addfld ('ACCSL_N' ,(/ 'lev' /), 'A','1/kg/m' ,'num tendency due to accretion of droplet by snow') - call addfld ('ACTIV_N' ,(/ 'lev' /), 'A','1/kg/m' ,'num tendency due to droplets activation') - call addfld ('DLF_N' ,(/ 'lev' /), 'A','1/kg/m' ,'num tendency due to detrainment of droplet') - - call addfld ('AUTOI_M' ,(/ 'lev' /), 'A','kg/kg/m' ,'mass tendency due to autoconversion of ice to snow') - call addfld ('ACCSI_M' ,(/ 'lev' /), 'A','kg/kg/m' ,'mass tendency due to accretion of ice by snow') - call addfld ('DIF_M' ,(/ 'lev' /), 'A','kg/kg/m' ,'mass tendency due to detrainment of cloud ice') - call addfld ('DEPOS_M' ,(/ 'lev' /), 'A','kg/kg/m' ,'mass tendency due to deposition') - - call addfld ('NUCLI_N' ,(/ 'lev' /), 'A','1/kg/m' ,'num tendency due to ice nucleation') - call addfld ('AUTOI_N' ,(/ 'lev' /), 'A','1/kg/m' ,'num tendency due to autoconversion of ice to snow') - call addfld ('ACCSI_N' ,(/ 'lev' /), 'A','1/kg/m' ,'num tendency due to accretion of ice by snow') - call addfld ('HMPI_N' ,(/ 'lev' /), 'A','1/kg/m' ,'num tendency due to HM process') - call addfld ('DIF_N' ,(/ 'lev' /), 'A','1/kg/m' ,'num tendency due to detrainment of cloud ice') - - call addfld ('TRSPC_M' ,(/ 'lev' /), 'A','kg/kg/m','mass tendency of droplets due to convective transport') - call addfld ('TRSPC_N' ,(/ 'lev' /), 'A','1/kg/m' ,'num tendency of droplets due to convective transport') - call addfld ('TRSPI_M' ,(/ 'lev' /), 'A','kg/kg/m','mass tendency of ice crystal due to convective transport') - call addfld ('TRSPI_N' ,(/ 'lev' /), 'A','1/kg/m' ,'num tendency of ice crystal due to convective transport') - - - call add_default ('CLDLIQZM', 1, ' ') - call add_default ('CLDICEZM', 1, ' ') - call add_default ('CLIQSNUM', 1, ' ') - call add_default ('CICESNUM', 1, ' ') - call add_default ('DNIFZM', 1, ' ') - call add_default ('DNLFZM', 1, ' ') - call add_default ('WUZM', 1, ' ') - call add_default ('QRAINZM', 1, ' ') - call add_default ('QSNOWZM', 1, ' ') - call add_default ('CRAINNUM', 1, ' ') - call add_default ('CSNOWNUM', 1, ' ') - call add_default ('QNLZM', 1, ' ') - call add_default ('QNIZM', 1, ' ') - call add_default ('QNRZM', 1, ' ') - call add_default ('QNSZM', 1, ' ') - call add_default ('FRZZM', 1, ' ') - - ! Initialization for the microphysics - - call zm_mphyi() - - ! Initialize the aerosol object with data from the modes/species - ! affecting climate, - ! i.e., the list index is hardcoded to 0. - - call rad_cnst_get_info(0, nmodes=nmodes, naero=nbulk) - - - do i = begchunk, endchunk - call zm_aero_init(nmodes, nbulk, aero(i)) - end do - - if (nmodes > 0) then - - dgnum_idx = pbuf_get_index('DGNUM') - - else if (nbulk > 0 .and. cam_physpkg_is('cam4')) then - - ! This call is needed to allow running the ZM microphysics with the - ! cam4 physics package. - call ndrop_bam_init() - - end if - - end subroutine zm_conv_micro_init - - - subroutine zm_aero_init(nmodes, nbulk, aero) - - use pmgrid, only: plev,plevp - - ! Initialize the zm_aero_t object for modal aerosols - - integer, intent(in) :: nmodes - integer, intent(in) :: nbulk - type(zm_aero_t), intent(out) :: aero - - integer :: iaer, l, m - integer :: nspecmx ! max number of species in a mode - - character(len=20), allocatable :: aername(:) - character(len=32) :: str32 - character(len=*), parameter :: routine = 'zm_conv_init' - - real(r8) :: sigmag, dgnumlo, dgnumhi - real(r8) :: alnsg - !---------------------------------------------------------------------------------- - - aero%nmodes = nmodes - aero%nbulk = nbulk - - if (nmodes > 0) then - - ! Initialize the modal aerosol information - - aero%scheme = 'modal' - - ! Get number of species in each mode, and find max. - allocate(aero%nspec(aero%nmodes)) - nspecmx = 0 - do m = 1, aero%nmodes - - call rad_cnst_get_info(0, m, nspec=aero%nspec(m), mode_type=str32) - - nspecmx = max(nspecmx, aero%nspec(m)) - - ! save mode index for specified mode types - select case (trim(str32)) - case ('accum') - aero%mode_accum_idx = m - case ('aitken') - aero%mode_aitken_idx = m - case ('coarse') - aero%mode_coarse_idx = m - end select - - end do - - ! Check that required mode types were found - if (aero%mode_accum_idx == -1 .or. aero%mode_aitken_idx == -1 .or. aero%mode_coarse_idx == -1) then - write(iulog,*) routine//': ERROR required mode type not found - mode idx:', & - aero%mode_accum_idx, aero%mode_aitken_idx, aero%mode_coarse_idx - call endrun(routine//': ERROR required mode type not found') - end if - - ! find indices for the dust and seasalt species in the coarse mode - do l = 1, aero%nspec(aero%mode_coarse_idx) - call rad_cnst_get_info(0, aero%mode_coarse_idx, l, spec_type=str32) - select case (trim(str32)) - case ('dust') - aero%coarse_dust_idx = l - case ('seasalt') - aero%coarse_nacl_idx = l - end select - end do - ! Check that required modal specie types were found - if (aero%coarse_dust_idx == -1 .or. aero%coarse_nacl_idx == -1) then - write(iulog,*) routine//': ERROR required mode-species type not found - indicies:', & - aero%coarse_dust_idx, aero%coarse_nacl_idx - call endrun(routine//': ERROR required mode-species type not found') - end if - - allocate( & - aero%num_a(nmodes), & - aero%mmr_a(nspecmx,nmodes), & - aero%numg_a(pcols,pver,nmodes), & - aero%mmrg_a(pcols,pver,nspecmx,nmodes), & - aero%voltonumblo(nmodes), & - aero%voltonumbhi(nmodes), & - aero%specdens(nspecmx,nmodes), & - aero%spechygro(nspecmx,nmodes), & - aero%dgnum(nmodes), & - aero%dgnumg(pcols,pver,nmodes) ) - - - do m = 1, nmodes - - ! Properties of modes - call rad_cnst_get_mode_props(0, m, & - sigmag=sigmag, dgnumlo=dgnumlo, dgnumhi=dgnumhi) - - alnsg = log(sigmag) - aero%voltonumblo(m) = 1._r8 / ( (pi/6._r8)*(dgnumlo**3._r8)*exp(4.5_r8*alnsg**2._r8) ) - aero%voltonumbhi(m) = 1._r8 / ( (pi/6._r8)*(dgnumhi**3._r8)*exp(4.5_r8*alnsg**2._r8) ) - - ! save sigmag of aitken mode - if (m == aero%mode_aitken_idx) aero%sigmag_aitken = sigmag - - ! Properties of modal species - do l = 1, aero%nspec(m) - call rad_cnst_get_aer_props(0, m, l, density_aer=aero%specdens(l,m), & - hygro_aer=aero%spechygro(l,m)) - end do - end do - - else if (nbulk > 0) then - - aero%scheme = 'bulk' - - ! Props needed for BAM number concentration calcs. - allocate( & - aername(nbulk), & - aero%num_to_mass_aer(nbulk), & - aero%mmr_bulk(nbulk), & - aero%mmrg_bulk(pcols,plev,nbulk) ) - - do iaer = 1, aero%nbulk - call rad_cnst_get_aer_props(0, iaer, & - aername = aername(iaer), & - num_to_mass_aer = aero%num_to_mass_aer(iaer) ) - - ! Look for sulfate aerosol in this list (Bulk aerosol only) - if (trim(aername(iaer)) == 'SULFATE') aero%idxsul = iaer - if (trim(aername(iaer)) == 'DUST1') aero%idxdst1 = iaer - if (trim(aername(iaer)) == 'DUST2') aero%idxdst2 = iaer - if (trim(aername(iaer)) == 'DUST3') aero%idxdst3 = iaer - if (trim(aername(iaer)) == 'DUST4') aero%idxdst4 = iaer - if (trim(aername(iaer)) == 'BCPHI') aero%idxbcphi = iaer - end do - - end if - - end subroutine zm_aero_init - - subroutine zm_conv_micro_outfld(conv, dnif, dnlf, lchnk, ncol) - - use cam_history, only: outfld - - type(zm_conv_t),intent(in) :: conv - real(r8), intent(in) :: dnlf(:,:) ! detrained convective cloud water num concen. - real(r8), intent(in) :: dnif(:,:) ! detrained convective cloud ice num concen. - integer, intent(in) :: lchnk - integer, intent(in) :: ncol - - integer :: i,k - - real(r8) :: cice_snum(pcols,pver) ! convective cloud ice sample number. - real(r8) :: cliq_snum(pcols,pver) ! convective cloud liquid sample number. - real(r8) :: crain_snum(pcols,pver) ! convective rain water sample number. - real(r8) :: csnow_snum(pcols,pver) ! convective snow sample number. - real(r8) :: wu_snum(pcols,pver) ! vertical velocity sample number - - real(r8) :: qni_snum(pcols,pver) ! convective cloud ice number sample number. - real(r8) :: qnl_snum(pcols,pver) ! convective cloud liquid number sample number. - - do k = 1,pver - do i = 1,ncol - if (conv%qice(i,k) .gt. 0.0_r8) then - cice_snum(i,k) = 1.0_r8 - else - cice_snum(i,k) = 0.0_r8 - end if - if (conv%qliq(i,k) .gt. 0.0_r8) then - cliq_snum(i,k) = 1.0_r8 - else - cliq_snum(i,k) = 0.0_r8 - end if - if (conv%qsnow(i,k) .gt. 0.0_r8) then - csnow_snum(i,k) = 1.0_r8 - else - csnow_snum(i,k) = 0.0_r8 - end if - if (conv%qrain(i,k) .gt. 0.0_r8) then - crain_snum(i,k) = 1.0_r8 - else - crain_snum(i,k) = 0.0_r8 - end if - - if (conv%qnl(i,k) .gt. 0.0_r8) then - qnl_snum(i,k) = 1.0_r8 - else - qnl_snum(i,k) = 0.0_r8 - end if - if (conv%qni(i,k) .gt. 0.0_r8) then - qni_snum(i,k) = 1.0_r8 - else - qni_snum(i,k) = 0.0_r8 - end if - if (conv%wu(i,k) .gt. 0.0_r8) then - wu_snum(i,k) = 1.0_r8 - else - wu_snum(i,k) = 0.0_r8 - end if - - end do - end do - - call outfld('ICIMRDP ',conv%qi ,pcols, lchnk ) - call outfld('CLDLIQZM',conv%qliq ,pcols, lchnk) - call outfld('CLDICEZM',conv%qice ,pcols, lchnk) - call outfld('CLIQSNUM',cliq_snum ,pcols, lchnk) - call outfld('CICESNUM',cice_snum ,pcols, lchnk) - call outfld('QRAINZM' ,conv%qrain ,pcols, lchnk) - call outfld('QSNOWZM' ,conv%qsnow ,pcols, lchnk) - call outfld('CRAINNUM',crain_snum ,pcols, lchnk) - call outfld('CSNOWNUM',csnow_snum ,pcols, lchnk) - - call outfld('WUZM' ,conv%wu ,pcols, lchnk) - call outfld('WUZMSNUM',wu_snum ,pcols, lchnk) - call outfld('QNLZM' ,conv%qnl ,pcols, lchnk) - call outfld('QNIZM' ,conv%qni ,pcols, lchnk) - call outfld('QNRZM' ,conv%qnr ,pcols, lchnk) - call outfld('QNSZM' ,conv%qns ,pcols, lchnk) - call outfld('FRZZM' ,conv%frz ,pcols, lchnk) - - call outfld('AUTOL_M' ,conv%autolm ,pcols, lchnk) - call outfld('ACCRL_M' ,conv%accrlm ,pcols, lchnk) - call outfld('BERGN_M' ,conv%bergnm ,pcols, lchnk) - call outfld('FHTIM_M' ,conv%fhtimm ,pcols, lchnk) - call outfld('FHTCT_M' ,conv%fhtctm ,pcols, lchnk) - call outfld('FHML_M' ,conv%fhmlm ,pcols, lchnk) - call outfld('HMPI_M' ,conv%hmpim ,pcols, lchnk) - call outfld('ACCSL_M' ,conv%accslm ,pcols, lchnk) - call outfld('DLF_M' ,conv%dlfm ,pcols, lchnk) - - call outfld('AUTOL_N' ,conv%autoln ,pcols, lchnk) - call outfld('ACCRL_N' ,conv%accrln ,pcols, lchnk) - call outfld('BERGN_N' ,conv%bergnn ,pcols, lchnk) - call outfld('FHTIM_N' ,conv%fhtimn ,pcols, lchnk) - call outfld('FHTCT_N' ,conv%fhtctn ,pcols, lchnk) - call outfld('FHML_N' ,conv%fhmln ,pcols, lchnk) - call outfld('ACCSL_N' ,conv%accsln ,pcols, lchnk) - call outfld('ACTIV_N' ,conv%activn ,pcols, lchnk) - call outfld('DLF_N' ,conv%dlfn ,pcols, lchnk) - call outfld('AUTOI_M' ,conv%autoim ,pcols, lchnk) - call outfld('ACCSI_M' ,conv%accsim ,pcols, lchnk) - call outfld('DIF_M' ,conv%difm ,pcols, lchnk) - call outfld('NUCLI_N' ,conv%nuclin ,pcols, lchnk) - call outfld('AUTOI_N' ,conv%autoin ,pcols, lchnk) - call outfld('ACCSI_N' ,conv%accsin ,pcols, lchnk) - call outfld('HMPI_N' ,conv%hmpin ,pcols, lchnk) - call outfld('DIF_N' ,conv%difn ,pcols, lchnk) - call outfld('COND_M' ,conv%cmel ,pcols, lchnk) - call outfld('DEPOS_M' ,conv%cmei ,pcols, lchnk) - - call outfld('TRSPC_M' ,conv%trspcm ,pcols, lchnk) - call outfld('TRSPC_N' ,conv%trspcn ,pcols, lchnk) - call outfld('TRSPI_M' ,conv%trspim ,pcols, lchnk) - call outfld('TRSPI_N' ,conv%trspin ,pcols, lchnk) - call outfld('DNIFZM' ,dnif ,pcols, lchnk) - call outfld('DNLFZM' ,dnlf ,pcols, lchnk) - - end subroutine zm_conv_micro_outfld end module zm_conv_intr diff --git a/src/physics/cam/zm_microphysics.F90 b/src/physics/cam/zm_microphysics.F90 deleted file mode 100644 index b54e1e684e..0000000000 --- a/src/physics/cam/zm_microphysics.F90 +++ /dev/null @@ -1,2455 +0,0 @@ -module zm_microphysics - -!--------------------------------------------------------------------------------- -! Purpose: -! CAM Interface for cumulus microphysics -! -! Author: Xialiang Song and Guang Jun Zhang, June 2010 -!--------------------------------------------------------------------------------- - -use shr_kind_mod, only: r8=>shr_kind_r8 -use spmd_utils, only: masterproc -use ppgrid, only: pcols, pver, pverp -use physconst, only: gravit, rair, tmelt, cpair, rh2o, r_universal, mwh2o, rhoh2o -use physconst, only: latvap, latice -!use activate_drop_mam, only: actdrop_mam_calc -use ndrop, only: activate_aerosol -use ndrop_bam, only: ndrop_bam_run -use nucleate_ice, only: nucleati -use shr_spfn_mod, only: erf => shr_spfn_erf -use shr_spfn_mod, only: gamma => shr_spfn_gamma -use wv_saturation, only: svp_water, svp_ice -use cam_logfile, only: iulog -use cam_abortutils, only: endrun -use micro_pumas_utils, only:ice_autoconversion, snow_self_aggregation, accrete_cloud_water_snow, & - secondary_ice_production, accrete_rain_snow, heterogeneous_rain_freezing, & - accrete_cloud_water_rain, self_collection_rain, accrete_cloud_ice_snow -use microp_aero, only: aerosol_properties_object -use aerosol_properties_mod, only: aerosol_properties - -implicit none -private -save - -public :: & - zm_mphyi, & - zm_mphy, & - zm_conv_t,& - zm_aero_t - -! Private module data - -! constants remaped -real(r8) :: g ! gravity -real(r8) :: mw ! molecular weight of water -real(r8) :: r ! Dry air Gas constant -real(r8) :: rv ! water vapor gas contstant -real(r8) :: rr ! universal gas constant -real(r8) :: cpp ! specific heat of dry air -real(r8) :: rhow ! density of liquid water -real(r8) :: xlf ! latent heat of freezing - -!from 'microconstants' -real(r8) :: rhosn ! bulk density snow -real(r8) :: rhoi ! bulk density ice - -real(r8) :: ac,bc,as,bs,ai,bi,ar,br !fall speed parameters -real(r8) :: ci,di !ice mass-diameter relation parameters -real(r8) :: cs,ds !snow mass-diameter relation parameters -real(r8) :: cr,dr !drop mass-diameter relation parameters -real(r8) :: Eii !collection efficiency aggregation of ice -real(r8) :: Ecc !collection efficiency -real(r8) :: Ecr !collection efficiency cloud droplets/rain -real(r8) :: DCS !autoconversion size threshold -real(r8) :: bimm,aimm !immersion freezing -real(r8) :: rhosu !typical 850mn air density -real(r8) :: mi0 ! new crystal mass -real(r8) :: rin ! radius of contact nuclei -real(r8) :: pi ! pi - -! contact freezing due to dust -! dust number mean radius (m), Zender et al JGR 2003 assuming number mode radius of 0.6 micron, sigma=2 -real(r8), parameter :: rn_dst1 = 0.258e-6_r8 -real(r8), parameter :: rn_dst2 = 0.717e-6_r8 -real(r8), parameter :: rn_dst3 = 1.576e-6_r8 -real(r8), parameter :: rn_dst4 = 3.026e-6_r8 - -! smallest mixing ratio considered in microphysics -real(r8), parameter :: qsmall = 1.e-18_r8 - - -type, public :: ptr2d - real(r8), pointer :: val(:,:) -end type ptr2d - -! Aerosols -type :: zm_aero_t - - ! Aerosol treatment - character(len=5) :: scheme ! either 'bulk' or 'modal' - - ! Bulk aerosols - integer :: nbulk = 0 ! number of bulk aerosols affecting climate - integer :: idxsul = -1 ! index in aerosol list for sulfate - integer :: idxdst1 = -1 ! index in aerosol list for dust1 - integer :: idxdst2 = -1 ! index in aerosol list for dust2 - integer :: idxdst3 = -1 ! index in aerosol list for dust3 - integer :: idxdst4 = -1 ! index in aerosol list for dust4 - integer :: idxbcphi = -1 ! index in aerosol list for Soot (BCPHI) - - real(r8), allocatable :: num_to_mass_aer(:) ! conversion of mmr to number conc for bulk aerosols - type(ptr2d), allocatable :: mmr_bulk(:) ! array of pointers to bulk aerosol mmr - real(r8), allocatable :: mmrg_bulk(:,:,:) ! gathered bulk aerosol mmr - - ! Modal aerosols - integer :: nmodes = 0 ! number of modes - integer, allocatable :: nspec(:) ! number of species in each mode - type(ptr2d), allocatable :: num_a(:) ! number mixing ratio of modes (interstitial phase) - type(ptr2d), allocatable :: mmr_a(:,:) ! species mmr in each mode (interstitial phase) - real(r8), allocatable :: numg_a(:,:,:) ! gathered number mixing ratio of modes (interstitial phase) - real(r8), allocatable :: mmrg_a(:,:,:,:) ! gathered species mmr in each mode (interstitial phase) - real(r8), allocatable :: voltonumblo(:) ! volume to number conversion (lower bound) for each mode - real(r8), allocatable :: voltonumbhi(:) ! volume to number conversion (upper bound) for each mode - real(r8), allocatable :: specdens(:,:) ! density of modal species - real(r8), allocatable :: spechygro(:,:) ! hygroscopicity of modal species - - integer :: mode_accum_idx = -1 ! index of accumulation mode - integer :: mode_aitken_idx = -1 ! index of aitken mode - integer :: mode_coarse_idx = -1 ! index of coarse mode - integer :: coarse_dust_idx = -1 ! index of dust in coarse mode - integer :: coarse_nacl_idx = -1 ! index of nacl in coarse mode - - type(ptr2d), allocatable :: dgnum(:) ! mode dry radius - real(r8), allocatable :: dgnumg(:,:,:) ! gathered mode dry radius - - real(r8) :: sigmag_aitken - -end type zm_aero_t - -type :: zm_conv_t - - real(r8), allocatable :: qi(:,:) ! wg grid slice of cloud ice. - real(r8), allocatable :: qliq(:,:) ! convective cloud liquid water. - real(r8), allocatable :: qice(:,:) ! convective cloud ice. - real(r8), allocatable :: wu(:,:) ! vertical velocity - real(r8), allocatable :: sprd(:,:) ! rate of production of snow at that layer - real(r8), allocatable :: qrain(:,:) ! convective rain water. - real(r8), allocatable :: qsnow(:,:) ! convective snow. - real(r8), allocatable :: qnl(:,:) ! convective cloud liquid water num concen. - real(r8), allocatable :: qni(:,:) ! convective cloud ice num concen. - real(r8), allocatable :: qnr(:,:) ! convective rain water num concen. - real(r8), allocatable :: qns(:,:) ! convective snow num concen. - real(r8), allocatable :: frz(:,:) ! heating rate due to freezing - real(r8), allocatable :: autolm(:,:) !mass tendency due to autoconversion of droplets to rain - real(r8), allocatable :: accrlm(:,:) !mass tendency due to accretion of droplets by rain - real(r8), allocatable :: bergnm(:,:) !mass tendency due to Bergeron process - real(r8), allocatable :: fhtimm(:,:) !mass tendency due to immersion freezing - real(r8), allocatable :: fhtctm(:,:) !mass tendency due to contact freezing - real(r8), allocatable :: fhmlm (:,:) !mass tendency due to homogeneous freezing - real(r8), allocatable :: hmpim (:,:) !mass tendency due to HM process - real(r8), allocatable :: accslm(:,:) !mass tendency due to accretion of droplets by snow - real(r8), allocatable :: dlfm (:,:) !mass tendency due to detrainment of droplet - real(r8), allocatable :: autoln(:,:) !num tendency due to autoconversion of droplets to rain - real(r8), allocatable :: accrln(:,:) !num tendency due to accretion of droplets by rain - real(r8), allocatable :: bergnn(:,:) !num tendency due to Bergeron process - real(r8), allocatable :: fhtimn(:,:) !num tendency due to immersion freezing - real(r8), allocatable :: fhtctn(:,:) !num tendency due to contact freezing - real(r8), allocatable :: fhmln (:,:) !num tendency due to homogeneous freezing - real(r8), allocatable :: accsln(:,:) !num tendency due to accretion of droplets by snow - real(r8), allocatable :: activn(:,:) !num tendency due to droplets activation - real(r8), allocatable :: dlfn (:,:) !num tendency due to detrainment of droplet - real(r8), allocatable :: autoim(:,:) !mass tendency due to autoconversion of cloud ice to snow - real(r8), allocatable :: accsim(:,:) !mass tendency due to accretion of cloud ice by snow - real(r8), allocatable :: difm (:,:) !mass tendency due to detrainment of cloud ice - real(r8), allocatable :: nuclin(:,:) !num tendency due to ice nucleation - real(r8), allocatable :: autoin(:,:) !num tendency due to autoconversion of cloud ice to snow - real(r8), allocatable :: accsin(:,:) !num tendency due to accretion of cloud ice by snow - real(r8), allocatable :: hmpin (:,:) !num tendency due to HM process - real(r8), allocatable :: difn (:,:) !num tendency due to detrainment of cloud ice - real(r8), allocatable :: cmel (:,:) !mass tendency due to condensation - real(r8), allocatable :: cmei (:,:) !mass tendency due to deposition - real(r8), allocatable :: trspcm(:,:) !LWC tendency due to convective transport - real(r8), allocatable :: trspcn(:,:) !droplet num tendency due to convective transport - real(r8), allocatable :: trspim(:,:) !IWC tendency due to convective transport - real(r8), allocatable :: trspin(:,:) !ice crystal num tendency due to convective transport - real(r8), allocatable :: dcape(:) ! CAPE change due to freezing heating - real(r8), allocatable :: lambdadpcu(:,:)! slope of cloud liquid size distr - real(r8), allocatable :: mudpcu(:,:) ! width parameter of droplet size distr - real(r8), allocatable :: di(:,:) - real(r8), allocatable :: dnl(:,:) - real(r8), allocatable :: dni(:,:) - real(r8), allocatable :: qide(:,:) ! cloud ice mixing ratio for detrainment (kg/kg) - real(r8), allocatable :: qncde(:,:) ! cloud water number concentration for detrainment (1/kg) - real(r8), allocatable :: qnide(:,:) ! cloud ice number concentration for detrainment (1/kg) - - -end type zm_conv_t - -real(r8), parameter :: dcon = 25.e-6_r8 -real(r8), parameter :: mucon = 5.3_r8 -real(r8), parameter :: lambdadpcu = (mucon + 1._r8)/dcon - -!=============================================================================== -contains -!=============================================================================== - -subroutine zm_mphyi - -!----------------------------------------------------------------------- -! -! Purpose: -! initialize constants for the cumulus microphysics -! called from zm_conv_init() in zm_conv_intr.F90 -! -! Author: Xialiang Song, June 2010 -! -!----------------------------------------------------------------------- - -!NOTE: -! latent heats should probably be fixed with temperature -! for energy conservation with the rest of the model -! (this looks like a +/- 3 or 4% effect, but will mess up energy balance) - - xlf = latice ! latent heat freezing - -! from microconstants - -! parameters below from Reisner et al. (1998) -! density parameters (kg/m3) - - rhosn = 100._r8 ! bulk density snow - rhoi = 500._r8 ! bulk density ice - rhow = 1000._r8 ! bulk density liquid - -! fall speed parameters, V = aD^b -! V is in m/s - -! droplets - ac = 3.e7_r8 - bc = 2._r8 - -! snow - as = 11.72_r8 - bs = 0.41_r8 - -! cloud ice - ai = 700._r8 - bi = 1._r8 - -! rain - ar = 841.99667_r8 - br = 0.8_r8 - -! particle mass-diameter relationship -! currently we assume spherical particles for cloud ice/snow -! m = cD^d - - pi= 3.14159265358979323846_r8 - -! cloud ice mass-diameter relationship - - ci = rhoi*pi/6._r8 - di = 3._r8 - -! snow mass-diameter relationship - - cs = rhosn*pi/6._r8 - ds = 3._r8 - -! drop mass-diameter relationship - - cr = rhow*pi/6._r8 - dr = 3._r8 - -! collection efficiency, aggregation of cloud ice and snow - - Eii = 0.1_r8 - -! collection efficiency, accretion of cloud water by rain - - Ecr = 1.0_r8 - -! autoconversion size threshold for cloud ice to snow (m) - - Dcs = 150.e-6_r8 -! immersion freezing parameters, bigg 1953 - - bimm = 100._r8 - aimm = 0.66_r8 - -! typical air density at 850 mb - - rhosu = 85000._r8/(rair * tmelt) - -! mass of new crystal due to aerosol freezing and growth (kg) - - mi0 = 4._r8/3._r8*pi*rhoi*(10.e-6_r8)*(10.e-6_r8)*(10.e-6_r8) - -! radius of contact nuclei aerosol (m) - - rin = 0.1e-6_r8 - -end subroutine zm_mphyi - -!=============================================================================== - -subroutine zm_mphy(su, qu, mu, du, eu, cmel, cmei, zf, pm, te, qe, & - eps0, jb, jt, jlcl, msg, il2g, grav, cp, rd, aero, gamhat, & - qc, qi, nc, ni, qcde, qide, ncde, nide, rprd, sprd, frz, & - wu, qr, qni, nr, ns, autolm, accrlm, bergnm, fhtimm, fhtctm, & - fhmlm, hmpim, accslm, dlfm, autoln, accrln, bergnn, fhtimn, fhtctn, & - fhmln, accsln, activn, dlfn, autoim, accsim, difm, nuclin, autoin, & - accsin, hmpin, difn, trspcm, trspcn, trspim, trspin, lamc, pgam ) - - -! Purpose: -! microphysic parameterization for Zhang-McFarlane convection scheme -! called from cldprp() in zm_conv.F90 -! -! Author: Xialiang Song, June 2010 - - use time_manager, only: get_step_size - -! variable declarations - - implicit none - -! input variables - real(r8), intent(in) :: su(pcols,pver) ! normalized dry stat energy of updraft - real(r8), intent(in) :: qu(pcols,pver) ! spec hum of updraft - real(r8), intent(in) :: mu(pcols,pver) ! updraft mass flux - real(r8), intent(in) :: du(pcols,pver) ! detrainement rate of updraft - real(r8), intent(in) :: eu(pcols,pver) ! entrainment rate of updraft - real(r8), intent(in) :: cmel(pcols,pver) ! condensation rate of updraft - real(r8), intent(in) :: cmei(pcols,pver) ! condensation rate of updraft - real(r8), intent(in) :: zf(pcols,pverp) ! height of interfaces - real(r8), intent(in) :: pm(pcols,pver) ! pressure of env - real(r8), intent(in) :: te(pcols,pver) ! temp of env - real(r8), intent(in) :: qe(pcols,pver) ! spec. humidity of env - real(r8), intent(in) :: eps0(pcols) - real(r8), intent(in) :: gamhat(pcols,pver) ! gamma=L/cp(dq*/dT) at interface - - integer, intent(in) :: jb(pcols) ! updraft base level - integer, intent(in) :: jt(pcols) ! updraft plume top - integer, intent(in) :: jlcl(pcols) ! updraft lifting cond level - integer, intent(in) :: msg ! missing moisture vals - integer, intent(in) :: il2g ! number of columns in gathered arrays - - type(zm_aero_t), intent(in) :: aero ! aerosol object - - real(r8) grav ! gravity - real(r8) cp ! heat capacity of dry air - real(r8) rd ! gas constant for dry air - -! output variables - real(r8), intent(out) :: qc(pcols,pver) ! cloud water mixing ratio (kg/kg) - real(r8), intent(out) :: qi(pcols,pver) ! cloud ice mixing ratio (kg/kg) - real(r8), intent(out) :: nc(pcols,pver) ! cloud water number conc (1/kg) - real(r8), intent(out) :: ni(pcols,pver) ! cloud ice number conc (1/kg) - real(r8), intent(out) :: qcde(pcols,pver) ! cloud water mixing ratio for detrainment(kg/kg) - real(r8), intent(out) :: qide(pcols,pver) ! cloud ice mixing ratio for detrainment (kg/kg) - real(r8), intent(out) :: ncde(pcols,pver) ! cloud water number conc for detrainment (1/kg) - real(r8), intent(out) :: nide(pcols,pver) ! cloud ice number conc for detrainment (1/kg) - real(r8), intent(out) :: wu(pcols,pver) - real(r8), intent(out) :: qni(pcols,pver) ! snow mixing ratio - real(r8), intent(out) :: qr(pcols,pver) ! rain mixing ratio - real(r8), intent(out) :: ns(pcols,pver) ! snow number conc - real(r8), intent(out) :: nr(pcols,pver) ! rain number conc - real(r8), intent(out) :: rprd(pcols,pver) ! rate of production of precip at that layer - real(r8), intent(out) :: sprd(pcols,pver) ! rate of production of snow at that layer - real(r8), intent(out) :: frz(pcols,pver) ! rate of freezing - - - real(r8), intent(inout) :: lamc(pcols,pver) ! slope of cloud liquid size distr - real(r8), intent(inout) :: pgam(pcols,pver) ! spectral width parameter of droplet size distr - -! tendency for output - real(r8),intent(out) :: autolm(pcols,pver) !mass tendency due to autoconversion of droplets to rain - real(r8),intent(out) :: accrlm(pcols,pver) !mass tendency due to accretion of droplets by rain - real(r8),intent(out) :: bergnm(pcols,pver) !mass tendency due to Bergeron process - real(r8),intent(out) :: fhtimm(pcols,pver) !mass tendency due to immersion freezing - real(r8),intent(out) :: fhtctm(pcols,pver) !mass tendency due to contact freezing - real(r8),intent(out) :: fhmlm (pcols,pver) !mass tendency due to homogeneous freezing - real(r8),intent(out) :: hmpim (pcols,pver) !mass tendency due to HM process - real(r8),intent(out) :: accslm(pcols,pver) !mass tendency due to accretion of droplets by snow - real(r8),intent(out) :: dlfm (pcols,pver) !mass tendency due to detrainment of droplet - real(r8),intent(out) :: trspcm(pcols,pver) !mass tendency of droplets due to convective transport - - real(r8),intent(out) :: autoln(pcols,pver) !num tendency due to autoconversion of droplets to rain - real(r8),intent(out) :: accrln(pcols,pver) !num tendency due to accretion of droplets by rain - real(r8),intent(out) :: bergnn(pcols,pver) !num tendency due to Bergeron process - real(r8),intent(out) :: fhtimn(pcols,pver) !num tendency due to immersion freezing - real(r8),intent(out) :: fhtctn(pcols,pver) !num tendency due to contact freezing - real(r8),intent(out) :: fhmln (pcols,pver) !num tendency due to homogeneous freezing - real(r8),intent(out) :: accsln(pcols,pver) !num tendency due to accretion of droplets by snow - real(r8),intent(out) :: activn(pcols,pver) !num tendency due to droplets activation - real(r8),intent(out) :: dlfn (pcols,pver) !num tendency due to detrainment of droplet - real(r8),intent(out) :: trspcn(pcols,pver) !num tendency of droplets due to convective transport - - real(r8),intent(out) :: autoim(pcols,pver) !mass tendency due to autoconversion of cloud ice to snow - real(r8),intent(out) :: accsim(pcols,pver) !mass tendency due to accretion of cloud ice by snow - real(r8),intent(out) :: difm (pcols,pver) !mass tendency due to detrainment of cloud ice - real(r8),intent(out) :: trspim(pcols,pver) !mass tendency of ice crystal due to convective transport - - real(r8),intent(out) :: nuclin(pcols,pver) !num tendency due to ice nucleation - real(r8),intent(out) :: autoin(pcols,pver) !num tendency due to autoconversion of cloud ice to snow - real(r8),intent(out) :: accsin(pcols,pver) !num tendency due to accretion of cloud ice by snow - real(r8),intent(out) :: hmpin (pcols,pver) !num tendency due to HM process - real(r8),intent(out) :: difn (pcols,pver) !num tendency due to detrainment of cloud ice - real(r8),intent(out) :: trspin(pcols,pver) !num tendency of ice crystal due to convective transport - -!................................................................................ -! local workspace -! all units mks unless otherwise stated - real(r8) :: deltat ! time step (s) - real(r8) :: omsm ! number near unity for round-off issues - real(r8) :: dum ! temporary dummy variable - real(r8) :: dum1 ! temporary dummy variable - real(r8) :: dum2 ! temporary dummy variable - - real(r8) :: q(pcols,pver) ! water vapor mixing ratio (kg/kg) - real(r8) :: t(pcols,pver) ! temperature (K) - real(r8) :: rho(pcols,pver) ! air density (kg m-3) - real(r8) :: dz(pcols,pver) ! height difference across model vertical level - - real(r8) :: qcic(pcols,pver) ! in-cloud cloud liquid mixing ratio - real(r8) :: qiic(pcols,pver) ! in-cloud cloud ice mixing ratio - real(r8) :: qniic(pcols,pver) ! in-precip snow mixing ratio - real(r8) :: qric(pcols,pver) ! in-precip rain mixing ratio - real(r8) :: ncic(pcols,pver) ! in-cloud droplet number conc - real(r8) :: niic(pcols,pver) ! in-cloud cloud ice number conc - real(r8) :: nsic(pcols,pver) ! in-precip snow number conc - real(r8) :: nric(pcols,pver) ! in-precip rain number conc - - real(r8) :: lami(pver) ! slope of cloud ice size distr - real(r8) :: n0i(pver) ! intercept of cloud ice size distr - real(r8) :: n0c(pver) ! intercept of cloud liquid size distr - real(r8) :: lams(pver) ! slope of snow size distr - real(r8) :: n0s(pver) ! intercept of snow size distr - real(r8) :: lamr(pver) ! slope of rain size distr - real(r8) :: n0r(pver) ! intercept of rain size distr - real(r8) :: cdist1(pver) ! size distr parameter to calculate droplet freezing - real(r8) :: lammax ! maximum allowed slope of size distr - real(r8) :: lammin ! minimum allowed slope of size distr - - real(r8) :: mnuccc(pver) ! mixing ratio tendency due to freezing of cloud water - real(r8) :: nnuccc(pver) ! number conc tendency due to freezing of cloud water - real(r8) :: mnucct(pver) ! mixing ratio tendency due to contact freezing of cloud water - real(r8) :: nnucct(pver) ! number conc tendency due to contact freezing of cloud water - real(r8) :: msacwi(pver) ! mixing ratio tendency due to HM ice multiplication - real(r8) :: nsacwi(pver) ! number conc tendency due to HM ice multiplication - real(r8) :: prf(pver) ! mixing ratio tendency due to fallout of rain - real(r8) :: psf(pver) ! mixing ratio tendency due to fallout of snow - real(r8) :: pnrf(pver) ! number conc tendency due to fallout of rain - real(r8) :: pnsf(pver) ! number conc tendency due to fallout of snow - real(r8) :: prc(pver) ! mixing ratio tendency due to autoconversion of cloud droplets - real(r8) :: nprc(pver) ! number conc tendency due to autoconversion of cloud droplets - real(r8) :: nprc1(pver) ! qr tendency due to autoconversion of cloud droplets - real(r8) :: nsagg(pver) ! ns tendency due to self-aggregation of snow - real(r8) :: dc0 ! mean size droplet size distr - real(r8) :: ds0 ! mean size snow size distr (area weighted) - real(r8) :: eci ! collection efficiency for riming of snow by droplets - real(r8) :: dv(pcols,pver) ! diffusivity of water vapor in air - real(r8) :: mua(pcols,pver) ! viscocity of air - real(r8) :: psacws(pver) ! mixing rat tendency due to collection of droplets by snow - real(r8) :: npsacws(pver) ! number conc tendency due to collection of droplets by snow - real(r8) :: pracs(pver) ! mixing rat tendency due to collection of rain by snow - real(r8) :: npracs(pver) ! number conc tendency due to collection of rain by snow - real(r8) :: mnuccr(pver) ! mixing rat tendency due to freezing of rain - real(r8) :: nnuccr(pver) ! number conc tendency due to freezing of rain - real(r8) :: pra(pver) ! mixing rat tendnency due to accretion of droplets by rain - real(r8) :: npra(pver) ! nc tendnency due to accretion of droplets by rain - real(r8) :: nragg(pver) ! nr tendency due to self-collection of rain - real(r8) :: prci(pver) ! mixing rat tendency due to autoconversion of cloud ice to snow - real(r8) :: nprci(pver) ! number conc tendency due to autoconversion of cloud ice to snow - real(r8) :: prai(pver) ! mixing rat tendency due to accretion of cloud ice by snow - real(r8) :: nprai(pver) ! number conc tendency due to accretion of cloud ice by snow - real(r8) :: prb(pver) ! rain mixing rat tendency due to Bergeron process - real(r8) :: nprb(pver) ! number conc tendency due to Bergeron process - real(r8) :: fhmrm (pcols,pver) !mass tendency due to homogeneous freezing of rain - -! fall speed - real(r8) :: arn(pcols,pver) ! air density corrected rain fallspeed parameter - real(r8) :: asn(pcols,pver) ! air density corrected snow fallspeed parameter - real(r8) :: acn(pcols,pver) ! air density corrected cloud droplet fallspeed parameter - real(r8) :: ain(pcols,pver) ! air density corrected cloud ice fallspeed parameter - real(r8) :: uns(pver) ! number-weighted snow fallspeed - real(r8) :: ums(pver) ! mass-weighted snow fallspeed - real(r8) :: unr(pver) ! number-weighted rain fallspeed - real(r8) :: umr(pver) ! mass-weighted rain fallspeed - -! conservation check - real(r8) :: qce ! dummy qc for conservation check - real(r8) :: qie ! dummy qi for conservation check - real(r8) :: nce ! dummy nc for conservation check - real(r8) :: nie ! dummy ni for conservation check - real(r8) :: qre ! dummy qr for conservation check - real(r8) :: nre ! dummy nr for conservation check - real(r8) :: qnie ! dummy qni for conservation check - real(r8) :: nse ! dummy ns for conservation check - real(r8) :: ratio ! parameter for conservation check - -! sum of source/sink terms for cloud hydrometeor - real(r8) :: qctend(pcols,pver) ! microphysical tendency qc (1/s) - real(r8) :: qitend(pcols,pver) ! microphysical tendency qi (1/s) - real(r8) :: nctend(pcols,pver) ! microphysical tendency nc (1/(kg*s)) - real(r8) :: nitend(pcols,pver) ! microphysical tendency ni (1/(kg*s)) - real(r8) :: qnitend(pcols,pver) ! snow mixing ratio source/sink term - real(r8) :: nstend(pcols,pver) ! snow number concentration source/sink term - real(r8) :: qrtend(pcols,pver) ! rain mixing ratio source/sink term - real(r8) :: nrtend(pcols,pver) ! rain number concentration source/sink term - -! terms for Bergeron process - real(r8) :: bergtsf !bergeron timescale to remove all liquid - real(r8) :: plevap ! cloud liquid water evaporation rate - -! variables for droplet activation by modal aerosols - real(r8) :: wmix, wmin, wmax, wdiab - real(r8) :: vol, nlsrc - real(r8), allocatable :: vaerosol(:), hygro(:), naermod(:) - real(r8), allocatable :: fn(:) ! number fraction of aerosols activated - real(r8), allocatable :: fm(:) ! mass fraction of aerosols activated - real(r8), allocatable :: fluxn(:) ! flux of activated aerosol number fraction into cloud (cm/s) - real(r8), allocatable :: fluxm(:) ! flux of activated aerosol mass fraction into cloud (cm/s) - real(r8) :: flux_fullact ! flux of activated aerosol fraction assuming 100% activation (cm/s) - real(r8) :: dmc - real(r8) :: ssmc - real(r8) :: dgnum_aitken - -! bulk aerosol variables - real(r8), allocatable :: naer2(:,:,:) ! new aerosol number concentration (/m3) - real(r8), allocatable :: naer2h(:,:,:) ! new aerosol number concentration (/m3) - real(r8), allocatable :: maerosol(:) ! aerosol mass conc (kg/m3) - real(r8) :: so4_num - real(r8) :: soot_num - real(r8) :: dst1_num - real(r8) :: dst2_num - real(r8) :: dst3_num - real(r8) :: dst4_num - real(r8) :: dst_num - -! droplet activation - logical :: in_cloud ! true when above cloud base layer (k > jb) - real(r8) :: smax_f ! droplet and rain size distr factor used in the - ! in-cloud smax calculation - real(r8) :: dum2l(pcols,pver) ! number conc of CCN (1/kg) - real(r8) :: npccn(pver) ! droplet activation rate - real(r8) :: ncmax - real(r8) :: mtimec ! factor to account for droplet activation timescale - -! ice nucleation - real(r8) :: dum2i(pcols,pver) ! number conc of ice nuclei available (1/kg) - real(r8) :: qs(pcols,pver) ! liquid-ice weighted sat mixing rat (kg/kg) - real(r8) :: es(pcols,pver) ! sat vapor press (pa) over water - real(r8) :: relhum(pcols,pver) ! relative humidity - real(r8) :: esi(pcols,pver) ! sat vapor press (pa) over ice - real(r8) :: nnuccd(pver) ! ice nucleation rate from deposition/cond.-freezing - real(r8) :: mnuccd(pver) ! mass tendency from ice nucleation - real(r8) :: mtime ! factor to account for ice nucleation timescale - -! output for ice nucleation - real(r8) :: nimey(pcols,pver) !number conc of ice nuclei due to meyers deposition (1/m3) - real(r8) :: nihf(pcols,pver) !number conc of ice nuclei due to heterogenous freezing (1/m3) - real(r8) :: nidep(pcols,pver) !number conc of ice nuclei due to deoposion nucleation (hetero nuc) (1/m3) - real(r8) :: niimm(pcols,pver) !number conc of ice nuclei due to immersion freezing (hetero nuc) (1/m3) - - real(r8) :: wpice, weff, fhom ! unused dummies - -! loop array variables - integer i,k, n, l - integer ii,kk, m - -! loop variables for iteration solution - integer iter,it,ltrue(pcols) - -! used in contact freezing via dust particles - real(r8) tcnt, viscosity, mfp - real(r8) slip1, slip2, slip3, slip4 - real(r8) dfaer1, dfaer2, dfaer3, dfaer4 - real(r8) nacon1,nacon2,nacon3,nacon4 - -! used in immersion freezing via soot - real(r8) ttend(pver) - real(r8) naimm - real(r8) :: ntaer(pcols,pver) - real(r8) :: ntaerh(pcols,pver) - -! used in homogeneous freezing - real(r8) :: fholm (pcols,pver) !mass tendency due to homogeneous freezing - real(r8) :: fholn (pcols,pver) !number conc tendency due to homogeneous freezing - -! used in secondary ice production - real(r8) ni_secp - -! used in vertical velocity calculation - real(r8) th(pcols,pver) - real(r8) qh(pcols,pver) - real(r8) zkine(pcols,pver) - real(r8) zbuo(pcols,pver) - real(r8) zfacbuo, cwdrag, cwifrac, retv, zbuoc - real(r8) zbc, zbe, zdkbuo, zdken - real(r8) arcf(pcols,pver) - real(r8) p(pcols,pver) - real(r8) ph(pcols,pver) - -! used in vertical integreation - logical qcimp(pver) ! true to solve qc with implicit formula - logical ncimp(pver) ! true to solve nc with implicit formula - logical qiimp(pver) ! true to solve qi with implicit formula - logical niimp(pver) ! true to solve ni with implicit formula - -! tendency due to adjustment - real(r8) :: ncadj(pcols,pver) !droplet num tendency due to adjustment - real(r8) :: niadj(pcols,pver) !ice crystal num tendency due to adjustment - real(r8) :: ncorg, niorg, total - - real(r8) :: rhoh(pcols,pver) ! air density (kg m-3) at interface - real(r8) :: rhom(pcols,pver) ! air density (kg m-3) at mid-level - real(r8) :: tu(pcols,pver) ! temperature in updraft (K) - - integer kqi(pcols),kqc(pcols) - logical lcbase(pcols), libase(pcols) - - real(r8) :: nai_bcphi, nai_dst1, nai_dst2, nai_dst3, nai_dst4 - - real(r8) flxrm, mvtrm, flxrn, mvtrn, flxsm, mvtsm, flxsn, mvtsn - integer nlr, nls - - real(r8) rmean, beta6, beta66, r6, r6c - real(r8) temp1, temp2, temp3, temp4 ! variable to store output which is not required by this routine - - class(aerosol_properties), pointer :: aero_props_obj => null() - -! Aerosol properties - aero_props_obj => aerosol_properties_object() - -!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc -! initialization -!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc - - if (aero%scheme == 'modal') then - - allocate(vaerosol(aero%nmodes), hygro(aero%nmodes), naermod(aero%nmodes), & - fn(aero%nmodes), fm(aero%nmodes), fluxn(aero%nmodes), fluxm(aero%nmodes)) - - else if (aero%scheme == 'bulk') then - - allocate( & - naer2(pcols,pver,aero%nbulk), & - naer2h(pcols,pver,aero%nbulk), & - maerosol(aero%nbulk)) - - end if - - deltat= get_step_size() !for FV dynamical core - - ! parameters for scheme - omsm=0.99999_r8 - zfacbuo = 0.5_r8/(1._r8+0.5_r8) - cwdrag = 1.875_r8*0.506_r8 - cwifrac = 0.5_r8 - retv = 0.608_r8 - bergtsf = 1800._r8 - - ! initialize multi-level fields - do i=1,il2g - do k=1,pver - q(i,k) = qu(i,k) - tu(i,k)= su(i,k) - grav/cp*zf(i,k) - t(i,k) = su(i,k) - grav/cp*zf(i,k) - p(i,k) = 100._r8*pm(i,k) - wu(i,k) = 0._r8 - zkine(i,k)= 0._r8 - arcf(i,k) = 0._r8 - zbuo(i,k) = 0._r8 - nc(i,k) = 0._r8 - ni(i,k) = 0._r8 - qc(i,k) = 0._r8 - qi(i,k) = 0._r8 - ncde(i,k) = 0._r8 - nide(i,k) = 0._r8 - qcde(i,k) = 0._r8 - qide(i,k) = 0._r8 - rprd(i,k) = 0._r8 - sprd(i,k) = 0._r8 - frz(i,k) = 0._r8 - qcic(i,k) = 0._r8 - qiic(i,k) = 0._r8 - ncic(i,k) = 0._r8 - niic(i,k) = 0._r8 - qr(i,k) = 0._r8 - qni(i,k) = 0._r8 - nr(i,k) = 0._r8 - ns(i,k) = 0._r8 - qric(i,k) = 0._r8 - qniic(i,k) = 0._r8 - nric(i,k) = 0._r8 - nsic(i,k) = 0._r8 - nimey(i,k) = 0._r8 - nihf(i,k) = 0._r8 - nidep(i,k) = 0._r8 - niimm(i,k) = 0._r8 - fhmrm(i,k) = 0._r8 - - autolm(i,k) = 0._r8 - accrlm(i,k) = 0._r8 - bergnm(i,k) = 0._r8 - fhtimm(i,k) = 0._r8 - fhtctm(i,k) = 0._r8 - fhmlm (i,k) = 0._r8 - fholm (i,k) = 0._r8 - hmpim (i,k) = 0._r8 - accslm(i,k) = 0._r8 - dlfm (i,k) = 0._r8 - - autoln(i,k) = 0._r8 - accrln(i,k) = 0._r8 - bergnn(i,k) = 0._r8 - fhtimn(i,k) = 0._r8 - fhtctn(i,k) = 0._r8 - fhmln (i,k) = 0._r8 - fholn (i,k) = 0._r8 - accsln(i,k) = 0._r8 - activn(i,k) = 0._r8 - dlfn (i,k) = 0._r8 - - autoim(i,k) = 0._r8 - accsim(i,k) = 0._r8 - difm (i,k) = 0._r8 - - nuclin(i,k) = 0._r8 - autoin(i,k) = 0._r8 - accsin(i,k) = 0._r8 - hmpin (i,k) = 0._r8 - difn (i,k) = 0._r8 - - trspcm(i,k) = 0._r8 - trspcn(i,k) = 0._r8 - trspim(i,k) = 0._r8 - trspin(i,k) = 0._r8 - - ncadj (i,k) = 0._r8 - niadj (i,k) = 0._r8 - end do - end do - - ! initialize time-varying parameters - do k=1,pver - do i=1,il2g - if (k .eq.1) then - rhoh(i,k) = p(i,k)/(t(i,k)*rd) - rhom(i,k) = p(i,k)/(t(i,k)*rd) - th (i,k) = te(i,k) - qh (i,k) = qe(i,k) - dz (i,k) = zf(i,k) - zf(i,k+1) - ph(i,k) = p(i,k) - else - rhoh(i,k) = 0.5_r8*(p(i,k)+p(i,k-1))/(t(i,k)*rd) - if (k .eq. pver) then - rhom(i,k) = p(i,k)/(rd*t(i,k)) - else - rhom(i,k) = 2.0_r8*p(i,k)/(rd*(t(i,k)+t(i,k+1))) - end if - th (i,k) = 0.5_r8*(te(i,k)+te(i,k-1)) - qh (i,k) = 0.5_r8*(qe(i,k)+qe(i,k-1)) - dz(i,k) = zf(i,k-1) - zf(i,k) - ph(i,k) = 0.5_r8*(p(i,k) + p(i,k-1)) - end if - dv(i,k) = 8.794E-5_r8*t(i,k)**1.81_r8/ph(i,k) - mua(i,k) = 1.496E-6_r8*t(i,k)**1.5_r8/ & - (t(i,k)+120._r8) - - rho(i,k) = rhoh(i,k) - - ! air density adjustment for fallspeed parameters - ! add air density correction factor to the power of - ! 0.54 following Heymsfield and Bansemer 2006 - - arn(i,k)=ar*(rhosu/rho(i,k))**0.54_r8 - asn(i,k)=as*(rhosu/rho(i,k))**0.54_r8 - acn(i,k)=ac*(rhosu/rho(i,k))**0.54_r8 - ain(i,k)=ai*(rhosu/rho(i,k))**0.54_r8 - - end do - end do - - if (aero%scheme == 'modal') then - - wmix = 0._r8 - wmin = 0._r8 - wmax = 10._r8 - wdiab = 0._r8 - - do k=1,pver - do i=1,il2g - dum2l(i,k)=0._r8 - dum2i(i,k)=0._r8 - ntaer(i,k) = 0.0_r8 - ntaerh(i,k) = 0.0_r8 - do m = 1, aero%nmodes - ntaer(i,k) = ntaer(i,k) + aero%numg_a(i,k,m)*rhom(i,k) - enddo - end do - end do - - else if (aero%scheme == 'bulk') then - - ! initialize aerosol number - do k=1,pver - do i=1,il2g - naer2(i,k,:)=0._r8 - naer2h(i,k,:)=0._r8 - dum2l(i,k)=0._r8 - dum2i(i,k)=0._r8 - end do - end do - - do k=1,pver - do i=1,il2g - ntaer(i,k) = 0.0_r8 - ntaerh(i,k) = 0.0_r8 - do m = 1, aero%nbulk - maerosol(m) = aero%mmrg_bulk(i,k,m)*rhom(i,k) - - ! set number nucleated for sulfate based on Lohmann et al. 2000 (JGR) Eq.2 - ! Na=340.*(massSO4)^0.58 where Na=cm-3 and massSO4=ug/m3 - ! convert units to Na [m-3] and SO4 [kgm-3] - ! Na(m-3)= 1.e6 cm3 m-3 Na(cm-3)=340. *(massSO4[kg/m3]*1.e9ug/kg)^0.58 - ! or Na(m-3)= 1.e6* 340.*(1.e9ug/kg)^0.58 * (massSO4[kg/m3])^0.58 - - if (m .eq. aero%idxsul) then - naer2(i,k,m)= 5.64259e13_r8 * maerosol(m)**0.58_r8 - else - naer2(i,k,m)=maerosol(m)*aero%num_to_mass_aer(m) - end if - ntaer(i,k) = ntaer(i,k) + naer2(i,k,m) - end do - end do - end do - - end if - - do i=1,il2g - ltrue(i)=0 - do k=1,pver - if (qc(i,k).ge.qsmall.or.qi(i,k).ge.qsmall.or.cmel(i,k).ge.qsmall.or.cmei(i,k).ge.qsmall) ltrue(i)=1 - end do - end do - - ! skip microphysical calculations if no cloud water - do i=1,il2g - if (ltrue(i).eq.0) then - do k=1,pver - qctend(i,k)=0._r8 - qitend(i,k)=0._r8 - qnitend(i,k)=0._r8 - qrtend(i,k)=0._r8 - nctend(i,k)=0._r8 - nitend(i,k)=0._r8 - nrtend(i,k)=0._r8 - nstend(i,k)=0._r8 - qniic(i,k)=0._r8 - qric(i,k)=0._r8 - nsic(i,k)=0._r8 - nric(i,k)=0._r8 - qni(i,k)=0._r8 - qr(i,k)=0._r8 - ns(i,k)=0._r8 - nr(i,k)=0._r8 - qc(i,k) = 0._r8 - qi(i,k) = 0._r8 - nc(i,k) = 0._r8 - ni(i,k) = 0._r8 - qcde(i,k) = 0._r8 - qide(i,k) = 0._r8 - ncde(i,k) = 0._r8 - nide(i,k) = 0._r8 - rprd(i,k) = 0._r8 - sprd(i,k) = 0._r8 - frz(i,k) = 0._r8 - end do - goto 300 - end if - - kqc(i) = 1 - kqi(i) = 1 - lcbase(i) = .true. - libase(i) = .true. - - ! assign number of steps for iteration - ! use 2 steps following Song and Zhang, 2011, J. Clim. - iter = 2 - - !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc - ! iteration - !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc - - do it=1,iter - - ! initialize sub-step microphysical tendencies - do k=1,pver - qctend(i,k)=0._r8 - qitend(i,k)=0._r8 - qnitend(i,k)=0._r8 - qrtend(i,k)=0._r8 - nctend(i,k)=0._r8 - nitend(i,k)=0._r8 - nrtend(i,k)=0._r8 - nstend(i,k)=0._r8 - rprd(i,k) = 0._r8 - sprd(i,k) = 0._r8 - frz(i,k) = 0._r8 - qniic(i,k)=0._r8 - qric(i,k)=0._r8 - nsic(i,k)=0._r8 - nric(i,k)=0._r8 - qiic(i,k)=0._r8 - qcic(i,k)=0._r8 - niic(i,k)=0._r8 - ncic(i,k)=0._r8 - qcimp(k) = .false. - ncimp(k) = .false. - qiimp(k) = .false. - niimp(k) = .false. - dum2l(i,k)=0._r8 - dum2i(i,k)=0._r8 - autolm(i,k) = 0._r8 - accrlm(i,k) = 0._r8 - bergnm(i,k) = 0._r8 - fhtimm(i,k) = 0._r8 - fhtctm(i,k) = 0._r8 - fhmlm (i,k) = 0._r8 - fholm (i,k) = 0._r8 - hmpim (i,k) = 0._r8 - accslm(i,k) = 0._r8 - dlfm (i,k) = 0._r8 - - autoln(i,k) = 0._r8 - accrln(i,k) = 0._r8 - bergnn(i,k) = 0._r8 - fhtimn(i,k) = 0._r8 - fhtctn(i,k) = 0._r8 - fhmln (i,k) = 0._r8 - fholn (i,k) = 0._r8 - accsln(i,k) = 0._r8 - activn(i,k) = 0._r8 - dlfn (i,k) = 0._r8 - ncadj (i,k) = 0._r8 - - autoim(i,k) = 0._r8 - accsim(i,k) = 0._r8 - difm (i,k) = 0._r8 - - nuclin(i,k) = 0._r8 - autoin(i,k) = 0._r8 - accsin(i,k) = 0._r8 - hmpin (i,k) = 0._r8 - difn (i,k) = 0._r8 - niadj (i,k) = 0._r8 - - trspcm(i,k) = 0._r8 - trspcn(i,k) = 0._r8 - trspim(i,k) = 0._r8 - trspin(i,k) = 0._r8 - - fhmrm (i,k) = 0._r8 - end do - - do k = pver,msg+2,-1 - - es(i,k) = svp_water(t(i,k)) ! over water in mixed clouds - esi(i,k) = svp_ice(t(i,k)) ! over ice - - if (k > jt(i) .and. k <= jb(i) .and. eps0(i) > 0._r8 & - .and.mu(i,k).gt.0._r8 .and. mu(i,k-1).gt.0._r8) then - - ! initialize precip fallspeeds to zero - if (it.eq.1) then - ums(k)=0._r8 - uns(k)=0._r8 - umr(k)=0._r8 - unr(k)=0._r8 - prf(k)=0._r8 - pnrf(k)=0._r8 - psf(k) =0._r8 - pnsf(k) = 0._r8 - end if - ttend(k)=0._r8 - nnuccd(k)=0._r8 - npccn(k)=0._r8 - - !************************************************************************************ - ! obtain values of cloud water/ice mixing ratios and number concentrations in updraft - ! for microphysical process calculations - ! units are kg/kg for mixing ratio, 1/kg for number conc - !************************************************************************************ - - - if (it.eq.1) then - qcic(i,k) = qc(i,k) - qiic(i,k) = qi(i,k) - ncic(i,k) = nc(i,k) - niic(i,k) = ni(i,k) - qniic(i,k)= qni(i,k) - qric(i,k) = qr(i,k) - nsic(i,k) = ns(i,k) - nric(i,k) = nr(i,k) - else - if (k.le.kqc(i)) then - qcic(i,k) = qc(i,k) - ncic(i,k) = nc(i,k) - - ! consider rain falling from above - flxrm = 0._r8 - mvtrm = 0._r8 - flxrn = 0._r8 - mvtrn = 0._r8 - nlr = 0 - - do kk= k,jt(i)+3,-1 - if (qr(i,kk-1) .gt. 0._r8) then - nlr = nlr + 1 - flxrm = flxrm + umr(kk-1)*qr(i,kk-1)*arcf(i,kk-1) - flxrn = flxrn + unr(kk-1)*nr(i,kk-1)*arcf(i,kk-1) - mvtrm = mvtrm + umr(kk-1)*arcf(i,kk-1) - mvtrn = mvtrn + unr(kk-1)*arcf(i,kk-1) - end if - end do - if (mvtrm.gt.0) then - qric(i,k) = (qr(i,k)*mu(i,k)+flxrm)/(mu(i,k)+mvtrm) - else - qric(i,k) = qr(i,k) - end if - if (mvtrn.gt.0) then - nric(i,k) = (nr(i,k)*mu(i,k)+flxrn)/(mu(i,k)+mvtrn) - else - nric(i,k) = nr(i,k) - end if - - end if - if (k.eq.kqc(i)) then - qcic(i,k) = qc(i,k-1) - ncic(i,k) = nc(i,k-1) - end if - if(k.le.kqi(i)) then - qiic(i,k) = qi(i,k) - niic(i,k) = ni(i,k) -! consider snow falling from above - flxsm = 0._r8 - mvtsm = 0._r8 - flxsn = 0._r8 - mvtsn = 0._r8 - nls = 0 - - do kk= k,jt(i)+3,-1 - if (qni(i,kk-1) .gt. 0._r8) then - nls = nls + 1 - flxsm = flxsm + ums(kk-1)*qni(i,kk-1)*arcf(i,kk-1) - mvtsm = mvtsm + ums(kk-1)*arcf(i,kk-1) - flxsn = flxsn + uns(kk-1)*ns(i,kk-1)*arcf(i,kk-1) - mvtsn = mvtsn + uns(kk-1)*arcf(i,kk-1) - end if - end do - - if (mvtsm.gt.0) then - qniic(i,k) = (qni(i,k)*mu(i,k)+flxsm)/(mu(i,k)+mvtsm) - else - qniic(i,k) = qni(i,k) - end if - if (mvtsn.gt.0) then - nsic(i,k) = (ns(i,k)*mu(i,k)+flxsn)/(mu(i,k)+mvtsn) - else - nsic(i,k) = ns(i,k) - end if - end if - if(k.eq.kqi(i)) then - qiic(i,k) = qi(i,k-1) - niic(i,k) = ni(i,k-1) - end if - end if - - !********************************************************************** - ! boundary condition for cloud liquid water and cloud ice - !*********************************************************************** - - ! boundary condition for provisional cloud water - if (cmel(i,k-1).gt.qsmall .and. lcbase(i) .and. it.eq.1 ) then - kqc(i) = k - lcbase(i) = .false. - qcic(i,k) = dz(i,k)*cmel(i,k-1)/(mu(i,k-1)+dz(i,k)*du(i,k-1)) - ncic(i,k) = qcic(i,k)/(4._r8/3._r8*pi*10.e-6_r8**3*rhow) - end if - - ! boundary condition for provisional cloud ice - if (qiic(i,k).gt.qsmall .and. libase(i) .and. it.eq.1 ) then - kqi(i) = k - libase(i) = .false. - else if ( cmei(i,k-1).gt.qsmall .and. & - cmei(i,k).lt.qsmall .and. k.le.jb(i) .and. libase(i) .and. it.eq.1 ) then - kqi(i)=k - libase(i) = .false. - qiic(i,k) = dz(i,k)*cmei(i,k-1)/(mu(i,k-1)+dz(i,k)*du(i,k-1)) - niic(i,k) = qiic(i,k)/(4._r8/3._r8*pi*25.e-6_r8**3*rhoi) - end if - - !*************************************************************************** - ! get size distribution parameters based on in-cloud cloud water/ice - ! these calculations also ensure consistency between number and mixing ratio - !*************************************************************************** - ! cloud ice - if (qiic(i,k).ge.qsmall) then - - ! add upper limit to in-cloud number concentration to prevent numerical error - niic(i,k)=min(niic(i,k),qiic(i,k)*1.e20_r8) - lami(k) = (gamma(1._r8+di)*ci* & - niic(i,k)/qiic(i,k))**(1._r8/di) - n0i(k) = niic(i,k)*lami(k) - - ! check for slope - lammax = 1._r8/10.e-6_r8 - lammin = 1._r8/(2._r8*dcs) - - ! adjust vars - if (lami(k).lt.lammin) then - lami(k) = lammin - n0i(k) = lami(k)**(di+1._r8)*qiic(i,k)/(ci*gamma(1._r8+di)) - niic(i,k) = n0i(k)/lami(k) - else if (lami(k).gt.lammax) then - lami(k) = lammax - n0i(k) = lami(k)**(di+1._r8)*qiic(i,k)/(ci*gamma(1._r8+di)) - niic(i,k) = n0i(k)/lami(k) - end if - else - lami(k) = 0._r8 - n0i(k) = 0._r8 - end if - - ! cloud water - if (qcic(i,k).ge.qsmall) then - - ! add upper limit to in-cloud number concentration to prevent numerical error - ncic(i,k)=min(ncic(i,k),qcic(i,k)*1.e20_r8) - - ! get pgam from fit to observations of martin et al. 1994 - - pgam(i,k)=0.0005714_r8*(ncic(i,k)/1.e6_r8/rho(i,k))+0.2714_r8 - pgam(i,k)=1._r8/(pgam(i,k)**2)-1._r8 - pgam(i,k)=max(pgam(i,k),2._r8) - pgam(i,k)=min(pgam(i,k),15._r8) - - ! calculate lamc - lamc(i,k) = (pi/6._r8*rhow*ncic(i,k)*gamma(pgam(i,k)+4._r8)/ & - (qcic(i,k)*gamma(pgam(i,k)+1._r8)))**(1._r8/3._r8) - - ! lammin, 50 micron diameter max mean size - lammin = (pgam(i,k)+1._r8)/40.e-6_r8 - lammax = (pgam(i,k)+1._r8)/1.e-6_r8 - - if (lamc(i,k).lt.lammin) then - lamc(i,k) = lammin - ncic(i,k) = 6._r8*lamc(i,k)**3*qcic(i,k)* & - gamma(pgam(i,k)+1._r8)/ & - (pi*rhow*gamma(pgam(i,k)+4._r8)) - else if (lamc(i,k).gt.lammax) then - lamc(i,k) = lammax - ncic(i,k) = 6._r8*lamc(i,k)**3*qcic(i,k)* & - gamma(pgam(i,k)+1._r8)/ & - (pi*rhow*gamma(pgam(i,k)+4._r8)) - end if - - ! parameter to calculate droplet freezing - - cdist1(k) = ncic(i,k)/gamma(pgam(i,k)+1._r8) - else - lamc(i,k) = 0._r8 - cdist1(k) = 0._r8 - end if - - ! boundary condition for cloud liquid water - if ( kqc(i) .eq. k ) then - qc(i,k) = 0._r8 - nc(i,k) = 0._r8 - end if - - ! boundary condition for cloud ice - if (kqi(i).eq.k ) then - qi(i,k) = 0._r8 - ni(i,k) = 0._r8 - end if - - !************************************************************************** - ! begin micropysical process calculations - !************************************************************************** - - !................................................................. - ! autoconversion of cloud liquid water to rain - ! formula from Khrouditnov and Kogan (2000) - ! minimum qc of 1 x 10^-8 prevents floating point error - - if (qcic(i,k).ge.1.e-8_r8) then - - ! nprc is increase in rain number conc due to autoconversion - ! nprc1 is decrease in cloud droplet conc due to autoconversion - ! Khrouditnov and Kogan (2000) -! prc(k) = 1350._r8*qcic(i,k)**2.47_r8* & -! (ncic(i,k)/1.e6_r8*rho(i,k))**(-1.79_r8) - - ! Liu and Daum(2004)(modified), Wood(2005) - rmean = 1.e6_r8*((qcic(i,k)/ncic(i,k))/(4._r8/3._r8*pi*rhow))**(1._r8/3._r8) - - if (rmean .ge. 15._r8) then - - beta6 = (1._r8+3._r8/rmean)**(1._r8/3._r8) - beta66 = (1._r8+3._r8/rmean)**2._r8 - r6 = beta6*rmean - r6c = 7.5_r8/(r6**0.5_r8*(qcic(i,k)*rho(i,k))**(1._r8/6._r8)) - prc(k) = 1.3e9_r8*beta66*(qcic(i,k)*rho(i,k))**3._r8/ & - (ncic(i,k)*rho(i,k))*max(0._r8,r6-r6c)/rho(i,k) - - nprc1(k) = prc(k)/(qcic(i,k)/ncic(i,k)) - nprc(k) = nprc1(k)*0.5_r8 - else - prc(k)=0._r8 - nprc(k)=0._r8 - nprc1(k)=0._r8 - end if - else - prc(k)=0._r8 - nprc(k)=0._r8 - nprc1(k)=0._r8 - end if - - ! provisional rain mixing ratio and number concentration (qric and nric) - ! at boundary are estimated via autoconversion - - if (k.eq.kqc(i) .and. it.eq.1) then - qric(i,k) = prc(k)*dz(i,k)/0.55_r8 - nric(i,k) = nprc(k)*dz(i,k)/0.55_r8 - qr(i,k) = 0.0_r8 - nr(i,k) = 0.0_r8 - end if - - !....................................................................... - ! Autoconversion of cloud ice to snow - ! similar to Ferrier (1994) - - call ice_autoconversion(t(i,k), qiic(i,k), lami(k), n0i(k), dcs, prci(k), nprci(k), 1) - - ! provisional snow mixing ratio and number concentration (qniic and nsic) - ! at boundary are estimated via autoconversion - - if (k.eq.kqi(i) .and. it.eq.1) then - qniic(i,k)= prci(k)*dz(i,k)*0.25_r8 - nsic(i,k)= nprci(k)*dz(i,k)*0.25_r8 - qni(i,k)= 0.0_r8 - ns(i,k)= 0.0_r8 - end if - - ! if precip mix ratio is zero so should number concentration - if (qniic(i,k).lt.qsmall) then - qniic(i,k)=0._r8 - nsic(i,k)=0._r8 - end if - if (qric(i,k).lt.qsmall) then - qric(i,k)=0._r8 - nric(i,k)=0._r8 - end if - - ! make sure number concentration is a positive number to avoid - ! taking root of negative later - nric(i,k)=max(nric(i,k),0._r8) - nsic(i,k)=max(nsic(i,k),0._r8) - - !********************************************************************** - ! get size distribution parameters for precip - !********************************************************************** - ! rain - - if (qric(i,k).ge.qsmall) then - lamr(k) = (pi*rhow*nric(i,k)/qric(i,k))**(1._r8/3._r8) - n0r(k) = nric(i,k)*lamr(k) - - ! check for slope - lammax = 1._r8/150.e-6_r8 - lammin = 1._r8/3000.e-6_r8 - - ! adjust vars - if (lamr(k).lt.lammin) then - lamr(k) = lammin - n0r(k) = lamr(k)**4*qric(i,k)/(pi*rhow) - nric(i,k) = n0r(k)/lamr(k) - else if (lamr(k).gt.lammax) then - lamr(k) = lammax - n0r(k) = lamr(k)**4*qric(i,k)/(pi*rhow) - nric(i,k) = n0r(k)/lamr(k) - end if - - ! provisional rain number and mass weighted mean fallspeed (m/s) - ! Eq.18 of Morrison and Gettelman, 2008, J. Climate - unr(k) = min(arn(i,k)*gamma(1._r8+br)/lamr(k)**br,10._r8) - umr(k) = min(arn(i,k)*gamma(4._r8+br)/(6._r8*lamr(k)**br),10._r8) - else - lamr(k) = 0._r8 - n0r(k) = 0._r8 - umr(k) = 0._r8 - unr(k) = 0._r8 - end if - - !...................................................................... - ! snow - if (qniic(i,k).ge.qsmall) then - lams(k) = (gamma(1._r8+ds)*cs*nsic(i,k)/ & - qniic(i,k))**(1._r8/ds) - n0s(k) = nsic(i,k)*lams(k) - - ! check for slope - lammax = 1._r8/10.e-6_r8 - lammin = 1._r8/2000.e-6_r8 - - ! adjust vars - if (lams(k).lt.lammin) then - lams(k) = lammin - n0s(k) = lams(k)**(ds+1._r8)*qniic(i,k)/(cs*gamma(1._r8+ds)) - nsic(i,k) = n0s(k)/lams(k) - else if (lams(k).gt.lammax) then - lams(k) = lammax - n0s(k) = lams(k)**(ds+1._r8)*qniic(i,k)/(cs*gamma(1._r8+ds)) - nsic(i,k) = n0s(k)/lams(k) - end if - - ! provisional snow number and mass weighted mean fallspeed (m/s) - ums(k) = min(asn(i,k)*gamma(4._r8+bs)/(6._r8*lams(k)**bs),3.6_r8) - uns(k) = min(asn(i,k)*gamma(1._r8+bs)/lams(k)**bs,3.6_r8) - else - lams(k) = 0._r8 - n0s(k) = 0._r8 - ums(k) = 0._r8 - uns(k) = 0._r8 - end if - - !....................................................................... - ! snow self-aggregation from passarelli, 1978, used by Reisner(1998,Eq.A.35) - ! this is hard-wired for bs = 0.4 for now - ! ignore self-collection of cloud ice - - call snow_self_aggregation(t(i,k), rho(i,k), asn(i,k), rhosn, qniic(i,k), nsic(i,k), nsagg(k), 1) - - !....................................................................... - ! accretion of cloud droplets onto snow/graupel - ! here use continuous collection equation with - ! simple gravitational collection kernel - ! ignore collisions between droplets/cloud ice - - ! ignore collision of snow with droplets above freezing - - call accrete_cloud_water_snow(t(i,k), rho(i,k), asn(i,k), uns(k), mua(i,k), & - qcic(i,k), ncic(i,k), qniic(i,k), pgam(i,k), lamc(i,k), lams(k), n0s(k), & - psacws(k), npsacws(k), 1) - - ! secondary ice production due to accretion of droplets by snow - ! (Hallet-Mossop process) (from Cotton et al., 1986) - - call secondary_ice_production(t(i,k), psacws(k), msacwi(k), nsacwi(k), 1) - - !....................................................................... - ! accretion of rain water by snow - ! formula from ikawa and saito, 1991, used by reisner et al., 1998 - - call accrete_rain_snow(t(i,k), rho(i,k), umr(k), ums(k), unr(k), uns(k), qric(i,k), & - qniic(i,k), lamr(k), n0r(k), lams(k), n0s(k), pracs(k), npracs(k), 1 ) - - !....................................................................... - ! heterogeneous freezing of rain drops - ! follows from Bigg (1953) - - call heterogeneous_rain_freezing(t(i,k), qric(i,k), nric(i,k), lamr(k), mnuccr(k), nnuccr(k), 1) - - !....................................................................... - ! accretion of cloud liquid water by rain - ! formula from Khrouditnov and Kogan (2000) - ! gravitational collection kernel, droplet fall speed neglected - - call accrete_cloud_water_rain(.true., qric(i,k), qcic(i,k), ncic(i,k), [1._r8], [0._r8], pra(k), npra(k), 1) - - !....................................................................... - ! Self-collection of rain drops - ! from Beheng(1994) - - call self_collection_rain(rho(i,k), qric(i,k), nric(i,k), nragg(k), 1) - - !....................................................................... - ! Accretion of cloud ice by snow - ! For this calculation, it is assumed that the Vs >> Vi - ! and Ds >> Di for continuous collection - - call accrete_cloud_ice_snow(t(i,k), rho(i,k), asn(i,k), qiic(i,k), niic(i,k), & - qniic(i,k), lams(k), n0s(k), prai(k), nprai(k), 1) - - !....................................................................... - ! fallout term - prf(k) = -umr(k)*qric(i,k)/dz(i,k) - pnrf(k) = -unr(k)*nric(i,k)/dz(i,k) - psf(k) = -ums(k)*qniic(i,k)/dz(i,k) - pnsf(k) = -uns(k)*nsic(i,k)/dz(i,k) - - !........................................................................ - ! calculate vertical velocity in cumulus updraft - - if (k.eq.jb(i)) then - zkine(i,jb(i)) = 0.5_r8 - wu (i,jb(i)) = 1._r8 - zbuo (i,jb(i)) = (tu(i,jb(i))*(1._r8+retv*qu(i,jb(i)))- & - th(i,jb(i))*(1._r8+retv*qh(i,jb(i))))/ & - (th(i,jb(i))*(1._r8+retv*qh(i,jb(i)))) - else - if (.true.) then - ! ECMWF formula - zbc = tu(i,k)*(1._r8+retv*qu(i,k)-qr(i,k)-qni(i,k)-qi(i,k)-qc(i,k)) - zbe = th(i,k)*(1._r8+retv*qh(i,k)) - zbuo(i,k) = (zbc-zbe)/zbe - zbuoc= (zbuo(i,k)+zbuo(i,k+1))*0.5_r8 - zdkbuo = dz(i,k+1)*grav*zfacbuo*zbuoc - zdken = min(.99_r8,(1._r8+cwdrag)*max(du(i,k),eu(i,k))*dz(i,k+1)/ & - max(1.e-10_r8,mu(i,k+1))) - zkine(i,k) = (zkine(i,k+1)*(1._r8-zdken)+zdkbuo)/ & - (1._r8+zdken) - else - ! Gregory formula - zbc = tu(i,k)*(1._r8+retv*qu(i,k)) - zbe = th(i,k)*(1._r8+retv*qh(i,k)) - zbuo(i,k) = (zbc-zbe)/zbe-qr(i,k)-qni(i,k)-qi(i,k)-qc(i,k) - zbuoc= (zbuo(i,k)+zbuo(i,k+1))*0.5_r8 - zdkbuo = dz(i,k+1)*grav*zbuoc*(1.0_r8-0.25_r8)/6._r8 - zdken = du(i,k)*dz(i,k+1)/max(1.e-10_r8,mu(i,k+1)) - zkine(i,k) = (zkine(i,k+1)*(1._r8-zdken)+zdkbuo)/ & - (1._r8+zdken) - end if - wu(i,k) = min(15._r8,sqrt(2._r8*max(0.1_r8,zkine(i,k) ))) - end if - - arcf(i,k)= mu(i,k)/wu(i,k) - - !............................................................................ - ! droplet activation - ! calculate potential for droplet activation if cloud water is present - ! formulation from Abdul-Razzak and Ghan (2000) and Abdul-Razzak et al. (1998), AR98 - - if (aero%scheme == 'bulk') then - naer2h(i,k,:) = 0.5_r8*(naer2(i,k,:) + naer2(i,k-1,:)) - end if - - ntaerh(i,k) = 0.5_r8*(ntaer(i,k) + ntaer(i,k-1)) - - if (qcic(i,k).ge.qsmall ) then - - if (aero%scheme == 'modal') then - - nlsrc = 0._r8 - - do m = 1, aero%nmodes - vaerosol(m) = 0._r8 - hygro(m) = 0._r8 - do l = 1, aero%nspec(m) - vol = max(0.5_r8*(aero%mmrg_a(i,k,l,m)+aero%mmrg_a(i,k-1,l,m)) , 0._r8)/aero%specdens(l,m) - vaerosol(m) = vaerosol(m) + vol - hygro(m) = hygro(m) + vol*aero%spechygro(l,m) - end do - if (vaerosol(m) > 1.0e-30_r8) then - hygro(m) = hygro(m)/(vaerosol(m)) - vaerosol(m) = vaerosol(m)*rho(i,k) - else - hygro(m) = 0.0_r8 - vaerosol(m) = 0.0_r8 - endif - naermod(m) = 0.5_r8*(aero%numg_a(i,k,m)+aero%numg_a(i,k-1,m))*rho(i,k) - naermod(m) = max(naermod(m), vaerosol(m)*aero%voltonumbhi(m)) - naermod(m) = min(naermod(m), vaerosol(m)*aero%voltonumblo(m)) - end do - - in_cloud = (k < jb(i)) - smax_f = 0.0_r8 - if (in_cloud) then - if ( qcic(i,k).ge.qsmall ) & - smax_f = ncic(i,k)/lamc(i,k) * gamma(2.0_r8 + pgam(i,k))/gamma(1.0_r8 + pgam(i,k)) - if ( qric(i,k).ge.qsmall) smax_f = smax_f + nric(i,k)/lamr(k) - - end if - - call activate_aerosol( & - wu(i,k), wmix, wdiab, wmin, wmax, & - t(i,k), rho(i,k), naermod, aero%nmodes, vaerosol, & - hygro, aero_props_obj, fn, fm, & - fluxn, fluxm, flux_fullact, in_cloud_in=in_cloud, smax_f=smax_f) - - do m = 1, aero%nmodes - nlsrc = nlsrc + fn(m)*naermod(m) ! number nucleated - end do - - if (nlsrc .ne. nlsrc) then - write(iulog,*) "nlsrc=",nlsrc,"wu(i,k)=",wu(i,k) - write(iulog,*) "fn(m)=",fn,"naermod(m)=",naermod,"aero%specdens(l,m)=",aero%specdens - write(iulog,*) "vaerosol(m)=",vaerosol,"aero%voltonumbhi(m)=",aero%voltonumbhi - write(iulog,*) "aero%voltonumblo(m)=",aero%voltonumblo,"k=",k,"i=",i - write(iulog,*) "aero%numg_a(i,k,m)=",aero%numg_a(i,k,:),"rho(i,k)=",rho(i,k) - write(iulog,*) "aero%mmrg_a(i,k,l,m)=",aero%mmrg_a(i,k,:,:) - end if - - dum2l(i,k) = nlsrc - - else if (aero%scheme == 'bulk') then - - call ndrop_bam_run( & - wu(i,k), t(i,k), rho(i,k), naer2h(i,k,:), aero%nbulk, & - aero%nbulk, maerosol, dum2) - - dum2l(i,k) = dum2 - - end if - - else - dum2l(i,k) = 0._r8 - end if - - ! get droplet activation rate - if (qcic(i,k).ge.qsmall .and. t(i,k).gt.238.15_r8 .and. k.gt.jt(i)+2 ) then - - ! assume aerosols already activated are equal number of existing droplets for simplicity - if (k.eq.kqc(i)) then - npccn(k) = dum2l(i,k)/deltat - else - npccn(k) = (dum2l(i,k)-ncic(i,k))/deltat - end if - - ! make sure number activated > 0 - npccn(k) = max(0._r8,npccn(k)) - ncmax = dum2l(i,k) - else - npccn(k)=0._r8 - ncmax = 0._r8 - end if - - !.............................................................................. - !ice nucleation - es(i,k) = svp_water(t(i,k)) ! over water in mixed clouds - esi(i,k) = svp_ice(t(i,k)) ! over ice - qs(i,k) = 0.622_r8*es(i,k)/(ph(i,k) - (1.0_r8-0.622_r8)*es(i,k)) - qs(i,k) = min(1.0_r8,qs(i,k)) - if (qs(i,k) < 0.0_r8) qs(i,k) = 1.0_r8 - - relhum(i,k)= 1.0_r8 - - if (t(i,k).lt.tmelt ) then - - ! compute aerosol number for so4, soot, and dust with units #/cm^3 - so4_num = 0._r8 - soot_num = 0._r8 - dst1_num = 0._r8 - dst2_num = 0._r8 - dst3_num = 0._r8 - dst4_num = 0._r8 - - if (aero%scheme == 'modal') then - - !For modal aerosols, assume for the upper troposphere: - ! soot = accumulation mode - ! sulfate = aiken mode - ! dust = coarse mode - ! since modal has internal mixtures. - soot_num = 0.5_r8*(aero%numg_a(i,k-1,aero%mode_accum_idx) & - +aero%numg_a(i,k,aero%mode_accum_idx))*rho(i,k)*1.0e-6_r8 - dmc = 0.5_r8*(aero%mmrg_a(i,k-1,aero%coarse_dust_idx,aero%mode_coarse_idx) & - +aero%mmrg_a(i,k,aero%coarse_dust_idx,aero%mode_coarse_idx)) - ssmc = 0.5_r8*(aero%mmrg_a(i,k-1,aero%coarse_nacl_idx,aero%mode_coarse_idx) & - +aero%mmrg_a(i,k,aero%coarse_nacl_idx,aero%mode_coarse_idx)) - if (dmc > 0._r8) then - dst_num = dmc/(ssmc + dmc) *(aero%numg_a(i,k-1,aero%mode_coarse_idx) & - + aero%numg_a(i,k,aero%mode_coarse_idx))*0.5_r8*rho(i,k)*1.0e-6_r8 - else - dst_num = 0.0_r8 - end if - dgnum_aitken = 0.5_r8*(aero%dgnumg(i,k,aero%mode_aitken_idx)+ & - aero%dgnumg(i,k-1,aero%mode_aitken_idx)) - if (dgnum_aitken > 0._r8) then - ! only allow so4 with D>0.1 um in ice nucleation - so4_num = 0.5_r8*(aero%numg_a(i,k-1,aero%mode_aitken_idx)+ & - aero%numg_a(i,k,aero%mode_aitken_idx))*rho(i,k)*1.0e-6_r8 & - * (0.5_r8 - 0.5_r8*erf(log(0.1e-6_r8/dgnum_aitken)/ & - (2._r8**0.5_r8*log(aero%sigmag_aitken)))) - else - so4_num = 0.0_r8 - end if - so4_num = max(0.0_r8, so4_num) - - else if (aero%scheme == 'bulk') then - - if (aero%idxsul > 0) then - so4_num = naer2h(i,k,aero%idxsul)/25._r8 *1.0e-6_r8 - end if - if (aero%idxbcphi > 0) then - soot_num = naer2h(i,k,aero%idxbcphi)/25._r8 *1.0e-6_r8 - end if - if (aero%idxdst1 > 0) then - dst1_num = naer2h(i,k,aero%idxdst1)/25._r8 *1.0e-6_r8 - end if - if (aero%idxdst2 > 0) then - dst2_num = naer2h(i,k,aero%idxdst2)/25._r8 *1.0e-6_r8 - end if - if (aero%idxdst3 > 0) then - dst3_num = naer2h(i,k,aero%idxdst3)/25._r8 *1.0e-6_r8 - end if - if (aero%idxdst4 > 0) then - dst4_num = naer2h(i,k,aero%idxdst4)/25._r8 *1.0e-6_r8 - end if - dst_num = dst1_num + dst2_num + dst3_num + dst4_num - - end if - - ! *** Turn off soot nucleation *** - soot_num = 0.0_r8 - - ! Liu et al.,J. climate, 2007 - if ( wu(i,k) .lt. 4.0_r8) then - call nucleati( & - wu(i,k), t(i,k), ph(i,k), relhum(i,k), 1.0_r8, qcic(i,k), & - 1.0e-20_r8, 0.0_r8, rho(i,k), so4_num, dst_num, soot_num, 1.0_r8, & - dum2i(i,k), nihf(i,k), niimm(i,k), nidep(i,k), nimey(i,k), & - wpice, weff, fhom, temp1, temp2, temp3, temp4, .true. ) - end if - nihf(i,k)=nihf(i,k)*rho(i,k) ! convert from #/kg -> #/m3) - niimm(i,k)=niimm(i,k)*rho(i,k) - nidep(i,k)=nidep(i,k)*rho(i,k) - nimey(i,k)=nimey(i,k)*rho(i,k) - - if (.false.) then - ! cooper curve (factor of 1000 is to convert from L-1 to m-3) - !dum2i(i,k)=0.005_r8*exp(0.304_r8*(273.15_r8-t(i,k)))*1000._r8 - - ! put limit on number of nucleated crystals, set to number at T=-30 C - ! cooper (limit to value at -35 C) - !dum2i(i,k)=min(dum2i(i,k),208.9e3_r8)/rho(i,k) ! convert from m-3 to kg-1 - end if - - else - dum2i(i,k)=0._r8 - end if - - ! ice nucleation if activated nuclei exist at t<0C - - if (dum2i(i,k).gt.0._r8.and.t(i,k).lt.tmelt.and. & - relhum(i,k)*es(i,k)/esi(i,k).gt. 1.05_r8 .and. k.gt.jt(i)+1) then - - if (k.eq.kqi(i)) then - nnuccd(k)=dum2i(i,k)/deltat - else - nnuccd(k)=(dum2i(i,k)-niic(i,k))/deltat - end if - nnuccd(k)=max(nnuccd(k),0._r8) - - !Calc mass of new particles using new crystal mass... - !also this will be multiplied by mtime as nnuccd is... - - mnuccd(k) = nnuccd(k) * mi0 - else - nnuccd(k)=0._r8 - mnuccd(k) = 0._r8 - end if - - !................................................................................ - ! Bergeron process - ! If 0C< T <-40C and both ice and liquid exist - - if (t(i,k).le.273.15_r8 .and. t(i,k).gt.233.15_r8 .and. & - qiic(i,k).gt.0.5e-6_r8 .and. qcic(i,k).gt. qsmall) then - plevap = qcic(i,k)/bergtsf - prb(k) = max(0._r8,plevap) - nprb(k) = prb(k)/(qcic(i,k)/ncic(i,k)) - else - prb(k)=0._r8 - nprb(k)=0._r8 - end if - - !................................................................................ - ! heterogeneous freezing of cloud water (-5C < T < -35C) - - if (qcic(i,k).ge.qsmall .and.ncic(i,k).gt.0._r8 .and. ntaerh(i,k).gt.0._r8 .and. & - t(i,k).le.268.15_r8 .and. t(i,k).gt.238.15_r8 ) then - - if (aero%scheme == 'bulk') then - ! immersion freezing (Diehl and Wurzler, 2004) - ttend(k) = -grav*wu(i,k)/cp/(1.0_r8+gamhat(i,k)) - - nai_bcphi = 0.0_r8 - nai_dst1 = 0.0_r8 - nai_dst2 = 0.0_r8 - nai_dst3 = 0.0_r8 - nai_dst4 = 0.0_r8 - - if (aero%idxbcphi > 0) nai_bcphi = naer2h(i,k,aero%idxbcphi) - if (aero%idxdst1 > 0) nai_dst1 = naer2h(i,k,aero%idxdst1) - if (aero%idxdst2 > 0) nai_dst2 = naer2h(i,k,aero%idxdst2) - if (aero%idxdst3 > 0) nai_dst3 = naer2h(i,k,aero%idxdst3) - if (aero%idxdst4 > 0) nai_dst4 = naer2h(i,k,aero%idxdst4) - - naimm = (0.00291_r8*nai_bcphi + 32.3_r8*(nai_dst1 + nai_dst2 + & - nai_dst3 + nai_dst4))/ntaerh(i,k) !m-3 - if (ttend(k) .lt. 0._r8) then - nnuccc(k) = -naimm*exp(273.15_r8-t(i,k))*ttend(k)*qcic(i,k)/rhow ! kg-1s-1 - mnuccc(k) = nnuccc(k)*qcic(i,k)/ncic(i,k) - end if - else - if (.false.) then - ! immersion freezing (Diehl and Wurzler, 2004) - ttend(k) = -grav*wu(i,k)/cp/(1.0_r8+gamhat(i,k)) - naimm = (0.00291_r8*soot_num + 32.3_r8*dst_num )*1.0e6_r8/ntaerh(i,k) !m-3 - if (ttend(k) .lt. 0._r8) then - nnuccc(k) = -naimm*exp(273.15_r8-t(i,k))*ttend(k)*qcic(i,k)/rhow ! kg-1s-1 - mnuccc(k) = nnuccc(k)*qcic(i,k)/ncic(i,k) - end if - else - ! immersion freezing (Bigg, 1953) - mnuccc(k) = pi*pi/36._r8*rhow* & - cdist1(k)*gamma(7._r8+pgam(i,k))* & - bimm*(exp(aimm*(273.15_r8-t(i,k)))-1._r8)/ & - lamc(i,k)**3/lamc(i,k)**3 - - nnuccc(k) = pi/6._r8*cdist1(k)*gamma(pgam(i,k)+4._r8) & - *bimm*(exp(aimm*(273.15_r8-t(i,k)))-1._r8)/lamc(i,k)**3 - end if - end if - - ! contact freezing (Young, 1974) with hooks into simulated dust - - tcnt=(270.16_r8-t(i,k))**1.3_r8 - viscosity=1.8e-5_r8*(t(i,k)/298.0_r8)**0.85_r8 ! Viscosity (kg/m/s) - mfp=2.0_r8*viscosity/(ph(i,k) & ! Mean free path (m) - *sqrt(8.0_r8*28.96e-3_r8/(pi*8.314409_r8*t(i,k)))) - - slip1=1.0_r8+(mfp/rn_dst1)*(1.257_r8+(0.4_r8*Exp(-(1.1_r8*rn_dst1/mfp))))! Slip correction factor - slip2=1.0_r8+(mfp/rn_dst2)*(1.257_r8+(0.4_r8*Exp(-(1.1_r8*rn_dst2/mfp)))) - slip3=1.0_r8+(mfp/rn_dst3)*(1.257_r8+(0.4_r8*Exp(-(1.1_r8*rn_dst3/mfp)))) - slip4=1.0_r8+(mfp/rn_dst4)*(1.257_r8+(0.4_r8*Exp(-(1.1_r8*rn_dst4/mfp)))) - - dfaer1=1.381e-23_r8*t(i,k)*slip1/(6._r8*pi*viscosity*rn_dst1) ! aerosol diffusivity (m2/s) - dfaer2=1.381e-23_r8*t(i,k)*slip2/(6._r8*pi*viscosity*rn_dst2) - dfaer3=1.381e-23_r8*t(i,k)*slip3/(6._r8*pi*viscosity*rn_dst3) - dfaer4=1.381e-23_r8*t(i,k)*slip4/(6._r8*pi*viscosity*rn_dst4) - - nacon1=0.0_r8 - nacon2=0.0_r8 - nacon3=0.0_r8 - nacon4=0.0_r8 - - if (aero%scheme == 'modal') then - - ! For modal aerosols: - ! use size '3' for dust coarse mode... - ! scale by dust fraction in coarse mode - - dmc = 0.5_r8*(aero%mmrg_a(i,k,aero%coarse_dust_idx,aero%mode_coarse_idx) & - +aero%mmrg_a(i,k-1,aero%coarse_dust_idx,aero%mode_coarse_idx)) - ssmc = 0.5_r8*(aero%mmrg_a(i,k,aero%coarse_nacl_idx,aero%mode_coarse_idx) & - +aero%mmrg_a(i,k-1,aero%coarse_nacl_idx,aero%mode_coarse_idx)) - if (dmc > 0.0_r8) then - nacon3 = dmc/(ssmc + dmc) * (aero%numg_a(i,k,aero%mode_coarse_idx) & - + aero%numg_a(i,k-1,aero%mode_coarse_idx))*0.5_r8*rho(i,k) - end if - - else if (aero%scheme == 'bulk') then - - if (aero%idxdst1.gt.0) then - nacon1=naer2h(i,k,aero%idxdst1)*tcnt *0.0_r8 - endif - if (aero%idxdst2.gt.0) then - nacon2=naer2h(i,k,aero%idxdst2)*tcnt ! 1/m3 - endif - if (aero%idxdst3.gt.0) then - nacon3=naer2h(i,k,aero%idxdst3)*tcnt - endif - if (aero%idxdst4.gt.0) then - nacon4=naer2h(i,k,aero%idxdst4)*tcnt - endif - end if - - mnucct(k) = (dfaer1*nacon1+dfaer2*nacon2+dfaer3*nacon3+dfaer4*nacon4)*pi*pi/3._r8*rhow* & - cdist1(k)*gamma(pgam(i,k)+5._r8)/lamc(i,k)**4 - - nnucct(k) = (dfaer1*nacon1+dfaer2*nacon2+dfaer3*nacon3+dfaer4*nacon4)*2._r8*pi* & - cdist1(k)*gamma(pgam(i,k)+2._r8)/lamc(i,k) - - ! if (nnuccc(k).gt.nnuccd(k)) then - ! dum=nnuccd(k)/nnuccc(k) - ! scale mixing ratio of droplet freezing with limit - ! mnuccc(k)=mnuccc(k)*dum - ! nnuccc(k)=nnuccd(k) - ! end if - - else - mnuccc(k) = 0._r8 - nnuccc(k) = 0._r8 - mnucct(k) = 0._r8 - nnucct(k) = 0._r8 - end if - - ! freeze cloud liquid water homogeneously at -40 C - if (t(i,k) < 233.15_r8 .and. qc(i,k) > 0._r8) then - - ! make sure freezing rain doesn't increase temperature above - ! threshold - dum = xlf/cp*qc(i,k) - if (t(i,k)+dum.gt.233.15_r8) then - dum = -(t(i,k)-233.15_r8)*cp/xlf - dum = dum/qc(i,k) - dum = max(0._r8,dum) - dum = min(1._r8,dum) - else - dum = 1._r8 - end if - fholm(i,k) = mu(i,k)*dum*qc(i,k) - fholn(i,k) = mu(i,k)*dum*nc(i,k) - end if - - - !**************************************************************************************** - ! conservation to ensure no negative values of cloud water/precipitation - ! in case microphysical process rates are large - ! note: for check on conservation, processes are multiplied by omsm - ! to prevent problems due to round off error - - ! since activation/nucleation processes are fast, need to take into account - ! factor mtime = mixing timescale in cloud / model time step - ! for now mixing timescale is assumed to be 15 min - !***************************************************************************************** - - mtime=deltat/900._r8 - mtimec=deltat/900._r8 - - ! conservation of qc - ! ice mass production from ice nucleation(deposition/cond.-freezing), mnuccd, - ! is considered as a part of cmei. - - qce = mu(i,k)*qc(i,k)-fholm(i,k) +dz(i,k)*cmel(i,k-1) - dum = arcf(i,k)*(pra(k)+prc(k)+prb(k)+mnuccc(k)+mnucct(k)+msacwi(k)+ & - psacws(k))*dz(i,k) - if( qce.lt.0._r8) then - qcimp(k) = .true. - prc(k) = 0._r8 - pra(k) = 0._r8 - prb(k) = 0._r8 - mnuccc(k) = 0._r8 - mnucct(k) = 0._r8 - msacwi(k) = 0._r8 - psacws(k) = 0._r8 - else if (dum.gt.qce) then - ratio = qce/dum*omsm - prc(k) = prc(k)*ratio - pra(k) = pra(k)*ratio - prb(k) = prb(k)*ratio - mnuccc(k) = mnuccc(k)*ratio - mnucct(k) = mnucct(k)*ratio - msacwi(k) = msacwi(k)*ratio - psacws(k) = psacws(k)*ratio - end if - - ! conservation of nc - nce = mu(i,k)*nc(i,k)-fholn(i,k) + (arcf(i,k)*npccn(k)*mtimec)*dz(i,k) - dum = arcf(i,k)*dz(i,k)*(nprc1(k)+npra(k)+nnuccc(k)+nnucct(k)+ & - npsacws(k)+ nprb(k) ) - if (nce.lt.0._r8) then - ncimp(k) = .true. - nprc1(k) = 0._r8 - npra(k) = 0._r8 - nnuccc(k) = 0._r8 - nnucct(k) = 0._r8 - npsacws(k) = 0._r8 - nprb(k) = 0._r8 - else if (dum.gt.nce) then - ratio = nce/dum*omsm - nprc1(k) = nprc1(k)*ratio - npra(k) = npra(k)*ratio - nnuccc(k) = nnuccc(k)*ratio - nnucct(k) = nnucct(k)*ratio - npsacws(k) = npsacws(k)*ratio - nprb(k) = nprb(k)*ratio - end if - - ! conservation of qi - qie = mu(i,k)*qi(i,k)+fholm(i,k) +dz(i,k)*(cmei(i,k-1) + & - ( mnuccc(k)+mnucct(k)+msacwi(k)+prb(k))*arcf(i,k) ) - dum = arcf(i,k)*(prci(k)+ prai(k))*dz(i,k) - if (qie.lt.0._r8) then - qiimp(k) = .true. - prci(k) = 0._r8 - prai(k) = 0._r8 - else if (dum.gt.qie) then - ratio = qie/dum*omsm - prci(k) = prci(k)*ratio - prai(k) = prai(k)*ratio - end if - - ! conservation of ni - nie = mu(i,k)*ni(i,k)+fholn(i,k) +dz(i,k)*(nnuccd(k)*mtime*arcf(i,k) & - +(nnuccc(k)+ nnucct(k))*arcf(i,k) ) - dum = arcf(i,k)*dz(i,k)*(-nsacwi(k)+nprci(k)+ nprai(k)) - if( nie.lt.0._r8) then - niimp(k) = .true. - nsacwi(k)= 0._r8 - nprci(k) = 0._r8 - nprai(k) = 0._r8 - else if (dum.gt.nie) then - ratio = nie/dum*omsm - nsacwi(k)= nsacwi(k)*ratio - nprci(k) = nprci(k)*ratio - nprai(k) = nprai(k)*ratio - end if - - ! conservation of qr - - qre = mu(i,k)*qr(i,k)+dz(i,k)*(pra(k)+prc(k))*arcf(i,k) - dum = arcf(i,k)*dz(i,k)*(pracs(k)+ mnuccr(k)-prf(k)) - if (qre.lt.0._r8) then - prf(k) = 0._r8 - pracs(k) = 0._r8 - mnuccr(k) = 0._r8 - else if (dum.gt.qre) then - ratio = qre/dum*omsm - prf(k) = prf(k)*ratio - pracs(k) = pracs(k)*ratio - mnuccr(k) = mnuccr(k)*ratio - end if - - ! conservation of nr - nre = mu(i,k)*nr(i,k) + nprc(k)*arcf(i,k)*dz(i,k) - dum = arcf(i,k)*dz(i,k)*(npracs(k)+nnuccr(k) & - -nragg(k)-pnrf(k)) - if(nre.lt.0._r8) then - npracs(k)= 0._r8 - nnuccr(k)= 0._r8 - nragg(k) = 0._r8 - pnrf(k) = 0._r8 - else if (dum.gt.nre) then - ratio = nre/dum*omsm - npracs(k)= npracs(k)*ratio - nnuccr(k)= nnuccr(k)*ratio - nragg(k) = nragg(k)*ratio - pnrf(k) = pnrf(k)*ratio - end if - - ! conservation of qni - - qnie = mu(i,k)*qni(i,k)+dz(i,k)*( (prai(k)+psacws(k)+prci(k)+ & - pracs(k)+mnuccr(k))*arcf(i,k) ) - dum = arcf(i,k)*dz(i,k)*(-psf(k)) - - if(qnie.lt.0._r8) then - psf(k) = 0._r8 - else if (dum.gt.qnie) then - ratio = qnie/dum*omsm - psf(k) = psf(k)*ratio - end if - - ! conservation of ns - nse = mu(i,k)*ns(i,k)+dz(i,k)*(nprci(k)+nnuccr(k))*arcf(i,k) - dum = arcf(i,k)*dz(i,k)*(-nsagg(k)-pnsf(k)) - if (nse.lt.0._r8) then - nsagg(k) = 0._r8 - pnsf(k) = 0._r8 - else if (dum.gt.nse) then - ratio = nse/dum*omsm - nsagg(k) = nsagg(k)*ratio - pnsf(k) = pnsf(k)*ratio - end if - - !***************************************************************************** - ! get tendencies due to microphysical conversion processes - !***************************************************************************** - - if (k.le.kqc(i)) then - qctend(i,k) = (-pra(k)-prc(k)-prb(k)-mnuccc(k)-mnucct(k)-msacwi(k)- & - psacws(k)) - - qitend(i,k) = (prb(k)+mnuccc(k)+mnucct(k)+msacwi(k)-prci(k)- prai(k)) - - qrtend(i,k) = (pra(k)+prc(k))+(-pracs(k)- mnuccr(k)) - - qnitend(i,k) = (prai(k)+psacws(k)+prci(k))+(pracs(k)+mnuccr(k)) - - ! multiply activation/nucleation by mtime to account for fast timescale - - nctend(i,k) = npccn(k)*mtimec+(-nnuccc(k)-nnucct(k)-npsacws(k) & - -npra(k)-nprc1(k)-nprb(k)) - - nitend(i,k) = nnuccd(k)*mtime+(nnuccc(k)+ nnucct(k)+nsacwi(k)-nprci(k)- & - nprai(k)) - - nstend(i,k) = nsagg(k)+nnuccr(k) + nprci(k) - - nrtend(i,k) = nprc(k)+(-npracs(k)-nnuccr(k) +nragg(k)) - - ! for output - ! cloud liquid water------------- - - autolm(i,k-1) = -prc(k)*arcf(i,k) - accrlm(i,k-1) = -pra(k)*arcf(i,k) - bergnm(i,k-1) = -prb(k)*arcf(i,k) - fhtimm(i,k-1) = -mnuccc(k)*arcf(i,k) - fhtctm(i,k-1) = -mnucct(k)*arcf(i,k) - hmpim (i,k-1) = -msacwi(k)*arcf(i,k) - accslm(i,k-1) = -psacws(k)*arcf(i,k) - fhmlm(i,k-1) = -fholm(i,k)/dz(i,k) - - autoln(i,k-1) = -nprc1(k)*arcf(i,k) - accrln(i,k-1) = -npra(k)*arcf(i,k) - bergnn(i,k-1) = -nprb(k)*arcf(i,k) - fhtimn(i,k-1) = -nnuccc(k)*arcf(i,k) - fhtctn(i,k-1) = -nnucct(k)*arcf(i,k) - accsln(i,k-1) = -npsacws(k)*arcf(i,k) - activn(i,k-1) = npccn(k)*mtimec*arcf(i,k) - fhmln(i,k-1) = -fholn(i,k)/dz(i,k) - - !cloud ice------------------------ - - autoim(i,k-1) = -prci(k)*arcf(i,k) - accsim(i,k-1) = -prai(k)*arcf(i,k) - - nuclin(i,k-1) = nnuccd(k)*mtime*arcf(i,k) - autoin(i,k-1) = -nprci(k)*arcf(i,k) - accsin(i,k-1) = -nprai(k)*arcf(i,k) - hmpin (i,k-1) = nsacwi(k)*arcf(i,k) - - else - qctend(i,k) = 0._r8 - qitend(i,k) = 0._r8 - qrtend(i,k) = 0._r8 - qnitend(i,k) = 0._r8 - nctend(i,k) = 0._r8 - nitend(i,k) = 0._r8 - nstend(i,k) = 0._r8 - nrtend(i,k) = 0._r8 - end if - - !******************************************************************************** - ! vertical integration - !******************************************************************************** - ! snow - if ( k.le.kqi(i) ) then - qni(i,k-1) = 1._r8/mu(i,k-1)* & - (mu(i,k)*qni(i,k)+dz(i,k)*(qnitend(i,k)+psf(k))*arcf(i,k) ) - - ns(i,k-1) = 1._r8/mu(i,k-1)* & - (mu(i,k)*ns(i,k)+dz(i,k)*(nstend(i,k)+pnsf(k))*arcf(i,k) ) - - else - qni(i,k-1)=0._r8 - ns(i,k-1)=0._r8 - end if - - if (qni(i,k-1).le.0._r8) then - qni(i,k-1)=0._r8 - ns(i,k-1)=0._r8 - end if - - ! rain - if (k.le.kqc(i) ) then - qr(i,k-1) = 1._r8/mu(i,k-1)* & - (mu(i,k)*qr(i,k)+dz(i,k)*(qrtend(i,k)+prf(k))*arcf(i,k) ) - - nr(i,k-1) = 1._r8/mu(i,k-1)* & - (mu(i,k)*nr(i,k)+dz(i,k)*(nrtend(i,k)+pnrf(k))*arcf(i,k) ) - - else - qr(i,k-1)=0._r8 - nr(i,k-1)=0._r8 - end if - - if( qr(i,k-1) .le. 0._r8) then - qr(i,k-1)=0._r8 - nr(i,k-1)=0._r8 - end if - - ! freeze rain homogeneously at -40 C - - if (t(i,k-1) < 233.15_r8 .and. qr(i,k-1) > 0._r8) then - - ! make sure freezing rain doesn't increase temperature above threshold - dum = xlf/cp*qr(i,k-1) - if (t(i,k-1)+dum.gt.233.15_r8) then - dum = -(t(i,k-1)-233.15_r8)*cp/xlf - dum = dum/qr(i,k-1) - dum = max(0._r8,dum) - dum = min(1._r8,dum) - else - dum = 1._r8 - end if - qni(i,k-1)=qni(i,k-1)+dum*qr(i,k-1) - ns(i,k-1)=ns(i,k-1)+dum*nr(i,k-1) - qr(i,k-1)=(1._r8-dum)*qr(i,k-1) - nr(i,k-1)=(1._r8-dum)*nr(i,k-1) - fhmrm(i,k-1) = -mu(i,k-1)*dum*qr(i,k-1)/dz(i,k) - end if - - - ! cloud water - if ( k.le.kqc(i) ) then - qc(i,k-1) = (mu(i,k)*qc(i,k)-fholm(i,k)+dz(i,k)*qctend(i,k)*arcf(i,k) & - +dz(i,k)*cmel(i,k-1) )/(mu(i,k-1)+dz(i,k)*du(i,k-1)) - - qcde(i,k) = qc(i,k-1) - - nc(i,k-1) = (mu(i,k)*nc(i,k) -fholn(i,k) +dz(i,k)*nctend(i,k)*arcf(i,k) ) & - /(mu(i,k-1)+dz(i,k)*du(i,k-1)) - - ncde(i,k) = nc(i,k-1) - else - qc(i,k-1)=0._r8 - nc(i,k-1)=0._r8 - end if - - if (qc(i,k-1).lt.0._r8) write(iulog,*) "negative qc(i,k-1)=",qc(i,k-1) - dlfm(i,k-1) = -du(i,k-1)*qcde(i,k) - dlfn(i,k-1) = -du(i,k-1)*ncde(i,k) - - if (qc(i,k-1).le. 0._r8) then - qc(i,k-1)=0._r8 - nc(i,k-1)=0._r8 - end if - - if (nc(i,k-1).lt. 0._r8) then - write(iulog,*) "nc(i,k-1)=",nc(i,k-1),"k-1=",k-1,"arcf(i,k)=",arcf(i,k) - write(iulog,*) "mu(i,k-1)=",mu(i,k-1),"mu(i,k)=",mu(i,k),"nc(i,k)=",ni(i,k) - write(iulog,*) "dz(i,k)=",dz(i,k),"du(i,k-1)=",du(i,k-1),"nctend(i,k)=",nctend(i,k) - write(iulog,*) "eu(i,k-1)=",eu(i,k-1) - end if - - ! cloud ice - if( k.le.kqi(i)) then - qi(i,k-1) = (mu(i,k)*qi(i,k)+fholm(i,k) +dz(i,k)*qitend(i,k)*arcf(i,k) & - +dz(i,k)*cmei(i,k-1) )/(mu(i,k-1)+dz(i,k)*du(i,k-1)) - - qide(i,k) = qi(i,k-1) - - ni(i,k-1) = (mu(i,k)*ni(i,k)+fholn(i,k)+dz(i,k)*nitend(i,k)*arcf(i,k) ) & - /(mu(i,k-1)+dz(i,k)*du(i,k-1)) - - nide(i,k) = ni(i,k-1) - else - qi(i,k-1)=0._r8 - ni(i,k-1)=0._r8 - end if - - if (qi(i,k-1).lt.0._r8) write(iulog,*) "negative qi(i,k-1)=",qi(i,k-1) - difm(i,k-1) = -du(i,k-1)*qide(i,k) - difn(i,k-1) = -du(i,k-1)*nide(i,k) - - if (qi(i,k-1).le. 0._r8) then - qi(i,k-1)=0._r8 - ni(i,k-1)=0._r8 - end if - - - if (ni(i,k-1).lt. 0._r8) then - write(iulog,*) "ni(i,k-1)=",ni(i,k-1),"k-1=",k-1,"arcf(i,k)=",arcf(i,k) - write(iulog,*) "mu(i,k-1)=",mu(i,k-1),"mu(i,k)=",mu(i,k),"ni(i,k)=",ni(i,k) - write(iulog,*) "dz(i,k)=",dz(i,k),"du(i,k-1)=",du(i,k-1),"nitend(i,k)=",nitend(i,k) - write(iulog,*) "eu(i,k-1)=",eu(i,k-1) - end if - - - frz(i,k-1) = cmei(i,k-1) + arcf(i,k)*(prb(k)+mnuccc(k)+mnucct(k)+msacwi(k)+ & - pracs(k)+mnuccr(k)+psacws(k) )-fhmlm(i,k-1)-fhmrm(i,k-1) - - - !****************************************************************************** - ! get size distribution parameters based on in-cloud cloud water/ice - ! these calculations also ensure consistency between number and mixing ratio - - ! following equation(2,3,4) of Morrison and Gettelman, 2008, J. Climate. - ! Gamma(n)= (n-1)! - ! lamc <-> lambda for cloud liquid water - ! pgam <-> meu for cloud liquid water - ! meu=0 for ice,rain and snow - !******************************************************************************* - - ! cloud ice - niorg = ni(i,k-1) - if (qi(i,k-1).ge.qsmall) then - - ! add upper limit to in-cloud number concentration to prevent numerical error - ni(i,k-1)=min(ni(i,k-1),qi(i,k-1)*1.e20_r8) - ! ni should be non-negative - ! ni(i,k-1) = max(ni(i,k-1), 0._r8) - if (ni(i,k-1).lt. 0._r8) write(iulog,*) "ni(i,k-1)=",ni(i,k-1) - - lami(k-1) = (gamma(1._r8+di)*ci* & - ni(i,k-1)/qi(i,k-1))**(1._r8/di) - n0i(k-1) = ni(i,k-1)*lami(k-1) - - ! check for slope - lammax = 1._r8/10.e-6_r8 - lammin = 1._r8/(2._r8*dcs) - - ! adjust vars - if (lami(k-1).lt.lammin) then - lami(k-1) = lammin - n0i(k-1) = lami(k-1)**(di+1._r8)*qi(i,k-1)/(ci*gamma(1._r8+di)) - ni(i,k-1) = n0i(k-1)/lami(k-1) - else if (lami(k-1).gt.lammax) then - lami(k-1) = lammax - n0i(k-1) = lami(k-1)**(di+1._r8)*qi(i,k-1)/(ci*gamma(1._r8+di)) - ni(i,k-1) = n0i(k-1)/lami(k-1) - end if - else - lami(k-1) = 0._r8 - n0i(k-1) = 0._r8 - end if - - nide(i,k) = ni(i,k-1) - difn(i,k-1) = -du(i,k-1)*nide(i,k) - - niadj(i,k-1)= (ni(i,k-1)- niorg)*mu(i,k-1)/dz(i,k) - - if (niadj(i,k-1) .lt. 0._r8) then - total = nuclin(i,k-1)-fhtimn(i,k-1)-fhtctn(i,k-1)-fhmln(i,k-1)+ hmpin (i,k-1) - if (total .ne. 0._r8) then - nuclin(i,k-1) = nuclin(i,k-1) + nuclin(i,k-1)*niadj(i,k-1)/total - fhtimn(i,k-1) = fhtimn(i,k-1) + fhtimn(i,k-1)*niadj(i,k-1)/total - fhtctn(i,k-1) = fhtctn(i,k-1) + fhtctn(i,k-1)*niadj(i,k-1)/total - fhmln (i,k-1) = fhmln (i,k-1) + fhmln (i,k-1)*niadj(i,k-1)/total - hmpin (i,k-1) = hmpin (i,k-1) + hmpin (i,k-1)*niadj(i,k-1)/total - else - total = 5._r8 - nuclin(i,k-1) = nuclin(i,k-1) + niadj(i,k-1)/total - fhtimn(i,k-1) = fhtimn(i,k-1) + niadj(i,k-1)/total - fhtctn(i,k-1) = fhtctn(i,k-1) + niadj(i,k-1)/total - fhmln (i,k-1) = fhmln (i,k-1) + niadj(i,k-1)/total - hmpin (i,k-1) = hmpin (i,k-1) + niadj(i,k-1)/total - end if - else if (niadj(i,k-1) .gt. 0._r8) then - total = autoin(i,k-1)+accsin(i,k-1) - if (total .ne. 0._r8) then - autoin(i,k-1) = autoin(i,k-1) + autoin(i,k-1)*niadj(i,k-1)/total - accsin(i,k-1) = accsin(i,k-1) + accsin(i,k-1)*niadj(i,k-1)/total - else - total = 2._r8 - autoin(i,k-1) = autoin(i,k-1) + niadj(i,k-1)/total - accsin(i,k-1) = accsin(i,k-1) + niadj(i,k-1)/total - end if - end if - - !................................................................................ - !cloud water - ncorg = nc(i,k-1) - if (qc(i,k-1).ge.qsmall) then - - ! add upper limit to in-cloud number concentration to prevent numerical error - nc(i,k-1)=min(nc(i,k-1),qc(i,k-1)*1.e20_r8) - ! and make sure it's non-negative - ! nc(i,k-1) = max(nc(i,k-1), 0._r8) - if (nc(i,k-1).lt. 0._r8) write(iulog,*) "nc(i,k-1)=",nc(i,k-1) - - ! get pgam from fit to observations of martin et al. 1994 - - pgam(i,k-1)=0.0005714_r8*(nc(i,k-1)/1.e6_r8/rho(i,k-1))+0.2714_r8 - pgam(i,k-1)=1._r8/(pgam(i,k-1)**2)-1._r8 - pgam(i,k-1)=max(pgam(i,k-1),2._r8) - pgam(i,k-1)=min(pgam(i,k-1),15._r8) - ! calculate lamc - - lamc(i,k-1) = (pi/6._r8*rhow*nc(i,k-1)*gamma(pgam(i,k-1)+4._r8)/ & - (qc(i,k-1)*gamma(pgam(i,k-1)+1._r8)))**(1._r8/3._r8) - - ! lammin, 50 micron diameter max mean size - lammin = (pgam(i,k-1)+1._r8)/40.e-6_r8 - lammax = (pgam(i,k-1)+1._r8)/1.e-6_r8 - - if (lamc(i,k-1).lt.lammin) then - lamc(i,k-1) = lammin - nc(i,k-1) = 6._r8*lamc(i,k-1)**3*qc(i,k-1)* & - gamma(pgam(i,k-1)+1._r8)/ & - (pi*rhow*gamma(pgam(i,k-1)+4._r8)) - else if (lamc(i,k-1).gt.lammax) then - lamc(i,k-1) = lammax - nc(i,k-1) = 6._r8*lamc(i,k-1)**3*qc(i,k-1)* & - gamma(pgam(i,k-1)+1._r8)/ & - (pi*rhow*gamma(pgam(i,k-1)+4._r8)) - end if - - ! parameter to calculate droplet freezing - - cdist1(k-1) = nc(i,k-1)/gamma(pgam(i,k-1)+1._r8) - else - lamc(i,k-1) = 0._r8 - cdist1(k-1) = 0._r8 - end if - - ncde(i,k) = nc(i,k-1) - dlfn(i,k-1) = -du(i,k-1)*ncde(i,k) - - ncadj(i,k-1) = (nc(i,k-1)- ncorg)*mu(i,k-1)/dz(i,k) - if (ncadj(i,k-1) .lt. 0._r8) then - activn(i,k-1) = activn(i,k-1) + ncadj(i,k-1) - else if (ncadj(i,k-1) .gt. 0._r8) then - total = autoln(i,k-1)+accrln(i,k-1)+bergnn(i,k-1)+accsln(i,k-1) - if (total .ne. 0._r8) then - autoln(i,k-1) = autoln(i,k-1) + autoln(i,k-1)*ncadj(i,k-1)/total - accrln(i,k-1) = accrln(i,k-1) + accrln(i,k-1)*ncadj(i,k-1)/total - bergnn(i,k-1) = bergnn(i,k-1) + bergnn(i,k-1)*ncadj(i,k-1)/total - accsln(i,k-1) = accsln(i,k-1) + accsln(i,k-1)*ncadj(i,k-1)/total - else - total = 4._r8 - autoln(i,k-1) = autoln(i,k-1) + ncadj(i,k-1)/total - accrln(i,k-1) = accrln(i,k-1) + ncadj(i,k-1)/total - bergnn(i,k-1) = bergnn(i,k-1) + ncadj(i,k-1)/total - accsln(i,k-1) = accsln(i,k-1) + ncadj(i,k-1)/total - end if - end if - - trspcm(i,k-1) = (mu(i,k)*qc(i,k) - mu(i,k-1)*qc(i,k-1))/dz(i,k) - trspcn(i,k-1) = (mu(i,k)*nc(i,k) - mu(i,k-1)*nc(i,k-1))/dz(i,k) - trspim(i,k-1) = (mu(i,k)*qi(i,k) - mu(i,k-1)*qi(i,k-1))/dz(i,k) - trspin(i,k-1) = (mu(i,k)*ni(i,k) - mu(i,k-1)*ni(i,k-1))/dz(i,k) - - if (k-1 .eq. jt(i)+1) then - trspcm(i,k-2) = mu(i,k-1)*qc(i,k-1)/dz(i,k-1) - trspcn(i,k-2) = mu(i,k-1)*nc(i,k-1)/dz(i,k-1) - trspim(i,k-2) = mu(i,k-1)*qi(i,k-1)/dz(i,k-1) - trspin(i,k-2) = mu(i,k-1)*ni(i,k-1)/dz(i,k-1) - qcde(i,k-1) = qc(i,k-1) - ncde(i,k-1) = nc(i,k-1) - qide(i,k-1) = qi(i,k-1) - nide(i,k-1) = ni(i,k-1) - dlfm (i,k-2) = -du(i,k-2)*qcde(i,k-1) - dlfn (i,k-2) = -du(i,k-2)*ncde(i,k-1) - difm (i,k-2) = -du(i,k-2)*qide(i,k-1) - difn (i,k-2) = -du(i,k-2)*nide(i,k-1) - end if - - - !....................................................................... - ! get size distribution parameters for precip - !...................................................................... - ! rain - if (qr(i,k-1).ge.qsmall) then - - lamr(k-1) = (pi*rhow*nr(i,k-1)/qr(i,k-1))**(1._r8/3._r8) - n0r(k-1) = nr(i,k-1)*lamr(k-1) - - ! check for slope - lammax = 1._r8/150.e-6_r8 - lammin = 1._r8/3000.e-6_r8 - ! adjust vars - if (lamr(k-1).lt.lammin) then - lamr(k-1) = lammin - n0r(k-1) = lamr(k-1)**4*qr(i,k-1)/(pi*rhow) - nr(i,k-1) = n0r(k-1)/lamr(k-1) - else if (lamr(k-1).gt.lammax) then - lamr(k-1) = lammax - n0r(k-1) = lamr(k-1)**4*qr(i,k-1)/(pi*rhow) - nr(i,k-1) = n0r(k-1)/lamr(k-1) - end if - - unr(k-1) = min(arn(i,k-1)*gamma(1._r8+br)/lamr(k-1)**br,10._r8) - umr(k-1) = min(arn(i,k-1)*gamma(4._r8+br)/(6._r8*lamr(k-1)**br),10._r8) - else - lamr(k-1) = 0._r8 - n0r(k-1) = 0._r8 - umr(k-1) = 0._r8 - unr(k-1) = 0._r8 - end if - - !...................................................................... - ! snow - if (qni(i,k-1).ge.qsmall) then - lams(k-1) = (gamma(1._r8+ds)*cs*ns(i,k-1)/ & - qni(i,k-1))**(1._r8/ds) - n0s(k-1) = ns(i,k-1)*lams(k-1) - - ! check for slope - lammax = 1._r8/10.e-6_r8 - lammin = 1._r8/2000.e-6_r8 - - ! adjust vars - if (lams(k-1).lt.lammin) then - lams(k-1) = lammin - n0s(k-1) = lams(k-1)**(ds+1._r8)*qni(i,k-1)/(cs*gamma(1._r8+ds)) - ns(i,k-1) = n0s(k-1)/lams(k-1) - else if (lams(k-1).gt.lammax) then - lams(k-1) = lammax - n0s(k-1) = lams(k-1)**(ds+1._r8)*qni(i,k-1)/(cs*gamma(1._r8+ds)) - ns(i,k-1) = n0s(k-1)/lams(k-1) - end if - ums(k-1) = min(asn(i,k-1)*gamma(4._r8+bs)/(6._r8*lams(k-1)**bs),3.6_r8) - uns(k-1) = min(asn(i,k-1)*gamma(1._r8+bs)/lams(k-1)**bs,3.6_r8) - else - lams(k-1) = 0._r8 - n0s(k-1) = 0._r8 - ums(k-1) = 0._r8 - uns(k-1) = 0._r8 - end if - - rprd(i,k-1)= (qnitend(i,k) + qrtend(i,k))*arcf(i,k) - sprd(i,k-1)= qnitend(i,k) *arcf(i,k) -fhmrm(i,k-1) - - end if ! k Date: Wed, 27 Sep 2023 16:52:55 -0600 Subject: [PATCH 157/291] Remove test which tested zmconv_micro --- cime_config/testdefs/testlist_cam.xml | 10 ------- .../cam/outfrq3s_convmic/shell_commands | 4 --- .../cam/outfrq3s_convmic/user_nl_cam | 6 ----- .../cam/outfrq3s_convmic/user_nl_clm | 27 ------------------- .../cam/outfrq3s_convmic/user_nl_cpl | 2 -- 5 files changed, 49 deletions(-) delete mode 100644 cime_config/testdefs/testmods_dirs/cam/outfrq3s_convmic/shell_commands delete mode 100644 cime_config/testdefs/testmods_dirs/cam/outfrq3s_convmic/user_nl_cam delete mode 100644 cime_config/testdefs/testmods_dirs/cam/outfrq3s_convmic/user_nl_clm delete mode 100644 cime_config/testdefs/testmods_dirs/cam/outfrq3s_convmic/user_nl_cpl diff --git a/cime_config/testdefs/testlist_cam.xml b/cime_config/testdefs/testlist_cam.xml index 73219c0c07..2a0156db0d 100644 --- a/cime_config/testdefs/testlist_cam.xml +++ b/cime_config/testdefs/testlist_cam.xml @@ -519,16 +519,6 @@ - - - - - - - - - - diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_convmic/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_convmic/shell_commands deleted file mode 100644 index 3a506cfaa1..0000000000 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_convmic/shell_commands +++ /dev/null @@ -1,4 +0,0 @@ -./xmlchange ROF_NCPL=\$ATM_NCPL -./xmlchange GLC_NCPL=\$ATM_NCPL -./xmlchange CAM_NML_USE_CASE=UNSET -./xmlchange RUN_STARTDATE="19950101" diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_convmic/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_convmic/user_nl_cam deleted file mode 100644 index f81fb38bfc..0000000000 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_convmic/user_nl_cam +++ /dev/null @@ -1,6 +0,0 @@ -zmconv_microp=.true. -mfilt=1,1,1,1,1,1 -ndens=1,1,1,1,1,1 -nhtfrq=3,3,3,3,3,3 -inithist='ENDOFRUN' -pbuf_global_allocate=.false. diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_convmic/user_nl_clm b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_convmic/user_nl_clm deleted file mode 100644 index f3ac27f1e6..0000000000 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_convmic/user_nl_clm +++ /dev/null @@ -1,27 +0,0 @@ -!---------------------------------------------------------------------------------- -! 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 = 3 -hist_mfilt = 1 -hist_ndens = 1 - diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_convmic/user_nl_cpl b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_convmic/user_nl_cpl deleted file mode 100644 index 398535cf65..0000000000 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_convmic/user_nl_cpl +++ /dev/null @@ -1,2 +0,0 @@ -reprosum_diffmax=1.0e-14 -reprosum_recompute=.true. From b499cc41773f8845f700f68cf2389d58a4484697 Mon Sep 17 00:00:00 2001 From: Brian Eaton Date: Thu, 28 Sep 2023 15:54:48 -0400 Subject: [PATCH 158/291] refactor LW cloud and aerosol optics, flux calc --- src/physics/rrtmgp/mcica_subcol_gen.F90 | 41 ++- src/physics/rrtmgp/radconstants.F90 | 4 +- src/physics/rrtmgp/radiation.F90 | 307 +++++++------------ src/physics/rrtmgp/rrtmgp_driver.F90 | 382 ------------------------ src/physics/rrtmgp/rrtmgp_inputs.F90 | 190 +++++++++--- 5 files changed, 280 insertions(+), 644 deletions(-) delete mode 100644 src/physics/rrtmgp/rrtmgp_driver.F90 diff --git a/src/physics/rrtmgp/mcica_subcol_gen.F90 b/src/physics/rrtmgp/mcica_subcol_gen.F90 index c77b20e4ed..f25732c729 100644 --- a/src/physics/rrtmgp/mcica_subcol_gen.F90 +++ b/src/physics/rrtmgp/mcica_subcol_gen.F90 @@ -25,16 +25,10 @@ module mcica_subcol_gen ! !---------------------------------------------------------------------------------------- -use shr_kind_mod, only: r8 => shr_kind_r8 -use ppgrid, only: pcols, pver, pverp -use cam_abortutils, only: endrun - -use shr_RandNum_mod, only: ShrKissRandGen - -! old: use mo_gas_optics_specification, only: ty_gas_optics_specification -! use mo_gas_optics, only: ty_gas_optics ! Wrong? +use shr_kind_mod, only: r8 => shr_kind_r8 +use ppgrid, only: pcols, pver +use shr_RandNum_mod, only: ShrKissRandGen use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp -use cam_logfile, only: iulog ! just for debugging (BPM) implicit none private @@ -47,8 +41,8 @@ module mcica_subcol_gen !======================================================================================== subroutine mcica_subcol_lw( & - kdist, nbnd, ngpt, ncol, changeseed, & - pmid, cldfrac, tauc, taucmcl) + kdist, nbnd, ngpt, ncol, nver, & + changeseed, pmid, cldfrac, tauc, taucmcl ) ! Arrays use CAM vertical index convention: index increases from top to bottom. ! This index ordering is assumed in the maximum-random overlap algorithm which starts @@ -64,15 +58,15 @@ subroutine mcica_subcol_lw( & integer, intent(in) :: nbnd ! number of spectral bands integer, intent(in) :: ngpt ! number of subcolumns (g-point intervals) integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nver ! number of layers integer, intent(in) :: changeseed ! if the subcolumn generator is called multiple times, ! permute the seed between each call. real(r8), intent(in) :: pmid(pcols,pver) ! layer pressures (Pa) - real(r8), intent(in) :: cldfrac(pcols,pver) ! layer cloud fraction - real(r8), intent(in) :: tauc(nbnd,pcols,pver) ! cloud optical depth - - real(r8), intent(out) :: taucmcl(ngpt,ncol,pver) ! subcolumn cloud optical depth [mcica] + real(r8), intent(in) :: cldfrac(ncol,nver) ! layer cloud fraction + real(r8), intent(in) :: tauc(nbnd,ncol,nver) ! cloud optical depth + real(r8), intent(out) :: taucmcl(ngpt,ncol,nver) ! subcolumn cloud optical depth [mcica] - ! Local vars + ! Local variables integer :: i, isubcol, k, n @@ -82,11 +76,12 @@ subroutine mcica_subcol_lw( & type(ShrKissRandGen) :: kiss_gen ! KISS RNG object integer :: kiss_seed(ncol,4) real(r8) :: rand_num_1d(ncol,1) ! random number (kissvec) - real(r8) :: rand_num(ncol,pver) ! random number (kissvec) + real(r8) :: rand_num(ncol,nver) ! random number (kissvec) - real(r8) :: cdf(ngpt,ncol,pver) ! random numbers - logical :: iscloudy(ngpt,ncol,pver) ! flag that says whether a gridbox is cloudy + real(r8) :: cdf(ngpt,ncol,nver) ! random numbers + logical :: iscloudy(ngpt,ncol,nver) ! flag that says whether a gridbox is cloudy !------------------------------------------------------------------------------------------ + ! clip cloud fraction cldf(:,:) = cldfrac(:ncol,:) where (cldf(:,:) < cldmin) @@ -122,7 +117,7 @@ subroutine mcica_subcol_lw( & ! - if the layer above is cloudy, use the same random number as in the layer above ! - if the layer above is clear, use a new random number - do k = 2, pver + do k = 2, nver do i = 1, ncol do isubcol = 1, ngpt if (cdf(isubcol,i,k-1) > 1._r8 - cldf(i,k-1) ) then @@ -134,14 +129,14 @@ subroutine mcica_subcol_lw( & end do end do - do k = 1, pver + do k = 1, nver iscloudy(:,:,k) = (cdf(:,:,k) >= 1._r8 - spread(cldf(:,k), dim=1, nCopies=ngpt) ) end do ! -- generate subcolumns for homogeneous clouds ----- ! where there is a cloud, set the subcolumn cloud properties; ! incoming tauc should be in-cloud quantites and not grid-averaged quantities - do k = 1,pver + do k = 1,nver do i = 1,ncol do isubcol = 1,ngpt if (iscloudy(isubcol,i,k) .and. (cldf(i,k) > 0._r8) ) then @@ -260,7 +255,6 @@ subroutine mcica_subcol_sw( & do k = 1, nver iscloudy(:,:,k) = (cdf(:,:,k) >= 1._r8 - spread(cldf(:,k), dim=1, nCopies=ngpt) ) - ! write(iulog,*) 'level ',k,' any(iscloud) = ',any(iscloudy(:,1,k)) ! BPM - Debugging - remove when done end do ! -- generate subcolumns for homogeneous clouds ----- @@ -274,7 +268,6 @@ subroutine mcica_subcol_sw( & taucmcl(isubcol,i,k) = tauc(n,i,k) ssacmcl(isubcol,i,k) = ssac(n,i,k) asmcmcl(isubcol,i,k) = asmc(n,i,k) - ! write(iulog,*) 'level ',k,' subcolumn ',isubcol, 'CLOUD! ssacmcl = ',ssacmcl(isubcol,i,k),', asmcmcl = ',asmcmcl(isubcol,i,k) ! BPM - Debugging - remove when done else taucmcl(isubcol,i,k) = 0._r8 ssacmcl(isubcol,i,k) = 1._r8 diff --git a/src/physics/rrtmgp/radconstants.F90 b/src/physics/rrtmgp/radconstants.F90 index 9aaca3ad1b..e414771568 100644 --- a/src/physics/rrtmgp/radconstants.F90 +++ b/src/physics/rrtmgp/radconstants.F90 @@ -26,8 +26,8 @@ module radconstants logical :: wavenumber_boundaries_set = .false. -integer, public, protected :: nswgpts ! # SW gpts -integer, public, protected :: nlwgpts ! # LW gpts +integer, public, protected :: nswgpts ! number of SW g-points +integer, public, protected :: nlwgpts ! number of LW g-points ! These are indices to specific bands for diagnostic output and COSP input. integer, public, protected :: idx_sw_diag = -1 ! band contains 500-nm wave diff --git a/src/physics/rrtmgp/radiation.F90 b/src/physics/rrtmgp/radiation.F90 index c7d305f371..46f108d507 100644 --- a/src/physics/rrtmgp/radiation.F90 +++ b/src/physics/rrtmgp/radiation.F90 @@ -28,8 +28,7 @@ module radiation use rrtmgp_inputs, only: rrtmgp_inputs_init use radconstants, only: nswbands, nlwbands, nswgpts, & - idx_nir_diag, idx_uv_diag, idx_lw_diag, & - idx_lw_cloudsim, nradgas, gasnamelength, gaslist, & + nradgas, gasnamelength, gaslist, & set_wavenumber_bands use cloud_rad_props, only: cloud_rad_props_init @@ -53,12 +52,12 @@ module radiation pio_def_var, pio_put_var, pio_get_var, & pio_put_att, PIO_NOWRITE, pio_closefile +use mo_source_functions, only: ty_source_func_lw use mo_gas_concentrations, only: ty_gas_concs use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp use mo_optical_props, only: ty_optical_props_1scl, ty_optical_props_2str use mo_fluxes_byband, only: ty_fluxes_byband - use string_utils, only: to_lower use cam_abortutils, only: endrun use error_messages, only: handle_err @@ -877,15 +876,8 @@ subroutine radiation_tend( & rrtmgp_set_aer_lw, rrtmgp_set_gases_sw, rrtmgp_set_cloud_sw, & rrtmgp_set_aer_sw - use aer_rad_props, only: aer_rad_props_lw - - use cloud_rad_props, only: ice_cloud_get_rad_props_lw, & - liquid_cloud_get_rad_props_lw, & - snow_cloud_get_rad_props_lw, & - grau_cloud_get_rad_props_lw - ! RRTMGP drivers for flux calculations. - use rrtmgp_driver, only: rte_lw + use mo_rte_lw, only: rte_lw use mo_rte_sw, only: rte_sw use radheat, only: radheat_tend @@ -968,37 +960,43 @@ subroutine radiation_tend( & real(r8), allocatable :: alb_dir(:,:) real(r8), allocatable :: alb_dif(:,:) - real(r8) :: cld_tau_cloudsim(pcols,pver) ! in-cloud liq+ice optical depth (for COSP) - real(r8) :: snow_tau_cloudsim(pcols,pver)! in-cloud snow optical depth (for COSP) - real(r8) :: grau_tau_cloudsim(pcols,pver)! in-cloud Graupel optical depth (for COSP) - - real(r8) :: ice_lw_abs (nlwbands,pcols,pver) ! ice absorption optics depth (LW) - real(r8) :: liq_lw_abs (nlwbands,pcols,pver) ! liquid absorption optics depth (LW) - real(r8) :: cld_lw_abs (nlwbands,pcols,pver) ! cloud absorption optics depth (LW) - real(r8) :: snow_lw_abs (nlwbands,pcols,pver)! snow absorption optics depth (LW) - real(r8) :: grau_lw_abs (nlwbands,pcols,pver)! graupel absorption optics depth (LW) - real(r8) :: c_cld_lw_abs (nlwbands,pcols,pver) ! combined cloud absorption optics depth (LW) - - ! Aerosol radiative properties **N.B.** These are zero-indexed to accomodate an "extra layer". - ! If no extra layer then the 0 index is ignored. - real(r8) :: aer_lw_abs (pcols,pver,nlwbands) ! aerosol absorption optics depth (LW) + ! in-cloud optical depths for COSP + real(r8) :: cld_tau_cloudsim(pcols,pver) ! liq + ice + real(r8) :: snow_tau_cloudsim(pcols,pver) ! snow + real(r8) :: grau_tau_cloudsim(pcols,pver) ! graupel + real(r8) :: cld_lw_abs_cloudsim(pcols,pver) ! liq + ice + real(r8) :: snow_lw_abs_cloudsim(pcols,pver)! snow + real(r8) :: grau_lw_abs_cloudsim(pcols,pver)! graupel ! Set vertical indexing in RRTMGP to be the same as CAM (top to bottom). logical, parameter :: top_at_1 = .true. - ! RRTMGP cloud objects (McICA sampling of cloud optical properties) - type(ty_optical_props_1scl) :: cloud_lw - type(ty_optical_props_2str) :: cloud_sw + ! TOA solar flux on RRTMGP g-points + real(r8), allocatable :: toa_flux(:,:) + ! TSI from RRTMGP data (from sum over g-point representation) + real(r8) :: tsi_ref + + ! Planck sources for LW. + type(ty_source_func_lw) :: sources_lw - ! gas vmr. Separate objects because SW only does calculations for daylight columns. + ! Gas volume mixing ratios. Use separate objects for LW and SW because SW only does + ! calculations for daylight columns. + ! These objects have a final method which deallocates the internal memory when they + ! go out of scope (i.e., when radiation_tend returns), so no need for explicit deallocation. type(ty_gas_concs) :: gas_concs_lw type(ty_gas_concs) :: gas_concs_sw - ! Atmosphere optics. This object contains gas optics, aerosol optics, and cloud optics. -! type(ty_optical_props_1scl) :: gas_optics_lw + ! Atmosphere optics. This object is initialized with gas optics, then is incremented + ! by the aerosol optics for the clear-sky radiative flux calculations, and then + ! incremented again by the cloud optics for the all-sky radiative flux calculations. + type(ty_optical_props_1scl) :: atm_optics_lw type(ty_optical_props_2str) :: atm_optics_sw - ! aerosol optics + ! Cloud optical properties objects (McICA sampling of cloud optical properties). + type(ty_optical_props_1scl) :: cloud_lw + type(ty_optical_props_2str) :: cloud_sw + + ! Aerosol optical properties objects. type(ty_optical_props_1scl) :: aer_lw type(ty_optical_props_2str) :: aer_sw @@ -1013,11 +1011,6 @@ subroutine radiation_tend( & real(r8) :: fnl(pcols,pverp) ! net longwave flux real(r8) :: fcnl(pcols,pverp) ! net clear-sky longwave flux - ! TOA solar flux on RRTMGP g-points - real(r8), allocatable :: toa_flux(:,:) - ! TSI from RRTMGP data (from sum over g-point representation) - real(r8) :: tsi_ref - ! for COSP real(r8) :: emis(pcols,pver) ! Cloud longwave emissivity real(r8) :: gb_snow_tau(pcols,pver) ! grid-box mean snow_tau @@ -1126,7 +1119,6 @@ subroutine radiation_tend( & end do end if - ! Find tropopause height if needed for diagnostic output if (hist_fld_active('FSNR') .or. hist_fld_active('FLNR')) then call tropopause_find(state, troplev, tropP=p_trop, primary=TROP_ALG_HYBSTOB, & @@ -1137,18 +1129,6 @@ subroutine radiation_tend( & ! calculated by each surface model at this time nextsw_cday = radiation_nextsw_cday() - - ! if Nday = 0, then we should not do shortwave, - ! *but* at then end of subroutine, heating rates will still be calculated, - ! and would get whatever is in pbuf for qrl / qrs. - ! To avoid non-daylit columns - ! from having shortwave heating, we should reset here: -! if (nday == 0) then -! qrs(1:ncol,1:pver) = 0._r8 -! rd%qrsc(1:ncol,1:pver) = 0._r8 ! this is what gets turned into QRSC in output (probably not needed here.) -! dosw = .false. -! end if - if (dosw .or. dolw) then allocate( & @@ -1199,13 +1179,15 @@ subroutine radiation_tend( & call endrun(sub//': ERROR: gas_concs_sw%init: '//trim(errmsg)) end if - ! Init and allocate arrays in atm optics object. + ! Initialize object for combined gas + aerosol + cloud optics. + ! Allocates arrays for properties represented on g-points. errmsg = atm_optics_sw%alloc_2str(nday, nlay, kdist_sw) if (len_trim(errmsg) > 0) then call endrun(sub//': ERROR: gas_optics_sw%alloc_2str: '//trim(errmsg)) end if - ! Init and allocate arrays in aerosol optics object. + ! Initialize object for SW aerosol optics. Allocates arrays + ! for properties represented by band. errmsg = aer_sw%alloc_2str(nday, nlay, kdist_sw%get_band_lims_wavenumber()) if (len_trim(errmsg) > 0) then call endrun(sub//': ERROR: aer_sw%alloc_2str: '//trim(errmsg)) @@ -1281,7 +1263,7 @@ subroutine radiation_tend( & call set_sw_diags() if (write_output) then - call radiation_output_sw(lchnk, ncol, icall, rd, pbuf, cam_out) ! QRS = qrs/cpair; whatever qrs is in pbuf + call radiation_output_sw(lchnk, ncol, icall, rd, pbuf, cam_out) end if end if ! (active_calls(icall)) @@ -1299,64 +1281,34 @@ subroutine radiation_tend( & if (dolw) then - call ice_cloud_get_rad_props_lw(state, pbuf, ice_lw_abs) - - call liquid_cloud_get_rad_props_lw(state, pbuf, liq_lw_abs) - - cld_lw_abs(:,:ncol,:) = liq_lw_abs(:,:ncol,:) + ice_lw_abs(:,:ncol,:) - - - if (cldfsnow_idx > 0) then - ! add in snow - call snow_cloud_get_rad_props_lw(state, pbuf, snow_lw_abs) - do i = 1, ncol - do k = 1, pver - if (cldfprime(i,k) > 0._r8) then - c_cld_lw_abs(:,i,k) = ( cldfsnow(i,k)*snow_lw_abs(:,i,k) & - + cld(i,k)*cld_lw_abs(:,i,k) )/cldfprime(i,k) - else - c_cld_lw_abs(:,i,k) = 0._r8 - end if - end do - end do - else - c_cld_lw_abs(:,:ncol,:) = cld_lw_abs(:,:ncol,:) + ! Initialize object for Planck sources. + errmsg = sources_lw%alloc(ncol, nlay, kdist_lw) + if (len_trim(errmsg) > 0) then + call endrun(sub//': ERROR, sources_lw%alloc: '//trim(errmsg)) end if - if (cldfgrau_idx > 0 .and. graupel_in_rad) then - ! add in graupel - call grau_cloud_get_rad_props_lw(state, pbuf, grau_lw_abs) - do i = 1, ncol - do k = 1, pver - if (cldfprime(i,k) > 0._r8) then - c_cld_lw_abs(:,i,k) = ( cldfgrau(i,k)*grau_lw_abs(:,i,k) & - + cld(i,k)*c_cld_lw_abs(:,i,k) )/cldfprime(i,k) - else - c_cld_lw_abs(:,i,k) = 0._r8 - end if - end do - end do + ! Set cloud optical properties in cloud_lw object. + call rrtmgp_set_cloud_lw( & + state, pbuf, nlay, cld, cldfsnow, & + cldfgrau, cldfprime, graupel_in_rad, kdist_lw, cloud_lw, & + cld_lw_abs_cloudsim, snow_lw_abs_cloudsim, grau_lw_abs_cloudsim ) + + ! Initialize object for gas concentrations + errmsg = gas_concs_lw%init(gaslist_lc) + if (len_trim(errmsg) > 0) then + call endrun(sub//': ERROR, gas_concs_lw%init: '//trim(errmsg)) end if - ! cloud_lw : cloud optical properties. - call initialize_rrtmgp_cloud_optics_lw(ncol, nlay, kdist_lw, cloud_lw) - - call rrtmgp_set_cloud_lw(state, nlwbands, cldfprime, c_cld_lw_abs, kdist_lw, & - cloud_lw) - - ! initialize/allocate object for aerosol optics - errmsg = aer_lw%alloc_1scl(ncol, & - nlay, & - kdist_lw%get_band_lims_wavenumber(), & - name='longwave aerosol optics') + ! Initialize object for combined gas + aerosol + cloud optics. + errmsg = atm_optics_lw%alloc_1scl(ncol, nlay, kdist_lw) if (len_trim(errmsg) > 0) then - call endrun(sub//': ERROR: aer_lw%alloc_1scalar: '//trim(errmsg)) + call endrun(sub//': ERROR: gas_optics_lw%alloc_1scl: '//trim(errmsg)) end if - ! initialize object for gas concentrations - errmsg = gas_concs_lw%init(gaslist_lc) + ! Initialize object for LW aerosol optics. + errmsg = aer_lw%alloc_1scl(ncol, nlay, kdist_lw%get_band_lims_wavenumber()) if (len_trim(errmsg) > 0) then - call endrun(sub//': ERROR, gas_concs_lw%init: '//trim(errmsg)) + call endrun(sub//': ERROR: aer_lw%alloc_1scl: '//trim(errmsg)) end if ! The climate (icall==0) calculation must occur last. @@ -1364,53 +1316,50 @@ subroutine radiation_tend( & if (active_calls(icall)) then + ! Set gas volume mixing ratios for this call in gas_concs_lw. call rrtmgp_set_gases_lw(icall, state, pbuf, nlay, gas_concs_lw) - call aer_rad_props_lw( & ! get absorption optical depth - icall, & ! input - state, & ! input - pbuf, & ! input - aer_lw_abs & ! outut - ) - call rrtmgp_set_aer_lw( & ! put absorption optical depth into aer_lw - ncol, & ! input - nlwbands, & ! input - aer_lw_abs, & ! input - aer_lw & ! output, %tau, ordered bottom-to-top - ) + ! Compute the gas optics and Planck sources. + errmsg = kdist_lw%gas_optics( & + pmid_rad, pint_rad, t_rad, t_sfc, gas_concs_lw, & + atm_optics_lw, sources_lw) + + ! Set LW aerosol optical properties in the aer_lw object. + call rrtmgp_set_aer_lw(icall, state, pbuf, aer_lw) - ! check that optical properties are in bounds: - call clipper(cloud_lw%tau, 0._r8, huge(cloud_lw%tau)) - call clipper(aer_lw%tau, 0._r8, huge(aer_lw%tau)) - - ! Compute LW fluxes - errmsg = rte_lw(kdist_lw, & ! input - gas_concs_lw, & ! input, (rrtmgp_set_gases_lw) - pmid_rad, & ! input, (rrtmgp_set_state) - t_rad, & ! input, (rrtmgp_set_state) - pint_rad, & ! input, (rrtmgp_set_state) - t_sfc, & ! input (rrtmgp_set_state) - emis_sfc, & ! input (rrtmgp_set_state) - cloud_lw, & ! input, (rrtmgp_set_cloud_lw) - flw, & ! output - flwc, & ! output - aer_props=aer_lw & ! optional input, (rrtmgp_set_aer_lw) - ) ! note inc_flux is an optional input, but as defined in set_rrtmgp_state, it is only for shortwave + ! Increment the gas optics by the aerosol optics. + errmsg = aer_lw%increment(atm_optics_lw) + if (len_trim(errmsg) > 0) then + call endrun(sub//': ERROR in aer_lw%increment: '//trim(errmsg)) + end if + + ! Compute clear-sky LW fluxes + errmsg = rte_lw(atm_optics_lw, top_at_1, sources_lw, emis_sfc, flwc) + if (len_trim(errmsg) > 0) then + call endrun(sub//': ERROR in clear-sky rte_lw: '//trim(errmsg)) + end if + + ! Increment the gas+aerosol optics by the cloud optics. + errmsg = cloud_lw%increment(atm_optics_lw) + if (len_trim(errmsg) > 0) then + call endrun(sub//': ERROR in cloud_lw%increment: '//trim(errmsg)) + end if + + ! Compute all-sky LW fluxes + errmsg = rte_lw(atm_optics_lw, top_at_1, sources_lw, emis_sfc, flw) if (len_trim(errmsg) > 0) then - call endrun(sub//': ERROR: rte_lw: '//trim(errmsg)) + call endrun(sub//': ERROR in all-sky rte_lw: '//trim(errmsg)) end if - ! - ! -- longwave output -- - ! - call set_lw_diags() ! Reverse direction of LW fluxes back to TOP-to-BOTTOM - ! And derive LW dry static energy tendency (QRL, rd%QRLC (J/kg/s)) + + ! Transform RRTMGP outputs to CAM outputs and compute heating rates. + call set_lw_diags() + if (write_output) then - ! QRL retrieved from pbuf and divided by cpair [(J/(kg s)) / (J/(K kg)) = K/s] call radiation_output_lw(lchnk, ncol, icall, rd, pbuf, cam_out) end if - end if - end do + end if ! (active_calls(icall)) + end do ! loop over diagnostic calcs (icall) else if (conserve_energy) then @@ -1430,7 +1379,7 @@ subroutine radiation_tend( & if (docosp) then emis(:,:) = 0._r8 - emis(:ncol,:) = 1._r8 - exp(-cld_lw_abs(idx_lw_cloudsim,:ncol,:)) + emis(:ncol,:) = 1._r8 - exp(-cld_lw_abs_cloudsim(:ncol,:)) call outfld('EMIS', emis, pcols, lchnk) ! compute grid-box mean SW and LW snow optical depth for use by COSP @@ -1445,11 +1394,11 @@ subroutine radiation_tend( & if (cldfgrau_idx > 0 .and. graupel_in_rad) then gb_snow_tau(i,k) = snow_tau_cloudsim(i,k)*cldfsnow(i,k) + & grau_tau_cloudsim(i,k)*cldfgrau(i,k) - gb_snow_lw(i,k) = snow_lw_abs(idx_lw_cloudsim,i,k)*cldfsnow(i,k) + & - grau_lw_abs(idx_lw_cloudsim,i,k)*cldfgrau(i,k) + gb_snow_lw(i,k) = snow_lw_abs_cloudsim(i,k)*cldfsnow(i,k) + & + grau_lw_abs_cloudsim(i,k)*cldfgrau(i,k) else gb_snow_tau(i,k) = snow_tau_cloudsim(i,k)*cldfsnow(i,k) - gb_snow_lw(i,k) = snow_lw_abs(idx_lw_cloudsim,i,k)*cldfsnow(i,k) + gb_snow_lw(i,k) = snow_lw_abs_cloudsim(i,k)*cldfsnow(i,k) end if end if end do @@ -1471,16 +1420,11 @@ subroutine radiation_tend( & end if end if ! docosp - else ! --> radiative flux calculations not updated - ! convert radiative heating rates from Q*dp to Q for energy conservation - ! qrs and qrl are whatever are in pbuf - ! since those might have been multiplied by pdel, we actually need to divide by pdel - ! to get back to what we want, which is a DSE tendency. - ! ** if you change qrs and qrl from J/kg/s here, then it won't be a DSE tendency, - ! yet it is expected to be in radheat_tend to get ptend%s - ! Does not matter if qrs and qrl are zero on these time steps - - ! this completes the conserve_energy logic, since neither sw nor lw ran + else + ! When radiative flux calculations not done, the quantity Q*dp from the previous + ! timestep is retrieved from the physics buffer and used for this timestep. + ! It is first converted to Q (dry static energy tendency) before being passed + ! to radheat_tend. if (conserve_energy) then qrs(1:ncol,1:pver) = qrs(1:ncol,1:pver) / state%pdel(1:ncol,1:pver) qrl(1:ncol,1:pver) = qrl(1:ncol,1:pver) / state%pdel(1:ncol,1:pver) @@ -1488,19 +1432,12 @@ subroutine radiation_tend( & end if ! if (dosw .or. dolw) then - ! ------------------------------------------------------------------------ - ! - ! After any radiative transfer is done: output & convert fluxes to heating - ! - - call rad_data_write(pbuf, state, cam_in, coszrs) ! output rad inputs and resulting heating rates - - ! NET RADIATIVE HEATING TENDENCY - ! INPUT: state, qrl, qrs, fsns, fsnt, flns, flnt, asdir - ! OUTPUT: - ! ptend%s = (qrs + qrl) - ! net_flx = fsnt - fsns - flnt + flns - ! pbuf is an argument, but *is not used* (qrl/qrs are pointers into it) + ! Output for PORT: Parallel Offline Radiative Transport + call rad_data_write(pbuf, state, cam_in, coszrs) + + ! Compute net radiative heating tendency. Note that the WACCM version + ! of radheat_tend merges upper atmosphere heating rates with those calculated + ! by RRTMGP. call radheat_tend(state, pbuf, ptend, qrl, qrs, fsns, & fsnt, flns, flnt, cam_in%asdir, net_flx) @@ -1514,8 +1451,8 @@ subroutine radiation_tend( & call outfld('HR', ftem, pcols, lchnk) end if - ! convert radiative heating rates to Q*dp for energy conservation - ! QRS & QRL should be in J/(kg s) (dry static energy tendency); not sure where this goes after radiation. + ! The radiative heating rates are carried in the physics buffer across timesteps + ! as Q*dp (for energy conservation). if (conserve_energy) then qrs(1:ncol,1:pver) = qrs(1:ncol,1:pver) * state%pdel(1:ncol,1:pver) qrl(1:ncol,1:pver) = qrl(1:ncol,1:pver) * state%pdel(1:ncol,1:pver) @@ -1532,6 +1469,7 @@ subroutine radiation_tend( & call free_fluxes(fsw) call free_fluxes(fswc) + call sources_lw%finalize() call free_optics_lw(cloud_lw) call free_optics_lw(aer_lw) call free_fluxes(flw) @@ -1585,8 +1523,8 @@ subroutine set_sw_diags() fsds(idxday(i)) = fsw%flux_dn(i, nlay+1) rd%fsdsc(idxday(i)) = fswc%flux_dn(i, nlay+1) rd%fsutoa(idxday(i)) = fsw%flux_up(i, 1) - rd%fsntoa(idxday(i)) = fsw%flux_net(i, 1) ! net sw flux at TOA (*NOT* the same as fsnt) - rd%fsntoac(idxday(i)) = fswc%flux_net(i, 1) ! net sw clearsky flux at TOA (*NOT* the same as fsntc) + rd%fsntoa(idxday(i)) = fsw%flux_net(i, 1) + rd%fsntoac(idxday(i)) = fswc%flux_net(i, 1) rd%solin(idxday(i)) = fswc%flux_dn(i, 1) rd%flux_sw_up(idxday(i),ktopcam:) = fsw%flux_up(i,ktoprad:) rd%flux_sw_dn(idxday(i),ktopcam:) = fsw%flux_dn(i,ktoprad:) @@ -1789,6 +1727,7 @@ subroutine radiation_output_sw(lchnk, ncol, icall, rd, pbuf, cam_out) call outfld('SOLIN'//diag(icall), rd%solin, pcols, lchnk) + ! QRS is output as temperature tendency. call outfld('QRS'//diag(icall), qrs(:ncol,:)/cpair, ncol, lchnk) call outfld('QRSC'//diag(icall), rd%qrsc(:ncol,:)/cpair, ncol, lchnk) @@ -2556,27 +2495,6 @@ end subroutine reset_fluxes !========================================================================================= -subroutine initialize_rrtmgp_cloud_optics_lw(ncol, nlevels, kdist, optics) - - integer, intent(in) :: ncol, nlevels - type(ty_gas_optics_rrtmgp), intent(in) :: kdist - type(ty_optical_props_1scl), intent(out) :: optics - - integer :: ngpt - character(len=128) :: errmsg - character(len=128) :: sub = 'initialize_rrtmgp_cloud_optics_lw' - - ngpt = kdist%get_ngpt() - errmsg =optics%alloc_1scl(ncol, nlevels, kdist, name='longwave cloud optics') - if (len_trim(errmsg) > 0) then - call endrun(trim(sub)//': ERROR: optics%alloc_1scalar: '//trim(errmsg)) - end if - optics%tau(:ncol, :nlevels, :ngpt) = 0.0 - -end subroutine initialize_rrtmgp_cloud_optics_lw - -!========================================================================================= - subroutine free_optics_sw(optics) type(ty_optical_props_2str), intent(inout) :: optics @@ -2585,6 +2503,7 @@ subroutine free_optics_sw(optics) if (allocated(optics%ssa)) deallocate(optics%ssa) if (allocated(optics%g)) deallocate(optics%g) call optics%finalize() + end subroutine free_optics_sw !========================================================================================= @@ -2595,6 +2514,7 @@ subroutine free_optics_lw(optics) if (allocated(optics%tau)) deallocate(optics%tau) call optics%finalize() + end subroutine free_optics_lw !========================================================================================= @@ -2611,6 +2531,7 @@ subroutine free_fluxes(fluxes) if (associated(fluxes%bnd_flux_dn)) deallocate(fluxes%bnd_flux_dn) if (associated(fluxes%bnd_flux_net)) deallocate(fluxes%bnd_flux_net) if (associated(fluxes%bnd_flux_dn_dir)) deallocate(fluxes%bnd_flux_dn_dir) + end subroutine free_fluxes !========================================================================================= diff --git a/src/physics/rrtmgp/rrtmgp_driver.F90 b/src/physics/rrtmgp/rrtmgp_driver.F90 deleted file mode 100644 index c7e0ed5324..0000000000 --- a/src/physics/rrtmgp/rrtmgp_driver.F90 +++ /dev/null @@ -1,382 +0,0 @@ -! This code is based closely on mo_rrtmgp_clr_all_sky.F90 from -! RRTM for GCM Applications - Parallel (RRTMGP) -! -! Eli Mlawer and Robert Pincus -! Andre Wehe and Jennifer Delamere -! email: rrtmgp@aer.com -! -! Copyright 2017, Atmospheric and Environmental Research and -! Regents of the University of Colorado. All right reserved. -! -! Use and duplication is permitted under the terms of the -! BSD 3-clause license, see http://opensource.org/licenses/BSD-3-Clause -! - -! -! This module provides an interface to RRTMGP for a common use case -- -! users want to start from gas concentrations, pressures, and temperatures, -! and compute clear-sky (aerosol plus gases) and all-sky fluxes. -! The routines here have the same names as those in mo_rrtmgp_[ls]w; normally users -! will use either this module or the underling modules, but not both -! -module rrtmgp_driver - use mo_rte_kind, only: wp - ! use mo_gas_optics, only: ty_gas_optics ! replacing this with _rrtmgp version - - use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp - - use mo_gas_concentrations, only: ty_gas_concs - use mo_optical_props, only: ty_optical_props, & - ty_optical_props_arry, & - ty_optical_props_1scl, & - ty_optical_props_2str, & - ty_optical_props_nstr - use mo_source_functions, only: ty_source_func_lw - ! use mo_fluxes, only: ty_fluxes ! not needed b/c mo_fluxes_byband extends this type - use mo_fluxes_byband, only: ty_fluxes_byband - use mo_rte_lw, only: base_rte_lw => rte_lw - use mo_rte_sw, only: base_rte_sw => rte_sw - - use cam_logfile, only: iulog - - implicit none - - public :: rte_lw, rte_sw - -contains - ! -------------------------------------------------- - ! - ! Interfaces using clear (gas + aerosol) and all-sky categories, starting from - ! pressures, temperatures, and gas amounts for the gas contribution - ! - ! -------------------------------------------------- - function rte_lw(k_dist, gas_concs, p_lay, t_lay, p_lev, & - t_sfc, sfc_emis, cloud_props, & - allsky_fluxes, clrsky_fluxes, & - aer_props, col_dry, t_lev, inc_flux, n_gauss_angles) result(error_msg) - ! class(ty_gas_optics), intent(in ) :: k_dist !< derived type with spectral information - class(ty_gas_optics_rrtmgp), intent(in ) :: k_dist !< derived type with spectral information - - type(ty_gas_concs), intent(in ) :: gas_concs !< derived type encapsulating gas concentrations - real(wp), dimension(:,:), intent(in ) :: p_lay, t_lay !< pressure [Pa], temperature [K] at layer centers (ncol,nlay) - real(wp), dimension(:,:), intent(in ) :: p_lev !< pressure at levels/interfaces [Pa] (ncol,nlay+1) - real(wp), dimension(:), intent(in ) :: t_sfc !< surface temperature [K] (ncol) - real(wp), dimension(:,:), intent(in ) :: sfc_emis !< emissivity at surface [] (nband, ncol) - class(ty_optical_props_arry), intent(in ) :: cloud_props !< cloud optical properties (ncol,nlay,ngpt) - class(ty_fluxes_byband), intent(inout) :: allsky_fluxes, clrsky_fluxes ! 3/21 - _byband bpm - - ! Optional inputs - class(ty_optical_props_arry), & - optional, intent(in ) :: aer_props !< aerosol optical properties - real(wp), dimension(:,:), & - optional, intent(in ) :: col_dry !< Molecular number density (ncol, nlay) - real(wp), dimension(:,:), target, & - optional, intent(in ) :: t_lev !< temperature at levels [K] (ncol, nlay+1) - real(wp), dimension(:,:), target, & - optional, intent(in ) :: inc_flux !< incident flux at domain top [W/m2] (ncol, ngpts) - integer, optional, intent(in ) :: n_gauss_angles ! Number of angles used in Gaussian quadrature (no-scattering solution) - character(len=128) :: error_msg - ! -------------------------------- - ! Local variables - ! - class(ty_optical_props_arry), allocatable :: optical_props - type(ty_source_func_lw) :: sources - - integer :: ncol, nlay, ngpt, nband, nstr - logical :: top_at_1 - ! -------------------------------- - ! Problem sizes - ! - - error_msg = "" - - ncol = size(p_lay, 1) - nlay = size(p_lay, 2) - ngpt = k_dist%get_ngpt() - nband = k_dist%get_nband() - - top_at_1 = p_lay(1, 1) < p_lay(1, nlay) - - ! ------------------------------------------------------------------------------------ - ! Error checking - ! - if(present(aer_props)) then - if(any([aer_props%get_ncol(), & - aer_props%get_nlay()] /= [ncol, nlay])) & - error_msg = "rrtmpg_lw: aerosol properties inconsistently sized" - if(.not. any(aer_props%get_ngpt() /= [ngpt, nband])) & - error_msg = "rrtmpg_lw: aerosol properties inconsistently sized" - end if - - if(present(t_lev)) then - if(any([size(t_lev, 1), & - size(t_lev, 2)] /= [ncol, nlay+1])) & - error_msg = "rrtmpg_lw: t_lev inconsistently sized" - end if - - if(present(inc_flux)) then - if(any([size(inc_flux, 1), & - size(inc_flux, 2)] /= [ncol, ngpt])) & - error_msg = "rrtmpg_lw: incident flux inconsistently sized" - end if - if(len_trim(error_msg) > 0) return - - ! ------------------------------------------------------------------------------------ - ! Optical properties arrays - ! - select type(cloud_props) - class is (ty_optical_props_1scl) ! No scattering - allocate(ty_optical_props_1scl::optical_props) - class is (ty_optical_props_2str) - allocate(ty_optical_props_2str::optical_props) - class is (ty_optical_props_nstr) - allocate(ty_optical_props_nstr::optical_props) - nstr = size(cloud_props%tau,1) - end select - - error_msg = optical_props%init(k_dist) - - if(len_trim(error_msg) > 0) return - select type (optical_props) - class is (ty_optical_props_1scl) ! No scattering - error_msg = optical_props%alloc_1scl(ncol, nlay) - class is (ty_optical_props_2str) - error_msg = optical_props%alloc_2str(ncol, nlay) - class is (ty_optical_props_nstr) - error_msg = optical_props%alloc_nstr(nstr, ncol, nlay) - end select - if (error_msg /= '') return - - ! - ! Source function - ! - error_msg = sources%init(k_dist) - error_msg = sources%alloc(ncol, nlay) - if (error_msg /= '') return - - ! ------------------------------------------------------------------------------------ - ! Clear skies - ! - ! Gas optical depth -- pressure need to be expressed as Pa - ! - error_msg = k_dist%gas_optics(p_lay, p_lev, t_lay, t_sfc, gas_concs, & - optical_props, sources) !, & - ! col_dry, t_lev) - ! col_dry & t_lev are optional, and we have not provided them. - if (error_msg /= '') then - return - end if - - ! ---------------------------------------------------- - ! Clear sky is gases + aerosols (if they're supplied) - ! - if (present(aer_props)) then - error_msg = aer_props%increment(optical_props) - end if - if (error_msg /= '') then - return - end if - - error_msg = base_rte_lw(optical_props, top_at_1, sources, & - sfc_emis, clrsky_fluxes, & - inc_flux, n_gauss_angles) - if (error_msg /= '') then - return - end if - - ! ------------------------------------------------------------------------------------ - ! All-sky fluxes = clear skies + clouds - ! - error_msg = cloud_props%increment(optical_props) - if(error_msg /= '') return - - error_msg = base_rte_lw(optical_props, top_at_1, sources, & - sfc_emis, allsky_fluxes, & - inc_flux, n_gauss_angles) - - call sources%finalize() - call optical_props%finalize() - - end function rte_lw - ! -------------------------------------------------- - ! -------------------------------------------------- - ! -------------------------------------------------- - function rte_sw(k_dist, & - gas_concs, & - p_lay, & - t_lay, & - p_lev, & - mu0, & - sfc_alb_dir, & - sfc_alb_dif, & - cloud_props, & - allsky_fluxes, & - clrsky_fluxes, & - aer_props, & - col_dry, & - inc_flux, & !< optional input: total solar irradiance (ncol, ngpt) - tsi_scaling, & !< optional input: scalar scaling factor for TSI - tsi_scaling_gpt & !< optional input: scaling for TSI by gpt - ) result(error_msg) - class(ty_gas_optics_rrtmgp), intent(in ) :: k_dist !< derived type with spectral information - - type(ty_gas_concs), intent(in ) :: gas_concs !< derived type encapsulating gas concentrations - real(wp), dimension(:,:), intent(in ) :: p_lay, t_lay !< pressure [Pa], temperature [K] at layer centers (ncol,nlay) - real(wp), dimension(:,:), intent(in ) :: p_lev !< pressure at levels/interfaces [Pa] (ncol,nlay+1) - real(wp), dimension(: ), intent(in ) :: mu0 !< cosine of solar zenith angle - real(wp), dimension(:,:), intent(in ) :: sfc_alb_dir, sfc_alb_dif - ! surface albedo for direct and diffuse radiation (band, col) - class(ty_optical_props_arry), intent(in ) :: cloud_props !< cloud optical properties (ncol,nlay,ngpt) - class(ty_fluxes_byband), intent(inout) :: allsky_fluxes, clrsky_fluxes - - ! Optional inputs - class(ty_optical_props_arry), target, & - optional, intent(in ) :: aer_props !< aerosol optical properties - real(wp), dimension(:,:), & - optional, intent(in ) :: col_dry, & !< Molecular number density (ncol, nlay) - inc_flux !< incident flux at domain top [W/m2] (ncol, ngpts) - real(wp), optional, intent(in ) :: tsi_scaling !< Optional scaling for total solar irradiance (SCALAR) - real(wp), dimension(:), optional, intent(in ) :: tsi_scaling_gpt !< Optional scaling of solar irradiance by gpoint - - - character(len=128) :: error_msg - ! -------------------------------- - ! Local variables - ! - class(ty_optical_props_arry), allocatable :: optical_props - real(wp), dimension(:,:), allocatable :: toa_flux - integer :: ncol, nlay, ngpt, nband, nstr - integer :: icol - logical :: top_at_1 - ! -------------------------------- - ! Problem sizes - ! - - error_msg = "" - - ncol = size(p_lay, 1) - nlay = size(p_lay, 2) - ngpt = k_dist%get_ngpt() - nband = k_dist%get_nband() - - top_at_1 = p_lay(1, 1) < p_lay(1, nlay) - - ! ------------------------------------------------------------------------------------ - ! Error checking - ! - if(present(aer_props)) then - if(any([aer_props%get_ncol(), & - aer_props%get_nlay()] /= [ncol, nlay])) & - error_msg = "rrtmgp_driver rte_sw: aerosol properties inconsistently sized" - if(.not. any(aer_props%get_ngpt() /= [ngpt, nband])) & - error_msg = "rrtmgp_driver rte_sw: aerosol properties inconsistently sized" - end if - - if (present(tsi_scaling) .and. (present(tsi_scaling_gpt))) then - error_msg = "rrtmgp_driver rte_sw: Only one of [tsi_scaling, tsi_scaling_gpt] may be specified." - end if - - if(present(tsi_scaling)) then - if(tsi_scaling <= 0._wp) then - error_msg = "rrtmgp_driver rte_sw: tsi_scaling is < 0" - end if - end if - - if(present(inc_flux)) then - if(any([size(inc_flux, 1), size(inc_flux, 2)] /= [ncol, ngpt])) then - error_msg = "rrtmgp_driver rte_sw: incident flux inconsistently sized" - end if - end if - if(len_trim(error_msg) > 0) return - - ! ------------------------------------------------------------------------------------ - ! - ! Optical properties arrays - ! - select type(cloud_props) - class is (ty_optical_props_1scl) ! No scattering - allocate(ty_optical_props_1scl::optical_props) - class is (ty_optical_props_2str) - allocate(ty_optical_props_2str::optical_props) - class is (ty_optical_props_nstr) - allocate(ty_optical_props_nstr::optical_props) - nstr = cloud_props%get_nmom() - end select - - error_msg = optical_props%init(k_dist%get_band_lims_wavenumber(), & - k_dist%get_band_lims_gpoint()) - if(len_trim(error_msg) > 0) return - select type (optical_props) - class is (ty_optical_props_1scl) ! No scattering - error_msg = optical_props%alloc_1scl(ncol, nlay) - class is (ty_optical_props_2str) - error_msg = optical_props%alloc_2str(ncol, nlay) - class is (ty_optical_props_nstr) - error_msg = optical_props%alloc_nstr(nstr, ncol, nlay) - end select - if (error_msg /= '') return - - allocate(toa_flux(ncol, ngpt)) - ! ------------------------------------------------------------------------------------ - ! Clear skies - ! - ! Gas optical depth -- pressure need to be expressed as Pa - ! - error_msg = k_dist%gas_optics(p_lay, p_lev, t_lay, gas_concs, & - optical_props, toa_flux) ! , & - ! col_dry) - ! col_dry is optional and we have not provided it. - if (error_msg /= '') return - ! - ! If users have supplied an incident flux, use that - ! - if (present(inc_flux)) then - toa_flux(:,:) = inc_flux(:,:) - end if - ! - ! If there is a scaling provided, apply it - ! - if(present(tsi_scaling)) toa_flux(:,:) = toa_flux(:,:) * tsi_scaling - - if(present(tsi_scaling_gpt)) then - do icol = 1,ncol - toa_flux(icol,:) = toa_flux(icol,:) * tsi_scaling_gpt - end do - end if - ! ---------------------------------------------------- - ! Clear sky is gases + aerosols (if they're supplied) - ! - if(present(aer_props)) error_msg = aer_props%increment(optical_props) - if(error_msg /= '') return - - error_msg = base_rte_sw(optical_props, top_at_1, & - mu0, toa_flux, & - sfc_alb_dir, sfc_alb_dif, & - clrsky_fluxes) - - if(error_msg /= '') return - ! ------------------------------------------------------------------------------------ - ! All-sky fluxes = clear skies + clouds - ! - error_msg = cloud_props%increment(optical_props) - if (error_msg /= '') then - return - end if - - error_msg = base_rte_sw(optical_props, & ! (in) Optical properties provided as arrays - top_at_1, & ! (in) Is the top of the domain at index 1? - mu0, & ! (in) cosine of solar zenith angle (ncol) - toa_flux, & ! (in) incident flux at top of domain [W/m2] (ncol, ngpt) - sfc_alb_dir, & ! (in) surface albedo, direct (nband, ncol) - sfc_alb_dif, & ! (in) surface albedo, diffuse (nband, ncol) - allsky_fluxes & ! (inout) Class describing output calculations (ty_fluxes_byband) - ) - - - call optical_props%finalize() - if (allocated(toa_flux)) then - deallocate(toa_flux) - end if - end function rte_sw - -end module rrtmgp_driver diff --git a/src/physics/rrtmgp/rrtmgp_inputs.F90 b/src/physics/rrtmgp/rrtmgp_inputs.F90 index fc6c5d4c4e..e629950c64 100644 --- a/src/physics/rrtmgp/rrtmgp_inputs.F90 +++ b/src/physics/rrtmgp/rrtmgp_inputs.F90 @@ -17,9 +17,9 @@ module rrtmgp_inputs use physics_buffer, only: physics_buffer_desc use camsrfexch, only: cam_in_t -use radconstants, only: nswbands, nlwbands, nswgpts, get_sw_spectral_boundaries, & - idx_sw_diag, idx_sw_cloudsim -use radconstants, only: nradgas, gaslist +use radconstants, only: nradgas, gaslist, nswbands, nlwbands, nswgpts, nlwgpts, & + get_sw_spectral_boundaries, idx_sw_diag, idx_sw_cloudsim, & + idx_lw_cloudsim use rad_constituents, only: rad_cnst_get_gas @@ -302,7 +302,8 @@ end function get_molar_mass_ratio subroutine rad_gas_get_vmr(icall, gas_name, state, pbuf, nlay, numactivecols, gas_concs, idxday) - ! Set volume mixing ratio in gas_concs data structure. + ! Set volume mixing ratio in gas_concs object. + ! The gas_concs%set_vmr method copies data into internally allocated storage. integer, intent(in) :: icall ! index of climate/diagnostic radiation call character(len=*), intent(in) :: gas_name @@ -466,57 +467,145 @@ end subroutine rrtmgp_set_gases_sw !================================================================================================== -subroutine rrtmgp_set_cloud_lw(state, nlwbands, cldfrac, c_cld_lw_abs, lwkDist, cloud_lw) +subroutine rrtmgp_set_cloud_lw( & + state, pbuf, nlay, cld, cldfsnow, & + cldfgrau, cldfprime, graupel_in_rad, kdist_lw, cloud_lw, & + cld_lw_abs_cloudsim, snow_lw_abs_cloudsim, grau_lw_abs_cloudsim ) + ! Compute combined cloud optical properties. ! Create MCICA stochastic arrays for cloud LW optical properties. + ! Initialize optical properties object (cloud_lw) and load with MCICA columns. ! arguments - type(physics_state), intent(in) :: state - integer, intent(in) :: nlwbands - real(r8), intent(in) :: cldfrac(pcols,pver) ! combined cloud fraction (snow plus regular) - real(r8), intent(in) :: c_cld_lw_abs(nlwbands,pcols,pver) ! combined cloud absorption optics depth (LW) - class(ty_gas_optics_rrtmgp), intent(in) :: lwkDist - type(ty_optical_props_1scl), intent(inout) :: cloud_lw - ! local vars - integer :: i - integer :: ncol - integer :: ngptlw - real(r8), allocatable :: taucmcl(:,:,:) ! cloud optical depth [mcica] - character(len=32) :: sub = 'rrtmgp_set_cloud_lw' + type(physics_state), intent(in) :: state + type(physics_buffer_desc), pointer :: pbuf(:) + integer, intent(in) :: nlay ! number of layers in radiation calculation (may include "extra layer") + real(r8), pointer :: cld(:,:) ! cloud fraction (liq+ice) + real(r8), pointer :: cldfsnow(:,:) ! cloud fraction of just "snow clouds" + real(r8), pointer :: cldfgrau(:,:) ! cloud fraction of just "graupel clouds" + real(r8), intent(in) :: cldfprime(pcols,pver) ! combined cloud fraction + + logical, intent(in) :: graupel_in_rad ! use graupel in radiation code + class(ty_gas_optics_rrtmgp), intent(in) :: kdist_lw + type(ty_optical_props_1scl), intent(out) :: cloud_lw + + ! Diagnostic outputs + real(r8), intent(out) :: cld_lw_abs_cloudsim(pcols,pver) ! in-cloud snow optical depth (for COSP) + real(r8), intent(out) :: snow_lw_abs_cloudsim(pcols,pver)! in-cloud snow optical depth (for COSP) + real(r8), intent(out) :: grau_lw_abs_cloudsim(pcols,pver)! in-cloud Graupel optical depth (for COSP) + + ! Local variables + + integer :: i, k, ncol + integer :: igpt, nver + + ! cloud radiative parameters are "in cloud" not "in cell" + real(r8) :: liq_lw_abs(nlwbands,pcols,pver) ! liquid absorption optics depth (LW) + real(r8) :: ice_lw_abs(nlwbands,pcols,pver) ! ice absorption optics depth (LW) + real(r8) :: cld_lw_abs(nlwbands,pcols,pver) ! cloud absorption optics depth (LW) + real(r8) :: snow_lw_abs(nlwbands,pcols,pver) ! snow absorption optics depth (LW) + real(r8) :: grau_lw_abs(nlwbands,pcols,pver) ! graupel absorption optics depth (LW) + real(r8) :: c_cld_lw_abs(nlwbands,pcols,pver) ! combined cloud absorption optics depth (LW) + + ! Arrays for converting from CAM chunks to RRTMGP inputs. + real(r8), allocatable :: cldf(:,:) + real(r8), allocatable :: tauc(:,:,:) + real(r8), allocatable :: taucmcl(:,:,:) + character(len=128) :: errmsg + character(len=*), parameter :: sub = 'rrtmgp_set_cloud_lw' !-------------------------------------------------------------------------------- + ncol = state%ncol - ngptlw = lwkDist%get_ngpt() - allocate(taucmcl(ngptlw,ncol,pver)) + ! Combine the cloud optical properties. These calculations are done on CAM "chunks". + + ! gammadist liquid optics + call liquid_cloud_get_rad_props_lw(state, pbuf, liq_lw_abs) + ! Mitchell ice optics + call ice_cloud_get_rad_props_lw(state, pbuf, ice_lw_abs) + + cld_lw_abs(:,:ncol,:) = liq_lw_abs(:,:ncol,:) + ice_lw_abs(:,:ncol,:) + + if (associated(cldfsnow)) then + ! add in snow + call snow_cloud_get_rad_props_lw(state, pbuf, snow_lw_abs) + do i = 1, ncol + do k = 1, pver + if (cldfprime(i,k) > 0._r8) then + c_cld_lw_abs(:,i,k) = ( cldfsnow(i,k)*snow_lw_abs(:,i,k) & + + cld(i,k)*cld_lw_abs(:,i,k) )/cldfprime(i,k) + else + c_cld_lw_abs(:,i,k) = 0._r8 + end if + end do + end do + else + c_cld_lw_abs(:,:ncol,:) = cld_lw_abs(:,:ncol,:) + end if + + ! add in graupel + if (associated(cldfgrau) .and. graupel_in_rad) then + call grau_cloud_get_rad_props_lw(state, pbuf, grau_lw_abs) + do i = 1, ncol + do k = 1, pver + if (cldfprime(i,k) > 0._r8) then + c_cld_lw_abs(:,i,k) = ( cldfgrau(i,k)*grau_lw_abs(:,i,k) & + + cld(i,k)*c_cld_lw_abs(:,i,k) )/cldfprime(i,k) + else + c_cld_lw_abs(:,i,k) = 0._r8 + end if + end do + end do + end if + + ! Cloud optics for COSP + cld_lw_abs_cloudsim = cld_lw_abs(idx_lw_cloudsim,:,:) + snow_lw_abs_cloudsim = snow_lw_abs(idx_lw_cloudsim,:,:) + grau_lw_abs_cloudsim = grau_lw_abs(idx_lw_cloudsim,:,:) - !***NB*** this code is currently set up to create the subcols for all model layers - ! not just the ones where the radiation calc is being done. Need - ! to subset cldfrac and c_cld_lw_abs to avoid computing unneeded random numbers. + ! Extract just the layers of CAM where RRTMGP does calculations. + + ! number of CAM's layers in radiation calculation. Does not include the "extra layer". + nver = pver - ktopcam + 1 + + allocate( & + cldf(ncol,nver), & + tauc(nlwbands,ncol,nver), & + taucmcl(nlwgpts,ncol,nver) ) + + ! Subset "chunk" data so just the number of CAM layers in the + ! radiation calculation are used by MCICA to produce subcolumns. + cldf = cldfprime(:ncol, ktopcam:) + tauc = c_cld_lw_abs(:, :ncol, ktopcam:) call mcica_subcol_lw( & - lwkdist, & ! spectral information - nlwbands, & ! number of spectral bands - ngptlw, & ! number of subcolumns (g-point intervals) - ncol, & ! number of columns - ngptlw, & ! changeseed, should be set to number of subcolumns - state%pmid, & ! layer pressures (Pa) - cldfrac, & ! layer cloud fraction - c_cld_lw_abs, & ! cloud optical depth - taucmcl & ! OUTPUT: subcolumn cloud optical depth [mcica] (ngpt, ncol, nver) - ) + kdist_lw, nlwbands, nlwgpts, ncol, nver, & + nlwgpts, state%pmid, cldf, tauc, taucmcl ) + + errmsg =cloud_lw%alloc_1scl(ncol, nlay, kdist_lw) + if (len_trim(errmsg) > 0) then + call endrun(sub//': ERROR: cloud_lw%alloc_1scalar: '//trim(errmsg)) + end if ! If there is an extra layer in the radiation then this initialization ! will provide zero optical depths there. cloud_lw%tau = 0.0_r8 - do i = 1, ngptlw + + ! Set the properties on g-points. + do i = 1, nlwgpts cloud_lw%tau(:ncol, ktoprad:, i) = taucmcl(i, :ncol, ktopcam:) end do + + ! validate checks that: tau > 0 errmsg = cloud_lw%validate() if (len_trim(errmsg) > 0) then call endrun(sub//': ERROR: cloud_lw%validate: '//trim(errmsg)) end if - deallocate(taucmcl) + + ! All information is in cloud_lw, now deallocate local vars. + deallocate(cldf, tauc, taucmcl) + end subroutine rrtmgp_set_cloud_lw !================================================================================================== @@ -798,23 +887,38 @@ end subroutine rrtmgp_set_cloud_sw !================================================================================================== -subroutine rrtmgp_set_aer_lw(ncol, nlwbands, aer_lw_abs, aer_lw) +subroutine rrtmgp_set_aer_lw(icall, state, pbuf, aer_lw) - ! Load aerosol optical properties into the RRTMGP object. + ! Load LW aerosol optical properties into the RRTMGP object. + + ! Arguments + integer, intent(in) :: icall + type(physics_state), target, intent(in) :: state + type(physics_buffer_desc), pointer :: pbuf(:) - ! arguments - integer, intent(in) :: ncol - integer, intent(in) :: nlwbands - real(r8), intent(in) :: aer_lw_abs(pcols,pver,nlwbands) ! aerosol absorption optics depth (LW) type(ty_optical_props_1scl), intent(inout) :: aer_lw - character(len=32) :: sub = 'rrtmgp_set_aer_lw' - character(len=128) :: errmsg + ! Local variables + integer :: ncol + + ! Aerosol LW absorption optical depth + real(r8) :: aer_lw_abs (pcols,pver,nlwbands) + + character(len=*), parameter :: sub = 'rrtmgp_set_aer_lw' + character(len=128) :: errmsg !-------------------------------------------------------------------------------- + + ncol = state%ncol + + ! Get aerosol longwave optical properties. + call aer_rad_props_lw(icall, state, pbuf, aer_lw_abs) + ! If there is an extra layer in the radiation then this initialization ! will provide zero optical depths there. aer_lw%tau = 0.0_r8 + aer_lw%tau(:ncol, ktoprad:, :) = aer_lw_abs(:ncol, ktopcam:, :) + errmsg = aer_lw%validate() if (len_trim(errmsg) > 0) then call endrun(sub//': ERROR: aer_lw%validate: '//trim(errmsg)) @@ -826,7 +930,7 @@ end subroutine rrtmgp_set_aer_lw subroutine rrtmgp_set_aer_sw( & icall, state, pbuf, nday, idxday, nnite, idxnite, aer_sw) - ! Load aerosol SW optical properties into the RRTMGP object. + ! Load SW aerosol optical properties into the RRTMGP object. ! Arguments integer, intent(in) :: icall From 49726ef7faba6cc63f255342855ac5732e5d79c7 Mon Sep 17 00:00:00 2001 From: Brian Eaton Date: Thu, 28 Sep 2023 19:11:14 -0400 Subject: [PATCH 159/291] misc cleanup; restore putting Q*dp in pbuf for energy conservation --- src/physics/rrtmgp/radiation.F90 | 141 ++++++--------------------- src/physics/rrtmgp/rrtmgp_inputs.F90 | 9 +- 2 files changed, 32 insertions(+), 118 deletions(-) diff --git a/src/physics/rrtmgp/radiation.F90 b/src/physics/rrtmgp/radiation.F90 index 46f108d507..9d551dd4c6 100644 --- a/src/physics/rrtmgp/radiation.F90 +++ b/src/physics/rrtmgp/radiation.F90 @@ -21,15 +21,12 @@ module radiation use time_manager, only: get_nstep, is_first_step, is_first_restart_step, & get_curr_calday, get_step_size -use rad_constituents, only: N_DIAG, rad_cnst_get_call_list, & - rad_cnst_get_gas, rad_cnst_out - +use rad_constituents, only: N_DIAG, rad_cnst_get_call_list, rad_cnst_get_gas, rad_cnst_out use rrtmgp_inputs, only: rrtmgp_inputs_init -use radconstants, only: nswbands, nlwbands, nswgpts, & - nradgas, gasnamelength, gaslist, & - set_wavenumber_bands +use radconstants, only: nradgas, gasnamelength, gaslist, nswbands, nlwbands, & + nswgpts, set_wavenumber_bands use cloud_rad_props, only: cloud_rad_props_init @@ -218,12 +215,6 @@ module radiation type(ty_gas_optics_rrtmgp) :: kdist_sw type(ty_gas_optics_rrtmgp) :: kdist_lw -! Mapping from RRTMG shortwave bands to RRTMGP. Currently needed to continue using -! the SW optics datasets from RRTMG (even thought there is a slight mismatch in the -! band boundaries of the 2 bands that overlap with the LW bands). -integer, parameter, dimension(14) :: rrtmg_to_rrtmgp_swbands = & - [ 14, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13 ] - ! lower case version of gaslist for RRTMGP character(len=gasnamelength) :: gaslist_lc(nradgas) @@ -405,7 +396,6 @@ real(r8) function radiation_nextsw_cday() logical :: dosw ! true => do shosrtwave calc integer :: offset ! offset for calendar day calculation integer :: dtime ! integer timestep size - real(r8):: calday ! calendar day of real(r8):: caldayp1 ! calendar day of next time-step !----------------------------------------------------------------------- @@ -419,7 +409,7 @@ real(r8) function radiation_nextsw_cday() nstep = nstep + 1 offset = offset + dtime if (radiation_do('sw', nstep)) then - radiation_nextsw_cday = get_curr_calday(offset=offset) + radiation_nextsw_cday = get_curr_calday(offset=offset) dosw = .true. end if end do @@ -1022,9 +1012,6 @@ subroutine radiation_tend( & character(len=128) :: errmsg character(len=*), parameter :: sub = 'radiation_tend' - - logical :: conserve_energy = .false. ! Flag to carry (QRS,QRL)*dp across time steps. - !-------------------------------------------------------------------------------------- lchnk = state%lchnk @@ -1043,8 +1030,8 @@ subroutine radiation_tend( & write_output = .true. end if - dosw = radiation_do('sw', get_nstep()) ! do shortwave heating calc this timestep? - dolw = radiation_do('lw', get_nstep()) ! do longwave heating calc this timestep? + dosw = radiation_do('sw', get_nstep()) ! do shortwave radiation calc this timestep? + dolw = radiation_do('lw', get_nstep()) ! do longwave radiation calc this timestep? ! Cosine solar zenith angle for current time step calday = get_curr_calday() @@ -1167,7 +1154,7 @@ subroutine radiation_tend( & cld_tau_cloudsim, snow_tau_cloudsim, grau_tau_cloudsim ) if (write_output) then - call radiation_output_cld(lchnk, ncol, rd) + call radiation_output_cld(lchnk, rd) end if ! If no daylight columns, can't create empty RRTMGP objects @@ -1270,9 +1257,9 @@ subroutine radiation_tend( & end do ! loop over diagnostic calcs (icall) else - if (conserve_energy) then - qrs(1:ncol,1:pver) = qrs(1:ncol,1:pver) / state%pdel(1:ncol,1:pver) - end if + ! SW calc not done. pbuf carries Q*dp across timesteps. + ! Convert to Q before calling radheat_tend. + qrs(:ncol,:) = qrs(:ncol,:) / state%pdel(:ncol,:) end if ! if (dosw) !=======================! @@ -1362,9 +1349,9 @@ subroutine radiation_tend( & end do ! loop over diagnostic calcs (icall) else - if (conserve_energy) then - qrl(1:ncol,1:pver) = qrl(1:ncol,1:pver) / state%pdel(1:ncol,1:pver) - end if + ! LW calc not done. pbuf carries Q*dp across timesteps. + ! Convert to Q before calling radheat_tend. + qrl(:ncol,:) = qrl(:ncol,:) / state%pdel(:ncol,:) end if ! if (dolw) deallocate( & @@ -1421,14 +1408,11 @@ subroutine radiation_tend( & end if ! docosp else - ! When radiative flux calculations not done, the quantity Q*dp from the previous - ! timestep is retrieved from the physics buffer and used for this timestep. - ! It is first converted to Q (dry static energy tendency) before being passed - ! to radheat_tend. - if (conserve_energy) then - qrs(1:ncol,1:pver) = qrs(1:ncol,1:pver) / state%pdel(1:ncol,1:pver) - qrl(1:ncol,1:pver) = qrl(1:ncol,1:pver) / state%pdel(1:ncol,1:pver) - end if + ! Radiative flux calculations not done. The quantity Q*dp is carried by the + ! physics buffer across timesteps. It must be converted to Q (dry static energy + ! tendency) before being passed to radheat_tend. + qrs(:ncol,:) = qrs(:ncol,:) / state%pdel(:ncol,:) + qrl(:ncol,:) = qrl(:ncol,:) / state%pdel(:ncol,:) end if ! if (dosw .or. dolw) then @@ -1453,10 +1437,8 @@ subroutine radiation_tend( & ! The radiative heating rates are carried in the physics buffer across timesteps ! as Q*dp (for energy conservation). - if (conserve_energy) then - qrs(1:ncol,1:pver) = qrs(1:ncol,1:pver) * state%pdel(1:ncol,1:pver) - qrl(1:ncol,1:pver) = qrl(1:ncol,1:pver) * state%pdel(1:ncol,1:pver) - end if + qrs(:ncol,:) = qrs(:ncol,:) * state%pdel(:ncol,:) + qrl(:ncol,:) = qrl(:ncol,:) * state%pdel(:ncol,:) if (.not. present(rd_out)) then deallocate(rd%fsdn, rd%fsdnc, rd%fsup, rd%fsupc, & @@ -1715,7 +1697,6 @@ subroutine radiation_output_sw(lchnk, ncol, icall, rd, pbuf, cam_out) real(r8), pointer :: fsnt(:) real(r8), pointer :: fsns(:) real(r8), pointer :: fsds(:) - real(r8), pointer :: su(:,:),sd(:,:),lu(:,:),ld(:,:) real(r8) :: ftem(pcols) !---------------------------------------------------------------------------- @@ -1775,12 +1756,11 @@ end subroutine radiation_output_sw !=============================================================================== -subroutine radiation_output_cld(lchnk, ncol, rd) +subroutine radiation_output_cld(lchnk, rd) ! Dump shortwave cloud optics information to history buffer. integer , intent(in) :: lchnk - integer, intent(in) :: ncol type(rad_out_t), intent(in) :: rd !---------------------------------------------------------------------------- @@ -1859,36 +1839,6 @@ end subroutine radiation_output_lw !=============================================================================== -subroutine calc_col_mean(state, mmr_pointer, mean_value) - - ! Compute the column mean mass mixing ratio. - - type(physics_state), intent(in) :: state - real(r8), dimension(:,:), pointer :: mmr_pointer ! mass mixing ratio (lev) - real(r8), dimension(pcols), intent(out) :: mean_value ! column mean mmr - - integer :: i, k, ncol - real(r8) :: ptot(pcols) - !----------------------------------------------------------------------- - - ncol = state%ncol - mean_value = 0.0_r8 - ptot = 0.0_r8 - - do k=1,pver - do i=1,ncol - mean_value(i) = mean_value(i) + mmr_pointer(i,k)*state%pdeldry(i,k) - ptot(i) = ptot(i) + state%pdeldry(i,k) - end do - end do - do i=1,ncol - mean_value(i) = mean_value(i) / ptot(i) - end do - -end subroutine calc_col_mean - -!========================================================================================= - subroutine coefs_init(coefs_file, available_gases, kdist) ! Read data from coefficients file. Initialize the kdist object. @@ -1916,7 +1866,7 @@ subroutine coefs_init(coefs_file, available_gases, kdist) gpt, & temperature_Planck - integer :: i, j, k + integer :: i integer :: did, vid integer :: ierr @@ -1928,11 +1878,10 @@ subroutine coefs_init(coefs_file, available_gases, kdist) real(r8) :: press_ref_trop, temp_ref_t, temp_ref_p real(r8), dimension(:,:,:), allocatable :: vmr_ref real(r8), dimension(:,:,:,:), allocatable :: kmajor - ! ? real(r8), dimension(:,:,:), allocatable :: selfrefin, forrefin real(r8), dimension(:,:,:), allocatable :: kminor_lower, kminor_upper real(r8), dimension(:,:), allocatable :: totplnk real(r8), dimension(:,:,:,:), allocatable :: planck_frac - real(r8), dimension(:), allocatable :: solar_src_quiet, solar_src_facular, solar_src_sunspot ! updated from solar_src + real(r8), dimension(:), allocatable :: solar_src_quiet, solar_src_facular, solar_src_sunspot real(r8) :: tsi_default real(r8), dimension(:,:,:), allocatable :: rayl_lower, rayl_upper character(len=32), dimension(:), allocatable :: gas_minor, & @@ -1973,8 +1922,6 @@ subroutine coefs_init(coefs_file, available_gases, kdist) call pio_seterrorhandling(fh, PIO_BCAST_ERROR) - ! Get variables and validate them, then put into kdist - ! Get dimensions and check for consistency with parameter values ierr = pio_inq_dimid(fh, 'absorber', did) @@ -2042,9 +1989,8 @@ subroutine coefs_init(coefs_file, available_gases, kdist) ierr = pio_inq_dimlen(fh, did, fit_coeffs) end if - ! Get variables - + ! names of absorbing gases allocate(gas_names(absorber)) ierr = pio_inq_varid(fh, 'gas_names', vid) @@ -2120,21 +2066,6 @@ subroutine coefs_init(coefs_file, available_gases, kdist) ierr = pio_get_var(fh, vid, kmajor) if (ierr /= PIO_NOERR) call endrun(sub//': error reading kmajor') - ! -bpm - variable wv_self & wv_for not in the newer files. - ! ! absorption coefficients due to water vapor self continuum - ! allocate(selfrefin(gpt,mixing_fraction,temperature)) - ! ierr = pio_inq_varid(fh, 'wv_self', vid) - ! if (ierr /= PIO_NOERR) call endrun(sub//': wv_self not found') - ! ierr = pio_get_var(fh, vid, selfrefin) - ! if (ierr /= PIO_NOERR) call endrun(sub//': error reading wv_self') - - ! ! absorption coefficients due to water vapor foreign continuum - ! allocate(forrefin(gpt,mixing_fraction,temperature)) - ! ierr = pio_inq_varid(fh, 'wv_for', vid) - ! if (ierr /= PIO_NOERR) call endrun(sub//': wv_for not found') - ! ierr = pio_get_var(fh, vid, forrefin) - ! if (ierr /= PIO_NOERR) call endrun(sub//': error reading wv_for') - ! absorption coefficients due to minor absorbing gases in lower part of atmosphere allocate(kminor_lower(contributors_lower, mixing_fraction, temperature)) ierr = pio_inq_varid(fh, 'kminor_lower', vid) @@ -2225,7 +2156,6 @@ subroutine coefs_init(coefs_file, available_gases, kdist) if (ierr /= PIO_NOERR) call endrun(sub//': error reading rayl_upper') end if - ! +bpm the others allocate(gas_minor(minorabsorbers)) ierr = pio_inq_varid(fh, 'gas_minor', vid) if (ierr /= PIO_NOERR) call endrun(sub//': gas_minor not found') @@ -2353,10 +2283,9 @@ subroutine coefs_init(coefs_file, available_gases, kdist) ! Close file call pio_closefile(fh) - ! Initialize the gas optics class with data. The calls look slightly different depending - ! on whether the radiation sources are internal to the atmosphere (longwave) or external (shortwave) - ! gas_optics%load() returns a string; a non-empty string indicates an error. - ! + ! Initialize the gas optics object with data. The calls look slightly different depending + ! on whether the radiation sources are internal to the atmosphere (longwave) or external (shortwave) + if (allocated(totplnk) .and. allocated(planck_frac)) then error_msg = kdist%load( & available_gases, gas_names, key_species, & @@ -2426,6 +2355,7 @@ subroutine coefs_init(coefs_file, available_gases, kdist) if (allocated(solar_src_sunspot)) deallocate(solar_src_sunspot) if (allocated(rayl_lower)) deallocate(rayl_lower) if (allocated(rayl_upper)) deallocate(rayl_upper) + end subroutine coefs_init !========================================================================================= @@ -2577,20 +2507,5 @@ end subroutine modified_cloud_fraction !========================================================================================= -elemental subroutine clipper(scalar, minval, maxval) - real(r8), intent(inout) :: scalar - real(r8), intent(in) :: minval, maxval - if (minval < maxval) then - if (scalar < minval) then - scalar = minval - end if - if (scalar > maxval) then - scalar = maxval - end if - end if -end subroutine clipper - -!========================================================================================= - end module radiation diff --git a/src/physics/rrtmgp/rrtmgp_inputs.F90 b/src/physics/rrtmgp/rrtmgp_inputs.F90 index e629950c64..caff2f6a71 100644 --- a/src/physics/rrtmgp/rrtmgp_inputs.F90 +++ b/src/physics/rrtmgp/rrtmgp_inputs.F90 @@ -125,9 +125,9 @@ subroutine rrtmgp_set_state( & real(r8), intent(out) :: alb_dif(nswbands,nday) ! surface albedo, diffuse radiation ! local variables - integer :: k, kk, i, iband + integer :: i, k, iband - real(r8) :: tref_min, tref_max, tmin, tmax + real(r8) :: tref_min, tref_max character(len=*), parameter :: sub='rrtmgp_set_state' character(len=512) :: errmsg @@ -497,7 +497,7 @@ subroutine rrtmgp_set_cloud_lw( & ! Local variables integer :: i, k, ncol - integer :: igpt, nver + integer :: nver ! cloud radiative parameters are "in cloud" not "in cell" real(r8) :: liq_lw_abs(nlwbands,pcols,pver) ! liquid absorption optics depth (LW) @@ -944,7 +944,7 @@ subroutine rrtmgp_set_aer_sw( & type(ty_optical_props_2str), intent(inout) :: aer_sw ! local variables - integer :: i, k, ib + integer :: i ! The optical arrays dimensioned in the vertical as 0:pver. ! The index 0 is for the extra layer used in the radiation @@ -958,7 +958,6 @@ subroutine rrtmgp_set_aer_sw( & real(r8) :: aer_tau_w_f(pcols,0:pver,nswbands) ! forward scattered fraction * w * tau ! aer_tau_w_f is not used by RRTMGP. character(len=*), parameter :: sub = 'rrtmgp_set_aer_sw' - character(len=128) :: errmsg !-------------------------------------------------------------------------------- ! Get aerosol shortwave optical properties. From 74bce491fec934f14d09b6d1e11d24e2eeeb251a Mon Sep 17 00:00:00 2001 From: Brian Eaton Date: Fri, 29 Sep 2023 14:22:56 -0400 Subject: [PATCH 160/291] remove some debug output; add error check routine --- src/physics/rrtmgp/radiation.F90 | 161 ++++++++----------------------- 1 file changed, 38 insertions(+), 123 deletions(-) diff --git a/src/physics/rrtmgp/radiation.F90 b/src/physics/rrtmgp/radiation.F90 index 9d551dd4c6..53dd2c1282 100644 --- a/src/physics/rrtmgp/radiation.F90 +++ b/src/physics/rrtmgp/radiation.F90 @@ -49,10 +49,10 @@ module radiation pio_def_var, pio_put_var, pio_get_var, & pio_put_att, PIO_NOWRITE, pio_closefile -use mo_source_functions, only: ty_source_func_lw use mo_gas_concentrations, only: ty_gas_concs use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp use mo_optical_props, only: ty_optical_props_1scl, ty_optical_props_2str +use mo_source_functions, only: ty_source_func_lw use mo_fluxes_byband, only: ty_fluxes_byband use string_utils, only: to_lower @@ -108,21 +108,11 @@ module radiation real(r8) :: flux_sw_dn(pcols,pverp) ! downward flux real(r8) :: flux_sw_clr_dn(pcols,pverp) ! downward clearsky flux - real(r8), allocatable :: fsdn(:,:) ! Downward SW flux on rrtmgp grid - real(r8), allocatable :: fsdnc(:,:) ! Downward SW clear sky flux on rrtmgp grid - real(r8), allocatable :: fsup(:,:) ! Upward SW flux on rrtmgp grid - real(r8), allocatable :: fsupc(:,:) ! Upward SW clear sky flux on rrtmgp grid - real(r8) :: flux_lw_up(pcols,pverp) ! upward shortwave flux on interfaces real(r8) :: flux_lw_clr_up(pcols,pverp) ! upward shortwave clearsky flux real(r8) :: flux_lw_dn(pcols,pverp) ! downward flux real(r8) :: flux_lw_clr_dn(pcols,pverp) ! downward clearsky flux - real(r8), allocatable :: fldn(:,:) ! Downward LW flux on rrtmgp grid - real(r8), allocatable :: fldnc(:,:) ! Downward LW clear sky flux on rrtmgp grid - real(r8), allocatable :: flup(:,:) ! Upward LW flux on rrtmgp grid - real(r8), allocatable :: flupc(:,:) ! Upward LW clear sky flux on rrtmgp grid - real(r8) :: qrlc(pcols,pver) real(r8) :: flntc(pcols) ! Clear sky lw flux at model top @@ -490,9 +480,7 @@ subroutine radiation_init(pbuf2d) end do errmsg = available_gases%init(gaslist_lc) - if (len_trim(errmsg) > 0) then - call endrun(sub//': ERROR: available_gases%init: '//trim(errmsg)) - end if + call stop_on_err(errmsg, sub, 'available_gases%init') ! Read RRTMGP coefficients files and initialize kdist objects. call coefs_init(coefs_sw_file, available_gases, kdist_sw) @@ -644,16 +632,6 @@ subroutine radiation_init(pbuf2d) call addfld('FDSC'//diag(icall), (/ 'ilev' /), 'I', 'W/m2', & 'Shortwave clear-sky downward flux', sampling_seq='rad_lwsw') - ! Fluxes on RRTMGP grid - call addfld('FSDN'//diag(icall), (/ 'plev_rad' /), 'I', 'W/m2', & - 'SW downward flux on rrtmgp grid', sampling_seq='rad_lwsw') - call addfld('FSDNC'//diag(icall), (/ 'plev_rad' /), 'I', 'W/m2', & - 'SW downward clear sky flux on rrtmgp grid', sampling_seq='rad_lwsw') - call addfld('FSUP'//diag(icall), (/ 'plev_rad' /), 'I', 'W/m2', & - 'SW upward flux on rrtmgp grid', sampling_seq='rad_lwsw') - call addfld('FSUPC'//diag(icall), (/ 'plev_rad' /), 'I', 'W/m2', & - 'SW upward clear sky flux on rrtmgp grid', sampling_seq='rad_lwsw') - if (history_amwg) then call add_default('SOLIN'//diag(icall), 1, ' ') call add_default('QRS'//diag(icall), 1, ' ') @@ -723,16 +701,6 @@ subroutine radiation_init(pbuf2d) call addfld('FDLC'//diag(icall), (/ 'ilev' /), 'I', 'W/m2', & 'Longwave clear-sky downward flux', sampling_seq='rad_lwsw') - ! Fluxes on rrtmgp grid - call addfld('FLDN'//diag(icall), (/ 'plev_rad' /), 'I', 'W/m2', & - 'LW downward flux on rrtmgp grid', sampling_seq='rad_lwsw') - call addfld('FLDNC'//diag(icall), (/ 'plev_rad' /), 'I', 'W/m2', & - 'LW downward clear sky flux on rrtmgp grid', sampling_seq='rad_lwsw') - call addfld('FLUP'//diag(icall), (/ 'plev_rad' /), 'I', 'W/m2', & - 'LW upward flux on rrtmgp grid', sampling_seq='rad_lwsw') - call addfld('FLUPC'//diag(icall), (/ 'plev_rad' /), 'I', 'W/m2', & - 'LW upward clear sky flux on rrtmgp grid', sampling_seq='rad_lwsw') - if (history_amwg) then call add_default('QRL'//diag(icall), 1, ' ') call add_default('FLNT'//diag(icall), 1, ' ') @@ -1006,11 +974,9 @@ subroutine radiation_tend( & real(r8) :: gb_snow_tau(pcols,pver) ! grid-box mean snow_tau real(r8) :: gb_snow_lw(pcols,pver) ! grid-box mean LW snow optical depth - real(r8) :: ftem(pcols,pver) ! Temporary workspace for outfld variables character(len=128) :: errmsg - character(len=*), parameter :: sub = 'radiation_tend' !-------------------------------------------------------------------------------------- @@ -1022,11 +988,6 @@ subroutine radiation_tend( & write_output = .false. else allocate(rd) - ! allocate elements of rd for output of fluxes on RRTMGP grid - if (.not. allocated(rd%fsdn)) then - allocate(rd%fsdn(pcols,nlay+1), rd%fsdnc(pcols,nlay+1), rd%fsup(pcols,nlay+1), rd%fsupc(pcols,nlay+1), & - rd%fldn(pcols,nlay+1), rd%fldnc(pcols,nlay+1), rd%flup(pcols,nlay+1), rd%flupc(pcols,nlay+1) ) - end if write_output = .true. end if @@ -1162,23 +1123,17 @@ subroutine radiation_tend( & ! Initialize object for gas concentrations. errmsg = gas_concs_sw%init(gaslist_lc) - if (len_trim(errmsg) > 0) then - call endrun(sub//': ERROR: gas_concs_sw%init: '//trim(errmsg)) - end if + call stop_on_err(errmsg, sub, 'gas_concs_sw%init') ! Initialize object for combined gas + aerosol + cloud optics. ! Allocates arrays for properties represented on g-points. errmsg = atm_optics_sw%alloc_2str(nday, nlay, kdist_sw) - if (len_trim(errmsg) > 0) then - call endrun(sub//': ERROR: gas_optics_sw%alloc_2str: '//trim(errmsg)) - end if + call stop_on_err(errmsg, sub, 'atm_optics_sw%alloc_2str') ! Initialize object for SW aerosol optics. Allocates arrays ! for properties represented by band. errmsg = aer_sw%alloc_2str(nday, nlay, kdist_sw%get_band_lims_wavenumber()) - if (len_trim(errmsg) > 0) then - call endrun(sub//': ERROR: aer_sw%alloc_2str: '//trim(errmsg)) - end if + call stop_on_err(errmsg, sub, 'aer_sw%alloc_2str') end if @@ -1198,9 +1153,7 @@ subroutine radiation_tend( & errmsg = kdist_sw%gas_optics( & pmid_day, pint_day, t_day, gas_concs_sw, atm_optics_sw, & toa_flux) - if (len_trim(errmsg) > 0) then - call endrun(sub//': ERROR: kdist_sw%gas_optics: '//trim(errmsg)) - end if + call stop_on_err(errmsg, sub, 'kdist_sw%gas_optics') ! Scale the solar source tsi_ref = sum(toa_flux(1,:)) @@ -1218,31 +1171,23 @@ subroutine radiation_tend( & ! Increment the gas optics (in atm_optics_sw) by the aerosol optics in aer_sw. errmsg = aer_sw%increment(atm_optics_sw) - if (len_trim(errmsg) > 0) then - call endrun(sub//': ERROR in aer_sw%increment: '//trim(errmsg)) - end if + call stop_on_err(errmsg, sub, 'aer_sw%increment') ! Compute clear-sky fluxes. errmsg = rte_sw(& atm_optics_sw, top_at_1, coszrs_day, toa_flux, & alb_dir, alb_dif, fswc) - if (len_trim(errmsg) > 0) then - call endrun(sub//': ERROR in clear-sky rte_sw: '//trim(errmsg)) - end if + call stop_on_err(errmsg, sub, 'clear-sky rte_sw') ! Increment the aerosol+gas optics (in atm_optics_sw) by the cloud optics in cloud_sw. errmsg = cloud_sw%increment(atm_optics_sw) - if (len_trim(errmsg) > 0) then - call endrun(sub//': ERROR in cloud_sw%increment: '//trim(errmsg)) - end if + call stop_on_err(errmsg, sub, 'cloud_sw%increment') ! Compute all-sky fluxes. errmsg = rte_sw(& atm_optics_sw, top_at_1, coszrs_day, toa_flux, & alb_dir, alb_dif, fsw) - if (len_trim(errmsg) > 0) then - call endrun(sub//': ERROR in all-sky rte_sw: '//trim(errmsg)) - end if + call stop_on_err(errmsg, sub, 'all-sky rte_sw') end if @@ -1270,9 +1215,7 @@ subroutine radiation_tend( & ! Initialize object for Planck sources. errmsg = sources_lw%alloc(ncol, nlay, kdist_lw) - if (len_trim(errmsg) > 0) then - call endrun(sub//': ERROR, sources_lw%alloc: '//trim(errmsg)) - end if + call stop_on_err(errmsg, sub, 'sources_lw%alloc') ! Set cloud optical properties in cloud_lw object. call rrtmgp_set_cloud_lw( & @@ -1282,21 +1225,15 @@ subroutine radiation_tend( & ! Initialize object for gas concentrations errmsg = gas_concs_lw%init(gaslist_lc) - if (len_trim(errmsg) > 0) then - call endrun(sub//': ERROR, gas_concs_lw%init: '//trim(errmsg)) - end if + call stop_on_err(errmsg, sub, 'gas_concs_lw%init') ! Initialize object for combined gas + aerosol + cloud optics. errmsg = atm_optics_lw%alloc_1scl(ncol, nlay, kdist_lw) - if (len_trim(errmsg) > 0) then - call endrun(sub//': ERROR: gas_optics_lw%alloc_1scl: '//trim(errmsg)) - end if + call stop_on_err(errmsg, sub, 'atm_optics_lw%alloc_1scl') ! Initialize object for LW aerosol optics. errmsg = aer_lw%alloc_1scl(ncol, nlay, kdist_lw%get_band_lims_wavenumber()) - if (len_trim(errmsg) > 0) then - call endrun(sub//': ERROR: aer_lw%alloc_1scl: '//trim(errmsg)) - end if + call stop_on_err(errmsg, sub, 'aer_lw%alloc_1scl') ! The climate (icall==0) calculation must occur last. do icall = N_DIAG, 0, -1 @@ -1310,33 +1247,26 @@ subroutine radiation_tend( & errmsg = kdist_lw%gas_optics( & pmid_rad, pint_rad, t_rad, t_sfc, gas_concs_lw, & atm_optics_lw, sources_lw) + call stop_on_err(errmsg, sub, 'kdist_lw%gas_optics') ! Set LW aerosol optical properties in the aer_lw object. call rrtmgp_set_aer_lw(icall, state, pbuf, aer_lw) ! Increment the gas optics by the aerosol optics. errmsg = aer_lw%increment(atm_optics_lw) - if (len_trim(errmsg) > 0) then - call endrun(sub//': ERROR in aer_lw%increment: '//trim(errmsg)) - end if + call stop_on_err(errmsg, sub, 'aer_lw%increment') ! Compute clear-sky LW fluxes errmsg = rte_lw(atm_optics_lw, top_at_1, sources_lw, emis_sfc, flwc) - if (len_trim(errmsg) > 0) then - call endrun(sub//': ERROR in clear-sky rte_lw: '//trim(errmsg)) - end if + call stop_on_err(errmsg, sub, 'clear-sky rte_lw') ! Increment the gas+aerosol optics by the cloud optics. errmsg = cloud_lw%increment(atm_optics_lw) - if (len_trim(errmsg) > 0) then - call endrun(sub//': ERROR in cloud_lw%increment: '//trim(errmsg)) - end if + call stop_on_err(errmsg, sub, 'cloud_lw%increment') ! Compute all-sky LW fluxes errmsg = rte_lw(atm_optics_lw, top_at_1, sources_lw, emis_sfc, flw) - if (len_trim(errmsg) > 0) then - call endrun(sub//': ERROR in all-sky rte_lw: '//trim(errmsg)) - end if + call stop_on_err(errmsg, sub, 'all-sky rte_lw') ! Transform RRTMGP outputs to CAM outputs and compute heating rates. call set_lw_diags() @@ -1441,8 +1371,6 @@ subroutine radiation_tend( & qrl(:ncol,:) = qrl(:ncol,:) * state%pdel(:ncol,:) if (.not. present(rd_out)) then - deallocate(rd%fsdn, rd%fsdnc, rd%fsup, rd%fsupc, & - rd%fldn, rd%fldnc, rd%flup, rd%flupc ) deallocate(rd) end if call free_optics_sw(atm_optics_sw) @@ -1487,11 +1415,6 @@ subroutine set_sw_diags() rd%flux_sw_clr_up = 0._r8 rd%flux_sw_clr_dn = 0._r8 - rd%fsdn = 0._r8 - rd%fsdnc = 0._r8 - rd%fsup = 0._r8 - rd%fsupc = 0._r8 - qrs = 0._r8 fsns = 0._r8 fsnt = 0._r8 @@ -1512,11 +1435,6 @@ subroutine set_sw_diags() rd%flux_sw_dn(idxday(i),ktopcam:) = fsw%flux_dn(i,ktoprad:) rd%flux_sw_clr_up(idxday(i),ktopcam:) = fswc%flux_up(i,ktoprad:) rd%flux_sw_clr_dn(idxday(i),ktopcam:) = fswc%flux_dn(i,ktoprad:) - - rd%fsdn(idxday(i),:) = fsw%flux_dn(i,:) - rd%fsdnc(idxday(i),:) = fswc%flux_dn(i,:) - rd%fsup(idxday(i),:) = fsw%flux_up(i,:) - rd%fsupc(idxday(i),:) = fswc%flux_up(i,:) end do ! Compute heating rate as a dry static energy tendency. @@ -1615,11 +1533,6 @@ subroutine set_lw_diags() rd%flut(:ncol) = flw%flux_up(:, ktoprad) rd%flutc(:ncol) = flwc%flux_up(:, ktoprad) - rd%fldn(:ncol,:) = flw%flux_dn - rd%fldnc(:ncol,:) = flwc%flux_dn - rd%flup(:ncol,:) = flw%flux_up - rd%flupc(:ncol,:) = flwc%flux_up - ! Output fluxes at 200 mb call vertinterp(ncol, pcols, pverp, state%pint, 20000._r8, fnl, rd%fln200) call vertinterp(ncol, pcols, pverp, state%pint, 20000._r8, fcnl, rd%fln200c) @@ -1747,11 +1660,6 @@ subroutine radiation_output_sw(lchnk, ncol, icall, rd, pbuf, cam_out) call outfld('FDS'//diag(icall), rd%flux_sw_dn, pcols, lchnk) call outfld('FDSC'//diag(icall), rd%flux_sw_clr_dn, pcols, lchnk) - call outfld('FSDN'//diag(icall), rd%fsdn, pcols, lchnk) - call outfld('FSDNC'//diag(icall), rd%fsdnc, pcols, lchnk) - call outfld('FSUP'//diag(icall), rd%fsup, pcols, lchnk) - call outfld('FSUPC'//diag(icall), rd%fsupc, pcols, lchnk) - end subroutine radiation_output_sw !=============================================================================== @@ -1830,11 +1738,6 @@ subroutine radiation_output_lw(lchnk, ncol, icall, rd, pbuf, cam_out) call outfld('FUL'//diag(icall), rd%flux_lw_up, pcols, lchnk) call outfld('FULC'//diag(icall), rd%flux_lw_clr_up, pcols, lchnk) - call outfld('FLDN'//diag(icall), rd%fldn, pcols, lchnk) - call outfld('FLDNC'//diag(icall), rd%fldnc, pcols, lchnk) - call outfld('FLUP'//diag(icall), rd%flup, pcols, lchnk) - call outfld('FLUPC'//diag(icall), rd%flupc, pcols, lchnk) - end subroutine radiation_output_lw !=============================================================================== @@ -1921,8 +1824,7 @@ subroutine coefs_init(coefs_file, available_gases, kdist) call pio_seterrorhandling(fh, PIO_BCAST_ERROR) - - ! Get dimensions and check for consistency with parameter values + ! Get dimensions ierr = pio_inq_dimid(fh, 'absorber', did) if (ierr /= PIO_NOERR) call endrun(sub//': absorber not found') @@ -2052,7 +1954,6 @@ subroutine coefs_init(coefs_file, available_gases, kdist) if (ierr /= PIO_NOERR) call endrun(sub//': error reading absorption_coefficient_ref_P') ! volume mixing ratios for reference atmosphere - ! vmr_ref(temperature, absorber_ext, atmos_layer) allocate(vmr_ref(atmos_layer, absorber_ext, temperature)) ierr = pio_inq_varid(fh, 'vmr_ref', vid) if (ierr /= PIO_NOERR) call endrun(sub//': vmr_ref not found') @@ -2283,7 +2184,7 @@ subroutine coefs_init(coefs_file, available_gases, kdist) ! Close file call pio_closefile(fh) - ! Initialize the gas optics object with data. The calls look slightly different depending + ! Initialize the gas optics object with data. The calls are slightly different depending ! on whether the radiation sources are internal to the atmosphere (longwave) or external (shortwave) if (allocated(totplnk) .and. allocated(planck_frac)) then @@ -2327,9 +2228,7 @@ subroutine coefs_init(coefs_file, available_gases, kdist) error_msg = 'must supply either totplnk and planck_frac, or solar_src_[*]' end if - if (len_trim(error_msg) > 0) then - call endrun(sub//': ERROR: '//trim(error_msg)) - end if + call stop_on_err(error_msg, sub, 'kdist%load') deallocate( & gas_names, key_species, & @@ -2507,5 +2406,21 @@ end subroutine modified_cloud_fraction !========================================================================================= +subroutine stop_on_err(errmsg, sub, info) + +! call endrun if RRTMGP function returns non-empty error message. + + character(len=*), intent(in) :: errmsg ! return message from RRTMGP function + character(len=*), intent(in) :: sub ! name of calling subroutine + character(len=*), intent(in) :: info ! name of called function + + if (len_trim(errmsg) > 0) then + call endrun(trim(sub)//': ERROR: '//trim(info)//': '//trim(errmsg)) + end if + +end subroutine stop_on_err + +!========================================================================================= + end module radiation From d37e70a4486796ce9f1f70ad4f1022b5a0670ccb Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Fri, 29 Sep 2023 13:43:53 -0600 Subject: [PATCH 161/291] Unused code deletion and update setting short-lived species fieldnames Signed-off-by: Lizzie Lundgren --- src/chemistry/mozart/mo_chem_utls.F90 | 12 ------------ src/chemistry/mozart/short_lived_species.F90 | 2 +- src/control/runtime_opts.F90 | 3 --- 3 files changed, 1 insertion(+), 16 deletions(-) diff --git a/src/chemistry/mozart/mo_chem_utls.F90 b/src/chemistry/mozart/mo_chem_utls.F90 index d444a89d5e..dbed06c9e8 100644 --- a/src/chemistry/mozart/mo_chem_utls.F90 +++ b/src/chemistry/mozart/mo_chem_utls.F90 @@ -3,7 +3,6 @@ module mo_chem_utls private public :: get_spc_ndx, get_het_ndx, get_extfrc_ndx, get_rxt_ndx, get_inv_ndx - public :: utls_chem_is save @@ -174,15 +173,4 @@ integer function get_rxt_ndx( rxt_tag ) end function get_rxt_ndx - logical function utls_chem_is (name) result(chem_is) - use string_utils, only : to_lower - - character(len=*), intent(in) :: name - chem_is = .false. - if ( to_lower(name) == 'mozart' ) then - chem_is = .true. - endif - - end function utls_chem_is - end module mo_chem_utls diff --git a/src/chemistry/mozart/short_lived_species.F90 b/src/chemistry/mozart/short_lived_species.F90 index 8807776d98..37a43d90bb 100644 --- a/src/chemistry/mozart/short_lived_species.F90 +++ b/src/chemistry/mozart/short_lived_species.F90 @@ -138,7 +138,7 @@ subroutine initialize_short_lived_species(ncid_ini, pbuf2d) do m=1,nslvd if (cam_chempkg_is('geoschem_mam4')) then - write(fieldname,'(a,a)') trim(slvd_lst(m)) + fieldname = trim(slvd_lst(m)) else n = map(m) fieldname = solsym(n) diff --git a/src/control/runtime_opts.F90 b/src/control/runtime_opts.F90 index 3f95e1c704..6d5a6e1058 100644 --- a/src/control/runtime_opts.F90 +++ b/src/control/runtime_opts.F90 @@ -209,9 +209,6 @@ subroutine read_namelist(nlfilename, single_column, scmlat, scmlon) call hemco_readnl(nlfilename) call cam_budget_readnl(nlfilename) call phys_grid_ctem_readnl(nlfilename) -#if (defined HEMCO_CESM) - call hemco_readnl(nlfilename) -#endif end subroutine read_namelist From ddda4164a241ba2cd2651c0a9496fc66175a3178 Mon Sep 17 00:00:00 2001 From: Brian Eaton Date: Fri, 29 Sep 2023 20:44:08 -0400 Subject: [PATCH 162/291] update build for changes to rte-rrtmgp develop branch --- .gitignore | 1 + Externals_CAM.cfg | 21 ++++++++++----- bld/build-namelist | 28 +++++++++++++++----- bld/configure | 20 +++++++------- bld/namelist_files/namelist_defaults_cam.xml | 4 +-- 5 files changed, 48 insertions(+), 26 deletions(-) diff --git a/.gitignore b/.gitignore index f845629454..fd86ccd9e0 100644 --- a/.gitignore +++ b/.gitignore @@ -11,6 +11,7 @@ src/physics/cosp2/src src/physics/silhs src/physics/pumas src/physics/pumas-frozen +src/physics/rrtmgp/data src/physics/rrtmgp/ext src/dynamics/fv3/atmos_cubed_sphere libraries/FMS diff --git a/Externals_CAM.cfg b/Externals_CAM.cfg index a0adb29d61..b9691c4e85 100644 --- a/Externals_CAM.cfg +++ b/Externals_CAM.cfg @@ -1,10 +1,3 @@ -[rrtmgp] -local_path = src/physics/rrtmgp/ext -protocol = git -repo_url = https://github.com/brian-eaton/rte-rrtmgp.git -tag = local_fix01 -required = True - [chem_proc] local_path = chem_proc protocol = git @@ -91,5 +84,19 @@ repo_url = https://github.com/ESCOMP/HEMCO_CESM.git required = True externals = Externals_HCO.cfg +[rte-rrtmgp] +local_path = src/physics/rrtmgp/ext +protocol = git +repo_url = https://github.com/earth-system-radiation/rte-rrtmgp.git +hash = a1b6781 +required = True + +[rrtmgp-data] +local_path = src/physics/rrtmgp/data +protocol = git +repo_url = https://github.com/earth-system-radiation/rrtmgp-data.git +tag = v1.7.1 +required = True + [externals_description] schema_version = 1.0.0 diff --git a/bld/build-namelist b/bld/build-namelist index 1b1012f524..bada94c795 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -693,15 +693,16 @@ my $rad_pkg = $cfg->get('rad'); if ($rad_pkg eq 'camrt') { add_default($nl, 'absems_data'); } -elsif ($rad_pkg eq 'rrtmgp') { - # Data for gas optics is provided with the source code. The paths to this data - # are relative to the root directory of the cam component. +elsif ($rad_pkg =~ m/rrtmgp/) { + # Dataset for gas optics are checked out of an external repo into + # the source code directory. The paths to this data are relative + # to the root directory of the cam component. my $cam_dir = $cfg->get('cam_dir'); add_default($nl, 'rrtmgp_coefs_lw_file'); my $rel_path = $nl->get_value('rrtmgp_coefs_lw_file'); my $abs_path = quote_string(set_abs_filepath($rel_path, $cam_dir)); - # need to overwrite the relative pathname with the absolute pathname in the namelist object + # Overwrite the relative pathname with the absolute pathname in the namelist object $nl->set_variable_value('radiation_nl', 'rrtmgp_coefs_lw_file', $abs_path); add_default($nl, 'rrtmgp_coefs_sw_file'); @@ -863,7 +864,6 @@ if ($chem_rad_passive or $aqua_mode) { # The aerosol optics depend on which radiative transfer model is used due to differing # wavelength bands used. -my $rrtmg = $rad_pkg eq 'rrtmg' ? 1 : 0; # @aero_names contains the names of the entities (bulk aerosols and modes) # that are externally mixed in aerosol optics calculation. These entities are all @@ -1242,7 +1242,7 @@ if ($carma eq 'bc_strat') { } } -if ($rrtmg) { +if ($rad_pkg eq 'rrtmg') { # CARMA Microphysics - RRTMG Only # @@ -1662,11 +1662,25 @@ if ($rad_pkg ne 'none') { } # Cloud optics -if ($rad_pkg =~ /rrtmg/) { # matches both rrtmg and rrtmgp +if ($rad_pkg =~ m/rrtmg/) { # matches both rrtmg and rrtmgp add_default($nl, 'liqcldoptics'); add_default($nl, 'icecldoptics'); add_default($nl, 'liqopticsfile'); add_default($nl, 'iceopticsfile'); + + # rrtmgp only implemented with mitchell and gammadist cloud optics + if ($rad_pkg =~ m/rrtmgp/) { + my $liqcldoptics = $nl->get_value('liqcldoptics'); + if ($liqcldoptics !~ m/gammadist/) { + die "$ProgName - ERROR: RRTMGP only implemented with gammadist liquid cloud optics\n" . + "liqcldoptics = $liqcldoptics\n"; + } + my $icecldoptics = $nl->get_value('icecldoptics'); + if ($icecldoptics !~ m/mitchell/) { + die "$ProgName - ERROR: RRTMGP only implemented with mitchell ice cloud optics\n" . + "icecldoptics = $icecldoptics\n"; + } + } } # Volcanic Aerosol Mass climatology dataset diff --git a/bld/configure b/bld/configure index a6a4ee804d..c199044857 100755 --- a/bld/configure +++ b/bld/configure @@ -1088,7 +1088,7 @@ if ($rad_pkg eq 'camrt') { " with aerosol package $chem_pkg\n"; } } -elsif ($rad_pkg eq 'rrtmg') { +elsif ($rad_pkg =~ m/rrtmg/) { # The rrtmg package doesn't work with the CAM3 prescribed aerosols if ($phys_pkg eq 'cam3') { @@ -1130,7 +1130,7 @@ if ($phys_pkg eq 'spcam_sam1mom') { } if ($phys_pkg eq 'spcam_m2005') { - if ($rad_pkg ne 'rrtmg') { + if ($rad_pkg !~ m/rrtmg/) { die "configure ERROR: radiation package: $rad_pkg is not compatible\n". " with m2005 -- it should be rrtmg\n"; } @@ -2212,16 +2212,16 @@ sub write_filepath } elsif ($rad eq 'rrtmgp') { print $fh "$camsrcdir/src/physics/rrtmgp\n"; - print $fh "$camsrcdir/src/physics/rrtmgp/ext/rrtmgp\n"; - print $fh "$camsrcdir/src/physics/rrtmgp/ext/rte\n"; + print $fh "$camsrcdir/src/physics/rrtmgp/ext/extensions\n"; + print $fh "$camsrcdir/src/physics/rrtmgp/ext/gas-optics\n"; + print $fh "$camsrcdir/src/physics/rrtmgp/ext/rrtmgp-frontend\n"; + print $fh "$camsrcdir/src/physics/rrtmgp/ext/rte-frontend\n"; if ($use_rrtmgp_gpu) { - print $fh "$camsrcdir/src/physics/rrtmgp/ext/rrtmgp/kernels-openacc\n"; - print $fh "$camsrcdir/src/physics/rrtmgp/ext/rte/kernels-openacc\n"; + print $fh "$camsrcdir/src/physics/rrtmgp/ext/rrtmgp-kernels/accel\n"; + print $fh "$camsrcdir/src/physics/rrtmgp/ext/rte-kernels/accel\n"; } - print $fh "$camsrcdir/src/physics/rrtmgp/ext/rrtmgp/kernels\n"; - print $fh "$camsrcdir/src/physics/rrtmgp/ext/rte/kernels\n"; - print $fh "$camsrcdir/src/physics/rrtmgp/ext/extensions\n"; - print $fh "$camsrcdir/src/physics/rrtmgp/ext/extensions/cloud_optics\n"; + print $fh "$camsrcdir/src/physics/rrtmgp/ext/rrtmgp-kernels\n"; + print $fh "$camsrcdir/src/physics/rrtmgp/ext/rte-kernels\n"; } if ($clubb_sgs) { diff --git a/bld/namelist_files/namelist_defaults_cam.xml b/bld/namelist_files/namelist_defaults_cam.xml index d361e48955..b1768fae57 100644 --- a/bld/namelist_files/namelist_defaults_cam.xml +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -589,8 +589,8 @@ atm/cam/physprops/iceoptics_c080917.nc atm/cam/physprops/F_nwvl200_mu20_lam50_res64_t298_c080428.nc -src/physics/rrtmgp/ext/rrtmgp/data/rrtmgp-data-lw-g128-210809.nc -src/physics/rrtmgp/ext/rrtmgp/data/rrtmgp-data-sw-g112-210809.nc +src/physics/rrtmgp/data/rrtmgp-gas-lw-g128.nc +src/physics/rrtmgp/data/rrtmgp-gas-sw-g112.nc atm/cam/rad/abs_ems_factors_fastvx.c030508.nc From d43c4e840ababc03928976e22b774c3225de01e5 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Mon, 2 Oct 2023 11:43:36 -0600 Subject: [PATCH 163/291] Add script to copy GEOS-Chem config files during case setup Signed-off-by: Lizzie Lundgren --- cime_config/cam.case_setup | 30 ++++++++++++++++++++++++++++++ 1 file changed, 30 insertions(+) create mode 100755 cime_config/cam.case_setup diff --git a/cime_config/cam.case_setup b/cime_config/cam.case_setup new file mode 100755 index 0000000000..fc0f6d2742 --- /dev/null +++ b/cime_config/cam.case_setup @@ -0,0 +1,30 @@ +#! /usr/bin/env bash + +# This script is run from CIME when calling case.setup + +cam_root=$1 +cam_config=$2 +case_root=$3 + +# GEOS-Chem only: copy config files to case +gc_option="-chem geoschem" +if [[ "${cam_config}" == *"${gc_option}"* ]]; then + geoschem_config_src="${cam_root}/src/chemistry/geoschem/geoschem_src/run/CESM" + if [ ! -d "${geoschem_config_src}" ]; then + echo "ERROR: Did not find path to GEOS-Chem source code at ${geoschem_config_src}" + exit 1 + fi + fnames=('species_database.yml', 'geoschem_config.yml', 'HISTORY.rc', 'HEMCO_Config.rc', 'HEMCO_Diagn.rc') + for fname in ${fnames[*]}; do + sourcefile="${cam_root}/${geoschem_config_src}/${fname}" + targetfile="${case_root}/${fileName}" + if [ ! -f "${sourcefile}" ]; then + echo "ERROR: Cannot find GEOS-Chem configuration file to move: ${sourcefile}" + exit 1 + fi + if [ ! -f "${targetfile}" ]; then + echo "CAM namelist one-time copy of GEOS-Chem run directory files: from ${sourcefile} to ${targetfile}" + fi + cp ${sourcefile} ${targetfile} + done +fi From 675afd0aa21b328d12aef5cd085142000c66b4e1 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Thu, 5 Oct 2023 11:43:55 -0600 Subject: [PATCH 164/291] Update deposition input file path used for GEOS-Chem Signed-off-by: Lizzie Lundgren --- bld/namelist_files/namelist_defaults_cam.xml | 2 +- bld/namelist_files/namelist_definition.xml | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/bld/namelist_files/namelist_defaults_cam.xml b/bld/namelist_files/namelist_defaults_cam.xml index 64f0436c5b..b0c8f6a04f 100644 --- a/bld/namelist_files/namelist_defaults_cam.xml +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -1928,7 +1928,7 @@ atm/cam/chem/trop_mozart/dvel/dep_data_c20221208.nc -/glade/u/home/elundgren/drydep_henrys_law_nc/dep_data_file_geoschem.nc +atm/cam/chem/geoschem/dvel/dep_data_file_geoschem_2022Sep21.nc atm/waccm/phot/effxstex.txt diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index d49905044b..ac5f287841 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -7300,9 +7300,9 @@ List of species that undergo dry deposition. Default: set by build-namelist. - -Full pathname of file containing gas phase deposition data including effective +Pathname of file containing gas phase deposition data including effective Henry's law coefficients. Default: set by build-namelist. From 4e552bbf4c8bfe7f82d069973ba46a64ea61dc45 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Thu, 5 Oct 2023 11:44:37 -0600 Subject: [PATCH 165/291] Copy GEOS-Chem configuration files from caseroot to run directory Previously files were copied from camconf. Signed-off-by: Lizzie Lundgren --- cime_config/buildnml | 50 +++++++++++++++++--------------------------- 1 file changed, 19 insertions(+), 31 deletions(-) diff --git a/cime_config/buildnml b/cime_config/buildnml index c35f7c6243..98789a6f5e 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -191,42 +191,17 @@ def buildnml(case, caseroot, compname): rc, out, err = run_cmd(cmd, from_dir=camconf) expect(rc==0,"Command %s failed rc=%d\nout=%s\nerr=%s"%(cmd,rc,out,err)) - # ----------------------------------------------------- - # For GEOS-Chem / HEMCO only: - # Copy input files from storage location into Buildconf/camconf - # This only needs to be done once - # ----------------------------------------------------- - - # We use this to figure out if we are using the GEOS-Chem chemistry - # mechanism. - # Might have to do something else with HEMCO_CESM? - if '-chem geoschem' in CAM_CONFIG_OPTS: - geoschem_src = os.path.join(srcroot, "src/chemistry/geoschem/geoschem_src") - if not os.path.isdir(geoschem_src): - raise SystemExit("ERROR: Did not find path to GEOS-Chem source code at {:s}".format(geoschem_src)) - if os.path.isdir(rundir): - for fileName in ['species_database.yml', 'geoschem_config.yml', - 'HISTORY.rc', 'HEMCO_Config.rc', 'HEMCO_Diagn.rc']: - file1 = os.path.join(geoschem_src, "run/CESM", fileName) - file2 = os.path.join(camconf, fileName) - if not os.path.exists(file2): - logger.info("CAM namelist one-time copy: file1 %s file2 %s ", file1, file2) - shutil.copy(file1,file2) - # ----------------------------------------------------- # copy resolved namelist, atm_in, to rundir # ----------------------------------------------------- if os.path.isdir(rundir): - for fileName in ['atm_in', 'species_database.yml', 'geoschem_config.yml', - 'HISTORY.rc', 'HEMCO_Config.rc', 'HEMCO_Diagn.rc']: - file1 = os.path.join(camconf, fileName) - file2 = os.path.join(rundir, fileName) - if fileName == 'atm_in' and ninst > 1: - file2 += inst_string - if os.path.exists(file1) or fileName == 'atm_in': - logger.info("CAM namelist copy: file1 %s file2 %s ", file1, file2) - shutil.copy(file1,file2) + file1 = os.path.join(camconf, "atm_in") + file2 = os.path.join(rundir, "atm_in") + if ninst > 1: + file2 += inst_string + logger.info("CAM namelist copy: file1 %s file2 %s ", file1, file2) + shutil.copy(file1,file2) # ----------------------------------------------------- # copy drv_flds_in to rundir if it does not exist @@ -237,6 +212,19 @@ def buildnml(case, caseroot, compname): if (os.path.isfile(file1)) and (not os.path.isfile(file2)): shutil.copy(file1,file2) + # ----------------------------------------------------- + # copy geos-chem config files to rundir if using geos-chem chemistry + # ----------------------------------------------------- + + if os.path.isdir(rundir) and '-chem geoschem' in CAM_CONFIG_OPTS: + for fname in ['species_database.yml', 'geoschem_config.yml', + 'HISTORY.rc', 'HEMCO_Config.rc', 'HEMCO_Diagn.rc']: + file1 = os.path.join(caseroot, fname) + file2 = os.path.join(rundir, fname) + if not os.path.exists(file2): + logger.info("GEOS-Chem config file copy: file1 %s file2 %s ", file1, file2) + shutil.copy(file1,file2) + ############################################################################### def _main_func(): From 0a6e8a5dfa7dbab274c15f6341eece1b79a4299c Mon Sep 17 00:00:00 2001 From: Brian Eaton Date: Fri, 6 Oct 2023 19:16:57 -0400 Subject: [PATCH 166/291] remove null() init in pointer declarations for thread safety --- Externals.cfg | 10 +++---- src/physics/rrtmgp/radiation.F90 | 45 +++++++++++++--------------- src/physics/rrtmgp/rrtmgp_inputs.F90 | 38 ++++++++--------------- 3 files changed, 39 insertions(+), 54 deletions(-) diff --git a/Externals.cfg b/Externals.cfg index 9badad437d..95914651eb 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -1,7 +1,7 @@ [ccs_config] -tag = ccs_config_cesm0.0.73 +hash = 980862e protocol = git -repo_url = https://github.com/ESMCI/ccs_config_cesm +repo_url = https://github.com/brian-eaton/ccs_config_cesm local_path = ccs_config required = True @@ -21,7 +21,7 @@ externals = Externals.cfg required = True [cmeps] -tag = cmeps0.14.34 +tag = cmeps0.14.39 protocol = git repo_url = https://github.com/ESCOMP/CMEPS.git local_path = components/cmeps @@ -36,7 +36,7 @@ externals = Externals_CDEPS.cfg required = True [cpl7] -tag = cpl77.0.5 +tag = cpl77.0.6 protocol = git repo_url = https://github.com/ESCOMP/CESM_CPL7andDataComps local_path = components/cpl7 @@ -64,7 +64,7 @@ local_path = libraries/parallelio required = True [cime] -tag = cime6.0.125 +tag = cime6.0.156 protocol = git repo_url = https://github.com/ESMCI/cime local_path = cime diff --git a/src/physics/rrtmgp/radiation.F90 b/src/physics/rrtmgp/radiation.F90 index 53dd2c1282..01d4a057cb 100644 --- a/src/physics/rrtmgp/radiation.F90 +++ b/src/physics/rrtmgp/radiation.F90 @@ -36,7 +36,6 @@ module radiation use scamMod, only: scm_crm_mode, single_column, have_cld, cldobs use cam_history, only: addfld, add_default, horiz_only, outfld, hist_fld_active -use cam_history_support, only: add_vert_coord use radiation_data, only: rad_data_register, rad_data_init @@ -169,8 +168,8 @@ module radiation integer :: fsnt_idx = 0 integer :: flns_idx = 0 integer :: flnt_idx = 0 -integer :: cldfsnow_idx = 0 integer :: cld_idx = 0 +integer :: cldfsnow_idx = 0 integer :: cldfgrau_idx = 0 character(len=4) :: diag(0:N_DIAG) =(/' ','_d1 ','_d2 ','_d3 ','_d4 ','_d5 ',& @@ -183,6 +182,10 @@ module radiation ! Number of layers in radiation calculations. integer :: nlay +! Number of CAM layers in radiation calculations. Is either equal to nlay, or is +! 1 less than nlay if "extra layer" is used in the radiation calculations. +integer :: nlaycam + ! Indices for copying data between CAM/WACCM and RRTMGP arrays. Since RRTMGP is ! vertical order agnostic we can send data using the top to bottom order used ! in CAM/WACCM. But the number of layers that RRTMGP does computations for @@ -198,9 +201,6 @@ module radiation ! Note: for CAM's top to bottom indexing, the index of a given layer ! (midpoint) and the upper interface of that layer, are the same. -! vertical coordinate for output of fluxes on radiation grid -real(r8), allocatable, target :: plev_rad(:) - ! Gas optics objects contain the data read from the coefficients files. type(ty_gas_optics_rrtmgp) :: kdist_sw type(ty_gas_optics_rrtmgp) :: kdist_lw @@ -452,26 +452,21 @@ subroutine radiation_init(pbuf2d) ! below 1 Pa then an extra layer is added to the top of the model for ! the purpose of the radiation calculation. nlay = count( pref_edge(:) > 1._r8 ) ! pascals (0.01 mbar) - allocate(plev_rad(nlay+1)) if (nlay == pverp) then ! Top model interface is below 1 Pa. RRTMGP is active in all model layers plus ! 1 extra layer between model top and 1 Pa. ktopcam = 1 ktoprad = 2 - plev_rad(1) = 1.01_r8 ! Top of extra layer, Pa. - plev_rad(2:) = pref_edge + nlaycam = pver else - ! nlay < pverp. nlay layers are set by radiation - ktopcam = pverp - nlay + 1 + ! nlay < pverp. nlay layers are used in radiation calcs, and they are + ! all CAM layers. + ktopcam = pver - nlay + 1 ktoprad = 1 - plev_rad = pref_edge(ktopcam:) + nlaycam = nlay end if - ! Define a pressure coordinate to allow output of data on the radiation grid. - call add_vert_coord('plev_rad', nlay+1, 'Pressures at radiation flux calculations', & - 'Pa', plev_rad) - ! Create lowercase version of the gaslist for RRTMGP. The ty_gas_concs objects ! work with CAM's uppercase names, but other objects that get input from the gas ! concs objects don't work. @@ -499,8 +494,8 @@ subroutine radiation_init(pbuf2d) call cloud_rad_props_init() cld_idx = pbuf_get_index('CLD') - cldfsnow_idx = pbuf_get_index('CLDFSNOW',errcode=ierr) - cldfgrau_idx = pbuf_get_index('CLDFGRAU',errcode=ierr) + cldfsnow_idx = pbuf_get_index('CLDFSNOW', errcode=ierr) + cldfgrau_idx = pbuf_get_index('CLDFGRAU', errcode=ierr) if (is_first_step()) then call pbuf_set_field(pbuf2d, qrl_idx, 0._r8) @@ -885,11 +880,11 @@ subroutine radiation_tend( & integer :: itim_old real(r8), pointer :: cld(:,:) ! cloud fraction - real(r8), pointer :: cldfsnow(:,:) => null() ! cloud fraction of just "snow clouds" - real(r8), pointer :: cldfgrau(:,:) => null() ! cloud fraction of just "graupel clouds" + real(r8), pointer :: cldfsnow(:,:) ! cloud fraction of just "snow clouds" + real(r8), pointer :: cldfgrau(:,:) ! cloud fraction of just "graupel clouds" real(r8) :: cldfprime(pcols,pver) ! combined cloud fraction - real(r8), pointer :: qrs(:,:) => null() ! shortwave radiative heating rate - real(r8), pointer :: qrl(:,:) => null() ! longwave radiative heating rate + real(r8), pointer :: qrs(:,:) ! shortwave radiative heating rate + real(r8), pointer :: qrl(:,:) ! longwave radiative heating rate real(r8), pointer :: fsds(:) ! Surface solar down flux real(r8), pointer :: fsns(:) ! Surface solar absorbed flux real(r8), pointer :: fsnt(:) ! Net column abs solar flux at model top @@ -1029,9 +1024,11 @@ subroutine radiation_tend( & ! Associate pointers to physics buffer fields itim_old = pbuf_old_tim_idx() + nullify(cldfsnow) if (cldfsnow_idx > 0) then call pbuf_get_field(pbuf, cldfsnow_idx, cldfsnow, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) end if + nullify(cldfgrau) if (cldfgrau_idx > 0 .and. graupel_in_rad) then call pbuf_get_field(pbuf, cldfgrau_idx, cldfgrau, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) endif @@ -1219,9 +1216,9 @@ subroutine radiation_tend( & ! Set cloud optical properties in cloud_lw object. call rrtmgp_set_cloud_lw( & - state, pbuf, nlay, cld, cldfsnow, & - cldfgrau, cldfprime, graupel_in_rad, kdist_lw, cloud_lw, & - cld_lw_abs_cloudsim, snow_lw_abs_cloudsim, grau_lw_abs_cloudsim ) + state, pbuf, ncol, nlay, nlaycam, & + cld, cldfsnow, cldfgrau, cldfprime, graupel_in_rad, & + kdist_lw, cloud_lw, cld_lw_abs_cloudsim, snow_lw_abs_cloudsim, grau_lw_abs_cloudsim) ! Initialize object for gas concentrations errmsg = gas_concs_lw%init(gaslist_lc) diff --git a/src/physics/rrtmgp/rrtmgp_inputs.F90 b/src/physics/rrtmgp/rrtmgp_inputs.F90 index caff2f6a71..7f5cda89a4 100644 --- a/src/physics/rrtmgp/rrtmgp_inputs.F90 +++ b/src/physics/rrtmgp/rrtmgp_inputs.F90 @@ -316,14 +316,14 @@ subroutine rad_gas_get_vmr(icall, gas_name, state, pbuf, nlay, numactivecols, ga integer, optional, intent(in) :: idxday(:) ! indices of daylight columns in a chunk - ! local + ! Local variables integer :: i, idx(numactivecols) real(r8), pointer :: gas_mmr(:,:) real(r8), allocatable :: gas_vmr(:,:) real(r8), allocatable :: mmr(:,:) real(r8) :: massratio - ! -- for ozone profile above model + ! For ozone profile above model real(r8) :: P_top, P_int, P_mid, alpha, beta, a, b, chi_mid, chi_0, chi_eff character(len=128) :: errmsg @@ -468,9 +468,9 @@ end subroutine rrtmgp_set_gases_sw !================================================================================================== subroutine rrtmgp_set_cloud_lw( & - state, pbuf, nlay, cld, cldfsnow, & - cldfgrau, cldfprime, graupel_in_rad, kdist_lw, cloud_lw, & - cld_lw_abs_cloudsim, snow_lw_abs_cloudsim, grau_lw_abs_cloudsim ) + state, pbuf, ncol, nlay, nlaycam, & + cld, cldfsnow, cldfgrau, cldfprime, graupel_in_rad, & + kdist_lw, cloud_lw, cld_lw_abs_cloudsim, snow_lw_abs_cloudsim, grau_lw_abs_cloudsim) ! Compute combined cloud optical properties. ! Create MCICA stochastic arrays for cloud LW optical properties. @@ -479,7 +479,9 @@ subroutine rrtmgp_set_cloud_lw( & ! arguments type(physics_state), intent(in) :: state type(physics_buffer_desc), pointer :: pbuf(:) + integer, intent(in) :: ncol ! number of columns in CAM chunk integer, intent(in) :: nlay ! number of layers in radiation calculation (may include "extra layer") + integer, intent(in) :: nlaycam ! number of CAM layers in radiation calculation real(r8), pointer :: cld(:,:) ! cloud fraction (liq+ice) real(r8), pointer :: cldfsnow(:,:) ! cloud fraction of just "snow clouds" real(r8), pointer :: cldfgrau(:,:) ! cloud fraction of just "graupel clouds" @@ -496,8 +498,7 @@ subroutine rrtmgp_set_cloud_lw( & ! Local variables - integer :: i, k, ncol - integer :: nver + integer :: i, k ! cloud radiative parameters are "in cloud" not "in cell" real(r8) :: liq_lw_abs(nlwbands,pcols,pver) ! liquid absorption optics depth (LW) @@ -508,16 +509,14 @@ subroutine rrtmgp_set_cloud_lw( & real(r8) :: c_cld_lw_abs(nlwbands,pcols,pver) ! combined cloud absorption optics depth (LW) ! Arrays for converting from CAM chunks to RRTMGP inputs. - real(r8), allocatable :: cldf(:,:) - real(r8), allocatable :: tauc(:,:,:) - real(r8), allocatable :: taucmcl(:,:,:) + real(r8) :: cldf(ncol,nlaycam) + real(r8) :: tauc(nlwbands,ncol,nlaycam) + real(r8) :: taucmcl(nlwgpts,ncol,nlaycam) character(len=128) :: errmsg character(len=*), parameter :: sub = 'rrtmgp_set_cloud_lw' !-------------------------------------------------------------------------------- - ncol = state%ncol - ! Combine the cloud optical properties. These calculations are done on CAM "chunks". ! gammadist liquid optics @@ -566,22 +565,14 @@ subroutine rrtmgp_set_cloud_lw( & ! Extract just the layers of CAM where RRTMGP does calculations. - ! number of CAM's layers in radiation calculation. Does not include the "extra layer". - nver = pver - ktopcam + 1 - - allocate( & - cldf(ncol,nver), & - tauc(nlwbands,ncol,nver), & - taucmcl(nlwgpts,ncol,nver) ) - ! Subset "chunk" data so just the number of CAM layers in the ! radiation calculation are used by MCICA to produce subcolumns. cldf = cldfprime(:ncol, ktopcam:) tauc = c_cld_lw_abs(:, :ncol, ktopcam:) call mcica_subcol_lw( & - kdist_lw, nlwbands, nlwgpts, ncol, nver, & - nlwgpts, state%pmid, cldf, tauc, taucmcl ) + kdist_lw, nlwbands, nlwgpts, ncol, nlaycam, & + nlwgpts, state%pmid, cldf, tauc, taucmcl ) errmsg =cloud_lw%alloc_1scl(ncol, nlay, kdist_lw) if (len_trim(errmsg) > 0) then @@ -603,9 +594,6 @@ subroutine rrtmgp_set_cloud_lw( & call endrun(sub//': ERROR: cloud_lw%validate: '//trim(errmsg)) end if - ! All information is in cloud_lw, now deallocate local vars. - deallocate(cldf, tauc, taucmcl) - end subroutine rrtmgp_set_cloud_lw !================================================================================================== From 52bdd66e0ee3fbb30f94e3b7183b97472f4562d7 Mon Sep 17 00:00:00 2001 From: Brian Eaton Date: Thu, 12 Oct 2023 19:30:57 -0400 Subject: [PATCH 167/291] update ccs_config external --- Externals.cfg | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Externals.cfg b/Externals.cfg index 8a4baa7dfb..5110afadb8 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -1,7 +1,7 @@ [ccs_config] -hash = 980862e +tag = ccs_config_cesm0.0.79 protocol = git -repo_url = https://github.com/brian-eaton/ccs_config_cesm +repo_url = https://github.com/ESMCI/ccs_config_cesm local_path = ccs_config required = True From b489af0fbb554e39affd2acec66e8dead782b9f2 Mon Sep 17 00:00:00 2001 From: Brian Eaton Date: Fri, 13 Oct 2023 12:04:25 -0400 Subject: [PATCH 168/291] modify initialization in cam_dev to match cam --- src/physics/cam_dev/physpkg.F90 | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/src/physics/cam_dev/physpkg.F90 b/src/physics/cam_dev/physpkg.F90 index b288a17177..ba945def14 100644 --- a/src/physics/cam_dev/physpkg.F90 +++ b/src/physics/cam_dev/physpkg.F90 @@ -837,16 +837,19 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) ! low level, so init it early. Must at least do this before radiation. call wv_sat_init + ! solar irradiance data modules + call solar_data_init() + ! Initialize rad constituents and their properties call rad_cnst_init() + + call radiation_init(pbuf2d) + call aer_rad_props_init() ! initialize carma call carma_init() - ! solar irradiance data modules - call solar_data_init() - ! Prognostic chemistry. call chem_init(phys_state,pbuf2d) @@ -882,8 +885,6 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) endif endif - call radiation_init(pbuf2d) - call cloud_diagnostics_init() call radheat_init(pref_mid) From 99361e130b072275b365d00c6bb01015c1680460 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Fri, 13 Oct 2023 11:24:34 -0600 Subject: [PATCH 169/291] Updates to copy GEOS-Chem files to case and then run directory Signed-off-by: Lizzie Lundgren --- cime_config/buildnml | 5 ++--- cime_config/cam.case_setup | 29 ++++++++++++++--------------- src/physics/cam/physpkg.F90 | 1 + 3 files changed, 17 insertions(+), 18 deletions(-) diff --git a/cime_config/buildnml b/cime_config/buildnml index 98789a6f5e..79552907a0 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -221,9 +221,8 @@ def buildnml(case, caseroot, compname): 'HISTORY.rc', 'HEMCO_Config.rc', 'HEMCO_Diagn.rc']: file1 = os.path.join(caseroot, fname) file2 = os.path.join(rundir, fname) - if not os.path.exists(file2): - logger.info("GEOS-Chem config file copy: file1 %s file2 %s ", file1, file2) - shutil.copy(file1,file2) + logger.info("GEOS-Chem config file copy: file1 %s file2 %s ", file1, file2) + shutil.copy(file1,file2) ############################################################################### def _main_func(): diff --git a/cime_config/cam.case_setup b/cime_config/cam.case_setup index fc0f6d2742..092ab49ee7 100755 --- a/cime_config/cam.case_setup +++ b/cime_config/cam.case_setup @@ -2,29 +2,28 @@ # This script is run from CIME when calling case.setup -cam_root=$1 -cam_config=$2 -case_root=$3 +case_root=$1 +cam_root=$2 +cam_options=$3 -# GEOS-Chem only: copy config files to case -gc_option="-chem geoschem" -if [[ "${cam_config}" == *"${gc_option}"* ]]; then +# Copy GEOS-Chem configuration files from source code to case +if [[ "${cam_options}" == *"geoschem"* ]]; then geoschem_config_src="${cam_root}/src/chemistry/geoschem/geoschem_src/run/CESM" if [ ! -d "${geoschem_config_src}" ]; then - echo "ERROR: Did not find path to GEOS-Chem source code at ${geoschem_config_src}" + echo "ERROR: GEOS-Chem source code not found at ${geoschem_config_src}" exit 1 fi - fnames=('species_database.yml', 'geoschem_config.yml', 'HISTORY.rc', 'HEMCO_Config.rc', 'HEMCO_Diagn.rc') + fnames=('species_database.yml' 'geoschem_config.yml' 'HISTORY.rc' 'HEMCO_Config.rc' 'HEMCO_Diagn.rc') for fname in ${fnames[*]}; do - sourcefile="${cam_root}/${geoschem_config_src}/${fname}" - targetfile="${case_root}/${fileName}" - if [ ! -f "${sourcefile}" ]; then - echo "ERROR: Cannot find GEOS-Chem configuration file to move: ${sourcefile}" + source_file="${geoschem_config_src}/${fname}" + target_file="${case_root}/${fname}" + if [ ! -f "${source_file}" ]; then + echo "ERROR: Cannot find GEOS-Chem configuration file ${source_file}" exit 1 fi - if [ ! -f "${targetfile}" ]; then - echo "CAM namelist one-time copy of GEOS-Chem run directory files: from ${sourcefile} to ${targetfile}" + if [ ! -f "${target_file}" ]; then + echo "One-time copy of GEOS-Chem run directory files from ${source_file} to ${target_file}" fi - cp ${sourcefile} ${targetfile} + cp ${source_file} ${target_file} done fi diff --git a/src/physics/cam/physpkg.F90 b/src/physics/cam/physpkg.F90 index 62fa13b6fd..706b9dcdee 100644 --- a/src/physics/cam/physpkg.F90 +++ b/src/physics/cam/physpkg.F90 @@ -1616,6 +1616,7 @@ subroutine tphysac (ztodt, cam_in, & call chem_timestep_tend(state, ptend, cam_in, cam_out, ztodt, & pbuf, fh2o=fh2o) + if ( (trim(cam_take_snapshot_after) == "chem_timestep_tend") .and. & (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then call cam_snapshot_ptend_outfld(ptend, lchnk) From 2731270797495a077c90c5a14a0ada6c1411a018 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Fri, 13 Oct 2023 14:28:39 -0600 Subject: [PATCH 170/291] Change cam case_setup script from bash to python This update requires cime updates at: https://github.com/ESMCI/cime/pull/4497 Signed-off-by: Lizzie Lundgren --- cime_config/cam.case_setup | 29 ----------------------------- cime_config/cam.case_setup.py | 28 ++++++++++++++++++++++++++++ 2 files changed, 28 insertions(+), 29 deletions(-) delete mode 100755 cime_config/cam.case_setup create mode 100755 cime_config/cam.case_setup.py diff --git a/cime_config/cam.case_setup b/cime_config/cam.case_setup deleted file mode 100755 index 092ab49ee7..0000000000 --- a/cime_config/cam.case_setup +++ /dev/null @@ -1,29 +0,0 @@ -#! /usr/bin/env bash - -# This script is run from CIME when calling case.setup - -case_root=$1 -cam_root=$2 -cam_options=$3 - -# Copy GEOS-Chem configuration files from source code to case -if [[ "${cam_options}" == *"geoschem"* ]]; then - geoschem_config_src="${cam_root}/src/chemistry/geoschem/geoschem_src/run/CESM" - if [ ! -d "${geoschem_config_src}" ]; then - echo "ERROR: GEOS-Chem source code not found at ${geoschem_config_src}" - exit 1 - fi - fnames=('species_database.yml' 'geoschem_config.yml' 'HISTORY.rc' 'HEMCO_Config.rc' 'HEMCO_Diagn.rc') - for fname in ${fnames[*]}; do - source_file="${geoschem_config_src}/${fname}" - target_file="${case_root}/${fname}" - if [ ! -f "${source_file}" ]; then - echo "ERROR: Cannot find GEOS-Chem configuration file ${source_file}" - exit 1 - fi - if [ ! -f "${target_file}" ]; then - echo "One-time copy of GEOS-Chem run directory files from ${source_file} to ${target_file}" - fi - cp ${source_file} ${target_file} - done -fi diff --git a/cime_config/cam.case_setup.py b/cime_config/cam.case_setup.py new file mode 100755 index 0000000000..19bea2c567 --- /dev/null +++ b/cime_config/cam.case_setup.py @@ -0,0 +1,28 @@ +#! /usr/bin/env python3 + +""" +Script run from CIME when calling case.setup +Expects 3 arguments: + (1) case root path + (2) cam root path + (3) cam configuration options +""" + +import sys, os, shutil + +case_root = sys.argv[1] +cam_root = sys.argv[2] +cam_options = sys.argv[3] + +# If using GEOS-Chem chemistry then copy GEOS-Chem configuration files from source code to case +if '-chem geoschem' in cam_options: + geoschem_src = os.path.join(cam_root,'src','chemistry','geoschem','geoschem_src') + if not os.path.isdir(geoschem_src): + raise SystemExit("ERROR: Did not find path to GEOS-Chem source code at {:s}".format(geoschem_src)) + for fname in ['species_database.yml', 'geoschem_config.yml', + 'HISTORY.rc', 'HEMCO_Config.rc', 'HEMCO_Diagn.rc']: + file1 = os.path.join(geoschem_src, 'run','CESM', fname) + if not os.path.exists(file1): + raise SystemExit("ERROR: GEOS-Chem configuration file does not exist: {}".format(file1)) + file2 = os.path.join(case_root, fname) + shutil.copy(file1,file2) From c44c904445d52b334d0e7e9aabe40c8a008a24ae Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Fri, 13 Oct 2023 14:32:57 -0600 Subject: [PATCH 171/291] Fix typo in error message Signed-off-by: Lizzie Lundgren --- src/physics/cam/constituents.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/physics/cam/constituents.F90 b/src/physics/cam/constituents.F90 index cda9c82db4..b93cf060b3 100644 --- a/src/physics/cam/constituents.F90 +++ b/src/physics/cam/constituents.F90 @@ -173,7 +173,7 @@ subroutine cnst_add (name, mwc, cpc, qminc, & padv = padv+1 ind = padv if (padv > pcnst) then - write(errmsg, *) sub//': FATAL: advected tracer (', trim(name), ') index for greater than pcnst=', pcnst + write(errmsg, *) sub//': FATAL: advected tracer (', trim(name), ') index is greater than number of constituents' call endrun(errmsg) end if From ba3134841b6258f4ff516eb6f4f91e876ba5a781 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Fri, 13 Oct 2023 15:21:45 -0600 Subject: [PATCH 172/291] Change GEOS-Chem acronym in compset long name from GC to GEOSCHEM The compset aliases will continue to use GC, e.g. FCnudged_GC Signed-off-by: Lizzie Lundgren --- cime_config/config_component.xml | 20 ++++++++--------- cime_config/config_compsets.xml | 38 ++++++++++++++++---------------- cime_config/config_pes.xml | 2 +- 3 files changed, 30 insertions(+), 30 deletions(-) diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index 899c6083ae..ab760aeede 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -8,9 +8,9 @@ CAM =============== --> - CAM cam6 physics: - CAM cam5 physics: - CAM cam4 physics: + CAM cam6 physics: + CAM cam5 physics: + CAM cam4 physics: CAM cam3 physics: CAM simplified and non-versioned physics : CAM7 development physics: @@ -38,7 +38,7 @@ --> CAM-Chem troposphere/stratosphere chemistry with simplified VBS-SOA: CAM-Chem troposphere/stratosphere chemistry with simplified VBS-SOA and expanded isoprene and terpene oxidation: - GEOS-Chem troposphere/stratosphere chemistry : + GEOS-Chem troposphere/stratosphere chemistry : CAM-Chem troposphere/stratosphere chem with simplified volatility basis set SOA scheme and fire emissons : CAM CLUBB - turned on by default in CAM60: CAM-Chem troposphere/stratosphere chem with extended volatility basis set SOA scheme and modal aersols : @@ -141,7 +141,7 @@ -phys cam_dev -chem ghg_mam4 -chem trop_strat_mam5_vbs - -chem geoschem_mam4 + -chem geoschem_mam4 -chem trop_mam7 -chem trop_strat_mam5_vbsext @@ -175,7 +175,7 @@ -offline_dyn -nlev 56 -nlev 56 - -nlev 56 + -nlev 56 -nlev 88 -nlev 145 -nlev 58 -model_top lt @@ -233,7 +233,7 @@ waccm_ma_2000_cam6 waccm_sc_2000_cam6 2000_trop_strat_vbs_cam6 - 2000_geoschem + 2000_geoschem waccmx_ma_2000_cam6 aquaplanet_cam3 @@ -250,7 +250,7 @@ 2010_trop_strat_vbs_cam6 waccm_tsmlt_2010_cam6 waccm_sc_2010_cam6 - 2010_geoschem + 2010_geoschem 1850-2005_cam5 1850-2005_cam4 @@ -271,8 +271,8 @@ hist_trop_strat_nudged_cam6 hist_trop_strat_vbsext_cam6 hist_trop_strat_vbsfire_cam6 - hist_geoschem - hist_geoschem_nudged + hist_geoschem + hist_geoschem_nudged waccmx_ma_hist_cam6 1850-PD_cam5 diff --git a/cime_config/config_compsets.xml b/cime_config/config_compsets.xml index 1ab4866706..ce65ad81e1 100644 --- a/cime_config/config_compsets.xml +++ b/cime_config/config_compsets.xml @@ -563,27 +563,27 @@ FC2000climo_GC - 2000_CAM60%GC%HEMCO_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV + 2000_CAM60%GEOSCHEM%HEMCO_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV FC2010climo_GC - 2010_CAM60%GC%HEMCO_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV + 2010_CAM60%GEOSCHEM%HEMCO_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV FCHIST_GC - HIST_CAM60%GC%HEMCO_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV + HIST_CAM60%GEOSCHEM%HEMCO_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV FCSD_GC - HIST_CAM60%GC%HEMCO%SDYN_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV + HIST_CAM60%GEOSCHEM%HEMCO%SDYN_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV FCnudged_GC - HIST_CAM60%GC%HEMCO%NUDG_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV + HIST_CAM60%GEOSCHEM%HEMCO%NUDG_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV @@ -599,18 +599,18 @@ 1980-01-01 1850-01-01 2010-01-01 - 2015-01-01 + 2015-01-01 2013-01-01 1995-01-01 1995-01-01 2005-01-01 2005-01-01 - 2015-01-01 + 2015-01-01 2010-01-01 1980-01-01 2000-01-01 - 2000-01-01 - 2010-01-01 + 2000-01-01 + 2010-01-01 2004-01-01 1950-01-01 @@ -649,7 +649,7 @@ 1 1 - 1 + 1 @@ -657,7 +657,7 @@ 1 1 - 1 + 1 @@ -665,7 +665,7 @@ 1 1 - 1 + 1 @@ -673,7 +673,7 @@ 1 1 - 1 + 1 @@ -681,7 +681,7 @@ 1 1 - 1 + 1 @@ -689,7 +689,7 @@ 1 1 - 1 + 1 @@ -697,7 +697,7 @@ 1 1 - 1 + 1 @@ -705,7 +705,7 @@ 1 1 - 1 + 1 @@ -713,7 +713,7 @@ 1 1 - 1 + 1 @@ -721,7 +721,7 @@ 1 1 - 1 + 1 diff --git a/cime_config/config_pes.xml b/cime_config/config_pes.xml index 49a5a4594b..fd0d3694ad 100644 --- a/cime_config/config_pes.xml +++ b/cime_config/config_pes.xml @@ -1769,7 +1769,7 @@ 1 - + 1 1 From da76f711576ac0143d5202aec009cdd54dfa548c Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Mon, 16 Oct 2023 13:40:14 -0600 Subject: [PATCH 173/291] Change GEOS-Chem namelist and its parameter to use geoschem not gc This update also changes the subroutine used to read the namelist from gc_readnl to geoschem_readnl. Signed-off-by: Lizzie Lundgren --- bld/namelist_files/namelist_definition.xml | 4 +-- .../use_cases/2000_geoschem.xml | 2 +- .../use_cases/2010_geoschem.xml | 2 +- .../use_cases/hist_geoschem.xml | 2 +- .../use_cases/hist_geoschem_nudged.xml | 2 +- bld/namelist_files/use_cases/sd_geoschem.xml | 2 +- src/chemistry/geoschem/chemistry.F90 | 26 +++++++++---------- 7 files changed, 20 insertions(+), 20 deletions(-) diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index b9bfa1e0ec..613ee17492 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -5100,8 +5100,8 @@ Default: set by build-namelist for climo cases, otherwise -1 to use model clock. - + Full pathname to GEOS-Chem chemistry inputs directory Default: set by build-namelist. diff --git a/bld/namelist_files/use_cases/2000_geoschem.xml b/bld/namelist_files/use_cases/2000_geoschem.xml index d967d25c41..11a3b20b03 100644 --- a/bld/namelist_files/use_cases/2000_geoschem.xml +++ b/bld/namelist_files/use_cases/2000_geoschem.xml @@ -6,7 +6,7 @@ -/glade/p/univ/umit0034/ExtData/CHEM_INPUTS/ +/glade/p/univ/umit0034/ExtData/CHEM_INPUTS/ /glade/p/univ/umit0034/Shared/GEOS-Chem/f.e20.FC2010.f09_f09.144.GC_vbsext.001.cam.i.0007-01-01-00000.nc diff --git a/bld/namelist_files/use_cases/2010_geoschem.xml b/bld/namelist_files/use_cases/2010_geoschem.xml index b0bce3ae6b..04bd57b1ba 100644 --- a/bld/namelist_files/use_cases/2010_geoschem.xml +++ b/bld/namelist_files/use_cases/2010_geoschem.xml @@ -4,7 +4,7 @@ -/glade/p/univ/umit0034/ExtData/CHEM_INPUTS/ +/glade/p/univ/umit0034/ExtData/CHEM_INPUTS/ /glade/p/univ/umit0034/Shared/GEOS-Chem/f.e20.FC2010.f09_f09.144.GC_vbsext.001.cam.i.0007-01-01-00000.nc diff --git a/bld/namelist_files/use_cases/hist_geoschem.xml b/bld/namelist_files/use_cases/hist_geoschem.xml index 6e4c1d181b..5d1ec8e1e4 100644 --- a/bld/namelist_files/use_cases/hist_geoschem.xml +++ b/bld/namelist_files/use_cases/hist_geoschem.xml @@ -6,7 +6,7 @@ -/glade/p/univ/umit0034/ExtData/CHEM_INPUTS/ +/glade/p/univ/umit0034/ExtData/CHEM_INPUTS/ /glade/p/univ/umit0034/Shared/GEOS-Chem/f.e20.FC2010.f09_f09.144.GC_vbsext.001.cam.i.0007-01-01-00000.nc diff --git a/bld/namelist_files/use_cases/hist_geoschem_nudged.xml b/bld/namelist_files/use_cases/hist_geoschem_nudged.xml index 13afb38906..9e71a46303 100644 --- a/bld/namelist_files/use_cases/hist_geoschem_nudged.xml +++ b/bld/namelist_files/use_cases/hist_geoschem_nudged.xml @@ -6,7 +6,7 @@ -/glade/p/univ/umit0034/ExtData/CHEM_INPUTS/ +/glade/p/univ/umit0034/ExtData/CHEM_INPUTS/ /glade/p/univ/umit0034/Shared/GEOS-Chem/f.e20.FC2010.f09_f09.144.GC_vbsext.001.cam.i.0007-01-01-00000.nc diff --git a/bld/namelist_files/use_cases/sd_geoschem.xml b/bld/namelist_files/use_cases/sd_geoschem.xml index 8691b5babb..a29c3f9ed6 100644 --- a/bld/namelist_files/use_cases/sd_geoschem.xml +++ b/bld/namelist_files/use_cases/sd_geoschem.xml @@ -6,7 +6,7 @@ -/glade/p/univ/umit0034/ExtData/CHEM_INPUTS/ +/glade/p/univ/umit0034/ExtData/CHEM_INPUTS/ /glade/p/univ/umit0034/Shared/GEOS-Chem/f.e20.FCSD.f19_f19_mg17.cesm2.1-exp002.001.cam.i.2005-01-01-00000_c180801.nc atm/cam/met/MERRA2/1.9x2.5/fv_1.9x2.5_nc3000_Nsw084_Nrs016_Co120_Fi001_ZR_GRNL_MERRA2_c190617.nc diff --git a/src/chemistry/geoschem/chemistry.F90 b/src/chemistry/geoschem/chemistry.F90 index f5534a0ee8..c947494808 100644 --- a/src/chemistry/geoschem/chemistry.F90 +++ b/src/chemistry/geoschem/chemistry.F90 @@ -66,7 +66,7 @@ module chemistry CHARACTER(LEN=500) :: speciesDB = 'species_database.yml' ! Location of chemistry input - CHARACTER(LEN=shr_kind_cl) :: gc_cheminputs + CHARACTER(LEN=shr_kind_cl) :: geoschem_cheminputs ! Debugging LOGICAL :: debug = .TRUE. @@ -724,7 +724,7 @@ subroutine chem_readnl(nlfile) CALL lightning_readnl(nlfile) - CALL gc_readnl(nlfile) + CALL geoschem_readnl(nlfile) IF ( MasterProc ) THEN @@ -1129,9 +1129,9 @@ subroutine chem_init(phys_state, pbuf2d) RC = RC ) ! First setup directories - Input_Opt%Chem_Inputs_Dir = TRIM(gc_cheminputs) + Input_Opt%Chem_Inputs_Dir = TRIM(geoschem_cheminputs) Input_Opt%SpcDatabaseFile = TRIM(speciesDB) - Input_Opt%FAST_JX_DIR = TRIM(gc_cheminputs)//'FAST_JX/v2020-02/' + Input_Opt%FAST_JX_DIR = TRIM(geoschem_cheminputs)//'FAST_JX/v2020-02/' !---------------------------------------------------------- ! CESM-specific input flags @@ -1739,9 +1739,9 @@ subroutine gc_update_timesteps(DT) end subroutine gc_update_timesteps !================================================================================================ - ! subroutine gc_readnl + ! subroutine geoschem_readnl !================================================================================================ - subroutine gc_readnl(nlfile) + subroutine geoschem_readnl(nlfile) ! Purpose: reads the namelist from cam/src/control/runtime_opts ! CAM modules @@ -1751,17 +1751,17 @@ subroutine gc_readnl(nlfile) character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input integer :: unitn, ierr - character(len=*), parameter :: subname = 'gc_readnl' + character(len=*), parameter :: subname = 'geoschem_readnl' - namelist /gc_nl/ gc_cheminputs + namelist /geoschem_nl/ geoschem_cheminputs ! Read namelist IF ( MasterProc ) THEN unitn = getunit() OPEN( unitn, FILE=TRIM(nlfile), STATUS='old' ) - CALL find_group_name(unitn, 'gc_nl', STATUS=ierr) + CALL find_group_name(unitn, 'geoschem_nl', STATUS=ierr) IF ( ierr == 0 ) THEN - READ(unitn, gc_nl, IOSTAT=ierr) + READ(unitn, geoschem_nl, IOSTAT=ierr) IF ( ierr /= 0 ) THEN CALL ENDRUN(subname // ':: ERROR reading namelist') ENDIF @@ -1771,12 +1771,12 @@ subroutine gc_readnl(nlfile) ENDIF ! Broadcast namelist variables - CALL mpi_bcast(gc_cheminputs, LEN(gc_cheminputs), mpi_character, masterprocid, mpicom, ierr) + CALL mpi_bcast(geoschem_cheminputs, LEN(geoschem_cheminputs), mpi_character, masterprocid, mpicom, ierr) IF ( ierr /= mpi_success ) then - CALL endrun(subname//': MPI_BCAST ERROR: gc_cheminputs') + CALL endrun(subname//': MPI_BCAST ERROR: geoschem_cheminputs') ENDIF - end subroutine gc_readnl + end subroutine geoschem_readnl !================================================================================================ ! subroutine chem_timestep_tend From 7ce9dd8d44b20d7c90716c32e2f1a90181d153ee Mon Sep 17 00:00:00 2001 From: Brian Eaton Date: Tue, 17 Oct 2023 15:16:15 -0600 Subject: [PATCH 174/291] add limits on P and T for FMTHIST --- src/physics/rrtmgp/rrtmgp_inputs.F90 | 23 ++++++++++------------- 1 file changed, 10 insertions(+), 13 deletions(-) diff --git a/src/physics/rrtmgp/rrtmgp_inputs.F90 b/src/physics/rrtmgp/rrtmgp_inputs.F90 index 7f5cda89a4..938be91767 100644 --- a/src/physics/rrtmgp/rrtmgp_inputs.F90 +++ b/src/physics/rrtmgp/rrtmgp_inputs.F90 @@ -154,23 +154,20 @@ subroutine rrtmgp_set_state( & ! The top reference pressure from the RRTMGP coefficients datasets is 1.005183574463 Pa ! Set the top of the extra layer just below that. pint_rad(:,1) = 1.01_r8 + else + ! nlay < pverp, thus the 1 Pa level is within a CAM layer. Assuming the top interface of + ! this layer is at a pressure < 1 Pa, we need to adjust the top of this layer so that it + ! is within the valid pressure range of RRTMGP (otherwise RRTMGP issues an error). Then + ! set the midpoint pressure halfway between the interfaces. + pint_rad(:,1) = 1.01_r8 + pmid_rad(:,1) = 0.5_r8 * (pint_rad(:,1) + pint_rad(:,2)) end if - ! Check that the temperatures are within the limits of RRTMGP validity. + ! Limit temperatures to be within the limits of RRTMGP validity. tref_min = kdist_sw%get_temp_min() tref_max = kdist_sw%get_temp_max() - if ( any(t_rad < tref_min) .or. any(t_rad > tref_max) ) then - ! Report out of range value and quit. - do i = 1, ncol - do k = 1, nlay - if ( t_rad(i,k) < tref_min .or. t_rad(i,k) > tref_max ) then - write(errmsg,*) 'temp outside valid range: ', t_rad(i,k), ': column lat=', & - state%lat(i)*180._r8/pi, ': column lon=', state%lon(i)*180._r8/pi, ': level idx=',k - call endrun(sub//': ERROR, '//errmsg) - end if - end do - end do - end if + t_rad = merge(t_rad, tref_min, t_rad > tref_min) + t_rad = merge(t_rad, tref_max, t_rad < tref_max) ! Construct arrays containing only daylight columns do i = 1, nday From 7f1d0993528283e53e692046d66d8411b447a0f1 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Tue, 17 Oct 2023 11:19:39 -0400 Subject: [PATCH 175/291] Updates for paper, SE grid compatibility, bug fixes - Support Input_Opt%correctConvUTLS to correct for convective scavenging of soluble tracers (science update, upcoming paper) - Update to UCX mpi broadcast of State_Chm%NOXCOEFF as SE grid not all CPUs have same amount of chunks and MPI code has to be moved to higher level that is aware of chunking - Update to drydep namelist for SE compatibility - Fix for incorrect SOA mapping inconsistent with published Fritz et al. (2022) methodology Signed-off-by: Haipeng Lin --- src/chemistry/geoschem/chemistry.F90 | 88 ++++++++++++++++++---------- 1 file changed, 58 insertions(+), 30 deletions(-) diff --git a/src/chemistry/geoschem/chemistry.F90 b/src/chemistry/geoschem/chemistry.F90 index c947494808..43357aa854 100644 --- a/src/chemistry/geoschem/chemistry.F90 +++ b/src/chemistry/geoschem/chemistry.F90 @@ -656,6 +656,8 @@ subroutine chem_readnl(nlfile) use aero_model, only : aero_model_readnl use dust_model, only : dust_readnl #endif + ! For dry deposition on unstructured grids + use mo_drydep, only : drydep_srf_file ! args CHARACTER(LEN=*), INTENT(IN) :: nlfile ! filepath for file containing namelist input @@ -672,9 +674,9 @@ subroutine chem_readnl(nlfile) RC = GC_SUCCESS namelist /chem_inparm/ depvel_lnd_file + namelist /chem_inparm/ drydep_srf_file ! ghg chem - namelist /chem_inparm/ bndtvg, h2orates, ghg_chem if (debug .and. masterproc) write(iulog,'(a)') 'chem_readnl: reading namelists for GEOS-Chem chemistry' @@ -831,7 +833,7 @@ subroutine chem_readnl(nlfile) IF (IERR == 0) THEN READ(unitn, chem_inparm, IOSTAT=IERR) IF (IERR /= 0) THEN - CALL endrun('chem_readnl: ERROR reading namelist') + CALL endrun('chem_readnl: ERROR reading namelist chem_inparm') ENDIF ENDIF CLOSE(unitn) @@ -864,6 +866,10 @@ subroutine chem_readnl(nlfile) IF ( ierr /= mpi_success ) then CALL endrun(subname//': MPI_BCAST ERROR: depvel_lnd_file') ENDIF + CALL mpi_bcast(drydep_srf_file, LEN(drydep_srf_file), mpi_character, masterprocid, mpicom, ierr) + IF ( ierr /= mpi_success ) then + CALL endrun(subname//': MPI_BCAST ERROR: drydep_srf_file') + ENDIF CALL mpi_bcast(ghg_chem, 1, mpi_logical, masterprocid, mpicom, ierr) IF ( ierr /= mpi_success ) then CALL endrun(subname//': MPI_BCAST ERROR: ghg_chem') @@ -1122,32 +1128,31 @@ subroutine chem_init(phys_state, pbuf2d) Input_Opt%thisCPU = myCPU Input_Opt%amIRoot = MasterProc - !IF ( MasterProc ) THEN - IF ( .True. ) THEN - CALL Read_Input_File( Input_Opt = Input_Opt, & - State_Grid = maxGrid, & - RC = RC ) - - ! First setup directories - Input_Opt%Chem_Inputs_Dir = TRIM(geoschem_cheminputs) - Input_Opt%SpcDatabaseFile = TRIM(speciesDB) - Input_Opt%FAST_JX_DIR = TRIM(geoschem_cheminputs)//'FAST_JX/v2020-02/' + CALL Read_Input_File( Input_Opt = Input_Opt, & + State_Grid = maxGrid, & + RC = RC ) - !---------------------------------------------------------- - ! CESM-specific input flags - !---------------------------------------------------------- - - ! onlineAlbedo -> True (use CLM albedo) - ! -> False (read monthly-mean albedo from HEMCO) - Input_Opt%onlineAlbedo = .true. + ! First setup directories + Input_Opt%Chem_Inputs_Dir = TRIM(geoschem_cheminputs) + Input_Opt%SpcDatabaseFile = TRIM(speciesDB) + Input_Opt%FAST_JX_DIR = TRIM(geoschem_cheminputs)//'FAST_JX/v2020-02/' + + !---------------------------------------------------------- + ! CESM-specific input flags + !---------------------------------------------------------- - ! applyQtend: apply tendencies of water vapor to specific humidity - Input_Opt%applyQtend = .False. + ! onlineAlbedo -> True (use CLM albedo) + ! -> False (read monthly-mean albedo from HEMCO) + Input_Opt%onlineAlbedo = .true. - IF ( .NOT. Input_Opt%LSOA ) THEN - CALL ENDRUN('CESM2-GC requires the complex SOA option to be on!') - ENDIF + ! applyQtend: apply tendencies of water vapor to specific humidity + Input_Opt%applyQtend = .False. + ! correctConvUTLS: Apply photolytic correction for convective scavenging of soluble tracers? + Input_Opt%correctConvUTLS = .true. + + IF ( .NOT. Input_Opt%LSOA ) THEN + CALL ENDRUN('CESM2-GC requires the complex SOA option to be on!') ENDIF CALL Validate_Directories( Input_Opt, RC ) @@ -1482,7 +1487,7 @@ subroutine chem_init(phys_state, pbuf2d) CALL aero_model_init( pbuf2d ) ! Initialize drydep - CALL drydep_inti( depvel_lnd_file) + CALL drydep_inti( depvel_lnd_file ) #endif IF ( gas_wetdep_method == 'NEU' ) THEN @@ -1592,6 +1597,18 @@ subroutine chem_init(phys_state, pbuf2d) State_Chm = State_Chm(I), & State_Diag = State_Diag(I), & State_Grid = State_Grid(I) ) + + ! Because not all CPUs in the communicator have the same amount of chunks, + ! it is only guaranteed that the first chunk in all CPUs can participate in + ! MPI_bcast of the NOXCOEFF array. So only the root CPU & root chunk will + ! read the NOXCOEFF array from disk, then broadcast to all other CPU's first + ! chunks, then remaining chunks can be copied locally without MPI. (hplin, 10/17/23) + IF( I == BEGCHUNK ) THEN + CALL mpi_bcast( State_Chm(I)%NOXCOEFF, size(State_Chm(I)%NOXCOEFF), mpi_real8, masterprocid, mpicom, ierr ) + IF ( ierr /= mpi_success ) CALL endrun('Error in mpi_bcast of NOXCOEFF in first chunk') + ELSE + State_CHM(I)%NOXCOEFF = State_Chm(BEGCHUNK)%NOXCOEFF + ENDIF ENDDO ENDIF @@ -1673,7 +1690,7 @@ subroutine chem_init(phys_state, pbuf2d) ! Cleanup Call Cleanup_State_Grid( maxGrid, RC ) - if (debug .and. masterproc) write(iulog,'(a)') 'chem_init: GEOS-Chem chemistry initialization complete' + if (masterproc) write(iulog,'(a)') 'chem_init: GEOS-Chem chemistry initialization complete' end subroutine chem_init @@ -2180,6 +2197,12 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) ENDDO #if defined( MODAL_AERO ) + ! NOTE: GEOS-Chem bulk aerosol concentrations (BCPI, BCPO, SO4, ...) are ZEROED OUT + ! here in order to be reconstructed from the modal concentrations. + ! + ! This means that any changes to the BULK mass will be ignored between the end + ! of the gas_phase_chemdr and the beginning of the next!! + ! ! First reset State_Chm%Species to zero out MAM-inherited GEOS-Chem aerosols DO M = 1, ntot_amode DO SM = 1, nspec_amode(M) @@ -2227,7 +2250,8 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) ! map2GC(bulk constituent index) constituent index (bulk) GEOS-Chem species index (bulk) ! map2MAM4(SM, M) SM, M (modal) constituent index (bulk) ! (map2MAM4 is a N to 1 operation) - ! + ! Query functions: + ! xname_massptr(SM, M) SM, M NAME of modal aer (bc_a1, bc_a4, ...) !------------------------------------------------------------------------------------------ binRatio = 0.0e+00_r8 DO M = 1, ntot_amode @@ -2405,15 +2429,18 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) ENDIF #endif + ! Convert mass fluxes to VMR as needed for MAM4 aerosols (these operate on vmr0 - initial and vmr1 - end of timestep) DO N = 1, gas_pcnst ! See definition of map2chm M = map2chm(N) IF ( M > 0 ) THEN + ! Is a GEOS-Chem species? vmr0(:nY,:nZ,N) = State_Chm(LCHNK)%Species(M)%Conc(1,:nY,nZ:1:-1) * & MWDry / adv_mass(N) ! We'll substract concentrations after chemistry later mmr_tend(:nY,:nZ,N) = REAL(State_Chm(LCHNK)%Species(M)%Conc(1,:nY,nZ:1:-1),r8) ELSEIF ( M < 0 ) THEN + ! Is a MAM4 species? Get VMR from state%q directly. vmr0(:nY,:nZ,N) = state%q(:nY,:nZ,-M) * & MWDry / adv_mass(N) mmr_tend(:nY,:nZ,N) = state%q(:nY,:nZ,-M) @@ -3865,6 +3892,8 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) ! Deal with aerosol SOA species ! First deal with lowest two volatility bins + ! Only map TOSA0 (K1) and ASOAN (K2) to soa1_ and soa2_, according to Fritz et al. + ! SOAIE (K3) and SOAGX (K4) were mapped in the code but are inconsistent with the model description paper. speciesName_1 = 'TSOA0' speciesName_2 = 'ASOAN' speciesName_3 = 'SOAIE' @@ -3886,10 +3915,9 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) N = lptr2_soa_a_amode(M,iBin) IF ( N <= 0 ) CYCLE P = mapCnst(N) - IF ( P > 0 .AND. K1 > 0 .AND. K2 > 0 .AND. K3 > 0 .AND. K4 > 0 ) THEN + IF ( P > 0 .AND. K1 > 0 .AND. K2 > 0 ) THEN vmr1(:nY,:nZ,P) = state%q(:nY,:nZ,N) / bulkMass(:nY,:nZ) & - * (vmr1(:nY,:nZ,K1) + vmr1(:nY,:nZ,K2) + & - vmr1(:nY,:nZ,K3) + vmr1(:nY,:nZ,K4)) + * (vmr1(:nY,:nZ,K1) + vmr1(:nY,:nZ,K2)) ENDIF ENDDO ENDDO From af0446aa994783a1195e09c1db3e6b931094fe04 Mon Sep 17 00:00:00 2001 From: Brian Eaton Date: Wed, 18 Oct 2023 11:11:53 -0600 Subject: [PATCH 176/291] fix namelist and cloud optics indexing for waccm --- bld/namelist_files/namelist_defaults_cam.xml | 21 ++++++++++++++++---- src/physics/rrtmgp/rrtmgp_inputs.F90 | 14 ++++++++----- 2 files changed, 26 insertions(+), 9 deletions(-) diff --git a/bld/namelist_files/namelist_defaults_cam.xml b/bld/namelist_files/namelist_defaults_cam.xml index b1768fae57..31faecaed3 100644 --- a/bld/namelist_files/namelist_defaults_cam.xml +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -456,7 +456,7 @@ atm/cam/physprops/ssam_rrtmg_c080918.nc atm/cam/physprops/sscm_rrtmg_c080918.nc - + atm/cam/physprops/sulfate_rrtmg_c080918.nc atm/cam/physprops/sulfate_rrtmg_c080918.nc atm/cam/physprops/dust1_rrtmg_c080918.nc @@ -497,7 +497,8 @@ atm/cam/physprops/ssam_rrtmg_c100508.nc atm/cam/physprops/dust_aeronet_rrtmg_c141106.nc atm/cam/physprops/sulfate_rrtmg_c080918.nc - + + atm/cam/physprops/sulfate_rrtmg_c080918.nc atm/cam/physprops/ocpho_rrtmg_c101112.nc atm/cam/physprops/ocpho_rrtmg_c130709.nc @@ -514,7 +515,8 @@ atm/cam/physprops/volc_camRRTMG_byradius_sigma1.6_mode1_c210211.nc atm/cam/physprops/volc_camRRTMG_byradius_sigma1.6_mode2_c210211.nc atm/cam/physprops/volc_camRRTMG_byradius_sigma1.2_mode3_c210211.nc - + + atm/cam/physprops/volc_camRRTMG_byradius_sigma1.6_c130724.nc atm/cam/physprops/volc_camRRTMG_byradius_sigma1.6_mode1_c210211.nc atm/cam/physprops/volc_camRRTMG_byradius_sigma1.6_mode2_c210211.nc @@ -549,18 +551,29 @@ atm/cam/physprops/mam7_mode5_rrtmg_c120904.nc atm/cam/physprops/mam7_mode6_rrtmg_c120904.nc atm/cam/physprops/mam7_mode7_rrtmg_c120904.nc - + + atm/cam/physprops/mam4_mode1_rrtmg_aeronetdust_c141106.nc atm/cam/physprops/mam4_mode2_rrtmg_aitkendust_c141106.nc atm/cam/physprops/mam4_mode3_rrtmg_aeronetdust_c141106.nc + atm/cam/physprops/mam4_mode1_rrtmg_aeronetdust_sig1.6_dgnh.48_c140304.nc atm/cam/physprops/mam4_mode3_rrtmg_aeronetdust_sig1.2_dgnl.40_c150219.nc + atm/cam/physprops/mam4_mode1_rrtmg_aeronetdust_c141106.nc atm/cam/physprops/mam4_mode2_rrtmg_aitkendust_c141106.nc atm/cam/physprops/mam4_mode3_rrtmg_aeronetdust_c141106.nc atm/cam/physprops/mam4_mode4_rrtmg_c130628.nc + atm/cam/physprops/mam4_mode1_rrtmg_aeronetdust_sig1.6_dgnh.48_c140304.nc atm/cam/physprops/mam4_mode3_rrtmg_aeronetdust_sig1.2_dgnl.40_c150219.nc + +atm/cam/physprops/mam4_mode1_rrtmg_aeronetdust_sig1.6_dgnh.48_c140304.nc +atm/cam/physprops/mam4_mode2_rrtmg_aitkendust_c141106.nc +atm/cam/physprops/mam4_mode3_rrtmg_aeronetdust_c141106.nc +atm/cam/physprops/mam4_mode4_rrtmg_c130628.nc +atm/cam/physprops/mam4_mode3_rrtmg_aeronetdust_sig1.2_dgnl.40_c150219.nc + atm/cam/physprops/mam7_mode1_rrtmg_c120904.nc atm/cam/physprops/mam7_mode2_rrtmg_c120904.nc atm/cam/physprops/mam7_mode3_rrtmg_c120904.nc diff --git a/src/physics/rrtmgp/rrtmgp_inputs.F90 b/src/physics/rrtmgp/rrtmgp_inputs.F90 index 938be91767..93b32b007f 100644 --- a/src/physics/rrtmgp/rrtmgp_inputs.F90 +++ b/src/physics/rrtmgp/rrtmgp_inputs.F90 @@ -566,7 +566,11 @@ subroutine rrtmgp_set_cloud_lw( & ! radiation calculation are used by MCICA to produce subcolumns. cldf = cldfprime(:ncol, ktopcam:) tauc = c_cld_lw_abs(:, :ncol, ktopcam:) + + ! Enforce tauc >= 0. + tauc = merge(tauc, 0.0_r8, tauc > 0.0_r8) + ! MCICA uses spectral data (on bands) to construct subcolumns (one per g-point) call mcica_subcol_lw( & kdist_lw, nlwbands, nlwgpts, ncol, nlaycam, & nlwgpts, state%pmid, cldf, tauc, taucmcl ) @@ -582,7 +586,7 @@ subroutine rrtmgp_set_cloud_lw( & ! Set the properties on g-points. do i = 1, nlwgpts - cloud_lw%tau(:ncol, ktoprad:, i) = taucmcl(i, :ncol, ktopcam:) + cloud_lw%tau(:,ktoprad:,i) = taucmcl(i,:,:) end do ! validate checks that: tau > 0 @@ -823,7 +827,7 @@ subroutine rrtmgp_set_cloud_sw( & ! set asymmetry to zero when tauc = 0 asmc = merge(asmc, 0.0_r8, tauc > 0.0_r8) - ! MCICA converts from bands to gpts (e.g., 224 g-points instead of 14 bands) + ! MCICA uses spectral data (on bands) to construct subcolumns (one per g-point) call mcica_subcol_sw( & kdist_sw, nswbands, nswgpts, nday, nlay, & nver, changeseed, pmid, cldf, tauc, & @@ -843,9 +847,9 @@ subroutine rrtmgp_set_cloud_sw( & ! Set the properties on g-points. do igpt = 1,nswgpts - cloud_sw%g (:, ktoprad:, igpt) = asmcmcl(igpt, ktopcam:, :) - cloud_sw%ssa(:, ktoprad:, igpt) = ssacmcl(igpt, ktopcam:, :) - cloud_sw%tau(:, ktoprad:, igpt) = taucmcl(igpt, ktopcam:, :) + cloud_sw%g (:,ktoprad:,igpt) = asmcmcl(igpt,:,:) + cloud_sw%ssa(:,ktoprad:,igpt) = ssacmcl(igpt,:,:) + cloud_sw%tau(:,ktoprad:,igpt) = taucmcl(igpt,:,:) end do ! validate checks that: tau > 0, ssa is in range [0,1], and g is in range [-1,1]. From a66be1578443f84c546a795cf9b4f168d5d019e4 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Thu, 19 Oct 2023 00:14:55 -0400 Subject: [PATCH 177/291] Slight formatting updates to GEOS-Chem run log output --- src/chemistry/geoschem/chemistry.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/chemistry/geoschem/chemistry.F90 b/src/chemistry/geoschem/chemistry.F90 index 43357aa854..ec38b67918 100644 --- a/src/chemistry/geoschem/chemistry.F90 +++ b/src/chemistry/geoschem/chemistry.F90 @@ -4210,8 +4210,8 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) Nullify(NEvapr ) Nullify(cmfdqr ) - IF ( rootChunk ) WRITE(iulog,*) ' GEOS-Chem Chemistry step ', iStep, ' completed' - IF ( lastChunk ) WRITE(iulog,*) ' Chemistry completed on all chunks completed of MasterProc' + IF ( rootChunk ) WRITE(iulog,*) 'GEOS-Chem Chemistry step ', iStep, ' completed' + IF ( lastChunk ) WRITE(iulog,*) 'Chemistry completed on all chunks of root CPU' IF ( FIRST ) THEN FIRST = .false. ENDIF From 18efa42822fc02556edb2dedf7519a7bb0fafe0c Mon Sep 17 00:00:00 2001 From: Brian Eaton Date: Thu, 19 Oct 2023 12:39:11 -0400 Subject: [PATCH 178/291] replace 1 by ktopcam in a few places for high top models --- src/physics/rrtmgp/radiation.F90 | 26 +++++++++++++++----------- 1 file changed, 15 insertions(+), 11 deletions(-) diff --git a/src/physics/rrtmgp/radiation.F90 b/src/physics/rrtmgp/radiation.F90 index 01d4a057cb..5af989e7fe 100644 --- a/src/physics/rrtmgp/radiation.F90 +++ b/src/physics/rrtmgp/radiation.F90 @@ -1327,9 +1327,10 @@ subroutine radiation_tend( & ! N.B.: For snow optical properties, the GRID-BOX MEAN shortwave and longwave ! optical depths are passed. - call cospsimulator_intr_run(state, pbuf, cam_in, emis, coszrs, & - cld_swtau_in=cld_tau_cloudsim,& - snow_tau_in=gb_snow_tau, snow_emis_in=gb_snow_lw) + call cospsimulator_intr_run( & + state, pbuf, cam_in, emis, coszrs, & + cld_swtau_in=cld_tau_cloudsim, snow_tau_in=gb_snow_tau, & + snow_emis_in=gb_snow_lw) cosp_cnt(lchnk) = 0 end if end if ! docosp @@ -1438,10 +1439,10 @@ subroutine set_sw_diags() call heating_rate('SW', ncol, fns, qrs) call heating_rate('SW', ncol, fcns, rd%qrsc) - fsns(:ncol) = fns(:ncol,pverp) ! net sw flux at surface - fsnt(:ncol) = fns(:ncol,1) ! net sw flux at top-of-model (w/o extra layer) - rd%fsnsc(:ncol) = fcns(:ncol,pverp) ! net sw clearsky flux at surface - rd%fsntc(:ncol) = fcns(:ncol,1) ! net sw clearsky flux at top + fsns(:ncol) = fns(:ncol,pverp) ! net sw flux at surface + fsnt(:ncol) = fns(:ncol,ktopcam) ! net sw flux at top-of-model (w/o extra layer) + rd%fsnsc(:ncol) = fcns(:ncol,pverp) ! net sw clearsky flux at surface + rd%fsntc(:ncol) = fcns(:ncol,ktopcam) ! net sw clearsky flux at top cam_out%netsw(:ncol) = fsns(:ncol) @@ -1519,10 +1520,10 @@ subroutine set_lw_diags() call heating_rate('LW', ncol, fcnl, rd%qrlc) flns(:ncol) = fnl(:ncol, pverp) - flnt(:ncol) = fnl(:ncol, 1) + flnt(:ncol) = fnl(:ncol, ktopcam) rd%flnsc(:ncol) = fcnl(:ncol, pverp) - rd%flntc(:ncol) = fcnl(:ncol, 1) ! net lw flux at top-of-model + rd%flntc(:ncol) = fcnl(:ncol, ktopcam) ! net lw flux at top-of-model cam_out%flwds(:ncol) = flw%flux_dn(:, nlay+1) rd%fldsc(:ncol) = flwc%flux_dn(:, nlay+1) @@ -1563,10 +1564,13 @@ subroutine heating_rate(type, ncol, flux_net, hrate) ! local vars integer :: k + ! Initialize for layers where RRTMGP is not providing fluxes. + hrate = 0.0_r8 + select case (type) case ('LW') - do k = 1, pver + do k = ktopcam, pver ! (flux divergence as bottom-MINUS-top) * g/dp hrate(:ncol,k) = (flux_net(:ncol,k+1) - flux_net(:ncol,k)) * & gravit / state%pdel(:ncol,k) @@ -1574,7 +1578,7 @@ subroutine heating_rate(type, ncol, flux_net, hrate) case ('SW') - do k = 1, pver + do k = ktopcam, pver ! top - bottom hrate(:ncol,k) = (flux_net(:ncol,k) - flux_net(:ncol,k+1)) * & gravit / state%pdel(:ncol,k) From 972c057e14c63a6e4a0cd5ec20d3ed66c6fe3c04 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Fri, 20 Oct 2023 11:24:47 -0400 Subject: [PATCH 179/291] Update GEOS-Chem external tag to 14.1.2 --- Externals_CAM.cfg | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Externals_CAM.cfg b/Externals_CAM.cfg index 122a8bb0f0..5be47f26cb 100644 --- a/Externals_CAM.cfg +++ b/Externals_CAM.cfg @@ -80,7 +80,7 @@ required = True local_path = src/chemistry/geoschem/geoschem_src protocol = git repo_url = https://github.com/geoschem/geos-chem.git -tag = 14.1.1 +tag = 14.1.2 required = True [hemco] From 95bc735e49a1d454cc82550b901d690b3582248b Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Fri, 20 Oct 2023 11:20:01 -0600 Subject: [PATCH 180/291] Remove unnecessary comment about NTHRDS Signed-off-by: Lizzie Lundgren --- cime_config/config_compsets.xml | 6 ------ 1 file changed, 6 deletions(-) diff --git a/cime_config/config_compsets.xml b/cime_config/config_compsets.xml index ce65ad81e1..f64c1dd507 100644 --- a/cime_config/config_compsets.xml +++ b/cime_config/config_compsets.xml @@ -555,12 +555,6 @@ HIST_CAM60%WXIED%SDYN_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV - - - - - - FC2000climo_GC 2000_CAM60%GEOSCHEM%HEMCO_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV From 3f6d12ddccd19c03fdf7d7fcd18cb444aa679d52 Mon Sep 17 00:00:00 2001 From: Cheryl Craig Date: Fri, 20 Oct 2023 15:47:02 -0600 Subject: [PATCH 181/291] Modfy calling sequences to allow for removal of zm_common --- src/physics/cam/convect_shallow.F90 | 2 ++ src/physics/cam/zm_conv_intr.F90 | 3 +++ 2 files changed, 5 insertions(+) diff --git a/src/physics/cam/convect_shallow.F90 b/src/physics/cam/convect_shallow.F90 index 4f0844fd24..d7b909a375 100644 --- a/src/physics/cam/convect_shallow.F90 +++ b/src/physics/cam/convect_shallow.F90 @@ -14,6 +14,7 @@ module convect_shallow use physconst, only : cpair, zvir use ppgrid, only : pver, pcols, pverp use zm_conv_evap_mod, only : zm_conv_evap_run + use zm_conv_intr, only : zmconv_ke, zmconv_ke_lnd, zmconv_org use cam_history, only : outfld, addfld, horiz_only use cam_logfile, only : iulog use phys_control, only : phys_getopts @@ -868,6 +869,7 @@ subroutine convect_shallow_tend( ztodt , cmfmc , & call zm_conv_evap_run( state1%ncol, pcols, pver, pverp, & gravit, latice, latvap, tmelt, & + cpair, zmconv_ke, zmconv_ke_lnd, zmconv_org, & state1%t, state1%pmid, state1%pdel, state1%q(:pcols,:pver,1), & landfracdum, & ptend_loc%s, tend_s_snwprd, tend_s_snwevmlt, & diff --git a/src/physics/cam/zm_conv_intr.F90 b/src/physics/cam/zm_conv_intr.F90 index 2e44af000e..7d8445e688 100644 --- a/src/physics/cam/zm_conv_intr.F90 +++ b/src/physics/cam/zm_conv_intr.F90 @@ -38,6 +38,7 @@ module zm_conv_intr zm_conv_tend, &! return tendencies zm_conv_tend_2 ! return tendencies + public zmconv_ke, zmconv_ke_lnd, zmconv_org ! needed by convect_shallow integer ::& ! indices for fields in the physics buffer zm_mu_idx, & @@ -651,6 +652,7 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , & call zm_conv_evap_run(state1%ncol, pcols, pver, pverp, & gravit, latice, latvap, tmelt, & + cpair, zmconv_ke, zmconv_ke_lnd, zmconv_org, & state1%t,state1%pmid,state1%pdel,state1%q(:pcols,:pver,1), & landfrac, & ptend_loc%s, tend_s_snwprd, tend_s_snwevmlt, ptend_loc%q(:pcols,:pver,1), & @@ -710,6 +712,7 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , & call t_startf ('zm_conv_momtran_run') call zm_conv_momtran_run (ncol, pcols, pver, pverp, & l_windt,winds, 2, mu, md, & + zmconv_momcu, zmconv_momcd, & du, eu, ed, dp, dsubcld, & jt, maxg, ideep, 1, lengath, & nstep, wind_tends, pguall, pgdall, icwu, icwd, ztodt, seten ) From 3e7282b7e1a0653e63abe80e829162aa472c7a89 Mon Sep 17 00:00:00 2001 From: Brian Eaton Date: Tue, 24 Oct 2023 18:26:27 -0400 Subject: [PATCH 182/291] add tests; update ChangeLog --- cime_config/testdefs/testlist_cam.xml | 43 +++++ .../cam/cam6_port_f09_rrtmgp/shell_commands | 3 + .../cam/cam6_port_f09_rrtmgp/user_nl_cam | 15 ++ .../cam/outfrq9s_rrtmgp/shell_commands | 3 + .../cam/outfrq9s_rrtmgp/user_nl_cam | 4 + .../cam/outfrq9s_rrtmgp/user_nl_clm | 27 +++ .../usermods_dirs/rrtmgp/shell_commands | 7 - cime_config/usermods_dirs/rrtmgp/user_nl_cam | 11 -- .../usermods_dirs/scam_rrtmgp/shell_commands | 21 --- .../usermods_dirs/scam_rrtmgp/user_nl_cam | 15 -- doc/ChangeLog | 161 ++++++++++++++++++ src/physics/cam/phys_prop.F90 | 4 +- src/physics/spcam/crm/CLUBB/crmx_mt95.f90 | 6 +- 13 files changed, 260 insertions(+), 60 deletions(-) create mode 100644 cime_config/testdefs/testmods_dirs/cam/cam6_port_f09_rrtmgp/shell_commands create mode 100644 cime_config/testdefs/testmods_dirs/cam/cam6_port_f09_rrtmgp/user_nl_cam create mode 100644 cime_config/testdefs/testmods_dirs/cam/outfrq9s_rrtmgp/shell_commands create mode 100644 cime_config/testdefs/testmods_dirs/cam/outfrq9s_rrtmgp/user_nl_cam create mode 100644 cime_config/testdefs/testmods_dirs/cam/outfrq9s_rrtmgp/user_nl_clm delete mode 100755 cime_config/usermods_dirs/rrtmgp/shell_commands delete mode 100644 cime_config/usermods_dirs/rrtmgp/user_nl_cam delete mode 100755 cime_config/usermods_dirs/scam_rrtmgp/shell_commands delete mode 100644 cime_config/usermods_dirs/scam_rrtmgp/user_nl_cam diff --git a/cime_config/testdefs/testlist_cam.xml b/cime_config/testdefs/testlist_cam.xml index 854ad1ac5a..e56ca8d4a9 100644 --- a/cime_config/testdefs/testlist_cam.xml +++ b/cime_config/testdefs/testlist_cam.xml @@ -199,6 +199,14 @@ + + + + + + + + @@ -1745,6 +1753,15 @@ + + + + + + + + + @@ -1754,6 +1771,15 @@ + + + + + + + + + @@ -2678,6 +2704,15 @@ + + + + + + + + + @@ -2766,6 +2801,14 @@ + + + + + + + + diff --git a/cime_config/testdefs/testmods_dirs/cam/cam6_port_f09_rrtmgp/shell_commands b/cime_config/testdefs/testmods_dirs/cam/cam6_port_f09_rrtmgp/shell_commands new file mode 100644 index 0000000000..106897a2c6 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/cam6_port_f09_rrtmgp/shell_commands @@ -0,0 +1,3 @@ +./xmlchange --append CAM_CONFIG_OPTS="-rad rrtmgp" +./xmlchange ROF_NCPL=\$ATM_NCPL +./xmlchange GLC_NCPL=\$ATM_NCPL diff --git a/cime_config/testdefs/testmods_dirs/cam/cam6_port_f09_rrtmgp/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/cam6_port_f09_rrtmgp/user_nl_cam new file mode 100644 index 0000000000..fcbd0d438b --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/cam6_port_f09_rrtmgp/user_nl_cam @@ -0,0 +1,15 @@ + offline_driver_infile = '$DIN_LOC_ROOT/atm/cam/port/base_cam6_3mode_1deg.doubleCO2.cam.h1.0001-01-01-00000_c170526.nc' + rad_data_fdh = .true. + empty_htapes = .true. + avgflag_pertape = 'A','I' + fincl1 = 'SOLIN', 'QRS', 'FSNS', 'FSNT','FSNSC', 'FSDSC','FSNR','FLNR', + 'FSNTOA', 'FSUTOA', 'FSNTOAC', 'FSNTC', 'FSDSC', 'FSDS', 'SWCF', + 'QRL', 'FLNS', 'FLDS', 'FLNT', 'LWCF', 'FLUT' ,'FLUTC', 'FLNTC', + 'FLNSC', 'FLDSC' + fincl2 = 'SOLIN', 'QRS', 'FSNS', 'FSNT','FSNSC', 'FSDSC','FSNR','FLNR', + 'FSNTOA', 'FSUTOA', 'FSNTOAC', 'FSNTC', 'FSDSC', 'FSDS', 'SWCF', + 'QRL', 'FLNS', 'FLDS', 'FLNT', 'LWCF', 'FLUT' ,'FLUTC', 'FLNTC', + 'FLNSC', 'FLDSC' + rad_data_output = .false. + mfilt=100,100 + nhtfrq=-120,73 diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_rrtmgp/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_rrtmgp/shell_commands new file mode 100644 index 0000000000..106897a2c6 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_rrtmgp/shell_commands @@ -0,0 +1,3 @@ +./xmlchange --append CAM_CONFIG_OPTS="-rad rrtmgp" +./xmlchange ROF_NCPL=\$ATM_NCPL +./xmlchange GLC_NCPL=\$ATM_NCPL diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_rrtmgp/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_rrtmgp/user_nl_cam new file mode 100644 index 0000000000..8482082dce --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_rrtmgp/user_nl_cam @@ -0,0 +1,4 @@ +mfilt=1,1,1,1,1,1 +ndens=1,1,1,1,1,1 +nhtfrq=9,9,9,9,9,9 +inithist='ENDOFRUN' diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_rrtmgp/user_nl_clm b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_rrtmgp/user_nl_clm new file mode 100644 index 0000000000..0d83b5367b --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_rrtmgp/user_nl_clm @@ -0,0 +1,27 @@ +!---------------------------------------------------------------------------------- +! Users should add all user specific namelist changes below in the form of +! namelist_var = new_namelist_value +! +! Include namelist variables for drv_flds_in ONLY if -megan and/or -drydep options +! are set in the CLM_NAMELIST_OPTS env variable. +! +! EXCEPTIONS: +! Set use_cndv by the compset you use and the CLM_BLDNML_OPTS -dynamic_vegetation setting +! Set use_vichydro by the compset you use and the CLM_BLDNML_OPTS -vichydro setting +! Set use_cn by the compset you use and CLM_BLDNML_OPTS -bgc setting +! Set use_crop by the compset you use and CLM_BLDNML_OPTS -crop setting +! Set spinup_state by the CLM_BLDNML_OPTS -bgc_spinup setting +! Set irrigate by the CLM_BLDNML_OPTS -irrig setting +! Set dtime with L_NCPL option +! Set fatmlndfrc with LND_DOMAIN_PATH/LND_DOMAIN_FILE options +! Set finidat with RUN_REFCASE/RUN_REFDATE/RUN_REFTOD options for hybrid or branch cases +! (includes $inst_string for multi-ensemble cases) +! Set glc_grid with CISM_GRID option +! Set glc_smb with GLC_SMB option +! Set maxpatch_glcmec with GLC_NEC option +! Set glc_do_dynglacier with GLC_TWO_WAY_COUPLING env variable +!---------------------------------------------------------------------------------- +hist_nhtfrq = 9 +hist_mfilt = 1 +hist_ndens = 1 + diff --git a/cime_config/usermods_dirs/rrtmgp/shell_commands b/cime_config/usermods_dirs/rrtmgp/shell_commands deleted file mode 100755 index 341f65a34e..0000000000 --- a/cime_config/usermods_dirs/rrtmgp/shell_commands +++ /dev/null @@ -1,7 +0,0 @@ -./xmlchange --force STOP_OPTION=ndays - -./xmlchange --force STOP_N=2 - -./xmlchange --append CAM_CONFIG_OPTS="--rad rrtmgp" - -./xmlchange DOUT_S=FALSE diff --git a/cime_config/usermods_dirs/rrtmgp/user_nl_cam b/cime_config/usermods_dirs/rrtmgp/user_nl_cam deleted file mode 100644 index e13d8e4865..0000000000 --- a/cime_config/usermods_dirs/rrtmgp/user_nl_cam +++ /dev/null @@ -1,11 +0,0 @@ -nhtfrq = 0,-3,1 -mfilt = 1,8,1 -ndens = 2,2,2 -history_budget = .true. -history_budget_histfile_num = 1 - -FINCL1 = 'FUS', 'FDS', 'FUL', 'FDL', 'FUSC', 'FDSC', 'FULC', 'FDLC', 'HR', 'QRSC', 'QRLC', 'TOT_CLD_VISTAU', 'TOT_ICLD_VISTAU', 'LIQ_ICLD_VISTAU', 'ICE_ICLD_VISTAU', 'SNOW_ICLD_VISTAU' - -FINCL2 = 'SOLIN','FSNT','FSNTC','FSNTOA','FSNTOAC','SWCF','LWCF','FLUT','FLUTC','PRECT','CLDTOT','CLDLOW','CLDHGH','TMQ','TGCLDLWP','TGCLDIWP','QRS','QRSC','QRL','QRLC' - -FINCL3 = 'T','Q','U','V','QRS','QRSC','QRL','QRLC','DTCOND','PTTEND','DTCORE','PRECT','LHFLX','SHFLX','FLUT','FLUTC','FSNT','FSNTC' diff --git a/cime_config/usermods_dirs/scam_rrtmgp/shell_commands b/cime_config/usermods_dirs/scam_rrtmgp/shell_commands deleted file mode 100755 index ff2497324b..0000000000 --- a/cime_config/usermods_dirs/scam_rrtmgp/shell_commands +++ /dev/null @@ -1,21 +0,0 @@ -./xmlchange --force MPILIB=mpi-serial - -./xmlchange --force REST_OPTION=never - -./xmlchange --force CLM_FORCE_COLDSTART=on - -./xmlchange --force PTS_LON=238.5 - -./xmlchange --force PTS_LAT=31.5 - -./xmlchange --force RUN_STARTDATE=1999-07-11 - -./xmlchange --force START_TOD=0 - -./xmlchange --force STOP_OPTION=nsteps - -./xmlchange --force STOP_N=144 - -./xmlchange --append CAM_CONFIG_OPTS="--rad rrtmgp" - -./xmlchange DOUT_S=FALSE diff --git a/cime_config/usermods_dirs/scam_rrtmgp/user_nl_cam b/cime_config/usermods_dirs/scam_rrtmgp/user_nl_cam deleted file mode 100644 index 57ebe708ed..0000000000 --- a/cime_config/usermods_dirs/scam_rrtmgp/user_nl_cam +++ /dev/null @@ -1,15 +0,0 @@ -iopfile="$DIN_LOC_ROOT/atm/cam/scam/iop/DYCOMSrf02_48hr_4scam.nc" -ncdata="$DIN_LOC_ROOT/atm/cam/scam/iop/CESM2.F2000climo.IOP_SITES.cam.i.0003-07-01-00000.nc" -mfilt=2088 -nhtfrq=1 -scm_use_obs_uv = .true. -scm_use_obs_T =.true. -scm_relaxation = .true. -scm_relax_fincl = 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', - 'ncl_a3', 'num_a1', 'num_a2', 'num_a3', - 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' -scm_relax_bot_p = 105000. -scm_relax_top_p = 200. -scm_relax_linear = .true. -scm_relax_tau_bot_sec = 864000. -scm_relax_tau_top_sec = 172800. diff --git a/doc/ChangeLog b/doc/ChangeLog index 4a2c43d13f..60c061a614 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,5 +1,166 @@ =============================================================== +Tag name: +Originator(s): brianpm, courtneyp, eaton +Date: +One-line Summary: Provide RRTMGP as a radiation parameterization +Github PR URL: + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +#255 - Provide RRTMGP as a radiation parameterization +https://github.com/ESCOMP/CAM/issues/255 + +Describe any changes made to build system: +. '-rad' argument to configure accepts the values 'rrtmgp' and 'rrtmgp_gpu' + to build the RRTMGP code for CPUs or for GPUs. + +Describe any changes made to the namelist: +. add variables rrtmgp_coefs_lw_file and rrtmgp_coefs_sw_file to contain + filepaths for the RRTMGP coefficients files. + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: +. performance evaluation of RRTMGP has not yet been done. + +Code reviewed by: + +List all files eliminated: + +src/physics/rrtmg/cloud_rad_props.F90 +src/physics/rrtmg/ebert_curry.F90 +src/physics/rrtmg/oldcloud.F90 +src/physics/rrtmg/slingo.F90 +. these cloud optics files which can be shared by rrtmg and rrtmgp are + moved to src/physics/cam + +List all files added and what they do: + +bld/namelist_files/use_cases/1850_cam5.xml +. use case file for 1850 cam5 physics + +cime_config/testdefs/testmods_dirs/cam/cam6_port_f09_rrtmgp/shell_commands +cime_config/testdefs/testmods_dirs/cam/cam6_port_f09_rrtmgp/user_nl_cam +cime_config/testdefs/testmods_dirs/cam/outfrq9s_rrtmgp/shell_commands +cime_config/testdefs/testmods_dirs/cam/outfrq9s_rrtmgp/user_nl_cam +cime_config/testdefs/testmods_dirs/cam/outfrq9s_rrtmgp/user_nl_clm +. for adding RRTMGP to tests + +src/physics/cam/cloud_rad_props.F90 +src/physics/cam/ebert_curry.F90 +src/physics/cam/oldcloud.F90 +src/physics/cam/slingo.F90 +. these 4 files are shared cloud optics code moved here from src/physics/rrtmg/. +. remove unused code, cleanup unused vars + +src/physics/rrtmgp/mcica_subcol_gen.F90 +src/physics/rrtmgp/radconstants.F90 +src/physics/rrtmgp/radiation.F90 +src/physics/rrtmgp/rrtmgp_inputs.F90 +. CAM interface code for RRTMGP. + +List all existing files that have been modified, and describe the changes: + +.gitignore +. add directories src/physics/rrtmgp/{data,ext} + +Externals_CAM.cfg +. add external definition for rte-rrtmgp source +. add external definition for rrtmgp data + +bld/build-namelist +. set the correct filepaths for the coefficient datasets which are checked + out in the source code directory tree. +. generalize logic to include both rrtmgp and rrtmg when appropriate +. add error check for old cloud optics no longer supported + +bld/config_files/definition.xml +. add 'rrtmgp' as valid value for 'rad' configure option + +bld/configure +. add rrtmgp and rrtmgp_gpu as valid values for '-rad' argument. +. '-rad rrtmgp_gpu' sets a flag used to add the filepaths for the GPU code + versions to the Filepath file. The '_gpu' suffix is removed before + setting the parameter value for 'rad' in the config_cache.xml file. + +bld/namelist_files/namelist_defaults_cam.xml +. the aersol and cloud optics datasets for RRTMG are being reused for + RRTMGP for now + +bld/namelist_files/namelist_definition.xml +. add 'rrtmgp' as valid value for 'radiation_scheme' +. add variables rrtmgp_coefs_lw_file and rrtmgp_coefs_sw_file to contain + filepaths for the RRTMGP coefficients files. + +cime_config/testdefs/testlist_cam.xml (aux_cam) +. add aux_cam tests: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.cheyenne_intel.cam-outfrq9s_rrtmgp + SMS_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_rrtmgp + SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.cheyenne_intel.cam-outfrq9s_rrtmgp + ERP_D_Ln9.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_rrtmgp + SMS_Ld5.f09_f09_mg17.PC6.izumi_gnu.cam-cam6_port_f09_rrtmgp + +src/chemistry/utils/solar_data.F90 +. add solar_htng_spctrl_scl to log file output + +src/physics/cam/aer_rad_props.F90 +. nrh, ot_length now accessed from phys_prop + +src/physics/cam/aerosol_optics_cam.F90 +. ot_length now accessed from phys_prop + +src/physics/cam/phys_prop.F90 +. add the public parameter nrh to this module. Was previously in + radconstants. +. turn off old debug output to log file + +src/physics/cam/physpkg.F90 +. reorder initialization of solar_data and radiation modules to allow + reading the spectral band boundaries from the input data rather than + requiring them to be hardcoded. + +src/physics/cam/rad_constituents.F90 +. access ot_length from phys_prop rather than rad_constituents + +src/physics/cam_dev/physpkg.F90 +. reorder initialization of solar_data and radiation modules to allow + reading the wavenumber band boundaries from the input data rather than + requiring them to be hardcoded. + +src/physics/camrt/radconstants.F90 +. parameters ot_length and nrh moved to phys_props + +src/physics/rrtmg/radconstants.F90 +. parameters ot_length and nrh moved to phys_props + +src/physics/simple/radconstants.F90 +. parameters ot_length and nrh moved to phys_props +. add dummy interface for get_sw_spectral_boundaries + +src/physics/spcam/crm/CLUBB/crmx_mt95.f90 +. removed 3 non-ascii characters (in comments) + +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. + +cheyenne/intel/aux_cam: + +izumi/nag/aux_cam: + +izumi/gnu/aux_cam: + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: None. + New RRTMGP option changes answers only when enabled. + +=============================================================== +=============================================================== + Tag name: cam6_3_133 Originator(s): fvitt Date: 19 Oct 2023 diff --git a/src/physics/cam/phys_prop.F90 b/src/physics/cam/phys_prop.F90 index ecbf6f85e0..6c504e8c78 100644 --- a/src/physics/cam/phys_prop.F90 +++ b/src/physics/cam/phys_prop.F90 @@ -1111,9 +1111,7 @@ subroutine bulk_props_init(physprop, nc_id) type(var_desc_T) :: vid - ! ***N.B.*** RRTMGP hasn't set the value of idx_sw_diag when this routine is - ! called. The debug option will need to be modified for RRTMGP. - logical :: debug = .true. + logical :: debug = .false. character(len=*), parameter :: subname = 'bulk_props_init' !------------------------------------------------------------------------------------ diff --git a/src/physics/spcam/crm/CLUBB/crmx_mt95.f90 b/src/physics/spcam/crm/CLUBB/crmx_mt95.f90 index 14d75bc733..7c2ff7d9db 100644 --- a/src/physics/spcam/crm/CLUBB/crmx_mt95.f90 +++ b/src/physics/spcam/crm/CLUBB/crmx_mt95.f90 @@ -1,10 +1,10 @@ ! A C-program for MT19937, with initialization improved 2002/1/26. ! Coded by Takuji Nishimura and Makoto Matsumoto. -! Code converted to Fortran 95 by José Rui Faustino de Sousa +! Code converted to Fortran 95 by Jose Rui Faustino de Sousa ! Date: 2002-02-01 -! Enhanced version by José Rui Faustino de Sousa +! Enhanced version by Jose Rui Faustino de Sousa ! Date: 2003-04-30 ! Interface: @@ -1310,7 +1310,7 @@ subroutine genrand_res53_7d( r ) end subroutine genrand_res53_7d ! These real versions are due to Isaku Wada, 2002/01/09 added - ! Altered by José Sousa genrand_real[1-3] will not return exactely + ! Altered by Jose Sousa genrand_real[1-3] will not return exactely ! the same values but should have the same properties and are faster end module crmx_mt95 From f1cfe38deb758cd637c1d4702ca606b35a293ae4 Mon Sep 17 00:00:00 2001 From: Brian Eaton Date: Wed, 25 Oct 2023 13:33:01 -0400 Subject: [PATCH 183/291] fix tests --- cime_config/testdefs/testlist_cam.xml | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/cime_config/testdefs/testlist_cam.xml b/cime_config/testdefs/testlist_cam.xml index e56ca8d4a9..a51e1324d1 100644 --- a/cime_config/testdefs/testlist_cam.xml +++ b/cime_config/testdefs/testlist_cam.xml @@ -201,7 +201,7 @@ - + @@ -2704,9 +2704,8 @@ - + - From cf0e7b66249fc3e9b605676cea232e66f304cc13 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Mon, 30 Oct 2023 11:12:42 -0400 Subject: [PATCH 184/291] Update Externals_CAM.cfg to use hash as 14.1.2 matches branch as well --- Externals_CAM.cfg | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Externals_CAM.cfg b/Externals_CAM.cfg index 5be47f26cb..2228f18644 100644 --- a/Externals_CAM.cfg +++ b/Externals_CAM.cfg @@ -80,7 +80,7 @@ required = True local_path = src/chemistry/geoschem/geoschem_src protocol = git repo_url = https://github.com/geoschem/geos-chem.git -tag = 14.1.2 +hash = 28345ee7 required = True [hemco] From 95cd2a57782266451154f4dab74ec4111071570a Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Mon, 30 Oct 2023 13:43:03 -0400 Subject: [PATCH 185/291] Revert "Update Externals_CAM.cfg to use hash as 14.1.2 matches branch as well" This reverts commit cf0e7b66249fc3e9b605676cea232e66f304cc13. --- Externals_CAM.cfg | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Externals_CAM.cfg b/Externals_CAM.cfg index 2228f18644..5be47f26cb 100644 --- a/Externals_CAM.cfg +++ b/Externals_CAM.cfg @@ -80,7 +80,7 @@ required = True local_path = src/chemistry/geoschem/geoschem_src protocol = git repo_url = https://github.com/geoschem/geos-chem.git -hash = 28345ee7 +tag = 14.1.2 required = True [hemco] From 1b5c2811b48449d6e8ebfa65acde229d87cb30d7 Mon Sep 17 00:00:00 2001 From: Steve Goldhaber Date: Mon, 2 Oct 2023 21:32:27 +0200 Subject: [PATCH 186/291] Suggested changes to cam.case_setup.py --- cime_config/cam.case_setup.py | 93 +++++++++++++++++++++++++---------- 1 file changed, 67 insertions(+), 26 deletions(-) diff --git a/cime_config/cam.case_setup.py b/cime_config/cam.case_setup.py index 19bea2c567..be04d3e039 100755 --- a/cime_config/cam.case_setup.py +++ b/cime_config/cam.case_setup.py @@ -1,28 +1,69 @@ #! /usr/bin/env python3 -""" -Script run from CIME when calling case.setup -Expects 3 arguments: - (1) case root path - (2) cam root path - (3) cam configuration options -""" - -import sys, os, shutil - -case_root = sys.argv[1] -cam_root = sys.argv[2] -cam_options = sys.argv[3] - -# If using GEOS-Chem chemistry then copy GEOS-Chem configuration files from source code to case -if '-chem geoschem' in cam_options: - geoschem_src = os.path.join(cam_root,'src','chemistry','geoschem','geoschem_src') - if not os.path.isdir(geoschem_src): - raise SystemExit("ERROR: Did not find path to GEOS-Chem source code at {:s}".format(geoschem_src)) - for fname in ['species_database.yml', 'geoschem_config.yml', - 'HISTORY.rc', 'HEMCO_Config.rc', 'HEMCO_Diagn.rc']: - file1 = os.path.join(geoschem_src, 'run','CESM', fname) - if not os.path.exists(file1): - raise SystemExit("ERROR: GEOS-Chem configuration file does not exist: {}".format(file1)) - file2 = os.path.join(case_root, fname) - shutil.copy(file1,file2) +"""Copy GEOS-Chem configuration files from source to the case directory. +This script is run from CIME when calling case.setup""" + +import logging +import os +import shutil +import sys + +_CIMEROOT = os.environ.get("CIMEROOT") +if _CIMEROOT is None: + raise SystemExit("ERROR: must set CIMEROOT environment variable") +# end if +_LIBDIR = os.path.join(_CIMEROOT, "CIME", "Tools") +sys.path.append(_LIBDIR) +sys.path.insert(0, _CIMEROOT) + +#pylint: disable=wrong-import-position +from CIME.case import Case + +logger = logging.getLogger(__name__) + +if len(sys.argv) != 3: + raise SystemExit(f"Incorrect call to {sys.argv[0]}, need CAM root and case root") +# end if +cam_root = sys.argv[1] +case_root = sys.argv[2] + +with Case(case_root) as case: + cam_config = case.get_value('CAM_CONFIG_OPTS') + # Gather case information (from _build_usernl_files in case_setup.py) + comp_interface = case.get_value("COMP_INTERFACE") + + if comp_interface == "nuopc": + ninst = case.get_value("NINST") + elif ninst == 1: + ninst = case.get_value("NINST_CAM") + # end if +# end with + +# GEOS-Chem only: copy config files to case +if '-chem geoschem' in cam_config: + geoschem_config_src = os.path.join(cam_root, 'src', 'chemistry', + 'geoschem', 'geoschem_src', 'run', 'CESM') + if not os.path.isdir(geoschem_config_src): + raise SystemExit(f"ERROR: Did not find path to GEOS-Chem source code at {geoschem_config_src}") + # end if + for fileName in ['species_database.yml', 'geoschem_config.yml', 'HISTORY.rc', + 'HEMCO_Config.rc', 'HEMCO_Diagn.rc']: + source_file = os.path.join(cam_root, geoschem_config_src, fileName) + if not os.path.exists(source_file): + raise SystemExit(f"ERROR: Did not find source file, {fileName}") + # end if + spaths = source_file.splitext(source_file) + for inst_num in range(ninst): + if ninst > 1: + target_file = f"{spaths[0]}_{inst_num+1:04d}{spaths[1]}" + else: + target_file = os.path.join(case_root, fileName) + # end if + if not os.path.exists(target_file): + logger.info("CAM namelist one-time copy of GEOS-Chem run directory files: source_file %s target_file %s ", + source_file, target_file) + shutil.copy(source_file, target_file) + # end if + # end for + # end for +# end if From 0d4bf3fb07fbad54d31173f9da2650da9162138d Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Tue, 31 Oct 2023 09:46:05 -0600 Subject: [PATCH 187/291] Fix bug and change error messages in cam.case_setup.py Signed-off-by: Lizzie Lundgren --- cime_config/cam.case_setup.py | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/cime_config/cam.case_setup.py b/cime_config/cam.case_setup.py index be04d3e039..e8cb17c5a6 100755 --- a/cime_config/cam.case_setup.py +++ b/cime_config/cam.case_setup.py @@ -44,15 +44,15 @@ geoschem_config_src = os.path.join(cam_root, 'src', 'chemistry', 'geoschem', 'geoschem_src', 'run', 'CESM') if not os.path.isdir(geoschem_config_src): - raise SystemExit(f"ERROR: Did not find path to GEOS-Chem source code at {geoschem_config_src}") + raise SystemExit(f"ERROR: Did not find path to GEOS-Chem config files at {geoschem_config_src}") # end if for fileName in ['species_database.yml', 'geoschem_config.yml', 'HISTORY.rc', 'HEMCO_Config.rc', 'HEMCO_Diagn.rc']: source_file = os.path.join(cam_root, geoschem_config_src, fileName) if not os.path.exists(source_file): - raise SystemExit(f"ERROR: Did not find source file, {fileName}") + raise SystemExit(f"ERROR: Did not find source file, {source_file}") # end if - spaths = source_file.splitext(source_file) + spaths = os.path.splitext(source_file) for inst_num in range(ninst): if ninst > 1: target_file = f"{spaths[0]}_{inst_num+1:04d}{spaths[1]}" From 84e830df9a6490f8b83a4a5e933527b9fc71e63e Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Fri, 3 Nov 2023 09:14:27 -0600 Subject: [PATCH 188/291] Remove the FCSD_GC compset This compset for GEOS-Chem is not currently functional. We can bring back the option in the future if there is demand. Signed-off-by: Lizzie Lundgren --- bld/namelist_files/use_cases/sd_geoschem.xml | 209 ------------------- cime_config/config_component.xml | 2 - cime_config/config_compsets.xml | 6 - cime_config/testdefs/testlist_cam.xml | 8 - 4 files changed, 225 deletions(-) delete mode 100644 bld/namelist_files/use_cases/sd_geoschem.xml diff --git a/bld/namelist_files/use_cases/sd_geoschem.xml b/bld/namelist_files/use_cases/sd_geoschem.xml deleted file mode 100644 index a29c3f9ed6..0000000000 --- a/bld/namelist_files/use_cases/sd_geoschem.xml +++ /dev/null @@ -1,209 +0,0 @@ - - - - - - - - -/glade/p/univ/umit0034/ExtData/CHEM_INPUTS/ - -/glade/p/univ/umit0034/Shared/GEOS-Chem/f.e20.FCSD.f19_f19_mg17.cesm2.1-exp002.001.cam.i.2005-01-01-00000_c180801.nc -atm/cam/met/MERRA2/1.9x2.5/fv_1.9x2.5_nc3000_Nsw084_Nrs016_Co120_Fi001_ZR_GRNL_MERRA2_c190617.nc - -/glade/p/univ/umit0034/Shared/GEOS-Chem/f.e20.FCSD.f09_f09_mg17.cesm2.1-exp002.001.cam.i.2005-01-01-00000_c180801.nc -atm/cam/met/MERRA2/0.9x1.25/fv_0.9x1.25_nc3000_Nsw042_Nrs008_Co060_Fi001_ZR_sgh30_24km_GRNL_MERRA2_c171218.nc - -/glade/p/univ/umit0034/Shared/dep_data_file_geoschem_c230417.nc - -HEMCO_Config.rc -HEMCO_Diagn.rc - - - - -20150101 - -50. -.true. - - -2015/MERRA2_1.9x2.5_20150101.nc -atm/cam/met/MERRA2/1.9x2.5 -atm/cam/met/MERRA2/1.9x2.5/filenames_list_c20210302 - -2015/MERRA2_0.9x1.25_20150101.nc -atm/cam/met/MERRA2/0.9x1.25 -atm/cam/met/MERRA2/0.9x1.25/filenames_1975-2017_c190125.txt - -2010/MERRA2_0.5x0.63_20100101.nc -atm/cam/met/MERRA2/0.5x0.63 -atm/cam/met/MERRA2/0.5x0.63/filenames_list_c180612 - - -atm/cam/solar/SolarForcingNRLSSI2_daily_s18820101_e20171231_c191122.nc -SERIAL - - -.true. -.true. -.false. -0.25D0 - - -SERIAL -atm/waccm/lb/LBC_1750-2014_CMIP6_0p5degLat_c170126.nc - - - - - - - -'ACET','ACTA','ALD2','AROMP4','AROMP5','ATOOH','BALD','BENZP','BR2','BRCL','BRNO3','BZCO3H','BZPAN','CH2O','CL2','CLNO2','CLNO3','CLO','CLOO','CSL','EOH','ETHLN','ETHN','ETHP','ETNO3','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HI','HMHP','HMML','HNO3','HOBR','HOCL','HOI','HONIT','HPALD1','HPALD2','HPALD3','HPALD4','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDC','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','IPRNO3','ITCN','ITHN','LIMO','LVOC','MACR','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MCT','MENO3','MGLY','MOH','MONITS','MONITU','MPAN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','N2O5','NH3','NO2','NPHEN','NPRNO3','O3','PAN','PHEN','PP','PPN','PROPNN','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2','AERI','AONITA','ASOA1','ASOA2','ASOA3','ASOAN','ASOG1','ASOG2','ASOG3','BRSALA','BRSALC','INDIOL','IONITA','ISALA','ISALC','MONITA','MSA','NH4','NIT','NITS','SALAAL','SALACL','SALCAL','SALCCL','SO4S','SOAGX','SOAIE','TSOA0','TSOA1','TSOA2','TSOA3','TSOG0','TSOG1','TSOG2','TSOG3','PFE' - - - - -'ACTA','ALD2','AROMP4','AROMP5','ATOOH','BALD','BENZP','BR2','BRCL','BZCO3H','BZPAN','CH2O','CSL','EOH','ETHLN','ETHN','ETHP','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HI','HMHP','HMML','HNO3','HOBR','HOCL','HOI','HONIT','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','ITCN','ITHN','LIMO','LVOC','LVOCOA','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MCT','MEK','MGLY','MOH','MONITS','MONITU','MP','MPAN','MPN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','NH3','NPHEN','PAN','PHEN','PP','PPN','PROPNN','PRPE','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2','AERI','AONITA','ASOA1','ASOA2','ASOA3','ASOAN','ASOG1','ASOG2','ASOG3','BRSALA','BRSALC','INDIOL','IONITA','ISALA','ISALC','MONITA','MSA','NH4','NIT','NITS','SALAAL','SALACL','SALCAL','SALCCL','SO4S','SOAGX','SOAIE','TSOA0','TSOA1','TSOA2','TSOA3','TSOG0','TSOG1','TSOG2','TSOG3','PFE' - - - -'dst_a1','so4_a1','nh4_a1','pom_a1','pomff1_a1','pombb1_a1','soa_a1','bc_a1','ncl_a1','num_a1','so4_a2','nh4_a2','soa_a2','ncl_a2','dst_a2','num_a2','dst_a3','ncl_a3','so4_a3','pom_a3','bc_a3','num_a3','ncl_a4','so4_a4','pom_a4','pomff1_a4','pombb1_a4','bc_a4','nh4_a4','num_a4','dst_a5','so4_a5','nh4_a5','num_a5','ncl_a6','so4_a6','nh4_a6','num_a6','dst_a7','so4_a7','nh4_a7','num_a7','soa1_a1','soa1_a2','soa2_a1','soa2_a2','soa3_a1','soa3_a2','soa4_a1','soa4_a2','soa5_a1','soa5_a2','soaff1_a1','soaff2_a1','soaff3_a1','soaff4_a1','soaff5_a1','soabb1_a1','soabb2_a1','soabb3_a1','soabb4_a1','soabb5_a1','soabg1_a1','soabg2_a1','soabg3_a1','soabg4_a1','soabg5_a1','soaff1_a2','soaff2_a2','soaff3_a2','soaff4_a2','soaff5_a2','soabb1_a2','soabb2_a2','soabb3_a2','soabb4_a2','soabb5_a2','soabg1_a2','soabg2_a2','soabg3_a2','soabg4_a2','soabg5_a2' - - - -'dst_a1','so4_a1','nh4_a1','pom_a1','pomff1_a1','pombb1_a1','soa_a1','bc_a1','ncl_a1','num_a1','so4_a2','nh4_a2','soa_a2','ncl_a2','dst_a2','num_a2','dst_a3','ncl_a3','so4_a3','pom_a3','bc_a3','num_a3','ncl_a4','so4_a4','pom_a4','pomff1_a4','pombb1_a4','bc_a4','nh4_a4','num_a4','dst_a5','so4_a5','nh4_a5','num_a5','ncl_a6','so4_a6','nh4_a6','num_a6','dst_a7','so4_a7','nh4_a7','num_a7','soa1_a1','soa1_a2','soa2_a1','soa2_a2','soa3_a1','soa3_a2','soa4_a1','soa4_a2','soa5_a1','soa5_a2','soaff1_a1','soaff2_a1','soaff3_a1','soaff4_a1','soaff5_a1','soabb1_a1','soabb2_a1','soabb3_a1','soabb4_a1','soabb5_a1','soabg1_a1','soabg2_a1','soabg3_a1','soabg4_a1','soabg5_a1','soaff1_a2','soaff2_a2','soaff3_a2','soaff4_a2','soaff5_a2','soabb1_a2','soabb2_a2','soabb3_a2','soabb4_a2','soabb5_a2','soabg1_a2','soabg2_a2','soabg3_a2','soabg4_a2','soabg5_a2' - - - - - 1,30,365,240,240,480,365,73,30 - 0,-24,-24,-3,-1,1,-24,-120,-240 -'A','A','A','A','A','A','A','A','I' - -.true. -.false. -.false. -.false. -.false. -.false. -.false. -.false. -.false. - - -'AREA', -'HEIGHT', -'T', -'U', -'V', -'Q', -'PS', -'CLOUD', -'TROPP_P', -'TROPP_T', -'TROPP_Z', -'DF_CO', -'DF_O3', -'DF_NO2', -'DF_SO4', -'DF_NIT', -'CT_O3', -'CT_OH', -'OHwgtByAirMassColumnFull', -'Chem_SO3AQ', -'Jval_Cl2O2', -'Jval_H2O2', -'Jval_NO2', -'Jval_PAN', -'JvalO3O3P', -'JvalO3O1D', -'LNO_COL_PROD', -'Prod_Ox', -'Prod_SO4', -'Prod_CO', -'Prod_H2O2', -'ProdCOfromCH4', -'ProdCOfromNMVOC', -'Loss_Ox', -'Loss_CH4', -'Loss_CO', -'LossOHbyCH4columnTrop', -'LossOHbyMCFcolumnTrop', -'LossHNO3onSeaSalt', -'ACET', -'ALD2', -'ALK4', -'BR', -'BRCL', -'BRNO3', -'BRO', -'BROX', -'BROY', -'C3H8', -'CH2O', -'CH3CL', -'CH4', -'CL', -'CLNO3', -'CLO', -'CLOX', -'CLOY', -'CO', -'DMS', -'EOH', -'H2O', -'H2O2', -'H2SO4', -'HO2', -'HOX', -'HBR', -'HCL', -'HOBR', -'HOCL', -'HNO3', -'HNO4', -'ISOP', -'MACR', -'MAP', -'MEK', -'MOH', -'MVK', -'N2O', -'N2O5', -'NHX', -'NIT', -'NO', -'NO2', -'NO3', -'NOX', -'NOY', -'O3', -'OH', -'PAN', -'PM25', -'RCHO', -'SALA', -'SALC', -'SO2', -'SO4', -'SOX', -'TOLU', -'bc_a1', -'bc_a4', -'dst_a1', -'dst_a2', -'dst_a3', -'num_a1', -'num_a2', -'num_a3', -'num_a4', -'pom_a1', -'pom_a4', -'so4_a1', -'so4_a2', -'so4_a3', - - - diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index ab760aeede..9f8e3a5698 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -175,7 +175,6 @@ -offline_dyn -nlev 56 -nlev 56 - -nlev 56 -nlev 88 -nlev 145 -nlev 58 -model_top lt @@ -299,7 +298,6 @@ sd_waccm_ma_cam4 sd_trop_strat_vbs_cam6 sd_trop_strat2_cam6 - sd_geoschem sd_cam6 dabi_p2004 diff --git a/cime_config/config_compsets.xml b/cime_config/config_compsets.xml index f64c1dd507..2408be5b95 100644 --- a/cime_config/config_compsets.xml +++ b/cime_config/config_compsets.xml @@ -570,11 +570,6 @@ HIST_CAM60%GEOSCHEM%HEMCO_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV - - FCSD_GC - HIST_CAM60%GEOSCHEM%HEMCO%SDYN_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV - - FCnudged_GC HIST_CAM60%GEOSCHEM%HEMCO%NUDG_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV @@ -599,7 +594,6 @@ 1995-01-01 2005-01-01 2005-01-01 - 2015-01-01 2010-01-01 1980-01-01 2000-01-01 diff --git a/cime_config/testdefs/testlist_cam.xml b/cime_config/testdefs/testlist_cam.xml index 60035ac588..90a3f6ee17 100644 --- a/cime_config/testdefs/testlist_cam.xml +++ b/cime_config/testdefs/testlist_cam.xml @@ -1635,14 +1635,6 @@ - - - - - - - - From 15bbeef4b0556509d1db473b80e235f02e6cb11b Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Fri, 3 Nov 2023 09:19:12 -0600 Subject: [PATCH 189/291] Remove NTHRDS overrides for GEOS-Chem NTHRDS is 1 by default when using GEOS-Chem compsets so these overrides are not necessary. We find that manually changing NTHRDS to something other than 1 breaks the model, but this is the case with non-GEOS-Chem compsets as well. Unless this becomes a problem the overrides are not needed at this time. Signed-off-by: Lizzie Lundgren --- cime_config/config_compsets.xml | 10 ---------- cime_config/config_pes.xml | 12 ------------ 2 files changed, 22 deletions(-) diff --git a/cime_config/config_compsets.xml b/cime_config/config_compsets.xml index 2408be5b95..d2aec47d2e 100644 --- a/cime_config/config_compsets.xml +++ b/cime_config/config_compsets.xml @@ -637,7 +637,6 @@ 1 1 - 1 @@ -645,7 +644,6 @@ 1 1 - 1 @@ -653,7 +651,6 @@ 1 1 - 1 @@ -661,7 +658,6 @@ 1 1 - 1 @@ -669,7 +665,6 @@ 1 1 - 1 @@ -677,7 +672,6 @@ 1 1 - 1 @@ -685,7 +679,6 @@ 1 1 - 1 @@ -693,7 +686,6 @@ 1 1 - 1 @@ -701,7 +693,6 @@ 1 1 - 1 @@ -709,7 +700,6 @@ 1 1 - 1 diff --git a/cime_config/config_pes.xml b/cime_config/config_pes.xml index fd0d3694ad..42fe06d64a 100644 --- a/cime_config/config_pes.xml +++ b/cime_config/config_pes.xml @@ -1769,18 +1769,6 @@ 1 - - - 1 - 1 - 1 - 1 - 1 - 1 - 1 - 1 - - From 392e9e33494b472b4367152d6b4a96c1fc22d37d Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Wed, 8 Nov 2023 13:25:31 -0700 Subject: [PATCH 190/291] Remove redundant includes of src/hemco in .gitignore Signed-off-by: Lizzie Lundgren --- .gitignore | 1 - 1 file changed, 1 deletion(-) diff --git a/.gitignore b/.gitignore index b2434334bb..0c9f941a97 100644 --- a/.gitignore +++ b/.gitignore @@ -10,7 +10,6 @@ src/physics/clubb src/physics/cosp2/src src/physics/silhs src/chemistry/geoschem/geoschem_src -src/hemco src/physics/pumas src/physics/pumas-frozen src/dynamics/fv3/atmos_cubed_sphere From 12d89ea1e334b8f7ef9920a1846bef2198c48a52 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Tue, 14 Nov 2023 21:13:57 -0500 Subject: [PATCH 191/291] Exit with warning in build-namelist if hemco_config_file or hemco_diagn_file are specified in user namelist. Current behavior in build-namelist enforces use of config files in case directory which are copied to run directory at submit time. User customization to user_nl_cam for the path of HEMCO config files will not take effect when running with GEOS-Chem chemistry, instead the user should edit or symlink from the files in the case directory similar to standalone GEOS-Chem operation. This commit adds a check in build-namelist for this customization and aborts with error to warn user that this is unsupported. Signed-off-by: Haipeng Lin --- bld/build-namelist | 23 ++++++++++++++++++++--- 1 file changed, 20 insertions(+), 3 deletions(-) diff --git a/bld/build-namelist b/bld/build-namelist index 3f92d38125..2dda74cf0b 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -2960,10 +2960,27 @@ if ($nl->get_value('use_hemco') =~ m/$TRUE/io) { $nl->delete_variable('chem_inparm', 'ext_frc_specifier'); $nl->delete_variable('chem_inparm', 'srf_emis_specifier'); - # If using GEOS-Chem reset paths of HEMCO configuration files to local filename only if ($chem =~ /geoschem/) { - $nl->set_variable_value('hemco_nl', 'hemco_config_file', "'HEMCO_Config.rc'"); - $nl->set_variable_value('hemco_nl', 'hemco_diagn_file', "'HEMCO_Diagn.rc'"); + + # For now, HEMCO config and diagnostic configuration files are always used from + # the case directory. Exit if user has specified other paths in the user namelist + # because it will not work. + if ($nl->get_value('hemco_config_file') ne "'" . $inputdata_rootdir . "/HEMCO_Config.rc'") { + die "CAM Namelist ERROR: When running with GEOS-Chem chemistry, hemco_config_file\n". + "must not be manually set in the namelist. Instead, modify (or symlink from) the HEMCO_Config.rc\n". + "in the case directory, which will be copied to the run directory when submitting,\n". + "Then remove the hemco_config_file option from the user namelist.\n"; + } + + if ($nl->get_value('hemco_diagn_file') ne "'" . $inputdata_rootdir . "/HEMCO_Diagn.rc'") { + die "CAM Namelist ERROR: When running with GEOS-Chem chemistry, hemco_diagn_file\n". + "must not be manually set in the namelist. Instead, modify (or symlink from) the HEMCO_Diagn.rc\n". + "in the case directory, which will be copied to the run directory when submitting.\n". + "Then remove the hemco_diagn_file option from the user namelist.\n"; + } + + $nl->set_variable_value('hemco_nl', 'hemco_config_file', "'HEMCO_Config.rc'"); + $nl->set_variable_value('hemco_nl', 'hemco_diagn_file', "'HEMCO_Diagn.rc'"); } } From 5c048af25496932af3fd43cbfd94cfa63b20611b Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Wed, 15 Nov 2023 15:08:47 -0500 Subject: [PATCH 192/291] Fix typo; indent with spaces --- bld/build-namelist | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/bld/build-namelist b/bld/build-namelist index 2dda74cf0b..5f70e2b523 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -2968,7 +2968,7 @@ if ($nl->get_value('use_hemco') =~ m/$TRUE/io) { if ($nl->get_value('hemco_config_file') ne "'" . $inputdata_rootdir . "/HEMCO_Config.rc'") { die "CAM Namelist ERROR: When running with GEOS-Chem chemistry, hemco_config_file\n". "must not be manually set in the namelist. Instead, modify (or symlink from) the HEMCO_Config.rc\n". - "in the case directory, which will be copied to the run directory when submitting,\n". + "in the case directory, which will be copied to the run directory when submitting.\n". "Then remove the hemco_config_file option from the user namelist.\n"; } @@ -2980,7 +2980,7 @@ if ($nl->get_value('use_hemco') =~ m/$TRUE/io) { } $nl->set_variable_value('hemco_nl', 'hemco_config_file', "'HEMCO_Config.rc'"); - $nl->set_variable_value('hemco_nl', 'hemco_diagn_file', "'HEMCO_Diagn.rc'"); + $nl->set_variable_value('hemco_nl', 'hemco_diagn_file', "'HEMCO_Diagn.rc'"); } } From cc85a5be56669162cecee534ab966625fb2604f8 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Thu, 16 Nov 2023 13:08:09 -0700 Subject: [PATCH 193/291] Split master deposition lists into two: mozart and geoschem Deposition lists are no longer stored in GEOS-Chem use case files. Set_dep_lists now takes chem as an argument and picks the appropriate master deposition list file to use, either Mozart or GEOS-Chem. Signed-off-by: Lizzie Lundgren --- bld/build-namelist | 2 +- .../geoschem_master_aer_drydep_list.xml | 91 ++++++++++ .../geoschem_master_aer_wetdep_list.xml | 89 +++++++++ .../geoschem_master_gas_drydep_list.xml | 170 ++++++++++++++++++ .../geoschem_master_gas_wetdep_list.xml | 152 ++++++++++++++++ ....xml => mozart_master_aer_drydep_list.xml} | 0 ....xml => mozart_master_aer_wetdep_list.xml} | 0 ....xml => mozart_master_gas_drydep_list.xml} | 0 ....xml => mozart_master_gas_wetdep_list.xml} | 0 .../use_cases/2000_geoschem.xml | 20 --- .../use_cases/2010_geoschem.xml | 20 --- .../use_cases/hist_geoschem.xml | 20 --- .../use_cases/hist_geoschem_nudged.xml | 22 --- bld/perl5lib/Build/ChemNamelist.pm | 110 ++++-------- 14 files changed, 541 insertions(+), 155 deletions(-) create mode 100644 bld/namelist_files/geoschem_master_aer_drydep_list.xml create mode 100644 bld/namelist_files/geoschem_master_aer_wetdep_list.xml create mode 100644 bld/namelist_files/geoschem_master_gas_drydep_list.xml create mode 100644 bld/namelist_files/geoschem_master_gas_wetdep_list.xml rename bld/namelist_files/{master_aer_drydep_list.xml => mozart_master_aer_drydep_list.xml} (100%) rename bld/namelist_files/{master_aer_wetdep_list.xml => mozart_master_aer_wetdep_list.xml} (100%) rename bld/namelist_files/{master_gas_drydep_list.xml => mozart_master_gas_drydep_list.xml} (100%) rename bld/namelist_files/{master_gas_wetdep_list.xml => mozart_master_gas_wetdep_list.xml} (100%) diff --git a/bld/build-namelist b/bld/build-namelist index 5f70e2b523..7cf81732ec 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -576,7 +576,7 @@ if ( ($chem ne 'none') or ( $prog_species ) ){ my ( $gas_wetdep_list, $aer_wetdep_list, $aer_sol_facti, $aer_sol_factb, $aer_scav_coef, $aer_drydep_list, $gas_drydep_list ) = - set_dep_lists( $cfgdir, $chem_proc_src, $chem_src_dir, $nl, $print ); + set_dep_lists( $chem, $cfgdir, $chem_proc_src, $chem_src_dir, $nl, $print ); if (length($gas_wetdep_list)>2){ add_default($nl, 'gas_wetdep_method' ); diff --git a/bld/namelist_files/geoschem_master_aer_drydep_list.xml b/bld/namelist_files/geoschem_master_aer_drydep_list.xml new file mode 100644 index 0000000000..a31d3ff31c --- /dev/null +++ b/bld/namelist_files/geoschem_master_aer_drydep_list.xml @@ -0,0 +1,91 @@ + + + + + + + dst_a1 + so4_a1 + nh4_a1 + pom_a1 + pomff1_a1 + pombb1_a1 + soa_a1 + bc_a1 + ncl_a1 + num_a1 + so4_a2 + nh4_a2 + soa_a2 + ncl_a2 + dst_a2 + num_a2 + dst_a3 + ncl_a3 + so4_a3 + pom_a3 + bc_a3 + num_a3 + ncl_a4 + so4_a4 + pom_a4 + pomff1_a4 + pombb1_a4 + bc_a4 + nh4_a4 + num_a4 + dst_a5 + so4_a5 + nh4_a5 + num_a5 + ncl_a6 + so4_a6 + nh4_a6 + num_a6 + dst_a7 + so4_a7 + nh4_a7 + num_a7 + soa1_a1 + soa1_a2 + soa2_a1 + soa2_a2 + soa3_a1 + soa3_a2 + soa4_a1 + soa4_a2 + soa5_a1 + soa5_a2 + soaff1_a1 + soaff2_a1 + soaff3_a1 + soaff4_a1 + soaff5_a1 + soabb1_a1 + soabb2_a1 + soabb3_a1 + soabb4_a1 + soabb5_a1 + soabg1_a1 + soabg2_a1 + soabg3_a1 + soabg4_a1 + soabg5_a1 + soaff1_a2 + soaff2_a2 + soaff3_a2 + soaff4_a2 + soaff5_a2 + soabb1_a2 + soabb2_a2 + soabb3_a2 + soabb4_a2 + soabb5_a2 + soabg1_a2 + soabg2_a2 + soabg3_a2 + soabg4_a2 + soabg5_a2 + + + diff --git a/bld/namelist_files/geoschem_master_aer_wetdep_list.xml b/bld/namelist_files/geoschem_master_aer_wetdep_list.xml new file mode 100644 index 0000000000..16391485fe --- /dev/null +++ b/bld/namelist_files/geoschem_master_aer_wetdep_list.xml @@ -0,0 +1,89 @@ + + + + + dst_a1 + so4_a1 + nh4_a1 + pom_a1 + pomff1_a1 + pombb1_a1 + soa_a1 + bc_a1 + ncl_a1 + num_a1 + so4_a2 + nh4_a2 + soa_a2 + ncl_a2 + dst_a2 + num_a2 + dst_a3 + ncl_a3 + so4_a3 + pom_a3 + bc_a3 + num_a3 + ncl_a4 + so4_a4 + pom_a4 + pomff1_a4 + pombb1_a4 + bc_a4 + nh4_a4 + num_a4 + dst_a5 + so4_a5 + nh4_a5 + num_a5 + ncl_a6 + so4_a6 + nh4_a6 + num_a6 + dst_a7 + so4_a7 + nh4_a7 + num_a7 + soa1_a1 + soa1_a2 + soa2_a1 + soa2_a2 + soa3_a1 + soa3_a2 + soa4_a1 + soa4_a2 + soa5_a1 + soa5_a2 + soaff1_a1 + soaff2_a1 + soaff3_a1 + soaff4_a1 + soaff5_a1 + soabb1_a1 + soabb2_a1 + soabb3_a1 + soabb4_a1 + soabb5_a1 + soabg1_a1 + soabg2_a1 + soabg3_a1 + soabg4_a1 + soabg5_a1 + soaff1_a2 + soaff2_a2 + soaff3_a2 + soaff4_a2 + soaff5_a2 + soabb1_a2 + soabb2_a2 + soabb3_a2 + soabb4_a2 + soabb5_a2 + soabg1_a2 + soabg2_a2 + soabg3_a2 + soabg4_a2 + soabg5_a2 + + + diff --git a/bld/namelist_files/geoschem_master_gas_drydep_list.xml b/bld/namelist_files/geoschem_master_gas_drydep_list.xml new file mode 100644 index 0000000000..eebafa33a7 --- /dev/null +++ b/bld/namelist_files/geoschem_master_gas_drydep_list.xml @@ -0,0 +1,170 @@ + + + + + + + ACET + ACTA + ALD2 + AROMP4 + AROMP5 + ATOOH + BALD + BENZP + BR2 + BRCL + BRNO3 + BZCO3H + BZPAN + CH2O + CL2 + CLNO2 + CLNO3 + CLO + CLOO + CSL + EOH + ETHLN + ETHN + ETHP + ETNO3 + ETP + GLYC + GLYX + H2O2 + HAC + HBR + HC5A + HCL + HCOOH + HI + HMHP + HMML + HNO3 + HOBR + HOCL + HOI + HONIT + HPALD1 + HPALD2 + HPALD3 + HPALD4 + HPETHNL + I2 + I2O2 + I2O3 + I2O4 + IBR + ICHE + ICL + ICN + ICPDH + IDC + IDCHP + IDHDP + IDHPE + IDN + IEPOXA + IEPOXB + IEPOXD + IHN1 + IHN2 + IHN3 + IHN4 + INPB + INPD + IONO + IONO2 + IPRNO3 + ITCN + ITHN + LIMO + LVOC + LVOCOA + MACR + MACR1OOH + MAP + MCRDH + MCRENOL + MCRHN + MCRHNB + MCRHP + MCT + MENO3 + MGLY + MOH + MONITS + MONITU + MPAN + MTPA + MTPO + MVK + MVKDH + MVKHC + MVKHCB + MVKHP + MVKN + MVKPC + N2O5 + NH3 + NO2 + NPHEN + NPRNO3 + O3 + PAN + PHEN + PP + PPN + PROPNN + PRPN + PYAC + R4N2 + R4P + RA3P + RB3P + RIPA + RIPB + RIPC + RIPD + RP + SO2 + AERI + AONITA + ASOA1 + ASOA2 + ASOA3 + ASOAN + ASOG1 + ASOG2 + ASOG3 + BRSALA + BRSALC + INDIOL + IONITA + ISALA + ISALC + MONITA + MSA + NH4 + NIT + NITS + SALAAL + SALACL + SALCAL + SALCCL + SO4S + SOAGX + SOAIE + TSOA0 + TSOA1 + TSOA2 + TSOA3 + TSOG0 + TSOG1 + TSOG2 + TSOG3 + PFE + + + diff --git a/bld/namelist_files/geoschem_master_gas_wetdep_list.xml b/bld/namelist_files/geoschem_master_gas_wetdep_list.xml new file mode 100644 index 0000000000..419f518c32 --- /dev/null +++ b/bld/namelist_files/geoschem_master_gas_wetdep_list.xml @@ -0,0 +1,152 @@ + + + + + ACTA + ALD2 + AROMP4 + AROMP5 + ATOOH + BALD + BENZP + BR2 + BRCL + BZCO3H + BZPAN + CH2O + CSL + EOH + ETHLN + ETHN + ETHP + ETP + GLYC + GLYX + H2O2 + HAC + HBR + HC5A + HCL + HCOOH + HI + HMHP + HMML + HNO3 + HOBR + HOCL + HOI + HONIT + HPETHNL + I2 + I2O2 + I2O3 + I2O4 + IBR + ICHE + ICL + ICN + ICPDH + IDCHP + IDHDP + IDHPE + IDN + IEPOXA + IEPOXB + IEPOXD + IHN1 + IHN2 + IHN3 + IHN4 + INPB + INPD + IONO + IONO2 + ITCN + ITHN + LIMO + LVOC + LVOCOA + MACR1OOH + MAP + MCRDH + MCRENOL + MCRHN + MCRHNB + MCRHP + MCT + MEK + MGLY + MOH + MONITS + MONITU + MP + MPAN + MPN + MTPA + MTPO + MVK + MVKDH + MVKHC + MVKHCB + MVKHP + MVKN + MVKPC + NH3 + NPHEN + PAN + PHEN + PP + PPN + PROPNN + PRPE + PRPN + PYAC + R4N2 + R4P + RA3P + RB3P + RIPA + RIPB + RIPC + RIPD + RP + SO2 + AERI + AONITA + ASOA1 + ASOA2 + ASOA3 + ASOAN + ASOG1 + ASOG2 + ASOG3 + BRSALA + BRSALC + INDIOL + IONITA + ISALA + ISALC + MONITA + MSA + NH4 + NIT + NITS + SALAAL + SALACL + SALCAL + SALCCL + SO4S + SOAGX + SOAIE + TSOA0 + TSOA1 + TSOA2 + TSOA3 + TSOG0 + TSOG1 + TSOG2 + TSOG3 + PFE + + + diff --git a/bld/namelist_files/master_aer_drydep_list.xml b/bld/namelist_files/mozart_master_aer_drydep_list.xml similarity index 100% rename from bld/namelist_files/master_aer_drydep_list.xml rename to bld/namelist_files/mozart_master_aer_drydep_list.xml diff --git a/bld/namelist_files/master_aer_wetdep_list.xml b/bld/namelist_files/mozart_master_aer_wetdep_list.xml similarity index 100% rename from bld/namelist_files/master_aer_wetdep_list.xml rename to bld/namelist_files/mozart_master_aer_wetdep_list.xml diff --git a/bld/namelist_files/master_gas_drydep_list.xml b/bld/namelist_files/mozart_master_gas_drydep_list.xml similarity index 100% rename from bld/namelist_files/master_gas_drydep_list.xml rename to bld/namelist_files/mozart_master_gas_drydep_list.xml diff --git a/bld/namelist_files/master_gas_wetdep_list.xml b/bld/namelist_files/mozart_master_gas_wetdep_list.xml similarity index 100% rename from bld/namelist_files/master_gas_wetdep_list.xml rename to bld/namelist_files/mozart_master_gas_wetdep_list.xml diff --git a/bld/namelist_files/use_cases/2000_geoschem.xml b/bld/namelist_files/use_cases/2000_geoschem.xml index 11a3b20b03..f82bcaa4b5 100644 --- a/bld/namelist_files/use_cases/2000_geoschem.xml +++ b/bld/namelist_files/use_cases/2000_geoschem.xml @@ -43,26 +43,6 @@ - - - -'ACET','ACTA','ALD2','AROMP4','AROMP5','ATOOH','BALD','BENZP','BR2','BRCL','BRNO3','BZCO3H','BZPAN','CH2O','CL2','CLNO2','CLNO3','CLO','CLOO','CSL','EOH','ETHLN','ETHN','ETHP','ETNO3','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HI','HMHP','HMML','HNO3','HOBR','HOCL','HOI','HONIT','HPALD1','HPALD2','HPALD3','HPALD4','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDC','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','IPRNO3','ITCN','ITHN','LIMO','LVOC','MACR','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MCT','MENO3','MGLY','MOH','MONITS','MONITU','MPAN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','N2O5','NH3','NO2','NPHEN','NPRNO3','O3','PAN','PHEN','PP','PPN','PROPNN','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2','AERI','AONITA','ASOA1','ASOA2','ASOA3','ASOAN','ASOG1','ASOG2','ASOG3','BRSALA','BRSALC','INDIOL','IONITA','ISALA','ISALC','MONITA','MSA','NH4','NIT','NITS','SALAAL','SALACL','SALCAL','SALCCL','SO4S','SOAGX','SOAIE','TSOA0','TSOA1','TSOA2','TSOA3','TSOG0','TSOG1','TSOG2','TSOG3','PFE' - - - - -'ACTA','ALD2','AROMP4','AROMP5','ATOOH','BALD','BENZP','BR2','BRCL','BZCO3H','BZPAN','CH2O','CSL','EOH','ETHLN','ETHN','ETHP','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HI','HMHP','HMML','HNO3','HOBR','HOCL','HOI','HONIT','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','ITCN','ITHN','LIMO','LVOC','LVOCOA','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MCT','MEK','MGLY','MOH','MONITS','MONITU','MP','MPAN','MPN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','NH3','NPHEN','PAN','PHEN','PP','PPN','PROPNN','PRPE','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2','AERI','AONITA','ASOA1','ASOA2','ASOA3','ASOAN','ASOG1','ASOG2','ASOG3','BRSALA','BRSALC','INDIOL','IONITA','ISALA','ISALC','MONITA','MSA','NH4','NIT','NITS','SALAAL','SALACL','SALCAL','SALCCL','SO4S','SOAGX','SOAIE','TSOA0','TSOA1','TSOA2','TSOA3','TSOG0','TSOG1','TSOG2','TSOG3','PFE' - - - -'dst_a1','so4_a1','nh4_a1','pom_a1','pomff1_a1','pombb1_a1','soa_a1','bc_a1','ncl_a1','num_a1','so4_a2','nh4_a2','soa_a2','ncl_a2','dst_a2','num_a2','dst_a3','ncl_a3','so4_a3','pom_a3','bc_a3','num_a3','ncl_a4','so4_a4','pom_a4','pomff1_a4','pombb1_a4','bc_a4','nh4_a4','num_a4','dst_a5','so4_a5','nh4_a5','num_a5','ncl_a6','so4_a6','nh4_a6','num_a6','dst_a7','so4_a7','nh4_a7','num_a7','soa1_a1','soa1_a2','soa2_a1','soa2_a2','soa3_a1','soa3_a2','soa4_a1','soa4_a2','soa5_a1','soa5_a2','soaff1_a1','soaff2_a1','soaff3_a1','soaff4_a1','soaff5_a1','soabb1_a1','soabb2_a1','soabb3_a1','soabb4_a1','soabb5_a1','soabg1_a1','soabg2_a1','soabg3_a1','soabg4_a1','soabg5_a1','soaff1_a2','soaff2_a2','soaff3_a2','soaff4_a2','soaff5_a2','soabb1_a2','soabb2_a2','soabb3_a2','soabb4_a2','soabb5_a2','soabg1_a2','soabg2_a2','soabg3_a2','soabg4_a2','soabg5_a2' - - - -'dst_a1','so4_a1','nh4_a1','pom_a1','pomff1_a1','pombb1_a1','soa_a1','bc_a1','ncl_a1','num_a1','so4_a2','nh4_a2','soa_a2','ncl_a2','dst_a2','num_a2','dst_a3','ncl_a3','so4_a3','pom_a3','bc_a3','num_a3','ncl_a4','so4_a4','pom_a4','pomff1_a4','pombb1_a4','bc_a4','nh4_a4','num_a4','dst_a5','so4_a5','nh4_a5','num_a5','ncl_a6','so4_a6','nh4_a6','num_a6','dst_a7','so4_a7','nh4_a7','num_a7','soa1_a1','soa1_a2','soa2_a1','soa2_a2','soa3_a1','soa3_a2','soa4_a1','soa4_a2','soa5_a1','soa5_a2','soaff1_a1','soaff2_a1','soaff3_a1','soaff4_a1','soaff5_a1','soabb1_a1','soabb2_a1','soabb3_a1','soabb4_a1','soabb5_a1','soabg1_a1','soabg2_a1','soabg3_a1','soabg4_a1','soabg5_a1','soaff1_a2','soaff2_a2','soaff3_a2','soaff4_a2','soaff5_a2','soabb1_a2','soabb2_a2','soabb3_a2','soabb4_a2','soabb5_a2','soabg1_a2','soabg2_a2','soabg3_a2','soabg4_a2','soabg5_a2' - - - 1,30,365,240,240,480,365,73,30 diff --git a/bld/namelist_files/use_cases/2010_geoschem.xml b/bld/namelist_files/use_cases/2010_geoschem.xml index 04bd57b1ba..b8ef551202 100644 --- a/bld/namelist_files/use_cases/2010_geoschem.xml +++ b/bld/namelist_files/use_cases/2010_geoschem.xml @@ -40,26 +40,6 @@ - - - -'ACET','ACTA','ALD2','AROMP4','AROMP5','ATOOH','BALD','BENZP','BR2','BRCL','BRNO3','BZCO3H','BZPAN','CH2O','CL2','CLNO2','CLNO3','CLO','CLOO','CSL','EOH','ETHLN','ETHN','ETHP','ETNO3','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HI','HMHP','HMML','HNO3','HOBR','HOCL','HOI','HONIT','HPALD1','HPALD2','HPALD3','HPALD4','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDC','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','IPRNO3','ITCN','ITHN','LIMO','LVOC','MACR','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MCT','MENO3','MGLY','MOH','MONITS','MONITU','MPAN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','N2O5','NH3','NO2','NPHEN','NPRNO3','O3','PAN','PHEN','PP','PPN','PROPNN','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2','AERI','AONITA','ASOA1','ASOA2','ASOA3','ASOAN','ASOG1','ASOG2','ASOG3','BRSALA','BRSALC','INDIOL','IONITA','ISALA','ISALC','MONITA','MSA','NH4','NIT','NITS','SALAAL','SALACL','SALCAL','SALCCL','SO4S','SOAGX','SOAIE','TSOA0','TSOA1','TSOA2','TSOA3','TSOG0','TSOG1','TSOG2','TSOG3','PFE' - - - - -'ACTA','ALD2','AROMP4','AROMP5','ATOOH','BALD','BENZP','BR2','BRCL','BZCO3H','BZPAN','CH2O','CSL','EOH','ETHLN','ETHN','ETHP','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HI','HMHP','HMML','HNO3','HOBR','HOCL','HOI','HONIT','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','ITCN','ITHN','LIMO','LVOC','LVOCOA','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MCT','MEK','MGLY','MOH','MONITS','MONITU','MP','MPAN','MPN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','NH3','NPHEN','PAN','PHEN','PP','PPN','PROPNN','PRPE','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2','AERI','AONITA','ASOA1','ASOA2','ASOA3','ASOAN','ASOG1','ASOG2','ASOG3','BRSALA','BRSALC','INDIOL','IONITA','ISALA','ISALC','MONITA','MSA','NH4','NIT','NITS','SALAAL','SALACL','SALCAL','SALCCL','SO4S','SOAGX','SOAIE','TSOA0','TSOA1','TSOA2','TSOA3','TSOG0','TSOG1','TSOG2','TSOG3','PFE' - - - -'dst_a1','so4_a1','nh4_a1','pom_a1','pomff1_a1','pombb1_a1','soa_a1','bc_a1','ncl_a1','num_a1','so4_a2','nh4_a2','soa_a2','ncl_a2','dst_a2','num_a2','dst_a3','ncl_a3','so4_a3','pom_a3','bc_a3','num_a3','ncl_a4','so4_a4','pom_a4','pomff1_a4','pombb1_a4','bc_a4','nh4_a4','num_a4','dst_a5','so4_a5','nh4_a5','num_a5','ncl_a6','so4_a6','nh4_a6','num_a6','dst_a7','so4_a7','nh4_a7','num_a7','soa1_a1','soa1_a2','soa2_a1','soa2_a2','soa3_a1','soa3_a2','soa4_a1','soa4_a2','soa5_a1','soa5_a2','soaff1_a1','soaff2_a1','soaff3_a1','soaff4_a1','soaff5_a1','soabb1_a1','soabb2_a1','soabb3_a1','soabb4_a1','soabb5_a1','soabg1_a1','soabg2_a1','soabg3_a1','soabg4_a1','soabg5_a1','soaff1_a2','soaff2_a2','soaff3_a2','soaff4_a2','soaff5_a2','soabb1_a2','soabb2_a2','soabb3_a2','soabb4_a2','soabb5_a2','soabg1_a2','soabg2_a2','soabg3_a2','soabg4_a2','soabg5_a2' - - - -'dst_a1','so4_a1','nh4_a1','pom_a1','pomff1_a1','pombb1_a1','soa_a1','bc_a1','ncl_a1','num_a1','so4_a2','nh4_a2','soa_a2','ncl_a2','dst_a2','num_a2','dst_a3','ncl_a3','so4_a3','pom_a3','bc_a3','num_a3','ncl_a4','so4_a4','pom_a4','pomff1_a4','pombb1_a4','bc_a4','nh4_a4','num_a4','dst_a5','so4_a5','nh4_a5','num_a5','ncl_a6','so4_a6','nh4_a6','num_a6','dst_a7','so4_a7','nh4_a7','num_a7','soa1_a1','soa1_a2','soa2_a1','soa2_a2','soa3_a1','soa3_a2','soa4_a1','soa4_a2','soa5_a1','soa5_a2','soaff1_a1','soaff2_a1','soaff3_a1','soaff4_a1','soaff5_a1','soabb1_a1','soabb2_a1','soabb3_a1','soabb4_a1','soabb5_a1','soabg1_a1','soabg2_a1','soabg3_a1','soabg4_a1','soabg5_a1','soaff1_a2','soaff2_a2','soaff3_a2','soaff4_a2','soaff5_a2','soabb1_a2','soabb2_a2','soabb3_a2','soabb4_a2','soabb5_a2','soabg1_a2','soabg2_a2','soabg3_a2','soabg4_a2','soabg5_a2' - - - 1,30,365,240,240,480,365,73,30 diff --git a/bld/namelist_files/use_cases/hist_geoschem.xml b/bld/namelist_files/use_cases/hist_geoschem.xml index 5d1ec8e1e4..86720663c7 100644 --- a/bld/namelist_files/use_cases/hist_geoschem.xml +++ b/bld/namelist_files/use_cases/hist_geoschem.xml @@ -37,26 +37,6 @@ 'noy', 'nhx' - - - -'ACET','ACTA','ALD2','AROMP4','AROMP5','ATOOH','BALD','BENZP','BR2','BRCL','BRNO3','BZCO3H','BZPAN','CH2O','CL2','CLNO2','CLNO3','CLO','CLOO','CSL','EOH','ETHLN','ETHN','ETHP','ETNO3','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HI','HMHP','HMML','HNO3','HOBR','HOCL','HOI','HONIT','HPALD1','HPALD2','HPALD3','HPALD4','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDC','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','IPRNO3','ITCN','ITHN','LIMO','LVOC','LVOCOA','MACR','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MCT','MENO3','MGLY','MOH','MONITS','MONITU','MPAN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','N2O5','NH3','NO2','NPHEN','NPRNO3','O3','PAN','PHEN','PP','PPN','PROPNN','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2','AERI','AONITA','ASOA1','ASOA2','ASOA3','ASOAN','ASOG1','ASOG2','ASOG3','BRSALA','BRSALC','INDIOL','IONITA','ISALA','ISALC','MONITA','MSA','NH4','NIT','NITS','SALAAL','SALACL','SALCAL','SALCCL','SO4S','SOAGX','SOAIE','TSOA0','TSOA1','TSOA2','TSOA3','TSOG0','TSOG1','TSOG2','TSOG3','PFE' - - - - -'ACTA','ALD2','AROMP4','AROMP5','ATOOH','BALD','BENZP','BR2','BRCL','BZCO3H','BZPAN','CH2O','CSL','EOH','ETHLN','ETHN','ETHP','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HI','HMHP','HMML','HNO3','HOBR','HOCL','HOI','HONIT','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','ITCN','ITHN','LIMO','LVOC','LVOCOA','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MCT','MEK','MGLY','MOH','MONITS','MONITU','MP','MPAN','MPN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','NH3','NPHEN','PAN','PHEN','PP','PPN','PROPNN','PRPE','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2','AERI','AONITA','ASOA1','ASOA2','ASOA3','ASOAN','ASOG1','ASOG2','ASOG3','BRSALA','BRSALC','INDIOL','IONITA','ISALA','ISALC','MONITA','MSA','NH4','NIT','NITS','SALAAL','SALACL','SALCAL','SALCCL','SO4S','SOAGX','SOAIE','TSOA0','TSOA1','TSOA2','TSOA3','TSOG0','TSOG1','TSOG2','TSOG3','PFE' - - - -'dst_a1','so4_a1','nh4_a1','pom_a1','pomff1_a1','pombb1_a1','soa_a1','bc_a1','ncl_a1','num_a1','so4_a2','nh4_a2','soa_a2','ncl_a2','dst_a2','num_a2','dst_a3','ncl_a3','so4_a3','pom_a3','bc_a3','num_a3','ncl_a4','so4_a4','pom_a4','pomff1_a4','pombb1_a4','bc_a4','nh4_a4','num_a4','dst_a5','so4_a5','nh4_a5','num_a5','ncl_a6','so4_a6','nh4_a6','num_a6','dst_a7','so4_a7','nh4_a7','num_a7','soa1_a1','soa1_a2','soa2_a1','soa2_a2','soa3_a1','soa3_a2','soa4_a1','soa4_a2','soa5_a1','soa5_a2','soaff1_a1','soaff2_a1','soaff3_a1','soaff4_a1','soaff5_a1','soabb1_a1','soabb2_a1','soabb3_a1','soabb4_a1','soabb5_a1','soabg1_a1','soabg2_a1','soabg3_a1','soabg4_a1','soabg5_a1','soaff1_a2','soaff2_a2','soaff3_a2','soaff4_a2','soaff5_a2','soabb1_a2','soabb2_a2','soabb3_a2','soabb4_a2','soabb5_a2','soabg1_a2','soabg2_a2','soabg3_a2','soabg4_a2','soabg5_a2' - - - -'dst_a1','so4_a1','nh4_a1','pom_a1','pomff1_a1','pombb1_a1','soa_a1','bc_a1','ncl_a1','num_a1','so4_a2','nh4_a2','soa_a2','ncl_a2','dst_a2','num_a2','dst_a3','ncl_a3','so4_a3','pom_a3','bc_a3','num_a3','ncl_a4','so4_a4','pom_a4','pomff1_a4','pombb1_a4','bc_a4','nh4_a4','num_a4','dst_a5','so4_a5','nh4_a5','num_a5','ncl_a6','so4_a6','nh4_a6','num_a6','dst_a7','so4_a7','nh4_a7','num_a7','soa1_a1','soa1_a2','soa2_a1','soa2_a2','soa3_a1','soa3_a2','soa4_a1','soa4_a2','soa5_a1','soa5_a2','soaff1_a1','soaff2_a1','soaff3_a1','soaff4_a1','soaff5_a1','soabb1_a1','soabb2_a1','soabb3_a1','soabb4_a1','soabb5_a1','soabg1_a1','soabg2_a1','soabg3_a1','soabg4_a1','soabg5_a1','soaff1_a2','soaff2_a2','soaff3_a2','soaff4_a2','soaff5_a2','soabb1_a2','soabb2_a2','soabb3_a2','soabb4_a2','soabb5_a2','soabg1_a2','soabg2_a2','soabg3_a2','soabg4_a2','soabg5_a2' - - - 1,30,365,240,240,480,365,73,30 diff --git a/bld/namelist_files/use_cases/hist_geoschem_nudged.xml b/bld/namelist_files/use_cases/hist_geoschem_nudged.xml index 9e71a46303..345347ab89 100644 --- a/bld/namelist_files/use_cases/hist_geoschem_nudged.xml +++ b/bld/namelist_files/use_cases/hist_geoschem_nudged.xml @@ -92,28 +92,6 @@ 0.1 .false. - - - - - -'ACET','ACTA','ALD2','AROMP4','AROMP5','ATOOH','BALD','BENZP','BR2','BRCL','BRNO3','BZCO3H','BZPAN','CH2O','CL2','CLNO2','CLNO3','CLO','CLOO','CSL','EOH','ETHLN','ETHN','ETHP','ETNO3','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HI','HMHP','HMML','HNO3','HOBR','HOCL','HOI','HONIT','HPALD1','HPALD2','HPALD3','HPALD4','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDC','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','IPRNO3','ITCN','ITHN','LIMO','LVOC','LVOCOA','MACR','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MCT','MENO3','MGLY','MOH','MONITS','MONITU','MPAN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','N2O5','NH3','NO2','NPHEN','NPRNO3','O3','PAN','PHEN','PP','PPN','PROPNN','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2','AERI','AONITA','ASOA1','ASOA2','ASOA3','ASOAN','ASOG1','ASOG2','ASOG3','BRSALA','BRSALC','INDIOL','IONITA','ISALA','ISALC','MONITA','MSA','NH4','NIT','NITS','SALAAL','SALACL','SALCAL','SALCCL','SO4S','SOAGX','SOAIE','TSOA0','TSOA1','TSOA2','TSOA3','TSOG0','TSOG1','TSOG2','TSOG3','PFE' - - - - -'ACTA','ALD2','AROMP4','AROMP5','ATOOH','BALD','BENZP','BR2','BRCL','BZCO3H','BZPAN','CH2O','CSL','EOH','ETHLN','ETHN','ETHP','ETP','GLYC','GLYX','H2O2','HAC','HBR','HC5A','HCL','HCOOH','HI','HMHP','HMML','HNO3','HOBR','HOCL','HOI','HONIT','HPETHNL','I2','I2O2','I2O3','I2O4','IBR','ICHE','ICL','ICN','ICPDH','IDCHP','IDHDP','IDHPE','IDN','IEPOXA','IEPOXB','IEPOXD','IHN1','IHN2','IHN3','IHN4','INPB','INPD','IONO','IONO2','ITCN','ITHN','LIMO','LVOC','LVOCOA','MACR1OOH','MAP','MCRDH','MCRENOL','MCRHN','MCRHNB','MCRHP','MCT','MEK','MGLY','MOH','MONITS','MONITU','MP','MPAN','MPN','MTPA','MTPO','MVK','MVKDH','MVKHC','MVKHCB','MVKHP','MVKN','MVKPC','NH3','NPHEN','PAN','PHEN','PP','PPN','PROPNN','PRPE','PRPN','PYAC','R4N2','R4P','RA3P','RB3P','RIPA','RIPB','RIPC','RIPD','RP','SO2','AERI','AONITA','ASOA1','ASOA2','ASOA3','ASOAN','ASOG1','ASOG2','ASOG3','BRSALA','BRSALC','INDIOL','IONITA','ISALA','ISALC','MONITA','MSA','NH4','NIT','NITS','SALAAL','SALACL','SALCAL','SALCCL','SO4S','SOAGX','SOAIE','TSOA0','TSOA1','TSOA2','TSOA3','TSOG0','TSOG1','TSOG2','TSOG3','PFE' - - - -'dst_a1','so4_a1','nh4_a1','pom_a1','pomff1_a1','pombb1_a1','soa_a1','bc_a1','ncl_a1','num_a1','so4_a2','nh4_a2','soa_a2','ncl_a2','dst_a2','num_a2','dst_a3','ncl_a3','so4_a3','pom_a3','bc_a3','num_a3','ncl_a4','so4_a4','pom_a4','pomff1_a4','pombb1_a4','bc_a4','nh4_a4','num_a4','dst_a5','so4_a5','nh4_a5','num_a5','ncl_a6','so4_a6','nh4_a6','num_a6','dst_a7','so4_a7','nh4_a7','num_a7','soa1_a1','soa1_a2','soa2_a1','soa2_a2','soa3_a1','soa3_a2','soa4_a1','soa4_a2','soa5_a1','soa5_a2','soaff1_a1','soaff2_a1','soaff3_a1','soaff4_a1','soaff5_a1','soabb1_a1','soabb2_a1','soabb3_a1','soabb4_a1','soabb5_a1','soabg1_a1','soabg2_a1','soabg3_a1','soabg4_a1','soabg5_a1','soaff1_a2','soaff2_a2','soaff3_a2','soaff4_a2','soaff5_a2','soabb1_a2','soabb2_a2','soabb3_a2','soabb4_a2','soabb5_a2','soabg1_a2','soabg2_a2','soabg3_a2','soabg4_a2','soabg5_a2' - - - -'dst_a1','so4_a1','nh4_a1','pom_a1','pomff1_a1','pombb1_a1','soa_a1','bc_a1','ncl_a1','num_a1','so4_a2','nh4_a2','soa_a2','ncl_a2','dst_a2','num_a2','dst_a3','ncl_a3','so4_a3','pom_a3','bc_a3','num_a3','ncl_a4','so4_a4','pom_a4','pomff1_a4','pombb1_a4','bc_a4','nh4_a4','num_a4','dst_a5','so4_a5','nh4_a5','num_a5','ncl_a6','so4_a6','nh4_a6','num_a6','dst_a7','so4_a7','nh4_a7','num_a7','soa1_a1','soa1_a2','soa2_a1','soa2_a2','soa3_a1','soa3_a2','soa4_a1','soa4_a2','soa5_a1','soa5_a2','soaff1_a1','soaff2_a1','soaff3_a1','soaff4_a1','soaff5_a1','soabb1_a1','soabb2_a1','soabb3_a1','soabb4_a1','soabb5_a1','soabg1_a1','soabg2_a1','soabg3_a1','soabg4_a1','soabg5_a1','soaff1_a2','soaff2_a2','soaff3_a2','soaff4_a2','soaff5_a2','soabb1_a2','soabb2_a2','soabb3_a2','soabb4_a2','soabb5_a2','soabg1_a2','soabg2_a2','soabg3_a2','soabg4_a2','soabg5_a2' - - - 1,30,365,240,240,480,365,73,30 diff --git a/bld/perl5lib/Build/ChemNamelist.pm b/bld/perl5lib/Build/ChemNamelist.pm index 88d573afe1..7d4f5a6103 100644 --- a/bld/perl5lib/Build/ChemNamelist.pm +++ b/bld/perl5lib/Build/ChemNamelist.pm @@ -44,7 +44,7 @@ sub chem_has_species #------------------------------------------------------------------------------- sub set_dep_lists { - my ( $cfgdir, $chem_proc_src, $chem_src_dir, $nl, $print_lvl ) = @_; + my ( $chem, $cfgdir, $chem_proc_src, $chem_src_dir, $nl, $print_lvl ) = @_; my ( $gas_wetdep_list, $aer_wetdep_list, $aer_drydep_list, $aer_sol_facti, $aer_sol_factb, $aer_scav_coef, $gas_drydep_list ) ; @@ -71,37 +71,17 @@ sub set_dep_lists if ($print_lvl>=2) {print "Chemistry species : @species_list \n" ;} if ($print_lvl>=2) {print "Not transported species : @nottransported_list \n" ;} - if (!defined $nl->get_value('gas_wetdep_list')) { - $gas_wetdep_list = get_gas_wetdep_list( $cfgdir, $print_lvl, \@species_list, \@nottransported_list ); - } else { - $gas_wetdep_list = $nl->get_value('gas_wetdep_list'); - $gas_wetdep_list = filter_dep_list( $gas_wetdep_list, $print_lvl, \@species_list, \@nottransported_list ); - if ($print_lvl>=2) {print " gas wet dep list : $gas_wetdep_list \n" ;} - } + $gas_wetdep_list = get_gas_wetdep_list( $chem, $cfgdir, $print_lvl, \@species_list, \@nottransported_list ); + if ($print_lvl>=2) {print " gas wet dep list : $gas_wetdep_list \n" ;} - if (!defined $nl->get_value('aer_wetdep_list')) { - $aer_wetdep_list = get_aer_wetdep_list( $cfgdir, $print_lvl, \@species_list, \@nottransported_list ); - } else { - $aer_wetdep_list = $nl->get_value('aer_wetdep_list'); - $aer_wetdep_list = filter_dep_list( $aer_wetdep_list, $print_lvl, \@species_list, \@nottransported_list ); - if ($print_lvl>=2) {print " aer wet dep list : $aer_wetdep_list \n" ;} - } + $aer_wetdep_list = get_aer_wetdep_list( $chem, $cfgdir, $print_lvl, \@species_list, \@nottransported_list ); + if ($print_lvl>=2) {print " aer wet dep list : $aer_wetdep_list \n" ;} - if (!defined $nl->get_value('drydep_list')) { - $gas_drydep_list = get_gas_drydep_list( $cfgdir, $print_lvl, \@species_list, \@nottransported_list ); - } else { - $gas_drydep_list = $nl->get_value('drydep_list'); - $gas_drydep_list = filter_dep_list( $gas_drydep_list, $print_lvl, \@species_list, \@nottransported_list ); - if ($print_lvl>=2) {print " dry dep list : $gas_drydep_list \n" ;} - } + $gas_drydep_list = get_gas_drydep_list( $chem, $cfgdir, $print_lvl, \@species_list, \@nottransported_list ); + if ($print_lvl>=2) {print " dry dep list : $gas_drydep_list \n" ;} - if (!defined $nl->get_value('aer_drydep_list')) { - $aer_drydep_list = get_aer_drydep_list( $cfgdir, $print_lvl, \@species_list, \@nottransported_list ); - } else { - $aer_drydep_list = $nl->get_value('aer_drydep_list'); - $aer_drydep_list = filter_dep_list( $aer_drydep_list, $print_lvl, \@species_list, \@nottransported_list ); - if ($print_lvl>=2) {print " aer dry dep list : $aer_drydep_list \n" ;} - } + $aer_drydep_list = get_aer_drydep_list( $chem, $cfgdir, $print_lvl, \@species_list, \@nottransported_list ); + if ($print_lvl>=2) {print " aer dry dep list : $aer_drydep_list \n" ;} # set solubility factors for aerosols if (length($aer_wetdep_list)>2){ @@ -229,9 +209,14 @@ sub print_modal_info #------------------------------------------------------------------------------- sub get_gas_drydep_list { - my ($cfg_dir,$print_lvl,$species_list,$nottransported_list) = @_; + my ($chem,$cfg_dir,$print_lvl,$species_list,$nottransported_list) = @_; - my $master_file = "$cfg_dir/namelist_files/master_gas_drydep_list.xml"; + my $master_file = ''; + if ($chem =~ /geoschem/) { + $master_file = "$cfg_dir/namelist_files/geoschem_master_gas_drydep_list.xml"; + } else { + $master_file = "$cfg_dir/namelist_files/mozart_master_gas_drydep_list.xml"; + } my $list = get_dep_list($master_file,$print_lvl,$species_list,$nottransported_list); @@ -244,9 +229,14 @@ sub get_gas_drydep_list #------------------------------------------------------------------------------- sub get_aer_drydep_list { - my ($cfg_dir,$print_lvl,$species_list,$nottransported_list) = @_; + my ($chem,$cfg_dir,$print_lvl,$species_list,$nottransported_list) = @_; - my $master_file = "$cfg_dir/namelist_files/master_aer_drydep_list.xml"; + my $master_file = ''; + if ($chem =~ /geoschem/) { + $master_file = "$cfg_dir/namelist_files/geoschem_master_aer_drydep_list.xml"; + } else { + $master_file = "$cfg_dir/namelist_files/mozart_master_aer_drydep_list.xml"; + } my $list = get_dep_list($master_file,$print_lvl,$species_list,$nottransported_list); @@ -257,10 +247,15 @@ sub get_aer_drydep_list #------------------------------------------------------------------------------- sub get_aer_wetdep_list { - my ($cfg_dir,$print_lvl,$species_list,$nottransported_list) = @_; - - my $master_file = "$cfg_dir/namelist_files/master_aer_wetdep_list.xml"; + my ($chem,$cfg_dir,$print_lvl,$species_list,$nottransported_list) = @_; + my $master_file = ''; + if ($chem =~ /geoschem/) { + $master_file = "$cfg_dir/namelist_files/geoschem_master_aer_wetdep_list.xml"; + } else { + $master_file = "$cfg_dir/namelist_files/mozart_master_aer_wetdep_list.xml"; + } + my $list = get_dep_list($master_file,$print_lvl,$species_list,$nottransported_list); if ($print_lvl>=2) {print " aer wet dep list : $list \n" ;} @@ -270,9 +265,14 @@ sub get_aer_wetdep_list #------------------------------------------------------------------------------- sub get_gas_wetdep_list { - my ($cfg_dir,$print_lvl,$species_list,$nottransported_list) = @_; + my ($chem,$cfg_dir,$print_lvl,$species_list,$nottransported_list) = @_; - my $master_file = "$cfg_dir/namelist_files/master_gas_wetdep_list.xml"; + my $master_file = ''; + if ($chem =~ /geoschem/) { + $master_file = "$cfg_dir/namelist_files/geoschem_master_gas_wetdep_list.xml"; + } else { + $master_file = "$cfg_dir/namelist_files/mozart_master_gas_wetdep_list.xml"; + } my $list = get_dep_list($master_file,$print_lvl,$species_list,$nottransported_list); @@ -310,40 +310,6 @@ sub get_dep_list return ($list); } - -#------------------------------------------------------------------------------- -#------------------------------------------------------------------------------- -sub filter_dep_list -{ - my ( $input_list, $print_lvl, $species_list_ref, $nottransported_list_ref ) = @_; - - if ($print_lvl>=2){ print "Filtering deposition species list \n"; } - - my @species_list = @{$species_list_ref}; - my @nottransported_list = @{$nottransported_list_ref}; - - my @master_list = split( ('\s+|\s*,+\s*'), $input_list); - - my $list = ''; - my $first = 1; my $pre = ""; - foreach my $name (sort @species_list) { - foreach my $item (@master_list) { - $item =~ s/['"]//g; #"' - if (!($item ~~ @nottransported_list)) { - if ($name eq $item) { - $list .= $pre . quote_string($name) ; - if ($first) { $pre = ","; $first = 0; } - } - } - } - } - - if ( length($list)<1 ) {$list = quote_string(' ') ;} - - return ($list); - -} - #------------------------------------------------------------------------------- sub read_master_list_file { From dcc7e204afa92c52ce94be22dcf2d4d3147b6794 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Thu, 16 Nov 2023 15:19:22 -0700 Subject: [PATCH 194/291] Revert dep_data_file input_pathname to "abs"; use new file for geoschem Previously the dep_data_file default for GEOS-Chem was not actually being used due to inclusion in the use case files. This let a bug go under the radar that dep_data_file input_pathname="abs" was removed from the namelist definitions, meaning the configured inputdata path would not be used as a prefix to whatever dep_data_file was set as. This allowed GEOS-Chem compsets to work since the full path was in the use case files, but it resulted in non-GEOS-Chem compsets failing due to an incomplete path for the deposition netcdf file containing Henry's Law coeffs et al. This update restores using inputdata path as a prefix to dep_data_file, and so fixes the non-GEOS-Chem compsets. It also removes the setting of dep_data_file in the GEOS-Chem compsets and updates the filename in the namelist defaults for dep_data_file if using GEOS-Chem. GEOS-Chem compsets will not work until someone at NCAR moves the file to the target inputdata directory. The request to do this has been made. Signed-off-by: Lizzie Lundgren --- bld/namelist_files/namelist_defaults_cam.xml | 2 +- bld/namelist_files/namelist_definition.xml | 4 ++-- bld/namelist_files/use_cases/2000_geoschem.xml | 2 -- bld/namelist_files/use_cases/2010_geoschem.xml | 2 -- bld/namelist_files/use_cases/hist_geoschem.xml | 2 -- bld/namelist_files/use_cases/hist_geoschem_nudged.xml | 2 -- 6 files changed, 3 insertions(+), 11 deletions(-) diff --git a/bld/namelist_files/namelist_defaults_cam.xml b/bld/namelist_files/namelist_defaults_cam.xml index 6bc286eec6..9d9190b103 100644 --- a/bld/namelist_files/namelist_defaults_cam.xml +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -1932,7 +1932,7 @@ atm/cam/chem/trop_mozart/dvel/dep_data_c20221208.nc -atm/cam/chem/geoschem/dvel/dep_data_file_geoschem_2022Sep21.nc +atm/cam/chem/geoschem/dvel/dep_data_file_geoschem_c230417.nc atm/waccm/phot/effxstex.txt diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index 613ee17492..a6c4a3eab1 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -7307,9 +7307,9 @@ List of species that undergo dry deposition. Default: set by build-namelist. - -Pathname of file containing gas phase deposition data including effective +Full pathname of file containing gas phase deposition data including effective Henry's law coefficients. Default: set by build-namelist. diff --git a/bld/namelist_files/use_cases/2000_geoschem.xml b/bld/namelist_files/use_cases/2000_geoschem.xml index f82bcaa4b5..f85e1dd4ef 100644 --- a/bld/namelist_files/use_cases/2000_geoschem.xml +++ b/bld/namelist_files/use_cases/2000_geoschem.xml @@ -12,8 +12,6 @@ /glade/p/univ/umit0034/Shared/GEOS-Chem/f.e20.FC2010.f19_f19.144.GC_vbsext.001.cam.i.0007-01-01-00000.nc -/glade/p/univ/umit0034/Shared/dep_data_file_geoschem_c230417.nc - HEMCO_Config.rc HEMCO_Diagn.rc diff --git a/bld/namelist_files/use_cases/2010_geoschem.xml b/bld/namelist_files/use_cases/2010_geoschem.xml index b8ef551202..72685aa4d2 100644 --- a/bld/namelist_files/use_cases/2010_geoschem.xml +++ b/bld/namelist_files/use_cases/2010_geoschem.xml @@ -10,8 +10,6 @@ /glade/p/univ/umit0034/Shared/GEOS-Chem/f.e20.FC2010.f19_f19.144.GC_vbsext.001.cam.i.0007-01-01-00000.nc -/glade/p/univ/umit0034/Shared/dep_data_file_geoschem_c230417.nc - HEMCO_Config.rc HEMCO_Diagn.rc diff --git a/bld/namelist_files/use_cases/hist_geoschem.xml b/bld/namelist_files/use_cases/hist_geoschem.xml index 86720663c7..ea28eca22c 100644 --- a/bld/namelist_files/use_cases/hist_geoschem.xml +++ b/bld/namelist_files/use_cases/hist_geoschem.xml @@ -12,8 +12,6 @@ /glade/p/univ/umit0034/Shared/GEOS-Chem/f.e20.FC2010.f19_f19.144.GC_vbsext.001.cam.i.0007-01-01-00000.nc -/glade/p/univ/umit0034/Shared/dep_data_file_geoschem_c230417.nc - HEMCO_Config.rc HEMCO_Diagn.rc diff --git a/bld/namelist_files/use_cases/hist_geoschem_nudged.xml b/bld/namelist_files/use_cases/hist_geoschem_nudged.xml index 345347ab89..8a32ee167b 100644 --- a/bld/namelist_files/use_cases/hist_geoschem_nudged.xml +++ b/bld/namelist_files/use_cases/hist_geoschem_nudged.xml @@ -12,8 +12,6 @@ /glade/p/univ/umit0034/Shared/GEOS-Chem/f.e20.FC2010.f19_f19.144.GC_vbsext.001.cam.i.0007-01-01-00000.nc -/glade/p/univ/umit0034/Shared/dep_data_file_geoschem_c230417.nc - HEMCO_Config.rc HEMCO_Diagn.rc From 2ed878354b37f5ebd5e946870a945bc9a8b6fb60 Mon Sep 17 00:00:00 2001 From: Cheryl Craig Date: Wed, 13 Dec 2023 12:59:00 -0700 Subject: [PATCH 195/291] Fix compilation error --- src/physics/cam/convect_shallow.F90 | 2 +- src/physics/cam/zm_conv_intr.F90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/physics/cam/convect_shallow.F90 b/src/physics/cam/convect_shallow.F90 index d7b909a375..bca53640f1 100644 --- a/src/physics/cam/convect_shallow.F90 +++ b/src/physics/cam/convect_shallow.F90 @@ -870,7 +870,7 @@ subroutine convect_shallow_tend( ztodt , cmfmc , & call zm_conv_evap_run( state1%ncol, pcols, pver, pverp, & gravit, latice, latvap, tmelt, & cpair, zmconv_ke, zmconv_ke_lnd, zmconv_org, & - state1%t, state1%pmid, state1%pdel, state1%q(:pcols,:pver,1), & + state1%t(:,:), state1%pmid, state1%pdel, state1%q(:pcols,:pver,1), & landfracdum, & ptend_loc%s, tend_s_snwprd, tend_s_snwevmlt, & ptend_loc%q(:pcols,:pver,1), & diff --git a/src/physics/cam/zm_conv_intr.F90 b/src/physics/cam/zm_conv_intr.F90 index 7d8445e688..9f2d05afbc 100644 --- a/src/physics/cam/zm_conv_intr.F90 +++ b/src/physics/cam/zm_conv_intr.F90 @@ -653,7 +653,7 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , & call zm_conv_evap_run(state1%ncol, pcols, pver, pverp, & gravit, latice, latvap, tmelt, & cpair, zmconv_ke, zmconv_ke_lnd, zmconv_org, & - state1%t,state1%pmid,state1%pdel,state1%q(:pcols,:pver,1), & + state1%t(:,:),state1%pmid,state1%pdel,state1%q(:pcols,:pver,1), & landfrac, & ptend_loc%s, tend_s_snwprd, tend_s_snwevmlt, ptend_loc%q(:pcols,:pver,1), & rprd, cld, ztodt, & From caa528d6ffffd4191873451ec439713eee0cdfbc Mon Sep 17 00:00:00 2001 From: Cheryl Craig Date: Thu, 14 Dec 2023 16:49:32 -0700 Subject: [PATCH 196/291] address some reviewer comments --- Externals_CAM.cfg | 2 +- bld/configure | 3 -- src/physics/cam/convect_shallow.F90 | 2 +- src/physics/cam/zm_conv_intr.F90 | 47 ++++++++++++++------- src/physics/spcam/crmclouds_camaerosols.F90 | 2 +- 5 files changed, 35 insertions(+), 21 deletions(-) diff --git a/Externals_CAM.cfg b/Externals_CAM.cfg index 4305516b9e..0deba5cb89 100644 --- a/Externals_CAM.cfg +++ b/Externals_CAM.cfg @@ -50,7 +50,7 @@ tag = ALI_ARMS_v1.0.1 required = True [atmos_phys] -tag = 3d03d40923 +tag = 0f5021cbe5 protocol = git repo_url = https://github.com/cacraigucar/atmospheric_physics required = True diff --git a/bld/configure b/bld/configure index a202ccf6f6..678d0a8ac6 100755 --- a/bld/configure +++ b/bld/configure @@ -1802,9 +1802,6 @@ if ($usr_cppdefs and $print>=2) { print "Commandline CPP definitions: \'$usr_cpp # the CPP definitions that were explicitly set in the defaults file or by the user on the commandline. my $cfg_cppdefs = ' '; -# Turn on CCPP "OLD_CAM" -$cfg_cppdefs .= " -DOLD_CAM"; - # Building for perturbation growth tests if ($pergro eq "ON") { $cfg_cppdefs .= " -DPERGRO"; } diff --git a/src/physics/cam/convect_shallow.F90 b/src/physics/cam/convect_shallow.F90 index bca53640f1..2897db6651 100644 --- a/src/physics/cam/convect_shallow.F90 +++ b/src/physics/cam/convect_shallow.F90 @@ -13,7 +13,7 @@ module convect_shallow use shr_kind_mod, only : r8=>shr_kind_r8 use physconst, only : cpair, zvir use ppgrid, only : pver, pcols, pverp - use zm_conv_evap_mod, only : zm_conv_evap_run + use zm_conv_evap, only : zm_conv_evap_run use zm_conv_intr, only : zmconv_ke, zmconv_ke_lnd, zmconv_org use cam_history, only : outfld, addfld, horiz_only use cam_logfile, only : iulog diff --git a/src/physics/cam/zm_conv_intr.F90 b/src/physics/cam/zm_conv_intr.F90 index 9f2d05afbc..a245c54778 100644 --- a/src/physics/cam/zm_conv_intr.F90 +++ b/src/physics/cam/zm_conv_intr.F90 @@ -10,10 +10,10 @@ module zm_conv_intr use shr_kind_mod, only: r8=>shr_kind_r8 use physconst, only: cpair, epsilo, gravit, latvap, tmelt, rair use ppgrid, only: pver, pcols, pverp, begchunk, endchunk - use zm_conv_evap_mod, only: zm_conv_evap_run - use zm_convr_mod, only: zm_convr_init, zm_convr_run - use zm_conv_convtran_mod, only: zm_conv_convtran_run - use zm_conv_momtran_mod, only: zm_conv_momtran_run + use zm_conv_evap, only: zm_conv_evap_run + use zm_convr, only: zm_convr_init, zm_convr_run + use zm_conv_convtran, only: zm_conv_convtran_run + use zm_conv_momtran, only: zm_conv_momtran_run use rad_constituents, only: rad_cnst_get_info, rad_cnst_get_mode_num, rad_cnst_get_aer_mmr, & rad_cnst_get_aer_props, rad_cnst_get_mode_props !, & @@ -155,6 +155,7 @@ subroutine zm_conv_register ! convective mass fluxes call pbuf_add_field('CMFMC_DP', 'physpkg', dtype_r8, (/pcols,pverp/), mconzm_idx) +!CACNOTE - Is zm_org really a constituent or was it just a handy structure to use for an allocatable which persists in the run? if (zmconv_org) then call cnst_add('ZM_ORG',0._r8,0._r8,0._r8,ixorg,longname='organization parameter') endif @@ -237,7 +238,7 @@ subroutine zm_conv_init(pref_edge) use cam_history, only: addfld, add_default, horiz_only use ppgrid, only: pcols, pver - use zm_convr_mod, only: zm_convr_init + use zm_convr, only: zm_convr_init use pmgrid, only: plev,plevp use spmd_utils, only: masterproc use phys_control, only: phys_deepconv_pbl, phys_getopts, cam_physpkg_is @@ -545,6 +546,7 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , & ! call t_startf ('zm_convr_run') +!CACNOTE - Need to remove the pointer and may need to copy in/out around the zm_convr_run call if (zmconv_org) then allocate(zm_org2d(pcols,pver)) org => state%q(:,:,ixorg) @@ -552,16 +554,31 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , & endif !CACNOTE - Need to check errflg and report errors - call zm_convr_run( ncol , pcols, pver, & - pverp, gravit ,latice ,cpwv ,cpliq ,& - rh2o,& - state%t ,state%q(:,:,1), prec ,jctop ,jcbot , & - pblh ,state%zm ,state%phis ,state%zi ,ptend_loc%q(:,:,1) , & - ptend_loc%s , state%pmid ,state%pint ,state%pdel , & - .5_r8*ztodt ,mcon ,cme , cape, & - tpert ,dlf ,pflx ,zdu ,rprd , & - mu, md, du, eu, ed, & - dp, dsubcld, jt, maxg, ideep, & +! call zm_convr_run(ncol, ncol, pver, & +! pverp, gravit, latice, cpwv, cpliq, rh2o, & +! state%t(:ncol,:), state%q(:ncol,:,1), prec(:ncol), jctop(:ncol), jcbot(:ncol), & +! pblh(:ncol), state%zm(:ncol,:), state%phis, state%zi(:ncol,:), ptend_loc%q(:ncol,:,1), & +! ptend_loc%s(:ncol,:), state%pmid(:ncol,:), state%pint(:ncol,:), state%pdel(:ncol,:), & +! .5_r8*ztodt, mcon(:ncol,:), cme(:ncol,:), cape(:ncol), & +! tpert(:ncol), dlf(:ncol,:), pflx(:ncol,:), zdu(:ncol,:), rprd(:ncol,:), & +! mu(:ncol,:), md(:ncol,:), du(:ncol,:), eu(:ncol,:), ed(:ncol,:), & +! dp(:ncol,:), dsubcld(:ncol), jt(:ncol), maxg(:ncol), ideep(:ncol), & +! ql(:ncol,:), rliq(:ncol), landfrac(:ncol), & +!!CACNOTE - This call needs to be used when the pointer attribute is removed from these variables +!! org(:ncol,:), orgt(:ncol,:), zm_org2d(:ncol,:), & +! org, orgt, zm_org2d, & +! dif(:ncol,:), dnlf(:ncol,:), dnif(:ncol,:), & +! rice(:ncol), errmsg, errflg) + + call zm_convr_run(ncol, pcols, pver, & + pverp, gravit, latice, cpwv, cpliq, rh2o, & + state%t, state%q(:,:,1), prec, jctop, jcbot, & + pblh, state%zm, state%phis, state%zi, ptend_loc%q(:,:,1), & + ptend_loc%s, state%pmid, state%pint, state%pdel, & + .5_r8*ztodt, mcon, cme, cape, & + tpert, dlf, pflx, zdu, rprd, & + mu, md, du, eu, ed, & + dp, dsubcld, jt, maxg, ideep, & ql, rliq, landfrac, & org, orgt, zm_org2d, & dif, dnlf, dnif, & diff --git a/src/physics/spcam/crmclouds_camaerosols.F90 b/src/physics/spcam/crmclouds_camaerosols.F90 index 8ebdb0f016..b3dc07d271 100644 --- a/src/physics/spcam/crmclouds_camaerosols.F90 +++ b/src/physics/spcam/crmclouds_camaerosols.F90 @@ -608,7 +608,7 @@ subroutine crmclouds_convect_tend(state, ptend, ztodt, pbuf) use time_manager, only: get_nstep use physics_buffer, only: physics_buffer_desc, pbuf_old_tim_idx, pbuf_get_index, pbuf_get_field use constituents, only: pcnst, cnst_get_ind - use zm_conv_convtran_mod, only: zm_conv_convtran_run + use zm_conv_convtran,only: zm_conv_convtran_run use error_messages, only: alloc_err ! Arguments From a8117555b2accc3afb98e8da2dd9020ce4dd8c5b Mon Sep 17 00:00:00 2001 From: Meg Fowler Date: Wed, 20 Dec 2023 08:15:12 -0700 Subject: [PATCH 197/291] Add ability to output UGUST variable from coupler. --- src/control/camsrfexch.F90 | 2 ++ src/cpl/nuopc/atm_import_export.F90 | 14 ++++++++++++++ src/physics/cam/cam_diagnostics.F90 | 3 +++ 3 files changed, 19 insertions(+) diff --git a/src/control/camsrfexch.F90 b/src/control/camsrfexch.F90 index de1ea4ce6e..f45a2a1c13 100644 --- a/src/control/camsrfexch.F90 +++ b/src/control/camsrfexch.F90 @@ -100,6 +100,7 @@ module camsrfexch real(r8) :: tref(pcols) ! ref height surface air temp real(r8) :: qref(pcols) ! ref height specific humidity real(r8) :: u10(pcols) ! 10m wind speed + real(r8) :: ugustOut(pcols) ! gustiness added real(r8) :: ts(pcols) ! merged surface temp real(r8) :: sst(pcols) ! sea surface temp real(r8) :: snowhland(pcols) ! snow depth (liquid water equivalent) over land @@ -218,6 +219,7 @@ subroutine hub2atm_alloc( cam_in ) cam_in(c)%tref (:) = 0._r8 cam_in(c)%qref (:) = 0._r8 cam_in(c)%u10 (:) = 0._r8 + cam_in(c)%ugustOut (:) = 0._r8 cam_in(c)%ts (:) = 0._r8 cam_in(c)%sst (:) = 0._r8 cam_in(c)%snowhland(:) = 0._r8 diff --git a/src/cpl/nuopc/atm_import_export.F90 b/src/cpl/nuopc/atm_import_export.F90 index 8c28b120fa..c8e25ed1c4 100644 --- a/src/cpl/nuopc/atm_import_export.F90 +++ b/src/cpl/nuopc/atm_import_export.F90 @@ -244,6 +244,7 @@ subroutine advertise_fields(gcomp, flds_scalar_name, rc) call fldlist_add(fldsToAtm_num, fldsToAtm, 'So_ssq' ) call fldlist_add(fldsToAtm_num, fldsToAtm, 'So_re' ) call fldlist_add(fldsToAtm_num, fldsToAtm, 'Sx_u10' ) + call fldlist_add(fldsToAtm_num, fldsToAtm, 'So_ugustOut') call fldlist_add(fldsToAtm_num, fldsToAtm, 'Faxx_taux' ) call fldlist_add(fldsToAtm_num, fldsToAtm, 'Faxx_tauy' ) call fldlist_add(fldsToAtm_num, fldsToAtm, 'Faxx_lat' ) @@ -766,6 +767,19 @@ subroutine import_fields( gcomp, cam_in, restart_init, rc) end do end if + call state_getfldptr(importState, 'So_ugustOut', fldptr=fldptr1d, exists=exists, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (exists) then + g = 1 + do c = begchunk,endchunk + do i = 1,get_ncols_p(c) + cam_in(c)%ugustOut(i) = fldptr1d(g) + g = g + 1 + end do + end do + end if + + ! bgc scenarios call state_getfldptr(importState, 'Fall_fco2_lnd', fldptr=fldptr1d, exists=exists_fco2_lnd, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/src/physics/cam/cam_diagnostics.F90 b/src/physics/cam/cam_diagnostics.F90 index 10612edfa9..ba5be6bcf5 100644 --- a/src/physics/cam/cam_diagnostics.F90 +++ b/src/physics/cam/cam_diagnostics.F90 @@ -501,6 +501,7 @@ subroutine diag_init_moist(pbuf2d) call addfld ('TREFHTMX', horiz_only, 'X','K','Maximum reference height temperature over output period') call addfld ('QREFHT', horiz_only, 'A', 'kg/kg','Reference height humidity') call addfld ('U10', horiz_only, 'A', 'm/s','10m wind speed') + call addfld ('UGUST', horiz_only, 'A', 'm/s','Gustiness term added to U10') call addfld ('RHREFHT', horiz_only, 'A', 'fraction','Reference height relative humidity') call addfld ('LANDFRAC', horiz_only, 'A', 'fraction','Fraction of sfc area covered by land') @@ -1785,6 +1786,8 @@ subroutine diag_surf (cam_in, cam_out, state, pbuf) call outfld('TREFHTMN', cam_in%tref, pcols, lchnk) call outfld('QREFHT', cam_in%qref, pcols, lchnk) call outfld('U10', cam_in%u10, pcols, lchnk) + call outfld('UGUST', cam_in%ugustOut, pcols, lchnk) + ! ! Calculate and output reference height RH (RHREFHT) call qsat(cam_in%tref(1:ncol), state%ps(1:ncol), tem2(1:ncol), ftem(1:ncol), ncol) From d375f4dc36c2b5caa8d17b3be7a796b48aa82ec6 Mon Sep 17 00:00:00 2001 From: Meg Fowler Date: Tue, 2 Jan 2024 08:24:24 -0700 Subject: [PATCH 198/291] Fixing alignment issues --- src/physics/cam/cam_diagnostics.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/physics/cam/cam_diagnostics.F90 b/src/physics/cam/cam_diagnostics.F90 index ba5be6bcf5..aaecdf2d2c 100644 --- a/src/physics/cam/cam_diagnostics.F90 +++ b/src/physics/cam/cam_diagnostics.F90 @@ -501,7 +501,7 @@ subroutine diag_init_moist(pbuf2d) call addfld ('TREFHTMX', horiz_only, 'X','K','Maximum reference height temperature over output period') call addfld ('QREFHT', horiz_only, 'A', 'kg/kg','Reference height humidity') call addfld ('U10', horiz_only, 'A', 'm/s','10m wind speed') - call addfld ('UGUST', horiz_only, 'A', 'm/s','Gustiness term added to U10') + call addfld ('UGUST', horiz_only, 'A', 'm/s','Gustiness term added to U10') call addfld ('RHREFHT', horiz_only, 'A', 'fraction','Reference height relative humidity') call addfld ('LANDFRAC', horiz_only, 'A', 'fraction','Fraction of sfc area covered by land') @@ -1786,7 +1786,7 @@ subroutine diag_surf (cam_in, cam_out, state, pbuf) call outfld('TREFHTMN', cam_in%tref, pcols, lchnk) call outfld('QREFHT', cam_in%qref, pcols, lchnk) call outfld('U10', cam_in%u10, pcols, lchnk) - call outfld('UGUST', cam_in%ugustOut, pcols, lchnk) + call outfld('UGUST', cam_in%ugustOut, pcols, lchnk) ! ! Calculate and output reference height RH (RHREFHT) From 8f6573db765daa31595197005e31fd2f2a5569af Mon Sep 17 00:00:00 2001 From: Meg Fowler Date: Wed, 3 Jan 2024 13:43:24 -0700 Subject: [PATCH 199/291] Update CMEPS in Externals.cfg --- Externals.cfg | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Externals.cfg b/Externals.cfg index c60ee52605..43bfbb0be9 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -21,7 +21,7 @@ externals = Externals.cfg required = True [cmeps] -tag = cmeps0.14.43 +tag = cmeps0.14.49 protocol = git repo_url = https://github.com/ESCOMP/CMEPS.git local_path = components/cmeps From a8a92e6817953232f159135d9a4875fd5a3d88fa Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Fri, 5 Jan 2024 12:09:38 -0700 Subject: [PATCH 200/291] update cime external --- Externals.cfg | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Externals.cfg b/Externals.cfg index 43bfbb0be9..6a839de4a3 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -64,7 +64,7 @@ local_path = libraries/parallelio required = True [cime] -tag = cime6.0.156 +tag = cime6.0.198 protocol = git repo_url = https://github.com/ESMCI/cime local_path = cime From bdb36e6042dc86bcfc86c42fbeb9944165ff04e4 Mon Sep 17 00:00:00 2001 From: Cheryl Craig Date: Thu, 11 Jan 2024 16:26:18 -0700 Subject: [PATCH 201/291] Only pass ncols to ZM routines --- src/physics/cam/cloud_fraction.F90 | 6 +- src/physics/cam/convect_shallow.F90 | 23 +-- src/physics/cam/macrop_driver.F90 | 6 +- src/physics/cam/rk_stratiform.F90 | 158 ++++++++++---------- src/physics/cam/zm_conv_intr.F90 | 152 ++++++++++++------- src/physics/spcam/crmclouds_camaerosols.F90 | 13 +- 6 files changed, 209 insertions(+), 149 deletions(-) diff --git a/src/physics/cam/cloud_fraction.F90 b/src/physics/cam/cloud_fraction.F90 index 365da98f50..3285862fae 100644 --- a/src/physics/cam/cloud_fraction.F90 +++ b/src/physics/cam/cloud_fraction.F90 @@ -751,10 +751,10 @@ subroutine cldfrc_fice(ncol, t, fice, fsnow) ! Arguments integer, intent(in) :: ncol ! number of active columns - real(r8), intent(in) :: t(pcols,pver) ! temperature + real(r8), intent(in) :: t(:,:) ! temperature - real(r8), intent(out) :: fice(pcols,pver) ! Fractional ice content within cloud - real(r8), intent(out) :: fsnow(pcols,pver) ! Fractional snow content for convection + real(r8), intent(out) :: fice(:,:) ! Fractional ice content within cloud + real(r8), intent(out) :: fsnow(:,:) ! Fractional snow content for convection ! Local variables real(r8) :: tmax_fice ! max temperature for cloud ice formation diff --git a/src/physics/cam/convect_shallow.F90 b/src/physics/cam/convect_shallow.F90 index 2897db6651..ffd1db8f5f 100644 --- a/src/physics/cam/convect_shallow.F90 +++ b/src/physics/cam/convect_shallow.F90 @@ -867,15 +867,20 @@ subroutine convect_shallow_tend( ztodt , cmfmc , & sh_cldliq(:ncol,:) = 0._r8 sh_cldice(:ncol,:) = 0._r8 - call zm_conv_evap_run( state1%ncol, pcols, pver, pverp, & - gravit, latice, latvap, tmelt, & - cpair, zmconv_ke, zmconv_ke_lnd, zmconv_org, & - state1%t(:,:), state1%pmid, state1%pdel, state1%q(:pcols,:pver,1), & - landfracdum, & - ptend_loc%s, tend_s_snwprd, tend_s_snwevmlt, & - ptend_loc%q(:pcols,:pver,1), & - rprdsh, cld, ztodt, & - precc, snow, ntprprd, ntsnprd , flxprec, flxsnow ) + !REMOVECAM - no longer need these when CAM is retired and pcols no longer exists + tend_s_snwprd(:,:) = 0._r8 + tend_s_snwevmlt(:,:) = 0._r8 + snow(:) = 0._r8 + !REMOVECAM_END + + call zm_conv_evap_run(state1%ncol, pver, pverp, & + gravit, latice, latvap, tmelt, & + cpair, zmconv_ke, zmconv_ke_lnd, zmconv_org, & + state1%t(:ncol,:),state1%pmid(:ncol,:),state1%pdel(:ncol,:),state1%q(:ncol,:pver,1), & + landfracdum(:ncol), & + ptend_loc%s(:ncol,:), tend_s_snwprd(:ncol,:), tend_s_snwevmlt(:ncol,:), ptend_loc%q(:ncol,:pver,1), & + rprdsh(:ncol,:), cld(:ncol,:), ztodt, & + precc(:ncol), snow(:ncol), ntprprd(:ncol,:), ntsnprd(:ncol,:), flxprec(:ncol,:), flxsnow(:ncol,:) ) ! ---------------------------------------------- ! ! record history variables from zm_conv_evap_run ! diff --git a/src/physics/cam/macrop_driver.F90 b/src/physics/cam/macrop_driver.F90 index 092848dd0e..92d52fff8c 100644 --- a/src/physics/cam/macrop_driver.F90 +++ b/src/physics/cam/macrop_driver.F90 @@ -868,7 +868,11 @@ subroutine macrop_driver_tend( & ! This uses a ramp ( -30 ~ -10 for fice, -5 ~ 0 for fsnow ). ! The ramp within convective cloud may be different - call cldfrc_fice( ncol, state_loc%t, fice, fsnow ) +!REMOVECAM - no longer need these when CAM is retired and pcols no longer exists + fice(:,:) = 0._r8 + fsnow(:,:) = 0._r8 +!REMOVECAM_END + call cldfrc_fice( ncol, state_loc%t(:ncol,:), fice(:ncol,:), fsnow(:ncol,:) ) lq(:) = .FALSE. diff --git a/src/physics/cam/rk_stratiform.F90 b/src/physics/cam/rk_stratiform.F90 index 5d165acc40..84607a20b7 100644 --- a/src/physics/cam/rk_stratiform.F90 +++ b/src/physics/cam/rk_stratiform.F90 @@ -2,7 +2,7 @@ module rk_stratiform !------------------------------------------------------------------------------------------------------- ! -! Provides the CAM interface to the Rasch and Kristjansson (RK) +! Provides the CAM interface to the Rasch and Kristjansson (RK) ! prognostic cloud microphysics, and the cam3/4 macrophysics. ! !------------------------------------------------------------------------------------------------------- @@ -27,26 +27,26 @@ module rk_stratiform public :: rk_stratiform_tend public :: rk_stratiform_readnl -! Physics buffer indices +! Physics buffer indices integer :: landm_idx = 0 -integer :: qcwat_idx = 0 -integer :: lcwat_idx = 0 -integer :: tcwat_idx = 0 +integer :: qcwat_idx = 0 +integer :: lcwat_idx = 0 +integer :: tcwat_idx = 0 -integer :: cld_idx = 0 -integer :: ast_idx = 0 -integer :: concld_idx = 0 -integer :: fice_idx = 0 +integer :: cld_idx = 0 +integer :: ast_idx = 0 +integer :: concld_idx = 0 +integer :: fice_idx = 0 -integer :: qme_idx = 0 -integer :: prain_idx = 0 -integer :: nevapr_idx = 0 +integer :: qme_idx = 0 +integer :: prain_idx = 0 +integer :: nevapr_idx = 0 integer :: wsedl_idx = 0 -integer :: rei_idx = 0 -integer :: rel_idx = 0 +integer :: rei_idx = 0 +integer :: rel_idx = 0 integer :: shfrc_idx = 0 integer :: cmfmc_sh_idx = 0 @@ -92,8 +92,8 @@ subroutine rk_stratiform_readnl(nlfile) character(len=*), parameter :: subname = 'rk_stratiform_readnl' ! Namelist variables - real(r8) :: rk_strat_icritw = unset_r8 ! icritw = threshold for autoconversion of warm ice - real(r8) :: rk_strat_icritc = unset_r8 ! icritc = threshold for autoconversion of cold ice + real(r8) :: rk_strat_icritw = unset_r8 ! icritw = threshold for autoconversion of warm ice + real(r8) :: rk_strat_icritc = unset_r8 ! icritc = threshold for autoconversion of cold ice real(r8) :: rk_strat_conke = unset_r8 ! conke = tunable constant for evaporation of precip real(r8) :: rk_strat_r3lcrit = unset_r8 ! r3lcrit = critical radius where liq conversion begins real(r8) :: rk_strat_polstrat_rhmin = unset_r8 ! condensation threadhold in polar stratosphere @@ -144,7 +144,7 @@ subroutine rk_stratiform_register use constituents, only: cnst_add, pcnst use physconst, only: mwh2o, cpair - + use physics_buffer, only : pbuf_add_field, dtype_r8, dyn_time_lvls !----------------------------------------------------------------------- @@ -166,7 +166,7 @@ subroutine rk_stratiform_register call pbuf_add_field('AST', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), ast_idx) call pbuf_add_field('CONCLD', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), concld_idx) - call pbuf_add_field('FICE', 'physpkg', dtype_r8, (/pcols,pver/), fice_idx) + call pbuf_add_field('FICE', 'physpkg', dtype_r8, (/pcols,pver/), fice_idx) call pbuf_add_field('QME', 'physpkg', dtype_r8, (/pcols,pver/), qme_idx) call pbuf_add_field('PRAIN', 'physpkg', dtype_r8, (/pcols,pver/), prain_idx) @@ -186,8 +186,8 @@ end subroutine rk_stratiform_register function rk_stratiform_implements_cnst(name) - !----------------------------------------------------------------------------- ! - ! ! + !----------------------------------------------------------------------------- ! + ! ! ! Return true if specified constituent is implemented by this package ! ! ! !----------------------------------------------------------------------------- ! @@ -208,7 +208,7 @@ subroutine rk_stratiform_init_cnst(name, latvals, lonvals, mask, q) !----------------------------------------------------------------------- ! ! ! ! Initialize the cloud water mixing ratios (liquid and ice), if they are ! - ! not read from the initial file ! + ! not read from the initial file ! ! ! !----------------------------------------------------------------------- ! @@ -237,7 +237,7 @@ subroutine rk_stratiform_init() !-------------------------------------------- ! ! ! ! Initialize the cloud water parameterization ! - ! ! + ! ! !-------------------------------------------- ! use physics_buffer, only: physics_buffer_desc, pbuf_get_index @@ -247,7 +247,7 @@ subroutine rk_stratiform_init() use phys_control, only: cam_physpkg_is use physconst, only: tmelt, rhodair, rh2o use cldwat, only: inimc - + integer :: m, mm logical :: history_amwg ! output the variables used by the AMWG diag package logical :: history_aerosol ! Output the MAM aerosol tendencies @@ -258,7 +258,7 @@ subroutine rk_stratiform_init() !----------------------------------------------------------------------- call phys_getopts( history_aerosol_out = history_aerosol , & - history_amwg_out = history_amwg , & + history_amwg_out = history_amwg , & history_budget_out = history_budget , & history_budget_histfile_num_out = history_budget_histfile_num) @@ -268,7 +268,7 @@ subroutine rk_stratiform_init() if( convect_shallow_use_shfrc() ) then use_shfrc = .true. shfrc_idx = pbuf_get_index('shfrc') - else + else use_shfrc = .false. endif @@ -326,7 +326,7 @@ subroutine rk_stratiform_init() call addfld ('ICWMR', (/ 'lev' /), 'A', 'kg/kg' , 'Prognostic in-cloud water mixing ratio' ) call addfld ('ICIMR', (/ 'lev' /), 'A', 'kg/kg' , 'Prognostic in-cloud ice mixing ratio' ) call addfld ('PCSNOW', horiz_only , 'A', 'm/s' , 'Snow fall from prognostic clouds' ) - + call addfld ('DQSED', (/ 'lev' /), 'A', 'kg/kg/s' , 'Water vapor tendency from cloud sedimentation' ) call addfld ('DLSED', (/ 'lev' /), 'A', 'kg/kg/s' , 'Cloud liquid tendency from sedimentation' ) call addfld ('DISED', (/ 'lev' /), 'A', 'kg/kg/s' , 'Cloud ice tendency from sedimentation' ) @@ -339,7 +339,7 @@ subroutine rk_stratiform_init() call addfld ('CNVCLD', horiz_only, 'A', 'fraction', 'Vertically integrated convective cloud amount' ) call addfld ('CLDST', (/ 'lev' /), 'A', 'fraction', 'Stratus cloud fraction' ) call addfld ('CONCLD', (/ 'lev' /), 'A', 'fraction', 'Convective cloud cover' ) - + call addfld ('AST', (/ 'lev' /), 'A','fraction' , 'Stratus cloud fraction' ) call addfld ('LIQCLDF', (/ 'lev' /), 'A', 'fraction', 'Stratus Liquid cloud fraction' ) call addfld ('ICECLDF', (/ 'lev' /), 'A', 'fraction', 'Stratus ICE cloud fraction' ) @@ -420,11 +420,11 @@ subroutine rk_stratiform_tend( & dlf2, rliq, cmfmc, ts, & sst, zdu) - !-------------------------------------------------------- ! - ! ! + !-------------------------------------------------------- ! + ! ! ! Interface to sedimentation, detrain, cloud fraction and ! ! cloud macro - microphysics subroutines ! - ! ! + ! ! !-------------------------------------------------------- ! use cloud_fraction, only: cldfrc, cldfrc_fice @@ -475,7 +475,7 @@ subroutine rk_stratiform_tend( & ! Physics buffer fields real(r8), pointer :: landm(:) ! Land fraction ramped over water - real(r8), pointer :: prec_str(:) ! [Total] Sfc flux of precip from stratiform [ m/s ] + real(r8), pointer :: prec_str(:) ! [Total] Sfc flux of precip from stratiform [ m/s ] real(r8), pointer :: snow_str(:) ! [Total] Sfc flux of snow from stratiform [ m/s ] real(r8), pointer :: prec_sed(:) ! Surface flux of total cloud water from sedimentation real(r8), pointer :: snow_sed(:) ! Surface flux of cloud ice from sedimentation @@ -517,12 +517,12 @@ subroutine rk_stratiform_tend( & real(r8) :: clc(pcols) ! Column convective cloud amount real(r8) :: relhum(pcols,pver) ! RH, output to determine drh/da real(r8) :: rhu00(pcols,pver) - real(r8) :: rhu002(pcols,pver) ! Same as rhu00 but for perturbed rh + real(r8) :: rhu002(pcols,pver) ! Same as rhu00 but for perturbed rh real(r8) :: rhdfda(pcols,pver) real(r8) :: cld2(pcols,pver) ! Same as cld but for perturbed rh - real(r8) :: concld2(pcols,pver) ! Same as concld but for perturbed rh - real(r8) :: cldst2(pcols,pver) ! Same as cldst but for perturbed rh - real(r8) :: relhum2(pcols,pver) ! RH after perturbation + real(r8) :: concld2(pcols,pver) ! Same as concld but for perturbed rh + real(r8) :: cldst2(pcols,pver) ! Same as cldst but for perturbed rh + real(r8) :: relhum2(pcols,pver) ! RH after perturbation real(r8) :: icecldf(pcols,pver) ! Ice cloud fraction real(r8) :: liqcldf(pcols,pver) ! Liquid cloud fraction (combined into cloud) real(r8) :: icecldf_out(pcols,pver) ! Ice cloud fraction @@ -547,11 +547,11 @@ subroutine rk_stratiform_tend( & real(r8) :: repartht(pcols,pver) ! Heating rate due to phase repartition of input precip real(r8) :: icimr(pcols,pver) ! In cloud ice mixing ratio real(r8) :: icwmr(pcols,pver) ! In cloud water mixing ratio - real(r8) :: fwaut(pcols,pver) - real(r8) :: fsaut(pcols,pver) - real(r8) :: fracw(pcols,pver) - real(r8) :: fsacw(pcols,pver) - real(r8) :: fsaci(pcols,pver) + real(r8) :: fwaut(pcols,pver) + real(r8) :: fsaut(pcols,pver) + real(r8) :: fracw(pcols,pver) + real(r8) :: fsacw(pcols,pver) + real(r8) :: fsaci(pcols,pver) real(r8) :: cmeice(pcols,pver) ! Rate of cond-evap of ice within the cloud real(r8) :: cmeliq(pcols,pver) ! Rate of cond-evap of liq within the cloud real(r8) :: ice2pr(pcols,pver) ! Rate of conversion of ice to precip @@ -569,8 +569,8 @@ subroutine rk_stratiform_tend( & real(r8) :: psacio(pcols,pver) ! RK accretion of cloud ice by snow (1/s) real(r8) :: iwc(pcols,pver) ! Grid box average ice water content - real(r8) :: lwc(pcols,pver) ! Grid box average liquid water content - + real(r8) :: lwc(pcols,pver) ! Grid box average liquid water content + logical :: lq(pcnst) integer :: troplev(pcols) real(r8) :: rlat(pcols) @@ -598,7 +598,7 @@ subroutine rk_stratiform_tend( & call pbuf_get_field(pbuf, ast_idx, ast, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) call pbuf_get_field(pbuf, fice_idx, fice) - + call pbuf_get_field(pbuf, cmfmc_sh_idx, cmfmc_sh) call pbuf_get_field(pbuf, prec_str_idx, prec_str) @@ -616,7 +616,7 @@ subroutine rk_stratiform_tend( & call pbuf_get_field(pbuf, rei_idx, rei) call pbuf_get_field(pbuf, wsedl_idx, wsedl) - + ! check that qcwat and tcwat were initialized; if not then do it now. if (qcwat(1,1) == huge(1._r8)) then qcwat(:ncol,:) = state%q(:ncol,:,1) @@ -636,16 +636,16 @@ subroutine rk_stratiform_tend( & ! ------------- ! ! Allow the cloud liquid drops and ice particles to sediment. - ! This is done before adding convectively detrained cloud water, + ! This is done before adding convectively detrained cloud water, ! because the phase of the detrained water is unknown. call t_startf('stratiform_sediment') call cld_sediment_vel( ncol, & icefrac, landfrac, ocnfrac, state1%pmid, state1%pdel, state1%t, & - cld, state1%q(:,:,ixcldliq), state1%q(:,:,ixcldice), & + cld, state1%q(:,:,ixcldliq), state1%q(:,:,ixcldice), & pvliq, pvice, landm, snowh ) - + wsedl(:ncol,:pver) = pvliq(:ncol,:pver)/gravit/(state1%pmid(:ncol,:pver)/(287.15_r8*state1%t(:ncol,:pver))) lq(:) = .FALSE. @@ -680,7 +680,7 @@ subroutine rk_stratiform_tend( & call physics_ptend_init(ptend_all, state%psetcols, 'stratiform') call physics_ptend_sum( ptend_loc, ptend_all, ncol ) - ! Update physics state type state1 with ptend_loc + ! Update physics state type state1 with ptend_loc call physics_update( state1, ptend_loc, dtime ) call t_stopf('stratiform_sediment') @@ -695,13 +695,13 @@ subroutine rk_stratiform_tend( & ! Put all of the detraining cloud water from convection into the large scale cloud. ! It all goes in liquid for the moment. - ! Strictly speaking, this approach is detraining all the cconvective water into + ! Strictly speaking, this approach is detraining all the cconvective water into ! the environment, not the large-scale cloud. lq(:) = .FALSE. lq(ixcldliq) = .TRUE. call physics_ptend_init( ptend_loc, state1%psetcols, 'pcwdetrain', lq=lq) - + do k = 1, pver do i = 1, state1%ncol ptend_loc%q(i,k,ixcldliq) = dlf(i,k) @@ -725,7 +725,7 @@ subroutine rk_stratiform_tend( & ! -------------------------------------- ! ! ----------------------------------------------------------------------------- ! - ! Treatment of cloud fraction in CAM4 and CAM5 differs ! + ! Treatment of cloud fraction in CAM4 and CAM5 differs ! ! (1) CAM4 ! ! . Cumulus AMT = Deep Cumulus AMT ( empirical fcn of mass flux ) + ! ! Shallow Cumulus AMT ( empirical fcn of mass flux ) ! @@ -738,7 +738,7 @@ subroutine rk_stratiform_tend( & ! . Stratus AMT = fcn of environmental-mean RH ( no Stability Stratus ) ! ! . Cumulus and Stratus are non-overlapped with higher priority on Cumulus ! ! . Cumulus ( both Deep and Shallow ) has its own LWC and IWC. ! - ! ----------------------------------------------------------------------------- ! + ! ----------------------------------------------------------------------------- ! if( use_shfrc ) then call pbuf_get_field(pbuf, shfrc_idx, shfrc ) @@ -748,8 +748,8 @@ subroutine rk_stratiform_tend( & endif ! Stratus ('ast' = max(alst,aist)) and total cloud fraction ('cld = ast + concld') - ! will be computed using this updated 'concld' in the stratiform macrophysics - ! scheme (mmacro_pcond) later below. + ! will be computed using this updated 'concld' in the stratiform macrophysics + ! scheme (mmacro_pcond) later below. call t_startf("cldfrc") call cldfrc( lchnk, ncol, pbuf, & @@ -759,7 +759,7 @@ subroutine rk_stratiform_tend( & cmfmc, cmfmc_sh, landfrac,snowh, concld, cldst, & ts, sst, state1%pint(:,pverp), zdu, ocnfrac, rhu00, & state1%q(:,:,ixcldice), icecldf, liqcldf, & - relhum, 0 ) + relhum, 0 ) ! Re-calculate cloud with perturbed rh add call cldfrc to estimate rhdfda. @@ -770,7 +770,7 @@ subroutine rk_stratiform_tend( & cmfmc, cmfmc_sh, landfrac, snowh, concld2, cldst2, & ts, sst, state1%pint(:,pverp), zdu, ocnfrac, rhu002, & state1%q(:,:,ixcldice), icecldf2, liqcldf2, & - relhum2, 1 ) + relhum2, 1 ) call t_stopf("cldfrc") @@ -785,7 +785,7 @@ subroutine rk_stratiform_tend( & ! Under certain circumstances, rh+ cause cld not to changed ! when at an upper limit, or w/ strong subsidence if( ( cld2(i,k) - cld(i,k) ) < 1.e-4_r8 ) then - rhdfda(i,k) = 0.01_r8*relhum(i,k)*1.e+4_r8 + rhdfda(i,k) = 0.01_r8*relhum(i,k)*1.e+4_r8 else rhdfda(i,k) = 0.01_r8*relhum(i,k)/(cld2(i,k)-cld(i,k)) endif @@ -802,13 +802,17 @@ subroutine rk_stratiform_tend( & rdtime = 1._r8/dtime ! Define fractional amount of stratus condensate and precipitation in ice phase. - ! This uses a ramp ( -30 ~ -10 for fice, -5 ~ 0 for fsnow ). + ! This uses a ramp ( -30 ~ -10 for fice, -5 ~ 0 for fsnow ). ! The ramp within convective cloud may be different - call cldfrc_fice(ncol, state1%t, fice, fsnow) +!REMOVECAM - no longer need these when CAM is retired and pcols no longer exists + fice(:,:) = 0._r8 + fsnow(:,:) = 0._r8 +!REMOVECAM_END + call cldfrc_fice(ncol, state1%t(1:ncol,:), fice(1:ncol,:), fsnow(1:ncol,:)) - ! Perform repartitioning of stratiform condensate. - ! Corresponding heating tendency will be added later. + ! Perform repartitioning of stratiform condensate. + ! Corresponding heating tendency will be added later. lq(:) = .FALSE. lq(ixcldice) = .true. @@ -830,7 +834,7 @@ subroutine rk_stratiform_tend( & repartht(:ncol,:pver) = (latice/dtime) * ( state1%q(:ncol,:pver,ixcldice) - repartht(:ncol,:pver) ) - ! Non-micro and non-macrophysical external advective forcings to compute net condensation rate. + ! Non-micro and non-macrophysical external advective forcings to compute net condensation rate. ! Note that advective forcing of condensate is aggregated into liquid phase. qtend(:ncol,:pver) = ( state1%q(:ncol,:pver,1) - qcwat(:ncol,:pver) ) * rdtime @@ -869,7 +873,7 @@ subroutine rk_stratiform_tend( & ptend_loc%q(i,k,ixcldliq) = qme(i,k)*(1._r8-fice(i,k)) - liq2pr(i,k) end do end do - + do k = 1, pver do i = 1, ncol ast(i,k) = cld(i,k) @@ -960,7 +964,7 @@ subroutine rk_stratiform_tend( & cmfmc, cmfmc_sh, landfrac, snowh, concld, cldst, & ts, sst, state1%pint(:,pverp), zdu, ocnfrac, rhu00, & state1%q(:,:,ixcldice), icecldf, liqcldf, & - relhum, 0 ) + relhum, 0 ) call t_stopf("cldfrc") endif @@ -968,7 +972,7 @@ subroutine rk_stratiform_tend( & call outfld( 'CONCLD ', concld, pcols, lchnk ) call outfld( 'CLDST ', cldst, pcols, lchnk ) call outfld( 'CNVCLD ', clc, pcols, lchnk ) - call outfld( 'AST', ast, pcols, lchnk ) + call outfld( 'AST', ast, pcols, lchnk ) do k = 1, pver do i = 1, ncol @@ -1000,7 +1004,7 @@ subroutine rk_stratiform_tend( & tcwat(:ncol,k) = state1%t(:ncol,k) lcwat(:ncol,k) = state1%q(:ncol,k,ixcldice) + state1%q(:ncol,k,ixcldliq) end do - + ! Cloud water and ice particle sizes, saved in physics buffer for radiation call cldefr( lchnk, ncol, landfrac, state1%t, rel, rei, state1%ps, state1%pmid, landm, icefrac, snowh ) @@ -1025,7 +1029,7 @@ subroutine debug_microphys_1(state1,ptend,i,k, & use physconst, only: tmelt implicit none - + integer, intent(in) :: i,k type(physics_state), intent(in) :: state1 ! local copy of the state variable type(physics_ptend), intent(in) :: ptend ! local copy of the ptend variable @@ -1058,11 +1062,11 @@ subroutine debug_microphys_1(state1,ptend,i,k, & wv = 0 wi = 0 wlf = 0 - wvf = 0 + wvf = 0 wif = 0 - write(iulog,*) + write(iulog,*) write(iulog,*) ' input state, t, q, l, i ', k, state1%t(i,k), state1%q(i,k,1), state1%q(i,k,ixcldliq), state1%q(i,k,ixcldice) write(iulog,*) ' rain, snow, total from components before accumulation ', qr1, qs1, qr1+qs1 write(iulog,*) ' total precip before accumulation ', k, pr1 @@ -1143,7 +1147,7 @@ subroutine debug_microphys_1(state1,ptend,i,k, & ! + evapheat(i,k) + prfzheat(i,k) + meltheat(i,k) res = qs1+qr1-pr1 - w4 = max(abs(qs1),abs(qr1),abs(pr1)) + w4 = max(abs(qs1),abs(qr1),abs(pr1)) if (w4.gt.0._r8) then if (res/w4.gt.1.e-14_r8) then write(iulog,*) ' imbalance in precips calculated two ways ' @@ -1173,14 +1177,14 @@ subroutine debug_microphys_2(state1,& use ppgrid, only: pver use physconst, only: tmelt use physics_types, only: physics_state - + implicit none type(physics_state), intent(in) :: state1 ! local copy of the state variable real(r8), intent(in) :: snow_pcw(pcols) - real(r8), intent(in) :: fsaut(pcols,pver) - real(r8), intent(in) :: fsacw(pcols,pver) - real(r8), intent(in) :: fsaci(pcols,pver) + real(r8), intent(in) :: fsaut(pcols,pver) + real(r8), intent(in) :: fsacw(pcols,pver) + real(r8), intent(in) :: fsaci(pcols,pver) real(r8), intent(in) :: meltheat(pcols,pver) ! heating rate due to phase change of precip @@ -1189,7 +1193,7 @@ subroutine debug_microphys_2(state1,& ncol = state1%ncol lchnk = state1%lchnk - + do i = 1,ncol if (snow_pcw(i) .gt. 0.01_r8/8.64e4_r8 .and. state1%t(i,pver) .gt. tmelt) then write(iulog,*) ' stratiform: snow, temp, ', i, lchnk, & @@ -1201,7 +1205,7 @@ subroutine debug_microphys_2(state1,& write(iulog,*) ' meltheat ', meltheat(i,:) call endrun ('STRATIFORM_TEND') endif - + if (snow_pcw(i)*8.64e4_r8 .lt. -1.e-5_r8) then write(iulog,*) ' neg snow ', snow_pcw(i)*8.64e4_r8 write(iulog,*) ' stratiform: snow_pcw, temp, ', i, lchnk, & @@ -1214,7 +1218,7 @@ subroutine debug_microphys_2(state1,& call endrun ('STRATIFORM_TEND') endif end do - + end subroutine debug_microphys_2 end module rk_stratiform diff --git a/src/physics/cam/zm_conv_intr.F90 b/src/physics/cam/zm_conv_intr.F90 index a245c54778..b69f02d125 100644 --- a/src/physics/cam/zm_conv_intr.F90 +++ b/src/physics/cam/zm_conv_intr.F90 @@ -486,7 +486,10 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , & integer :: ii real(r8),pointer :: zm_org2d(:,:) - real(r8),pointer :: orgt(:,:), org(:,:) + real(r8),allocatable :: orgt_alloc(:,:), org_alloc(:,:) + + real(r8) :: zm_org2d_noalloc(state%ncol,pver) + real(r8) :: orgt_noalloc(state%ncol,pver), org_noalloc(state%ncol,pver) logical :: lq(pcnst) @@ -546,43 +549,60 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , & ! call t_startf ('zm_convr_run') -!CACNOTE - Need to remove the pointer and may need to copy in/out around the zm_convr_run call if (zmconv_org) then allocate(zm_org2d(pcols,pver)) - org => state%q(:,:,ixorg) - orgt => ptend_loc%q(:,:,ixorg) + allocate(org_alloc(ncol,pver)) + allocate(orgt_alloc(ncol,pver)) + org_noalloc(:ncol,:) = state%q(1:ncol,:,ixorg) endif +!REMOVECAM - no longer need these when CAM is retired and pcols no longer exists + ptend_loc%q(:,:,1) = 0._r8 + ptend_loc%s(:,:) = 0._r8 + mcon(:,:) = 0._r8 + dlf(:,:) = 0._r8 + pflx(:,:) = 0._r8 + cme(:,:) = 0._r8 + cape(:) = 0._r8 + zdu(:,:) = 0._r8 + rprd(:,:) = 0._r8 + dif(:,:) = 0._r8 + dnlf(:,:) = 0._r8 + dnif(:,:) = 0._r8 + mu(:,:) = 0._r8 + eu(:,:) = 0._r8 + du(:,:) = 0._r8 + md(:,:) = 0._r8 + ed(:,:) = 0._r8 + dp(:,:) = 0._r8 + dsubcld(:) = 0._r8 + jctop(:) = 0._r8 + jcbot(:) = 0._r8 + prec(:) = 0._r8 + rliq(:) = 0._r8 + rice(:) = 0._r8 + ideep(:) = 0._r8 +!REMOVECAM_END + !CACNOTE - Need to check errflg and report errors -! call zm_convr_run(ncol, ncol, pver, & -! pverp, gravit, latice, cpwv, cpliq, rh2o, & -! state%t(:ncol,:), state%q(:ncol,:,1), prec(:ncol), jctop(:ncol), jcbot(:ncol), & -! pblh(:ncol), state%zm(:ncol,:), state%phis, state%zi(:ncol,:), ptend_loc%q(:ncol,:,1), & -! ptend_loc%s(:ncol,:), state%pmid(:ncol,:), state%pint(:ncol,:), state%pdel(:ncol,:), & -! .5_r8*ztodt, mcon(:ncol,:), cme(:ncol,:), cape(:ncol), & -! tpert(:ncol), dlf(:ncol,:), pflx(:ncol,:), zdu(:ncol,:), rprd(:ncol,:), & -! mu(:ncol,:), md(:ncol,:), du(:ncol,:), eu(:ncol,:), ed(:ncol,:), & -! dp(:ncol,:), dsubcld(:ncol), jt(:ncol), maxg(:ncol), ideep(:ncol), & -! ql(:ncol,:), rliq(:ncol), landfrac(:ncol), & -!!CACNOTE - This call needs to be used when the pointer attribute is removed from these variables -!! org(:ncol,:), orgt(:ncol,:), zm_org2d(:ncol,:), & -! org, orgt, zm_org2d, & -! dif(:ncol,:), dnlf(:ncol,:), dnif(:ncol,:), & -! rice(:ncol), errmsg, errflg) - - call zm_convr_run(ncol, pcols, pver, & + call zm_convr_run(ncol, pver, & pverp, gravit, latice, cpwv, cpliq, rh2o, & - state%t, state%q(:,:,1), prec, jctop, jcbot, & - pblh, state%zm, state%phis, state%zi, ptend_loc%q(:,:,1), & - ptend_loc%s, state%pmid, state%pint, state%pdel, & - .5_r8*ztodt, mcon, cme, cape, & - tpert, dlf, pflx, zdu, rprd, & - mu, md, du, eu, ed, & - dp, dsubcld, jt, maxg, ideep, & - ql, rliq, landfrac, & - org, orgt, zm_org2d, & - dif, dnlf, dnif, & - rice, errmsg, errflg) + state%t(:ncol,:), state%q(:ncol,:,1), prec(:ncol), jctop(:ncol), jcbot(:ncol), & + pblh(:ncol), state%zm(:ncol,:), state%phis, state%zi(:ncol,:), ptend_loc%q(:ncol,:,1), & + ptend_loc%s(:ncol,:), state%pmid(:ncol,:), state%pint(:ncol,:), state%pdel(:ncol,:), & + .5_r8*ztodt, mcon(:ncol,:), cme(:ncol,:), cape(:ncol), & + tpert(:ncol), dlf(:ncol,:), pflx(:ncol,:), zdu(:ncol,:), rprd(:ncol,:), & + mu(:ncol,:), md(:ncol,:), du(:ncol,:), eu(:ncol,:), ed(:ncol,:), & + dp(:ncol,:), dsubcld(:ncol), jt(:ncol), maxg(:ncol), ideep(:ncol), & + ql(:ncol,:), rliq(:ncol), landfrac(:ncol), & + org_noalloc(:,:), orgt_noalloc(:,:), zm_org2d_noalloc(:,:), & + dif(:ncol,:), dnlf(:ncol,:), dnif(:ncol,:), & + rice(:ncol), errmsg, errflg) + + if (zmconv_org) then + ptend_loc%q(:,:,ixorg)=orgt_noalloc(:ncol,:) + zm_org2d(:ncol,:) = zm_org2d_noalloc(:ncol,:) + endif lengath = count(ideep > 0) @@ -666,15 +686,20 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , & call pbuf_get_field(pbuf, dp_cldice_idx, dp_cldice ) dp_cldliq(:ncol,:) = 0._r8 dp_cldice(:ncol,:) = 0._r8 +!REMOVECAM - no longer need these when CAM is retired and pcols no longer exists + flxprec(:,:) = 0._r8 + flxsnow(:,:) = 0._r8 + snow(:) = 0._r8 +!REMOVECAM_END - call zm_conv_evap_run(state1%ncol, pcols, pver, pverp, & + call zm_conv_evap_run(state1%ncol, pver, pverp, & gravit, latice, latvap, tmelt, & cpair, zmconv_ke, zmconv_ke_lnd, zmconv_org, & - state1%t(:,:),state1%pmid,state1%pdel,state1%q(:pcols,:pver,1), & - landfrac, & - ptend_loc%s, tend_s_snwprd, tend_s_snwevmlt, ptend_loc%q(:pcols,:pver,1), & - rprd, cld, ztodt, & - prec, snow, ntprprd, ntsnprd , flxprec, flxsnow) + state1%t(:ncol,:),state1%pmid(:ncol,:),state1%pdel(:ncol,:),state1%q(:ncol,:pver,1), & + landfrac(:ncol), & + ptend_loc%s(:ncol,:), tend_s_snwprd(:ncol,:), tend_s_snwevmlt(:ncol,:), ptend_loc%q(:ncol,:pver,1), & + rprd(:ncol,:), cld(:ncol,:), ztodt, & + prec(:ncol), snow(:ncol), ntprprd(:ncol,:), ntsnprd(:ncol,:), flxprec(:ncol,:), flxsnow(:ncol,:) ) evapcdp(:ncol,:pver) = ptend_loc%q(:ncol,:pver,1) @@ -727,12 +752,18 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , & l_windt(2) = .true. call t_startf ('zm_conv_momtran_run') - call zm_conv_momtran_run (ncol, pcols, pver, pverp, & - l_windt,winds, 2, mu, md, & + +!REMOVECAM - no longer need this when CAM is retired and pcols no longer exists + wind_tends(:,:,:) = 0._r8 +!REMOVECAM_END + + call zm_conv_momtran_run (ncol, pver, pverp, & + l_windt,winds(:ncol,:,:), 2, mu(:ncol,:), md(:ncol,:), & zmconv_momcu, zmconv_momcd, & - du, eu, ed, dp, dsubcld, & - jt, maxg, ideep, 1, lengath, & - nstep, wind_tends, pguall, pgdall, icwu, icwd, ztodt, seten ) + du(:ncol,:), eu(:ncol,:), ed(:ncol,:), dp(:ncol,:), dsubcld(:ncol), & + jt(:ncol), maxg(:ncol), ideep(:ncol), 1, lengath, & + nstep, wind_tends(:ncol,:,:), pguall(:ncol,:,:), pgdall(:ncol,:,:), & + icwu(:ncol,:,:), icwd(:ncol,:,:), ztodt, seten(:ncol,:) ) call t_stopf ('zm_conv_momtran_run') ptend_loc%u(:ncol,:pver) = wind_tends(:ncol,:pver,1) @@ -781,11 +812,16 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , & fake_dpdry(:,:) = 0._r8 call t_startf ('convtran1') - call zm_conv_convtran_run (pcols, pver, & - ptend_loc%lq,state1%q, pcnst, mu, md, & - du, eu, ed, dp, dsubcld, & - jt,maxg, ideep, 1, lengath, & - nstep, fracis, ptend_loc%q, fake_dpdry, ztodt) + +!REMOVECAM - no longer need this when CAM is retired and pcols no longer exists + ptend_loc%q(:,:,:) = 0._r8 +!REMOVECAM_END + + call zm_conv_convtran_run (ncol, pver, & + ptend_loc%lq,state1%q(:ncol,:,:), pcnst, mu(:ncol,:), md(:ncol,:), & + du(:ncol,:), eu(:ncol,:), ed(:ncol,:), dp(:ncol,:), dsubcld(:ncol), & + jt(:ncol), maxg(:ncol), ideep(:ncol), 1, lengath, & + nstep, fracis(:ncol,:,:), ptend_loc%q(:ncol,:,:), fake_dpdry(:ncol,:), ztodt) call t_stopf ('convtran1') call outfld('ZMDICE ',ptend_loc%q(1,1,ixcldice) ,pcols ,lchnk ) @@ -826,6 +862,7 @@ subroutine zm_conv_tend_2( state, ptend, ztodt, pbuf) integer :: i, lchnk, istat integer :: lengath ! number of columns with deep convection integer :: nstep + integer :: ncol real(r8), dimension(pcols,pver) :: dpdry @@ -858,11 +895,13 @@ subroutine zm_conv_tend_2( state, ptend, ztodt, pbuf) call pbuf_get_field(pbuf, zm_maxg_idx, maxg) call pbuf_get_field(pbuf, zm_ideep_idx, ideep) - lengath = count(ideep > 0) lchnk = state%lchnk + ncol = state%ncol nstep = get_nstep() + lengath = count(ideep > 0) + if (any(ptend%lq(:))) then ! initialize dpdry for call to convtran ! it is used for tracers of dry mixing ratio type @@ -872,11 +911,16 @@ subroutine zm_conv_tend_2( state, ptend, ztodt, pbuf) end do call t_startf ('convtran2') - call zm_conv_convtran_run (pcols, pver, & - ptend%lq,state%q, pcnst, mu, md, & - du, eu, ed, dp, dsubcld, & - jt, maxg, ideep, 1, lengath, & - nstep, fracis, ptend%q, dpdry, ztodt) + +!REMOVECAM - no longer need this when CAM is retired and pcols no longer exists + ptend%q(:,:,:) = 0._r8 +!REMOVECAM_END + + call zm_conv_convtran_run (ncol, pver, & + ptend%lq,state%q(:ncol,:,:), pcnst, mu(:ncol,:), md(:ncol,:), & + du(:ncol,:), eu(:ncol,:), ed(:ncol,:), dp(:ncol,:), dsubcld(:ncol), & + jt(:ncol), maxg(:ncol), ideep(:ncol), 1, lengath, & + nstep, fracis(:ncol,:,:), ptend%q(:ncol,:,:), dpdry(:ncol,:), ztodt) call t_stopf ('convtran2') end if diff --git a/src/physics/spcam/crmclouds_camaerosols.F90 b/src/physics/spcam/crmclouds_camaerosols.F90 index b3dc07d271..3d8f2e315f 100644 --- a/src/physics/spcam/crmclouds_camaerosols.F90 +++ b/src/physics/spcam/crmclouds_camaerosols.F90 @@ -732,11 +732,14 @@ subroutine crmclouds_convect_tend(state, ptend, ztodt, pbuf) dsubcld = 0._r8 - call zm_conv_convtran_run (pcols,pver, & - ptend%lq,state%q, pcnst, mu(:,:), md(:,:), & - du(:,:), eu(:,:), ed(:,:), dp(:,:), dsubcld(:), & - jt(:),maxg(:),ideep(:), 1, lengath, & - nstep, fracis, ptend%q, dpdry, ztodt ) + !REMOVECAM - no longer need these when CAM is retired and pcols no longer exists + ptend%q(:,:,:) = 0._r8 + !REMOVECAM_END + call zm_conv_convtran_run (ncol,pver, & + ptend%lq,state%q(:ncol,:,:), pcnst, mu(:ncol,:), md(:ncol,:), & + du(:ncol,:), eu(:ncol,:), ed(:ncol,:), dp(:ncol,:), dsubcld(:ncol), & + jt(:ncol),maxg(:ncol),ideep(:ncol), 1, lengath, & + nstep, fracis(:ncol,:,:), ptend%q(:ncol,:,:), dpdry(:ncol,:), ztodt ) end subroutine crmclouds_convect_tend !===================================================================================================== From 3558a95178d9a2a2abea6bf88d2e1309f836f326 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Thu, 18 Jan 2024 16:21:36 -0500 Subject: [PATCH 202/291] Update bld/configure Remove redundant/over limiting CCP definitions for GEOS-Chem Co-authored-by: Brian Eaton --- bld/configure | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/bld/configure b/bld/configure index 2e310c9969..5e9fb96d6a 100755 --- a/bld/configure +++ b/bld/configure @@ -1410,11 +1410,11 @@ if ($chem_pkg =~ '_mam3') { # Set GEOS-Chem CPP definitions here if ($chem_pkg =~ 'geoschem') { - $chem_cppdefs .= ' -DEXTERNAL_GRID -DEXTERNAL_FORCING -DLINUX_IFORT -DUSE_REAL8 -DMODEL_ -DMODEL_CESM'; - $chem_nadv = 267; # includes GC advected species (233), CO2 (1), and MAM aerosols (33) + $chem_cppdefs .= ' -DEXTERNAL_GRID -DEXTERNAL_FORCING'; + if ($chem_pkg eq 'geoschem_mam4') { + $chem_nadv = 267; # includes GC advected species (233), CO2 (1), and MAM aerosols (33) + } } - - # CARMA sectional microphysics # # New CARMA models need to define the number of advected constituents. From 14b6813e931f7a4622c5175ca007d9c371ea76d7 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Thu, 18 Jan 2024 14:37:19 -0700 Subject: [PATCH 203/291] Clean up GEOS-Chem code in configure based on suggestions from Brian Easton Signed-off-by: Lizzie Lundgren --- bld/configure | 17 +++++++++++------ 1 file changed, 11 insertions(+), 6 deletions(-) diff --git a/bld/configure b/bld/configure index 5e9fb96d6a..c44ea94669 100755 --- a/bld/configure +++ b/bld/configure @@ -592,10 +592,9 @@ if (defined $opts{'chem'}) { # If the user has specified a simple physics package... if ($simple_phys) { - # the only valid chemistry options are 'none', 'terminator' and 'geoschem' - if (($chem_pkg ne 'none') and ($chem_pkg ne 'terminator') and !($chem_pkg =~ 'geoschem')) { + if (($chem_pkg ne 'none') and ($chem_pkg ne 'terminator')) { die "configure ERROR: -phys=$phys_pkg -chem=$chem_pkg\n". - " -chem can only be set to 'none', 'terminator' or 'geoschem'.\n"; + " -chem can only be set to 'none' or 'terminator'.\n"; } } elsif ($phys_pkg =~ m/^cam3$|^cam4$|^spcam_sam1mom$/) { @@ -1408,9 +1407,8 @@ if ($chem_pkg =~ '_mam3') { $chem_cppdefs = ' -DMODAL_AERO -DMODAL_AERO_7MODE '; } -# Set GEOS-Chem CPP definitions here +# Customize GEOS-Chem advected species if ($chem_pkg =~ 'geoschem') { - $chem_cppdefs .= ' -DEXTERNAL_GRID -DEXTERNAL_FORCING'; if ($chem_pkg eq 'geoschem_mam4') { $chem_nadv = 267; # includes GC advected species (233), CO2 (1), and MAM aerosols (33) } @@ -1684,7 +1682,7 @@ elsif ($fc =~ /nvfor/) { $fc_type = 'nvhpc'; } # User override for Fortran compiler type if (defined $opts{'fc_type'}) { $fc_type = $opts{'fc_type'}; } -if ($fc_type == "oneapi") {$fc_type = 'intel'; } +if ($fc_type eq "oneapi") {$fc_type = 'intel'; } if ($fc_type) { $cfg_ref->set('fc_type', $fc_type); if ($print>=2) { print "Fortran compiler type: $fc_type$eol"; } @@ -1950,6 +1948,13 @@ if ($unicon) { $cfg_cppdefs .= ' -DUSE_UNICON'; } # HEMCO_CESM - indicates CESM model environment. Deprecated, will be removed soon. $cfg_cppdefs .= ' -DMODEL_ -DMODEL_CESM -DHEMCO_CESM -DUSE_REAL8 '; +# Compiler CPP definitions for GEOS-Chem +if ($chem_pkg =~ 'geoschem') { + $chem_cppdefs .= ' -DEXTERNAL_GRID -DEXTERNAL_FORCING'; + if ($fc_type eq 'intel') { $cfg_cppdefs .= ' -DLINUX_IFORT'; } + elsif ($fc_type eq 'gnu') { $cfg_cppdefs .= ' -DLINUX_GFORTRAN'; } +} + #----------------------------------------------------------------------------------------------- # CPP defines to put on Makefile From 2171b0154df5ba2a0508e7cbc3a1f28a6671efc4 Mon Sep 17 00:00:00 2001 From: Cheryl Craig Date: Fri, 19 Jan 2024 15:20:02 -0700 Subject: [PATCH 204/291] address final reviewer comments --- Externals_CAM.cfg | 4 ++-- src/chemistry/modal_aero/modal_aero_convproc.F90 | 1 + src/physics/cam/zm_conv_intr.F90 | 14 ++++++++------ 3 files changed, 11 insertions(+), 8 deletions(-) diff --git a/Externals_CAM.cfg b/Externals_CAM.cfg index 0deba5cb89..edf568fc89 100644 --- a/Externals_CAM.cfg +++ b/Externals_CAM.cfg @@ -50,9 +50,9 @@ tag = ALI_ARMS_v1.0.1 required = True [atmos_phys] -tag = 0f5021cbe5 +tag = atmos_phys0_02_000 protocol = git -repo_url = https://github.com/cacraigucar/atmospheric_physics +repo_url = https://github.com/ESCOMP/atmospheric_physics required = True local_path = src/atmos_phys diff --git a/src/chemistry/modal_aero/modal_aero_convproc.F90 b/src/chemistry/modal_aero/modal_aero_convproc.F90 index 3d13ed52e3..8f3b4a795e 100644 --- a/src/chemistry/modal_aero/modal_aero_convproc.F90 +++ b/src/chemistry/modal_aero/modal_aero_convproc.F90 @@ -587,6 +587,7 @@ subroutine ma_convproc_dp_intr( & call pbuf_get_field(pbuf, zm_ideep_idx, ideep) lengath = count(ideep > 0) + if (lengath > ncol) lengath = ncol ! should not happen, but force it to not be larger than ncol for safety sake fracice(:,:) = 0.0_r8 diff --git a/src/physics/cam/zm_conv_intr.F90 b/src/physics/cam/zm_conv_intr.F90 index b69f02d125..d559ce4be4 100644 --- a/src/physics/cam/zm_conv_intr.F90 +++ b/src/physics/cam/zm_conv_intr.F90 @@ -488,8 +488,8 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , & real(r8),pointer :: zm_org2d(:,:) real(r8),allocatable :: orgt_alloc(:,:), org_alloc(:,:) - real(r8) :: zm_org2d_noalloc(state%ncol,pver) - real(r8) :: orgt_noalloc(state%ncol,pver), org_noalloc(state%ncol,pver) + real(r8) :: zm_org2d_ncol(state%ncol,pver) + real(r8) :: orgt_ncol(state%ncol,pver), org_ncol(state%ncol,pver) logical :: lq(pcnst) @@ -553,7 +553,7 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , & allocate(zm_org2d(pcols,pver)) allocate(org_alloc(ncol,pver)) allocate(orgt_alloc(ncol,pver)) - org_noalloc(:ncol,:) = state%q(1:ncol,:,ixorg) + org_ncol(:ncol,:) = state%q(1:ncol,:,ixorg) endif !REMOVECAM - no longer need these when CAM is retired and pcols no longer exists @@ -595,16 +595,17 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , & mu(:ncol,:), md(:ncol,:), du(:ncol,:), eu(:ncol,:), ed(:ncol,:), & dp(:ncol,:), dsubcld(:ncol), jt(:ncol), maxg(:ncol), ideep(:ncol), & ql(:ncol,:), rliq(:ncol), landfrac(:ncol), & - org_noalloc(:,:), orgt_noalloc(:,:), zm_org2d_noalloc(:,:), & + org_ncol(:,:), orgt_ncol(:,:), zm_org2d_ncol(:,:), & dif(:ncol,:), dnlf(:ncol,:), dnif(:ncol,:), & rice(:ncol), errmsg, errflg) if (zmconv_org) then - ptend_loc%q(:,:,ixorg)=orgt_noalloc(:ncol,:) - zm_org2d(:ncol,:) = zm_org2d_noalloc(:ncol,:) + ptend_loc%q(:,:,ixorg)=orgt_ncol(:ncol,:) + zm_org2d(:ncol,:) = zm_org2d_ncol(:ncol,:) endif lengath = count(ideep > 0) + if (lengath > ncol) lengath = ncol ! should not happen, but force it to not be larger than ncol for safety sake call outfld('CAPE', cape, pcols, lchnk) ! RBN - CAPE output ! @@ -901,6 +902,7 @@ subroutine zm_conv_tend_2( state, ptend, ztodt, pbuf) nstep = get_nstep() lengath = count(ideep > 0) + if (lengath > ncol) lengath = ncol ! should not happen, but force it to not be larger than ncol for safety sake if (any(ptend%lq(:))) then ! initialize dpdry for call to convtran From f2dae331c1ab706a3f0ca0973ebfa605b3743b8d Mon Sep 17 00:00:00 2001 From: Cheryl Craig Date: Fri, 19 Jan 2024 15:27:33 -0700 Subject: [PATCH 205/291] Remove CAM3 test since no longer supported --- cime_config/testdefs/testlist_cam.xml | 10 ---------- 1 file changed, 10 deletions(-) diff --git a/cime_config/testdefs/testlist_cam.xml b/cime_config/testdefs/testlist_cam.xml index 8fcb4e0a6f..384387edc2 100644 --- a/cime_config/testdefs/testlist_cam.xml +++ b/cime_config/testdefs/testlist_cam.xml @@ -329,16 +329,6 @@ - - - - - - - - - - From 6319c77344c79f6ec393dbc4dfc8bb27612624f5 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Tue, 23 Jan 2024 09:40:11 -0700 Subject: [PATCH 206/291] Remove unnecessary changes made for GEOS-Chem; minor bug fix for GNU Signed-off-by: Lizzie Lundgren --- bld/build-namelist | 4 ---- bld/namelist_files/namelist_definition.xml | 2 +- cime_config/config_component.xml | 2 -- src/chemistry/geoschem/chemistry.F90 | 6 +++--- 4 files changed, 4 insertions(+), 10 deletions(-) diff --git a/bld/build-namelist b/bld/build-namelist index 48fdd72a73..1440069dd2 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -583,10 +583,6 @@ if ( ($chem ne 'none') or ( $prog_species ) ){ add_default($nl, 'gas_wetdep_list', 'val'=>$gas_wetdep_list ); } - if ($chem =~ /geoschem/) { - $prescribe_aerosols = $FALSE; - } - if (length($aer_wetdep_list)>2){ # determine if prescribed aerosols are not needed ... if ($aer_wetdep_list =~ /so4/i && diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index ebf84d5788..d7fab81ada 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -6028,7 +6028,7 @@ radiatively passive. Default: FALSE - Wet deposition method used MOZ --> mozart scheme is used diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index 9f8e3a5698..21d3ec6d4b 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -50,7 +50,6 @@ CAM super-parameterized CAM one moment SAM microphysics CAM super-parameterized CAM one moment SAM microphysics using CLUBB CAM super-parameterized CAM double moment m2005 SAM microphysics - CAM super-parameterized CAM double moment m2005 SAM microphysics using GEOS-Chem CAM super-parameterized CAM double moment m2005 SAM microphysics using CLUBB CAM tropospheric chemistry with bulk aerosols: @@ -83,7 +82,6 @@ CAM moist Held-Suarez forcing (Thatcher and Jablonowski, 2016): CAM moist simple model (Frierson, 2006): CAM dry Held-Suarez forcing (Held and Suarez (1994)): - CAM with GEOS-Chem dycore test: CAM moist dynamical core test with Ullrich et al. (2014) baroclinic wave IC, Kessler physics and terminator chemistry: diff --git a/src/dynamics/se/dp_coupling.F90 b/src/dynamics/se/dp_coupling.F90 index 61b7fc54e9..68f92a6400 100644 --- a/src/dynamics/se/dp_coupling.F90 +++ b/src/dynamics/se/dp_coupling.F90 @@ -1,3 +1,4 @@ +!#define old_cam module dp_coupling !------------------------------------------------------------------------------- @@ -54,7 +55,11 @@ subroutine d_p_coupling(phys_state, phys_tend, pbuf2d, dyn_out) use phys_control, only: use_gw_front, use_gw_front_igw use hycoef, only: hyai, ps0 use fvm_mapping, only: dyn2phys_vector, dyn2phys_all_vars +#ifdef old_cam + use time_mod, only: timelevel_qdp +#else use se_dyn_time_mod, only: timelevel_qdp +#endif use control_mod, only: qsplit use test_fvm_mapping, only: test_mapping_overwrite_dyn_state, test_mapping_output_phys_state use prim_advance_mod, only: tot_energy_dyn @@ -427,8 +432,9 @@ subroutine p_d_coupling(phys_state, phys_tend, dyn_in, tl_f, tl_qdp) !JMD hybrid = config_thread_region(par,'horizontal') hybrid = config_thread_region(par,'serial') call get_loop_ranges(hybrid,ibeg=nets,iend=nete) - - ! high-order mapping of ft and fm (and fq if no cslam) using fvm technology + ! + ! high-order mapping of ft and fm using fvm technology + ! call t_startf('phys2dyn') call phys2dyn_forcings_fvm(elem, dyn_in%fvm, hybrid,nets,nete,ntrac==0, tl_f, tl_qdp) call t_stopf('phys2dyn') @@ -474,19 +480,20 @@ subroutine p_d_coupling(phys_state, phys_tend, dyn_in, tl_f, tl_qdp) dyn_in%elem(ie)%derived%FT(:,:,k) = & dyn_in%elem(ie)%derived%FT(:,:,k) * & dyn_in%elem(ie)%spheremp(:,:) - do m = 1, qsize - dyn_in%elem(ie)%derived%FQ(:,:,k,m) = & - dyn_in%elem(ie)%derived%FQ(:,:,k,m) * & - dyn_in%elem(ie)%spheremp(:,:) - end do end do end if kptr = 0 call edgeVpack(edgebuf, dyn_in%elem(ie)%derived%FM(:,:,:,:), 2*nlev, kptr, ie) kptr = kptr + 2*nlev call edgeVpack(edgebuf, dyn_in%elem(ie)%derived%FT(:,:,:), nlev, kptr, ie) - kptr = kptr + nlev - call edgeVpack(edgebuf, dyn_in%elem(ie)%derived%FQ(:,:,:,:), nlev*qsize, kptr, ie) + if (fv_nphys < 1) then + ! + ! if using CSLAM qdp is being overwritten with CSLAM values in the dynamics + ! so no need to do boundary exchange of tracer tendency on GLL grid here + ! + kptr = kptr + nlev + call edgeVpack(edgebuf, dyn_in%elem(ie)%derived%FQ(:,:,:,:), nlev*qsize, kptr, ie) + end if end do if (iam < par%nprocs) then @@ -499,7 +506,9 @@ subroutine p_d_coupling(phys_state, phys_tend, dyn_in, tl_f, tl_qdp) kptr = kptr + 2*nlev call edgeVunpack(edgebuf, dyn_in%elem(ie)%derived%FT(:,:,:), nlev, kptr, ie) kptr = kptr + nlev - call edgeVunpack(edgebuf, dyn_in%elem(ie)%derived%FQ(:,:,:,:), nlev*qsize, kptr, ie) + if (fv_nphys < 1) then + call edgeVunpack(edgebuf, dyn_in%elem(ie)%derived%FQ(:,:,:,:), nlev*qsize, kptr, ie) + end if if (fv_nphys > 0) then do k = 1, nlev dyn_in%elem(ie)%derived%FM(:,:,1,k) = & @@ -511,11 +520,6 @@ subroutine p_d_coupling(phys_state, phys_tend, dyn_in, tl_f, tl_qdp) dyn_in%elem(ie)%derived%FT(:,:,k) = & dyn_in%elem(ie)%derived%FT(:,:,k) * & dyn_in%elem(ie)%rspheremp(:,:) - do m = 1, qsize - dyn_in%elem(ie)%derived%FQ(:,:,k,m) = & - dyn_in%elem(ie)%derived%FQ(:,:,k,m) * & - dyn_in%elem(ie)%rspheremp(:,:) - end do end do end if end do @@ -546,7 +550,9 @@ subroutine derived_phys_dry(phys_state, phys_tend, pbuf2d) use shr_const_mod, only: shr_const_rwv use phys_control, only: waccmx_is use geopotential, only: geopotential_t +#ifndef old_cam use static_energy, only: update_dry_static_energy_run +#endif use check_energy, only: check_energy_timestep_init use hycoef, only: hyai, ps0 use shr_vmath_mod, only: shr_vmath_log @@ -696,14 +702,21 @@ subroutine derived_phys_dry(phys_state, phys_tend, pbuf2d) phys_state(lchnk)%pmid , phys_state(lchnk)%pdel , phys_state(lchnk)%rpdel , & phys_state(lchnk)%t , phys_state(lchnk)%q(:,:,:), rairv(:,:,lchnk), gravit, zvirv , & phys_state(lchnk)%zi , phys_state(lchnk)%zm , ncol) - +#ifdef old_cam + do k = 1, pver + do i = 1, ncol + phys_state(lchnk)%s(i,k) = cpairv(i,k,lchnk)*phys_state(lchnk)%t(i,k) & + + gravit*phys_state(lchnk)%zm(i,k) + phys_state(lchnk)%phis(i) + end do + end do +#else ! Compute initial dry static energy, include surface geopotential call update_dry_static_energy_run(pver, gravit, phys_state(lchnk)%t(1:ncol,:), & phys_state(lchnk)%zm(1:ncol,:), & phys_state(lchnk)%phis(1:ncol), & phys_state(lchnk)%s(1:ncol,:), & cpairv(1:ncol,:,lchnk), errflg, errmsg) - +#endif ! Ensure tracers are all positive call qneg3('D_P_COUPLING',lchnk ,ncol ,pcols ,pver , & 1, pcnst, qmin ,phys_state(lchnk)%q) diff --git a/src/dynamics/se/dycore/control_mod.F90 b/src/dynamics/se/dycore/control_mod.F90 index 053f478c6a..6d92e66d7d 100644 --- a/src/dynamics/se/dycore/control_mod.F90 +++ b/src/dynamics/se/dycore/control_mod.F90 @@ -16,6 +16,7 @@ module control_mod integer, public :: rk_stage_user = 0 ! number of RK stages to use integer, public :: ftype = 2 ! Forcing Type integer, public :: ftype_conserve = 1 !conserve momentum (dp*u) + integer, public :: dribble_in_rsplit_loop = 0 integer, public :: statediag_numtrac = 3 integer, public :: qsplit = 1 ! ratio of dynamics tsteps to tracer tsteps diff --git a/src/dynamics/se/dycore/fvm_control_volume_mod.F90 b/src/dynamics/se/dycore/fvm_control_volume_mod.F90 index c1b3c6fc15..e3208c86cd 100644 --- a/src/dynamics/se/dycore/fvm_control_volume_mod.F90 +++ b/src/dynamics/se/dycore/fvm_control_volume_mod.F90 @@ -128,7 +128,6 @@ module fvm_control_volume_mod ! !****************************************** ! - real (kind=r8) , allocatable :: phis_physgrid(:,:) real (kind=r8) , allocatable :: vtx_cart_physgrid(:,:,:,:) real (kind=r8) , allocatable :: flux_orient_physgrid(:,:,:) integer , allocatable :: ifct_physgrid(:,:) @@ -280,7 +279,6 @@ subroutine allocate_physgrid_vars(fvm,par) end if do ie=1,nelemd - allocate(fvm(ie)%phis_physgrid (fv_nphys,fv_nphys)) allocate(fvm(ie)%vtx_cart_physgrid (4,2,1-nhc_phys:fv_nphys+nhc_phys,1-nhc_phys:fv_nphys+nhc_phys)) allocate(fvm(ie)%flux_orient_physgrid (2,1-nhc_phys:fv_nphys+nhc_phys,1-nhc_phys:fv_nphys+nhc_phys)) allocate(fvm(ie)%ifct_physgrid (1-nhc_phys:fv_nphys+nhc_phys,1-nhc_phys:fv_nphys+nhc_phys)) diff --git a/src/dynamics/se/dycore/fvm_mapping.F90 b/src/dynamics/se/dycore/fvm_mapping.F90 index f52d961be5..98afd40f2a 100644 --- a/src/dynamics/se/dycore/fvm_mapping.F90 +++ b/src/dynamics/se/dycore/fvm_mapping.F90 @@ -1,3 +1,4 @@ +!#define old_cam ! ! pg3->GLL and GLL->pg3 mapping algorithm described in: ! @@ -24,7 +25,7 @@ module fvm_mapping private public :: phys2dyn_forcings_fvm, dyn2phys, dyn2phys_vector, dyn2phys_all_vars,dyn2fvm_mass_vars - public :: phys2dyn,fvm2dyn,dyn2fvm + public :: phys2dyn,fvm2dyn,dyn2fvm,cslam2gll save integer :: save_max_overlap real(kind=r8), allocatable, dimension(:,:,:,:,:) :: save_air_mass_overlap @@ -58,8 +59,7 @@ subroutine phys2dyn_forcings_fvm(elem, fvm, hybrid,nets,nete,no_cslam, tl_f, tl_ integer, intent(in) :: nets, nete, tl_f, tl_qdp integer :: ie,i,j,k,m_cnst,nq - real (kind=r8), dimension(:,:,:,:,:) , allocatable :: fld_phys, fld_gll, fld_fvm - real (kind=r8), allocatable, dimension(:,:,:,:,:) :: qgll + real (kind=r8), dimension(:,:,:,:,:) , allocatable :: fld_phys, fld_gll real (kind=r8) :: element_ave ! ! for tensor product Lagrange interpolation @@ -67,14 +67,6 @@ subroutine phys2dyn_forcings_fvm(elem, fvm, hybrid,nets,nete,no_cslam, tl_f, tl_ integer :: nflds logical, allocatable :: llimiter(:) - allocate(qgll(np,np,nlev,thermodynamic_active_species_num,nets:nete)) - - do ie=nets,nete - do nq=1,thermodynamic_active_species_num - qgll(:,:,:,nq,ie) = elem(ie)%state%Qdp(:,:,:,nq,tl_qdp)/elem(ie)%state%dp3d(:,:,:,tl_f) - end do - end do - if (no_cslam) then call endrun("phys2dyn_forcings_fvm: no cslam case: NOT SUPPORTED") else if (nc.ne.fv_nphys) then @@ -113,7 +105,7 @@ subroutine phys2dyn_forcings_fvm(elem, fvm, hybrid,nets,nete,no_cslam, tl_f, tl_ ! ! do mapping of fu,fv,ft ! - call phys2dyn(hybrid,elem,fld_phys(:,:,:,1:3,:),fld_gll(:,:,:,1:3,:),nets,nete,nlev,3,fvm,llimiter(1:3),2,.true.) + call phys2dyn(hybrid,elem,fld_phys(:,:,:,1:3,:),fld_gll(:,:,:,:,:),nets,nete,nlev,3,fvm,llimiter(1:),2,.true.) do ie=nets,nete elem(ie)%derived%fT(:,:,:) = fld_gll(:,:,:,1,ie) elem(ie)%derived%fM(:,:,1,:) = fld_gll(:,:,:,2,ie) @@ -134,38 +126,7 @@ subroutine phys2dyn_forcings_fvm(elem, fvm, hybrid,nets,nete,no_cslam, tl_f, tl_ end do end do call t_stopf('p2d-pg2:phys2fvm') - - ! - ! overwrite SE Q with cslam Q - ! - nflds = thermodynamic_active_species_num - allocate(fld_gll(np,np,nlev,nflds,nets:nete)) - allocate(fld_fvm(1-nhc:nc+nhc,1-nhc:nc+nhc,nlev,nflds,nets:nete)) - do ie=nets,nete - ! - ! compute cslam updated Q value - do m_cnst=1,thermodynamic_active_species_num - fld_fvm(1:nc,1:nc,:,m_cnst,ie) = fvm(ie)%c(1:nc,1:nc,:,thermodynamic_active_species_idx(m_cnst))+& - fvm(ie)%fc(1:nc,1:nc,:,thermodynamic_active_species_idx(m_cnst))/fvm(ie)%dp_fvm(1:nc,1:nc,:) - enddo - end do - call t_startf('p2d-pg2:fvm2dyn') - llimiter(1:nflds) = .false. - call fvm2dyn(fld_fvm,fld_gll(:,:,:,1:nflds,:),hybrid,nets,nete,nlev,nflds,fvm,llimiter(1:nflds)) - call t_stopf('p2d-pg2:fvm2dyn') - ! - ! fld_gll now holds q cslam value on gll grid - ! - ! convert fld_gll to increment (q_new-q_old) - ! - do ie=nets,nete - do m_cnst=1,thermodynamic_active_species_num - elem(ie)%derived%fq(:,:,:,m_cnst) =& - fld_gll(:,:,:,m_cnst,ie)-qgll(:,:,:,m_cnst,ie) - end do - end do - deallocate(fld_fvm) - !deallocate arrays allocated in dyn2phys_all_vars + !deallocate arrays allocated in dyn2phys_all_vars deallocate(save_air_mass_overlap,save_q_phys,save_q_overlap,& save_overlap_area,save_num_overlap,save_overlap_idx,save_dp_phys) else @@ -178,7 +139,7 @@ subroutine phys2dyn_forcings_fvm(elem, fvm, hybrid,nets,nete,no_cslam, tl_f, tl_ !***************************************************************************************** ! ! nflds is ft, fu, fv, + thermo species - nflds = 3+thermodynamic_active_species_num + nflds = 3 allocate(fld_phys(1-nhc_phys:fv_nphys+nhc_phys,1-nhc_phys:fv_nphys+nhc_phys,nlev,nflds,nets:nete)) allocate(fld_gll(np,np,nlev,nflds,nets:nete)) allocate(llimiter(nflds)) @@ -190,18 +151,8 @@ subroutine phys2dyn_forcings_fvm(elem, fvm, hybrid,nets,nete,no_cslam, tl_f, tl_ fld_phys(1:fv_nphys,1:fv_nphys,:,1,ie) = fvm(ie)%ft(1:fv_nphys,1:fv_nphys,:) fld_phys(1:fv_nphys,1:fv_nphys,:,2,ie) = fvm(ie)%fm(1:fv_nphys,1:fv_nphys,1,:) fld_phys(1:fv_nphys,1:fv_nphys,:,3,ie) = fvm(ie)%fm(1:fv_nphys,1:fv_nphys,2,:) - ! - ! compute cslam mixing ratio with physics update - ! - do m_cnst=1,thermodynamic_active_species_num - do k=1,nlev - fld_phys(1:fv_nphys,1:fv_nphys,k,m_cnst+3,ie) = & - fvm(ie)%c(1:fv_nphys,1:fv_nphys,k,thermodynamic_active_species_idx(m_cnst))+& - fvm(ie)%fc_phys(1:fv_nphys,1:fv_nphys,k,thermodynamic_active_species_idx(m_cnst)) - end do - end do - end do - ! + end do + ! ! do mapping ! call phys2dyn(hybrid,elem,fld_phys,fld_gll,nets,nete,nlev,nflds,fvm,llimiter,2) @@ -210,24 +161,18 @@ subroutine phys2dyn_forcings_fvm(elem, fvm, hybrid,nets,nete,no_cslam, tl_f, tl_ elem(ie)%derived%fM(:,:,1,:) = fld_gll(:,:,:,2,ie) elem(ie)%derived%fM(:,:,2,:) = fld_gll(:,:,:,3,ie) end do + deallocate(fld_gll) do ie=nets,nete - do m_cnst=1,thermodynamic_active_species_num - ! - ! convert fq so that it will effectively overwrite SE q with CSLAM q - ! - elem(ie)%derived%fq(:,:,:,m_cnst) = fld_gll(:,:,:,m_cnst+3,ie)-& - qgll(:,:,:,m_cnst,ie) - end do do m_cnst = 1,ntrac fvm(ie)%fc(1:nc,1:nc,:,m_cnst) = fvm(ie)%fc_phys(1:nc,1:nc,:,m_cnst)*fvm(ie)%dp_fvm(1:nc,1:nc,:) end do end do end if - deallocate(fld_phys,llimiter,fld_gll,qgll) + deallocate(fld_phys,llimiter) end subroutine phys2dyn_forcings_fvm ! for multiple fields - subroutine fvm2dyntn(fld_fvm,fld_gll,hybrid,nets,nete,numlev,num_flds,fvm,llimiter) + subroutine fvm2dyntn(fld_fvm,fld_gll,hybrid,nets,nete,numlev,num_flds,fvm,llimiter,halo_filled) use dimensions_mod, only: np, nhc, nc use hybrid_mod , only: hybrid_t use bndry_mod , only: ghost_exchange @@ -240,7 +185,10 @@ subroutine fvm2dyntn(fld_fvm,fld_gll,hybrid,nets,nete,numlev,num_flds,fvm,llimit type (hybrid_t) , intent(in) :: hybrid type(fvm_struct) , intent(in) :: fvm(nets:nete) logical , intent(in) :: llimiter(num_flds) + logical, optional , intent(in) :: halo_filled + integer :: ie, iwidth + logical :: fill_halo ! !********************************************* ! @@ -248,13 +196,22 @@ subroutine fvm2dyntn(fld_fvm,fld_gll,hybrid,nets,nete,numlev,num_flds,fvm,llimit ! !********************************************* ! - do ie=nets,nete - call ghostpack(ghostBufQnhc_s, fld_fvm(:,:,:,:,ie),numlev*num_flds,0,ie) - end do - call ghost_exchange(hybrid,ghostbufQnhc_s,location='fvm2dyntn') - do ie=nets,nete - call ghostunpack(ghostbufQnhc_s, fld_fvm(:,:,:,:,ie),numlev*num_flds,0,ie) - end do + fill_halo = .false. + if (present(halo_filled)) then + if (.not.halo_filled) fill_halo = .true. + else + fill_halo = .true. + end if + + if (fill_halo) then + do ie=nets,nete + call ghostpack(ghostBufQnhc_s, fld_fvm(:,:,:,:,ie),numlev*num_flds,0,ie) + end do + call ghost_exchange(hybrid,ghostbufQnhc_s,location='fvm2dyntn') + do ie=nets,nete + call ghostunpack(ghostbufQnhc_s, fld_fvm(:,:,:,:,ie),numlev*num_flds,0,ie) + end do + end if ! ! mapping ! @@ -267,7 +224,7 @@ subroutine fvm2dyntn(fld_fvm,fld_gll,hybrid,nets,nete,numlev,num_flds,fvm,llimit end subroutine fvm2dyntn ! for single field - subroutine fvm2dynt1(fld_fvm,fld_gll,hybrid,nets,nete,numlev,fvm,llimiter) + subroutine fvm2dynt1(fld_fvm,fld_gll,hybrid,nets,nete,numlev,fvm,llimiter,halo_filled) use dimensions_mod, only: np, nhc, nc use hybrid_mod , only: hybrid_t use bndry_mod , only: ghost_exchange @@ -280,7 +237,10 @@ subroutine fvm2dynt1(fld_fvm,fld_gll,hybrid,nets,nete,numlev,fvm,llimiter) type (hybrid_t) , intent(in) :: hybrid type(fvm_struct) , intent(in) :: fvm(nets:nete) logical , intent(in) :: llimiter(1) + logical, optional , intent(in) :: halo_filled + integer :: ie, iwidth + logical :: fill_halo ! !********************************************* ! @@ -288,13 +248,22 @@ subroutine fvm2dynt1(fld_fvm,fld_gll,hybrid,nets,nete,numlev,fvm,llimiter) ! !********************************************* ! - do ie=nets,nete - call ghostpack(ghostBufQnhc_t1, fld_fvm(:,:,:,1,ie),numlev,0,ie) - end do - call ghost_exchange(hybrid,ghostbufQnhc_t1,location='fvm2dynt1') - do ie=nets,nete - call ghostunpack(ghostbufQnhc_t1, fld_fvm(:,:,:,1,ie),numlev,0,ie) - end do + fill_halo = .false. + if (present(halo_filled)) then + if (.not.halo_filled) fill_halo = .true. + else + fill_halo = .true. + end if + + if (fill_halo) then + do ie=nets,nete + call ghostpack(ghostBufQnhc_t1, fld_fvm(:,:,:,1,ie),numlev,0,ie) + end do + call ghost_exchange(hybrid,ghostbufQnhc_t1,location='fvm2dynt1') + do ie=nets,nete + call ghostunpack(ghostbufQnhc_t1, fld_fvm(:,:,:,1,ie),numlev,0,ie) + end do + end if ! ! mapping ! @@ -305,7 +274,6 @@ subroutine fvm2dynt1(fld_fvm,fld_gll,hybrid,nets,nete,numlev,fvm,llimiter) end do end subroutine fvm2dynt1 - subroutine fill_halo_phys(fld_phys,hybrid,nets,nete,num_lev,num_flds) use dimensions_mod, only: nhc_phys, fv_nphys use hybrid_mod , only: hybrid_t @@ -503,7 +471,6 @@ subroutine dyn2phys_all_vars(nets,nete,elem,fvm,& do k=1,nlev inv_darea_dp_fvm = dyn2fvm(elem(ie)%state%dp3d(:,:,k,tl),elem(ie)%metdet(:,:)) inv_darea_dp_fvm = 1.0_r8/inv_darea_dp_fvm - T_phys(:,k,ie) = RESHAPE(dyn2phys(elem(ie)%state%T(:,:,k,tl),elem(ie)%metdet(:,:),inv_area),SHAPE(T_phys(:,k,ie))) Omega_phys(:,k,ie) = RESHAPE(dyn2phys(elem(ie)%derived%omega(:,:,k),elem(ie)%metdet(:,:),inv_area), & SHAPE(Omega_phys(:,k,ie))) @@ -1318,5 +1285,64 @@ subroutine get_q_overlap_save(ie,k,fvm,q_fvm,num_trac,q_phys) end do end subroutine get_q_overlap_save + subroutine cslam2gll(elem, fvm, hybrid,nets,nete, tl_f, tl_qdp) + use dimensions_mod, only: nc,nlev,np,nhc + use hybrid_mod, only: hybrid_t + use air_composition, only: thermodynamic_active_species_num, thermodynamic_active_species_idx + use fvm_mod, only: ghostBuf_cslam2gll + use bndry_mod, only: ghost_exchange + use edge_mod, only: ghostpack,ghostunpack + + type (element_t), intent(inout):: elem(:) + type(fvm_struct), intent(inout):: fvm(:) + type (hybrid_t), intent(in) :: hybrid ! distributed parallel structure (shared) + integer, intent(in) :: nets, nete, tl_f, tl_qdp + + integer :: ie,i,j,k,m_cnst,nq + real (kind=r8), dimension(:,:,:,:,:) , allocatable :: fld_fvm, fld_gll + ! + ! for tensor product Lagrange interpolation + ! + integer :: nflds + logical, allocatable :: llimiter(:) + call t_startf('cslam2gll') + nflds = thermodynamic_active_species_num + allocate(fld_fvm(1-nhc:nc+nhc,1-nhc:nc+nhc,nlev,nflds,nets:nete)) + allocate(fld_gll(np,np,nlev,thermodynamic_active_species_num,nets:nete)) + allocate(llimiter(nflds)) + llimiter(1:nflds) = .false. + do ie=nets,nete + do m_cnst=1,thermodynamic_active_species_num + do k=1,nlev + fld_fvm(1:nc,1:nc,k,m_cnst,ie) = & + fvm(ie)%c(1:nc,1:nc,k,thermodynamic_active_species_idx(m_cnst)) + end do + end do + end do + call t_startf('fvm:fill_halo_cslam2gll') + do ie=nets,nete + call ghostpack(ghostBuf_cslam2gll, fld_fvm(:,:,:,:,ie),nlev*nflds,0,ie) + end do + + call ghost_exchange(hybrid,ghostBuf_cslam2gll,location='cslam2gll') + + do ie=nets,nete + call ghostunpack(ghostBuf_cslam2gll, fld_fvm(:,:,:,:,ie),nlev*nflds,0,ie) + end do + call t_stopf('fvm:fill_halo_cslam2gll') + ! + ! do mapping + ! + call fvm2dyn(fld_fvm,fld_gll,hybrid,nets,nete,nlev,nflds,fvm,llimiter,halo_filled=.true.) + + do ie=nets,nete + do m_cnst=1,thermodynamic_active_species_num + elem(ie)%state%qdp(:,:,:,m_cnst,tl_qdp) = fld_gll(:,:,:,m_cnst,ie)*& + elem(ie)%state%dp3d(:,:,:,tl_f) + end do + end do + deallocate(fld_fvm,llimiter) + call t_stopf('cslam2gll') + end subroutine cslam2gll end module fvm_mapping diff --git a/src/dynamics/se/dycore/fvm_mod.F90 b/src/dynamics/se/dycore/fvm_mod.F90 index 309a101ba2..2ce7f502b1 100644 --- a/src/dynamics/se/dycore/fvm_mod.F90 +++ b/src/dynamics/se/dycore/fvm_mod.F90 @@ -1,3 +1,4 @@ +!#define old_cam #define FVM_TIMERS .FALSE. !-----------------------------------------------------------------------------! !MODULE FVM_MOD-----------------------------------------------------CE-for FVM! @@ -36,6 +37,7 @@ module fvm_mod type (EdgeBuffer_t), public :: ghostBufQnhcJet_h type (EdgeBuffer_t), public :: ghostBufFluxJet_h type (EdgeBuffer_t), public :: ghostBufPG_s + type (EdgeBuffer_t), public :: ghostBuf_cslam2gll interface fill_halo_fvm module procedure fill_halo_fvm_noprealloc @@ -496,13 +498,14 @@ subroutine fvm_init2(elem,fvm,hybrid,nets,nete) call initghostbuffer(hybrid%par,ghostBufQ1_vh,elem,klev*(ntrac+1),1,nc,nthreads=vert_num_threads*horz_num_threads) ! call initghostbuffer(hybrid%par,ghostBufFlux_h,elem,4*nlev,nhe,nc,nthreads=horz_num_threads) call initghostbuffer(hybrid%par,ghostBufFlux_vh,elem,4*nlev,nhe,nc,nthreads=vert_num_threads*horz_num_threads) + call initghostbuffer(hybrid%par,ghostBuf_cslam2gll,elem,nlev*thermodynamic_active_species_num,nhc,nc,nthreads=1) ! ! preallocate buffers for physics-dynamics coupling ! if (fv_nphys.ne.nc) then call initghostbuffer(hybrid%par,ghostBufPG_s,elem,nlev*(4+ntrac),nhc_phys,fv_nphys,nthreads=1) else - call initghostbuffer(hybrid%par,ghostBufPG_s,elem,nlev*(3+thermodynamic_active_species_num),nhc_phys,fv_nphys,nthreads=1) + call initghostbuffer(hybrid%par,ghostBufPG_s,elem,nlev*3,nhc_phys,fv_nphys,nthreads=1) end if if (fvm_supercycling.ne.fvm_supercycling_jet) then diff --git a/src/dynamics/se/dycore/fvm_reconstruction_mod.F90 b/src/dynamics/se/dycore/fvm_reconstruction_mod.F90 index b7310ad477..da0a8fc664 100644 --- a/src/dynamics/se/dycore/fvm_reconstruction_mod.F90 +++ b/src/dynamics/se/dycore/fvm_reconstruction_mod.F90 @@ -105,7 +105,7 @@ subroutine reconstruction(fcube,nlev_in,k_in,recons,irecons,llimiter,ntrac_in,& if(FVM_TIMERS) call t_startf('FVM:reconstruction:part#1') if (nhe>0) then do itr=1,ntrac_in - ! f=-9e9_r8 + !f=-9e9_r8 call extend_panel_interpolate(nc,nhc,nhr,nht,ns,nh,& fcube(:,:,k_in,itr),cubeboundary,halo_interp_weight,ibase,f(:,:,1),f(:,:,2:3)) call get_gradients(f(:,:,:),jx,jy,irecons,recons(:,:,:,itr),& @@ -113,8 +113,8 @@ subroutine reconstruction(fcube,nlev_in,k_in,recons,irecons,llimiter,ntrac_in,& end do else do itr=1,ntrac_in - ! f=-9e9_r8!to avoid floating point exception for uninitialized variables - ! !in non-existent cells (corners of cube) + !to avoid floating point exception for uninitialized variables !xxx + !in non-existent cells (corners of cube) call extend_panel_interpolate(nc,nhc,nhr,nht,ns,nh,& fcube(:,:,k_in,itr),cubeboundary,halo_interp_weight,ibase,f(:,:,1)) call get_gradients(f(:,:,:),jx,jy,irecons,recons(:,:,:,itr),& diff --git a/src/dynamics/se/dycore/global_norms_mod.F90 b/src/dynamics/se/dycore/global_norms_mod.F90 index 17e773d99c..6e08b64634 100644 --- a/src/dynamics/se/dycore/global_norms_mod.F90 +++ b/src/dynamics/se/dycore/global_norms_mod.F90 @@ -1,3 +1,4 @@ +!#define old_cam module global_norms_mod use shr_kind_mod, only: r8=>shr_kind_r8 @@ -577,7 +578,7 @@ subroutine print_cfl(elem,hybrid,nets,nete,dtnu,ptop,pmid,& deallocate(gp%weights) call automatically_set_viscosity_coefficients(hybrid,ne,max_min_dx,min_min_dx,nu_p ,1.0_r8 ,'_p ') - call automatically_set_viscosity_coefficients(hybrid,ne,max_min_dx,min_min_dx,nu ,0.5_r8,' ') + call automatically_set_viscosity_coefficients(hybrid,ne,max_min_dx,min_min_dx,nu ,1.0_r8,' ') call automatically_set_viscosity_coefficients(hybrid,ne,max_min_dx,min_min_dx,nu_div,2.5_r8 ,'_div') if (nu_q<0) nu_q = nu_p ! necessary for consistency @@ -600,12 +601,12 @@ subroutine print_cfl(elem,hybrid,nets,nete,dtnu,ptop,pmid,& lev_set = sponge_del4_lev < 0 if (ptop>1000.0_r8) then ! - ! low top (~1000 Pa) + ! low top (~10 Pa) ! top_000_032km = .true. else if (ptop>100.0_r8) then ! - ! CAM6 top (~225 Pa) + ! CAM6 top (~225 Pa) or CAM7 low top ! top_032_042km = .true. else if (ptop>1e-1_r8) then @@ -634,28 +635,38 @@ subroutine print_cfl(elem,hybrid,nets,nete,dtnu,ptop,pmid,& ! ! if user or namelist is not specifying sponge del4 settings here are best guesses (empirically determined) ! + umax = 0.0_r8 if (top_000_032km) then + umax = 120._r8 if (sponge_del4_lev <0) sponge_del4_lev = 1 if (sponge_del4_nu_fac <0) sponge_del4_nu_fac = 1.0_r8 if (sponge_del4_nu_div_fac<0) sponge_del4_nu_div_fac = 1.0_r8 end if - if (top_032_042km) then - if (sponge_del4_lev <0) sponge_del4_lev = 3 + if (top_032_042km) then + umax = 120._r8 + if (sponge_del4_lev <0) sponge_del4_lev = 1 if (sponge_del4_nu_fac <0) sponge_del4_nu_fac = 1.0_r8 - if (sponge_del4_nu_div_fac<0) sponge_del4_nu_div_fac = 4.5_r8 + if (sponge_del4_nu_div_fac<0) sponge_del4_nu_div_fac = 1.0_r8 end if if (top_042_090km) then - if (sponge_del4_lev <0) sponge_del4_lev = 3 - if (sponge_del4_nu_fac <0) sponge_del4_nu_fac = 5.0_r8 - if (sponge_del4_nu_div_fac<0) sponge_del4_nu_div_fac = 7.5_r8 + umax = 240._r8 + if (sponge_del4_lev <0) sponge_del4_lev = 1 + if (sponge_del4_nu_fac <0) sponge_del4_nu_fac = 1.0_r8 + if (sponge_del4_nu_div_fac<0) sponge_del4_nu_div_fac = 1.0_r8 end if + if (top_090_140km) then + umax = 300._r8 + end if + if (top_140_600km) then + umax = 800._r8 + end if if (top_090_140km.or.top_140_600km) then - if (sponge_del4_lev <0) sponge_del4_lev = 10 + if (sponge_del4_lev <0) sponge_del4_lev = 20 if (sponge_del4_nu_fac <0) sponge_del4_nu_fac = 5.0_r8 - if (sponge_del4_nu_div_fac<0) sponge_del4_nu_div_fac = 7.5_r8 + if (sponge_del4_nu_div_fac<0) sponge_del4_nu_div_fac = 10.0_r8 end if ! ! Log sponge layer configuration @@ -672,7 +683,6 @@ subroutine print_cfl(elem,hybrid,nets,nete,dtnu,ptop,pmid,& if (lev_set) then write(iulog, '(a,i0)') ' sponge_del4_lev = ',sponge_del4_lev end if - write(iulog,* )"" end if @@ -689,6 +699,7 @@ subroutine print_cfl(elem,hybrid,nets,nete,dtnu,ptop,pmid,& nu_t_lev(k) = (1.0_r8-scale1)*nu_p +scale1*nu_max end if end do + if (hybrid%masterthread)then write(iulog,*) "z computed from barometric formula (using US std atmosphere)" call std_atm_height(pmid(:),z(:)) @@ -696,8 +707,16 @@ subroutine print_cfl(elem,hybrid,nets,nete,dtnu,ptop,pmid,& do k=1,nlev write(iulog,'(i3,5e11.4)') k,pmid(k),z(k),nu_lev(k),nu_t_lev(k),nu_div_lev(k) end do - end if + if (nu_top>0) then + write(iulog,*) ": ksponge_end = ",ksponge_end + write(iulog,*) ": sponge layer Laplacian damping" + write(iulog,*) "k, p, z, nu_scale_top, nu (actual Laplacian damping coefficient)" + do k=1,ksponge_end + write(iulog,'(i3,4e11.4)') k,pmid(k),z(k),nu_scale_top(k),nu_scale_top(k)*nu_top + end do + end if + end if !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! @@ -732,16 +751,6 @@ subroutine print_cfl(elem,hybrid,nets,nete,dtnu,ptop,pmid,& S_laplacian = 2.0_r8 !using forward Euler for sponge diffusion S_hypervis = 2.0_r8 !using forward Euler for hyperviscosity S_rk_tracer = 2.0_r8 - ! - ! estimate max winds - ! - if (ptop>100.0_r8) then - umax = 120.0_r8 - else if (ptop>10.0_r8) then - umax = 400.0_r8 - else - umax = 800.0_r8 - end if ugw = 342.0_r8 !max gravity wave speed @@ -778,13 +787,14 @@ subroutine print_cfl(elem,hybrid,nets,nete,dtnu,ptop,pmid,& write(iulog,'(a,f10.2,a,f10.2,a)') '* dt_dyn_vis (hyperviscosity) ; u,v,T,dM) < ',dt_max_hypervis,& 's ',dt_dyn_visco_actual,'s' if (dt_dyn_visco_actual>dt_max_hypervis) write(iulog,*) 'WARNING: dt_dyn_vis theoretically unstable' - write(iulog,'(a,f10.2,a,f10.2,a)') '* dt_tracer_se (time-stepping tracers ; q ) < ',dt_max_tracer_se,'s ',& + if (.not.use_cslam) then + write(iulog,'(a,f10.2,a,f10.2,a)') '* dt_tracer_se (time-stepping tracers ; q ) < ',dt_max_tracer_se,'s ',& dt_tracer_se_actual,'s' - if (dt_tracer_se_actual>dt_max_tracer_se) write(iulog,*) 'WARNING: dt_tracer_se theoretically unstable' - write(iulog,'(a,f10.2,a,f10.2,a)') '* dt_tracer_vis (hyperviscosity tracers; q ) < ',dt_max_hypervis_tracer,'s',& - dt_tracer_visco_actual,'s' - if (dt_tracer_visco_actual>dt_max_hypervis_tracer) write(iulog,*) 'WARNING: dt_tracer_hypervis theoretically unstable' - + if (dt_tracer_se_actual>dt_max_tracer_se) write(iulog,*) 'WARNING: dt_tracer_se theoretically unstable' + write(iulog,'(a,f10.2,a,f10.2,a)') '* dt_tracer_vis (hyperviscosity tracers; q ) < ',dt_max_hypervis_tracer,'s',& + dt_tracer_visco_actual,'s' + if (dt_tracer_visco_actual>dt_max_hypervis_tracer) write(iulog,*) 'WARNING: dt_tracer_hypervis theoretically unstable' + end if if (use_cslam) then write(iulog,'(a,f10.2,a,f10.2,a)') '* dt_tracer_fvm (time-stepping tracers ; q ) < ',dt_max_tracer_fvm,& 's ',dt_tracer_fvm_actual diff --git a/src/dynamics/se/dycore/prim_advance_mod.F90 b/src/dynamics/se/dycore/prim_advance_mod.F90 index ed7a627ec4..096bfc6532 100644 --- a/src/dynamics/se/dycore/prim_advance_mod.F90 +++ b/src/dynamics/se/dycore/prim_advance_mod.F90 @@ -1,3 +1,4 @@ +!#define old_cam module prim_advance_mod use shr_kind_mod, only: r8=>shr_kind_r8 use edgetype_mod, only: EdgeBuffer_t @@ -14,7 +15,6 @@ module prim_advance_mod type (EdgeBuffer_t) :: edge3,edgeOmega,edgeSponge real (kind=r8), allocatable :: ur_weights(:) - contains subroutine prim_advance_init(par, elem) @@ -28,7 +28,9 @@ subroutine prim_advance_init(par, elem) integer :: i call initEdgeBuffer(par,edge3 ,elem,4*nlev ,bndry_type=HME_BNDRY_P2P, nthreads=horz_num_threads) - call initEdgeBuffer(par,edgeSponge,elem,4*ksponge_end,bndry_type=HME_BNDRY_P2P, nthreads=horz_num_threads) + if (ksponge_end>0) then + call initEdgeBuffer(par,edgeSponge,elem,4*ksponge_end,bndry_type=HME_BNDRY_P2P, nthreads=horz_num_threads) + end if call initEdgeBuffer(par,edgeOmega ,elem,nlev ,bndry_type=HME_BNDRY_P2P, nthreads=horz_num_threads) if(.not. allocated(ur_weights)) allocate(ur_weights(qsplit)) @@ -53,7 +55,11 @@ subroutine prim_advance_exp(elem, fvm, deriv, hvcoord, hybrid,dt, tl, nets, net use element_mod, only: element_t use hybvcoord_mod, only: hvcoord_t use hybrid_mod, only: hybrid_t +#ifdef old_cam + use time_mod, only: TimeLevel_t, timelevel_qdp, tevolve +#else use se_dyn_time_mod, only: TimeLevel_t, timelevel_qdp, tevolve +#endif use fvm_control_volume_mod, only: fvm_struct use cam_thermo, only: get_kappa_dry use air_composition, only: thermodynamic_active_species_num @@ -112,6 +118,7 @@ subroutine prim_advance_exp(elem, fvm, deriv, hvcoord, hybrid,dt, tl, nets, net ! ================================== ! Take timestep ! ================================== + call t_startf('prim_adv_prep') do nq=1,thermodynamic_active_species_num qidx(nq) = nq end do @@ -134,7 +141,7 @@ subroutine prim_advance_exp(elem, fvm, deriv, hvcoord, hybrid,dt, tl, nets, net do ie=nets,nete call get_kappa_dry(qwater(:,:,:,:,ie), qidx, kappa(:,:,:,ie)) end do - + call t_stopf('prim_adv_prep') dt_vis = dt @@ -280,7 +287,7 @@ subroutine applyCAMforcing(elem,fvm,np1,np1_qdp,dt_dribble,dt_phys,nets,nete,nsu real (kind=r8) :: pdel(np,np,nlev) real (kind=r8), allocatable :: ftmp_fvm(:,:,:,:,:) !diagnostics - + call t_startf('applyCAMforc') if (use_cslam) allocate(ftmp_fvm(nc,nc,nlev,ntrac,nets:nete)) if (ftype==0) then @@ -333,7 +340,7 @@ subroutine applyCAMforcing(elem,fvm,np1,np1_qdp,dt_dribble,dt_phys,nets,nete,nsu ! ! tracers ! - if (qsize>0.and.dt_local_tracer>0) then + if (.not.use_cslam.and.dt_local_tracer>0) then #if (defined COLUMN_OPENMP) !$omp parallel do num_threads(tracer_num_threads) private(q,k,i,j,v1) #endif @@ -389,7 +396,7 @@ subroutine applyCAMforcing(elem,fvm,np1,np1_qdp,dt_dribble,dt_phys,nets,nete,nsu if (use_cslam) ftmp_fvm(:,:,:,:,ie) = 0.0_r8 end if - if (ftype_conserve==1) then + if (ftype_conserve==1.and..not.use_cslam) then call get_dp(elem(ie)%state%Qdp(:,:,:,1:qsize,np1_qdp), MASS_MIXING_RATIO, & thermodynamic_active_species_idx_dycore, elem(ie)%state%dp3d(:,:,:,np1), pdel) do k=1,nlev @@ -422,6 +429,7 @@ subroutine applyCAMforcing(elem,fvm,np1,np1_qdp,dt_dribble,dt_phys,nets,nete,nsu end if if (ftype==1.and.nsubstep==1) call tot_energy_dyn(elem,fvm,nets,nete,np1,np1_qdp,'p2d') if (use_cslam) deallocate(ftmp_fvm) + call t_stopf('applyCAMforc') end subroutine applyCAMforcing diff --git a/src/dynamics/se/dycore/prim_advection_mod.F90 b/src/dynamics/se/dycore/prim_advection_mod.F90 index 17ad85ba61..db08cf94a3 100644 --- a/src/dynamics/se/dycore/prim_advection_mod.F90 +++ b/src/dynamics/se/dycore/prim_advection_mod.F90 @@ -1,3 +1,4 @@ +!#define old_cam #define OVERLAP 1 module prim_advection_mod ! @@ -23,7 +24,11 @@ module prim_advection_mod use element_mod, only: element_t use fvm_control_volume_mod, only: fvm_struct use hybvcoord_mod, only: hvcoord_t +#ifdef old_cam + use time_mod, only: TimeLevel_t, TimeLevel_Qdp +#else use se_dyn_time_mod, only: TimeLevel_t, TimeLevel_Qdp +#endif use control_mod, only: nu_q, nu_p, limiter_option, hypervis_subcycle_q, rsplit use edge_mod, only: edgevpack, edgevunpack, initedgebuffer, initedgesbuffer @@ -45,7 +50,7 @@ module prim_advection_mod public :: prim_advec_tracers_fvm public :: vertical_remap - type (EdgeBuffer_t) :: edgeAdv, edgeAdvp1, edgeAdvQminmax, edgeAdv1, edgeveloc + type (EdgeBuffer_t) :: edgeAdv, edgeAdvp1, edgeAdvQminmax, edgeveloc integer,parameter :: DSSeta = 1 integer,parameter :: DSSomega = 2 @@ -63,7 +68,7 @@ module prim_advection_mod subroutine Prim_Advec_Init1(par, elem) - use dimensions_mod, only: nlev, qsize, nelemd,ntrac + use dimensions_mod, only: nlev, qsize, nelemd,ntrac,use_cslam use parallel_mod, only: parallel_t, boundaryCommMethod type(parallel_t) :: par type (element_t) :: elem(:) @@ -80,7 +85,7 @@ subroutine Prim_Advec_Init1(par, elem) ! ! Set the number of threads used in the subroutine Prim_Advec_tracers_remap() ! - if (ntrac>0) then + if (use_cslam) then advec_remap_num_threads = 1 else advec_remap_num_threads = tracer_num_threads @@ -89,17 +94,17 @@ subroutine Prim_Advec_Init1(par, elem) ! allocate largest one first ! Currently this is never freed. If it was, only this first one should ! be freed, as only it knows the true size of the buffer. - call initEdgeBuffer(par,edgeAdvp1,elem,qsize*nlev + nlev,bndry_type=boundaryCommMethod,& - nthreads=horz_num_threads*advec_remap_num_threads) - call initEdgeBuffer(par,edgeAdv,elem,qsize*nlev,bndry_type=boundaryCommMethod, & - nthreads=horz_num_threads*advec_remap_num_threads) - ! This is a different type of buffer pointer allocation - ! used for determine the minimum and maximum value from - ! neighboring elements - call initEdgeSBuffer(par,edgeAdvQminmax,elem,qsize*nlev*2,bndry_type=boundaryCommMethod, & - nthreads=horz_num_threads*advec_remap_num_threads) - - call initEdgeBuffer(par,edgeAdv1,elem,nlev,bndry_type=boundaryCommMethod) + if (.not.use_cslam) then + call initEdgeBuffer(par,edgeAdvp1,elem,qsize*nlev + nlev,bndry_type=boundaryCommMethod,& + nthreads=horz_num_threads*advec_remap_num_threads) + call initEdgeBuffer(par,edgeAdv,elem,qsize*nlev,bndry_type=boundaryCommMethod, & + nthreads=horz_num_threads*advec_remap_num_threads) + ! This is a different type of buffer pointer allocation + ! used for determine the minimum and maximum value from + ! neighboring elements + call initEdgeSBuffer(par,edgeAdvQminmax,elem,qsize*nlev*2,bndry_type=boundaryCommMethod, & + nthreads=horz_num_threads*advec_remap_num_threads) + end if call initEdgeBuffer(par,edgeveloc,elem,2*nlev,bndry_type=boundaryCommMethod) diff --git a/src/dynamics/se/dycore/prim_driver_mod.F90 b/src/dynamics/se/dycore/prim_driver_mod.F90 index 6cfb52e356..7802e5201d 100644 --- a/src/dynamics/se/dycore/prim_driver_mod.F90 +++ b/src/dynamics/se/dycore/prim_driver_mod.F90 @@ -1,3 +1,4 @@ +!#define old_cam !#define _DBG_ print *,"file: ",__FILE__," line: ",__LINE__," ithr: ",hybrid%ithr #define _DBG_ module prim_driver_mod @@ -19,7 +20,6 @@ module prim_driver_mod private public :: prim_init2, prim_run_subcycle, prim_finalize public :: prim_set_dry_mass - contains !=============================================================================! @@ -28,8 +28,13 @@ subroutine prim_init2(elem, fvm, hybrid, nets, nete, tl, hvcoord) use dimensions_mod, only: irecons_tracer, fvm_supercycling use dimensions_mod, only: fv_nphys, nc use parallel_mod, only: syncmp +#ifdef old_cam + use time_mod, only: timelevel_t, tstep, phys_tscale, nsplit, TimeLevel_Qdp + use time_mod, only: nsplit_baseline,rsplit_baseline +#else use se_dyn_time_mod, only: timelevel_t, tstep, phys_tscale, nsplit, TimeLevel_Qdp use se_dyn_time_mod, only: nsplit_baseline,rsplit_baseline +#endif use prim_state_mod, only: prim_printstate use control_mod, only: runtype, topology, rsplit, qsplit, rk_stage_user, & nu, nu_q, nu_div, hypervis_subcycle, hypervis_subcycle_q, & @@ -61,9 +66,10 @@ subroutine prim_init2(elem, fvm, hybrid, nets, nete, tl, hvcoord) ! variables used to calculate CFL real (kind=r8) :: dtnu ! timestep*viscosity parameter - real (kind=r8) :: dt_dyn_vis ! viscosity timestep used in dynamics - real (kind=r8) :: dt_dyn_del2_sponge, dt_remap + real (kind=r8) :: dt_dyn_del2_sponge real (kind=r8) :: dt_tracer_vis ! viscosity timestep used in tracers + real (kind=r8) :: dt_dyn_vis ! viscosity timestep + real (kind=r8) :: dt_remap ! remapping timestep real (kind=r8) :: dp,dp0,T1,T0,pmid_ref(np,np) real (kind=r8) :: ps_ref(np,np,nets:nete) @@ -218,8 +224,12 @@ subroutine prim_run_subcycle(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,nsubst ! ! use hybvcoord_mod, only : hvcoord_t +#ifdef old_cam + use time_mod, only: TimeLevel_t, timelevel_update, timelevel_qdp, nsplit +#else use se_dyn_time_mod, only: TimeLevel_t, timelevel_update, timelevel_qdp, nsplit - use control_mod, only: statefreq,qsplit, rsplit, variable_nsplit +#endif + use control_mod, only: statefreq,qsplit, rsplit, variable_nsplit, dribble_in_rsplit_loop use prim_advance_mod, only: applycamforcing use prim_advance_mod, only: tot_energy_dyn,compute_omega use prim_state_mod, only: prim_printstate, adjust_nsplit @@ -227,8 +237,8 @@ subroutine prim_run_subcycle(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,nsubst use thread_mod, only: omp_get_thread_num use perf_mod , only: t_startf, t_stopf use fvm_mod , only: fill_halo_fvm, ghostBufQnhc_h - use dimensions_mod, only: use_cslam,fv_nphys, ksponge_end - + use dimensions_mod, only: use_cslam,fv_nphys + use fvm_mapping, only: cslam2gll type (element_t) , intent(inout) :: elem(:) type(fvm_struct), intent(inout) :: fvm(:) type (hybrid_t), intent(in) :: hybrid ! distributed parallel structure (shared) @@ -245,7 +255,6 @@ subroutine prim_run_subcycle(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,nsubst real (kind=r8) :: dp_np1(np,np) real (kind=r8) :: dp_start(np,np,nlev+1,nets:nete),dp_end(np,np,nlev,nets:nete) logical :: compute_diagnostics - ! =================================== ! Main timestepping loop ! =================================== @@ -282,12 +291,29 @@ subroutine prim_run_subcycle(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,nsubst call TimeLevel_Qdp( tl, qsplit, n0_qdp) - call tot_energy_dyn(elem,fvm,nets,nete,tl%n0,n0_qdp,'dAF') - call ApplyCAMForcing(elem,fvm,tl%n0,n0_qdp,dt_remap,dt_phys,nets,nete,nsubstep) - call tot_energy_dyn(elem,fvm,nets,nete,tl%n0,n0_qdp,'dBD') + if (dribble_in_rsplit_loop==0) then + call tot_energy_dyn(elem,fvm,nets,nete,tl%n0,n0_qdp,'dAF') + call ApplyCAMForcing(elem,fvm,tl%n0,n0_qdp,dt_remap,dt_phys,nets,nete,nsubstep) + call tot_energy_dyn(elem,fvm,nets,nete,tl%n0,n0_qdp,'dBD') + end if do r=1,rsplit if (r.ne.1) call TimeLevel_update(tl,"leapfrog") - call prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,r) + ! + ! if nsplit==1 and physics time-step is long then there will be noise in the + ! pressure field; hence "dripple" in tendencies + ! + if (dribble_in_rsplit_loop==1) then + call tot_energy_dyn(elem,fvm,nets,nete,tl%n0,n0_qdp,'dAF') + call ApplyCAMForcing(elem,fvm,tl%n0,n0_qdp,dt,dt_phys,nets,nete,MAX(nsubstep,r)) + call tot_energy_dyn(elem,fvm,nets,nete,tl%n0,n0_qdp,'dBD') + end if + ! + ! right after physics overwrite Qdp with CSLAM values + ! + if (use_cslam.and.nsubstep==1.and.r==1) then + call cslam2gll(elem, fvm, hybrid,nets,nete, tl%n0, n0_qdp) + end if + call prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,r,nsubstep==nsplit,dt_remap) enddo @@ -363,7 +389,6 @@ subroutine prim_run_subcycle(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,nsubst end do end do end do - if (nsubstep==nsplit.and.variable_nsplit) then call t_startf('adjust_nsplit') call adjust_nsplit(elem, tl, hybrid,nets,nete, fvm, omega_cn) @@ -389,7 +414,7 @@ subroutine prim_run_subcycle(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,nsubst end subroutine prim_run_subcycle - subroutine prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord, rstep) + subroutine prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord, rstep, last_step,dt_remap) ! ! Take qsplit dynamics steps and one tracer step ! for vertically lagrangian option, this subroutine does only the horizontal step @@ -407,7 +432,11 @@ subroutine prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord, rstep) ! tl%n0 time t + dt_q ! use hybvcoord_mod, only: hvcoord_t +#ifdef old_cam + use time_mod, only: TimeLevel_t, timelevel_update +#else use se_dyn_time_mod, only: TimeLevel_t, timelevel_update +#endif use control_mod, only: statefreq, qsplit, nu_p use thread_mod, only: omp_get_thread_num use prim_advance_mod, only: prim_advance_exp @@ -418,7 +447,12 @@ subroutine prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord, rstep) use dimensions_mod, only: kmin_jet, kmax_jet use fvm_mod, only: ghostBufQnhc_vh,ghostBufQ1_vh, ghostBufFlux_vh use fvm_mod, only: ghostBufQ1_h,ghostBufQnhcJet_h, ghostBufFluxJet_h - +#ifdef old_cam + use time_mod, only: timelevel_qdp +#else + use se_dyn_time_mod, only: timelevel_qdp +#endif + use fvm_mapping, only: cslam2gll #ifdef waccm_debug use cam_history, only: outfld #endif @@ -433,6 +467,8 @@ subroutine prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord, rstep) real(kind=r8), intent(in) :: dt ! "timestep dependent" timestep type (TimeLevel_t), intent(inout) :: tl integer, intent(in) :: rstep ! vertical remap subcycling step + logical, intent(in) :: last_step! last step before d_p_coupling + real(kind=r8), intent(in) :: dt_remap type (hybrid_t):: hybridnew,hybridnew2 real(kind=r8) :: st, st1, dp, dt_q @@ -440,6 +476,7 @@ subroutine prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord, rstep) integer :: ithr integer :: region_num_threads integer :: kbeg,kend + integer :: n0_qdp, np1_qdp real (kind=r8) :: tempdp3d(np,np), x real (kind=r8) :: tempmass(nc,nc) @@ -517,7 +554,6 @@ subroutine prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord, rstep) end do end if #endif - ! current dynamics state variables: ! derived%dp = dp at start of timestep ! derived%vn0 = mean horiz. flux: U*dp @@ -537,32 +573,19 @@ subroutine prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord, rstep) ! special case in CAM: if CSLAM tracers are turned on , qsize=1 but this tracer should ! not be advected. This will be cleaned up when the physgrid is merged into CAM trunk ! Currently advecting all species - if (qsize > 0) then - + if (.not.use_cslam) then call t_startf('prim_advec_tracers_remap') - if(use_cslam) then - ! Deactivate threading in the tracer dimension if this is a CSLAM run - region_num_threads = 1 - else - region_num_threads=tracer_num_threads - endif + region_num_threads=tracer_num_threads call omp_set_nested(.true.) !$OMP PARALLEL NUM_THREADS(region_num_threads), DEFAULT(SHARED), PRIVATE(hybridnew) - if(use_cslam) then - ! Deactivate threading in the tracer dimension if this is a CSLAM run - hybridnew = config_thread_region(hybrid,'serial') - else - hybridnew = config_thread_region(hybrid,'tracer') - endif + hybridnew = config_thread_region(hybrid,'tracer') call Prim_Advec_Tracers_remap(elem, deriv,hvcoord,hybridnew,dt_q,tl,nets,nete) !$OMP END PARALLEL call omp_set_nested(.false.) call t_stopf('prim_advec_tracers_remap') - end if - ! - ! only run fvm transport every fvm_supercycling rstep - ! - if (use_cslam) then + else + ! + ! only run fvm transport every fvm_supercycling rstep ! ! FVM transport ! @@ -594,7 +617,9 @@ subroutine prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord, rstep) fvm(ie)%psc(i,j) = sum(fvm(ie)%dp_fvm(i,j,:)) + hvcoord%hyai(1)*hvcoord%ps0 end do end do - end do + end do + call TimeLevel_Qdp( tl, qsplit, n0_qdp, np1_qdp) + if (.not.last_step) call cslam2gll(elem, fvm, hybrid,nets,nete, tl%np1, np1_qdp) else if ((mod(rstep,fvm_supercycling_jet) == 0)) then ! ! shorter fvm time-step in jet region @@ -609,7 +634,7 @@ subroutine prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord, rstep) (/nc*nc,nlev/)), nc*nc, ie) end do #endif - endif + endif end subroutine prim_step diff --git a/src/dynamics/se/dyn_comp.F90 b/src/dynamics/se/dyn_comp.F90 index 312349eb44..b147659299 100644 --- a/src/dynamics/se/dyn_comp.F90 +++ b/src/dynamics/se/dyn_comp.F90 @@ -1,3 +1,4 @@ +!#define old_cam module dyn_comp ! CAM interfaces to the SE Dynamical Core @@ -42,7 +43,11 @@ module dyn_comp use dimensions_mod, only: qsize, use_cslam use element_mod, only: element_t, elem_state_t use fvm_control_volume_mod, only: fvm_struct +#ifdef old_cam +use time_mod, only: nsplit +#else use se_dyn_time_mod, only: nsplit +#endif use edge_mod, only: initEdgeBuffer, edgeVpack, edgeVunpack, FreeEdgeBuffer use edgetype_mod, only: EdgeBuffer_t use bndry_mod, only: bndry_exchange @@ -110,7 +115,7 @@ subroutine dyn_readnl(NLFileName) use control_mod, only: topology, variable_nsplit use control_mod, only: fine_ne, hypervis_power, hypervis_scaling use control_mod, only: max_hypervis_courant, statediag_numtrac,refined_mesh - use control_mod, only: molecular_diff, pgf_formulation + use control_mod, only: molecular_diff, pgf_formulation, dribble_in_rsplit_loop use control_mod, only: sponge_del4_nu_div_fac, sponge_del4_nu_fac, sponge_del4_lev use dimensions_mod, only: ne, npart use dimensions_mod, only: large_Courant_incr @@ -168,7 +173,55 @@ subroutine dyn_readnl(NLFileName) integer :: se_kmax_jet real(r8) :: se_molecular_diff integer :: se_pgf_formulation - + integer :: se_dribble_in_rsplit_loop +#ifndef old_cam + namelist /dyn_se_inparm/ & + se_fine_ne, & ! For refined meshes + se_ftype, & ! forcing type + se_statediag_numtrac, & + se_fv_nphys, & + se_hypervis_power, & + se_hypervis_scaling, & + se_hypervis_subcycle, & + se_hypervis_subcycle_sponge, & + se_hypervis_subcycle_q, & + se_limiter_option, & + se_max_hypervis_courant, & + se_mesh_file, & ! Refined mesh definition file + se_ne, & + se_npes, & + se_nsplit, & ! # of dyn steps per physics timestep + se_nu, & + se_nu_div, & + se_nu_p, & + se_nu_top, & + se_sponge_del4_nu_fac, & + se_sponge_del4_nu_div_fac, & + se_sponge_del4_lev, & + se_qsplit, & + se_refined_mesh, & + se_rsplit, & + se_statefreq, & ! number of steps per printstate call + se_tstep_type, & + se_vert_remap_T, & + se_vert_remap_uvTq_alg, & + se_vert_remap_tracer_alg, & + se_write_grid_file, & + se_grid_filename, & + se_write_gll_corners, & + se_horz_num_threads, & + se_vert_num_threads, & + se_tracer_num_threads, & + se_write_restart_unstruct, & + se_large_Courant_incr, & + se_fvm_supercycling, & + se_fvm_supercycling_jet, & + se_kmin_jet, & + se_kmax_jet, & + se_molecular_diff, & + se_pgf_formulation, & + se_dribble_in_rsplit_loop +#else namelist /dyn_se_inparm/ & se_fine_ne, & ! For refined meshes se_ftype, & ! forcing type @@ -214,7 +267,7 @@ subroutine dyn_readnl(NLFileName) se_kmax_jet, & se_molecular_diff, & se_pgf_formulation - +#endif !-------------------------------------------------------------------------- ! defaults for variables not set by build-namelist @@ -288,7 +341,9 @@ subroutine dyn_readnl(NLFileName) call MPI_bcast(se_kmax_jet, 1, mpi_integer, masterprocid, mpicom, ierr) call MPI_bcast(se_molecular_diff, 1, mpi_real8, masterprocid, mpicom, ierr) call MPI_bcast(se_pgf_formulation, 1, mpi_integer, masterprocid, mpicom, ierr) - +#ifndef old_cam + call MPI_bcast(se_dribble_in_rsplit_loop, 1, mpi_integer, masterprocid, mpicom, ierr) +#endif if (se_npes <= 0) then call endrun('dyn_readnl: ERROR: se_npes must be > 0') end if @@ -356,7 +411,9 @@ subroutine dyn_readnl(NLFileName) variable_nsplit = .false. molecular_diff = se_molecular_diff pgf_formulation = se_pgf_formulation - +#ifndef old_cam + dribble_in_rsplit_loop = se_dribble_in_rsplit_loop +#endif if (fv_nphys > 0) then ! Use finite volume physics grid and CSLAM for tracer advection nphys_pts = fv_nphys*fv_nphys @@ -799,28 +856,49 @@ subroutine dyn_init(dyn_in, dyn_out) ! nu_scale_top(:) = 0.0_r8 if (nu_top>0) then - ptop = hvcoord%hyai(1)*hvcoord%ps0 - if (ptop>300.0_r8) then - ! - ! for low tops the tanh formulae below makes the sponge excessively deep - ! - nu_scale_top(1) = 4.0_r8 - nu_scale_top(2) = 2.0_r8 - nu_scale_top(3) = 1.0_r8 - ksponge_end = 3 - else - do k=1,nlev - press = hvcoord%hyam(k)*hvcoord%ps0+hvcoord%hybm(k)*pstd - nu_scale_top(k) = 8.0_r8*(1.0_r8+tanh(1.0_r8*log(ptop/press(1)))) ! tau will be maximum 8 at model top - if (nu_scale_top(k).ge.0.15_r8) then - ksponge_end = k - else - nu_scale_top(k) = 0.0_r8 - end if - end do - end if + ptop = hvcoord%hyai(1)*hvcoord%ps0 + if (ptop>300.0_r8) then + ! + ! for low tops the tanh formulae below makes the sponge excessively deep + ! + nu_scale_top(1) = 4.0_r8 + nu_scale_top(2) = 2.0_r8 + nu_scale_top(3) = 1.0_r8 + ksponge_end = 3 + else if (ptop>100.0_r8) then + ! + ! CAM6 top (~225 Pa) or CAM7 low top + ! + ! For backwards compatibility numbers below match tanh profile + ! used in FV + ! + nu_scale_top(1) = 4.4_r8 + nu_scale_top(2) = 1.3_r8 + nu_scale_top(3) = 3.9_r8 + ksponge_end = 3 + else if (ptop>1e-1_r8) then + ! + ! CAM7 FMT + ! + nu_scale_top(1) = 3.0_r8 + nu_scale_top(2) = 1.0_r8 + nu_scale_top(3) = 0.1_r8 + nu_scale_top(4) = 0.05_r8 + ksponge_end = 4 + else if (ptop>1e-4_r8) then + ! + ! WACCM and WACCM-x + ! + nu_scale_top(1) = 5.0_r8 + nu_scale_top(2) = 5.0_r8 + nu_scale_top(3) = 5.0_r8 + nu_scale_top(4) = 2.0_r8 + nu_scale_top(5) = 1.0_r8 + nu_scale_top(6) = 0.1_r8 + ksponge_end = 6 + end if else - ksponge_end = 0 + ksponge_end = 0 end if ksponge_end = MAX(MAX(ksponge_end,1),kmol_end) if (masterproc) then @@ -963,11 +1041,14 @@ subroutine dyn_run(dyn_state) use air_composition, only: thermodynamic_active_species_idx_dycore use prim_driver_mod, only: prim_run_subcycle use dimensions_mod, only: cnst_name_gll - use se_dyn_time_mod, only: tstep, nsplit, timelevel_qdp +#ifdef old_cam + use time_mod, only: tstep, nsplit, timelevel_qdp, tevolve +#else + use se_dyn_time_mod, only: tstep, nsplit, timelevel_qdp, tevolve +#endif use hybrid_mod, only: config_thread_region, get_loop_ranges use control_mod, only: qsplit, rsplit, ftype_conserve use thread_mod, only: horz_num_threads - use se_dyn_time_mod, only: tevolve type(dyn_export_t), intent(inout) :: dyn_state @@ -1042,24 +1123,23 @@ subroutine dyn_run(dyn_state) end if end do - - ! convert elem(ie)%derived%fq to mass tendency - do ie = nets, nete - do m = 1, qsize + if (.not.use_cslam) then + do ie = nets, nete + do m = 1, qsize do k = 1, nlev - do j = 1, np - do i = 1, np - dyn_state%elem(ie)%derived%FQ(i,j,k,m) = dyn_state%elem(ie)%derived%FQ(i,j,k,m)* & - rec2dt*dyn_state%elem(ie)%state%dp3d(i,j,k,tl_f) - end do - end do + do j = 1, np + do i = 1, np + dyn_state%elem(ie)%derived%FQ(i,j,k,m) = dyn_state%elem(ie)%derived%FQ(i,j,k,m)* & + rec2dt*dyn_state%elem(ie)%state%dp3d(i,j,k,tl_f) + end do + end do end do - end do - end do - + end do + end do + end if - if (ftype_conserve>0) then + if (ftype_conserve>0.and..not.use_cslam) then do ie = nets, nete do k=1,nlev do j=1,np @@ -1076,7 +1156,6 @@ subroutine dyn_run(dyn_state) end do end if - if (use_cslam) then do ie = nets, nete do m = 1, ntrac @@ -1795,6 +1874,7 @@ subroutine set_phis(dyn_in) integer :: ierr, pio_errtype character(len=max_fieldname_len) :: fieldname + character(len=max_fieldname_len) :: fieldname_gll character(len=max_hcoordname_len):: grid_name integer :: dims(2) integer :: dyn_cols @@ -1878,12 +1958,36 @@ subroutine set_phis(dyn_in) end if fieldname = 'PHIS' - if (dyn_field_exists(fh_topo, trim(fieldname))) then + fieldname_gll = 'PHIS_gll' + if (fv_nphys>0.and.dyn_field_exists(fh_topo, trim(fieldname_gll),required=.false.)) then + ! + ! If physgrid it is recommended to read in PHIS on the GLL grid and then + ! map to the physgrid in d_p_coupling + ! + ! This requires a topo file with PHIS_gll on it ... + ! + if (masterproc) then + write(iulog, *) "Reading in PHIS on GLL grid (mapped to physgrid in d_p_coupling)" + end if + call read_dyn_var(fieldname_gll, fh_topo, 'ncol_gll', phis_tmp) + else if (dyn_field_exists(fh_topo, trim(fieldname))) then if (fv_nphys == 0) then - call read_dyn_var(fieldname, fh_topo, 'ncol', phis_tmp) + if (masterproc) then + write(iulog, *) "Reading in PHIS" + end if + call read_dyn_var(fieldname, fh_topo, 'ncol', phis_tmp) else - call read_phys_field_2d(fieldname, fh_topo, 'ncol', phis_phys_tmp) - call map_phis_from_physgrid_to_gll(dyn_in%fvm, elem, phis_phys_tmp, & + ! + ! For backwards compatibility we allow reading in PHIS on the physgrid + ! which is then mapped to the GLL grid and back to the physgrid in d_p_coupling + ! (the latter is to avoid noise in derived quantities such as PSL) + ! + if (masterproc) then + write(iulog, *) "Reading in PHIS on physgrid" + write(iulog, *) "Recommended to read in PHIS on GLL grid" + end if + call read_phys_field_2d(fieldname, fh_topo, 'ncol', phis_phys_tmp) + call map_phis_from_physgrid_to_gll(dyn_in%fvm, elem, phis_phys_tmp, & phis_tmp, pmask) end if else @@ -1916,44 +2020,6 @@ subroutine set_phis(dyn_in) PHIS_OUT=phis_tmp, mask=pmask(:)) deallocate(glob_ind) - if (fv_nphys > 0) then - - ! initialize PHIS on physgrid - allocate(latvals_phys(fv_nphys*fv_nphys*nelemd)) - allocate(lonvals_phys(fv_nphys*fv_nphys*nelemd)) - indx = 1 - do ie = 1, nelemd - do j = 1, fv_nphys - do i = 1, fv_nphys - latvals_phys(indx) = dyn_in%fvm(ie)%center_cart_physgrid(i,j)%lat - lonvals_phys(indx) = dyn_in%fvm(ie)%center_cart_physgrid(i,j)%lon - indx = indx + 1 - end do - end do - end do - - allocate(pmask_phys(fv_nphys*fv_nphys*nelemd)) - pmask_phys(:) = .true. - allocate(glob_ind(fv_nphys*fv_nphys*nelemd)) - - j = 1 - do ie = 1, nelemd - do i = 1, fv_nphys*fv_nphys - ! Create a global(ish) column index - glob_ind(j) = elem(ie)%GlobalId - j = j + 1 - end do - end do - - call analytic_ic_set_ic(vcoord, latvals_phys, lonvals_phys, glob_ind, & - PHIS_OUT=phis_phys_tmp, mask=pmask_phys) - - deallocate(latvals_phys) - deallocate(lonvals_phys) - deallocate(pmask_phys) - deallocate(glob_ind) - end if - end if deallocate(pmask) @@ -1969,14 +2035,8 @@ subroutine set_phis(dyn_in) end do end do end do - if (fv_nphys > 0) then - do ie = 1, nelemd - dyn_in%fvm(ie)%phis_physgrid = RESHAPE(phis_phys_tmp(:,ie),(/fv_nphys,fv_nphys/)) - end do - end if - deallocate(phis_tmp) - if (fv_nphys > 0) then + if (allocated(phis_phys_tmp)) then deallocate(phis_phys_tmp) end if diff --git a/src/dynamics/se/dyn_grid.F90 b/src/dynamics/se/dyn_grid.F90 index 293f7402dd..7d94591c86 100644 --- a/src/dynamics/se/dyn_grid.F90 +++ b/src/dynamics/se/dyn_grid.F90 @@ -1,3 +1,4 @@ +!#define old_cam module dyn_grid !------------------------------------------------------------------------------- ! @@ -48,7 +49,11 @@ module dyn_grid use prim_init, only: prim_init1 use edge_mod, only: initEdgeBuffer use edgetype_mod, only: EdgeBuffer_t +#ifdef old_cam +use time_mod, only: TimeLevel_t +#else use se_dyn_time_mod, only: TimeLevel_t +#endif use dof_mod, only: UniqueCoords, UniquePoints implicit none @@ -133,7 +138,11 @@ subroutine dyn_grid_init() use hybrid_mod, only: hybrid_t, init_loop_ranges, & get_loop_ranges, config_thread_region use control_mod, only: qsplit, rsplit +#ifdef old_cam + use time_mod, only: tstep, nsplit +#else use se_dyn_time_mod, only: tstep, nsplit +#endif use fvm_mod, only: fvm_init2, fvm_init3, fvm_pg_init use dimensions_mod, only: irecons_tracer use comp_gll_ctr_vol, only: gll_grid_write @@ -182,7 +191,7 @@ subroutine dyn_grid_init() end if if (fv_nphys > 0) then - qsize_local = thermodynamic_active_species_num + 3 + qsize_local = 3 else qsize_local = pcnst + 3 end if diff --git a/src/dynamics/se/gravity_waves_sources.F90 b/src/dynamics/se/gravity_waves_sources.F90 index 9adffc001b..a19733b465 100644 --- a/src/dynamics/se/gravity_waves_sources.F90 +++ b/src/dynamics/se/gravity_waves_sources.F90 @@ -141,7 +141,7 @@ subroutine compute_frontogenesis(frontgf,frontga,tl,tlq,elem,ederiv,hybrid,nets, do ie=nets,nete ! pressure at model top - pint(:,:) = hvcoord%hyai(1) + pint(:,:) = hvcoord%hyai(1)*hvcoord%ps0 do k=1,nlev ! moist pressure at mid points sum_water(:,:) = 1.0_r8 diff --git a/src/physics/cam/vertical_diffusion.F90 b/src/physics/cam/vertical_diffusion.F90 index 224d87e3a0..7bdaf9eb23 100644 --- a/src/physics/cam/vertical_diffusion.F90 +++ b/src/physics/cam/vertical_diffusion.F90 @@ -280,6 +280,7 @@ subroutine vertical_diffusion_init(pbuf2d) use beljaars_drag_cam, only : beljaars_drag_init use upper_bc, only : ubc_init use phys_control, only : waccmx_is, fv_am_correction + use ref_pres, only : ptop_ref type(physics_buffer_desc), pointer :: pbuf2d(:,:) character(128) :: errstring ! Error status for init_vdiff @@ -301,6 +302,27 @@ subroutine vertical_diffusion_init(pbuf2d) if (masterproc) then write(iulog,*)'Initializing vertical diffusion (vertical_diffusion_init)' + if (ptop_ref>1e-1_r8.and.ptop_ref<100.0_r8) then + ! + ! CAM7 FMT + ! + write(iulog,*)'Artificial sponge layer vertical diffusion added:' + write(iulog,*)'vertical diffusion coefficient at interface 1 is increased by 2.0E6 m^2/s2' + write(iulog,*)'vertical diffusion coefficient at interface 2 is increased by 2.0E6 m^2/s2' + write(iulog,*)'vertical diffusion coefficient at interface 3 is increased by 0.5E6 m^2/s2' + write(iulog,*)'vertical diffusion coefficient at interface 4 is increased by 0.1E6 m^2/s2' + else if (ptop_ref>1e-4_r8) then + ! + ! WACCM and WACCM-x + ! + write(iulog,*)'Artificial sponge layer vertical diffusion added:' + write(iulog,*)'vertical diffusion coefficient at interface 1 is increased by 2.0E6 m^2/s2' + write(iulog,*)'vertical diffusion coefficient at interface 2 is increased by 2.0E6 m^2/s2' + write(iulog,*)'vertical diffusion coefficient at interface 3 is increased by 1.5E6 m^2/s2' + write(iulog,*)'vertical diffusion coefficient at interface 4 is increased by 1.0E6 m^2/s2' + write(iulog,*)'vertical diffusion coefficient at interface 5 is increased by 0.5E6 m^2/s2' + write(iulog,*)'vertical diffusion coefficient at interface 6 is increased by 0.1E6 m^2/s2' + end if end if ! Check to see if WACCM-X is on (currently we don't care whether the @@ -633,7 +655,6 @@ subroutine vertical_diffusion_init(pbuf2d) call pbuf_set_field(pbuf2d, qti_flx_idx, 0.0_r8) end if end if - end subroutine vertical_diffusion_init ! =============================================================================== ! @@ -695,6 +716,7 @@ subroutine vertical_diffusion_tend( & use upper_bc, only : ubc_get_flxs use coords_1d, only : Coords1D use phys_control, only : cam_physpkg_is + use ref_pres, only : ptop_ref ! --------------- ! ! Input Arguments ! @@ -1067,6 +1089,36 @@ subroutine vertical_diffusion_tend( & call outfld( 'ustar', ustar(:), pcols, lchnk ) call outfld( 'obklen', obklen(:), pcols, lchnk ) + ! + ! add sponge layer vertical diffusion + ! + if (ptop_ref>300.0_r8) then + ! + ! for low tops the tanh formulae below makes the sponge excessively deep + ! + else if (ptop_ref>100.0_r8) then + ! + ! CAM6 top (~225 Pa) or CAM7 low top + ! + else if (ptop_ref>1e-1_r8) then + ! + ! CAM7 FMT + ! + kvm(:ncol,1) = kvm(:ncol,1)+2E6_r8 + kvm(:ncol,2) = kvm(:ncol,2)+2E6_r8 + kvm(:ncol,3) = kvm(:ncol,3)+0.5E6_r8 + kvm(:ncol,4) = kvm(:ncol,4)+0.1E6_r8 + else if (ptop_ref>1e-4_r8) then + ! + ! WACCM and WACCM-x + ! + kvm(:ncol,1) = kvm(:ncol,1)+2E6_r8 + kvm(:ncol,2) = kvm(:ncol,2)+2E6_r8 + kvm(:ncol,3) = kvm(:ncol,3)+1.5E6_r8 + kvm(:ncol,4) = kvm(:ncol,4)+1.0E6_r8 + kvm(:ncol,5) = kvm(:ncol,5)+0.5E6_r8 + kvm(:ncol,6) = kvm(:ncol,6)+0.1E6_r8 + end if ! kvh (in pbuf) is used by other physics parameterizations, and as an initial guess in compute_eddy_diff ! on the next timestep. It is not updated by the compute_vdiff call below. From bd1f0047ccd5630c571a24ba941f6b9c07a6d548 Mon Sep 17 00:00:00 2001 From: Cheryl Craig Date: Tue, 23 Jan 2024 16:56:24 -0700 Subject: [PATCH 209/291] ChangeLog for cam6_3_146 --- doc/ChangeLog | 89 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 89 insertions(+) diff --git a/doc/ChangeLog b/doc/ChangeLog index 2cb653ca46..a219f92580 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,5 +1,94 @@ =============================================================== +Tag name: cam6_3_146 +Originator(s): cacraig +Date: Jan 23, 2024 +One-line Summary: ZM clean up in preparation for using via CCPP and remove zmconv_microp feature +Github PR URL: https://github.com/ESCOMP/CAM/pull/890 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Work to make ZM compatible with CCPP conversion process + - Removed CAM3 switch from ZM in move to no longer support CAM3 + - Remove microphysics embedded in ZM: https://github.com/ESCOMP/CAM/issues/889 + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: + - removed zmconv_microp namelist + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: nusbaume, mwaxmonsky + +List all files eliminated: +D src/physics/cam/zm_microphysics.F90 + - removed zmconv_microp capability as it is not used + +D src/physics/cam/zm_conv.F90 + - moved ZM to ESCOMP/atcmospheric_physics and broke into separate modules + +D cime_config/testdefs/testmods_dirs/cam/outfrq3s_convmic/shell_commands +D cime_config/testdefs/testmods_dirs/cam/outfrq3s_convmic/user_nl_cam +D cime_config/testdefs/testmods_dirs/cam/outfrq3s_convmic/user_nl_clm +D cime_config/testdefs/testmods_dirs/cam/outfrq3s_convmic/user_nl_cpl + - removed test which tested zmconv_microp + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: +M Externals_CAM.cfg + - updated ESCOMP/atmospheric_physics to bring in tag with ZM + +M bld/build-namelist +M bld/namelist_files/namelist_defaults_cam.xml +M bld/namelist_files/namelist_definition.xml +M src/physics/cam/clubb_intr.F90 + - removed zmconv_microp namelist and associated code + +M bld/configure + - add location for src/atmos_phys/zm + +M cime_config/testdefs/testlist_cam.xml + - removed test which tested zmconv_microp and CAM3 + +M src/physics/cam/macrop_driver.F90 + - removed zmconv_microp namelist and associated code + - Changes needed to support ZM no longer having pcols dimension + +M src/chemistry/modal_aero/modal_aero_convproc.F90 +M src/physics/cam/cloud_fraction.F90 +M src/physics/cam/convect_shallow.F90 +M src/physics/cam/rk_stratiform.F90 +M src/physics/spcam/crmclouds_camaerosols.F90 + - Changes needed to support ZM no longer having pcols dimension + +M src/physics/cam/zm_conv_intr.F90 + - Changes to prepare this routine to support CCPP conversion + - Pass in variables which were being "use"d in ZM previously + - Only pass :ncol sections of arrays since pcols has been removed from ZM + - removed zmconv_microp namelist and associated code + +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: all BFB except: + ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 (Overall: PEND) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + - preexisting failures + +izumi/nag/aux_cam: all BFB except: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - preexisting failure + +izumi/gnu/aux_cam: all BFB + +=============================================================== +=============================================================== + Tag name: cam6_3_145 Originator(s): katetc, cacraigucar, andrewgettelman Date: 05 Jan 2024 From fd8fa8e6141cf983d806adcc95e2d18620544195 Mon Sep 17 00:00:00 2001 From: Brian Eaton Date: Wed, 24 Jan 2024 10:19:25 -0500 Subject: [PATCH 210/291] update RRTMGP externals --- Externals_CAM.cfg | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Externals_CAM.cfg b/Externals_CAM.cfg index 3e929fcbbb..fe5f6364b1 100644 --- a/Externals_CAM.cfg +++ b/Externals_CAM.cfg @@ -83,14 +83,14 @@ externals = Externals_HCO.cfg local_path = src/physics/rrtmgp/ext protocol = git repo_url = https://github.com/earth-system-radiation/rte-rrtmgp.git -hash = a1b6781 +tag = v1.7 required = True [rrtmgp-data] local_path = src/physics/rrtmgp/data protocol = git repo_url = https://github.com/earth-system-radiation/rrtmgp-data.git -tag = v1.7.1 +tag = v1.8 required = True [externals_description] From 2312bef838b7ed2d571a1dd480f2bd4ca9de6253 Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Fri, 26 Jan 2024 13:00:23 -0700 Subject: [PATCH 211/291] resolve issue #864 (qneg) --- src/dynamics/se/dp_coupling.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/dynamics/se/dp_coupling.F90 b/src/dynamics/se/dp_coupling.F90 index 68f92a6400..2fa1014a18 100644 --- a/src/dynamics/se/dp_coupling.F90 +++ b/src/dynamics/se/dp_coupling.F90 @@ -697,6 +697,10 @@ subroutine derived_phys_dry(phys_state, phys_tend, pbuf2d) end if end do + ! Ensure tracers are all positive + call qneg3('D_P_COUPLING',lchnk ,ncol ,pcols ,pver , & + 1, pcnst, qmin ,phys_state(lchnk)%q) + ! Compute initial geopotential heights - based on full pressure call geopotential_t(phys_state(lchnk)%lnpint, phys_state(lchnk)%lnpmid , phys_state(lchnk)%pint, & phys_state(lchnk)%pmid , phys_state(lchnk)%pdel , phys_state(lchnk)%rpdel , & @@ -717,10 +721,6 @@ subroutine derived_phys_dry(phys_state, phys_tend, pbuf2d) phys_state(lchnk)%s(1:ncol,:), & cpairv(1:ncol,:,lchnk), errflg, errmsg) #endif - ! Ensure tracers are all positive - call qneg3('D_P_COUPLING',lchnk ,ncol ,pcols ,pver , & - 1, pcnst, qmin ,phys_state(lchnk)%q) - ! Compute energy and water integrals of input state pbuf_chnk => pbuf_get_chunk(pbuf2d, lchnk) call check_energy_timestep_init(phys_state(lchnk), phys_tend(lchnk), pbuf_chnk) From 00c09511d8d0fa88966a8abd8e39c8129c8727af Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Fri, 26 Jan 2024 13:02:04 -0700 Subject: [PATCH 212/291] change default topo file for ne30gp3 (read in PHIS in GLL grid); remove unused pg4 topo files --- bld/namelist_files/namelist_defaults_cam.xml | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/bld/namelist_files/namelist_defaults_cam.xml b/bld/namelist_files/namelist_defaults_cam.xml index 73cd23aa68..f24e455064 100644 --- a/bld/namelist_files/namelist_defaults_cam.xml +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -320,16 +320,11 @@ atm/cam/topo/se/ne3pg3_gmted2010_modis_bedmachine_nc0540_Laplace1000_noleak_20230209.nc atm/cam/topo/se/ne5pg3_nc3000_Co360_Fi001_MulG_PF_nullRR_Nsw064_20170516.nc atm/cam/topo/se/ne16pg3_nc3000_Co120_Fi001_PF_nullRR_Nsw084_20171012.nc -atm/cam/topo/se/ne30pg3_gmted2010_modis_bedmachine_nc3000_Laplace0100_20230105.nc +/glade/campaign/cgd/amp/pel/topo/files/se/ne30pg3_gmted2010_modis_bedmachine_nc3000_Laplace0100_noleak_20240117.nc atm/cam/topo/se/ne60pg3_nc3000_Co030_Fi001_PF_nullRR_Nsw021_20171012.nc atm/cam/topo/se/ne120pg3_nc3000_Co015_Fi001_PF_nullRR_Nsw010_20171014.nc atm/cam/topo/se/ne240pg3_nc3000_Co008_Fi001_PF_nullRR_Nsw005_20171015.nc -atm/cam/topo/se/ne5pg4_nc3000_Co360_Fi001_MulG_PF_nullRR_Nsw060_20170707.nc -atm/cam/topo/se/ne30pg4_nc3000_Co060_Fi001_PF_nullRR_Nsw042_20171014.nc -atm/cam/topo/se/ne60pg4_nc3000_Co030_Fi001_PF_nullRR_Nsw021_20171018.nc -atm/cam/topo/se/ne120pg4_nc3000_Co015_Fi001_PF_nullRR_Nsw010_20171014.nc - atm/cam/topo/se/ne30x8_CONUS_nc3000_Co060_Fi001_MulG_PF_RR_Nsw042_c200428.nc atm/cam/topo/se/ne30x4_ARCTIC_nc3000_Co060_Fi001_MulG_PF_RR_Nsw042_c200428.nc atm/cam/topo/se/ne30x8_ARCTICGRIS_nc3000_Co060_Fi001_MulG_PF_RR_Nsw042_c200428.nc From e71a057de6f269c77cd12d108509889c2b9fc22d Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Tue, 30 Jan 2024 10:06:43 -0700 Subject: [PATCH 213/291] remove ifdef old_cam --- src/dynamics/se/dp_coupling.F90 | 14 -------------- src/dynamics/se/dycore/fvm_mapping.F90 | 1 - src/dynamics/se/dycore/fvm_mod.F90 | 1 - src/dynamics/se/dycore/global_norms_mod.F90 | 1 - src/dynamics/se/dycore/prim_advance_mod.F90 | 5 ----- src/dynamics/se/dycore/prim_advection_mod.F90 | 5 ----- src/dynamics/se/dycore/prim_driver_mod.F90 | 18 ------------------ src/dynamics/se/dyn_comp.F90 | 9 --------- src/dynamics/se/dyn_grid.F90 | 9 --------- 9 files changed, 63 deletions(-) diff --git a/src/dynamics/se/dp_coupling.F90 b/src/dynamics/se/dp_coupling.F90 index 2fa1014a18..326f979ef9 100644 --- a/src/dynamics/se/dp_coupling.F90 +++ b/src/dynamics/se/dp_coupling.F90 @@ -1,4 +1,3 @@ -!#define old_cam module dp_coupling !------------------------------------------------------------------------------- @@ -55,11 +54,7 @@ subroutine d_p_coupling(phys_state, phys_tend, pbuf2d, dyn_out) use phys_control, only: use_gw_front, use_gw_front_igw use hycoef, only: hyai, ps0 use fvm_mapping, only: dyn2phys_vector, dyn2phys_all_vars -#ifdef old_cam - use time_mod, only: timelevel_qdp -#else use se_dyn_time_mod, only: timelevel_qdp -#endif use control_mod, only: qsplit use test_fvm_mapping, only: test_mapping_overwrite_dyn_state, test_mapping_output_phys_state use prim_advance_mod, only: tot_energy_dyn @@ -706,21 +701,12 @@ subroutine derived_phys_dry(phys_state, phys_tend, pbuf2d) phys_state(lchnk)%pmid , phys_state(lchnk)%pdel , phys_state(lchnk)%rpdel , & phys_state(lchnk)%t , phys_state(lchnk)%q(:,:,:), rairv(:,:,lchnk), gravit, zvirv , & phys_state(lchnk)%zi , phys_state(lchnk)%zm , ncol) -#ifdef old_cam - do k = 1, pver - do i = 1, ncol - phys_state(lchnk)%s(i,k) = cpairv(i,k,lchnk)*phys_state(lchnk)%t(i,k) & - + gravit*phys_state(lchnk)%zm(i,k) + phys_state(lchnk)%phis(i) - end do - end do -#else ! Compute initial dry static energy, include surface geopotential call update_dry_static_energy_run(pver, gravit, phys_state(lchnk)%t(1:ncol,:), & phys_state(lchnk)%zm(1:ncol,:), & phys_state(lchnk)%phis(1:ncol), & phys_state(lchnk)%s(1:ncol,:), & cpairv(1:ncol,:,lchnk), errflg, errmsg) -#endif ! Compute energy and water integrals of input state pbuf_chnk => pbuf_get_chunk(pbuf2d, lchnk) call check_energy_timestep_init(phys_state(lchnk), phys_tend(lchnk), pbuf_chnk) diff --git a/src/dynamics/se/dycore/fvm_mapping.F90 b/src/dynamics/se/dycore/fvm_mapping.F90 index 98afd40f2a..fd343474ad 100644 --- a/src/dynamics/se/dycore/fvm_mapping.F90 +++ b/src/dynamics/se/dycore/fvm_mapping.F90 @@ -1,4 +1,3 @@ -!#define old_cam ! ! pg3->GLL and GLL->pg3 mapping algorithm described in: ! diff --git a/src/dynamics/se/dycore/fvm_mod.F90 b/src/dynamics/se/dycore/fvm_mod.F90 index 2ce7f502b1..e2f311ee81 100644 --- a/src/dynamics/se/dycore/fvm_mod.F90 +++ b/src/dynamics/se/dycore/fvm_mod.F90 @@ -1,4 +1,3 @@ -!#define old_cam #define FVM_TIMERS .FALSE. !-----------------------------------------------------------------------------! !MODULE FVM_MOD-----------------------------------------------------CE-for FVM! diff --git a/src/dynamics/se/dycore/global_norms_mod.F90 b/src/dynamics/se/dycore/global_norms_mod.F90 index 6e08b64634..6db3ca7255 100644 --- a/src/dynamics/se/dycore/global_norms_mod.F90 +++ b/src/dynamics/se/dycore/global_norms_mod.F90 @@ -1,4 +1,3 @@ -!#define old_cam module global_norms_mod use shr_kind_mod, only: r8=>shr_kind_r8 diff --git a/src/dynamics/se/dycore/prim_advance_mod.F90 b/src/dynamics/se/dycore/prim_advance_mod.F90 index 096bfc6532..b9b6b746e0 100644 --- a/src/dynamics/se/dycore/prim_advance_mod.F90 +++ b/src/dynamics/se/dycore/prim_advance_mod.F90 @@ -1,4 +1,3 @@ -!#define old_cam module prim_advance_mod use shr_kind_mod, only: r8=>shr_kind_r8 use edgetype_mod, only: EdgeBuffer_t @@ -55,11 +54,7 @@ subroutine prim_advance_exp(elem, fvm, deriv, hvcoord, hybrid,dt, tl, nets, net use element_mod, only: element_t use hybvcoord_mod, only: hvcoord_t use hybrid_mod, only: hybrid_t -#ifdef old_cam - use time_mod, only: TimeLevel_t, timelevel_qdp, tevolve -#else use se_dyn_time_mod, only: TimeLevel_t, timelevel_qdp, tevolve -#endif use fvm_control_volume_mod, only: fvm_struct use cam_thermo, only: get_kappa_dry use air_composition, only: thermodynamic_active_species_num diff --git a/src/dynamics/se/dycore/prim_advection_mod.F90 b/src/dynamics/se/dycore/prim_advection_mod.F90 index db08cf94a3..6ee6d2586c 100644 --- a/src/dynamics/se/dycore/prim_advection_mod.F90 +++ b/src/dynamics/se/dycore/prim_advection_mod.F90 @@ -1,4 +1,3 @@ -!#define old_cam #define OVERLAP 1 module prim_advection_mod ! @@ -24,11 +23,7 @@ module prim_advection_mod use element_mod, only: element_t use fvm_control_volume_mod, only: fvm_struct use hybvcoord_mod, only: hvcoord_t -#ifdef old_cam - use time_mod, only: TimeLevel_t, TimeLevel_Qdp -#else use se_dyn_time_mod, only: TimeLevel_t, TimeLevel_Qdp -#endif use control_mod, only: nu_q, nu_p, limiter_option, hypervis_subcycle_q, rsplit use edge_mod, only: edgevpack, edgevunpack, initedgebuffer, initedgesbuffer diff --git a/src/dynamics/se/dycore/prim_driver_mod.F90 b/src/dynamics/se/dycore/prim_driver_mod.F90 index 7802e5201d..ad6ca121df 100644 --- a/src/dynamics/se/dycore/prim_driver_mod.F90 +++ b/src/dynamics/se/dycore/prim_driver_mod.F90 @@ -1,4 +1,3 @@ -!#define old_cam !#define _DBG_ print *,"file: ",__FILE__," line: ",__LINE__," ithr: ",hybrid%ithr #define _DBG_ module prim_driver_mod @@ -28,13 +27,8 @@ subroutine prim_init2(elem, fvm, hybrid, nets, nete, tl, hvcoord) use dimensions_mod, only: irecons_tracer, fvm_supercycling use dimensions_mod, only: fv_nphys, nc use parallel_mod, only: syncmp -#ifdef old_cam - use time_mod, only: timelevel_t, tstep, phys_tscale, nsplit, TimeLevel_Qdp - use time_mod, only: nsplit_baseline,rsplit_baseline -#else use se_dyn_time_mod, only: timelevel_t, tstep, phys_tscale, nsplit, TimeLevel_Qdp use se_dyn_time_mod, only: nsplit_baseline,rsplit_baseline -#endif use prim_state_mod, only: prim_printstate use control_mod, only: runtype, topology, rsplit, qsplit, rk_stage_user, & nu, nu_q, nu_div, hypervis_subcycle, hypervis_subcycle_q, & @@ -224,11 +218,7 @@ subroutine prim_run_subcycle(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,nsubst ! ! use hybvcoord_mod, only : hvcoord_t -#ifdef old_cam - use time_mod, only: TimeLevel_t, timelevel_update, timelevel_qdp, nsplit -#else use se_dyn_time_mod, only: TimeLevel_t, timelevel_update, timelevel_qdp, nsplit -#endif use control_mod, only: statefreq,qsplit, rsplit, variable_nsplit, dribble_in_rsplit_loop use prim_advance_mod, only: applycamforcing use prim_advance_mod, only: tot_energy_dyn,compute_omega @@ -432,11 +422,7 @@ subroutine prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord, rstep, last_s ! tl%n0 time t + dt_q ! use hybvcoord_mod, only: hvcoord_t -#ifdef old_cam - use time_mod, only: TimeLevel_t, timelevel_update -#else use se_dyn_time_mod, only: TimeLevel_t, timelevel_update -#endif use control_mod, only: statefreq, qsplit, nu_p use thread_mod, only: omp_get_thread_num use prim_advance_mod, only: prim_advance_exp @@ -447,11 +433,7 @@ subroutine prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord, rstep, last_s use dimensions_mod, only: kmin_jet, kmax_jet use fvm_mod, only: ghostBufQnhc_vh,ghostBufQ1_vh, ghostBufFlux_vh use fvm_mod, only: ghostBufQ1_h,ghostBufQnhcJet_h, ghostBufFluxJet_h -#ifdef old_cam - use time_mod, only: timelevel_qdp -#else use se_dyn_time_mod, only: timelevel_qdp -#endif use fvm_mapping, only: cslam2gll #ifdef waccm_debug use cam_history, only: outfld diff --git a/src/dynamics/se/dyn_comp.F90 b/src/dynamics/se/dyn_comp.F90 index b147659299..42059ef820 100644 --- a/src/dynamics/se/dyn_comp.F90 +++ b/src/dynamics/se/dyn_comp.F90 @@ -1,4 +1,3 @@ -!#define old_cam module dyn_comp ! CAM interfaces to the SE Dynamical Core @@ -43,11 +42,7 @@ module dyn_comp use dimensions_mod, only: qsize, use_cslam use element_mod, only: element_t, elem_state_t use fvm_control_volume_mod, only: fvm_struct -#ifdef old_cam -use time_mod, only: nsplit -#else use se_dyn_time_mod, only: nsplit -#endif use edge_mod, only: initEdgeBuffer, edgeVpack, edgeVunpack, FreeEdgeBuffer use edgetype_mod, only: EdgeBuffer_t use bndry_mod, only: bndry_exchange @@ -1041,11 +1036,7 @@ subroutine dyn_run(dyn_state) use air_composition, only: thermodynamic_active_species_idx_dycore use prim_driver_mod, only: prim_run_subcycle use dimensions_mod, only: cnst_name_gll -#ifdef old_cam - use time_mod, only: tstep, nsplit, timelevel_qdp, tevolve -#else use se_dyn_time_mod, only: tstep, nsplit, timelevel_qdp, tevolve -#endif use hybrid_mod, only: config_thread_region, get_loop_ranges use control_mod, only: qsplit, rsplit, ftype_conserve use thread_mod, only: horz_num_threads diff --git a/src/dynamics/se/dyn_grid.F90 b/src/dynamics/se/dyn_grid.F90 index 7d94591c86..b808ee587d 100644 --- a/src/dynamics/se/dyn_grid.F90 +++ b/src/dynamics/se/dyn_grid.F90 @@ -1,4 +1,3 @@ -!#define old_cam module dyn_grid !------------------------------------------------------------------------------- ! @@ -49,11 +48,7 @@ module dyn_grid use prim_init, only: prim_init1 use edge_mod, only: initEdgeBuffer use edgetype_mod, only: EdgeBuffer_t -#ifdef old_cam -use time_mod, only: TimeLevel_t -#else use se_dyn_time_mod, only: TimeLevel_t -#endif use dof_mod, only: UniqueCoords, UniquePoints implicit none @@ -138,11 +133,7 @@ subroutine dyn_grid_init() use hybrid_mod, only: hybrid_t, init_loop_ranges, & get_loop_ranges, config_thread_region use control_mod, only: qsplit, rsplit -#ifdef old_cam - use time_mod, only: tstep, nsplit -#else use se_dyn_time_mod, only: tstep, nsplit -#endif use fvm_mod, only: fvm_init2, fvm_init3, fvm_pg_init use dimensions_mod, only: irecons_tracer use comp_gll_ctr_vol, only: gll_grid_write From 33012678a8af030be35ce655e3a4e61eb3c5edd9 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Tue, 30 Jan 2024 10:18:10 -0700 Subject: [PATCH 214/291] Revert setting GEOS-Chem $chem_cppdefs to earlier in configure Signed-off-by: Lizzie Lundgren --- bld/configure | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/bld/configure b/bld/configure index c44ea94669..c695f384c7 100755 --- a/bld/configure +++ b/bld/configure @@ -1407,9 +1407,10 @@ if ($chem_pkg =~ '_mam3') { $chem_cppdefs = ' -DMODAL_AERO -DMODAL_AERO_7MODE '; } -# Customize GEOS-Chem advected species +# Customize GEOS-Chem advected species and chemistry CPP definitions if ($chem_pkg =~ 'geoschem') { - if ($chem_pkg eq 'geoschem_mam4') { + $chem_cppdefs .= ' -DEXTERNAL_GRID -DEXTERNAL_FORCING '; + if ($chem_pkg =~ '_mam4') { $chem_nadv = 267; # includes GC advected species (233), CO2 (1), and MAM aerosols (33) } } @@ -1950,7 +1951,6 @@ $cfg_cppdefs .= ' -DMODEL_ -DMODEL_CESM -DHEMCO_CESM -DUSE_REAL8 '; # Compiler CPP definitions for GEOS-Chem if ($chem_pkg =~ 'geoschem') { - $chem_cppdefs .= ' -DEXTERNAL_GRID -DEXTERNAL_FORCING'; if ($fc_type eq 'intel') { $cfg_cppdefs .= ' -DLINUX_IFORT'; } elsif ($fc_type eq 'gnu') { $cfg_cppdefs .= ' -DLINUX_GFORTRAN'; } } From 9a4144a7ed59ca943ae29074b75029d01b25538b Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Tue, 30 Jan 2024 10:18:39 -0700 Subject: [PATCH 215/291] Remove project paths to GEOS-Chem inputs; now stored in inputdata Signed-off-by: Lizzie Lundgren --- bld/namelist_files/use_cases/2000_geoschem.xml | 6 +++--- bld/namelist_files/use_cases/2010_geoschem.xml | 6 +++--- bld/namelist_files/use_cases/hist_geoschem.xml | 6 +++--- bld/namelist_files/use_cases/hist_geoschem_nudged.xml | 6 +++--- 4 files changed, 12 insertions(+), 12 deletions(-) diff --git a/bld/namelist_files/use_cases/2000_geoschem.xml b/bld/namelist_files/use_cases/2000_geoschem.xml index f85e1dd4ef..7463a49361 100644 --- a/bld/namelist_files/use_cases/2000_geoschem.xml +++ b/bld/namelist_files/use_cases/2000_geoschem.xml @@ -6,11 +6,11 @@ -/glade/p/univ/umit0034/ExtData/CHEM_INPUTS/ +atm/cam/geoschem/ExtData/CHEM_INPUTS/ -/glade/p/univ/umit0034/Shared/GEOS-Chem/f.e20.FC2010.f09_f09.144.GC_vbsext.001.cam.i.0007-01-01-00000.nc +atm/cam/geoschem/initial_conditions/f.e20.FC2010.f09_f09.144.GC_vbsext.001.cam.i.0007-01-01-00000.nc -/glade/p/univ/umit0034/Shared/GEOS-Chem/f.e20.FC2010.f19_f19.144.GC_vbsext.001.cam.i.0007-01-01-00000.nc +atm/cam/geoschem/initial_conditions/f.e20.FC2010.f19_f19.144.GC_vbsext.001.cam.i.0007-01-01-00000.nc HEMCO_Config.rc HEMCO_Diagn.rc diff --git a/bld/namelist_files/use_cases/2010_geoschem.xml b/bld/namelist_files/use_cases/2010_geoschem.xml index 72685aa4d2..2d3ee5db95 100644 --- a/bld/namelist_files/use_cases/2010_geoschem.xml +++ b/bld/namelist_files/use_cases/2010_geoschem.xml @@ -4,11 +4,11 @@ -/glade/p/univ/umit0034/ExtData/CHEM_INPUTS/ +atm/cam/geoschem/ExtData/CHEM_INPUTS/ -/glade/p/univ/umit0034/Shared/GEOS-Chem/f.e20.FC2010.f09_f09.144.GC_vbsext.001.cam.i.0007-01-01-00000.nc +atm/cam/geoschem/initial_conditions/f.e20.FC2010.f09_f09.144.GC_vbsext.001.cam.i.0007-01-01-00000.nc -/glade/p/univ/umit0034/Shared/GEOS-Chem/f.e20.FC2010.f19_f19.144.GC_vbsext.001.cam.i.0007-01-01-00000.nc +atm/cam/geoschem/initial_conditions/f.e20.FC2010.f19_f19.144.GC_vbsext.001.cam.i.0007-01-01-00000.nc HEMCO_Config.rc HEMCO_Diagn.rc diff --git a/bld/namelist_files/use_cases/hist_geoschem.xml b/bld/namelist_files/use_cases/hist_geoschem.xml index ea28eca22c..78b681e572 100644 --- a/bld/namelist_files/use_cases/hist_geoschem.xml +++ b/bld/namelist_files/use_cases/hist_geoschem.xml @@ -6,11 +6,11 @@ -/glade/p/univ/umit0034/ExtData/CHEM_INPUTS/ +atm/cam/geoschem/ExtData/CHEM_INPUTS/ -/glade/p/univ/umit0034/Shared/GEOS-Chem/f.e20.FC2010.f09_f09.144.GC_vbsext.001.cam.i.0007-01-01-00000.nc +atm/cam/geoschem/initial_conditions/f.e20.FC2010.f09_f09.144.GC_vbsext.001.cam.i.0007-01-01-00000.nc -/glade/p/univ/umit0034/Shared/GEOS-Chem/f.e20.FC2010.f19_f19.144.GC_vbsext.001.cam.i.0007-01-01-00000.nc +atm/cam/geoschem/initial_conditions/f.e20.FC2010.f19_f19.144.GC_vbsext.001.cam.i.0007-01-01-00000.nc HEMCO_Config.rc HEMCO_Diagn.rc diff --git a/bld/namelist_files/use_cases/hist_geoschem_nudged.xml b/bld/namelist_files/use_cases/hist_geoschem_nudged.xml index 8a32ee167b..0550880d80 100644 --- a/bld/namelist_files/use_cases/hist_geoschem_nudged.xml +++ b/bld/namelist_files/use_cases/hist_geoschem_nudged.xml @@ -6,11 +6,11 @@ -/glade/p/univ/umit0034/ExtData/CHEM_INPUTS/ +atm/cam/geoschem/ExtData/CHEM_INPUTS/ -/glade/p/univ/umit0034/Shared/GEOS-Chem/f.e20.FC2010.f09_f09.144.GC_vbsext.001.cam.i.0007-01-01-00000.nc +atm/cam/geoschem/initial_conditions/f.e20.FC2010.f09_f09.144.GC_vbsext.001.cam.i.0007-01-01-00000.nc -/glade/p/univ/umit0034/Shared/GEOS-Chem/f.e20.FC2010.f19_f19.144.GC_vbsext.001.cam.i.0007-01-01-00000.nc +atm/cam/geoschem/initial_conditions//f.e20.FC2010.f19_f19.144.GC_vbsext.001.cam.i.0007-01-01-00000.nc HEMCO_Config.rc HEMCO_Diagn.rc From a4d2a3a5dd2b399a8ac22f3a05b26165e8b97ae0 Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Tue, 30 Jan 2024 10:42:25 -0700 Subject: [PATCH 216/291] forgot to remove ifndef old_cam --- src/dynamics/se/dp_coupling.F90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/dynamics/se/dp_coupling.F90 b/src/dynamics/se/dp_coupling.F90 index 326f979ef9..1fdd52a0e4 100644 --- a/src/dynamics/se/dp_coupling.F90 +++ b/src/dynamics/se/dp_coupling.F90 @@ -545,9 +545,7 @@ subroutine derived_phys_dry(phys_state, phys_tend, pbuf2d) use shr_const_mod, only: shr_const_rwv use phys_control, only: waccmx_is use geopotential, only: geopotential_t -#ifndef old_cam use static_energy, only: update_dry_static_energy_run -#endif use check_energy, only: check_energy_timestep_init use hycoef, only: hyai, ps0 use shr_vmath_mod, only: shr_vmath_log From 7627b26f9ff263e3fe435565806e93505f5db648 Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Tue, 30 Jan 2024 10:47:38 -0700 Subject: [PATCH 217/291] remove comment --- src/dynamics/se/dycore/fvm_reconstruction_mod.F90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/dynamics/se/dycore/fvm_reconstruction_mod.F90 b/src/dynamics/se/dycore/fvm_reconstruction_mod.F90 index da0a8fc664..e6405939de 100644 --- a/src/dynamics/se/dycore/fvm_reconstruction_mod.F90 +++ b/src/dynamics/se/dycore/fvm_reconstruction_mod.F90 @@ -113,8 +113,6 @@ subroutine reconstruction(fcube,nlev_in,k_in,recons,irecons,llimiter,ntrac_in,& end do else do itr=1,ntrac_in - !to avoid floating point exception for uninitialized variables !xxx - !in non-existent cells (corners of cube) call extend_panel_interpolate(nc,nhc,nhr,nht,ns,nh,& fcube(:,:,k_in,itr),cubeboundary,halo_interp_weight,ibase,f(:,:,1)) call get_gradients(f(:,:,:),jx,jy,irecons,recons(:,:,:,itr),& From ea7da3216099805d0ce9b8b5d89993f10f219002 Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Tue, 30 Jan 2024 10:49:02 -0700 Subject: [PATCH 218/291] fix previous commit --- src/dynamics/se/dycore/fvm_reconstruction_mod.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/src/dynamics/se/dycore/fvm_reconstruction_mod.F90 b/src/dynamics/se/dycore/fvm_reconstruction_mod.F90 index e6405939de..b4708dfd3b 100644 --- a/src/dynamics/se/dycore/fvm_reconstruction_mod.F90 +++ b/src/dynamics/se/dycore/fvm_reconstruction_mod.F90 @@ -105,7 +105,6 @@ subroutine reconstruction(fcube,nlev_in,k_in,recons,irecons,llimiter,ntrac_in,& if(FVM_TIMERS) call t_startf('FVM:reconstruction:part#1') if (nhe>0) then do itr=1,ntrac_in - !f=-9e9_r8 call extend_panel_interpolate(nc,nhc,nhr,nht,ns,nh,& fcube(:,:,k_in,itr),cubeboundary,halo_interp_weight,ibase,f(:,:,1),f(:,:,2:3)) call get_gradients(f(:,:,:),jx,jy,irecons,recons(:,:,:,itr),& From ed72e9a97f727573a7dfc500bf63008b4c1bf1f3 Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Tue, 30 Jan 2024 10:51:36 -0700 Subject: [PATCH 219/291] remove ifndef old_cam --- src/dynamics/se/dyn_comp.F90 | 48 ------------------------------------ 1 file changed, 48 deletions(-) diff --git a/src/dynamics/se/dyn_comp.F90 b/src/dynamics/se/dyn_comp.F90 index 42059ef820..5ee535be7f 100644 --- a/src/dynamics/se/dyn_comp.F90 +++ b/src/dynamics/se/dyn_comp.F90 @@ -169,7 +169,6 @@ subroutine dyn_readnl(NLFileName) real(r8) :: se_molecular_diff integer :: se_pgf_formulation integer :: se_dribble_in_rsplit_loop -#ifndef old_cam namelist /dyn_se_inparm/ & se_fine_ne, & ! For refined meshes se_ftype, & ! forcing type @@ -216,53 +215,6 @@ subroutine dyn_readnl(NLFileName) se_molecular_diff, & se_pgf_formulation, & se_dribble_in_rsplit_loop -#else - namelist /dyn_se_inparm/ & - se_fine_ne, & ! For refined meshes - se_ftype, & ! forcing type - se_statediag_numtrac, & - se_fv_nphys, & - se_hypervis_power, & - se_hypervis_scaling, & - se_hypervis_subcycle, & - se_hypervis_subcycle_sponge, & - se_hypervis_subcycle_q, & - se_limiter_option, & - se_max_hypervis_courant, & - se_mesh_file, & ! Refined mesh definition file - se_ne, & - se_npes, & - se_nsplit, & ! # of dyn steps per physics timestep - se_nu, & - se_nu_div, & - se_nu_p, & - se_nu_top, & - se_sponge_del4_nu_fac, & - se_sponge_del4_nu_div_fac, & - se_sponge_del4_lev, & - se_qsplit, & - se_refined_mesh, & - se_rsplit, & - se_statefreq, & ! number of steps per printstate call - se_tstep_type, & - se_vert_remap_T, & - se_vert_remap_uvTq_alg, & - se_vert_remap_tracer_alg, & - se_write_grid_file, & - se_grid_filename, & - se_write_gll_corners, & - se_horz_num_threads, & - se_vert_num_threads, & - se_tracer_num_threads, & - se_write_restart_unstruct, & - se_large_Courant_incr, & - se_fvm_supercycling, & - se_fvm_supercycling_jet, & - se_kmin_jet, & - se_kmax_jet, & - se_molecular_diff, & - se_pgf_formulation -#endif !-------------------------------------------------------------------------- ! defaults for variables not set by build-namelist From 8bbc109a28147a4068864cc9390cb289dfc0918b Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Tue, 30 Jan 2024 10:52:30 -0700 Subject: [PATCH 220/291] complete previous commit --- src/dynamics/se/dyn_comp.F90 | 4 ---- 1 file changed, 4 deletions(-) diff --git a/src/dynamics/se/dyn_comp.F90 b/src/dynamics/se/dyn_comp.F90 index 5ee535be7f..6f8eb5477a 100644 --- a/src/dynamics/se/dyn_comp.F90 +++ b/src/dynamics/se/dyn_comp.F90 @@ -288,9 +288,7 @@ subroutine dyn_readnl(NLFileName) call MPI_bcast(se_kmax_jet, 1, mpi_integer, masterprocid, mpicom, ierr) call MPI_bcast(se_molecular_diff, 1, mpi_real8, masterprocid, mpicom, ierr) call MPI_bcast(se_pgf_formulation, 1, mpi_integer, masterprocid, mpicom, ierr) -#ifndef old_cam call MPI_bcast(se_dribble_in_rsplit_loop, 1, mpi_integer, masterprocid, mpicom, ierr) -#endif if (se_npes <= 0) then call endrun('dyn_readnl: ERROR: se_npes must be > 0') end if @@ -358,9 +356,7 @@ subroutine dyn_readnl(NLFileName) variable_nsplit = .false. molecular_diff = se_molecular_diff pgf_formulation = se_pgf_formulation -#ifndef old_cam dribble_in_rsplit_loop = se_dribble_in_rsplit_loop -#endif if (fv_nphys > 0) then ! Use finite volume physics grid and CSLAM for tracer advection nphys_pts = fv_nphys*fv_nphys From c809163147e15e915da95356a5eba23588a8ff0e Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Tue, 30 Jan 2024 11:08:56 -0700 Subject: [PATCH 221/291] add changelog message --- doc/ChangeLog | 86 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 86 insertions(+) diff --git a/doc/ChangeLog b/doc/ChangeLog index a219f92580..431d836a74 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,5 +1,91 @@ =============================================================== +Tag name: cam6_3_xxx +Originator(s): pel +Date: Jan 30, 2024 +One-line Summary: "science optimization" for SE-CSLAM and stabilize WACCM +Github PR URL: https://github.com/ESCOMP/CAM/pull/xxx + +Increase computational throughput of the SE-CSLAM dynamical core by: + + - Reducing se_nsplit to 2 (from 3) in FMT: CSLAM now runs with ~30% longer time-step compared to baseline + - No double advection of thermodynamic active tracers when using CSLAM. Overwrite GLL values of Q, CLDLIQ, + etc. every vertical remapping time-step with CSLAM values (interpolated from physics grid to GLL grid) + - Vertical sponge layer diffusion in physics for WACCM and WACCM-x + - No increased hyperdiffusion in sponge for FLT and FMT + +Provide stable configuration for WACCM with spectral-elements (ne30-pg3 and ne16pg3): namelist changes + +Resolve qneg issue 864 +Resolve issue 552 (read in topo file on GLL grid if available) +Partially resolve issue 951 (remove namelist defaults for pg4 grids) + +Describe any changes made to build system: + + - added namelist variable + +Describe any changes made to the namelist: + + - changed bnd_topo file for ne30-pg3 for reading in topography + on the GLL grid (if available) (issue #552) + - remove namelist defaults for pg4 topo files (issue #951) + - added namelist se_dribble_in_rsplit_loop to stabilize ne16pg3 WACCM + - change se_nsplit, se_rsplit and se_hypervis_subcycle for efficiency/stability + - se_hypervis_subcycle_sponge for efficiency/stability + - change se_nu, se_nu_div and se_sponge_del4_nu_div_fac to stabilize + ne16pg3 WACCM + + +List any changes to the defaults for the boundary datasets: + - new default topo file for ne30pg3 + +Describe any substantial timing or memory changes: + + - approximately 30% speed-up of entire CAM model using COMPSET FLTHIST or FMTHIST + + +List all existing files that have been modified, and describe the changes: + + bld/build-namelist + - add namelist variable + bld/namelist_files/namelist_defaults_cam.xml + - change defaults (see above) + bld/namelist_files/namelist_definition.xml + - add namelist variable + + all dycore changes described above (individual file changes not listed!) + + src/dynamics/se/dp_coupling.F90 + src/dynamics/se/dycore/control_mod.F90 + src/dynamics/se/dycore/fvm_control_volume_mod.F90 + src/dynamics/se/dycore/fvm_mapping.F90 + src/dynamics/se/dycore/fvm_mod.F90 + src/dynamics/se/dycore/fvm_reconstruction_mod.F90 + src/dynamics/se/dycore/global_norms_mod.F90 + src/dynamics/se/dycore/prim_advance_mod.F90 + src/dynamics/se/dycore/prim_advection_mod.F90 + src/dynamics/se/dycore/prim_driver_mod.F90 + src/dynamics/se/dyn_comp.F90 + src/dynamics/se/dyn_grid.F90 + + src/dynamics/se/gravity_waves_sources.F90 + - fix model top pressure bug + src/physics/cam/vertical_diffusion.F90 + - vertical sponge layer diffusion + +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. + + All spectral-element tests fail due to baseline differences. + The SE-CSLAM tests fail because of no double-advection + change as well as default hyperviscosity change + The SE (not CSLAM) tests fail because default hyperviscosity has changed + All WACCM tests fail due to added sponge layer vertical diffusion + +=============================================================== + Tag name: cam6_3_146 Originator(s): cacraig Date: Jan 23, 2024 From 648368f93b38e252cc3f9411f6e9da26968c5eaa Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Tue, 30 Jan 2024 11:13:06 -0700 Subject: [PATCH 222/291] minor modification to changelog --- doc/ChangeLog | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index 431d836a74..b630e00f05 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -18,7 +18,7 @@ Provide stable configuration for WACCM with spectral-elements (ne30-pg3 and ne16 Resolve qneg issue 864 Resolve issue 552 (read in topo file on GLL grid if available) -Partially resolve issue 951 (remove namelist defaults for pg4 grids) +Resolve issue 951 (remove namelist defaults for pg4 grids) Describe any changes made to build system: From c18380c179a758804ecf437e7f4c91f1bd9fcf6b Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Tue, 30 Jan 2024 15:27:01 -0700 Subject: [PATCH 223/291] Updated GEOs-Chem tests from cheyenne to derecho Signed-off-by: Lizzie Lundgren --- cime_config/testdefs/testlist_cam.xml | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/cime_config/testdefs/testlist_cam.xml b/cime_config/testdefs/testlist_cam.xml index 2a508ee4d0..2842400c22 100644 --- a/cime_config/testdefs/testlist_cam.xml +++ b/cime_config/testdefs/testlist_cam.xml @@ -19,7 +19,7 @@ - + @@ -44,7 +44,7 @@ - + @@ -1725,15 +1725,16 @@ - + - + - + + - + @@ -1946,7 +1947,7 @@ - + From 5d05e8c5320c752006a4fb0248ce6206cd2c730e Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Tue, 30 Jan 2024 15:34:18 -0700 Subject: [PATCH 224/291] Add categories prealpha and aux_cam to all GEOS-Chem compset tests Signed-off-by: Lizzie Lundgren --- cime_config/testdefs/testlist_cam.xml | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/cime_config/testdefs/testlist_cam.xml b/cime_config/testdefs/testlist_cam.xml index 2842400c22..5cd268c466 100644 --- a/cime_config/testdefs/testlist_cam.xml +++ b/cime_config/testdefs/testlist_cam.xml @@ -20,6 +20,8 @@ + + @@ -45,6 +47,8 @@ + + @@ -1728,6 +1732,8 @@ + + @@ -1948,6 +1954,8 @@ + + From 5fa370c9c6bfc17dcaffbf3bd6625f400af23dc4 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Wed, 31 Jan 2024 08:17:40 -0700 Subject: [PATCH 225/291] Delete redundant setting of deposition lists in namelists Signed-off-by: Lizzie Lundgren --- bld/build-namelist | 4 ---- 1 file changed, 4 deletions(-) diff --git a/bld/build-namelist b/bld/build-namelist index 1440069dd2..ff3375bd1b 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -613,10 +613,6 @@ if ( ($chem ne 'none') or ( $prog_species ) ){ if (length($aer_drydep_list)>2){ add_default($nl, 'aer_drydep_list', 'val'=>$aer_drydep_list ); } - $nl->set_variable_value('aerosol_nl', 'aer_drydep_list', $aer_drydep_list); - $nl->set_variable_value('aerosol_nl', 'aer_wetdep_list', $aer_wetdep_list); - $nl->set_variable_value('drydep_inparm', 'drydep_list', $gas_drydep_list); - $nl->set_variable_value('wetdep_inparm', 'gas_wetdep_list', $gas_wetdep_list); } if ($chem) { # drydep_srf_file is only needed for prognostic MAM when the grid is unstructured. From 28412bfe7f7eff39c5e870a3e26012dabb333c45 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Wed, 31 Jan 2024 08:22:23 -0700 Subject: [PATCH 226/291] Reduce GEOS-Chem tests to one aux_cam and one prealpha across two compsets Signed-off-by: Lizzie Lundgren --- cime_config/testdefs/testlist_cam.xml | 6 ------ 1 file changed, 6 deletions(-) diff --git a/cime_config/testdefs/testlist_cam.xml b/cime_config/testdefs/testlist_cam.xml index 5cd268c466..2ec7898bd9 100644 --- a/cime_config/testdefs/testlist_cam.xml +++ b/cime_config/testdefs/testlist_cam.xml @@ -20,8 +20,6 @@ - - @@ -47,8 +45,6 @@ - - @@ -1733,7 +1729,6 @@ - @@ -1954,7 +1949,6 @@ - From 40371e470698906677ec4d3835248ba1dbdc06de Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Wed, 31 Jan 2024 14:51:06 -0700 Subject: [PATCH 227/291] Change FCnudged_GC derecho test to not use zonal mean nudging I previously changed the test to zonal mean nudging when updating from cheyenne to derecho. Apparently the compset is not set up to do this and I therefore reverted to the previous test which is basic nuging. Signed-off-by: Lizzie Lundgren --- cime_config/testdefs/testlist_cam.xml | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/cime_config/testdefs/testlist_cam.xml b/cime_config/testdefs/testlist_cam.xml index ccb48d54d9..070c80eb2e 100644 --- a/cime_config/testdefs/testlist_cam.xml +++ b/cime_config/testdefs/testlist_cam.xml @@ -1705,14 +1705,13 @@ - + - - + From a3571bc819dfe8cb40e5e8a80b23a41e79e7a5fd Mon Sep 17 00:00:00 2001 From: Brian Eaton Date: Wed, 31 Jan 2024 19:38:48 -0500 Subject: [PATCH 228/291] address review comments --- bld/configure | 5 + cime_config/testdefs/testlist_cam.xml | 15 +- doc/ChangeLog | 34 ++- src/physics/cam/cloud_rad_props.F90 | 30 +-- ...t_curry.F90 => ebert_curry_ice_optics.F90} | 4 +- .../cam/{oldcloud.F90 => oldcloud_optics.F90} | 30 +-- .../cam/{slingo.F90 => slingo_liq_optics.F90} | 4 +- src/physics/rrtmg/radiation.F90 | 4 +- src/physics/rrtmgp/mcica_subcol_gen.F90 | 2 - src/physics/rrtmgp/radconstants.F90 | 20 +- src/physics/rrtmgp/radiation.F90 | 214 ++++++++++++------ 11 files changed, 230 insertions(+), 132 deletions(-) rename src/physics/cam/{ebert_curry.F90 => ebert_curry_ice_optics.F90} (99%) rename src/physics/cam/{oldcloud.F90 => oldcloud_optics.F90} (94%) rename src/physics/cam/{slingo.F90 => slingo_liq_optics.F90} (99%) diff --git a/bld/configure b/bld/configure index 9716d92579..3fb0bb74a1 100755 --- a/bld/configure +++ b/bld/configure @@ -1099,6 +1099,11 @@ elsif ($rad_pkg =~ m/rrtmg/) { die "configure ERROR: radiation package: $rad_pkg is not compatible\n". " with physics package $phys_pkg\n"; } + + # RRTMGP not currently working with CARMA + if ($rad_pkg eq 'rrtmgp' and $carma_pkg ne 'none') { + die "configure ERROR: The CARMA microphysics package does not currently work with RRTMGP\n"; + } } $cfg_ref->set('rad', $rad_pkg); diff --git a/cime_config/testdefs/testlist_cam.xml b/cime_config/testdefs/testlist_cam.xml index 1061073d4d..69d80f54e5 100644 --- a/cime_config/testdefs/testlist_cam.xml +++ b/cime_config/testdefs/testlist_cam.xml @@ -199,12 +199,13 @@ - + + @@ -1795,11 +1796,11 @@ - + - + @@ -1813,11 +1814,11 @@ - + - + @@ -2765,10 +2766,11 @@ - + + @@ -2865,6 +2867,7 @@ + diff --git a/doc/ChangeLog b/doc/ChangeLog index cac91effcd..3c6f232433 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -11,6 +11,12 @@ Purpose of changes (include the issue number and title text for each relevant Gi #255 - Provide RRTMGP as a radiation parameterization https://github.com/ESCOMP/CAM/issues/255 +Miscellaneous: +. The 1850_cam5.xml use case file was added back to the source code to + facilitate running the F1850 compset with CAM5. That discussion is in + issue #393. + + Describe any changes made to build system: . '-rad' argument to configure accepts the values 'rrtmgp' and 'rrtmgp_gpu' to build the RRTMGP code for CPUs or for GPUs. @@ -48,11 +54,16 @@ cime_config/testdefs/testmods_dirs/cam/outfrq9s_rrtmgp/user_nl_clm . for adding RRTMGP to tests src/physics/cam/cloud_rad_props.F90 -src/physics/cam/ebert_curry.F90 -src/physics/cam/oldcloud.F90 -src/physics/cam/slingo.F90 -. these 4 files are shared cloud optics code moved here from src/physics/rrtmg/. -. remove unused code, cleanup unused vars +src/physics/cam/ebert_curry_ice_optics.F90 +src/physics/cam/oldcloud_optics.F90 +src/physics/cam/slingo_liq_optics.F90 +. these 4 files are shared cloud optics code moved here from + src/physics/rrtmg/ with the following name changes: + - ebert_curry.F90 -> ebert_curry_ice_optics.F90 + - oldcloud.F90 -> oldcloud_optics.F90 + - slingo.F90 -> slingo_liq_optics.F90 +. remove unused code, cleanup unused vars, improve endrun messages +. module names changed to match file names. src/physics/rrtmgp/mcica_subcol_gen.F90 src/physics/rrtmgp/radconstants.F90 @@ -83,6 +94,7 @@ bld/configure . '-rad rrtmgp_gpu' sets a flag used to add the filepaths for the GPU code versions to the Filepath file. The '_gpu' suffix is removed before setting the parameter value for 'rad' in the config_cache.xml file. +. check to disallow CARMA + RRTMGP bld/namelist_files/namelist_defaults_cam.xml . the aersol and cloud optics datasets for RRTMG are being reused for @@ -93,13 +105,14 @@ bld/namelist_files/namelist_definition.xml . add variables rrtmgp_coefs_lw_file and rrtmgp_coefs_sw_file to contain filepaths for the RRTMGP coefficients files. -cime_config/testdefs/testlist_cam.xml (aux_cam) +cime_config/testdefs/testlist_cam.xml . add aux_cam tests: - ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.cheyenne_intel.cam-outfrq9s_rrtmgp - SMS_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_rrtmgp - SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.cheyenne_intel.cam-outfrq9s_rrtmgp + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s_rrtmgp + SMS_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_rrtmgp ERP_D_Ln9.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_rrtmgp SMS_Ld5.f09_f09_mg17.PC6.izumi_gnu.cam-cam6_port_f09_rrtmgp +. add prealpha test: + SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s_rrtmgp src/chemistry/utils/solar_data.F90 . add solar_htng_spctrl_scl to log file output @@ -134,6 +147,9 @@ src/physics/camrt/radconstants.F90 src/physics/rrtmg/radconstants.F90 . parameters ot_length and nrh moved to phys_props +src/physics/rrtmg/radiation.F90 +. ebert_curry -> ebert_curry_ice_optics + src/physics/simple/radconstants.F90 . parameters ot_length and nrh moved to phys_props . add dummy interface for get_sw_spectral_boundaries diff --git a/src/physics/cam/cloud_rad_props.F90 b/src/physics/cam/cloud_rad_props.F90 index 1e518a47d7..9c8a1a3562 100644 --- a/src/physics/cam/cloud_rad_props.F90 +++ b/src/physics/cam/cloud_rad_props.F90 @@ -10,12 +10,11 @@ module cloud_rad_props use constituents, only: cnst_get_ind use radconstants, only: nswbands, nlwbands, idx_sw_diag use rad_constituents, only: iceopticsfile, liqopticsfile -use oldcloud, only: oldcloud_init, oldcloud_lw, & +use oldcloud_optics, only: oldcloud_init, oldcloud_lw, & old_liq_get_rad_props_lw, old_ice_get_rad_props_lw - -use slingo, only: slingo_rad_props_init -use ebert_curry, only: ec_rad_props_init, scalefactor +use slingo_liq_optics, only: slingo_rad_props_init +use ebert_curry_ice_optics, only: ec_rad_props_init, scalefactor use interpolate_data, only: interp_type, lininterp_init, lininterp, & extrap_method_bndry, lininterp_finish @@ -101,6 +100,7 @@ subroutine cloud_rad_props_init() integer :: d_id, ext_sw_ice_id, ssa_sw_ice_id, asm_sw_ice_id, abs_lw_ice_id integer :: err + character(len=*), parameter :: sub = 'cloud_rad_props_init' liquidfile = liqopticsfile icefile = iceopticsfile @@ -131,11 +131,11 @@ subroutine cloud_rad_props_init() call handle_ncerr(nf90_inq_dimid( ncid, 'lw_band', dimid), 'getting lw_band dim') call handle_ncerr(nf90_inquire_dimension( ncid, dimid, len=f_nlwbands), 'getting n lw bands') - if (f_nlwbands /= nlwbands) call endrun('number of lw bands does not match') + if (f_nlwbands /= nlwbands) call endrun(sub//': number of lw bands does not match') call handle_ncerr(nf90_inq_dimid( ncid, 'sw_band', dimid), 'getting sw_band_dim') call handle_ncerr(nf90_inquire_dimension( ncid, dimid, len=f_nswbands), 'getting n sw bands') - if (f_nswbands /= nswbands) call endrun('number of sw bands does not match') + if (f_nswbands /= nswbands) call endrun(sub//': number of sw bands does not match') call handle_ncerr(nf90_inq_dimid( ncid, 'mu', mudimid), 'getting mu dim') call handle_ncerr(nf90_inquire_dimension( ncid, mudimid, len=nmu), 'getting n mu samples') @@ -210,12 +210,12 @@ subroutine cloud_rad_props_init() call handle_ncerr(nf90_inq_dimid( ncid, 'lw_band', dimid), 'getting lw_band dim') call handle_ncerr(nf90_inquire_dimension( ncid, dimid, len=f_nlwbands), 'getting n lw bands') if (f_nlwbands /= nlwbands) then - call endrun('number of lw bands does not match') + call endrun(sub//': number of lw bands does not match') end if call handle_ncerr(nf90_inq_dimid( ncid, 'sw_band', dimid), 'getting sw_band_dim') call handle_ncerr(nf90_inquire_dimension( ncid, dimid, len=f_nswbands), 'getting n sw bands') if (f_nswbands /= nswbands) then - call endrun('number of sw bands does not match') + call endrun(sub//': number of sw bands does not match') end if call handle_ncerr(nf90_inq_dimid( ncid, 'd_eff', d_dimid), 'getting deff dim') call handle_ncerr(nf90_inquire_dimension( ncid, d_dimid, len=n_g_d), 'getting n deff samples') @@ -347,7 +347,7 @@ subroutine get_ice_optics_sw(state, pbuf, tau, tau_w, tau_w_g, tau_w_f) real(r8),intent(out) :: tau (nswbands,pcols,pver) ! extinction optical depth real(r8),intent(out) :: tau_w (nswbands,pcols,pver) ! single scattering albedo * tau - real(r8),intent(out) :: tau_w_g(nswbands,pcols,pver) ! assymetry parameter * tau * w + real(r8),intent(out) :: tau_w_g(nswbands,pcols,pver) ! asymetry parameter * tau * w real(r8),intent(out) :: tau_w_f(nswbands,pcols,pver) ! forward scattered fraction * tau * w real(r8), pointer :: iciwpth(:,:), dei(:,:) @@ -370,7 +370,7 @@ subroutine get_snow_optics_sw(state, pbuf, tau, tau_w, tau_w_g, tau_w_f) real(r8),intent(out) :: tau (nswbands,pcols,pver) ! extinction optical depth real(r8),intent(out) :: tau_w (nswbands,pcols,pver) ! single scattering albedo * tau - real(r8),intent(out) :: tau_w_g(nswbands,pcols,pver) ! assymetry parameter * tau * w + real(r8),intent(out) :: tau_w_g(nswbands,pcols,pver) ! asymetry parameter * tau * w real(r8),intent(out) :: tau_w_f(nswbands,pcols,pver) ! forward scattered fraction * tau * w real(r8), pointer :: icswpth(:,:), des(:,:) @@ -393,12 +393,13 @@ subroutine get_grau_optics_sw(state, pbuf, tau, tau_w, tau_w_g, tau_w_f) real(r8),intent(out) :: tau (nswbands,pcols,pver) ! extinction optical depth real(r8),intent(out) :: tau_w (nswbands,pcols,pver) ! single scattering albedo * tau - real(r8),intent(out) :: tau_w_g(nswbands,pcols,pver) ! assymetry parameter * tau * w + real(r8),intent(out) :: tau_w_g(nswbands,pcols,pver) ! asymetry parameter * tau * w real(r8),intent(out) :: tau_w_f(nswbands,pcols,pver) ! forward scattered fraction * tau * w real(r8), pointer :: icgrauwpth(:,:), degrau(:,:) integer :: i,k + character(len=*), parameter :: sub = 'get_grau_optics_sw' ! This does the same thing as get_ice_optics_sw, except with a different ! water path and effective diameter. @@ -419,7 +420,7 @@ subroutine get_grau_optics_sw(state, pbuf, tau, tau_w, tau_w_g, tau_w_f) enddo else - call endrun('ERROR: Get_grau_optics_sw called when graupel properties not supported') + call endrun(sub//': ERROR: Get_grau_optics_sw called when graupel properties not supported') end if end subroutine get_grau_optics_sw @@ -520,6 +521,7 @@ subroutine grau_cloud_get_rad_props_lw(state, pbuf, abs_od) real(r8), intent(out) :: abs_od(nlwbands,pcols,pver) real(r8), pointer :: icgrauwpth(:,:), degrau(:,:) + character(len=*), parameter :: sub = 'grau_cloud_get_rad_props_lw' ! This does the same thing as ice_cloud_get_rad_props_lw, except with a ! different water path and effective diameter. @@ -529,7 +531,7 @@ subroutine grau_cloud_get_rad_props_lw(state, pbuf, abs_od) call interpolate_ice_optics_lw(state%ncol,icgrauwpth, degrau, abs_od) else - call endrun('ERROR: Grau_cloud_get_rad_props_lw called when graupel & + call endrun(sub//': ERROR: Grau_cloud_get_rad_props_lw called when graupel & &properties not supported') end if @@ -566,7 +568,7 @@ subroutine interpolate_ice_optics_sw(ncol, iciwpth, dei, tau, tau_w, & real(r8),intent(out) :: tau (nswbands,pcols,pver) ! extinction optical depth real(r8),intent(out) :: tau_w (nswbands,pcols,pver) ! single scattering albedo * tau - real(r8),intent(out) :: tau_w_g(nswbands,pcols,pver) ! assymetry parameter * tau * w + real(r8),intent(out) :: tau_w_g(nswbands,pcols,pver) ! asymetry parameter * tau * w real(r8),intent(out) :: tau_w_f(nswbands,pcols,pver) ! forward scattered fraction * tau * w type(interp_type) :: dei_wgts diff --git a/src/physics/cam/ebert_curry.F90 b/src/physics/cam/ebert_curry_ice_optics.F90 similarity index 99% rename from src/physics/cam/ebert_curry.F90 rename to src/physics/cam/ebert_curry_ice_optics.F90 index 8a47714c19..377d15de4a 100644 --- a/src/physics/cam/ebert_curry.F90 +++ b/src/physics/cam/ebert_curry_ice_optics.F90 @@ -1,4 +1,4 @@ -module ebert_curry +module ebert_curry_ice_optics use shr_kind_mod, only: r8 => shr_kind_r8 @@ -261,4 +261,4 @@ end subroutine ec_ice_get_rad_props_lw !============================================================================== -end module ebert_curry +end module ebert_curry_ice_optics diff --git a/src/physics/cam/oldcloud.F90 b/src/physics/cam/oldcloud_optics.F90 similarity index 94% rename from src/physics/cam/oldcloud.F90 rename to src/physics/cam/oldcloud_optics.F90 index d34794e4f1..bf53856ad6 100644 --- a/src/physics/cam/oldcloud.F90 +++ b/src/physics/cam/oldcloud_optics.F90 @@ -1,4 +1,4 @@ -module oldcloud +module oldcloud_optics !------------------------------------------------------------------------------------------------ !------------------------------------------------------------------------------------------------ @@ -10,7 +10,7 @@ module oldcloud use constituents, only: cnst_get_ind use physconst, only: gravit use radconstants, only: nlwbands -use ebert_curry, only: scalefactor +use ebert_curry_ice_optics, only: scalefactor use cam_abortutils, only: endrun @@ -79,8 +79,6 @@ subroutine oldcloud_init() call cnst_get_ind('CLDICE', ixcldice) call cnst_get_ind('CLDLIQ', ixcldliq) - return - end subroutine oldcloud_init !============================================================================== @@ -106,10 +104,8 @@ subroutine oldcloud_lw(state,pbuf,cld_abs_od,oldwp) integer :: ncol, itim_old, lwband, i, k, lchnk real(r8), pointer, dimension(:,:) :: iclwpth, iciwpth - real(r8) :: kabs, kabsi - real(r8) kabsl ! longwave liquid absorption coeff (m**2/g) - parameter (kabsl = 0.090361_r8) - + real(r8) :: kabs, kabsi + real(r8), parameter :: kabsl = 0.090361_r8 ! longwave liquid absorption coeff (m**2/g) ncol = state%ncol @@ -152,7 +148,6 @@ subroutine oldcloud_lw(state,pbuf,cld_abs_od,oldwp) !in range of 13 > rei > 130 micron (Ebert and Curry 92) kabsi = 0.005_r8 + 1._r8/min(max(13._r8,scalefactor*rei(i,k)),130._r8) kabs = kabsl*(1._r8-ficemr(i,k)) + kabsi*ficemr(i,k) - !emis(i,k) = 1._r8 - exp(-1.66_r8*kabs*clwp(i,k)) cldtau(i,k) = kabs*cwp(i,k) end do end do @@ -185,8 +180,7 @@ subroutine old_liq_get_rad_props_lw(state, pbuf, abs_od, oldliqwp) integer :: ncol, itim_old, lwband, i, k, lchnk real(r8) :: kabs, kabsi - real(r8) kabsl ! longwave liquid absorption coeff (m**2/g) - parameter (kabsl = 0.090361_r8) + real(r8), parameter :: kabsl = 0.090361_r8 ! longwave liquid absorption coeff (m**2/g) real(r8), pointer, dimension(:,:) :: iclwpth, iciwpth @@ -234,11 +228,10 @@ subroutine old_liq_get_rad_props_lw(state, pbuf, abs_od, oldliqwp) !in range of 13 > rei > 130 micron (Ebert and Curry 92) kabsi = 0.005_r8 + 1._r8/min(max(13._r8,scalefactor*rei(i,k)),130._r8) kabs = kabsl*(1._r8-ficemr(i,k)) ! + kabsi*ficemr(i,k) - !emis(i,k) = 1._r8 - exp(-1.66_r8*kabs*clwp(i,k)) cldtau(i,k) = kabs*cwp(i,k) end do end do -! + do lwband = 1,nlwbands abs_od(lwband,1:ncol,1:pver)=cldtau(1:ncol,1:pver) enddo @@ -267,10 +260,8 @@ subroutine old_ice_get_rad_props_lw(state, pbuf, abs_od, oldicewp) real(r8), pointer, dimension(:,:) :: rei integer :: ncol, itim_old, lwband, i, k, lchnk - real(r8) :: kabs, kabsi - - real(r8) kabsl ! longwave liquid absorption coeff (m**2/g) - parameter (kabsl = 0.090361_r8) + real(r8) :: kabs, kabsi + real(r8), parameter :: kabsl = 0.090361_r8 ! longwave liquid absorption coeff (m**2/g) real(r8), pointer, dimension(:,:) :: iclwpth, iciwpth @@ -318,11 +309,10 @@ subroutine old_ice_get_rad_props_lw(state, pbuf, abs_od, oldicewp) !in range of 13 > rei > 130 micron (Ebert and Curry 92) kabsi = 0.005_r8 + 1._r8/min(max(13._r8,scalefactor*rei(i,k)),130._r8) kabs = kabsi*ficemr(i,k) ! kabsl*(1._r8-ficemr(i,k)) + kabsi*ficemr(i,k) - !emis(i,k) = 1._r8 - exp(-1.66_r8*kabs*clwp(i,k)) cldtau(i,k) = kabs*cwp(i,k) end do end do -! + do lwband = 1,nlwbands abs_od(lwband,1:ncol,1:pver)=cldtau(1:ncol,1:pver) enddo @@ -331,4 +321,4 @@ end subroutine old_ice_get_rad_props_lw !============================================================================== -end module oldcloud +end module oldcloud_optics diff --git a/src/physics/cam/slingo.F90 b/src/physics/cam/slingo_liq_optics.F90 similarity index 99% rename from src/physics/cam/slingo.F90 rename to src/physics/cam/slingo_liq_optics.F90 index 80d42733b2..28b97920e8 100644 --- a/src/physics/cam/slingo.F90 +++ b/src/physics/cam/slingo_liq_optics.F90 @@ -1,4 +1,4 @@ -module slingo +module slingo_liq_optics !------------------------------------------------------------------------------------------------ ! Implements Slingo Optics for MG/RRTMG for liquid clouds and @@ -281,4 +281,4 @@ subroutine slingo_liq_get_rad_props_lw(state, pbuf, abs_od, oldliqwp) end subroutine slingo_liq_get_rad_props_lw -end module slingo +end module slingo_liq_optics diff --git a/src/physics/rrtmg/radiation.F90 b/src/physics/rrtmg/radiation.F90 index 4ca347d749..3b47e8c2ad 100644 --- a/src/physics/rrtmg/radiation.F90 +++ b/src/physics/rrtmg/radiation.F90 @@ -728,8 +728,8 @@ subroutine radiation_tend( & ice_cloud_get_rad_props_lw, cloud_rad_props_get_lw, & grau_cloud_get_rad_props_lw, get_grau_optics_sw, & snow_cloud_get_rad_props_lw, get_snow_optics_sw - use slingo, only: slingo_liq_get_rad_props_lw, slingo_liq_optics_sw - use ebert_curry, only: ec_ice_optics_sw, ec_ice_get_rad_props_lw + use slingo_liq_optics, only: slingo_liq_get_rad_props_lw, slingo_liq_optics_sw + use ebert_curry_ice_optics, only: ec_ice_optics_sw, ec_ice_get_rad_props_lw use rad_solar_var, only: get_variability use radsw, only: rad_rrtmg_sw diff --git a/src/physics/rrtmgp/mcica_subcol_gen.F90 b/src/physics/rrtmgp/mcica_subcol_gen.F90 index f25732c729..ccd414fd5f 100644 --- a/src/physics/rrtmgp/mcica_subcol_gen.F90 +++ b/src/physics/rrtmgp/mcica_subcol_gen.F90 @@ -53,7 +53,6 @@ subroutine mcica_subcol_lw( & ! number of subcolumns ! arguments - ! class(ty_gas_optics), intent(in) :: kdist ! spectral information ! Wrong? class(ty_gas_optics_rrtmgp), intent(in) :: kdist ! spectral information integer, intent(in) :: nbnd ! number of spectral bands integer, intent(in) :: ngpt ! number of subcolumns (g-point intervals) @@ -169,7 +168,6 @@ subroutine mcica_subcol_sw( & ! number of subcolumns ! arguments - ! class(ty_gas_optics), intent(in) :: kdist ! spectral information ! Wrong? class(ty_gas_optics_rrtmgp), intent(in) :: kdist ! spectral information integer, intent(in) :: nbnd ! number of spectral bands integer, intent(in) :: ngpt ! number of subcolumns (g-point intervals) diff --git a/src/physics/rrtmgp/radconstants.F90 b/src/physics/rrtmgp/radconstants.F90 index e414771568..06dccde2b8 100644 --- a/src/physics/rrtmgp/radconstants.F90 +++ b/src/physics/rrtmgp/radconstants.F90 @@ -37,7 +37,7 @@ module radconstants integer, public, protected :: idx_sw_cloudsim = -1 ! band contains 670-nm wave (for COSP) integer, public, protected :: idx_lw_cloudsim = -1 ! band contains 10.5 micron wave (for COSP) -! GASES TREATED BY RADIATION (line spectrae) +! GASES TREATED BY RADIATION (line spectra) ! These names are recognized by RRTMGP. They are in the coefficients files as ! lower case strings. These upper case names are used by CAM's namelist and ! rad_constituents module. @@ -73,6 +73,7 @@ subroutine set_wavenumber_bands(kdist_sw, kdist_lw) type(ty_gas_optics_rrtmgp), intent(in) :: kdist_lw ! Local variables + integer :: istat real(r8), allocatable :: values(:,:) character(len=128) :: errmsg @@ -95,7 +96,10 @@ subroutine set_wavenumber_bands(kdist_sw, kdist_lw) nlwgpts = kdist_lw%get_ngpt() ! SW band bounds in cm^-1 - allocate( values(2,nswbands) ) + allocate( values(2,nswbands), stat=istat ) + if (istat/=0) then + call endrun(sub//': ERROR allocating array: values(2,nswbands)') + end if values = kdist_sw%get_band_lims_wavenumber() wavenumber_low_shortwave = values(1,:) wavenumber_high_shortwave = values(2,:) @@ -109,7 +113,10 @@ subroutine set_wavenumber_bands(kdist_sw, kdist_lw) deallocate(values) ! LW band bounds in cm^-1 - allocate( values(2,nlwbands) ) + allocate( values(2,nlwbands), stat=istat ) + if (istat/=0) then + call endrun(sub//': ERROR allocating array: values(2,nlwbands)') + end if values = kdist_lw%get_band_lims_wavenumber() wavenumber_low_longwave = values(1,:) wavenumber_high_longwave = values(2,:) @@ -233,6 +240,10 @@ function get_band_index_by_value(swlw, targetvalue, units) result(ans) real(r8) :: tgt integer :: nbnds, i + character(len=128) :: errmsg + character(len=*), parameter :: sub = 'get_band_index_by_value' + !---------------------------------------------------------------------------- + select case (swlw) case ('sw','SW','shortwave') nbnds = nswbands @@ -273,7 +284,8 @@ function get_band_index_by_value(swlw, targetvalue, units) result(ans) end do if (ans == 0) then - call endrun('radconstants.F90: get_band_index_by_value: band not found: ') + write(errmsg,'(f10.3,a,a)') targetvalue, ' ', trim(units) + call endrun(sub//': band not found containing wave: '//trim(errmsg)) end if end function get_band_index_by_value diff --git a/src/physics/rrtmgp/radiation.F90 b/src/physics/rrtmgp/radiation.F90 index 5af989e7fe..d1b5603301 100644 --- a/src/physics/rrtmgp/radiation.F90 +++ b/src/physics/rrtmgp/radiation.F90 @@ -67,7 +67,6 @@ module radiation public :: & radiation_readnl, &! read namelist variables radiation_register, &! registers radiation physics buffer fields - radiation_nextsw_cday, &! calendar day of next radiation calculation radiation_do, &! query which radiation calcs are done this timestep radiation_init, &! initialization radiation_define_restart, &! define variables for restart @@ -107,8 +106,8 @@ module radiation real(r8) :: flux_sw_dn(pcols,pverp) ! downward flux real(r8) :: flux_sw_clr_dn(pcols,pverp) ! downward clearsky flux - real(r8) :: flux_lw_up(pcols,pverp) ! upward shortwave flux on interfaces - real(r8) :: flux_lw_clr_up(pcols,pverp) ! upward shortwave clearsky flux + real(r8) :: flux_lw_up(pcols,pverp) ! upward longwave flux on interfaces + real(r8) :: flux_lw_clr_up(pcols,pverp) ! upward longwave clearsky flux real(r8) :: flux_lw_dn(pcols,pverp) ! downward flux real(r8) :: flux_lw_clr_dn(pcols,pverp) ! downward clearsky flux @@ -221,13 +220,14 @@ subroutine radiation_readnl(nlfile) use namelist_utils, only: find_group_name use spmd_utils, only: mpicom, mstrid=>masterprocid, mpi_integer, mpi_logical, & - mpi_character + mpi_character, mpi_real8 character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input ! Local variables integer :: unitn, ierr integer :: dtime ! timestep size + character(len=32) :: errmsg character(len=*), parameter :: sub = 'radiation_readnl' character(len=cl) :: rrtmgp_coefs_lw_file, rrtmgp_coefs_sw_file @@ -244,7 +244,8 @@ subroutine radiation_readnl(nlfile) if (ierr == 0) then read(unitn, radiation_nl, iostat=ierr) if (ierr /= 0) then - call endrun(sub//': ERROR reading namelist') + write(errmsg,'(a,i5)') 'iostat =', ierr + call endrun(sub//': ERROR reading namelist: '//trim(errmsg)) end if end if close(unitn) @@ -267,7 +268,7 @@ subroutine radiation_readnl(nlfile) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: spectralflux") call mpi_bcast(use_rad_uniform_angle, 1, mpi_logical, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: use_rad_uniform_angle") - call mpi_bcast(rad_uniform_angle, 1, mpi_logical, mstrid, mpicom, ierr) + call mpi_bcast(rad_uniform_angle, 1, mpi_real8, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: rad_uniform_angle") call mpi_bcast(graupel_in_rad, 1, mpi_logical, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: graupel_in_rad") @@ -379,7 +380,8 @@ end function radiation_do real(r8) function radiation_nextsw_cday() - ! Return calendar day of next sw radiation calculation + ! If a SW radiation calculation will be done on the next time-step, then return + ! the calendar day of that time-step. Otherwise return -1.0 ! Local variables integer :: nstep ! timestep counter @@ -440,7 +442,7 @@ subroutine radiation_init(pbuf2d) ! temperature, water vapor, cloud ice and cloud ! liquid budgets. integer :: history_budget_histfile_num ! history file number for budget fields - integer :: ierr + integer :: ierr, istat integer :: dtime @@ -520,15 +522,15 @@ subroutine radiation_init(pbuf2d) ! "irad_always" is number of time steps to execute radiation continuously from ! start of initial OR restart run - nstep = get_nstep() + nstep = get_nstep() if (irad_always > 0) then - nstep = get_nstep() irad_always = irad_always + nstep end if if (docosp) call cospsimulator_intr_init() - allocate(cosp_cnt(begchunk:endchunk)) + allocate(cosp_cnt(begchunk:endchunk), stat=istat) + call check_allocate(istat, sub, 'cosp_cnt') if (is_first_restart_step()) then cosp_cnt(begchunk:endchunk) = cosp_cnt_init else @@ -858,7 +860,7 @@ subroutine radiation_tend( & ! if the argument is not present logical :: write_output - integer :: i, k + integer :: i, k, istat integer :: lchnk, ncol logical :: dosw, dolw integer :: icall ! loop index for climate/diagnostic radiation calls @@ -982,7 +984,8 @@ subroutine radiation_tend( & rd => rd_out write_output = .false. else - allocate(rd) + allocate(rd, stat=istat) + call check_allocate(istat, sub, 'rd') write_output = .true. end if @@ -1078,9 +1081,11 @@ subroutine radiation_tend( & allocate( & t_sfc(ncol), emis_sfc(nlwbands,ncol), toa_flux(nday,nswgpts), & - t_rad(ncol,nlay), pmid_rad(ncol,nlay), pint_rad(ncol,nlay+1), & - t_day(nday,nlay), pmid_day(nday,nlay), pint_day(nday,nlay+1), & - coszrs_day(nday), alb_dir(nswbands,nday), alb_dif(nswbands,nday) ) + t_rad(ncol,nlay), pmid_rad(ncol,nlay), pint_rad(ncol,nlay+1), & + t_day(nday,nlay), pmid_day(nday,nlay), pint_day(nday,nlay+1), & + coszrs_day(nday), alb_dir(nswbands,nday), alb_dif(nswbands,nday), & + stat=istat) + call check_allocate(istat, sub, 't_sfc,..,alb_dif') ! Prepares state variables, daylit columns, albedos for RRTMGP call rrtmgp_set_state( & @@ -1282,9 +1287,8 @@ subroutine radiation_tend( & end if ! if (dolw) deallocate( & - t_sfc, emis_sfc, t_rad, pmid_rad, pint_rad, & - t_day, pmid_day, pint_day, coszrs_day, alb_dir, & - alb_dif) + t_sfc, emis_sfc, toa_flux, t_rad, pmid_rad, pint_rad, & + t_day, pmid_day, pint_day, coszrs_day, alb_dir, alb_dif) !================! ! COSP simulator ! @@ -1573,7 +1577,7 @@ subroutine heating_rate(type, ncol, flux_net, hrate) do k = ktopcam, pver ! (flux divergence as bottom-MINUS-top) * g/dp hrate(:ncol,k) = (flux_net(:ncol,k+1) - flux_net(:ncol,k)) * & - gravit / state%pdel(:ncol,k) + gravit * state%rpdel(:ncol,k) end do case ('SW') @@ -1581,7 +1585,7 @@ subroutine heating_rate(type, ncol, flux_net, hrate) do k = ktopcam, pver ! top - bottom hrate(:ncol,k) = (flux_net(:ncol,k) - flux_net(:ncol,k+1)) * & - gravit / state%pdel(:ncol,k) + gravit * state%rpdel(:ncol,k) end do end select @@ -1772,7 +1776,7 @@ subroutine coefs_init(coefs_file, available_gases, kdist) integer :: i integer :: did, vid - integer :: ierr + integer :: ierr, istat character(32), dimension(:), allocatable :: gas_names integer, dimension(:,:,:), allocatable :: key_species @@ -1895,35 +1899,40 @@ subroutine coefs_init(coefs_file, available_gases, kdist) ! Get variables ! names of absorbing gases - allocate(gas_names(absorber)) + allocate(gas_names(absorber), stat=istat) + call check_allocate(istat, sub, 'gas_names') ierr = pio_inq_varid(fh, 'gas_names', vid) if (ierr /= PIO_NOERR) call endrun(sub//': gas_names not found') ierr = pio_get_var(fh, vid, gas_names) if (ierr /= PIO_NOERR) call endrun(sub//': error reading gas_names') ! key species pair for each band - allocate(key_species(2,atmos_layer,bnd)) + allocate(key_species(2,atmos_layer,bnd), stat=istat) + call check_allocate(istat, sub, 'key_species') ierr = pio_inq_varid(fh, 'key_species', vid) if (ierr /= PIO_NOERR) call endrun(sub//': key_species not found') ierr = pio_get_var(fh, vid, key_species) if (ierr /= PIO_NOERR) call endrun(sub//': error reading key_species') ! beginning and ending gpoint for each band - allocate(band2gpt(2,bnd)) + allocate(band2gpt(2,bnd), stat=istat) + call check_allocate(istat, sub, 'band2gpt') ierr = pio_inq_varid(fh, 'bnd_limits_gpt', vid) if (ierr /= PIO_NOERR) call endrun(sub//': bnd_limits_gpt not found') ierr = pio_get_var(fh, vid, band2gpt) if (ierr /= PIO_NOERR) call endrun(sub//': error reading bnd_limits_gpt') ! beginning and ending wavenumber for each band - allocate(band_lims_wavenum(2,bnd)) + allocate(band_lims_wavenum(2,bnd), stat=istat) + call check_allocate(istat, sub, 'band_lims_wavenum') ierr = pio_inq_varid(fh, 'bnd_limits_wavenumber', vid) if (ierr /= PIO_NOERR) call endrun(sub//': bnd_limits_wavenumber not found') ierr = pio_get_var(fh, vid, band_lims_wavenum) if (ierr /= PIO_NOERR) call endrun(sub//': error reading bnd_limits_wavenumber') ! pressures [hPa] for reference atmosphere; press_ref(# reference layers) - allocate(press_ref(pressure)) + allocate(press_ref(pressure), stat=istat) + call check_allocate(istat, sub, 'press_ref') ierr = pio_inq_varid(fh, 'press_ref', vid) if (ierr /= PIO_NOERR) call endrun(sub//': press_ref not found') ierr = pio_get_var(fh, vid, press_ref) @@ -1936,7 +1945,8 @@ subroutine coefs_init(coefs_file, available_gases, kdist) if (ierr /= PIO_NOERR) call endrun(sub//': error reading press_ref_trop') ! temperatures [K] for reference atmosphere; temp_ref(# reference layers) - allocate(temp_ref(temperature)) + allocate(temp_ref(temperature), stat=istat) + call check_allocate(istat, sub, 'temp_ref') ierr = pio_inq_varid(fh, 'temp_ref', vid) if (ierr /= PIO_NOERR) call endrun(sub//': temp_ref not found') ierr = pio_get_var(fh, vid, temp_ref) @@ -1955,28 +1965,32 @@ subroutine coefs_init(coefs_file, available_gases, kdist) if (ierr /= PIO_NOERR) call endrun(sub//': error reading absorption_coefficient_ref_P') ! volume mixing ratios for reference atmosphere - allocate(vmr_ref(atmos_layer, absorber_ext, temperature)) + allocate(vmr_ref(atmos_layer, absorber_ext, temperature), stat=istat) + call check_allocate(istat, sub, 'vmr_ref') ierr = pio_inq_varid(fh, 'vmr_ref', vid) if (ierr /= PIO_NOERR) call endrun(sub//': vmr_ref not found') ierr = pio_get_var(fh, vid, vmr_ref) if (ierr /= PIO_NOERR) call endrun(sub//': error reading vmr_ref') ! absorption coefficients due to major absorbing gases - allocate(kmajor(gpt,mixing_fraction,pressure_interp,temperature)) + allocate(kmajor(gpt,mixing_fraction,pressure_interp,temperature), stat=istat) + call check_allocate(istat, sub, 'kmajor') ierr = pio_inq_varid(fh, 'kmajor', vid) if (ierr /= PIO_NOERR) call endrun(sub//': kmajor not found') ierr = pio_get_var(fh, vid, kmajor) if (ierr /= PIO_NOERR) call endrun(sub//': error reading kmajor') ! absorption coefficients due to minor absorbing gases in lower part of atmosphere - allocate(kminor_lower(contributors_lower, mixing_fraction, temperature)) + allocate(kminor_lower(contributors_lower, mixing_fraction, temperature), stat=istat) + call check_allocate(istat, sub, 'kminor_lower') ierr = pio_inq_varid(fh, 'kminor_lower', vid) if (ierr /= PIO_NOERR) call endrun(sub//': kminor_lower not found') ierr = pio_get_var(fh, vid, kminor_lower) if (ierr /= PIO_NOERR) call endrun(sub//': error reading kminor_lower') ! absorption coefficients due to minor absorbing gases in upper part of atmosphere - allocate(kminor_upper(contributors_upper, mixing_fraction, temperature)) + allocate(kminor_upper(contributors_upper, mixing_fraction, temperature), stat=istat) + call check_allocate(istat, sub, 'kminor_upper') ierr = pio_inq_varid(fh, 'kminor_upper', vid) if (ierr /= PIO_NOERR) call endrun(sub//': kminor_upper not found') ierr = pio_get_var(fh, vid, kminor_upper) @@ -1985,7 +1999,8 @@ subroutine coefs_init(coefs_file, available_gases, kdist) ! integrated Planck function by band ierr = pio_inq_varid(fh, 'totplnk', vid) if (ierr == PIO_NOERR) then - allocate(totplnk(temperature_Planck,bnd)) + allocate(totplnk(temperature_Planck,bnd), stat=istat) + call check_allocate(istat, sub, 'totplnk') ierr = pio_get_var(fh, vid, totplnk) if (ierr /= PIO_NOERR) call endrun(sub//': error reading totplnk') end if @@ -1993,33 +2008,40 @@ subroutine coefs_init(coefs_file, available_gases, kdist) ! Planck fractions ierr = pio_inq_varid(fh, 'plank_fraction', vid) if (ierr == PIO_NOERR) then - allocate(planck_frac(gpt,mixing_fraction,pressure_interp,temperature)) + allocate(planck_frac(gpt,mixing_fraction,pressure_interp,temperature), stat=istat) + call check_allocate(istat, sub, 'planck_frac') ierr = pio_get_var(fh, vid, planck_frac) if (ierr /= PIO_NOERR) call endrun(sub//': error reading plank_fraction') end if ierr = pio_inq_varid(fh, 'optimal_angle_fit', vid) if (ierr == PIO_NOERR) then - allocate(optimal_angle_fit(fit_coeffs, bnd)) + allocate(optimal_angle_fit(fit_coeffs, bnd), stat=istat) + call check_allocate(istat, sub, 'optiman_angle_fit') ierr = pio_get_var(fh, vid, optimal_angle_fit) if (ierr /= PIO_NOERR) call endrun(sub//': error reading optimal_angle_fit') end if ierr = pio_inq_varid(fh, 'solar_source_quiet', vid) if (ierr == PIO_NOERR) then - allocate(solar_src_quiet(gpt)) + allocate(solar_src_quiet(gpt), stat=istat) + call check_allocate(istat, sub, 'solar_src_quiet') ierr = pio_get_var(fh, vid, solar_src_quiet) if (ierr /= PIO_NOERR) call endrun(sub//': error reading solar_source_quiet') end if + ierr = pio_inq_varid(fh, 'solar_source_facular', vid) if (ierr == PIO_NOERR) then - allocate(solar_src_facular(gpt)) + allocate(solar_src_facular(gpt), stat=istat) + call check_allocate(istat, sub, 'solar_src_facular') ierr = pio_get_var(fh, vid, solar_src_facular) if (ierr /= PIO_NOERR) call endrun(sub//': error reading solar_source_facular') end if + ierr = pio_inq_varid(fh, 'solar_source_sunspot', vid) if (ierr == PIO_NOERR) then - allocate(solar_src_sunspot(gpt)) + allocate(solar_src_sunspot(gpt), stat=istat) + call check_allocate(istat, sub, 'solar_src_sunspot') ierr = pio_get_var(fh, vid, solar_src_sunspot) if (ierr /= PIO_NOERR) call endrun(sub//': error reading solar_source_sunspot') end if @@ -2045,7 +2067,8 @@ subroutine coefs_init(coefs_file, available_gases, kdist) ! rayleigh scattering contribution in lower part of atmosphere ierr = pio_inq_varid(fh, 'rayl_lower', vid) if (ierr == PIO_NOERR) then - allocate(rayl_lower(gpt,mixing_fraction,temperature)) + allocate(rayl_lower(gpt,mixing_fraction,temperature), stat=istat) + call check_allocate(istat, sub, 'rayl_lower') ierr = pio_get_var(fh, vid, rayl_lower) if (ierr /= PIO_NOERR) call endrun(sub//': error reading rayl_lower') end if @@ -2053,50 +2076,59 @@ subroutine coefs_init(coefs_file, available_gases, kdist) ! rayleigh scattering contribution in upper part of atmosphere ierr = pio_inq_varid(fh, 'rayl_upper', vid) if (ierr == PIO_NOERR) then - allocate(rayl_upper(gpt,mixing_fraction,temperature)) + allocate(rayl_upper(gpt,mixing_fraction,temperature), stat=istat) + call check_allocate(istat, sub, 'rayl_upper') ierr = pio_get_var(fh, vid, rayl_upper) if (ierr /= PIO_NOERR) call endrun(sub//': error reading rayl_upper') end if - allocate(gas_minor(minorabsorbers)) + allocate(gas_minor(minorabsorbers), stat=istat) + call check_allocate(istat, sub, 'gas_minor') ierr = pio_inq_varid(fh, 'gas_minor', vid) if (ierr /= PIO_NOERR) call endrun(sub//': gas_minor not found') ierr = pio_get_var(fh, vid, gas_minor) if (ierr /= PIO_NOERR) call endrun(sub//': error reading gas_minor') - allocate(identifier_minor(minorabsorbers)) + allocate(identifier_minor(minorabsorbers), stat=istat) + call check_allocate(istat, sub, 'identifier_minor') ierr = pio_inq_varid(fh, 'identifier_minor', vid) if (ierr /= PIO_NOERR) call endrun(sub//': identifier_minor not found') ierr = pio_get_var(fh, vid, identifier_minor) if (ierr /= PIO_NOERR) call endrun(sub//': error reading identifier_minor') - allocate(minor_gases_lower(minor_absorber_intervals_lower)) + allocate(minor_gases_lower(minor_absorber_intervals_lower), stat=istat) + call check_allocate(istat, sub, 'minor_gases_lower') ierr = pio_inq_varid(fh, 'minor_gases_lower', vid) if (ierr /= PIO_NOERR) call endrun(sub//': minor_gases_lower not found') ierr = pio_get_var(fh, vid, minor_gases_lower) if (ierr /= PIO_NOERR) call endrun(sub//': error reading minor_gases_lower') - allocate(minor_gases_upper(minor_absorber_intervals_upper)) + allocate(minor_gases_upper(minor_absorber_intervals_upper), stat=istat) + call check_allocate(istat, sub, 'minor_gases_upper') ierr = pio_inq_varid(fh, 'minor_gases_upper', vid) if (ierr /= PIO_NOERR) call endrun(sub//': minor_gases_upper not found') ierr = pio_get_var(fh, vid, minor_gases_upper) if (ierr /= PIO_NOERR) call endrun(sub//': error reading minor_gases_upper') - allocate(minor_limits_gpt_lower(pairs,minor_absorber_intervals_lower)) + allocate(minor_limits_gpt_lower(pairs,minor_absorber_intervals_lower), stat=istat) + call check_allocate(istat, sub, 'minor_limits_gpt_lower') ierr = pio_inq_varid(fh, 'minor_limits_gpt_lower', vid) if (ierr /= PIO_NOERR) call endrun(sub//': minor_limits_gpt_lower not found') ierr = pio_get_var(fh, vid, minor_limits_gpt_lower) if (ierr /= PIO_NOERR) call endrun(sub//': error reading minor_limits_gpt_lower') - allocate(minor_limits_gpt_upper(pairs,minor_absorber_intervals_upper)) + allocate(minor_limits_gpt_upper(pairs,minor_absorber_intervals_upper), stat=istat) + call check_allocate(istat, sub, 'minor_limits_gpt_upper') ierr = pio_inq_varid(fh, 'minor_limits_gpt_upper', vid) if (ierr /= PIO_NOERR) call endrun(sub//': minor_limits_gpt_upper not found') ierr = pio_get_var(fh, vid, minor_limits_gpt_upper) if (ierr /= PIO_NOERR) call endrun(sub//': error reading minor_limits_gpt_upper') ! Read as integer and convert to logical - allocate(int2log(minor_absorber_intervals_lower)) - allocate(minor_scales_with_density_lower(minor_absorber_intervals_lower)) + allocate(int2log(minor_absorber_intervals_lower), stat=istat) + call check_allocate(istat, sub, 'int2log for lower') + allocate(minor_scales_with_density_lower(minor_absorber_intervals_lower), stat=istat) + call check_allocate(istat, sub, 'minor_scales_with_density_lower') ierr = pio_inq_varid(fh, 'minor_scales_with_density_lower', vid) if (ierr /= PIO_NOERR) call endrun(sub//': minor_scales_with_density_lower not found') ierr = pio_get_var(fh, vid, int2log) @@ -2111,8 +2143,10 @@ subroutine coefs_init(coefs_file, available_gases, kdist) deallocate(int2log) ! Read as integer and convert to logical - allocate(int2log(minor_absorber_intervals_upper)) - allocate(minor_scales_with_density_upper(minor_absorber_intervals_upper)) + allocate(int2log(minor_absorber_intervals_upper), stat=istat) + call check_allocate(istat, sub, 'int2log for upper') + allocate(minor_scales_with_density_upper(minor_absorber_intervals_upper), stat=istat) + call check_allocate(istat, sub, 'minor_scales_with_density_upper') ierr = pio_inq_varid(fh, 'minor_scales_with_density_upper', vid) if (ierr /= PIO_NOERR) call endrun(sub//': minor_scales_with_density_upper not found') ierr = pio_get_var(fh, vid, int2log) @@ -2127,8 +2161,10 @@ subroutine coefs_init(coefs_file, available_gases, kdist) deallocate(int2log) ! Read as integer and convert to logical - allocate(int2log(minor_absorber_intervals_lower)) - allocate(scale_by_complement_lower(minor_absorber_intervals_lower)) + allocate(int2log(minor_absorber_intervals_lower), stat=istat) + call check_allocate(istat, sub, 'int2log for lower') + allocate(scale_by_complement_lower(minor_absorber_intervals_lower), stat=istat) + call check_allocate(istat, sub, 'scale_by_complement_lower') ierr = pio_inq_varid(fh, 'scale_by_complement_lower', vid) if (ierr /= PIO_NOERR) call endrun(sub//': scale_by_complement_lower not found') ierr = pio_get_var(fh, vid, int2log) @@ -2143,8 +2179,10 @@ subroutine coefs_init(coefs_file, available_gases, kdist) deallocate(int2log) ! Read as integer and convert to logical - allocate(int2log(minor_absorber_intervals_upper)) - allocate(scale_by_complement_upper(minor_absorber_intervals_upper)) + allocate(int2log(minor_absorber_intervals_upper), stat=istat) + call check_allocate(istat, sub, 'int2log for upper') + allocate(scale_by_complement_upper(minor_absorber_intervals_upper), stat=istat) + call check_allocate(istat, sub, 'scale_by_complement_upper') ierr = pio_inq_varid(fh, 'scale_by_complement_upper', vid) if (ierr /= PIO_NOERR) call endrun(sub//': scale_by_complement_upper not found') ierr = pio_get_var(fh, vid, int2log) @@ -2158,25 +2196,29 @@ subroutine coefs_init(coefs_file, available_gases, kdist) end do deallocate(int2log) - allocate(scaling_gas_lower(minor_absorber_intervals_lower)) + allocate(scaling_gas_lower(minor_absorber_intervals_lower), stat=istat) + call check_allocate(istat, sub, 'scaling_gas_lower') ierr = pio_inq_varid(fh, 'scaling_gas_lower', vid) if (ierr /= PIO_NOERR) call endrun(sub//': scaling_gas_lower not found') ierr = pio_get_var(fh, vid, scaling_gas_lower) if (ierr /= PIO_NOERR) call endrun(sub//': error reading scaling_gas_lower') - allocate(scaling_gas_upper(minor_absorber_intervals_upper)) + allocate(scaling_gas_upper(minor_absorber_intervals_upper), stat=istat) + call check_allocate(istat, sub, 'scaling_gas_upper') ierr = pio_inq_varid(fh, 'scaling_gas_upper', vid) if (ierr /= PIO_NOERR) call endrun(sub//': scaling_gas_upper not found') ierr = pio_get_var(fh, vid, scaling_gas_upper) if (ierr /= PIO_NOERR) call endrun(sub//': error reading scaling_gas_upper') - allocate(kminor_start_lower(minor_absorber_intervals_lower)) + allocate(kminor_start_lower(minor_absorber_intervals_lower), stat=istat) + call check_allocate(istat, sub, 'kminor_start_lower') ierr = pio_inq_varid(fh, 'kminor_start_lower', vid) if (ierr /= PIO_NOERR) call endrun(sub//': kminor_start_lower not found') ierr = pio_get_var(fh, vid, kminor_start_lower) if (ierr /= PIO_NOERR) call endrun(sub//': error reading kminor_start_lower') - allocate(kminor_start_upper(minor_absorber_intervals_upper)) + allocate(kminor_start_upper(minor_absorber_intervals_upper), stat=istat) + call check_allocate(istat, sub, 'kminor_start_upper') ierr = pio_inq_varid(fh, 'kminor_start_upper', vid) if (ierr /= PIO_NOERR) call endrun(sub//': kminor_start_upper not found') ierr = pio_get_var(fh, vid, kminor_start_upper) @@ -2238,23 +2280,23 @@ subroutine coefs_init(coefs_file, available_gases, kdist) kmajor, kminor_lower, kminor_upper, & gas_minor, identifier_minor, & minor_gases_lower, minor_gases_upper, & - scaling_gas_lower, scaling_gas_upper, & minor_limits_gpt_lower, & minor_limits_gpt_upper, & minor_scales_with_density_lower, & minor_scales_with_density_upper, & scale_by_complement_lower, & scale_by_complement_upper, & + scaling_gas_lower, scaling_gas_upper, & kminor_start_lower, kminor_start_upper) + if (allocated(totplnk)) deallocate(totplnk) + if (allocated(planck_frac)) deallocate(planck_frac) if (allocated(optimal_angle_fit)) deallocate(optimal_angle_fit) - if (allocated(totplnk)) deallocate(totplnk) - if (allocated(planck_frac)) deallocate(planck_frac) if (allocated(solar_src_quiet)) deallocate(solar_src_quiet) if (allocated(solar_src_facular)) deallocate(solar_src_facular) if (allocated(solar_src_sunspot)) deallocate(solar_src_sunspot) - if (allocated(rayl_lower)) deallocate(rayl_lower) - if (allocated(rayl_upper)) deallocate(rayl_upper) + if (allocated(rayl_lower)) deallocate(rayl_lower) + if (allocated(rayl_upper)) deallocate(rayl_upper) end subroutine coefs_init @@ -2271,6 +2313,8 @@ subroutine initialize_rrtmgp_fluxes(ncol, nlevels, nbands, fluxes, do_direct) ! Local variables logical :: do_direct_local + integer :: istat + character(len=*), parameter :: sub = 'initialize_rrtmgp_fluxes' !---------------------------------------------------------------------------- if (present(do_direct)) then @@ -2280,16 +2324,28 @@ subroutine initialize_rrtmgp_fluxes(ncol, nlevels, nbands, fluxes, do_direct) end if ! Broadband fluxes - allocate(fluxes%flux_up(ncol, nlevels)) - allocate(fluxes%flux_dn(ncol, nlevels)) - allocate(fluxes%flux_net(ncol, nlevels)) - if (do_direct_local) allocate(fluxes%flux_dn_dir(ncol, nlevels)) + allocate(fluxes%flux_up(ncol, nlevels), stat=istat) + call check_allocate(istat, sub, 'fluxes%flux_up') + allocate(fluxes%flux_dn(ncol, nlevels), stat=istat) + call check_allocate(istat, sub, 'fluxes%flux_dn') + allocate(fluxes%flux_net(ncol, nlevels), stat=istat) + call check_allocate(istat, sub, 'fluxes%flux_net') + if (do_direct_local) then + allocate(fluxes%flux_dn_dir(ncol, nlevels), stat=istat) + call check_allocate(istat, sub, 'fluxes%flux_dn_dir') + end if ! Fluxes by band - allocate(fluxes%bnd_flux_up(ncol, nlevels, nbands)) - allocate(fluxes%bnd_flux_dn(ncol, nlevels, nbands)) - allocate(fluxes%bnd_flux_net(ncol, nlevels, nbands)) - if (do_direct_local) allocate(fluxes%bnd_flux_dn_dir(ncol, nlevels, nbands)) + allocate(fluxes%bnd_flux_up(ncol, nlevels, nbands), stat=istat) + call check_allocate(istat, sub, 'fluxes%bnd_flux_up') + allocate(fluxes%bnd_flux_dn(ncol, nlevels, nbands), stat=istat) + call check_allocate(istat, sub, 'fluxes%bnd_flux_dn') + allocate(fluxes%bnd_flux_net(ncol, nlevels, nbands), stat=istat) + call check_allocate(istat, sub, 'fluxes%bnd_flux_net') + if (do_direct_local) then + allocate(fluxes%bnd_flux_dn_dir(ncol, nlevels, nbands), stat=istat) + call check_allocate(istat, sub, 'fluxes%bnd_flux_dn_dir') + end if ! Initialize call reset_fluxes(fluxes) @@ -2423,5 +2479,21 @@ end subroutine stop_on_err !========================================================================================= +subroutine check_allocate(istat, sub, info) + + ! call endrun if allocate returns non-zero status + + integer, intent(in) :: istat ! return status from allocate + character(len=*), intent(in) :: sub ! name of calling subroutine + character(len=*), intent(in) :: info ! identify which call failed + + if (istat /= 0) then + call endrun(trim(sub)//': ERROR allocating: '//trim(info)) + end if + +end subroutine check_allocate + +!========================================================================================= + end module radiation From ffec5d1e2301aa8a93197970e5baf53c186d3599 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Thu, 1 Feb 2024 08:35:11 -0700 Subject: [PATCH 229/291] skip over geoschem in r8 kind checker --- test/system/TR8.sh | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/test/system/TR8.sh b/test/system/TR8.sh index e107c702d3..f56c9bc636 100755 --- a/test/system/TR8.sh +++ b/test/system/TR8.sh @@ -54,12 +54,12 @@ fi #Check Chemistry if [ -d "${CAM_ROOT}/components/cam" ]; then -ruby $ADDREALKIND_EXE -r r8 -l 1 -d $CAM_ROOT/components/cam/src/chemistry +ruby $ADDREALKIND_EXE -r r8 -l 1 -d $CAM_ROOT/components/cam/src/chemistry -s geoschem rc=`expr $? + $rc` else -ruby $ADDREALKIND_EXE -r r8 -l 1 -d $CAM_ROOT/src/chemistry +ruby $ADDREALKIND_EXE -r r8 -l 1 -d $CAM_ROOT/src/chemistry -s geoschem rc=`expr $? + $rc` fi From a5e78df39702959a7dd69d504927bdd69f98934d Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Thu, 1 Feb 2024 09:37:12 -0700 Subject: [PATCH 230/291] Update Changelog Signed-off-by: Lizzie Lundgren --- doc/ChangeLog | 164 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 164 insertions(+) diff --git a/doc/ChangeLog b/doc/ChangeLog index a219f92580..a81de9b635 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,5 +1,169 @@ =============================================================== +Tag name: cam6_3_147 +Originator(s): lizziel, jimmielin, fritzt +Date: +One-line Summary: Add GEOS-Chem chemistry as new chemistry option in CAM +Github PR URL: https://github.com/ESCOMP/CAM/pull/484 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Include GEOS-Chem 14.1.2 chemistry as alternative to CAM-chem + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: fvitt, brian-eaton, cacraigucar, gold2718, jedwards4b + +List all files that are renamed and why: +R100 bld/namelist_files/master_aer_drydep_list.xml +R100 bld/namelist_files/master_aer_wetdep_list.xml +R100 bld/namelist_files/master_gas_drydep_list.xml +R100 bld/namelist_files/master_gas_wetdep_list.xml + - Renamed with prefix mozart_ to distinguish from GEOS-Chem lists + +R099 src/chemistry/aerosol/drydep_mod.F90 + - Renamed to aer_drydep_mod.F90 to avoid module conflict name in GEOS-Chem + - Changed module name in file from drydep_mod to aer_drydep_mod + +List all files added and what they do: +A bld/namelist_files/geoschem_master_aer_drydep_list.xml +A bld/namelist_files/geoschem_master_aer_wetdep_list.xml +A bld/namelist_files/geoschem_master_gas_drydep_list.xml +A bld/namelist_files/geoschem_master_gas_wetdep_list.xml + - New deposition lists for use in GEOS-Chem only + +A bld/namelist_files/use_cases/2000_geoschem.xml +A bld/namelist_files/use_cases/2010_geoschem.xml +A bld/namelist_files/use_cases/hist_geoschem.xml +A bld/namelist_files/use_cases/hist_geoschem_nudged.xml + - Use case files for four GEOS-Chem chemistry compsets + +A cime_config/cam.case_setup.py + - Script called during CESM case setup for CAM-specific commands + - Copies GEOS-Chem config files from source to case directory if using GEOS-Chem + +A src/chemistry/geoschem/.exclude + - List of GEOS-Chem source files to skip during build + +A src/chemistry/geoschem/chem_mods.F90 + - GEOS-Chem version of chem_mods.F90 equivalent to Mozart pre-processed files + +A src/chemistry/geoschem/chemistry.F90 + - GEOS-Chem implementation of chemistry module used in CAM + +A src/chemistry/geoschem/geoschem_diagnostics_mod.F90 + - GEOS-Chem diagnostics module + +A src/chemistry/geoschem/geoschem_emissions_mod.F90 + - GEOS-Chem emissions module + +A src/chemistry/geoschem/geoschem_history_mod.F90 + - Interface file to connect GEOS-Chem state arrays to CAM history + +A src/chemistry/geoschem/m_spc_id.F90 + - GEOS-Chem version of m_spc_id.F90 equivalent to Mozart pre-processed files + +A src/chemistry/geoschem/mo_sim_dat.F90 + - GEOS-Chem version of m_spc_id.F90 equivalent to Mozart pre-processed files + +List all existing files that have been modified, and describe the changes: +M .gitignore + - Added GEOS-Chem directory which is its own git repository + +M Externals_CAM.cfg + - Added GEOS-Chem repository, tag 14.1.2 + +M bld/build-namelist + - Updates for GEOS-Chem namelists + +M bld/config_files/definition.xml + - Added geoschem_mam4 to list of chemistry packages + +M bld/configure + - Updates to build GEOS-Chem + +M bld/namelist_files/namelist_defaults_cam.xml + - Set GEOS-Chem default wave params and path to Henry's coeff file for deposition + +M bld/namelist_files/namelist_definition.xml + - Added GEOS-Chem input data path as new entry + - Added geoschem_mam4 to chem package list + +M bld/perl5lib/Build/ChemNamelist.pm + - Added log prints of all deposition species lists + - Updates to use different deposition lists based on chemistry selection + +M cime_config/buildnml + - Copy GEOS-Chem config files from case to run directory if using GEOS-Chem + +M cime_config/config_component.xml + - Added GEOS-Chem as chemistry option + - Set GEOS-Chem compset aliases + +M cime_config/config_compsets.xml + - Defined four GEOS-Chem compsets + +M cime_config/testdefs/testlist_cam.xml + - Added tests for all four GEOS-Chem compsets as category geoschem + - Included FCHIST_GC in aux_cam tests and FCnudged_GC in prealpha tests + +M doc/ChangeLog +M src/chemistry/bulk_aero/aero_model.F90 + - Renamed drydep_mod to aer_drydep_mod in use statements + +M src/chemistry/modal_aero/aero_model.F90 + - Renamed drydep_mod to aer_drydep_mod in use statements + +M src/chemistry/modal_aero/modal_aero_data.F90 + - Distinguish between SOAG and SOAGX since SOAGX a species in GEOS-Chem + +M src/chemistry/modal_aero/modal_aero_gasaerexch.F90 + - Skip MSA tendency if using GEOS-Chem + +M src/chemistry/modal_aero/sox_cldaero_mod.F90 + - Exit prior to in-cloud sulfur oxidation if using GEOS-Chem to avoid double-counting + +M src/chemistry/mozart/chemistry.F90 + - Add call to new subroutine short_lived_species_final + +M src/chemistry/mozart/mo_chem_utls.F90 + - Add optional argument in get_spc_ndx to ignore case in string compariosn + +M src/chemistry/mozart/mo_neu_wetdep.F90 + - Skip aerosol mapping if using GEOS-Chem; assume all species in dep_data_file + +M src/chemistry/mozart/short_lived_species.F90 + - Added array slvd_ref_mmr to store short-lived species reference values + - Initialized short-lived species not found to ref values if available + - Initialized GEOS-Chem short-lived species from slvd_lst not solsym + - Added set/get subroutines for GEOS-Chem short-lived species + - Added new subroutine short_lived_species_final to deallocate new array + +M src/cpl/nuopc/atm_import_export.F90 + - Added So_ustar to atm imports for use in GEOS-Chem dry dep over ocean + +M src/physics/cam/constituents.F90 + - Improved existing error handling messages for clarity + +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: + +izumi/nag/aux_cam: + +izumi/gnu/aux_cam: + +=============================================================== +=============================================================== + Tag name: cam6_3_146 Originator(s): cacraig Date: Jan 23, 2024 From 4442c2a2a783ba65be5bd519c67339530a2c9f4f Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Thu, 1 Feb 2024 09:57:13 -0700 Subject: [PATCH 231/291] include commit and time limit to goes-chem tests --- cime_config/testdefs/testlist_cam.xml | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/cime_config/testdefs/testlist_cam.xml b/cime_config/testdefs/testlist_cam.xml index 070c80eb2e..4b6647697d 100644 --- a/cime_config/testdefs/testlist_cam.xml +++ b/cime_config/testdefs/testlist_cam.xml @@ -1712,9 +1712,9 @@ + - @@ -1922,7 +1922,7 @@ - + @@ -1930,6 +1930,10 @@ + + + + From 86720ccfd55278efd108ae06c58dc635c63823d1 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Fri, 2 Feb 2024 09:08:26 -0700 Subject: [PATCH 232/291] update ChangLog --- doc/ChangeLog | 120 +++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 119 insertions(+), 1 deletion(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index a81de9b635..9d40f7ba63 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -2,12 +2,13 @@ Tag name: cam6_3_147 Originator(s): lizziel, jimmielin, fritzt -Date: +Date: 2 Feb 2024 One-line Summary: Add GEOS-Chem chemistry as new chemistry option in CAM Github PR URL: https://github.com/ESCOMP/CAM/pull/484 Purpose of changes (include the issue number and title text for each relevant GitHub issue): - Include GEOS-Chem 14.1.2 chemistry as alternative to CAM-chem + (issue #424 -- Implementing GEOS-Chem chemistry in CESM (CESM-GC)) Describe any changes made to build system: N/A @@ -156,10 +157,127 @@ 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: + PEND ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s + - pre-existing failures + + FAIL SMS_Ld1_Vnuopc.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d + - expected failure due to goeschem config file copy issue + + DIFF ERC_D_Ln9_P144x1_Vnuopc.ne16pg3_ne16pg3_mg17.QPC6HIST.derecho_intel.cam-outfrq3s_ttrac_usecase + DIFF ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq3s_cosp + DIFF ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPMOZ.derecho_intel.cam-outfrq3s + DIFF ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPX2000.derecho_intel.cam-outfrq3s + DIFF ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC5HIST.derecho_intel.cam-outfrq3s_usecase + DIFF ERI_D_Ln18_Vnuopc.f45_f45_mg37.QPC41850.derecho_intel.cam-co2rmp_usecase + DIFF ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s + DIFF ERP_D_Ln9_Vnuopc.f09_f09_mg17.QSC6.derecho_intel.cam-outfrq9s + DIFF ERP_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq9s + DIFF ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.derecho_intel.cam-outfrq9s + DIFF ERP_Ld3_Vnuopc.f09_f09_mg17.FWHIST.derecho_intel.cam-reduced_hist1d + DIFF ERP_Lh12_Vnuopc.f19_f19_mg17.FW4madSD.derecho_intel.cam-outfrq3h + DIFF ERP_Ln9_P24x3_Vnuopc.f45_f45_mg37.QPWmaC6.derecho_intel.cam-outfrq9s_mee_fluxes + DIFF ERP_Ln9_Vnuopc.f09_f09_mg17.F1850.derecho_intel.cam-outfrq9s + DIFF ERP_Ln9_Vnuopc.f09_f09_mg17.F2000climo.derecho_intel.cam-outfrq9s + DIFF ERP_Ln9_Vnuopc.f09_f09_mg17.F2000dev.derecho_intel.cam-outfrq9s_mg3 + DIFF ERP_Ln9_Vnuopc.f09_f09_mg17.F2010climo.derecho_intel.cam-outfrq9s + DIFF ERP_Ln9_Vnuopc.f09_f09_mg17.FHIST_BDRD.derecho_intel.cam-outfrq9s + DIFF ERP_Ln9_Vnuopc.f19_f19_mg17.FWsc1850.derecho_intel.cam-outfrq9s + DIFF ERP_Ln9_Vnuopc.ne30_ne30_mg17.FCnudged.derecho_intel.cam-outfrq9s + DIFF ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s + DIFF ERS_Ld3_Vnuopc.f10_f10_mg37.F1850.derecho_intel.cam-outfrq1d_14dec_ghg_cam_dev + DIFF ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.derecho_intel.cam-outfrq9s_mpasa120 + DIFF ERS_Ln9_P36x1_Vnuopc.mpasa480_mpasa480.F2000climo.derecho_intel.cam-outfrq9s_mpasa480 + DIFF ERS_Ln9_Vnuopc.f09_f09_mg17.FX2000.derecho_intel.cam-outfrq9s + DIFF ERS_Ln9_Vnuopc.f19_f19_mg17.FSPCAMS.derecho_intel.cam-outfrq9s + DIFF ERS_Ln9_Vnuopc.f19_f19_mg17.FXSD.derecho_intel.cam-outfrq9s + DIFF SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC5.derecho_intel.cam-scm_prep + DIFF SMS_D_Ld2_Vnuopc.f19_f19_mg17.QPC5HIST.derecho_intel.cam-volc_usecase + DIFF SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCts2nudged.derecho_intel.cam-outfrq9s_leapday + DIFF SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCvbsxHIST.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9_Vnuopc.f09_f09_mg17.FSD.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s_waccm_ma_mam4 + DIFF SMS_D_Ln9_Vnuopc.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie + DIFF SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC2000climo.derecho_intel.cam-outfrq3s_usecase + DIFF SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC5M7.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.QPX2000.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9_Vnuopc_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9_Vnuopc_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9_Vnuopc_P1280x1.ne30pg3_ne30pg3_mg17.FCLTHIST.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9_Vnuopc.T42_T42.FSCAM.derecho_intel.cam-outfrq9s + DIFF SMS_Ld1_Vnuopc.f09_f09_mg17.FW2000climo.derecho_intel.cam-outfrq1d + DIFF SMS_Ld1_Vnuopc.f19_f19.F2000dev.derecho_intel.cam-outfrq1d + DIFF SMS_Ld1_Vnuopc.ne30pg3_ne30pg3_mg17.FC2010climo.derecho_intel.cam-outfrq1d + DIFF SMS_Lh12_Vnuopc.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h + DIFF SMS_Lm13_Vnuopc.f10_f10_mg37.F2000climo.derecho_intel.cam-outfrq1m + DIFF SMS_Ln9_Vnuopc.f09_f09_mg17.F2010climo.derecho_intel.cam-nudging + DIFF SMS_Ln9_Vnuopc.f09_f09_mg17.FW1850.derecho_intel.cam-reduced_hist3s + DIFF SMS_Ln9_Vnuopc.f19_f19.F2000climo.derecho_intel.cam-silhs + DIFF SMS_Ln9_Vnuopc.f19_f19_mg17.FHIST.derecho_intel.cam-outfrq9s_nochem + - differences are only in Med_aoflux_atm_So_ustar mediator field resulting from adding + So_ustar to atm imports, otherwise all other fields bit-for-bit izumi/nag/aux_cam: + FAIL DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae + - pre-existing failure + + DIFF ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-carma_sea_salt + DIFF ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_cosp + DIFF ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_subcol + DIFF ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am + DIFF ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist + DIFF ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s + DIFF ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s + DIFF ERC_D_Ln9_Vnuopc.f10_f10_mg37.QSPCAMS.izumi_nag.cam-outfrq3s + DIFF ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase + DIFF ERC_D_Ln9_Vnuopc.ne16pg3_ne16pg3_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase + DIFF ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac + DIFF ERC_D_Ln9_Vnuopc.T5_T5_mg37.QPC4.izumi_nag.cam-outfrq3s_usecase + DIFF ERI_D_Ln18_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac + DIFF ERI_D_Ln18_Vnuopc.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 + DIFF ERP_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf + DIFF PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 + DIFF PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 + DIFF PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 + DIFF PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 + DIFF PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 + DIFF PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 + DIFF SMS_D_Ln3_Vnuopc.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s + DIFF SMS_D_Ln6_Vnuopc.ne5_ne5_mg37.QPWmaC4.izumi_nag.cam-outfrq3s_physgrid_tem + DIFF SMS_D_Ln7_Vnuopc.T42_T42_mg17.QPSCAMC5.izumi_nag.cam-scmarm + DIFF SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-rad_diag_mam + DIFF SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_ba + DIFF SMS_P48x1_D_Ln3_Vnuopc.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase + DIFF SUB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s + - differences are only in Med_aoflux_atm_So_ustar mediator field resulting from adding + So_ustar to atm imports, otherwise all other fields bit-for-bit izumi/gnu/aux_cam: + DIFF ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC4.izumi_gnu.cam-outfrq3s_diags + DIFF ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_gnu.cam-outfrq3s_unicon + DIFF ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_gnu.cam-rad_diag + DIFF ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPSPCAMM.izumi_gnu.cam-outfrq3s + DIFF ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC4.izumi_gnu.cam-outfrq3s_nudging_ne5_L26 + DIFF ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq3s_ba + DIFF ERI_D_Ln18_Vnuopc.T5_T5_mg37.QPC4.izumi_gnu.cam-co2rmp + DIFF ERP_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq9s + DIFF PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal0 + DIFF PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal1 + DIFF PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal3 + DIFF SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC4.izumi_gnu.cam-scm_prep + DIFF SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC6.izumi_gnu.cam-scm_prep_c6 + DIFF SMS_D_Ln3_Vnuopc.f10_f10_mg37.QPMOZ.izumi_gnu.cam-outfrq3s_chemproc + DIFF SMS_D_Ln9.f10_f10_mg37.2000_CAM%DEV%GHGMAM4_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV_SESP.izumi_gnu.cam-outfrq9s + DIFF SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC4.izumi_gnu.cam-outfrq9s_apmee + DIFF SMS_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-outfrq3s_ttrac + DIFF SMS_P48x1_D_Ln9_Vnuopc.f19_f19_mg17.FW4madSD.izumi_gnu.cam-outfrq9s + - differences are only in Med_aoflux_atm_So_ustar mediator field resulting from adding + So_ustar to atm imports, otherwise all other fields bit-for-bit + +Summarize any changes to answers: bit-for-bit unchanged =============================================================== =============================================================== From 26e6306f758e2d547862dab70ba90b9f25c9921e Mon Sep 17 00:00:00 2001 From: Jesse Nusbaumer Date: Mon, 5 Feb 2024 15:38:16 -0700 Subject: [PATCH 233/291] Update topo file path to official inputdata repo path in namelist defaults file. --- bld/namelist_files/namelist_defaults_cam.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/bld/namelist_files/namelist_defaults_cam.xml b/bld/namelist_files/namelist_defaults_cam.xml index 04893edb67..8318f855e6 100644 --- a/bld/namelist_files/namelist_defaults_cam.xml +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -320,7 +320,7 @@ atm/cam/topo/se/ne3pg3_gmted2010_modis_bedmachine_nc0540_Laplace1000_noleak_20230209.nc atm/cam/topo/se/ne5pg3_nc3000_Co360_Fi001_MulG_PF_nullRR_Nsw064_20170516.nc atm/cam/topo/se/ne16pg3_nc3000_Co120_Fi001_PF_nullRR_Nsw084_20171012.nc -/glade/campaign/cgd/amp/pel/topo/files/se/ne30pg3_gmted2010_modis_bedmachine_nc3000_Laplace0100_noleak_20240117.nc +atm/cam/topo/se/ne30pg3_gmted2010_modis_bedmachine_nc3000_Laplace0100_noleak_20240117.nc atm/cam/topo/se/ne60pg3_nc3000_Co030_Fi001_PF_nullRR_Nsw021_20171012.nc atm/cam/topo/se/ne120pg3_nc3000_Co015_Fi001_PF_nullRR_Nsw010_20171014.nc atm/cam/topo/se/ne240pg3_nc3000_Co008_Fi001_PF_nullRR_Nsw005_20171015.nc From ccb49739c8ca84ea22802ebd720d88e7185e33d8 Mon Sep 17 00:00:00 2001 From: Brian Eaton Date: Tue, 6 Feb 2024 10:13:19 -0500 Subject: [PATCH 234/291] use broadband flux objects for clear-sky calcs --- src/physics/rrtmgp/radiation.F90 | 129 ++++++++++++++------------- src/physics/rrtmgp/rrtmgp_inputs.F90 | 4 +- 2 files changed, 71 insertions(+), 62 deletions(-) diff --git a/src/physics/rrtmgp/radiation.F90 b/src/physics/rrtmgp/radiation.F90 index d1b5603301..099eaeae3c 100644 --- a/src/physics/rrtmgp/radiation.F90 +++ b/src/physics/rrtmgp/radiation.F90 @@ -52,6 +52,7 @@ module radiation use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp use mo_optical_props, only: ty_optical_props_1scl, ty_optical_props_2str use mo_source_functions, only: ty_source_func_lw +use mo_fluxes, only: ty_fluxes_broadband use mo_fluxes_byband, only: ty_fluxes_byband use string_utils, only: to_lower @@ -955,10 +956,13 @@ subroutine radiation_tend( & type(ty_optical_props_1scl) :: aer_lw type(ty_optical_props_2str) :: aer_sw - ! Flux objects contain all fluxes computed by RRTMGP. Includes spectrally resolved and - ! total fluxes for all levels of the RRTMGP grid. - type(ty_fluxes_byband) :: fsw, fswc - type(ty_fluxes_byband) :: flw, flwc + ! Flux objects contain all fluxes computed by RRTMGP. + ! SW allsky fluxes always include spectrally resolved fluxes needed for surface models. + type(ty_fluxes_byband) :: fsw + ! LW allsky fluxes only need spectrally resolved fluxes when spectralflux=.true. + type(ty_fluxes_byband) :: flw + ! Only broadband fluxes needed for clear sky (diagnostics). + type(ty_fluxes_broadband) :: fswc, flwc ! Arrays for output diagnostics on CAM grid. real(r8) :: fns(pcols,pverp) ! net shortwave flux @@ -1758,8 +1762,8 @@ subroutine coefs_init(coefs_file, available_gases, kdist) class(ty_gas_optics_rrtmgp), intent(out) :: kdist ! local variables - type(file_desc_t) :: fh ! pio file handle - character(len=256) :: locfn ! path to file on local storage + type(file_desc_t) :: fh ! pio file handle + character(len=cl) :: locfn ! path to file on local storage ! File dimensions integer :: & @@ -2124,9 +2128,10 @@ subroutine coefs_init(coefs_file, available_gases, kdist) ierr = pio_get_var(fh, vid, minor_limits_gpt_upper) if (ierr /= PIO_NOERR) call endrun(sub//': error reading minor_limits_gpt_upper') - ! Read as integer and convert to logical + ! Read as integer and convert to logical allocate(int2log(minor_absorber_intervals_lower), stat=istat) call check_allocate(istat, sub, 'int2log for lower') + allocate(minor_scales_with_density_lower(minor_absorber_intervals_lower), stat=istat) call check_allocate(istat, sub, 'minor_scales_with_density_lower') ierr = pio_inq_varid(fh, 'minor_scales_with_density_lower', vid) @@ -2140,29 +2145,7 @@ subroutine coefs_init(coefs_file, available_gases, kdist) minor_scales_with_density_lower(i) = .true. end if end do - deallocate(int2log) - - ! Read as integer and convert to logical - allocate(int2log(minor_absorber_intervals_upper), stat=istat) - call check_allocate(istat, sub, 'int2log for upper') - allocate(minor_scales_with_density_upper(minor_absorber_intervals_upper), stat=istat) - call check_allocate(istat, sub, 'minor_scales_with_density_upper') - ierr = pio_inq_varid(fh, 'minor_scales_with_density_upper', vid) - if (ierr /= PIO_NOERR) call endrun(sub//': minor_scales_with_density_upper not found') - ierr = pio_get_var(fh, vid, int2log) - if (ierr /= PIO_NOERR) call endrun(sub//': error reading minor_scales_with_density_upper') - do i = 1,minor_absorber_intervals_upper - if (int2log(i) .eq. 0) then - minor_scales_with_density_upper(i) = .false. - else - minor_scales_with_density_upper(i) = .true. - end if - end do - deallocate(int2log) - ! Read as integer and convert to logical - allocate(int2log(minor_absorber_intervals_lower), stat=istat) - call check_allocate(istat, sub, 'int2log for lower') allocate(scale_by_complement_lower(minor_absorber_intervals_lower), stat=istat) call check_allocate(istat, sub, 'scale_by_complement_lower') ierr = pio_inq_varid(fh, 'scale_by_complement_lower', vid) @@ -2176,11 +2159,27 @@ subroutine coefs_init(coefs_file, available_gases, kdist) scale_by_complement_lower(i) = .true. end if end do + deallocate(int2log) ! Read as integer and convert to logical allocate(int2log(minor_absorber_intervals_upper), stat=istat) call check_allocate(istat, sub, 'int2log for upper') + + allocate(minor_scales_with_density_upper(minor_absorber_intervals_upper), stat=istat) + call check_allocate(istat, sub, 'minor_scales_with_density_upper') + ierr = pio_inq_varid(fh, 'minor_scales_with_density_upper', vid) + if (ierr /= PIO_NOERR) call endrun(sub//': minor_scales_with_density_upper not found') + ierr = pio_get_var(fh, vid, int2log) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading minor_scales_with_density_upper') + do i = 1,minor_absorber_intervals_upper + if (int2log(i) .eq. 0) then + minor_scales_with_density_upper(i) = .false. + else + minor_scales_with_density_upper(i) = .true. + end if + end do + allocate(scale_by_complement_upper(minor_absorber_intervals_upper), stat=istat) call check_allocate(istat, sub, 'scale_by_complement_upper') ierr = pio_inq_varid(fh, 'scale_by_complement_upper', vid) @@ -2194,6 +2193,7 @@ subroutine coefs_init(coefs_file, available_gases, kdist) scale_by_complement_upper(i) = .true. end if end do + deallocate(int2log) allocate(scaling_gas_lower(minor_absorber_intervals_lower), stat=istat) @@ -2307,9 +2307,9 @@ subroutine initialize_rrtmgp_fluxes(ncol, nlevels, nbands, fluxes, do_direct) ! Allocate flux arrays and set values to zero. ! Arguments - integer, intent(in) :: ncol, nlevels, nbands - type(ty_fluxes_byband), intent(inout) :: fluxes - logical, intent(in), optional :: do_direct + integer, intent(in) :: ncol, nlevels, nbands + class(ty_fluxes_broadband), intent(inout) :: fluxes + logical, optional, intent(in) :: do_direct ! Local variables logical :: do_direct_local @@ -2335,17 +2335,23 @@ subroutine initialize_rrtmgp_fluxes(ncol, nlevels, nbands, fluxes, do_direct) call check_allocate(istat, sub, 'fluxes%flux_dn_dir') end if - ! Fluxes by band - allocate(fluxes%bnd_flux_up(ncol, nlevels, nbands), stat=istat) - call check_allocate(istat, sub, 'fluxes%bnd_flux_up') - allocate(fluxes%bnd_flux_dn(ncol, nlevels, nbands), stat=istat) - call check_allocate(istat, sub, 'fluxes%bnd_flux_dn') - allocate(fluxes%bnd_flux_net(ncol, nlevels, nbands), stat=istat) - call check_allocate(istat, sub, 'fluxes%bnd_flux_net') - if (do_direct_local) then - allocate(fluxes%bnd_flux_dn_dir(ncol, nlevels, nbands), stat=istat) - call check_allocate(istat, sub, 'fluxes%bnd_flux_dn_dir') - end if + select type (fluxes) + type is (ty_fluxes_byband) + ! Fluxes by band always needed for SW. Only allocate for LW + ! when spectralflux is true. + if (nbands == nswbands .or. spectralflux) then + allocate(fluxes%bnd_flux_up(ncol, nlevels, nbands), stat=istat) + call check_allocate(istat, sub, 'fluxes%bnd_flux_up') + allocate(fluxes%bnd_flux_dn(ncol, nlevels, nbands), stat=istat) + call check_allocate(istat, sub, 'fluxes%bnd_flux_dn') + allocate(fluxes%bnd_flux_net(ncol, nlevels, nbands), stat=istat) + call check_allocate(istat, sub, 'fluxes%bnd_flux_net') + if (do_direct_local) then + allocate(fluxes%bnd_flux_dn_dir(ncol, nlevels, nbands), stat=istat) + call check_allocate(istat, sub, 'fluxes%bnd_flux_dn_dir') + end if + end if + end select ! Initialize call reset_fluxes(fluxes) @@ -2358,24 +2364,23 @@ subroutine reset_fluxes(fluxes) ! Reset flux arrays to zero. - type(ty_fluxes_byband), intent(inout) :: fluxes + class(ty_fluxes_broadband), intent(inout) :: fluxes !---------------------------------------------------------------------------- ! Reset broadband fluxes fluxes%flux_up(:,:) = 0._r8 fluxes%flux_dn(:,:) = 0._r8 fluxes%flux_net(:,:) = 0._r8 - if (associated(fluxes%flux_dn_dir)) then - fluxes%flux_dn_dir(:,:) = 0._r8 - end if - - ! Reset band-by-band fluxes - fluxes%bnd_flux_up(:,:,:) = 0._r8 - fluxes%bnd_flux_dn(:,:,:) = 0._r8 - fluxes%bnd_flux_net(:,:,:) = 0._r8 - if (associated(fluxes%bnd_flux_dn_dir)) then - fluxes%bnd_flux_dn_dir(:,:,:) = 0._r8 - end if + if (associated(fluxes%flux_dn_dir)) fluxes%flux_dn_dir(:,:) = 0._r8 + + select type (fluxes) + type is (ty_fluxes_byband) + ! Reset band-by-band fluxes + if (associated(fluxes%bnd_flux_up)) fluxes%bnd_flux_up(:,:,:) = 0._r8 + if (associated(fluxes%bnd_flux_dn)) fluxes%bnd_flux_dn(:,:,:) = 0._r8 + if (associated(fluxes%bnd_flux_net)) fluxes%bnd_flux_net(:,:,:) = 0._r8 + if (associated(fluxes%bnd_flux_dn_dir)) fluxes%bnd_flux_dn_dir(:,:,:) = 0._r8 + end select end subroutine reset_fluxes @@ -2407,16 +2412,20 @@ end subroutine free_optics_lw subroutine free_fluxes(fluxes) - type(ty_fluxes_byband), intent(inout) :: fluxes + class(ty_fluxes_broadband), intent(inout) :: fluxes if (associated(fluxes%flux_up)) deallocate(fluxes%flux_up) if (associated(fluxes%flux_dn)) deallocate(fluxes%flux_dn) if (associated(fluxes%flux_net)) deallocate(fluxes%flux_net) if (associated(fluxes%flux_dn_dir)) deallocate(fluxes%flux_dn_dir) - if (associated(fluxes%bnd_flux_up)) deallocate(fluxes%bnd_flux_up) - if (associated(fluxes%bnd_flux_dn)) deallocate(fluxes%bnd_flux_dn) - if (associated(fluxes%bnd_flux_net)) deallocate(fluxes%bnd_flux_net) - if (associated(fluxes%bnd_flux_dn_dir)) deallocate(fluxes%bnd_flux_dn_dir) + + select type (fluxes) + type is (ty_fluxes_byband) + if (associated(fluxes%bnd_flux_up)) deallocate(fluxes%bnd_flux_up) + if (associated(fluxes%bnd_flux_dn)) deallocate(fluxes%bnd_flux_dn) + if (associated(fluxes%bnd_flux_net)) deallocate(fluxes%bnd_flux_net) + if (associated(fluxes%bnd_flux_dn_dir)) deallocate(fluxes%bnd_flux_dn_dir) + end select end subroutine free_fluxes diff --git a/src/physics/rrtmgp/rrtmgp_inputs.F90 b/src/physics/rrtmgp/rrtmgp_inputs.F90 index 93b32b007f..9aaab0f518 100644 --- a/src/physics/rrtmgp/rrtmgp_inputs.F90 +++ b/src/physics/rrtmgp/rrtmgp_inputs.F90 @@ -206,8 +206,8 @@ subroutine rrtmgp_set_state( & ! the albedo to be the average of the visible and near-infrared ! broadband albedos do i = 1, nday - alb_dir(iband,i) = 0.5 * (cam_in%aldir(idxday(i)) + cam_in%asdir(idxday(i))) - alb_dif(iband,i) = 0.5 * (cam_in%aldif(idxday(i)) + cam_in%asdif(idxday(i))) + alb_dir(iband,i) = 0.5_r8 * (cam_in%aldir(idxday(i)) + cam_in%asdir(idxday(i))) + alb_dif(iband,i) = 0.5_r8 * (cam_in%aldif(idxday(i)) + cam_in%asdif(idxday(i))) end do end if end do From 0ac117364976e955f497189c153f325f00c54ba3 Mon Sep 17 00:00:00 2001 From: Brian Eaton Date: Tue, 6 Feb 2024 13:00:22 -0500 Subject: [PATCH 235/291] address review comments --- doc/ChangeLog | 3 +++ src/physics/rrtmgp/rrtmgp_inputs.F90 | 34 +++++++++++++++------------- test/system/TR8.sh | 4 ++++ 3 files changed, 25 insertions(+), 16 deletions(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index 3c6f232433..fce0eb29da 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -157,6 +157,9 @@ src/physics/simple/radconstants.F90 src/physics/spcam/crm/CLUBB/crmx_mt95.f90 . removed 3 non-ascii characters (in comments) +test/system/TR8.sh +. add checks for rrtmgp interface code + 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 diff --git a/src/physics/rrtmgp/rrtmgp_inputs.F90 b/src/physics/rrtmgp/rrtmgp_inputs.F90 index 9aaab0f518..179b7b7f9b 100644 --- a/src/physics/rrtmgp/rrtmgp_inputs.F90 +++ b/src/physics/rrtmgp/rrtmgp_inputs.F90 @@ -39,6 +39,7 @@ module rrtmgp_inputs use cam_history_support, only: fillvalue use cam_logfile, only: iulog use cam_abortutils, only: endrun +use error_messages, only: alloc_err implicit none private @@ -230,7 +231,7 @@ end subroutine rrtmgp_set_state !========================================================================================= -logical function is_visible(wavenumber) +pure logical function is_visible(wavenumber) ! Wavenumber is in the visible if it is above the visible threshold ! wavenumber, and in the infrared if it is below the threshold @@ -315,6 +316,7 @@ subroutine rad_gas_get_vmr(icall, gas_name, state, pbuf, nlay, numactivecols, ga ! Local variables integer :: i, idx(numactivecols) + integer :: istat real(r8), pointer :: gas_mmr(:,:) real(r8), allocatable :: gas_vmr(:,:) real(r8), allocatable :: mmr(:,:) @@ -341,8 +343,10 @@ subroutine rad_gas_get_vmr(icall, gas_name, state, pbuf, nlay, numactivecols, ga call rad_cnst_get_gas(icall, gas_name, state, pbuf, gas_mmr) ! Copy into storage for RRTMGP - allocate(mmr(numactivecols, nlay)) - allocate(gas_vmr(numactivecols, nlay)) + allocate(mmr(numactivecols, nlay), stat=istat) + call alloc_err(istat, sub, 'mmr', numactivecols*nlay) + allocate(gas_vmr(numactivecols, nlay), stat=istat) + call alloc_err(istat, sub, 'gas_vmr', numactivecols*nlay) do i = 1, numactivecols mmr(i,ktoprad:) = gas_mmr(idx(i),ktopcam:) @@ -370,12 +374,10 @@ subroutine rad_gas_get_vmr(icall, gas_name, state, pbuf, nlay, numactivecols, ga ! to produce temperatures at the top of CAM that are most consistent with WACCM at similar pressure levels. if ((gas_name == 'O3') .and. (nlay == pverp)) then + P_top = 50.0_r8 do i = 1, numactivecols - P_top = 50.0_r8 P_int = state%pint(idx(i),1) ! pressure (Pa) at upper interface of CAM P_mid = state%pmid(idx(i),1) ! pressure (Pa) at midpoint of top layer of CAM - alpha = 0.0_r8 - beta = 0.0_r8 alpha = log(P_int/P_top) beta = log(P_mid/P_int)/log(P_mid/P_top) @@ -387,8 +389,6 @@ subroutine rad_gas_get_vmr(icall, gas_name, state, pbuf, nlay, numactivecols, ga chi_0 = chi_mid / (1._r8 + beta) chi_eff = chi_0 * (a + b) gas_vmr(i,1) = chi_eff - chi_eff = chi_eff * P_int / massratio / 9.8_r8 ! O3 column above in kg m-2 - chi_eff = chi_eff / 2.1415e-5_r8 ! O3 column above in DU end if end do end if @@ -489,7 +489,7 @@ subroutine rrtmgp_set_cloud_lw( & type(ty_optical_props_1scl), intent(out) :: cloud_lw ! Diagnostic outputs - real(r8), intent(out) :: cld_lw_abs_cloudsim(pcols,pver) ! in-cloud snow optical depth (for COSP) + real(r8), intent(out) :: cld_lw_abs_cloudsim(pcols,pver) ! in-cloud liq+ice optical depth (for COSP) real(r8), intent(out) :: snow_lw_abs_cloudsim(pcols,pver)! in-cloud snow optical depth (for COSP) real(r8), intent(out) :: grau_lw_abs_cloudsim(pcols,pver)! in-cloud Graupel optical depth (for COSP) @@ -645,27 +645,28 @@ subroutine rrtmgp_set_cloud_sw( & integer :: i, k, ncol integer :: igpt, nver + integer :: istat integer, parameter :: changeseed = 1 ! cloud radiative parameters are "in cloud" not "in cell" real(r8) :: ice_tau (nswbands,pcols,pver) ! ice extinction optical depth real(r8) :: ice_tau_w (nswbands,pcols,pver) ! ice single scattering albedo * tau - real(r8) :: ice_tau_w_g(nswbands,pcols,pver) ! ice assymetry parameter * tau * w + real(r8) :: ice_tau_w_g(nswbands,pcols,pver) ! ice asymmetry parameter * tau * w real(r8) :: liq_tau (nswbands,pcols,pver) ! liquid extinction optical depth real(r8) :: liq_tau_w (nswbands,pcols,pver) ! liquid single scattering albedo * tau - real(r8) :: liq_tau_w_g(nswbands,pcols,pver) ! liquid assymetry parameter * tau * w + real(r8) :: liq_tau_w_g(nswbands,pcols,pver) ! liquid asymmetry parameter * tau * w real(r8) :: cld_tau (nswbands,pcols,pver) ! cloud extinction optical depth real(r8) :: cld_tau_w (nswbands,pcols,pver) ! cloud single scattering albedo * tau - real(r8) :: cld_tau_w_g(nswbands,pcols,pver) ! cloud assymetry parameter * w * tau + real(r8) :: cld_tau_w_g(nswbands,pcols,pver) ! cloud asymmetry parameter * w * tau real(r8) :: snow_tau (nswbands,pcols,pver) ! snow extinction optical depth real(r8) :: snow_tau_w (nswbands,pcols,pver) ! snow single scattering albedo * tau - real(r8) :: snow_tau_w_g(nswbands,pcols,pver) ! snow assymetry parameter * tau * w + real(r8) :: snow_tau_w_g(nswbands,pcols,pver) ! snow asymmetry parameter * tau * w real(r8) :: grau_tau (nswbands,pcols,pver) ! graupel extinction optical depth real(r8) :: grau_tau_w (nswbands,pcols,pver) ! graupel single scattering albedo * tau - real(r8) :: grau_tau_w_g(nswbands,pcols,pver) ! graupel assymetry parameter * tau * w + real(r8) :: grau_tau_w_g(nswbands,pcols,pver) ! graupel asymmetry parameter * tau * w real(r8) :: c_cld_tau (nswbands,pcols,pver) ! combined cloud extinction optical depth real(r8) :: c_cld_tau_w (nswbands,pcols,pver) ! combined cloud single scattering albedo * tau - real(r8) :: c_cld_tau_w_g(nswbands,pcols,pver) ! combined cloud assymetry parameter * w * tau + real(r8) :: c_cld_tau_w_g(nswbands,pcols,pver) ! combined cloud asymmetry parameter * w * tau ! RRTMGP does not use this property in its 2-stream calculations. real(r8) :: sw_tau_w_f(nswbands,pcols,pver) ! Forward scattered fraction * tau * w. @@ -806,7 +807,8 @@ subroutine rrtmgp_set_cloud_sw( & day_cld_tau_w_g(nswbands,nday,nver), & tauc(nswbands,nday,nver), taucmcl(nswgpts,nday,nver), & ssac(nswbands,nday,nver), ssacmcl(nswgpts,nday,nver), & - asmc(nswbands,nday,nver), asmcmcl(nswgpts,nday,nver) ) + asmc(nswbands,nday,nver), asmcmcl(nswgpts,nday,nver), stat=istat) + call alloc_err(istat, sub, 'cldf,..,asmcmcl', 9*nswgpts*nday*nver) ! Subset "chunk" data so just the daylight columns, and the number of CAM layers in the ! radiation calculation are used by MCICA to produce subcolumns. diff --git a/test/system/TR8.sh b/test/system/TR8.sh index e107c702d3..b4eb0365d7 100755 --- a/test/system/TR8.sh +++ b/test/system/TR8.sh @@ -12,6 +12,8 @@ ruby $ADDREALKIND_EXE -r r8 -l 1 -d $CAM_ROOT/components/cam/src/physics/camrt rc=`expr $? + $rc` ruby $ADDREALKIND_EXE -r r8 -l 1 -d $CAM_ROOT/components/cam/src/physics/rrtmg -s aer_src rc=`expr $? + $rc` +ruby $ADDREALKIND_EXE -r r8 -l 1 -d $CAM_ROOT/components/cam/src/physics/rrtmgp -s data,ext +rc=`expr $? + $rc` ruby $ADDREALKIND_EXE -r r8 -l 1 -d $CAM_ROOT/components/cam/src/physics/simple rc=`expr $? + $rc` ruby $ADDREALKIND_EXE -r r8 -l 1 -d $CAM_ROOT/components/cam/src/physics/waccm @@ -27,6 +29,8 @@ ruby $ADDREALKIND_EXE -r r8 -l 1 -d $CAM_ROOT/src/physics/camrt rc=`expr $? + $rc` ruby $ADDREALKIND_EXE -r r8 -l 1 -d $CAM_ROOT/src/physics/rrtmg -s aer_src rc=`expr $? + $rc` +ruby $ADDREALKIND_EXE -r r8 -l 1 -d $CAM_ROOT/src/physics/rrtmgp -s data,ext +rc=`expr $? + $rc` ruby $ADDREALKIND_EXE -r r8 -l 1 -d $CAM_ROOT/src/physics/simple rc=`expr $? + $rc` ruby $ADDREALKIND_EXE -r r8 -l 1 -d $CAM_ROOT/src/physics/waccm From e6f1f709bce92c5b7492f5fd173eedd253d35571 Mon Sep 17 00:00:00 2001 From: Brian Eaton Date: Tue, 6 Feb 2024 20:32:39 -0500 Subject: [PATCH 236/291] fix filename in namelist defaults file --- bld/namelist_files/namelist_defaults_cam.xml | 2 +- src/physics/rrtmgp/rrtmgp_inputs.F90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/bld/namelist_files/namelist_defaults_cam.xml b/bld/namelist_files/namelist_defaults_cam.xml index 1fb2be793c..5afa8a0155 100644 --- a/bld/namelist_files/namelist_defaults_cam.xml +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -1993,7 +1993,7 @@ OFF -atm/cam/chem/trop_mam/atmsrf_ne3np4.pg3_c221214.nc +atm/cam/chem/trop_mam/atmsrf_ne3np4.pg3_221214.nc atm/cam/chem/trop_mam/atmsrf_ne5np4_110920.nc atm/cam/chem/trop_mam/atmsrf_ne5pg3_201105.nc atm/cam/chem/trop_mam/atmsrf_ne16np4_110920.nc diff --git a/src/physics/rrtmgp/rrtmgp_inputs.F90 b/src/physics/rrtmgp/rrtmgp_inputs.F90 index 179b7b7f9b..2f2b125e09 100644 --- a/src/physics/rrtmgp/rrtmgp_inputs.F90 +++ b/src/physics/rrtmgp/rrtmgp_inputs.F90 @@ -705,7 +705,7 @@ subroutine rrtmgp_set_cloud_sw( & call get_snow_optics_sw(state, pbuf, snow_tau, snow_tau_w, snow_tau_w_g, sw_tau_w_f) do i = 1, ncol do k = 1, pver - if (cldfprime(i,k) > 0.) then + if (cldfprime(i,k) > 0._r8) then c_cld_tau(:,i,k) = ( cldfsnow(i,k)*snow_tau(:,i,k) & + cld(i,k)*cld_tau(:,i,k) )/cldfprime(i,k) c_cld_tau_w(:,i,k) = ( cldfsnow(i,k)*snow_tau_w(:,i,k) & From eca1a90650308998e710ed9e272527cc9f5929c7 Mon Sep 17 00:00:00 2001 From: Cheryl Craig Date: Wed, 7 Feb 2024 16:39:24 -0700 Subject: [PATCH 237/291] update externals to match alpha17a --- Externals.cfg | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/Externals.cfg b/Externals.cfg index dfe04d45c4..1e76a9582d 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -1,5 +1,5 @@ [ccs_config] -tag = ccs_config_cesm0.0.82 +tag = ccs_config_cesm0.0.85 protocol = git repo_url = https://github.com/ESMCI/ccs_config_cesm local_path = ccs_config @@ -21,14 +21,14 @@ externals = Externals.cfg required = True [cmeps] -tag = cmeps0.14.43 +tag = cmeps0.14.45 protocol = git repo_url = https://github.com/ESCOMP/CMEPS.git local_path = components/cmeps required = True [cdeps] -tag = cdeps1.0.24 +tag = cdeps1.0.26 protocol = git repo_url = https://github.com/ESCOMP/CDEPS.git local_path = components/cdeps @@ -43,7 +43,7 @@ local_path = components/cpl7 required = True [share] -tag = share1.0.17 +tag = share1.0.18 protocol = git repo_url = https://github.com/ESCOMP/CESM_share local_path = share @@ -64,7 +64,7 @@ local_path = libraries/parallelio required = True [cime] -tag = cime6.0.175 +tag = cime6.0.209_httpsbranch01 protocol = git repo_url = https://github.com/ESMCI/cime local_path = cime @@ -79,7 +79,7 @@ externals = Externals_CISM.cfg required = True [clm] -tag = ctsm5.1.dev142 +tag = ctsm5.1.dev145 protocol = git repo_url = https://github.com/ESCOMP/CTSM local_path = components/clm From 26aee68ad5afbca0f3af46fd09d8c7396aafd38b Mon Sep 17 00:00:00 2001 From: Jesse Nusbaumer Date: Thu, 8 Feb 2024 11:10:53 -0700 Subject: [PATCH 238/291] Remove use of deprecated 'imp' module in python scripts (Github issue #970). --- cime_config/buildlib | 9 +++++---- cime_config/buildnml | 12 ++++++------ 2 files changed, 11 insertions(+), 10 deletions(-) diff --git a/cime_config/buildlib b/cime_config/buildlib index 73db5db3dd..172953ea40 100755 --- a/cime_config/buildlib +++ b/cime_config/buildlib @@ -6,7 +6,7 @@ create the cam library # pylint: disable=multiple-imports, wrong-import-position, wildcard-import # pylint: disable=unused-wildcard-import, bad-whitespace, too-many-locals # pylint: disable=invalid-name -import sys, os, filecmp, shutil, imp +import sys, os, filecmp, shutil _CIMEROOT = os.environ.get("CIMEROOT") @@ -19,6 +19,7 @@ sys.path.append(_LIBDIR) from standard_script_setup import * from CIME.case import Case from CIME.utils import run_sub_or_cmd, expect, run_cmd +from CIME.utils import import_from_file from CIME.buildlib import parse_input from CIME.build import get_standard_makefile_args @@ -41,10 +42,10 @@ def _build_cam(caseroot, libroot, bldroot): cmd = os.path.join(os.path.join(srcroot, "cime_config", "buildcpp")) logger.info(" ...calling cam buildcpp to set build time options") try: - mod = imp.load_source("buildcpp", cmd) - cam_cppdefs = mod.buildcpp(case) + buildcpp = import_from_file("buildcpp", cmd) + cam_cppdefs = buildcpp.buildcpp(case) except: - raise + raise RuntimeError("CAM's 'buildcpp' script failed to run properly.") with Case(caseroot) as case: diff --git a/cime_config/buildnml b/cime_config/buildnml index 28e3e8198c..ddd127d44f 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -4,7 +4,7 @@ CAM namelist creator """ # pylint: disable=multiple-imports -import sys, os, shutil, filecmp, imp +import sys, os, shutil, filecmp _CIMEROOT = os.environ.get("CIMEROOT") if _CIMEROOT is None: @@ -19,7 +19,7 @@ from standard_script_setup import * from CIME.XML.standard_module_setup import * from CIME.buildnml import create_namelist_infile, parse_input from CIME.case import Case -from CIME.utils import expect, run_cmd +from CIME.utils import expect, run_cmd, import_from_file logger = logging.getLogger(__name__) @@ -74,10 +74,10 @@ def buildnml(case, caseroot, compname): cmd = os.path.join(os.path.join(srcroot,"cime_config","buildcpp")) logger.info(" ...calling cam buildcpp to set build time options") try: - mod = imp.load_source("buildcpp", cmd) - mod.buildcpp(case) + buildcpp = import_from_file("buildcpp", cmd) + _ = buildcpp.buildcpp(case) except: - raise + raise RuntimeError("CAM's 'buildcpp' script failed to run properly.") # Verify that we have a config_cache file (generated by the call to buildcpp) expect(os.path.isfile(filename), @@ -172,7 +172,7 @@ def buildnml(case, caseroot, compname): buildnl_opts += ["-inputdata", input_data_list] - CAM_NAMELIST_OPTS += " stream_ndep_year_first=" + stream_ndep_year_first + CAM_NAMELIST_OPTS += " stream_ndep_year_first=" + stream_ndep_year_first CAM_NAMELIST_OPTS += " stream_ndep_year_last=" + stream_ndep_year_last CAM_NAMELIST_OPTS += " stream_ndep_year_align=" + stream_ndep_year_align CAM_NAMELIST_OPTS += " stream_ndep_data_filename='" + stream_ndep_data_filename.strip() + "'" From 29da94d36769ec616148741650ca9a9d8a35b43b Mon Sep 17 00:00:00 2001 From: Brian Eaton Date: Tue, 13 Feb 2024 09:40:47 -0500 Subject: [PATCH 239/291] address review comments --- bld/configure | 2 +- src/physics/cam/aer_rad_props.F90 | 2 +- src/physics/cam/cloud_rad_props.F90 | 20 ++-- src/physics/cam/cospsimulator_intr.F90 | 4 +- src/physics/cam/ebert_curry_ice_optics.F90 | 2 +- src/physics/cam/slingo_liq_optics.F90 | 2 +- src/physics/camrt/radiation.F90 | 2 +- src/physics/camrt/radsw.F90 | 6 +- src/physics/rrtmg/aer_src/rrtmg_sw_reftra.f90 | 2 +- src/physics/rrtmg/radiation.F90 | 14 +-- src/physics/rrtmg/radsw.F90 | 2 +- src/physics/rrtmgp/mcica_subcol_gen.F90 | 20 ++-- src/physics/rrtmgp/radconstants.F90 | 4 +- src/physics/rrtmgp/radiation.F90 | 109 ++++++++---------- 14 files changed, 89 insertions(+), 102 deletions(-) diff --git a/bld/configure b/bld/configure index 7915dc75a5..974c30dc5e 100755 --- a/bld/configure +++ b/bld/configure @@ -1077,7 +1077,7 @@ if (defined $opts{'rad'}) { # the radiation package name in the config_cache file. if ($rad_pkg eq 'rrtmgp_gpu') { $use_rrtmgp_gpu = 1; - $rad_pkg =~ s!_gpu!! + $rad_pkg = 'rrtmgp'; } } diff --git a/src/physics/cam/aer_rad_props.F90 b/src/physics/cam/aer_rad_props.F90 index 9ee53bfae1..08dced5a93 100644 --- a/src/physics/cam/aer_rad_props.F90 +++ b/src/physics/cam/aer_rad_props.F90 @@ -130,7 +130,7 @@ subroutine aer_rad_props_sw(list_idx, state, pbuf, nnite, idxnite, & real(r8), intent(out) :: tau (pcols,0:pver,nswbands) ! aerosol extinction optical depth real(r8), intent(out) :: tau_w (pcols,0:pver,nswbands) ! aerosol single scattering albedo * tau - real(r8), intent(out) :: tau_w_g(pcols,0:pver,nswbands) ! aerosol assymetry parameter * tau * w + real(r8), intent(out) :: tau_w_g(pcols,0:pver,nswbands) ! aerosol asymmetry parameter * tau * w real(r8), intent(out) :: tau_w_f(pcols,0:pver,nswbands) ! aerosol forward scattered fraction * tau * w ! Local variables diff --git a/src/physics/cam/cloud_rad_props.F90 b/src/physics/cam/cloud_rad_props.F90 index 9c8a1a3562..257138e7b5 100644 --- a/src/physics/cam/cloud_rad_props.F90 +++ b/src/physics/cam/cloud_rad_props.F90 @@ -71,6 +71,8 @@ module cloud_rad_props ixcldice, & ! cloud ice water index ixcldliq ! cloud liquid water index +real(r8), parameter :: tiny = 1.e-80_r8 + !============================================================================== contains !============================================================================== @@ -347,7 +349,7 @@ subroutine get_ice_optics_sw(state, pbuf, tau, tau_w, tau_w_g, tau_w_f) real(r8),intent(out) :: tau (nswbands,pcols,pver) ! extinction optical depth real(r8),intent(out) :: tau_w (nswbands,pcols,pver) ! single scattering albedo * tau - real(r8),intent(out) :: tau_w_g(nswbands,pcols,pver) ! asymetry parameter * tau * w + real(r8),intent(out) :: tau_w_g(nswbands,pcols,pver) ! asymmetry parameter * tau * w real(r8),intent(out) :: tau_w_f(nswbands,pcols,pver) ! forward scattered fraction * tau * w real(r8), pointer :: iciwpth(:,:), dei(:,:) @@ -370,7 +372,7 @@ subroutine get_snow_optics_sw(state, pbuf, tau, tau_w, tau_w_g, tau_w_f) real(r8),intent(out) :: tau (nswbands,pcols,pver) ! extinction optical depth real(r8),intent(out) :: tau_w (nswbands,pcols,pver) ! single scattering albedo * tau - real(r8),intent(out) :: tau_w_g(nswbands,pcols,pver) ! asymetry parameter * tau * w + real(r8),intent(out) :: tau_w_g(nswbands,pcols,pver) ! asymmetry parameter * tau * w real(r8),intent(out) :: tau_w_f(nswbands,pcols,pver) ! forward scattered fraction * tau * w real(r8), pointer :: icswpth(:,:), des(:,:) @@ -393,7 +395,7 @@ subroutine get_grau_optics_sw(state, pbuf, tau, tau_w, tau_w_g, tau_w_f) real(r8),intent(out) :: tau (nswbands,pcols,pver) ! extinction optical depth real(r8),intent(out) :: tau_w (nswbands,pcols,pver) ! single scattering albedo * tau - real(r8),intent(out) :: tau_w_g(nswbands,pcols,pver) ! asymetry parameter * tau * w + real(r8),intent(out) :: tau_w_g(nswbands,pcols,pver) ! asymmetry parameter * tau * w real(r8),intent(out) :: tau_w_f(nswbands,pcols,pver) ! forward scattered fraction * tau * w real(r8), pointer :: icgrauwpth(:,:), degrau(:,:) @@ -433,7 +435,7 @@ subroutine get_liquid_optics_sw(state, pbuf, tau, tau_w, tau_w_g, tau_w_f) real(r8),intent(out) :: tau (nswbands,pcols,pver) ! extinction optical depth real(r8),intent(out) :: tau_w (nswbands,pcols,pver) ! single scattering albedo * tau - real(r8),intent(out) :: tau_w_g(nswbands,pcols,pver) ! asymetry parameter * tau * w + real(r8),intent(out) :: tau_w_g(nswbands,pcols,pver) ! asymmetry parameter * tau * w real(r8),intent(out) :: tau_w_f(nswbands,pcols,pver) ! forward scattered fraction * tau * w real(r8), pointer, dimension(:,:) :: lamc, pgam, iclwpth @@ -568,7 +570,7 @@ subroutine interpolate_ice_optics_sw(ncol, iciwpth, dei, tau, tau_w, & real(r8),intent(out) :: tau (nswbands,pcols,pver) ! extinction optical depth real(r8),intent(out) :: tau_w (nswbands,pcols,pver) ! single scattering albedo * tau - real(r8),intent(out) :: tau_w_g(nswbands,pcols,pver) ! asymetry parameter * tau * w + real(r8),intent(out) :: tau_w_g(nswbands,pcols,pver) ! asymmetry parameter * tau * w real(r8),intent(out) :: tau_w_f(nswbands,pcols,pver) ! forward scattered fraction * tau * w type(interp_type) :: dei_wgts @@ -578,7 +580,7 @@ subroutine interpolate_ice_optics_sw(ncol, iciwpth, dei, tau, tau_w, & do k = 1,pver do i = 1,ncol - if( iciwpth(i,k) < 1.e-80_r8 .or. dei(i,k) == 0._r8) then + if( iciwpth(i,k) < tiny .or. dei(i,k) == 0._r8) then ! if ice water path is too small, OD := 0 tau (:,i,k) = 0._r8 tau_w (:,i,k) = 0._r8 @@ -626,7 +628,7 @@ subroutine interpolate_ice_optics_lw(ncol, iciwpth, dei, abs_od) do k = 1,pver do i = 1,ncol ! if ice water path is too small, OD := 0 - if( iciwpth(i,k) < 1.e-80_r8 .or. dei(i,k) == 0._r8) then + if( iciwpth(i,k) < tiny .or. dei(i,k) == 0._r8) then abs_od (:,i,k) = 0._r8 else ! for each cell interpolate to find weights in g_d_eff grid. @@ -659,7 +661,7 @@ subroutine gam_liquid_lw(clwptn, lamc, pgam, abs_od) type(interp_type) :: mu_wgts type(interp_type) :: lambda_wgts - if (clwptn < 1.e-80_r8) then + if (clwptn < tiny) then abs_od = 0._r8 return endif @@ -693,7 +695,7 @@ subroutine gam_liquid_sw(clwptn, lamc, pgam, tau, tau_w, tau_w_g, tau_w_f) type(interp_type) :: mu_wgts type(interp_type) :: lambda_wgts - if (clwptn < 1.e-80_r8) then + if (clwptn < tiny) then tau = 0._r8 tau_w = 0._r8 tau_w_g = 0._r8 diff --git a/src/physics/cam/cospsimulator_intr.F90 b/src/physics/cam/cospsimulator_intr.F90 index 855a8e82d5..6a01415f04 100644 --- a/src/physics/cam/cospsimulator_intr.F90 +++ b/src/physics/cam/cospsimulator_intr.F90 @@ -1107,7 +1107,7 @@ subroutine cospsimulator_intr_init() flag_xyfill=.true., fill_value=R_UNDEF) call addfld ('MODIS_fracliq', (/'cosp_scol','lev '/), 'I','1', 'Fraction of tau from liquid water', & flag_xyfill=.true., fill_value=R_UNDEF) - call addfld ('MODIS_asym', (/'cosp_scol','lev '/), 'I','1', 'Assymetry parameter (MODIS)', & + call addfld ('MODIS_asym', (/'cosp_scol','lev '/), 'I','1', 'Asymmetry parameter (MODIS)', & flag_xyfill=.true., fill_value=R_UNDEF) call addfld ('MODIS_ssa', (/'cosp_scol','lev '/), 'I','1', 'Single-scattering albedo (MODIS)', & flag_xyfill=.true., fill_value=R_UNDEF) @@ -3262,7 +3262,7 @@ subroutine subsample_and_optics(nPoints, nLevels, nColumns, nHydro,overlap, MODIS_snowSize, cospIN%tau_067, MODIS_opticalThicknessLiq, & MODIS_opticalThicknessIce, MODIS_opticalThicknessSnow) - ! Compute assymetry parameter and single scattering albedo + ! Compute asymmetry parameter and single scattering albedo call modis_optics(nPoints, nLevels, nColumns, MODIS_opticalThicknessLiq, & MODIS_waterSize*1.0e6_wp, MODIS_opticalThicknessIce, & MODIS_iceSize*1.0e6_wp, MODIS_opticalThicknessSnow, & diff --git a/src/physics/cam/ebert_curry_ice_optics.F90 b/src/physics/cam/ebert_curry_ice_optics.F90 index 377d15de4a..8d9b4985a7 100644 --- a/src/physics/cam/ebert_curry_ice_optics.F90 +++ b/src/physics/cam/ebert_curry_ice_optics.F90 @@ -61,7 +61,7 @@ subroutine ec_ice_optics_sw (state, pbuf, ice_tau, ice_tau_w, ice_tau_w_g, ice real(r8),intent(out) :: ice_tau (nswbands,pcols,pver) ! extinction optical depth real(r8),intent(out) :: ice_tau_w (nswbands,pcols,pver) ! single scattering albedo * tau - real(r8),intent(out) :: ice_tau_w_g(nswbands,pcols,pver) ! assymetry parameter * tau * w + real(r8),intent(out) :: ice_tau_w_g(nswbands,pcols,pver) ! asymmetry parameter * tau * w real(r8),intent(out) :: ice_tau_w_f(nswbands,pcols,pver) ! forward scattered fraction * tau * w logical, intent(in) :: oldicewp diff --git a/src/physics/cam/slingo_liq_optics.F90 b/src/physics/cam/slingo_liq_optics.F90 index 28b97920e8..781a056b29 100644 --- a/src/physics/cam/slingo_liq_optics.F90 +++ b/src/physics/cam/slingo_liq_optics.F90 @@ -82,7 +82,7 @@ subroutine slingo_liq_optics_sw(state, pbuf, liq_tau, liq_tau_w, liq_tau_w_g, li real(r8),intent(out) :: liq_tau (nswbands,pcols,pver) ! extinction optical depth real(r8),intent(out) :: liq_tau_w (nswbands,pcols,pver) ! single scattering albedo * tau - real(r8),intent(out) :: liq_tau_w_g(nswbands,pcols,pver) ! assymetry parameter * tau * w + real(r8),intent(out) :: liq_tau_w_g(nswbands,pcols,pver) ! asymmetry parameter * tau * w real(r8),intent(out) :: liq_tau_w_f(nswbands,pcols,pver) ! forward scattered fraction * tau * w logical, intent(in) :: oldliqwp diff --git a/src/physics/camrt/radiation.F90 b/src/physics/camrt/radiation.F90 index 7cd74faa11..7ca7b15daa 100644 --- a/src/physics/camrt/radiation.F90 +++ b/src/physics/camrt/radiation.F90 @@ -877,7 +877,7 @@ subroutine radiation_tend( & ! Aerosol shortwave radiative properties real(r8) :: aer_tau (pcols,0:pver,nswbands) ! aerosol extinction optical depth real(r8) :: aer_tau_w (pcols,0:pver,nswbands) ! aerosol single scattering albedo * tau - real(r8) :: aer_tau_w_g(pcols,0:pver,nswbands) ! aerosol assymetry parameter * w * tau + real(r8) :: aer_tau_w_g(pcols,0:pver,nswbands) ! aerosol asymmetry parameter * w * tau real(r8) :: aer_tau_w_f(pcols,0:pver,nswbands) ! aerosol forward scattered fraction * w * tau ! Aerosol longwave absorption optical depth diff --git a/src/physics/camrt/radsw.F90 b/src/physics/camrt/radsw.F90 index e0d609a4cc..58138e4a5f 100644 --- a/src/physics/camrt/radsw.F90 +++ b/src/physics/camrt/radsw.F90 @@ -237,7 +237,7 @@ subroutine radcswmx(lchnk ,ncol , & ! real(r8),intent(in) :: E_aer_tau (pcols,0:pver,nswbands) ! aerosol extinction optical depth real(r8),intent(in) :: E_aer_tau_w (pcols,0:pver,nswbands) ! aerosol single scattering albedo * tau - real(r8),intent(in) :: E_aer_tau_w_g(pcols,0:pver,nswbands) ! aerosol assymetry parameter * w * tau + real(r8),intent(in) :: E_aer_tau_w_g(pcols,0:pver,nswbands) ! aerosol asymmetry parameter * w * tau real(r8),intent(in) :: E_aer_tau_w_f(pcols,0:pver,nswbands) ! aerosol forward scattered fraction * w * tau ! @@ -288,7 +288,7 @@ subroutine radcswmx(lchnk ,ncol , & ! real(r8):: aer_tau (pcols,0:pver,nswbands) ! aerosol extinction optical depth real(r8):: aer_tau_w (pcols,0:pver,nswbands) ! aerosol single scattering albedo * tau - real(r8):: aer_tau_w_g(pcols,0:pver,nswbands) ! aerosol assymetry parameter * w * tau + real(r8):: aer_tau_w_g(pcols,0:pver,nswbands) ! aerosol asymmetry parameter * w * tau real(r8):: aer_tau_w_f(pcols,0:pver,nswbands) ! aerosol forward scattered fraction * w * tau real(r8) :: pmid(pcols,pver) ! Level pressure real(r8) :: pint(pcols,pverp) ! Interface pressure @@ -1994,7 +1994,7 @@ subroutine raddedmx(coszrs ,ndayc ,abh2o , & ! real(r8) trmin ! Minimum total transmission allowed real(r8) wray ! Rayleigh single scatter albedo - real(r8) gray ! Rayleigh asymetry parameter + real(r8) gray ! Rayleigh asymmetry parameter real(r8) fray ! Rayleigh forward scattered fraction parameter (trmin = 1.e-3_r8) diff --git a/src/physics/rrtmg/aer_src/rrtmg_sw_reftra.f90 b/src/physics/rrtmg/aer_src/rrtmg_sw_reftra.f90 index d37f392025..1622e48450 100644 --- a/src/physics/rrtmg/aer_src/rrtmg_sw_reftra.f90 +++ b/src/physics/rrtmg/aer_src/rrtmg_sw_reftra.f90 @@ -43,7 +43,7 @@ subroutine reftra_sw(nlayers, ncol, lrtchk, pgg, prmuz, ptau, pw, & ! lrtchk = .t. for all layers in clear profile ! lrtchk = .t. for cloudy layers in cloud profile ! = .f. for clear layers in cloud profile -! pgg = assymetry factor +! pgg = asymmetry factor ! prmuz = cosine solar zenith angle ! ptau = optical thickness ! pw = single scattering albedo diff --git a/src/physics/rrtmg/radiation.F90 b/src/physics/rrtmg/radiation.F90 index 3b47e8c2ad..12f8cd7ec6 100644 --- a/src/physics/rrtmg/radiation.F90 +++ b/src/physics/rrtmg/radiation.F90 @@ -806,28 +806,28 @@ subroutine radiation_tend( & ! cloud radiative parameters are "in cloud" not "in cell" real(r8) :: ice_tau (nswbands,pcols,pver) ! ice extinction optical depth real(r8) :: ice_tau_w (nswbands,pcols,pver) ! ice single scattering albedo * tau - real(r8) :: ice_tau_w_g(nswbands,pcols,pver) ! ice assymetry parameter * tau * w + real(r8) :: ice_tau_w_g(nswbands,pcols,pver) ! ice asymmetry parameter * tau * w real(r8) :: ice_tau_w_f(nswbands,pcols,pver) ! ice forward scattered fraction * tau * w real(r8) :: ice_lw_abs (nlwbands,pcols,pver) ! ice absorption optics depth (LW) ! cloud radiative parameters are "in cloud" not "in cell" real(r8) :: liq_tau (nswbands,pcols,pver) ! liquid extinction optical depth real(r8) :: liq_tau_w (nswbands,pcols,pver) ! liquid single scattering albedo * tau - real(r8) :: liq_tau_w_g(nswbands,pcols,pver) ! liquid assymetry parameter * tau * w + real(r8) :: liq_tau_w_g(nswbands,pcols,pver) ! liquid asymmetry parameter * tau * w real(r8) :: liq_tau_w_f(nswbands,pcols,pver) ! liquid forward scattered fraction * tau * w real(r8) :: liq_lw_abs (nlwbands,pcols,pver) ! liquid absorption optics depth (LW) ! cloud radiative parameters are "in cloud" not "in cell" real(r8) :: cld_tau (nswbands,pcols,pver) ! cloud extinction optical depth real(r8) :: cld_tau_w (nswbands,pcols,pver) ! cloud single scattering albedo * tau - real(r8) :: cld_tau_w_g(nswbands,pcols,pver) ! cloud assymetry parameter * w * tau + real(r8) :: cld_tau_w_g(nswbands,pcols,pver) ! cloud asymmetry parameter * w * tau real(r8) :: cld_tau_w_f(nswbands,pcols,pver) ! cloud forward scattered fraction * w * tau real(r8) :: cld_lw_abs (nlwbands,pcols,pver) ! cloud absorption optics depth (LW) ! cloud radiative parameters are "in cloud" not "in cell" real(r8) :: snow_tau (nswbands,pcols,pver) ! snow extinction optical depth real(r8) :: snow_tau_w (nswbands,pcols,pver) ! snow single scattering albedo * tau - real(r8) :: snow_tau_w_g(nswbands,pcols,pver) ! snow assymetry parameter * tau * w + real(r8) :: snow_tau_w_g(nswbands,pcols,pver) ! snow asymmetry parameter * tau * w real(r8) :: snow_tau_w_f(nswbands,pcols,pver) ! snow forward scattered fraction * tau * w real(r8) :: snow_lw_abs (nlwbands,pcols,pver)! snow absorption optics depth (LW) @@ -835,7 +835,7 @@ subroutine radiation_tend( & ! cloud radiative parameters are "in cloud" not "in cell" real(r8) :: grau_tau (nswbands,pcols,pver) ! graupel extinction optical depth real(r8) :: grau_tau_w (nswbands,pcols,pver) ! graupel single scattering albedo * tau - real(r8) :: grau_tau_w_g(nswbands,pcols,pver) ! graupel assymetry parameter * tau * w + real(r8) :: grau_tau_w_g(nswbands,pcols,pver) ! graupel asymmetry parameter * tau * w real(r8) :: grau_tau_w_f(nswbands,pcols,pver) ! graupel forward scattered fraction * tau * w real(r8) :: grau_lw_abs (nlwbands,pcols,pver)! graupel absorption optics depth (LW) @@ -843,7 +843,7 @@ subroutine radiation_tend( & real(r8) :: cldfprime(pcols,pver) ! combined cloud fraction (snow plus regular) real(r8) :: c_cld_tau (nswbands,pcols,pver) ! combined cloud extinction optical depth real(r8) :: c_cld_tau_w (nswbands,pcols,pver) ! combined cloud single scattering albedo * tau - real(r8) :: c_cld_tau_w_g(nswbands,pcols,pver) ! combined cloud assymetry parameter * w * tau + real(r8) :: c_cld_tau_w_g(nswbands,pcols,pver) ! combined cloud asymmetry parameter * w * tau real(r8) :: c_cld_tau_w_f(nswbands,pcols,pver) ! combined cloud forward scattered fraction * w * tau real(r8) :: c_cld_lw_abs (nlwbands,pcols,pver) ! combined cloud absorption optics depth (LW) @@ -855,7 +855,7 @@ subroutine radiation_tend( & ! Aerosol radiative properties real(r8) :: aer_tau (pcols,0:pver,nswbands) ! aerosol extinction optical depth real(r8) :: aer_tau_w (pcols,0:pver,nswbands) ! aerosol single scattering albedo * tau - real(r8) :: aer_tau_w_g(pcols,0:pver,nswbands) ! aerosol assymetry parameter * w * tau + real(r8) :: aer_tau_w_g(pcols,0:pver,nswbands) ! aerosol asymmetry parameter * w * tau real(r8) :: aer_tau_w_f(pcols,0:pver,nswbands) ! aerosol forward scattered fraction * w * tau real(r8) :: aer_lw_abs (pcols,pver,nlwbands) ! aerosol absorption optics depth (LW) diff --git a/src/physics/rrtmg/radsw.F90 b/src/physics/rrtmg/radsw.F90 index df222557dd..994d56b44e 100644 --- a/src/physics/rrtmg/radsw.F90 +++ b/src/physics/rrtmg/radsw.F90 @@ -255,7 +255,7 @@ subroutine rad_rrtmg_sw(lchnk,ncol ,rrtmg_levs ,r_state , & ! Aerosol radiative property arrays real(r8) :: tauxar(pcols,0:pver) ! aerosol extinction optical depth real(r8) :: wa(pcols,0:pver) ! aerosol single scattering albedo - real(r8) :: ga(pcols,0:pver) ! aerosol assymetry parameter + real(r8) :: ga(pcols,0:pver) ! aerosol asymmetry parameter real(r8) :: fa(pcols,0:pver) ! aerosol forward scattered fraction ! CRM diff --git a/src/physics/rrtmgp/mcica_subcol_gen.F90 b/src/physics/rrtmgp/mcica_subcol_gen.F90 index ccd414fd5f..85bea8281c 100644 --- a/src/physics/rrtmgp/mcica_subcol_gen.F90 +++ b/src/physics/rrtmgp/mcica_subcol_gen.F90 @@ -1,5 +1,14 @@ module mcica_subcol_gen +!---------------------------------------------------------------------------------------- +! +! Purpose: Create McICA stochastic arrays for cloud optical properties. +! Input cloud optical properties directly: cloud optical depth, single +! scattering albedo and asymmetry parameter. Output will be stochastic +! arrays of these variables. (longwave scattering is not yet available) +! +! Original code: From RRTMG, with the following copyright notice, +! based on Raisanen et al., QJRMS, 2004: ! -------------------------------------------------------------------------- ! | | ! | Copyright 2006-2007, Atmospheric & Environmental Research, Inc. (AER). | @@ -9,15 +18,8 @@ module mcica_subcol_gen ! | (http://www.rtweb.aer.com/) | ! | | ! -------------------------------------------------------------------------- - -!---------------------------------------------------------------------------------------- -! -! Purpose: Create McICA stochastic arrays for cloud optical properties. -! Input cloud optical properties directly: cloud optical depth, single -! scattering albedo and asymmetry parameter. Output will be stochastic -! arrays of these variables. (longwave scattering is not yet available) -! -! Original code: From RRTMG based on Raisanen et al., QJRMS, 2004. +! This code is a refactored version of code originally in the files +! mcica_subcol_gen_lw.F90 and mcica_subcol_gen_sw.F90 ! ! Uses the KISS random number generator. ! diff --git a/src/physics/rrtmgp/radconstants.F90 b/src/physics/rrtmgp/radconstants.F90 index 06dccde2b8..f490b81b7b 100644 --- a/src/physics/rrtmgp/radconstants.F90 +++ b/src/physics/rrtmgp/radconstants.F90 @@ -13,8 +13,8 @@ module radconstants ! Number of bands in SW and LW. These values must match data in the RRTMGP coefficients datasets. ! But they are needed to allocate space in the physics buffer and need to be available before the -! RRTMGP datasets are read. So they are set as parameters here and checked in radiation_init after -! the datasets are read. +! RRTMGP datasets are read. So they are set as parameters here and checked in the +! set_wavenumber_bands subroutine after the datasets are read. integer, parameter, public :: nswbands = 14 integer, parameter, public :: nlwbands = 16 diff --git a/src/physics/rrtmgp/radiation.F90 b/src/physics/rrtmgp/radiation.F90 index 099eaeae3c..18488bedb7 100644 --- a/src/physics/rrtmgp/radiation.F90 +++ b/src/physics/rrtmgp/radiation.F90 @@ -56,8 +56,7 @@ module radiation use mo_fluxes_byband, only: ty_fluxes_byband use string_utils, only: to_lower -use cam_abortutils, only: endrun -use error_messages, only: handle_err +use cam_abortutils, only: endrun, handle_allocate_error use cam_logfile, only: iulog @@ -531,7 +530,7 @@ subroutine radiation_init(pbuf2d) if (docosp) call cospsimulator_intr_init() allocate(cosp_cnt(begchunk:endchunk), stat=istat) - call check_allocate(istat, sub, 'cosp_cnt') + call handle_allocate_error(istat, sub, 'cosp_cnt') if (is_first_restart_step()) then cosp_cnt(begchunk:endchunk) = cosp_cnt_init else @@ -989,7 +988,7 @@ subroutine radiation_tend( & write_output = .false. else allocate(rd, stat=istat) - call check_allocate(istat, sub, 'rd') + call handle_allocate_error(istat, sub, 'rd') write_output = .true. end if @@ -1089,7 +1088,7 @@ subroutine radiation_tend( & t_day(nday,nlay), pmid_day(nday,nlay), pint_day(nday,nlay+1), & coszrs_day(nday), alb_dir(nswbands,nday), alb_dif(nswbands,nday), & stat=istat) - call check_allocate(istat, sub, 't_sfc,..,alb_dif') + call handle_allocate_error(istat, sub, 't_sfc,..,alb_dif') ! Prepares state variables, daylit columns, albedos for RRTMGP call rrtmgp_set_state( & @@ -1904,7 +1903,7 @@ subroutine coefs_init(coefs_file, available_gases, kdist) ! names of absorbing gases allocate(gas_names(absorber), stat=istat) - call check_allocate(istat, sub, 'gas_names') + call handle_allocate_error(istat, sub, 'gas_names') ierr = pio_inq_varid(fh, 'gas_names', vid) if (ierr /= PIO_NOERR) call endrun(sub//': gas_names not found') ierr = pio_get_var(fh, vid, gas_names) @@ -1912,7 +1911,7 @@ subroutine coefs_init(coefs_file, available_gases, kdist) ! key species pair for each band allocate(key_species(2,atmos_layer,bnd), stat=istat) - call check_allocate(istat, sub, 'key_species') + call handle_allocate_error(istat, sub, 'key_species') ierr = pio_inq_varid(fh, 'key_species', vid) if (ierr /= PIO_NOERR) call endrun(sub//': key_species not found') ierr = pio_get_var(fh, vid, key_species) @@ -1920,7 +1919,7 @@ subroutine coefs_init(coefs_file, available_gases, kdist) ! beginning and ending gpoint for each band allocate(band2gpt(2,bnd), stat=istat) - call check_allocate(istat, sub, 'band2gpt') + call handle_allocate_error(istat, sub, 'band2gpt') ierr = pio_inq_varid(fh, 'bnd_limits_gpt', vid) if (ierr /= PIO_NOERR) call endrun(sub//': bnd_limits_gpt not found') ierr = pio_get_var(fh, vid, band2gpt) @@ -1928,7 +1927,7 @@ subroutine coefs_init(coefs_file, available_gases, kdist) ! beginning and ending wavenumber for each band allocate(band_lims_wavenum(2,bnd), stat=istat) - call check_allocate(istat, sub, 'band_lims_wavenum') + call handle_allocate_error(istat, sub, 'band_lims_wavenum') ierr = pio_inq_varid(fh, 'bnd_limits_wavenumber', vid) if (ierr /= PIO_NOERR) call endrun(sub//': bnd_limits_wavenumber not found') ierr = pio_get_var(fh, vid, band_lims_wavenum) @@ -1936,7 +1935,7 @@ subroutine coefs_init(coefs_file, available_gases, kdist) ! pressures [hPa] for reference atmosphere; press_ref(# reference layers) allocate(press_ref(pressure), stat=istat) - call check_allocate(istat, sub, 'press_ref') + call handle_allocate_error(istat, sub, 'press_ref') ierr = pio_inq_varid(fh, 'press_ref', vid) if (ierr /= PIO_NOERR) call endrun(sub//': press_ref not found') ierr = pio_get_var(fh, vid, press_ref) @@ -1950,7 +1949,7 @@ subroutine coefs_init(coefs_file, available_gases, kdist) ! temperatures [K] for reference atmosphere; temp_ref(# reference layers) allocate(temp_ref(temperature), stat=istat) - call check_allocate(istat, sub, 'temp_ref') + call handle_allocate_error(istat, sub, 'temp_ref') ierr = pio_inq_varid(fh, 'temp_ref', vid) if (ierr /= PIO_NOERR) call endrun(sub//': temp_ref not found') ierr = pio_get_var(fh, vid, temp_ref) @@ -1970,7 +1969,7 @@ subroutine coefs_init(coefs_file, available_gases, kdist) ! volume mixing ratios for reference atmosphere allocate(vmr_ref(atmos_layer, absorber_ext, temperature), stat=istat) - call check_allocate(istat, sub, 'vmr_ref') + call handle_allocate_error(istat, sub, 'vmr_ref') ierr = pio_inq_varid(fh, 'vmr_ref', vid) if (ierr /= PIO_NOERR) call endrun(sub//': vmr_ref not found') ierr = pio_get_var(fh, vid, vmr_ref) @@ -1978,7 +1977,7 @@ subroutine coefs_init(coefs_file, available_gases, kdist) ! absorption coefficients due to major absorbing gases allocate(kmajor(gpt,mixing_fraction,pressure_interp,temperature), stat=istat) - call check_allocate(istat, sub, 'kmajor') + call handle_allocate_error(istat, sub, 'kmajor') ierr = pio_inq_varid(fh, 'kmajor', vid) if (ierr /= PIO_NOERR) call endrun(sub//': kmajor not found') ierr = pio_get_var(fh, vid, kmajor) @@ -1986,7 +1985,7 @@ subroutine coefs_init(coefs_file, available_gases, kdist) ! absorption coefficients due to minor absorbing gases in lower part of atmosphere allocate(kminor_lower(contributors_lower, mixing_fraction, temperature), stat=istat) - call check_allocate(istat, sub, 'kminor_lower') + call handle_allocate_error(istat, sub, 'kminor_lower') ierr = pio_inq_varid(fh, 'kminor_lower', vid) if (ierr /= PIO_NOERR) call endrun(sub//': kminor_lower not found') ierr = pio_get_var(fh, vid, kminor_lower) @@ -1994,7 +1993,7 @@ subroutine coefs_init(coefs_file, available_gases, kdist) ! absorption coefficients due to minor absorbing gases in upper part of atmosphere allocate(kminor_upper(contributors_upper, mixing_fraction, temperature), stat=istat) - call check_allocate(istat, sub, 'kminor_upper') + call handle_allocate_error(istat, sub, 'kminor_upper') ierr = pio_inq_varid(fh, 'kminor_upper', vid) if (ierr /= PIO_NOERR) call endrun(sub//': kminor_upper not found') ierr = pio_get_var(fh, vid, kminor_upper) @@ -2004,7 +2003,7 @@ subroutine coefs_init(coefs_file, available_gases, kdist) ierr = pio_inq_varid(fh, 'totplnk', vid) if (ierr == PIO_NOERR) then allocate(totplnk(temperature_Planck,bnd), stat=istat) - call check_allocate(istat, sub, 'totplnk') + call handle_allocate_error(istat, sub, 'totplnk') ierr = pio_get_var(fh, vid, totplnk) if (ierr /= PIO_NOERR) call endrun(sub//': error reading totplnk') end if @@ -2013,7 +2012,7 @@ subroutine coefs_init(coefs_file, available_gases, kdist) ierr = pio_inq_varid(fh, 'plank_fraction', vid) if (ierr == PIO_NOERR) then allocate(planck_frac(gpt,mixing_fraction,pressure_interp,temperature), stat=istat) - call check_allocate(istat, sub, 'planck_frac') + call handle_allocate_error(istat, sub, 'planck_frac') ierr = pio_get_var(fh, vid, planck_frac) if (ierr /= PIO_NOERR) call endrun(sub//': error reading plank_fraction') end if @@ -2021,7 +2020,7 @@ subroutine coefs_init(coefs_file, available_gases, kdist) ierr = pio_inq_varid(fh, 'optimal_angle_fit', vid) if (ierr == PIO_NOERR) then allocate(optimal_angle_fit(fit_coeffs, bnd), stat=istat) - call check_allocate(istat, sub, 'optiman_angle_fit') + call handle_allocate_error(istat, sub, 'optiman_angle_fit') ierr = pio_get_var(fh, vid, optimal_angle_fit) if (ierr /= PIO_NOERR) call endrun(sub//': error reading optimal_angle_fit') end if @@ -2029,7 +2028,7 @@ subroutine coefs_init(coefs_file, available_gases, kdist) ierr = pio_inq_varid(fh, 'solar_source_quiet', vid) if (ierr == PIO_NOERR) then allocate(solar_src_quiet(gpt), stat=istat) - call check_allocate(istat, sub, 'solar_src_quiet') + call handle_allocate_error(istat, sub, 'solar_src_quiet') ierr = pio_get_var(fh, vid, solar_src_quiet) if (ierr /= PIO_NOERR) call endrun(sub//': error reading solar_source_quiet') end if @@ -2037,7 +2036,7 @@ subroutine coefs_init(coefs_file, available_gases, kdist) ierr = pio_inq_varid(fh, 'solar_source_facular', vid) if (ierr == PIO_NOERR) then allocate(solar_src_facular(gpt), stat=istat) - call check_allocate(istat, sub, 'solar_src_facular') + call handle_allocate_error(istat, sub, 'solar_src_facular') ierr = pio_get_var(fh, vid, solar_src_facular) if (ierr /= PIO_NOERR) call endrun(sub//': error reading solar_source_facular') end if @@ -2045,7 +2044,7 @@ subroutine coefs_init(coefs_file, available_gases, kdist) ierr = pio_inq_varid(fh, 'solar_source_sunspot', vid) if (ierr == PIO_NOERR) then allocate(solar_src_sunspot(gpt), stat=istat) - call check_allocate(istat, sub, 'solar_src_sunspot') + call handle_allocate_error(istat, sub, 'solar_src_sunspot') ierr = pio_get_var(fh, vid, solar_src_sunspot) if (ierr /= PIO_NOERR) call endrun(sub//': error reading solar_source_sunspot') end if @@ -2072,7 +2071,7 @@ subroutine coefs_init(coefs_file, available_gases, kdist) ierr = pio_inq_varid(fh, 'rayl_lower', vid) if (ierr == PIO_NOERR) then allocate(rayl_lower(gpt,mixing_fraction,temperature), stat=istat) - call check_allocate(istat, sub, 'rayl_lower') + call handle_allocate_error(istat, sub, 'rayl_lower') ierr = pio_get_var(fh, vid, rayl_lower) if (ierr /= PIO_NOERR) call endrun(sub//': error reading rayl_lower') end if @@ -2081,48 +2080,48 @@ subroutine coefs_init(coefs_file, available_gases, kdist) ierr = pio_inq_varid(fh, 'rayl_upper', vid) if (ierr == PIO_NOERR) then allocate(rayl_upper(gpt,mixing_fraction,temperature), stat=istat) - call check_allocate(istat, sub, 'rayl_upper') + call handle_allocate_error(istat, sub, 'rayl_upper') ierr = pio_get_var(fh, vid, rayl_upper) if (ierr /= PIO_NOERR) call endrun(sub//': error reading rayl_upper') end if allocate(gas_minor(minorabsorbers), stat=istat) - call check_allocate(istat, sub, 'gas_minor') + call handle_allocate_error(istat, sub, 'gas_minor') ierr = pio_inq_varid(fh, 'gas_minor', vid) if (ierr /= PIO_NOERR) call endrun(sub//': gas_minor not found') ierr = pio_get_var(fh, vid, gas_minor) if (ierr /= PIO_NOERR) call endrun(sub//': error reading gas_minor') allocate(identifier_minor(minorabsorbers), stat=istat) - call check_allocate(istat, sub, 'identifier_minor') + call handle_allocate_error(istat, sub, 'identifier_minor') ierr = pio_inq_varid(fh, 'identifier_minor', vid) if (ierr /= PIO_NOERR) call endrun(sub//': identifier_minor not found') ierr = pio_get_var(fh, vid, identifier_minor) if (ierr /= PIO_NOERR) call endrun(sub//': error reading identifier_minor') allocate(minor_gases_lower(minor_absorber_intervals_lower), stat=istat) - call check_allocate(istat, sub, 'minor_gases_lower') + call handle_allocate_error(istat, sub, 'minor_gases_lower') ierr = pio_inq_varid(fh, 'minor_gases_lower', vid) if (ierr /= PIO_NOERR) call endrun(sub//': minor_gases_lower not found') ierr = pio_get_var(fh, vid, minor_gases_lower) if (ierr /= PIO_NOERR) call endrun(sub//': error reading minor_gases_lower') allocate(minor_gases_upper(minor_absorber_intervals_upper), stat=istat) - call check_allocate(istat, sub, 'minor_gases_upper') + call handle_allocate_error(istat, sub, 'minor_gases_upper') ierr = pio_inq_varid(fh, 'minor_gases_upper', vid) if (ierr /= PIO_NOERR) call endrun(sub//': minor_gases_upper not found') ierr = pio_get_var(fh, vid, minor_gases_upper) if (ierr /= PIO_NOERR) call endrun(sub//': error reading minor_gases_upper') allocate(minor_limits_gpt_lower(pairs,minor_absorber_intervals_lower), stat=istat) - call check_allocate(istat, sub, 'minor_limits_gpt_lower') + call handle_allocate_error(istat, sub, 'minor_limits_gpt_lower') ierr = pio_inq_varid(fh, 'minor_limits_gpt_lower', vid) if (ierr /= PIO_NOERR) call endrun(sub//': minor_limits_gpt_lower not found') ierr = pio_get_var(fh, vid, minor_limits_gpt_lower) if (ierr /= PIO_NOERR) call endrun(sub//': error reading minor_limits_gpt_lower') allocate(minor_limits_gpt_upper(pairs,minor_absorber_intervals_upper), stat=istat) - call check_allocate(istat, sub, 'minor_limits_gpt_upper') + call handle_allocate_error(istat, sub, 'minor_limits_gpt_upper') ierr = pio_inq_varid(fh, 'minor_limits_gpt_upper', vid) if (ierr /= PIO_NOERR) call endrun(sub//': minor_limits_gpt_upper not found') ierr = pio_get_var(fh, vid, minor_limits_gpt_upper) @@ -2130,10 +2129,10 @@ subroutine coefs_init(coefs_file, available_gases, kdist) ! Read as integer and convert to logical allocate(int2log(minor_absorber_intervals_lower), stat=istat) - call check_allocate(istat, sub, 'int2log for lower') + call handle_allocate_error(istat, sub, 'int2log for lower') allocate(minor_scales_with_density_lower(minor_absorber_intervals_lower), stat=istat) - call check_allocate(istat, sub, 'minor_scales_with_density_lower') + call handle_allocate_error(istat, sub, 'minor_scales_with_density_lower') ierr = pio_inq_varid(fh, 'minor_scales_with_density_lower', vid) if (ierr /= PIO_NOERR) call endrun(sub//': minor_scales_with_density_lower not found') ierr = pio_get_var(fh, vid, int2log) @@ -2147,7 +2146,7 @@ subroutine coefs_init(coefs_file, available_gases, kdist) end do allocate(scale_by_complement_lower(minor_absorber_intervals_lower), stat=istat) - call check_allocate(istat, sub, 'scale_by_complement_lower') + call handle_allocate_error(istat, sub, 'scale_by_complement_lower') ierr = pio_inq_varid(fh, 'scale_by_complement_lower', vid) if (ierr /= PIO_NOERR) call endrun(sub//': scale_by_complement_lower not found') ierr = pio_get_var(fh, vid, int2log) @@ -2164,10 +2163,10 @@ subroutine coefs_init(coefs_file, available_gases, kdist) ! Read as integer and convert to logical allocate(int2log(minor_absorber_intervals_upper), stat=istat) - call check_allocate(istat, sub, 'int2log for upper') + call handle_allocate_error(istat, sub, 'int2log for upper') allocate(minor_scales_with_density_upper(minor_absorber_intervals_upper), stat=istat) - call check_allocate(istat, sub, 'minor_scales_with_density_upper') + call handle_allocate_error(istat, sub, 'minor_scales_with_density_upper') ierr = pio_inq_varid(fh, 'minor_scales_with_density_upper', vid) if (ierr /= PIO_NOERR) call endrun(sub//': minor_scales_with_density_upper not found') ierr = pio_get_var(fh, vid, int2log) @@ -2181,7 +2180,7 @@ subroutine coefs_init(coefs_file, available_gases, kdist) end do allocate(scale_by_complement_upper(minor_absorber_intervals_upper), stat=istat) - call check_allocate(istat, sub, 'scale_by_complement_upper') + call handle_allocate_error(istat, sub, 'scale_by_complement_upper') ierr = pio_inq_varid(fh, 'scale_by_complement_upper', vid) if (ierr /= PIO_NOERR) call endrun(sub//': scale_by_complement_upper not found') ierr = pio_get_var(fh, vid, int2log) @@ -2197,28 +2196,28 @@ subroutine coefs_init(coefs_file, available_gases, kdist) deallocate(int2log) allocate(scaling_gas_lower(minor_absorber_intervals_lower), stat=istat) - call check_allocate(istat, sub, 'scaling_gas_lower') + call handle_allocate_error(istat, sub, 'scaling_gas_lower') ierr = pio_inq_varid(fh, 'scaling_gas_lower', vid) if (ierr /= PIO_NOERR) call endrun(sub//': scaling_gas_lower not found') ierr = pio_get_var(fh, vid, scaling_gas_lower) if (ierr /= PIO_NOERR) call endrun(sub//': error reading scaling_gas_lower') allocate(scaling_gas_upper(minor_absorber_intervals_upper), stat=istat) - call check_allocate(istat, sub, 'scaling_gas_upper') + call handle_allocate_error(istat, sub, 'scaling_gas_upper') ierr = pio_inq_varid(fh, 'scaling_gas_upper', vid) if (ierr /= PIO_NOERR) call endrun(sub//': scaling_gas_upper not found') ierr = pio_get_var(fh, vid, scaling_gas_upper) if (ierr /= PIO_NOERR) call endrun(sub//': error reading scaling_gas_upper') allocate(kminor_start_lower(minor_absorber_intervals_lower), stat=istat) - call check_allocate(istat, sub, 'kminor_start_lower') + call handle_allocate_error(istat, sub, 'kminor_start_lower') ierr = pio_inq_varid(fh, 'kminor_start_lower', vid) if (ierr /= PIO_NOERR) call endrun(sub//': kminor_start_lower not found') ierr = pio_get_var(fh, vid, kminor_start_lower) if (ierr /= PIO_NOERR) call endrun(sub//': error reading kminor_start_lower') allocate(kminor_start_upper(minor_absorber_intervals_upper), stat=istat) - call check_allocate(istat, sub, 'kminor_start_upper') + call handle_allocate_error(istat, sub, 'kminor_start_upper') ierr = pio_inq_varid(fh, 'kminor_start_upper', vid) if (ierr /= PIO_NOERR) call endrun(sub//': kminor_start_upper not found') ierr = pio_get_var(fh, vid, kminor_start_upper) @@ -2325,14 +2324,14 @@ subroutine initialize_rrtmgp_fluxes(ncol, nlevels, nbands, fluxes, do_direct) ! Broadband fluxes allocate(fluxes%flux_up(ncol, nlevels), stat=istat) - call check_allocate(istat, sub, 'fluxes%flux_up') + call handle_allocate_error(istat, sub, 'fluxes%flux_up') allocate(fluxes%flux_dn(ncol, nlevels), stat=istat) - call check_allocate(istat, sub, 'fluxes%flux_dn') + call handle_allocate_error(istat, sub, 'fluxes%flux_dn') allocate(fluxes%flux_net(ncol, nlevels), stat=istat) - call check_allocate(istat, sub, 'fluxes%flux_net') + call handle_allocate_error(istat, sub, 'fluxes%flux_net') if (do_direct_local) then allocate(fluxes%flux_dn_dir(ncol, nlevels), stat=istat) - call check_allocate(istat, sub, 'fluxes%flux_dn_dir') + call handle_allocate_error(istat, sub, 'fluxes%flux_dn_dir') end if select type (fluxes) @@ -2341,14 +2340,14 @@ subroutine initialize_rrtmgp_fluxes(ncol, nlevels, nbands, fluxes, do_direct) ! when spectralflux is true. if (nbands == nswbands .or. spectralflux) then allocate(fluxes%bnd_flux_up(ncol, nlevels, nbands), stat=istat) - call check_allocate(istat, sub, 'fluxes%bnd_flux_up') + call handle_allocate_error(istat, sub, 'fluxes%bnd_flux_up') allocate(fluxes%bnd_flux_dn(ncol, nlevels, nbands), stat=istat) - call check_allocate(istat, sub, 'fluxes%bnd_flux_dn') + call handle_allocate_error(istat, sub, 'fluxes%bnd_flux_dn') allocate(fluxes%bnd_flux_net(ncol, nlevels, nbands), stat=istat) - call check_allocate(istat, sub, 'fluxes%bnd_flux_net') + call handle_allocate_error(istat, sub, 'fluxes%bnd_flux_net') if (do_direct_local) then allocate(fluxes%bnd_flux_dn_dir(ncol, nlevels, nbands), stat=istat) - call check_allocate(istat, sub, 'fluxes%bnd_flux_dn_dir') + call handle_allocate_error(istat, sub, 'fluxes%bnd_flux_dn_dir') end if end if end select @@ -2488,21 +2487,5 @@ end subroutine stop_on_err !========================================================================================= -subroutine check_allocate(istat, sub, info) - - ! call endrun if allocate returns non-zero status - - integer, intent(in) :: istat ! return status from allocate - character(len=*), intent(in) :: sub ! name of calling subroutine - character(len=*), intent(in) :: info ! identify which call failed - - if (istat /= 0) then - call endrun(trim(sub)//': ERROR allocating: '//trim(info)) - end if - -end subroutine check_allocate - -!========================================================================================= - end module radiation From ea9aaa2d82868bccaa7e1efe775ebad6816276db Mon Sep 17 00:00:00 2001 From: Cheryl Craig Date: Mon, 19 Feb 2024 09:55:13 -0700 Subject: [PATCH 240/291] Update cime tag --- Externals.cfg | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Externals.cfg b/Externals.cfg index 1e76a9582d..259561d182 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -64,7 +64,7 @@ local_path = libraries/parallelio required = True [cime] -tag = cime6.0.209_httpsbranch01 +tag = cime6.0.217_httpsbranch01 protocol = git repo_url = https://github.com/ESMCI/cime local_path = cime From 43f4b095283f0d64645f350febe9897bfe8c8bc5 Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Mon, 19 Feb 2024 10:43:16 -0700 Subject: [PATCH 241/291] stat check --- src/dynamics/se/dycore/fvm_mapping.F90 | 22 ++++++++++++++++++---- 1 file changed, 18 insertions(+), 4 deletions(-) diff --git a/src/dynamics/se/dycore/fvm_mapping.F90 b/src/dynamics/se/dycore/fvm_mapping.F90 index fd343474ad..e69fe9a188 100644 --- a/src/dynamics/se/dycore/fvm_mapping.F90 +++ b/src/dynamics/se/dycore/fvm_mapping.F90 @@ -19,6 +19,7 @@ module fvm_mapping use element_mod, only: element_t use fvm_control_volume_mod, only: fvm_struct use perf_mod, only: t_startf, t_stopf + use cam_abortutils, only: endrun implicit none private @@ -48,7 +49,6 @@ subroutine phys2dyn_forcings_fvm(elem, fvm, hybrid,nets,nete,no_cslam, tl_f, tl_ use dimensions_mod, only: np, nc,nlev use dimensions_mod, only: fv_nphys, nhc_phys,ntrac,nhc,ksponge_end, nu_scale_top use hybrid_mod, only: hybrid_t - use cam_abortutils, only: endrun use air_composition, only: thermodynamic_active_species_num, thermodynamic_active_species_idx type (element_t), intent(inout):: elem(:) type(fvm_struct), intent(inout):: fvm(:) @@ -66,6 +66,8 @@ subroutine phys2dyn_forcings_fvm(elem, fvm, hybrid,nets,nete,no_cslam, tl_f, tl_ integer :: nflds logical, allocatable :: llimiter(:) + integer :: ierr=0 + if (no_cslam) then call endrun("phys2dyn_forcings_fvm: no cslam case: NOT SUPPORTED") else if (nc.ne.fv_nphys) then @@ -78,9 +80,21 @@ subroutine phys2dyn_forcings_fvm(elem, fvm, hybrid,nets,nete,no_cslam, tl_f, tl_ ! call t_startf('p2d-pg2:copying') nflds = 4+ntrac - allocate(fld_phys(1-nhc_phys:fv_nphys+nhc_phys,1-nhc_phys:fv_nphys+nhc_phys,nlev,nflds,nets:nete)) - allocate(fld_gll(np,np,nlev,3,nets:nete)) - allocate(llimiter(nflds)) + allocate(fld_phys(1-nhc_phys:fv_nphys+nhc_phys,1-nhc_phys:fv_nphys+nhc_phys,nlev,nflds,nets:nete), stat=ierr) + if( ierr /= 0 ) then + write(iulog,*) 'phys2dyn_forcings_fvm: fld_phys allocation error = ',ierr + call endrun('phys2dyn_forcings_fvm: failed to allocate fld_phys array') + end if + allocate(fld_gll(np,np,nlev,3,nets:nete), stat=ierr) + if( ierr /= 0 ) then + write(iulog,*) 'phys2dyn_forcings_fvm: fld_gll allocation error = ',ierr + call endrun('phys2dyn_forcings_fvm: failed to allocate fld_gll array') + end if + allocate(llimiter(nflds), stat=ierr) + if( ierr /= 0 ) then + write(iulog,*) 'phys2dyn_forcings_fvm: llimiter allocation error = ',ierr + call endrun('phys2dyn_forcings_fvm: failed to allocate llimiter array') + end if fld_phys = -9.99E99_r8!xxx necessary? llimiter = .false. From bf7635adc8f1b7a6b67b53952bc7cc10360fcc5e Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Mon, 19 Feb 2024 10:45:47 -0700 Subject: [PATCH 242/291] Update src/dynamics/se/dycore/fvm_mapping.F90 Co-authored-by: Jesse Nusbaumer --- src/dynamics/se/dycore/fvm_mapping.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/dynamics/se/dycore/fvm_mapping.F90 b/src/dynamics/se/dycore/fvm_mapping.F90 index e69fe9a188..d5299fede3 100644 --- a/src/dynamics/se/dycore/fvm_mapping.F90 +++ b/src/dynamics/se/dycore/fvm_mapping.F90 @@ -1355,7 +1355,7 @@ subroutine cslam2gll(elem, fvm, hybrid,nets,nete, tl_f, tl_qdp) elem(ie)%state%dp3d(:,:,:,tl_f) end do end do - deallocate(fld_fvm,llimiter) + deallocate(fld_fvm, fld_gll, llimiter) call t_stopf('cslam2gll') end subroutine cslam2gll end module fvm_mapping From 5338d363498c6ec9fd85bd0412cbd672e04eac9e Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Mon, 19 Feb 2024 10:58:38 -0700 Subject: [PATCH 243/291] change comment --- src/dynamics/se/dycore/global_norms_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/dynamics/se/dycore/global_norms_mod.F90 b/src/dynamics/se/dycore/global_norms_mod.F90 index 6db3ca7255..daf616c449 100644 --- a/src/dynamics/se/dycore/global_norms_mod.F90 +++ b/src/dynamics/se/dycore/global_norms_mod.F90 @@ -600,7 +600,7 @@ subroutine print_cfl(elem,hybrid,nets,nete,dtnu,ptop,pmid,& lev_set = sponge_del4_lev < 0 if (ptop>1000.0_r8) then ! - ! low top (~10 Pa) + ! low top; usually idealized test cases ! top_000_032km = .true. else if (ptop>100.0_r8) then From 44703192846364336590b3d9548697d6c4bec947 Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Mon, 19 Feb 2024 11:04:23 -0700 Subject: [PATCH 244/291] minor mod --- src/dynamics/se/dyn_comp.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/dynamics/se/dyn_comp.F90 b/src/dynamics/se/dyn_comp.F90 index 6f8eb5477a..d11c6dd144 100644 --- a/src/dynamics/se/dyn_comp.F90 +++ b/src/dynamics/se/dyn_comp.F90 @@ -472,7 +472,7 @@ subroutine dyn_readnl(NLFileName) end if end if - if (fv_nphys > 0) then + if (use_cslam) then write(iulog, '(a)') 'dyn_readnl: physics will run on FVM points; advection by CSLAM' write(iulog,'(a,i0)') 'dyn_readnl: se_fv_nphys = ', fv_nphys else @@ -1847,7 +1847,7 @@ subroutine set_phis(dyn_in) allocate(phis_tmp(npsq,nelemd)) phis_tmp = 0.0_r8 - if (fv_nphys > 0) then + if (use_cslam) then allocate(phis_phys_tmp(fv_nphys**2,nelemd)) phis_phys_tmp = 0.0_r8 do ie=1,nelemd @@ -1872,7 +1872,7 @@ subroutine set_phis(dyn_in) ! Set name of grid object which will be used to read data from file ! into internal data structure via PIO. - if (fv_nphys == 0) then + if (.not.use_cslam) then grid_name = 'GLL' else grid_name = 'physgrid_d' @@ -1898,7 +1898,7 @@ subroutine set_phis(dyn_in) fieldname = 'PHIS' fieldname_gll = 'PHIS_gll' - if (fv_nphys>0.and.dyn_field_exists(fh_topo, trim(fieldname_gll),required=.false.)) then + if (use_cslam.and.dyn_field_exists(fh_topo, trim(fieldname_gll),required=.false.)) then ! ! If physgrid it is recommended to read in PHIS on the GLL grid and then ! map to the physgrid in d_p_coupling @@ -1910,7 +1910,7 @@ subroutine set_phis(dyn_in) end if call read_dyn_var(fieldname_gll, fh_topo, 'ncol_gll', phis_tmp) else if (dyn_field_exists(fh_topo, trim(fieldname))) then - if (fv_nphys == 0) then + if (.not.use_cslam) then if (masterproc) then write(iulog, *) "Reading in PHIS" end if From 379f23fa9ddf5d115d2aadb37450567f62e09d1f Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Mon, 19 Feb 2024 11:06:06 -0700 Subject: [PATCH 245/291] fix compiltation error --- src/dynamics/se/dycore/fvm_mapping.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/src/dynamics/se/dycore/fvm_mapping.F90 b/src/dynamics/se/dycore/fvm_mapping.F90 index d5299fede3..6af6c9f349 100644 --- a/src/dynamics/se/dycore/fvm_mapping.F90 +++ b/src/dynamics/se/dycore/fvm_mapping.F90 @@ -50,6 +50,7 @@ subroutine phys2dyn_forcings_fvm(elem, fvm, hybrid,nets,nete,no_cslam, tl_f, tl_ use dimensions_mod, only: fv_nphys, nhc_phys,ntrac,nhc,ksponge_end, nu_scale_top use hybrid_mod, only: hybrid_t use air_composition, only: thermodynamic_active_species_num, thermodynamic_active_species_idx + use cam_abortutils, only: endrun type (element_t), intent(inout):: elem(:) type(fvm_struct), intent(inout):: fvm(:) From 96e163ce63838d7dd1e077f53252e3233c5248fc Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Mon, 19 Feb 2024 11:07:20 -0700 Subject: [PATCH 246/291] minor mod --- src/dynamics/se/dyn_grid.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/dynamics/se/dyn_grid.F90 b/src/dynamics/se/dyn_grid.F90 index b808ee587d..aa3ec8027a 100644 --- a/src/dynamics/se/dyn_grid.F90 +++ b/src/dynamics/se/dyn_grid.F90 @@ -177,7 +177,7 @@ subroutine dyn_grid_init() if (iam < par%nprocs) then call prim_init1(elem, fvm, par, TimeLevel) - if (fv_nphys > 0) then + if (use_cslam) then call dp_init(elem, fvm) end if From 597177a6d704324e7111e4a0ec952e637413d49a Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Mon, 19 Feb 2024 11:09:02 -0700 Subject: [PATCH 247/291] Update src/physics/cam/vertical_diffusion.F90 Co-authored-by: Jesse Nusbaumer --- src/physics/cam/vertical_diffusion.F90 | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/src/physics/cam/vertical_diffusion.F90 b/src/physics/cam/vertical_diffusion.F90 index 7bdaf9eb23..f2b19bdf31 100644 --- a/src/physics/cam/vertical_diffusion.F90 +++ b/src/physics/cam/vertical_diffusion.F90 @@ -307,21 +307,21 @@ subroutine vertical_diffusion_init(pbuf2d) ! CAM7 FMT ! write(iulog,*)'Artificial sponge layer vertical diffusion added:' - write(iulog,*)'vertical diffusion coefficient at interface 1 is increased by 2.0E6 m^2/s2' - write(iulog,*)'vertical diffusion coefficient at interface 2 is increased by 2.0E6 m^2/s2' - write(iulog,*)'vertical diffusion coefficient at interface 3 is increased by 0.5E6 m^2/s2' - write(iulog,*)'vertical diffusion coefficient at interface 4 is increased by 0.1E6 m^2/s2' + write(iulog,*)'vertical diffusion coefficient at interface 1 is increased by 2.0E6 m2 s-2' + write(iulog,*)'vertical diffusion coefficient at interface 2 is increased by 2.0E6 m2 s-2' + write(iulog,*)'vertical diffusion coefficient at interface 3 is increased by 0.5E6 m2 s-2' + write(iulog,*)'vertical diffusion coefficient at interface 4 is increased by 0.1E6 m2 s-2' else if (ptop_ref>1e-4_r8) then ! ! WACCM and WACCM-x ! write(iulog,*)'Artificial sponge layer vertical diffusion added:' - write(iulog,*)'vertical diffusion coefficient at interface 1 is increased by 2.0E6 m^2/s2' - write(iulog,*)'vertical diffusion coefficient at interface 2 is increased by 2.0E6 m^2/s2' - write(iulog,*)'vertical diffusion coefficient at interface 3 is increased by 1.5E6 m^2/s2' - write(iulog,*)'vertical diffusion coefficient at interface 4 is increased by 1.0E6 m^2/s2' - write(iulog,*)'vertical diffusion coefficient at interface 5 is increased by 0.5E6 m^2/s2' - write(iulog,*)'vertical diffusion coefficient at interface 6 is increased by 0.1E6 m^2/s2' + write(iulog,*)'vertical diffusion coefficient at interface 1 is increased by 2.0E6 m2 s-2' + write(iulog,*)'vertical diffusion coefficient at interface 2 is increased by 2.0E6 m2 s-2' + write(iulog,*)'vertical diffusion coefficient at interface 3 is increased by 1.5E6 m2 s-2' + write(iulog,*)'vertical diffusion coefficient at interface 4 is increased by 1.0E6 m2 s-2' + write(iulog,*)'vertical diffusion coefficient at interface 5 is increased by 0.5E6 m2 s-2' + write(iulog,*)'vertical diffusion coefficient at interface 6 is increased by 0.1E6 m2 s-2' end if end if From 84db8635860c9f2aebbde827d8ab086e62be060b Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Mon, 19 Feb 2024 11:12:16 -0700 Subject: [PATCH 248/291] minor clean-up --- src/dynamics/se/dyn_comp.F90 | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/src/dynamics/se/dyn_comp.F90 b/src/dynamics/se/dyn_comp.F90 index d11c6dd144..d70d8539a4 100644 --- a/src/dynamics/se/dyn_comp.F90 +++ b/src/dynamics/se/dyn_comp.F90 @@ -1927,7 +1927,8 @@ subroutine set_phis(dyn_in) end if call read_phys_field_2d(fieldname, fh_topo, 'ncol', phis_phys_tmp) call map_phis_from_physgrid_to_gll(dyn_in%fvm, elem, phis_phys_tmp, & - phis_tmp, pmask) + phis_tmp, pmask) + deallocate(phis_phys_tmp) end if else call endrun(sub//': Could not find PHIS field on input datafile') @@ -1975,9 +1976,6 @@ subroutine set_phis(dyn_in) end do end do deallocate(phis_tmp) - if (allocated(phis_phys_tmp)) then - deallocate(phis_phys_tmp) - end if ! boundary exchange to update the redundent columns in the element objects do ie = 1, nelemd From 15826b3809d4195544f808549168eedaf008d663 Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Mon, 19 Feb 2024 11:14:00 -0700 Subject: [PATCH 249/291] Update src/dynamics/se/dycore/fvm_mapping.F90 Co-authored-by: Francis Vitt --- src/dynamics/se/dycore/fvm_mapping.F90 | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/src/dynamics/se/dycore/fvm_mapping.F90 b/src/dynamics/se/dycore/fvm_mapping.F90 index 6af6c9f349..83f1d477b5 100644 --- a/src/dynamics/se/dycore/fvm_mapping.F90 +++ b/src/dynamics/se/dycore/fvm_mapping.F90 @@ -210,11 +210,9 @@ subroutine fvm2dyntn(fld_fvm,fld_gll,hybrid,nets,nete,numlev,num_flds,fvm,llimit ! !********************************************* ! - fill_halo = .false. + fill_halo = .true. if (present(halo_filled)) then - if (.not.halo_filled) fill_halo = .true. - else - fill_halo = .true. + fill_halo = .not. halo_filled end if if (fill_halo) then From fdac7d4185a31f2d934b8d7fe85fd933a7a2b349 Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Mon, 19 Feb 2024 11:14:12 -0700 Subject: [PATCH 250/291] Update src/dynamics/se/dycore/fvm_mapping.F90 Co-authored-by: Francis Vitt --- src/dynamics/se/dycore/fvm_mapping.F90 | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/src/dynamics/se/dycore/fvm_mapping.F90 b/src/dynamics/se/dycore/fvm_mapping.F90 index 83f1d477b5..ba14492644 100644 --- a/src/dynamics/se/dycore/fvm_mapping.F90 +++ b/src/dynamics/se/dycore/fvm_mapping.F90 @@ -260,11 +260,9 @@ subroutine fvm2dynt1(fld_fvm,fld_gll,hybrid,nets,nete,numlev,fvm,llimiter,halo_f ! !********************************************* ! - fill_halo = .false. + fill_halo = .true. if (present(halo_filled)) then - if (.not.halo_filled) fill_halo = .true. - else - fill_halo = .true. + fill_halo = .not. halo_filled end if if (fill_halo) then From adb4a83b25d1e2439a71b21d9de26b4e4cc567ad Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Mon, 19 Feb 2024 11:16:06 -0700 Subject: [PATCH 251/291] add comment --- src/dynamics/se/dycore/fvm_mapping.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/dynamics/se/dycore/fvm_mapping.F90 b/src/dynamics/se/dycore/fvm_mapping.F90 index ba14492644..489234dfb0 100644 --- a/src/dynamics/se/dycore/fvm_mapping.F90 +++ b/src/dynamics/se/dycore/fvm_mapping.F90 @@ -199,7 +199,7 @@ subroutine fvm2dyntn(fld_fvm,fld_gll,hybrid,nets,nete,numlev,num_flds,fvm,llimit type (hybrid_t) , intent(in) :: hybrid type(fvm_struct) , intent(in) :: fvm(nets:nete) logical , intent(in) :: llimiter(num_flds) - logical, optional , intent(in) :: halo_filled + logical, optional , intent(in) :: halo_filled !optional if boundary exchange for fld_fvm has already been called integer :: ie, iwidth logical :: fill_halo From ff0e805b899a3a85ad64a72b1e1b35d866110f15 Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Mon, 19 Feb 2024 11:18:06 -0700 Subject: [PATCH 252/291] add comment --- src/dynamics/se/dycore/fvm_mapping.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/dynamics/se/dycore/fvm_mapping.F90 b/src/dynamics/se/dycore/fvm_mapping.F90 index 489234dfb0..c0268064b6 100644 --- a/src/dynamics/se/dycore/fvm_mapping.F90 +++ b/src/dynamics/se/dycore/fvm_mapping.F90 @@ -249,7 +249,7 @@ subroutine fvm2dynt1(fld_fvm,fld_gll,hybrid,nets,nete,numlev,fvm,llimiter,halo_f type (hybrid_t) , intent(in) :: hybrid type(fvm_struct) , intent(in) :: fvm(nets:nete) logical , intent(in) :: llimiter(1) - logical, optional , intent(in) :: halo_filled + logical, optional , intent(in) :: halo_filled!optional if boundary exchange for fld_fvm has already been called integer :: ie, iwidth logical :: fill_halo @@ -332,7 +332,7 @@ subroutine phys2dyn(hybrid,elem,fld_phys,fld_gll,nets,nete,num_lev,num_flds,fvm, type(fvm_struct) , intent(in) :: fvm(:) integer, optional , intent(in) :: istart_vector logical , intent(in) :: llimiter(num_flds) - logical, optional , intent(in) :: halo_filled + logical, optional , intent(in) :: halo_filled!optional if boundary exchange for fld_fvm has already been called integer :: i, j, ie, k, iwidth real (kind=r8) :: v1,v2 From 5fa87c20fc7cb9aaea0f128b0869c3426311e7e6 Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Mon, 19 Feb 2024 11:19:33 -0700 Subject: [PATCH 253/291] Update src/dynamics/se/dp_coupling.F90 Co-authored-by: Francis Vitt --- src/dynamics/se/dp_coupling.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/dynamics/se/dp_coupling.F90 b/src/dynamics/se/dp_coupling.F90 index 1fdd52a0e4..ed465b8956 100644 --- a/src/dynamics/se/dp_coupling.F90 +++ b/src/dynamics/se/dp_coupling.F90 @@ -481,7 +481,7 @@ subroutine p_d_coupling(phys_state, phys_tend, dyn_in, tl_f, tl_qdp) call edgeVpack(edgebuf, dyn_in%elem(ie)%derived%FM(:,:,:,:), 2*nlev, kptr, ie) kptr = kptr + 2*nlev call edgeVpack(edgebuf, dyn_in%elem(ie)%derived%FT(:,:,:), nlev, kptr, ie) - if (fv_nphys < 1) then + if (.not. use_cslam) then ! ! if using CSLAM qdp is being overwritten with CSLAM values in the dynamics ! so no need to do boundary exchange of tracer tendency on GLL grid here From eeae0a7ac896f82e924564d093cbb0eaca48dd86 Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Mon, 19 Feb 2024 11:20:09 -0700 Subject: [PATCH 254/291] Update src/dynamics/se/dp_coupling.F90 Co-authored-by: Francis Vitt --- src/dynamics/se/dp_coupling.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/dynamics/se/dp_coupling.F90 b/src/dynamics/se/dp_coupling.F90 index ed465b8956..66ccb47b94 100644 --- a/src/dynamics/se/dp_coupling.F90 +++ b/src/dynamics/se/dp_coupling.F90 @@ -501,7 +501,7 @@ subroutine p_d_coupling(phys_state, phys_tend, dyn_in, tl_f, tl_qdp) kptr = kptr + 2*nlev call edgeVunpack(edgebuf, dyn_in%elem(ie)%derived%FT(:,:,:), nlev, kptr, ie) kptr = kptr + nlev - if (fv_nphys < 1) then + if (.not. use_cslam) then call edgeVunpack(edgebuf, dyn_in%elem(ie)%derived%FQ(:,:,:,:), nlev*qsize, kptr, ie) end if if (fv_nphys > 0) then From b91b56934b221f9ad1f3d8eacbe25aaded5f4830 Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Mon, 19 Feb 2024 11:20:59 -0700 Subject: [PATCH 255/291] Update src/dynamics/se/dycore/fvm_mapping.F90 Co-authored-by: Francis Vitt --- src/dynamics/se/dycore/fvm_mapping.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/dynamics/se/dycore/fvm_mapping.F90 b/src/dynamics/se/dycore/fvm_mapping.F90 index c0268064b6..30097ad248 100644 --- a/src/dynamics/se/dycore/fvm_mapping.F90 +++ b/src/dynamics/se/dycore/fvm_mapping.F90 @@ -119,7 +119,8 @@ subroutine phys2dyn_forcings_fvm(elem, fvm, hybrid,nets,nete,no_cslam, tl_f, tl_ ! ! do mapping of fu,fv,ft ! - call phys2dyn(hybrid,elem,fld_phys(:,:,:,1:3,:),fld_gll(:,:,:,:,:),nets,nete,nlev,3,fvm,llimiter(1:),2,.true.) + call phys2dyn(hybrid,elem,fld_phys(:,:,:,1:3,:),fld_gll,nets,nete,nlev,3,fvm,llimiter, & + istart_vector=2,halo_filled=.true.) do ie=nets,nete elem(ie)%derived%fT(:,:,:) = fld_gll(:,:,:,1,ie) elem(ie)%derived%fM(:,:,1,:) = fld_gll(:,:,:,2,ie) From be0597fb9cb25989b4304457245205d068a03ca8 Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Mon, 19 Feb 2024 11:23:43 -0700 Subject: [PATCH 256/291] add description --- src/dynamics/se/dycore/fvm_mapping.F90 | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/dynamics/se/dycore/fvm_mapping.F90 b/src/dynamics/se/dycore/fvm_mapping.F90 index 30097ad248..abebc910ba 100644 --- a/src/dynamics/se/dycore/fvm_mapping.F90 +++ b/src/dynamics/se/dycore/fvm_mapping.F90 @@ -1295,7 +1295,10 @@ subroutine get_q_overlap_save(ie,k,fvm,q_fvm,num_trac,q_phys) save_q_phys(:,:,k,m_cnst,ie) = q_phys(:,:,m_cnst) end do end subroutine get_q_overlap_save - + ! + ! Routine to overwrite thermodynamic active tracers on the GLL grid with CSLAM values + ! by Lagrange interpolation from 3x3 CSLAM grid to GLL grid. + ! subroutine cslam2gll(elem, fvm, hybrid,nets,nete, tl_f, tl_qdp) use dimensions_mod, only: nc,nlev,np,nhc use hybrid_mod, only: hybrid_t From bb4ba338824ae681e2634b19718b85e4653b238e Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Mon, 19 Feb 2024 11:27:47 -0700 Subject: [PATCH 257/291] simplify code --- src/dynamics/se/dycore/global_norms_mod.F90 | 42 +++++++-------------- 1 file changed, 14 insertions(+), 28 deletions(-) diff --git a/src/dynamics/se/dycore/global_norms_mod.F90 b/src/dynamics/se/dycore/global_norms_mod.F90 index daf616c449..1b052e60af 100644 --- a/src/dynamics/se/dycore/global_norms_mod.F90 +++ b/src/dynamics/se/dycore/global_norms_mod.F90 @@ -634,39 +634,25 @@ subroutine print_cfl(elem,hybrid,nets,nete,dtnu,ptop,pmid,& ! ! if user or namelist is not specifying sponge del4 settings here are best guesses (empirically determined) ! - umax = 0.0_r8 - if (top_000_032km) then - umax = 120._r8 - if (sponge_del4_lev <0) sponge_del4_lev = 1 - if (sponge_del4_nu_fac <0) sponge_del4_nu_fac = 1.0_r8 - if (sponge_del4_nu_div_fac<0) sponge_del4_nu_div_fac = 1.0_r8 - end if - - if (top_032_042km) then - umax = 120._r8 - if (sponge_del4_lev <0) sponge_del4_lev = 1 - if (sponge_del4_nu_fac <0) sponge_del4_nu_fac = 1.0_r8 - if (sponge_del4_nu_div_fac<0) sponge_del4_nu_div_fac = 1.0_r8 - end if - - if (top_042_090km) then - umax = 240._r8 - if (sponge_del4_lev <0) sponge_del4_lev = 1 - if (sponge_del4_nu_fac <0) sponge_del4_nu_fac = 1.0_r8 - if (sponge_del4_nu_div_fac<0) sponge_del4_nu_div_fac = 1.0_r8 - end if + if (sponge_del4_lev <0) sponge_del4_lev = 1 + if (sponge_del4_nu_fac <0) sponge_del4_nu_fac = 1.0_r8 + if (sponge_del4_nu_div_fac<0) sponge_del4_nu_div_fac = 1.0_r8 - if (top_090_140km) then - umax = 300._r8 - end if - if (top_140_600km) then - umax = 800._r8 - end if - if (top_090_140km.or.top_140_600km) then + if (top_090_140km.or.top_140_600km) then ! defaults for waccm(x) if (sponge_del4_lev <0) sponge_del4_lev = 20 if (sponge_del4_nu_fac <0) sponge_del4_nu_fac = 5.0_r8 if (sponge_del4_nu_div_fac<0) sponge_del4_nu_div_fac = 10.0_r8 end if + + ! set max wind speed for diagnostics + umax = 120.0_r8 + if (top_042_090km) then + umax = 240._r8 + else if (top_090_140km) then + umax = 300._r8 + else if (top_140_600km) then + umax = 800._r8 + end if ! ! Log sponge layer configuration ! From e32a843446ed92f0808d512b1a7afa807fc0cef1 Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Mon, 19 Feb 2024 11:29:14 -0700 Subject: [PATCH 258/291] fix --- src/dynamics/se/dycore/fvm_mapping.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/dynamics/se/dycore/fvm_mapping.F90 b/src/dynamics/se/dycore/fvm_mapping.F90 index abebc910ba..45c1edcd3d 100644 --- a/src/dynamics/se/dycore/fvm_mapping.F90 +++ b/src/dynamics/se/dycore/fvm_mapping.F90 @@ -18,9 +18,9 @@ module fvm_mapping use dimensions_mod, only: irecons_tracer use element_mod, only: element_t use fvm_control_volume_mod, only: fvm_struct - use perf_mod, only: t_startf, t_stopf + use perf_mod, only: t_startf, t_stopf use cam_abortutils, only: endrun - + use cam_logfile, only: iulog implicit none private From 4f1f577ca83f452ae21b325d74226657decfbbc9 Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Mon, 19 Feb 2024 11:30:44 -0700 Subject: [PATCH 259/291] fix indentation --- src/dynamics/se/dycore/prim_driver_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/dynamics/se/dycore/prim_driver_mod.F90 b/src/dynamics/se/dycore/prim_driver_mod.F90 index ad6ca121df..9169d0f435 100644 --- a/src/dynamics/se/dycore/prim_driver_mod.F90 +++ b/src/dynamics/se/dycore/prim_driver_mod.F90 @@ -565,7 +565,7 @@ subroutine prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord, rstep, last_s !$OMP END PARALLEL call omp_set_nested(.false.) call t_stopf('prim_advec_tracers_remap') - else + else ! ! only run fvm transport every fvm_supercycling rstep ! From 1ba50bbac4db752d6477d72d70dff8eeeb656ce9 Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Mon, 19 Feb 2024 11:34:49 -0700 Subject: [PATCH 260/291] reduce code length --- src/physics/cam/vertical_diffusion.F90 | 12 ++---------- 1 file changed, 2 insertions(+), 10 deletions(-) diff --git a/src/physics/cam/vertical_diffusion.F90 b/src/physics/cam/vertical_diffusion.F90 index f2b19bdf31..292bb84e90 100644 --- a/src/physics/cam/vertical_diffusion.F90 +++ b/src/physics/cam/vertical_diffusion.F90 @@ -1092,17 +1092,9 @@ subroutine vertical_diffusion_tend( & ! ! add sponge layer vertical diffusion ! - if (ptop_ref>300.0_r8) then + if (ptop_ref>1e-1_r8.and.ptop_ref<100.0_r8) then ! - ! for low tops the tanh formulae below makes the sponge excessively deep - ! - else if (ptop_ref>100.0_r8) then - ! - ! CAM6 top (~225 Pa) or CAM7 low top - ! - else if (ptop_ref>1e-1_r8) then - ! - ! CAM7 FMT + ! CAM7 FMT (but not CAM6 top (~225 Pa) or CAM7 low top or lower) ! kvm(:ncol,1) = kvm(:ncol,1)+2E6_r8 kvm(:ncol,2) = kvm(:ncol,2)+2E6_r8 From 8a20418cb3b101de40ef0058ff7b8d213405b8dd Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Mon, 19 Feb 2024 11:40:31 -0700 Subject: [PATCH 261/291] fix compilation error --- src/dynamics/se/dp_coupling.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/dynamics/se/dp_coupling.F90 b/src/dynamics/se/dp_coupling.F90 index 66ccb47b94..beba3d3611 100644 --- a/src/dynamics/se/dp_coupling.F90 +++ b/src/dynamics/se/dp_coupling.F90 @@ -312,7 +312,7 @@ subroutine p_d_coupling(phys_state, phys_tend, dyn_in, tl_f, tl_qdp) use fvm_mapping, only: phys2dyn_forcings_fvm use test_fvm_mapping, only: test_mapping_overwrite_tendencies use test_fvm_mapping, only: test_mapping_output_mapped_tendencies - + use dimensions_mod, only: use_cslam ! arguments type(physics_state), intent(inout), dimension(begchunk:endchunk) :: phys_state type(physics_tend), intent(inout), dimension(begchunk:endchunk) :: phys_tend From cd12ccc5aac5ee8808a16c39c4a3733f869c7321 Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Mon, 19 Feb 2024 15:12:12 -0700 Subject: [PATCH 262/291] fix dycore budgets --- src/dynamics/se/dycore/prim_driver_mod.F90 | 6 +++++- src/dynamics/se/dycore_budget.F90 | 10 +++++----- src/dynamics/se/dyn_comp.F90 | 10 ++++++---- 3 files changed, 16 insertions(+), 10 deletions(-) diff --git a/src/dynamics/se/dycore/prim_driver_mod.F90 b/src/dynamics/se/dycore/prim_driver_mod.F90 index 9169d0f435..dc012e2d12 100644 --- a/src/dynamics/se/dycore/prim_driver_mod.F90 +++ b/src/dynamics/se/dycore/prim_driver_mod.F90 @@ -301,9 +301,13 @@ subroutine prim_run_subcycle(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,nsubst ! right after physics overwrite Qdp with CSLAM values ! if (use_cslam.and.nsubstep==1.and.r==1) then + call tot_energy_dyn(elem,fvm,nets,nete,tl%n0,n0_qdp,'dAF') call cslam2gll(elem, fvm, hybrid,nets,nete, tl%n0, n0_qdp) + call tot_energy_dyn(elem,fvm,nets,nete,tl%n0,n0_qdp,'dBD') end if + call tot_energy_dyn(elem,fvm,nets,nete,tl%n0,n0_qdp,'dBL') call prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,r,nsubstep==nsplit,dt_remap) + call tot_energy_dyn(elem,fvm,nets,nete,tl%np1,n0_qdp,'dAL') enddo @@ -565,7 +569,7 @@ subroutine prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord, rstep, last_s !$OMP END PARALLEL call omp_set_nested(.false.) call t_stopf('prim_advec_tracers_remap') - else + else ! ! only run fvm transport every fvm_supercycling rstep ! diff --git a/src/dynamics/se/dycore_budget.F90 b/src/dynamics/se/dycore_budget.F90 index d2bfe0fceb..14f1d65167 100644 --- a/src/dynamics/se/dycore_budget.F90 +++ b/src/dynamics/se/dycore_budget.F90 @@ -63,7 +63,7 @@ subroutine print_budget(hstwr) ! ! mass budgets dynamics ! - real(r8) :: dMdt_floating_dyn ! mass tendency floating dynamics (dAD-dBD) + real(r8) :: dMdt_floating_dyn ! mass tendency floating dynamics (dAL-dBL) real(r8) :: dMdt_vert_remap ! mass tendency vertical remapping (dAR-dAD) real(r8) :: dMdt_del4_fric_heat ! mass tendency del4 frictional heating (dAH-dCH) real(r8) :: dMdt_del4_tot ! mass tendency del4 + del4 frictional heating (dAH-dBH) @@ -73,7 +73,7 @@ subroutine print_budget(hstwr) ! ! energy budgets dynamics ! - real(r8) :: dEdt_floating_dyn ! dE/dt floating dynamics (dAD-dBD) + real(r8) :: dEdt_floating_dyn ! dE/dt floating dynamics (dAL-dBL) real(r8) :: dEdt_vert_remap ! dE/dt vertical remapping (dAR-dAD) real(r8) :: dEdt_del4 ! dE/dt del4 (dCH-dBH) real(r8) :: dEdt_del4_fric_heat ! dE/dt del4 frictional heating (dAH-dCH) @@ -132,7 +132,7 @@ subroutine print_budget(hstwr) call cam_budget_get_global('dBF' ,idx(i),E_dBF(i)) !state passed to physics end do - call cam_budget_get_global('dAD-dBD',teidx,dEdt_floating_dyn) + call cam_budget_get_global('dAL-dBL',teidx,dEdt_floating_dyn) call cam_budget_get_global('dAR-dAD',teidx,dEdt_vert_remap) dEdt_dycore_dyn = dEdt_floating_dyn+dEdt_vert_remap @@ -459,7 +459,7 @@ subroutine print_budget(hstwr) ! detailed mass budget in dynamical core ! if (is_cam_budget('dAD').and.is_cam_budget('dBD').and.is_cam_budget('dAR').and.is_cam_budget('dCH')) then - call cam_budget_get_global('dAD-dBD',m_cnst,dMdt_floating_dyn) + call cam_budget_get_global('dAL-dBL',m_cnst,dMdt_floating_dyn) call cam_budget_get_global('dAR-dAD',m_cnst,dMdt_vert_remap) tmp = dMdt_floating_dyn+dMdt_vert_remap diff = abs_diff(tmp,0.0_r8,pf=pf) @@ -472,7 +472,7 @@ subroutine print_budget(hstwr) write(iulog,*) "Error: mass non-conservation in dynamical core" write(iulog,*) "(detailed budget below)" write(iulog,*) " " - write(iulog,*)"dMASS/dt 2D dynamics (dAD-dBD) ",dMdt_floating_dyn," Pa/m^2/s" + write(iulog,*)"dMASS/dt 2D dynamics (dAL-dBL) ",dMdt_floating_dyn," Pa/m^2/s" write(iulog,*)"dE/dt vertical remapping (dAR-dAD) ",dMdt_vert_remap write(iulog,*)" " write(iulog,*)"Breakdown of 2D dynamics:" diff --git a/src/dynamics/se/dyn_comp.F90 b/src/dynamics/se/dyn_comp.F90 index d70d8539a4..5dcffe7347 100644 --- a/src/dynamics/se/dyn_comp.F90 +++ b/src/dynamics/se/dyn_comp.F90 @@ -618,12 +618,14 @@ subroutine dyn_init(dyn_in, dyn_out) integer :: m_cnst, m ! variables for initializing energy and axial angular momentum diagnostics - integer, parameter :: num_stages = 12 - character (len = 4), dimension(num_stages) :: stage = (/"dED","dAF","dBD","dAD","dAR","dBF","dBH","dCH","dAH","dBS","dAS","p2d"/) + integer, parameter :: num_stages = 14 + character (len = 4), dimension(num_stages) :: stage = (/"dED","dAF","dBD","dBL","dAL","dAD","dAR","dBF","dBH","dCH","dAH","dBS","dAS","p2d"/) character (len = 70),dimension(num_stages) :: stage_txt = (/& " end of previous dynamics ",& !dED " from previous remapping or state passed to dynamics",& !dAF - state in beginning of nsplit loop " state after applying CAM forcing ",& !dBD - state after applyCAMforcing + " before floating dynamics ",& !dBL + " after floating dynamics ",& !dAL " before vertical remapping ",& !dAD - state before vertical remapping " after vertical remapping ",& !dAR - state at end of nsplit loop " state passed to parameterizations ",& !dBF @@ -927,8 +929,8 @@ subroutine dyn_init(dyn_in, dyn_out) ! ! Register tendency (difference) budgets ! - call cam_budget_em_register('dEdt_floating_dyn' ,'dAD','dBD','dyn','dif', & - longname="dE/dt floating dynamics (dAD-dBD)" ) + call cam_budget_em_register('dEdt_floating_dyn' ,'dAL','dBL','dyn','dif', & + longname="dE/dt floating dynamics (dAL-dBL)" ) call cam_budget_em_register('dEdt_vert_remap' ,'dAR','dAD','dyn','dif', & longname="dE/dt vertical remapping (dAR-dAD)" ) call cam_budget_em_register('dEdt_phys_tot_in_dyn','dBD','dAF','dyn','dif', & From 02abc17857e996b652a24f3ab15d85f9a440d197 Mon Sep 17 00:00:00 2001 From: Brian Eaton Date: Mon, 19 Feb 2024 19:21:39 -0500 Subject: [PATCH 263/291] address review comments --- cime_config/testdefs/testlist_cam.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cime_config/testdefs/testlist_cam.xml b/cime_config/testdefs/testlist_cam.xml index 73ec42ee96..62cd0af626 100644 --- a/cime_config/testdefs/testlist_cam.xml +++ b/cime_config/testdefs/testlist_cam.xml @@ -1805,7 +1805,7 @@ - + @@ -2785,7 +2785,7 @@ - + From 89a46e6bf386a72a196f20331e09bb8d1425f66f Mon Sep 17 00:00:00 2001 From: Cheryl Craig Date: Tue, 20 Feb 2024 16:28:37 -0700 Subject: [PATCH 264/291] Update TMC test --- cime_config/SystemTests/tmc.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/SystemTests/tmc.py b/cime_config/SystemTests/tmc.py index 9fb8a5f7ab..ba92070de9 100644 --- a/cime_config/SystemTests/tmc.py +++ b/cime_config/SystemTests/tmc.py @@ -25,7 +25,7 @@ def run_phase(self): self.run_indv() cpllog = ''.join(get_latest_cpl_logs(self._case)) atmlog = cpllog.replace("cpl.log","atm.log") - atmlog = atmlog.replace("drv.log","atm.log") + atmlog = atmlog.replace("med.log","atm.log") if '.gz' == atmlog[-3:]: fopen = gzip.open else: From 538a35673ef1f1a3b374f0cf10ca93c6b2a4b7dc Mon Sep 17 00:00:00 2001 From: Brian Eaton Date: Wed, 21 Feb 2024 13:55:37 -0500 Subject: [PATCH 265/291] update ChangeLog --- doc/ChangeLog | 33 +++++++++++++++++++++++++++------ 1 file changed, 27 insertions(+), 6 deletions(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index 8fbe06f141..5ea328d2c8 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,8 +1,8 @@ =============================================================== -Tag name: +Tag name: cam6_3_148 Originator(s): brianpm, courtneyp, eaton -Date: +Date: Wed 21 Feb 2024 One-line Summary: Provide RRTMGP as a radiation parameterization Github PR URL: https://github.com/ESCOMP/CAM/pull/909 @@ -16,7 +16,6 @@ Miscellaneous: facilitate running the F1850 compset with CAM5. That discussion is in issue #393. - Describe any changes made to build system: . '-rad' argument to configure accepts the values 'rrtmgp' and 'rrtmgp_gpu' to build the RRTMGP code for CPUs or for GPUs. @@ -30,7 +29,7 @@ List any changes to the defaults for the boundary datasets: none Describe any substantial timing or memory changes: . performance evaluation of RRTMGP has not yet been done. -Code reviewed by: +Code reviewed by: nusbaume, cacraigucar, sjsprecious List all files eliminated: @@ -165,14 +164,36 @@ 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. -cheyenne/intel/aux_cam: - derecho/intel/aux_cam: + ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 (Overall: PEND) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + SMS_Ld1_Vnuopc.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: PEND) details: +-- pre-existing failures + + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + FAIL ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s_rrtmgp NLCOMP + FAIL ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s_rrtmgp BASELINE /glade/campaign/cesm/community/amwg/cam_baselines/cam6_3_147: ERROR BFAIL baseline directory '/glade/campaign/cesm/community/amwg/cam_baselines/cam6_3_147/ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s_rrtmgp' does not exist + SMS_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + FAIL SMS_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_rrtmgp NLCOMP + FAIL SMS_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_rrtmgp BASELINE /glade/campaign/cesm/community/amwg/cam_baselines/cam6_3_147: ERROR BFAIL baseline directory '/glade/campaign/cesm/community/amwg/cam_baselines/cam6_3_147/SMS_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_rrtmgp' does not exist +-- expected diffs - no baselines for new tests + izumi/nag/aux_cam: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: +-- pre-existing failure + izumi/gnu/aux_cam: + ERP_D_Ln9.ne3pg3_ne3pg3_mg37.QPC6.izumi_gnu.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + FAIL ERP_D_Ln9.ne3pg3_ne3pg3_mg37.QPC6.izumi_gnu.cam-outfrq9s_rrtmgp NLCOMP + FAIL ERP_D_Ln9.ne3pg3_ne3pg3_mg37.QPC6.izumi_gnu.cam-outfrq9s_rrtmgp BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_147_gnu: ERROR BFAIL baseline directory '/fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_147_gnu/ERP_D_Ln9.ne3pg3_ne3pg3_mg37.QPC6.izumi_gnu.cam-outfrq9s_rrtmgp' does not exist + SMS_Ld5.f09_f09_mg17.PC6.izumi_gnu.cam-cam6_port_f09_rrtmgp (Overall: DIFF) details: + FAIL SMS_Ld5.f09_f09_mg17.PC6.izumi_gnu.cam-cam6_port_f09_rrtmgp NLCOMP + FAIL SMS_Ld5.f09_f09_mg17.PC6.izumi_gnu.cam-cam6_port_f09_rrtmgp BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_147_gnu: ERROR BFAIL baseline directory '/fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_147_gnu/SMS_Ld5.f09_f09_mg17.PC6.izumi_gnu.cam-cam6_port_f09_rrtmgp' does not exist +-- expected diffs - no baselines for new tests + CAM tag used for the baseline comparison tests if different than previous tag: From 2a08713a6c82a4babbf0390ae48742fc9d869c7d Mon Sep 17 00:00:00 2001 From: Cheryl Craig Date: Wed, 21 Feb 2024 12:13:36 -0700 Subject: [PATCH 266/291] Fix failing tests --- Externals.cfg | 2 +- cime_config/buildnml | 16 +- cime_config/testdefs/testlist_cam.xml | 635 +++++++++++++------------- 3 files changed, 328 insertions(+), 325 deletions(-) diff --git a/Externals.cfg b/Externals.cfg index 259561d182..c453364b82 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -64,7 +64,7 @@ local_path = libraries/parallelio required = True [cime] -tag = cime6.0.217_httpsbranch01 +tag = cime6.0.217_httpsbranch02 protocol = git repo_url = https://github.com/ESMCI/cime local_path = cime diff --git a/cime_config/buildnml b/cime_config/buildnml index 0af683719a..707d830d2d 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -216,13 +216,15 @@ def buildnml(case, caseroot, compname): # copy geos-chem config files to rundir if using geos-chem chemistry # ----------------------------------------------------- - if os.path.isdir(rundir) and '-chem geoschem' in CAM_CONFIG_OPTS: - for fname in ['species_database.yml', 'geoschem_config.yml', - 'HISTORY.rc', 'HEMCO_Config.rc', 'HEMCO_Diagn.rc']: - file1 = os.path.join(caseroot, fname) - file2 = os.path.join(rundir, fname) - logger.info("GEOS-Chem config file copy: file1 %s file2 %s ", file1, file2) - shutil.copy(file1,file2) + if os.path.isdir(rundir) \ + and os.path.exists(os.path.join(caseroot, "species_database.yaml"))\ + and '-chem geoschem' in CAM_CONFIG_OPTS: + for fname in ['species_database.yml', 'geoschem_config.yml', + 'HISTORY.rc', 'HEMCO_Config.rc', 'HEMCO_Diagn.rc']: + file1 = os.path.join(caseroot, fname) + file2 = os.path.join(rundir, fname) + logger.info("GEOS-Chem config file copy: file1 %s file2 %s ", file1, file2) + shutil.copy(file1,file2) ############################################################################### def _main_func(): diff --git a/cime_config/testdefs/testlist_cam.xml b/cime_config/testdefs/testlist_cam.xml index 4b6647697d..5066141629 100644 --- a/cime_config/testdefs/testlist_cam.xml +++ b/cime_config/testdefs/testlist_cam.xml @@ -5,7 +5,7 @@ - + @@ -17,7 +17,7 @@ - + @@ -25,7 +25,7 @@ - + @@ -33,7 +33,7 @@ - + @@ -42,7 +42,7 @@ - + @@ -50,7 +50,7 @@ - + @@ -58,7 +58,7 @@ - + @@ -67,7 +67,7 @@ - + @@ -77,7 +77,7 @@ - + @@ -87,7 +87,7 @@ - + @@ -97,7 +97,7 @@ - + @@ -109,7 +109,7 @@ - + @@ -123,7 +123,7 @@ - + @@ -131,7 +131,7 @@ - + @@ -139,7 +139,7 @@ - + @@ -148,7 +148,7 @@ - + @@ -158,7 +158,7 @@ - + @@ -168,7 +168,7 @@ - + @@ -181,7 +181,7 @@ - + @@ -191,7 +191,7 @@ - + @@ -199,7 +199,7 @@ - + @@ -207,7 +207,7 @@ - + @@ -215,7 +215,7 @@ - + @@ -223,7 +223,7 @@ - + @@ -231,7 +231,7 @@ - + @@ -239,13 +239,13 @@ - + - + @@ -253,7 +253,7 @@ - + @@ -263,7 +263,7 @@ - + @@ -271,7 +271,7 @@ - + @@ -279,7 +279,7 @@ - + @@ -288,7 +288,7 @@ - + @@ -297,7 +297,7 @@ - + @@ -305,7 +305,7 @@ - + @@ -316,7 +316,7 @@ - + @@ -326,7 +326,7 @@ - + @@ -336,9 +336,10 @@ - + + @@ -346,7 +347,7 @@ - + @@ -356,7 +357,7 @@ - + @@ -366,7 +367,7 @@ - + @@ -376,7 +377,7 @@ - + @@ -386,7 +387,7 @@ - + @@ -396,7 +397,7 @@ - + @@ -406,7 +407,7 @@ - + @@ -416,7 +417,7 @@ - + @@ -426,7 +427,7 @@ - + @@ -436,7 +437,7 @@ - + @@ -446,7 +447,7 @@ - + @@ -456,7 +457,7 @@ - + @@ -466,7 +467,7 @@ - + @@ -476,7 +477,7 @@ - + @@ -486,7 +487,7 @@ - + @@ -496,7 +497,7 @@ - + @@ -506,7 +507,7 @@ - + @@ -516,7 +517,7 @@ - + @@ -526,7 +527,7 @@ - + @@ -536,7 +537,7 @@ - + @@ -546,7 +547,7 @@ - + @@ -555,7 +556,7 @@ - + @@ -563,7 +564,7 @@ - + @@ -572,7 +573,7 @@ - + @@ -580,7 +581,7 @@ - + @@ -589,7 +590,7 @@ - + @@ -599,7 +600,7 @@ - + @@ -609,7 +610,7 @@ - + @@ -621,7 +622,7 @@ - + @@ -632,7 +633,7 @@ - + @@ -643,7 +644,7 @@ - + @@ -654,7 +655,7 @@ - + @@ -665,7 +666,7 @@ - + @@ -676,7 +677,7 @@ - + @@ -687,7 +688,7 @@ - + @@ -698,7 +699,7 @@ - + @@ -709,7 +710,7 @@ - + @@ -734,7 +735,7 @@ - + @@ -745,7 +746,7 @@ - + @@ -756,7 +757,7 @@ - + @@ -767,7 +768,7 @@ - + @@ -777,7 +778,7 @@ - + @@ -786,7 +787,7 @@ - + @@ -796,7 +797,7 @@ - + @@ -806,7 +807,7 @@ - + @@ -816,7 +817,7 @@ - + @@ -826,7 +827,7 @@ - + @@ -836,7 +837,7 @@ - + @@ -846,7 +847,7 @@ - + @@ -856,7 +857,7 @@ - + @@ -866,7 +867,7 @@ - + @@ -876,7 +877,7 @@ - + @@ -886,7 +887,7 @@ - + @@ -896,7 +897,7 @@ - + @@ -907,7 +908,7 @@ - + @@ -917,7 +918,7 @@ - + @@ -926,7 +927,7 @@ - + @@ -934,7 +935,7 @@ - + @@ -942,7 +943,7 @@ - + @@ -952,7 +953,7 @@ - + @@ -962,7 +963,7 @@ - + @@ -972,7 +973,7 @@ - + @@ -982,7 +983,7 @@ - + @@ -992,7 +993,7 @@ - + @@ -1002,7 +1003,7 @@ - + @@ -1012,7 +1013,7 @@ - + @@ -1022,7 +1023,7 @@ - + @@ -1032,7 +1033,7 @@ - + @@ -1042,7 +1043,7 @@ - + @@ -1052,7 +1053,7 @@ - + @@ -1062,7 +1063,7 @@ - + @@ -1072,7 +1073,7 @@ - + @@ -1082,7 +1083,7 @@ - + @@ -1092,7 +1093,7 @@ - + @@ -1102,7 +1103,7 @@ - + @@ -1112,7 +1113,7 @@ - + @@ -1122,7 +1123,7 @@ - + @@ -1132,7 +1133,7 @@ - + @@ -1142,7 +1143,7 @@ - + @@ -1152,7 +1153,7 @@ - + @@ -1161,7 +1162,7 @@ - + @@ -1171,7 +1172,7 @@ - + @@ -1181,7 +1182,7 @@ - + @@ -1191,7 +1192,7 @@ - + @@ -1201,7 +1202,7 @@ - + @@ -1211,7 +1212,7 @@ - + @@ -1222,7 +1223,7 @@ - + @@ -1231,7 +1232,7 @@ - + @@ -1240,7 +1241,7 @@ - + @@ -1250,7 +1251,7 @@ - + @@ -1260,7 +1261,7 @@ - + @@ -1270,7 +1271,7 @@ - + @@ -1280,7 +1281,7 @@ - + @@ -1289,7 +1290,7 @@ - + @@ -1297,7 +1298,7 @@ - + @@ -1306,7 +1307,7 @@ - + @@ -1316,7 +1317,7 @@ - + @@ -1326,7 +1327,7 @@ - + @@ -1336,7 +1337,7 @@ - + @@ -1346,7 +1347,7 @@ - + @@ -1355,7 +1356,7 @@ - + @@ -1364,7 +1365,7 @@ - + @@ -1373,7 +1374,7 @@ - + @@ -1394,37 +1395,37 @@ - + - + - + - + - + - + - + @@ -1435,7 +1436,7 @@ - + @@ -1446,7 +1447,7 @@ - + @@ -1455,7 +1456,7 @@ - + @@ -1470,7 +1471,7 @@ - + @@ -1480,7 +1481,7 @@ - + @@ -1489,7 +1490,7 @@ - + @@ -1498,7 +1499,7 @@ - + @@ -1507,7 +1508,7 @@ - + @@ -1517,7 +1518,7 @@ - + @@ -1535,17 +1536,17 @@ - + - + - + @@ -1554,7 +1555,7 @@ - + @@ -1563,7 +1564,7 @@ - + @@ -1572,7 +1573,7 @@ - + @@ -1581,7 +1582,7 @@ - + @@ -1590,7 +1591,7 @@ - + @@ -1598,7 +1599,7 @@ - + @@ -1606,7 +1607,7 @@ - + @@ -1614,7 +1615,7 @@ - + @@ -1622,7 +1623,7 @@ - + @@ -1630,7 +1631,7 @@ - + @@ -1638,7 +1639,7 @@ - + @@ -1646,7 +1647,7 @@ - + @@ -1655,7 +1656,7 @@ - + @@ -1664,7 +1665,7 @@ - + @@ -1674,7 +1675,7 @@ - + @@ -1685,7 +1686,7 @@ - + @@ -1695,7 +1696,7 @@ - + @@ -1705,7 +1706,7 @@ - + @@ -1715,7 +1716,7 @@ - + @@ -1725,7 +1726,7 @@ - + @@ -1736,7 +1737,7 @@ - + @@ -1746,7 +1747,7 @@ - + @@ -1755,7 +1756,7 @@ - + @@ -1764,7 +1765,7 @@ - + @@ -1809,7 +1810,7 @@ - + @@ -1818,7 +1819,7 @@ - + @@ -1827,7 +1828,7 @@ - + @@ -1835,7 +1836,7 @@ - + @@ -1844,7 +1845,7 @@ - + @@ -1853,7 +1854,7 @@ - + @@ -1862,12 +1863,12 @@ - + - + @@ -1876,23 +1877,23 @@ - + - + - + - + @@ -1901,12 +1902,12 @@ - + - + @@ -1925,7 +1926,7 @@ - + @@ -1935,7 +1936,7 @@ - + @@ -1945,17 +1946,17 @@ - + - + - + @@ -1966,7 +1967,7 @@ - + @@ -1976,7 +1977,7 @@ - + @@ -1985,7 +1986,7 @@ - + @@ -1997,13 +1998,13 @@ - + - + @@ -2012,7 +2013,7 @@ - + @@ -2020,7 +2021,7 @@ - + @@ -2028,17 +2029,17 @@ - + - + - + @@ -2047,7 +2048,7 @@ - + @@ -2056,7 +2057,7 @@ - + @@ -2065,12 +2066,12 @@ - + - + @@ -2080,7 +2081,7 @@ - + @@ -2090,7 +2091,7 @@ - + @@ -2098,7 +2099,7 @@ - + @@ -2106,7 +2107,7 @@ - + @@ -2115,7 +2116,7 @@ - + @@ -2124,7 +2125,7 @@ - + @@ -2133,7 +2134,7 @@ - + @@ -2143,7 +2144,7 @@ - + @@ -2151,7 +2152,7 @@ - + @@ -2160,7 +2161,7 @@ - + @@ -2170,17 +2171,17 @@ - + - + - + @@ -2189,7 +2190,7 @@ - + @@ -2198,7 +2199,7 @@ - + @@ -2208,7 +2209,7 @@ - + @@ -2217,12 +2218,12 @@ - + - + @@ -2231,7 +2232,7 @@ - + @@ -2241,7 +2242,7 @@ - + @@ -2250,7 +2251,7 @@ - + @@ -2260,7 +2261,7 @@ - + @@ -2269,7 +2270,7 @@ - + @@ -2278,7 +2279,7 @@ - + @@ -2287,7 +2288,7 @@ - + @@ -2296,7 +2297,7 @@ - + @@ -2304,7 +2305,7 @@ - + @@ -2312,7 +2313,7 @@ - + @@ -2320,7 +2321,7 @@ - + @@ -2328,7 +2329,7 @@ - + @@ -2337,12 +2338,12 @@ - + - + @@ -2351,7 +2352,7 @@ - + @@ -2360,7 +2361,7 @@ - + @@ -2368,7 +2369,7 @@ - + @@ -2376,7 +2377,7 @@ - + @@ -2385,7 +2386,7 @@ - + @@ -2393,7 +2394,7 @@ - + @@ -2402,7 +2403,7 @@ - + @@ -2411,7 +2412,7 @@ - + @@ -2425,12 +2426,12 @@ - + - + @@ -2439,22 +2440,22 @@ - + - + - + - + @@ -2463,12 +2464,12 @@ - + - + @@ -2476,7 +2477,7 @@ - + @@ -2484,22 +2485,22 @@ - + - + - + - + @@ -2507,7 +2508,7 @@ - + @@ -2515,7 +2516,7 @@ - + @@ -2523,7 +2524,7 @@ - + @@ -2532,7 +2533,7 @@ - + @@ -2540,7 +2541,7 @@ - + @@ -2548,32 +2549,32 @@ - + - + - + - + - + - + @@ -2583,7 +2584,7 @@ - + @@ -2591,7 +2592,7 @@ - + @@ -2600,7 +2601,7 @@ - + @@ -2608,7 +2609,7 @@ - + @@ -2617,7 +2618,7 @@ - + @@ -2625,7 +2626,7 @@ - + @@ -2634,22 +2635,22 @@ - + - + - + - + @@ -2658,17 +2659,17 @@ - + - + - + @@ -2677,7 +2678,7 @@ - + @@ -2686,12 +2687,12 @@ - + - + @@ -2700,7 +2701,7 @@ - + @@ -2710,7 +2711,7 @@ - + @@ -2719,13 +2720,13 @@ - + - + @@ -2734,17 +2735,17 @@ - + - + - + @@ -2753,7 +2754,7 @@ - + @@ -2761,13 +2762,13 @@ - + - + @@ -2777,7 +2778,7 @@ - + @@ -2787,7 +2788,7 @@ - + @@ -2797,7 +2798,7 @@ - + @@ -2807,7 +2808,7 @@ - + @@ -2816,13 +2817,13 @@ - + - + @@ -2831,7 +2832,7 @@ - + @@ -2842,20 +2843,20 @@ - + - + - + @@ -2869,7 +2870,7 @@ - + From 7423b5a7628f162f1ef5f609c551ef67719d8daf Mon Sep 17 00:00:00 2001 From: Cheryl Craig Date: Wed, 21 Feb 2024 14:43:44 -0700 Subject: [PATCH 267/291] Add a couple more prealpha tests --- cime_config/testdefs/testlist_cam.xml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/cime_config/testdefs/testlist_cam.xml b/cime_config/testdefs/testlist_cam.xml index cf9c681ca2..0061d5c9ce 100644 --- a/cime_config/testdefs/testlist_cam.xml +++ b/cime_config/testdefs/testlist_cam.xml @@ -419,6 +419,7 @@ + @@ -499,6 +500,7 @@ + From 25155844c69fa2b72ed046e8c09c0e865e43cab5 Mon Sep 17 00:00:00 2001 From: Cheryl Craig Date: Thu, 22 Feb 2024 10:45:55 -0700 Subject: [PATCH 268/291] Update ChangeLog for cam6_3_149 --- doc/ChangeLog | 106 +++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 104 insertions(+), 2 deletions(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index 5ea328d2c8..76105da84b 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,5 +1,107 @@ =============================================================== +Tag name: cam6_3_149 +Originator(s): cacraig, fischer, jedwards +Date: Feb 22, 2024 +One-line Summary: Update externals to match cesm2_3_alpha17a +Github PR URL: https://github.com/ESCOMP/CAM/pull/977 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Update externals to match CESM alpha17a tag and the cime external needed to support GEOS-Chem + - Made changes to fix failing regression tests + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: nusbaume + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: +M Externals.cfg + - Update externals to match cesm2_3_alpha17a + - Update cime tag to newer one to support GEOS-Chem + +M cime_config/SystemTests/tmc.py + - Fix failing TMC test (due to changes in cime) + +M cime_config/buildnml + - Fix failing GEOS-Chem test (due to changes in externals) + +M cime_config/testdefs/testlist_cam.xml + - Remove obsolete _Vnuopc qualifier on tests + - Introduce a few test types to prealpha testing (they had previously been exclusively tested in aux_cam) + +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. + +All jobs had errors about MEMCOMP and TPUTCOMP failing due to missing files (due to changes in externals now making these files) + +derecho/intel/aux_cam: + ERP_Ln9.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 (Overall: PEND) details: + ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: FAIL) details: + - pre-existing failures + + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ld3_Vnuopc.f09_f09_mg17.FWHIST.derecho_intel.cam-reduced_hist1d (Overall: DIFF) details: + ERP_Lh12_Vnuopc.f19_f19_mg17.FW4madSD.derecho_intel.cam-outfrq3h (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F1850.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000dev.derecho_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2010climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.FHIST_BDRD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f19_f19_mg17.FWsc1850.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne30_ne30_mg17.FCnudged.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ld3_Vnuopc.f10_f10_mg37.F1850.derecho_intel.cam-outfrq1d_14dec_ghg_cam_dev (Overall: DIFF) details: + ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.derecho_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) details: + ERS_Ln9_P36x1_Vnuopc.mpasa480_mpasa480.F2000climo.derecho_intel.cam-outfrq9s_mpasa480 (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f09_f09_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f19_f19_mg17.FSPCAMS.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCts2nudged.derecho_intel.cam-outfrq9s_leapday (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCvbsxHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FSD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s_waccm_ma_mam4 (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P1280x1.ne30pg3_ne30pg3_mg17.FCLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_Ld1_Vnuopc.f09_f09_mg17.FW2000climo.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1_Vnuopc.f19_f19.F2000dev.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1_Vnuopc.ne30pg3_ne30pg3_mg17.FC2010climo.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Lh12_Vnuopc.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h (Overall: DIFF) details: + SMS_Lm13_Vnuopc.f10_f10_mg37.F2000climo.derecho_intel.cam-outfrq1m (Overall: DIFF) details: + SMS_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f09_f09_mg17.F2010climo.derecho_intel.cam-nudging (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f09_f09_mg17.FW1850.derecho_intel.cam-reduced_hist3s (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f19_f19.F2000climo.derecho_intel.cam-silhs (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f19_f19_mg17.FHIST.derecho_intel.cam-outfrq9s_nochem (Overall: DIFF) details: + - Differences due to changed externals + +izumi/nag/aux_cam: All baselines PASS for nag + DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure + +izumi/gnu/aux_cam: all BFB except: + FAIL SMS_D_Ln9.f10_f10_mg37.2000_CAM%DEV%GHGMAM4_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV_SESP.izumi_gnu.cam-outfrq9s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_148_gnu: DIFF + FAIL SMS_P48x1_D_Ln9_Vnuopc.f19_f19_mg17.FW4madSD.izumi_gnu.cam-outfrq9s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_148_gnu: DIFF + - Differences due to changed externals + +=============================================================== +=============================================================== + Tag name: cam6_3_148 Originator(s): brianpm, courtneyp, eaton Date: Wed 21 Feb 2024 @@ -38,7 +140,7 @@ src/physics/rrtmg/ebert_curry.F90 src/physics/rrtmg/oldcloud.F90 src/physics/rrtmg/slingo.F90 . these cloud optics files which can be shared by rrtmg and rrtmgp are - moved to src/physics/cam + moved to src/physics/cam List all files added and what they do: @@ -124,7 +226,7 @@ src/physics/cam/aerosol_optics_cam.F90 src/physics/cam/phys_prop.F90 . add the public parameter nrh to this module. Was previously in - radconstants. + radconstants. . turn off old debug output to log file src/physics/cam/physpkg.F90 From 948b0a822c0d736fdf0bdb4fb3406ef6566274c7 Mon Sep 17 00:00:00 2001 From: Jesse Nusbaumer Date: Thu, 22 Feb 2024 15:12:14 -0700 Subject: [PATCH 269/291] Add allocation checks and update ChangeLog. --- doc/ChangeLog | 58 +++++++++++++++----------- src/dynamics/se/dycore/fvm_mapping.F90 | 30 ++++++++++--- 2 files changed, 58 insertions(+), 30 deletions(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index b630e00f05..2e207c315b 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -4,7 +4,7 @@ Tag name: cam6_3_xxx Originator(s): pel Date: Jan 30, 2024 One-line Summary: "science optimization" for SE-CSLAM and stabilize WACCM -Github PR URL: https://github.com/ESCOMP/CAM/pull/xxx +Github PR URL: https://github.com/ESCOMP/CAM/pull/968 Increase computational throughput of the SE-CSLAM dynamical core by: @@ -19,10 +19,13 @@ Provide stable configuration for WACCM with spectral-elements (ne30-pg3 and ne16 Resolve qneg issue 864 Resolve issue 552 (read in topo file on GLL grid if available) Resolve issue 951 (remove namelist defaults for pg4 grids) +Resolve issue 970 (remove deprecated 'imp' module from buildnml and buildlib) Describe any changes made to build system: - added namelist variable + - modified 'buildnml' and 'buildlib' python scripts + to remove deprecated 'imp' python module. Describe any changes made to the namelist: @@ -46,32 +49,39 @@ Describe any substantial timing or memory changes: List all existing files that have been modified, and describe the changes: - bld/build-namelist - - add namelist variable - bld/namelist_files/namelist_defaults_cam.xml - - change defaults (see above) - bld/namelist_files/namelist_definition.xml - - add namelist variable +M bld/build-namelist + - add namelist variable - all dycore changes described above (individual file changes not listed!) +M bld/namelist_files/namelist_defaults_cam.xml + - change defaults (see above) - src/dynamics/se/dp_coupling.F90 - src/dynamics/se/dycore/control_mod.F90 - src/dynamics/se/dycore/fvm_control_volume_mod.F90 - src/dynamics/se/dycore/fvm_mapping.F90 - src/dynamics/se/dycore/fvm_mod.F90 - src/dynamics/se/dycore/fvm_reconstruction_mod.F90 - src/dynamics/se/dycore/global_norms_mod.F90 - src/dynamics/se/dycore/prim_advance_mod.F90 - src/dynamics/se/dycore/prim_advection_mod.F90 - src/dynamics/se/dycore/prim_driver_mod.F90 - src/dynamics/se/dyn_comp.F90 - src/dynamics/se/dyn_grid.F90 +M bld/namelist_files/namelist_definition.xml + - add namelist variable + +M cime_config/buildlib +M cime_config/buildnml + - remove deprecated "imp" python module - src/dynamics/se/gravity_waves_sources.F90 - - fix model top pressure bug - src/physics/cam/vertical_diffusion.F90 - - vertical sponge layer diffusion +M src/dynamics/se/dp_coupling.F90 +M src/dynamics/se/dycore/control_mod.F90 +M src/dynamics/se/dycore/fvm_control_volume_mod.F90 +M src/dynamics/se/dycore/fvm_mapping.F90 +M src/dynamics/se/dycore/fvm_mod.F90 +M src/dynamics/se/dycore/fvm_reconstruction_mod.F90 +M src/dynamics/se/dycore/global_norms_mod.F90 +M src/dynamics/se/dycore/prim_advance_mod.F90 +M src/dynamics/se/dycore/prim_advection_mod.F90 +M src/dynamics/se/dycore/prim_driver_mod.F90 +M src/dynamics/se/dyn_comp.F90 +M src/dynamics/se/dyn_grid.F90 +M src/dynamics/se/dycore_budget.F90 + - implement SE dycore improvements + +M src/dynamics/se/gravity_waves_sources.F90 + - fix model top pressure bug + +M src/physics/cam/vertical_diffusion.F90 + - add vertical sponge layer diffusion 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, diff --git a/src/dynamics/se/dycore/fvm_mapping.F90 b/src/dynamics/se/dycore/fvm_mapping.F90 index 45c1edcd3d..9182953ccd 100644 --- a/src/dynamics/se/dycore/fvm_mapping.F90 +++ b/src/dynamics/se/dycore/fvm_mapping.F90 @@ -50,7 +50,6 @@ subroutine phys2dyn_forcings_fvm(elem, fvm, hybrid,nets,nete,no_cslam, tl_f, tl_ use dimensions_mod, only: fv_nphys, nhc_phys,ntrac,nhc,ksponge_end, nu_scale_top use hybrid_mod, only: hybrid_t use air_composition, only: thermodynamic_active_species_num, thermodynamic_active_species_idx - use cam_abortutils, only: endrun type (element_t), intent(inout):: elem(:) type(fvm_struct), intent(inout):: fvm(:) @@ -67,7 +66,7 @@ subroutine phys2dyn_forcings_fvm(elem, fvm, hybrid,nets,nete,no_cslam, tl_f, tl_ integer :: nflds logical, allocatable :: llimiter(:) - integer :: ierr=0 + integer :: ierr if (no_cslam) then call endrun("phys2dyn_forcings_fvm: no cslam case: NOT SUPPORTED") @@ -1313,7 +1312,7 @@ subroutine cslam2gll(elem, fvm, hybrid,nets,nete, tl_f, tl_qdp) type (hybrid_t), intent(in) :: hybrid ! distributed parallel structure (shared) integer, intent(in) :: nets, nete, tl_f, tl_qdp - integer :: ie,i,j,k,m_cnst,nq + integer :: ie,i,j,k,m_cnst,nq,ierr real (kind=r8), dimension(:,:,:,:,:) , allocatable :: fld_fvm, fld_gll ! ! for tensor product Lagrange interpolation @@ -1322,9 +1321,28 @@ subroutine cslam2gll(elem, fvm, hybrid,nets,nete, tl_f, tl_qdp) logical, allocatable :: llimiter(:) call t_startf('cslam2gll') nflds = thermodynamic_active_species_num - allocate(fld_fvm(1-nhc:nc+nhc,1-nhc:nc+nhc,nlev,nflds,nets:nete)) - allocate(fld_gll(np,np,nlev,thermodynamic_active_species_num,nets:nete)) - allocate(llimiter(nflds)) + + !Allocate variables + !------------------ + allocate(fld_fvm(1-nhc:nc+nhc,1-nhc:nc+nhc,nlev,nflds,nets:nete), stat=ierr) + if( ierr /= 0 ) then + write(iulog,*) 'cslam2gll: fld_fvm allocation error = ', ierr + call endrun('cslam2gll: failed to allocate fld_fvm array') + end if + + allocate(fld_gll(np,np,nlev,thermodynamic_active_species_num,nets:nete),stat=ierr) + if( ierr /= 0 ) then + write(iulog,*) 'cslam2gll: fld_gll allocation error = ', ierr + call endrun('cslam2gll: failed to allocate fld_gll array') + end if + + allocate(llimiter(nflds), stat=ierr) + if( ierr /= 0 ) then + write(iulog,*) 'cslam2gll: llimiter allocation error = ', ierr + call endrun('cslam2gll: failed to allocate llimiter array') + end if + !------------------ + llimiter(1:nflds) = .false. do ie=nets,nete do m_cnst=1,thermodynamic_active_species_num From c4eb85c5841c8d6ee6e707a3798b34bb4a7706fb Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Fri, 23 Feb 2024 11:40:39 -0700 Subject: [PATCH 270/291] changelog updates --- doc/ChangeLog | 195 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 195 insertions(+) diff --git a/doc/ChangeLog b/doc/ChangeLog index 76105da84b..676bcae485 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,5 +1,200 @@ =============================================================== +Tag name: cam6_3_150 +Originator(s): megandevlan, peverwhee +Date: Feb 23, 2024 +One-line Summary: Adding convective gustiness to U10: Add UGUST output to CAM +Github PR URL: https://github.com/ESCOMP/CAM/pull/943 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Update CMEPS external to bring in gustiness + - Add UGUST output to CAM + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: + - can now include 'UGUST' in fincl lists (default: Average flag) + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: cacraigucar, peverwhee + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: +M Externals.cfg + - Update CMEPS tag to bring in gustiness + +M src/control/camsrfexch.F90 + - Add ugust to cam_in + +M src/cpl/nuopc/atm_import_export.F90 + - Set ugust + +M src/physics/cam/cam_diagnostics.F90 + - Add UGUST addfld/outfld calls + +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. + +All (coupled) jobs had errors about MEMCOMP failing due to missing files - to +be fixed in upcoming CIME tag + +derecho/intel/aux_cam: + ERP_Ln9.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 (Overall: PEND) details: + ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: FAIL) details: + - pre-existing failures + + ERC_D_Ln9.ne16_ne16_mg17.FADIAB.derecho_intel.cam-terminator (Overall: NLFAIL) details: + ERC_D_Ln9.T42_T42_mg17.FDABIP04.derecho_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERC_D_Ln9.T42_T42_mg17.FHS94.derecho_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERS_Ln9.ne0TESTONLYne5x4_ne0TESTONLYne5x4_mg37.FADIAB.derecho_intel.cam-outfrq3s_refined (Overall: NLFAIL) details: + SMS_D_Ld5.f19_f19_mg17.PC4.derecho_intel.cam-cam4_port5d (Overall: NLFAIL) details: + SMS_Ld5.f09_f09_mg17.PC6.derecho_intel.cam-cam6_port_f09 (Overall: NLFAIL) details: + - add_gusts added to nuopc.runconfig + + ERC_D_Ln9.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq3s_cosp (Overall: DIFF) details: + ERC_D_Ln9.f19_f19_mg17.QPMOZ.derecho_intel.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9.f19_f19_mg17.QPX2000.derecho_intel.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9.ne16_ne16_mg17.QPC5HIST.derecho_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + ERC_D_Ln9_P144x1.ne16pg3_ne16pg3_mg17.QPC6HIST.derecho_intel.cam-outfrq3s_ttrac_usecase (Overall: DIFF) details: + ERI_D_Ln18.f45_f45_mg37.QPC41850.derecho_intel.cam-co2rmp_usecase (Overall: DIFF) details: + ERP_D_Ln9.f09_f09_mg17.QSC6.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.F2000dev.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + ERP_Ld3.f09_f09_mg17.FWHIST.derecho_intel.cam-reduced_hist1d (Overall: DIFF) details: + ERP_Lh12.f19_f19_mg17.FW4madSD.derecho_intel.cam-outfrq3h (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F1850.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F2000dev.derecho_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.FHIST_BDRD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f19_f19_mg17.FWsc1850.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.ne30_ne30_mg17.FCnudged.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_P24x3.f45_f45_mg37.QPWmaC6.derecho_intel.cam-outfrq9s_mee_fluxes (Overall: DIFF) details: + ERS_Ld3.f10_f10_mg37.F1850.derecho_intel.cam-outfrq1d_14dec_ghg_cam_dev (Overall: DIFF) details: + ERS_Ln9.f09_f09_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9.f19_f19_mg17.FSPCAMS.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9.f19_f19_mg17.FXSD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_P288x1.mpasa120_mpasa120.F2000climo.derecho_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) details: + ERS_Ln9_P36x1.mpasa480_mpasa480.F2000climo.derecho_intel.cam-outfrq9s_mpasa480 (Overall: DIFF) details: + SCT_D_Ln7.T42_T42_mg17.QPC5.derecho_intel.cam-scm_prep (Overall: DIFF) details: + SMS_D_Ld2.f19_f19_mg17.QPC5HIST.derecho_intel.cam-volc_usecase (Overall: DIFF) details: + SMS_D_Ln9.f09_f09_mg17.FCts2nudged.derecho_intel.cam-outfrq9s_leapday (Overall: DIFF) details: + SMS_D_Ln9.f09_f09_mg17.FCvbsxHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.f09_f09_mg17.FSD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s_waccm_ma_mam4 (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.QPC2000climo.derecho_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.QPC5M7.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.ne16_ne16_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.ne16_ne16_mg17.QPX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_P1280x1.ne30pg3_ne30pg3_mg17.FCLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_Ld1.f09_f09_mg17.FW2000climo.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1.f19_f19.F2000dev.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1.ne30pg3_ne30pg3_mg17.FC2010climo.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Lh12.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h (Overall: DIFF) details: + SMS_Lm13.f10_f10_mg37.F2000climo.derecho_intel.cam-outfrq1m (Overall: DIFF) details: + SMS_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-nudging (Overall: DIFF) details: + SMS_Ln9.f09_f09_mg17.FW1850.derecho_intel.cam-reduced_hist3s (Overall: DIFF) details: + SMS_Ln9.f19_f19.F2000climo.derecho_intel.cam-silhs (Overall: DIFF) details: + SMS_Ln9.f19_f19_mg17.FHIST.derecho_intel.cam-outfrq9s_nochem (Overall: DIFF) details: + SMS_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + - failures due to So_ugustOut in cpl.hi and answer changes for cam_dev tests + +izumi/nag/aux_cam: + DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure + + ERC_D_Ln9.mpasa480z32_mpasa480.FHS94.izumi_nag.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERI_D_Ln18.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic (Overall: NLFAIL) details: + ERI_D_Ln18.ne5pg3_ne5pg3_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic (Overall: NLFAIL) details: + ERS_Ln27.ne5pg3_ne5pg3_mg37.FKESSLER.izumi_nag.cam-outfrq9s (Overall: NLFAIL) details: + ERS_Ln9.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq9s (Overall: NLFAIL) details: + PEM_D_Ln9.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + SMS_D_Ld2.f45_f45_mg37.PC5.izumi_nag.cam-outfrq24h_port (Overall: NLFAIL) details: + SMS_D_Ln9_P1x1.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + TMC_D.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: NLFAIL) details: + TMC_D.T5_T5_mg37.QPC5.izumi_nag.cam-ghgrmp_e8 (Overall: NLFAIL) details: + - add_gusts added to nuopc.runconfig + + ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-carma_sea_salt (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_cosp (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_subcol (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QSPCAMS.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9.ne16_ne16_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) details: + ERC_D_Ln9.ne16pg3_ne16pg3_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) details: + ERC_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac (Overall: DIFF) details: + ERC_D_Ln9.T5_T5_mg37.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) details: + ERI_D_Ln18.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: DIFF) details: + ERI_D_Ln18.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 (Overall: DIFF) details: + ERP_Ln9.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) details: + PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: DIFF) details: + PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: DIFF) details: + PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: DIFF) details: + PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: DIFF) details: + PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: DIFF) details: + PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: DIFF) details: + SMS_D_Ln3.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + SMS_D_Ln6.ne5_ne5_mg37.QPWmaC4.izumi_nag.cam-outfrq3s_physgrid_tem (Overall: DIFF) details: + SMS_D_Ln7.T42_T42_mg17.QPSCAMC5.izumi_nag.cam-scmarm (Overall: DIFF) details: + SMS_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-rad_diag_mam (Overall: DIFF) details: + SMS_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_ba (Overall: DIFF) details: + SMS_P48x1_D_Ln3.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase (Overall: DIFF) details: + SUB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + - failures due to So_ugustOut in cpl.hi + +izumi/gnu/aux_cam: + ERC_D_Ln9.f10_f10_mg37.FADIAB.izumi_gnu.cam-terminator (Overall: NLFAIL) details: + ERC_D_Ln9.ne5pg2_ne5pg2_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9.ne5pg4_ne5pg4_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: NLFAIL) details: + ERP_Ln9.ne5_ne5_mg37.FHS94.izumi_gnu.cam-outfrq9s (Overall: NLFAIL) details: + PEM_D_Ln9.ne5pg3_ne5pg3_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: NLFAIL) details: + SMS_Ld5.f09_f09_mg17.PC6.izumi_gnu.cam-cam6_port_f09_rrtmgp (Overall: NLFAIL) details: + - add_gusts added to nuopc.runconfig + + ERC_D_Ln9.f10_f10_mg37.QPC4.izumi_gnu.cam-outfrq3s_diags (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_gnu.cam-outfrq3s_unicon (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_gnu.cam-rad_diag (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPSPCAMM.izumi_gnu.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9.ne5_ne5_mg37.QPC4.izumi_gnu.cam-outfrq3s_nudging_ne5_L26 (Overall: DIFF) details: + ERC_D_Ln9.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq3s_ba (Overall: DIFF) details: + ERI_D_Ln18.T5_T5_mg37.QPC4.izumi_gnu.cam-co2rmp (Overall: DIFF) details: + ERP_D_Ln9.ne3pg3_ne3pg3_mg37.QPC6.izumi_gnu.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + ERP_Ln9.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal0 (Overall: DIFF) details: + PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal1 (Overall: DIFF) details: + PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal3 (Overall: DIFF) details: + SCT_D_Ln7.T42_T42_mg17.QPC4.izumi_gnu.cam-scm_prep (Overall: DIFF) details: + SCT_D_Ln7.T42_T42_mg17.QPC6.izumi_gnu.cam-scm_prep_c6 (Overall: DIFF) details: + SMS_D_Ln3.f10_f10_mg37.QPMOZ.izumi_gnu.cam-outfrq3s_chemproc (Overall: DIFF) details: + SMS_D_Ln9.f10_f10_mg37.2000_CAM%DEV%GHGMAM4_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV_SESP.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.f10_f10_mg37.QPWmaC4.izumi_gnu.cam-outfrq9s_apmee (Overall: DIFF) details: + SMS_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-outfrq3s_ttrac (Overall: DIFF) details: + SMS_P48x1_D_Ln9.f19_f19_mg17.FW4madSD.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + - failures due to So_ugustOut in cpl.hi and answer changes for cam_dev tests + +=============================================================== + Tag name: cam6_3_149 Originator(s): cacraig, fischer, jedwards Date: Feb 22, 2024 From ea364f9d3de8a0c400d80f610b696e1e8a3db74f Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Fri, 23 Feb 2024 14:16:46 -0700 Subject: [PATCH 271/291] change allocation size --- src/dynamics/se/dycore/fvm_mapping.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/dynamics/se/dycore/fvm_mapping.F90 b/src/dynamics/se/dycore/fvm_mapping.F90 index 9182953ccd..0f090ebe9e 100644 --- a/src/dynamics/se/dycore/fvm_mapping.F90 +++ b/src/dynamics/se/dycore/fvm_mapping.F90 @@ -90,7 +90,7 @@ subroutine phys2dyn_forcings_fvm(elem, fvm, hybrid,nets,nete,no_cslam, tl_f, tl_ write(iulog,*) 'phys2dyn_forcings_fvm: fld_gll allocation error = ',ierr call endrun('phys2dyn_forcings_fvm: failed to allocate fld_gll array') end if - allocate(llimiter(nflds), stat=ierr) + allocate(llimiter(3), stat=ierr) if( ierr /= 0 ) then write(iulog,*) 'phys2dyn_forcings_fvm: llimiter allocation error = ',ierr call endrun('phys2dyn_forcings_fvm: failed to allocate llimiter array') From fc6af9b673352a7b0c20c03c6545b2eb8f7e14e0 Mon Sep 17 00:00:00 2001 From: Cheryl Craig Date: Fri, 23 Feb 2024 14:50:22 -0700 Subject: [PATCH 272/291] Update namelist settings --- bld/namelist_files/namelist_defaults_cam.xml | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/bld/namelist_files/namelist_defaults_cam.xml b/bld/namelist_files/namelist_defaults_cam.xml index 5afa8a0155..69ac654b86 100644 --- a/bld/namelist_files/namelist_defaults_cam.xml +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -2138,6 +2138,7 @@ 0.1 0.5 4.2 + 4.25 0.0 1.0 0.1 @@ -2177,6 +2178,7 @@ .false. .false. .false. + .true. .false. .false. .false. @@ -2328,7 +2330,6 @@ 1.D0 1.D0 - 0.375D0 1.D0 @@ -2468,7 +2469,7 @@ 0.45D0 0.45D0 0.35D0 -0.35D0 +1.30D0 0.30D0 0.30D0 0.45D0 @@ -2752,7 +2753,6 @@ 1.0D0 1.e-7 -5.e-6 5.e-3 .false. @@ -2762,7 +2762,6 @@ .true. .false. -.true. 5.0e-6 From 11a5276617e4b2e643b883352090f7b406e1fd42 Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Fri, 23 Feb 2024 15:12:27 -0700 Subject: [PATCH 273/291] restructure code --- src/physics/cam/vertical_diffusion.F90 | 87 ++++++++++++++------------ 1 file changed, 46 insertions(+), 41 deletions(-) diff --git a/src/physics/cam/vertical_diffusion.F90 b/src/physics/cam/vertical_diffusion.F90 index 292bb84e90..5b0970df13 100644 --- a/src/physics/cam/vertical_diffusion.F90 +++ b/src/physics/cam/vertical_diffusion.F90 @@ -141,6 +141,8 @@ module vertical_diffusion logical :: waccmx_mode = .false. logical :: do_hb_above_clubb = .false. +real(r8),allocatable :: kvm_sponge(:) + contains ! =============================================================================== ! @@ -290,7 +292,7 @@ subroutine vertical_diffusion_init(pbuf2d) real(r8), parameter :: ntop_eddy_pres = 1.e-7_r8 ! Pressure below which eddy diffusion is not done in WACCM-X. (Pa) - integer :: im, l, m, nmodes, nspec + integer :: im, l, m, nmodes, nspec, ierr logical :: history_amwg ! output the variables used by the AMWG diag package logical :: history_eddy ! output the eddy variables @@ -298,30 +300,49 @@ subroutine vertical_diffusion_init(pbuf2d) integer :: history_budget_histfile_num ! output history file number for budget fields logical :: history_waccm ! output variables of interest for WACCM runs - ! ----------------------------------------------------------------- ! - + ! + ! add sponge layer vertical diffusion + ! + if (ptop_ref>1e-1_r8.and.ptop_ref<100.0_r8) then + ! + ! CAM7 FMT (but not CAM6 top (~225 Pa) or CAM7 low top or lower) + ! + allocate(kvm_sponge(4), stat=ierr) + if( ierr /= 0 ) then + write(iulog,*) 'vertical_diffusion_init: kvm_sponge allocation error = ',ierr + call endrun('vertical_diffusion_init: failed to allocate kvm_sponge array') + end if + kvm_sponge(1) = 2E6_r8 + kvm_sponge(2) = 2E6_r8 + kvm_sponge(3) = 0.5E6_r8 + kvm_sponge(4) = 0.1E6_r8 + else if (ptop_ref>1e-4_r8) then + ! + ! WACCM and WACCM-x + ! + allocate(kvm_sponge(6), stat=ierr) + if( ierr /= 0 ) then + write(iulog,*) 'vertical_diffusion_init: kvm_sponge allocation error = ',ierr + call endrun('vertical_diffusion_init: failed to allocate kvm_sponge array') + end if + kvm_sponge(1) = 2E6_r8 + kvm_sponge(2) = 2E6_r8 + kvm_sponge(3) = 1.5E6_r8 + kvm_sponge(4) = 1.0E6_r8 + kvm_sponge(5) = 0.5E6_r8 + kvm_sponge(6) = 0.1E6_r8 + else + allocate(kvm_sponge(1)) + kvm_sponge(1) = 0.0_r8 + end if + if (masterproc) then write(iulog,*)'Initializing vertical diffusion (vertical_diffusion_init)' - if (ptop_ref>1e-1_r8.and.ptop_ref<100.0_r8) then - ! - ! CAM7 FMT - ! - write(iulog,*)'Artificial sponge layer vertical diffusion added:' - write(iulog,*)'vertical diffusion coefficient at interface 1 is increased by 2.0E6 m2 s-2' - write(iulog,*)'vertical diffusion coefficient at interface 2 is increased by 2.0E6 m2 s-2' - write(iulog,*)'vertical diffusion coefficient at interface 3 is increased by 0.5E6 m2 s-2' - write(iulog,*)'vertical diffusion coefficient at interface 4 is increased by 0.1E6 m2 s-2' - else if (ptop_ref>1e-4_r8) then - ! - ! WACCM and WACCM-x - ! + if (maxval(kvm_sponge(:))>0.0_r8) then write(iulog,*)'Artificial sponge layer vertical diffusion added:' - write(iulog,*)'vertical diffusion coefficient at interface 1 is increased by 2.0E6 m2 s-2' - write(iulog,*)'vertical diffusion coefficient at interface 2 is increased by 2.0E6 m2 s-2' - write(iulog,*)'vertical diffusion coefficient at interface 3 is increased by 1.5E6 m2 s-2' - write(iulog,*)'vertical diffusion coefficient at interface 4 is increased by 1.0E6 m2 s-2' - write(iulog,*)'vertical diffusion coefficient at interface 5 is increased by 0.5E6 m2 s-2' - write(iulog,*)'vertical diffusion coefficient at interface 6 is increased by 0.1E6 m2 s-2' + do k=1,size(kvm_sponge(:),1) + write(iulog,'(a44,i2,a17,e7.2,a8)') 'vertical diffusion coefficient at interface',k,' is increased by ',kvm_sponge(k),' m2 s-2' + end do end if end if @@ -1092,25 +1113,9 @@ subroutine vertical_diffusion_tend( & ! ! add sponge layer vertical diffusion ! - if (ptop_ref>1e-1_r8.and.ptop_ref<100.0_r8) then - ! - ! CAM7 FMT (but not CAM6 top (~225 Pa) or CAM7 low top or lower) - ! - kvm(:ncol,1) = kvm(:ncol,1)+2E6_r8 - kvm(:ncol,2) = kvm(:ncol,2)+2E6_r8 - kvm(:ncol,3) = kvm(:ncol,3)+0.5E6_r8 - kvm(:ncol,4) = kvm(:ncol,4)+0.1E6_r8 - else if (ptop_ref>1e-4_r8) then - ! - ! WACCM and WACCM-x - ! - kvm(:ncol,1) = kvm(:ncol,1)+2E6_r8 - kvm(:ncol,2) = kvm(:ncol,2)+2E6_r8 - kvm(:ncol,3) = kvm(:ncol,3)+1.5E6_r8 - kvm(:ncol,4) = kvm(:ncol,4)+1.0E6_r8 - kvm(:ncol,5) = kvm(:ncol,5)+0.5E6_r8 - kvm(:ncol,6) = kvm(:ncol,6)+0.1E6_r8 - end if + do k=1,size(kvm_sponge(:),1) + kvm(:ncol,1) = kvm(:ncol,1)+kvm_sponge(k) + end do ! kvh (in pbuf) is used by other physics parameterizations, and as an initial guess in compute_eddy_diff ! on the next timestep. It is not updated by the compute_vdiff call below. From 51478ad411b01f728970d4ed6d69d1774e29bf01 Mon Sep 17 00:00:00 2001 From: Jesse Nusbaumer Date: Tue, 27 Feb 2024 08:27:59 -0700 Subject: [PATCH 274/291] Add 'allocated' check for kvm_sponge. --- src/physics/cam/vertical_diffusion.F90 | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/src/physics/cam/vertical_diffusion.F90 b/src/physics/cam/vertical_diffusion.F90 index 5b0970df13..dfd38842f9 100644 --- a/src/physics/cam/vertical_diffusion.F90 +++ b/src/physics/cam/vertical_diffusion.F90 @@ -335,14 +335,17 @@ subroutine vertical_diffusion_init(pbuf2d) allocate(kvm_sponge(1)) kvm_sponge(1) = 0.0_r8 end if - + if (masterproc) then write(iulog,*)'Initializing vertical diffusion (vertical_diffusion_init)' - if (maxval(kvm_sponge(:))>0.0_r8) then + if (allocated(kvm_sponge(:))) then write(iulog,*)'Artificial sponge layer vertical diffusion added:' do k=1,size(kvm_sponge(:),1) - write(iulog,'(a44,i2,a17,e7.2,a8)') 'vertical diffusion coefficient at interface',k,' is increased by ',kvm_sponge(k),' m2 s-2' + write(iulog,'(a44,i2,a17,e7.2,a8)') 'vertical diffusion coefficient at interface',k,' is increased by ', & + kvm_sponge(k),' m2 s-2' end do + else + call endrun('vertical_diffusion_init: kvm_sponge not allocated. Please check model top pressure value') end if end if From 6719ede7ee62e6e8f0663694e027e430ab83da7f Mon Sep 17 00:00:00 2001 From: Jesse Nusbaumer Date: Tue, 27 Feb 2024 08:31:29 -0700 Subject: [PATCH 275/291] Re-add mistakenly deleted if statement. --- src/physics/cam/vertical_diffusion.F90 | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/src/physics/cam/vertical_diffusion.F90 b/src/physics/cam/vertical_diffusion.F90 index dfd38842f9..244d441a83 100644 --- a/src/physics/cam/vertical_diffusion.F90 +++ b/src/physics/cam/vertical_diffusion.F90 @@ -339,14 +339,16 @@ subroutine vertical_diffusion_init(pbuf2d) if (masterproc) then write(iulog,*)'Initializing vertical diffusion (vertical_diffusion_init)' if (allocated(kvm_sponge(:))) then - write(iulog,*)'Artificial sponge layer vertical diffusion added:' - do k=1,size(kvm_sponge(:),1) - write(iulog,'(a44,i2,a17,e7.2,a8)') 'vertical diffusion coefficient at interface',k,' is increased by ', & - kvm_sponge(k),' m2 s-2' - end do + if (maxval(kvm_sponge(:))>0.0_r8) then + write(iulog,*)'Artificial sponge layer vertical diffusion added:' + do k=1,size(kvm_sponge(:),1) + write(iulog,'(a44,i2,a17,e7.2,a8)') 'vertical diffusion coefficient at interface',k,' is increased by ', & + kvm_sponge(k),' m2 s-2' + end do + end if !maxval > 0 else call endrun('vertical_diffusion_init: kvm_sponge not allocated. Please check model top pressure value') - end if + end if !allocated end if ! Check to see if WACCM-X is on (currently we don't care whether the From e48c32ed6a6bd98b0400f98dd697f8052ab03a39 Mon Sep 17 00:00:00 2001 From: Jesse Nusbaumer Date: Tue, 27 Feb 2024 10:35:40 -0700 Subject: [PATCH 276/291] Don't allocate kvm_sponge if it is not being used. --- src/physics/cam/vertical_diffusion.F90 | 25 ++++++++++--------------- 1 file changed, 10 insertions(+), 15 deletions(-) diff --git a/src/physics/cam/vertical_diffusion.F90 b/src/physics/cam/vertical_diffusion.F90 index 244d441a83..327407a4e2 100644 --- a/src/physics/cam/vertical_diffusion.F90 +++ b/src/physics/cam/vertical_diffusion.F90 @@ -331,23 +331,16 @@ subroutine vertical_diffusion_init(pbuf2d) kvm_sponge(4) = 1.0E6_r8 kvm_sponge(5) = 0.5E6_r8 kvm_sponge(6) = 0.1E6_r8 - else - allocate(kvm_sponge(1)) - kvm_sponge(1) = 0.0_r8 end if if (masterproc) then write(iulog,*)'Initializing vertical diffusion (vertical_diffusion_init)' if (allocated(kvm_sponge(:))) then - if (maxval(kvm_sponge(:))>0.0_r8) then - write(iulog,*)'Artificial sponge layer vertical diffusion added:' - do k=1,size(kvm_sponge(:),1) - write(iulog,'(a44,i2,a17,e7.2,a8)') 'vertical diffusion coefficient at interface',k,' is increased by ', & - kvm_sponge(k),' m2 s-2' - end do - end if !maxval > 0 - else - call endrun('vertical_diffusion_init: kvm_sponge not allocated. Please check model top pressure value') + write(iulog,*)'Artificial sponge layer vertical diffusion added:' + do k=1,size(kvm_sponge(:),1) + write(iulog,'(a44,i2,a17,e7.2,a8)') 'vertical diffusion coefficient at interface',k,' is increased by ', & + kvm_sponge(k),' m2 s-2' + end do end if !allocated end if @@ -1118,9 +1111,11 @@ subroutine vertical_diffusion_tend( & ! ! add sponge layer vertical diffusion ! - do k=1,size(kvm_sponge(:),1) - kvm(:ncol,1) = kvm(:ncol,1)+kvm_sponge(k) - end do + if (allocated(kvm_sponge)) then + do k=1,size(kvm_sponge(:),1) + kvm(:ncol,1) = kvm(:ncol,1)+kvm_sponge(k) + end do + end if ! kvh (in pbuf) is used by other physics parameterizations, and as an initial guess in compute_eddy_diff ! on the next timestep. It is not updated by the compute_vdiff call below. From 22fa45e7afa026914e92a0ed156922e767899ddf Mon Sep 17 00:00:00 2001 From: Cheryl Craig Date: Thu, 29 Feb 2024 13:18:17 -0700 Subject: [PATCH 277/291] Remove obsolete file README_EXTERNALS --- README_EXTERNALS | 49 ------------------------------------------------ 1 file changed, 49 deletions(-) delete mode 100644 README_EXTERNALS diff --git a/README_EXTERNALS b/README_EXTERNALS deleted file mode 100644 index 2b6c2bc4e3..0000000000 --- a/README_EXTERNALS +++ /dev/null @@ -1,49 +0,0 @@ -Example taken from bulletin board forum for "Subversion Issues" in the -thread for "Introduction to Subversion"...(070208) - - -Working with externals: - -checkout the HEAD of cam's trunk into working copy directory -> svn co $SVN/cam1/trunk cam_trunk_head_wc - -view the property set for cam's external definitions -> svn propget svn:externals cam_trunk_head_wc - -view revision, URL and other useful information specific to external files -> cd cam_trunk_head_wc/models/lnd/clm2/src -> svn info main - -create new clm branch for mods required of cam -> svn copy $SVN/clm2/trunk_tags/ $SVN/clm2/branches/ -m "appropriate message" - -have external directories in working copy refer to new clm branch to make changes -> svn switch $SVN/clm2/branches//src/main main - ---make changes to clm files-- - -when satisfied with changes and testing, commit to HEAD of clm branch -> svn commit main -m "appropriate message" - -tag new version of clm branch - review naming conventions! -> svn copy $SVN/clm2/branches/ $SVN/clm2/branch_tags/_tags/ -m "appropriate message" - -have external directories in working copy refer to new clm tag -> svn switch $SVN/clm2/branch_tags/_tags//src/main main - -modify cam's property for external definitions in working copy -> emacs cam_trunk_head_wc/SVN_EXTERNAL_DIRECTORIES - ---point definition to URL of new-tag-name-- - -set the property - don't forget the 'dot' at the end! -> svn propset svn:externals -F SVN_EXTERNAL_DIRECTORIES cam_trunk_head_wc - ---continue with other cam mods-- - -commit changes from working copy directory to HEAD of cam trunk - NOTE: a commit from here will *NOT* recurse to external directories -> cd cam_trunk_head_wc -> svn commit -m "appropriate message" - -tag new version of cam trunk -> svn copy $SVN/cam1/trunk $SVN/cam1/trunk_tags/ -m "appropriate message" From 52f7d5b414333faef5d925115e4c62ef4a499c3e Mon Sep 17 00:00:00 2001 From: Jesse Nusbaumer Date: Fri, 1 Mar 2024 15:20:48 -0700 Subject: [PATCH 278/291] Fix syntax error found during testing. --- src/physics/cam/vertical_diffusion.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/physics/cam/vertical_diffusion.F90 b/src/physics/cam/vertical_diffusion.F90 index 327407a4e2..12c50b4234 100644 --- a/src/physics/cam/vertical_diffusion.F90 +++ b/src/physics/cam/vertical_diffusion.F90 @@ -335,7 +335,7 @@ subroutine vertical_diffusion_init(pbuf2d) if (masterproc) then write(iulog,*)'Initializing vertical diffusion (vertical_diffusion_init)' - if (allocated(kvm_sponge(:))) then + if (allocated(kvm_sponge)) then write(iulog,*)'Artificial sponge layer vertical diffusion added:' do k=1,size(kvm_sponge(:),1) write(iulog,'(a44,i2,a17,e7.2,a8)') 'vertical diffusion coefficient at interface',k,' is increased by ', & From 098b4c24dbea2ff0c93c0b9fac12c95b50f02aa2 Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Wed, 6 Mar 2024 15:07:12 -0700 Subject: [PATCH 279/291] namelist_default not setting WACCM-x variables correctly since waccm_phys="1" is true for WACCM-x --- bld/namelist_files/namelist_defaults_cam.xml | 33 ++++++++++---------- 1 file changed, 17 insertions(+), 16 deletions(-) diff --git a/bld/namelist_files/namelist_defaults_cam.xml b/bld/namelist_files/namelist_defaults_cam.xml index 208200db18..94b75fff19 100644 --- a/bld/namelist_files/namelist_defaults_cam.xml +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -3126,8 +3126,8 @@ 1 3 - 0 - 1 + 0 + 1 2 @@ -3138,21 +3138,21 @@ 3 2 4 - 9 - 8 + 9 + 8 2 3 3 1 - 1 - 3 - 2 - 4 - 20 - 4 - 2 - 4 + 1 + 3 + 2 + 4 + 20 + 4 + 2 + 4 1 2 @@ -3166,12 +3166,12 @@ 1.9 -1 +6.e15 5.e15 -6.e15 -1 +6.e15 10.e15 -6.e15 -1 @@ -3185,7 +3185,7 @@ -1 -1 -7.5 + 7.5 -1 1 @@ -3209,7 +3209,8 @@ 7 3 - 2 + 2 + 4 3 -1 From 5aa24d698204846944b5d01b3f803745253ae744 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 8 Mar 2024 14:25:09 -0700 Subject: [PATCH 280/291] fix so that all three flavors of intel compiler are recognized on derecho --- bld/configure | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/bld/configure b/bld/configure index 974c30dc5e..f77b822046 100755 --- a/bld/configure +++ b/bld/configure @@ -1696,7 +1696,7 @@ elsif ($fc =~ /nvfor/) { $fc_type = 'nvhpc'; } # User override for Fortran compiler type if (defined $opts{'fc_type'}) { $fc_type = $opts{'fc_type'}; } -if ($fc_type eq "oneapi") {$fc_type = 'intel'; } +if ($fc_type =~ /intel/) {$fc_type = 'intel'; } if ($fc_type) { $cfg_ref->set('fc_type', $fc_type); if ($print>=2) { print "Fortran compiler type: $fc_type$eol"; } From 323976618c01a949295585c2dc903d58e57a3ee8 Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Sat, 16 Mar 2024 21:29:15 -0600 Subject: [PATCH 281/291] fix restart issue --- src/dynamics/se/dycore/se_dyn_time_mod.F90 | 29 +++++++++++++--------- 1 file changed, 17 insertions(+), 12 deletions(-) diff --git a/src/dynamics/se/dycore/se_dyn_time_mod.F90 b/src/dynamics/se/dycore/se_dyn_time_mod.F90 index 4dfd981661..cfe7ad2323 100644 --- a/src/dynamics/se/dycore/se_dyn_time_mod.F90 +++ b/src/dynamics/se/dycore/se_dyn_time_mod.F90 @@ -80,6 +80,7 @@ end subroutine TimeLevel_init_specific !locations for nm1 and n0 for Qdp - because !it only has 2 levels for storage subroutine TimeLevel_Qdp(tl, qsplit, n0, np1) + use dimensions_mod, only: use_cslam type (TimeLevel_t) :: tl integer, intent(in) :: qsplit integer, intent(inout) :: n0 @@ -87,22 +88,26 @@ subroutine TimeLevel_Qdp(tl, qsplit, n0, np1) integer :: i_temp - i_temp = tl%nstep/qsplit - - if (mod(i_temp,2) ==0) then + if (use_cslam) then n0 = 1 - if (present(np1)) then - np1 = 2 - endif + if (present(np1)) np1 = 1 else - n0 = 2 - if (present(np1)) then - np1 = 1 - end if - endif + i_temp = tl%nstep/qsplit + + if (mod(i_temp,2) ==0) then + n0 = 1 + if (present(np1)) then + np1 = 2 + endif + else + n0 = 2 + if (present(np1)) then + np1 = 1 + end if + endif !print * ,'nstep = ', tl%nstep, 'qsplit= ', qsplit, 'i_temp = ', i_temp, 'n0 = ', n0 - + endif end subroutine TimeLevel_Qdp subroutine TimeLevel_update(tl,uptype) From 673f1808880bb1f2fe2d7b6dadc6cca50261dfd7 Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Mon, 18 Mar 2024 10:11:32 -0600 Subject: [PATCH 282/291] save memory by dynamic allocation of elem% variables --- src/dynamics/se/dycore/element_mod.F90 | 17 ++++-------- src/dynamics/se/dycore/prim_init.F90 | 38 ++++++++++++++++++++++++-- 2 files changed, 41 insertions(+), 14 deletions(-) diff --git a/src/dynamics/se/dycore/element_mod.F90 b/src/dynamics/se/dycore/element_mod.F90 index 6ba2b36e02..2e758727db 100644 --- a/src/dynamics/se/dycore/element_mod.F90 +++ b/src/dynamics/se/dycore/element_mod.F90 @@ -25,9 +25,8 @@ module element_mod real (kind=r8) :: T (np,np,nlev,timelevels) ! temperature real (kind=r8) :: dp3d (np,np,nlev,timelevels) ! dry delta p on levels real (kind=r8) :: psdry (np,np) ! dry surface pressure - real (kind=r8) :: phis (np,np) ! surface geopotential (prescribed) - real (kind=r8) :: Qdp (np,np,nlev,qsize_d,2) ! Tracer mass - + real (kind=r8) :: phis (np,np) ! surface geopotential (prescribed) + real (kind=r8), allocatable :: Qdp(:,:,:,:,:) ! Tracer mass end type elem_state_t !___________________________________________________________________ @@ -43,20 +42,16 @@ module element_mod real (kind=r8) :: phi(np,np,nlev) ! geopotential real (kind=r8) :: omega(np,np,nlev) ! vertical velocity - ! semi-implicit diagnostics: computed in explict-component, reused in Helmholtz-component. - real (kind=r8) :: zeta(np,np,nlev) ! relative vorticity - real (kind=r8) :: div(np,np,nlev,timelevels) ! divergence - ! tracer advection fields used for consistency and limiters real (kind=r8) :: dp(np,np,nlev) ! for dp_tracers at physics timestep - real (kind=r8) :: divdp(np,np,nlev) ! divergence of dp - real (kind=r8) :: divdp_proj(np,np,nlev) ! DSSed divdp + real (kind=r8), allocatable :: divdp(:,:,:) ! divergence of dp + real (kind=r8), allocatable :: divdp_proj(:,:,:) ! DSSed divdp real (kind=r8) :: mass(MAX(qsize_d,ntrac_d)+9) ! total tracer mass for diagnostics ! forcing terms for CAM - real (kind=r8) :: FQ(np,np,nlev,qsize_d) ! tracer forcing + real (kind=r8), allocatable :: FQ(:,:,:,:) ! tracer forcing real (kind=r8) :: FM(np,np,2,nlev) ! momentum forcing - real (kind=r8) :: FDP(np,np,nlev) ! save full updated dp right after physics + real (kind=r8), allocatable :: FDP(:,:,:) ! save full updated dp right after physics real (kind=r8) :: FT(np,np,nlev) ! temperature forcing real (kind=r8) :: etadot_prescribed(np,np,nlevp) ! prescribed vertical tendency real (kind=r8) :: u_met(np,np,nlev) ! zonal component of prescribed meteorology winds diff --git a/src/dynamics/se/dycore/prim_init.F90 b/src/dynamics/se/dycore/prim_init.F90 index 42a336f65c..ac5450f49e 100644 --- a/src/dynamics/se/dycore/prim_init.F90 +++ b/src/dynamics/se/dycore/prim_init.F90 @@ -56,6 +56,7 @@ subroutine prim_init1(elem, fvm, par, Tl) use shr_reprosum_mod, only: repro_sum => shr_reprosum_calc use fvm_analytic_mod, only: compute_basic_coordinate_vars use fvm_control_volume_mod, only: fvm_struct, allocate_physgrid_vars + use air_composition, only: thermodynamic_active_species_num type(element_t), pointer :: elem(:) type(fvm_struct), pointer :: fvm(:) @@ -70,7 +71,7 @@ subroutine prim_init1(elem, fvm, par, Tl) integer :: ie integer :: nets, nete integer :: nelem_edge - integer :: ierr, j + integer :: ierr=0, j logical, parameter :: Debug = .FALSE. real(r8), allocatable :: aratio(:,:) @@ -166,8 +167,39 @@ subroutine prim_init1(elem, fvm, par, Tl) call mpi_allreduce(nelemd, nelemdmax, 1, MPI_INTEGER, MPI_MAX, par%comm, ierr) if (nelemd > 0) then - allocate(elem(nelemd)) - call allocate_element_desc(elem) + allocate(elem(nelemd)) + call allocate_element_desc(elem) + if(fv_nphys > 0) then + do ie=1,nelemd + allocate(elem(ie)%state%Qdp(np,np,nlev,thermodynamic_active_species_num,1), stat=ierr) + if( ierr /= 0 ) then + call endrun('prim_init1: failed to allocate qdp array') + end if + end do + end if + else + do ie=1,nelemd + allocate(elem(ie)%state%Qdp(np,np,nlev,thermodynamic_active_species_num,2), stat=ierr) + if( ierr /= 0 ) then + call endrun('prim_init1: failed to allocate qdp array') + end if + allocate(elem(ie)%derived%FQ(np,np,nlev,thermodynamic_active_species_num), stat=ierr) + if( ierr /= 0 ) then + call endrun('prim_init1: failed to allocate fq array') + end if + allocate(elem(ie)%derived%FDP(np,np,nlev), stat=ierr) + if( ierr /= 0 ) then + call endrun('prim_init1: failed to allocate fdp array') + end if + allocate(elem(ie)%derived%divdp(np,np,nlev), stat=ierr) + if( ierr /= 0 ) then + call endrun('prim_init1: failed to allocate divdp array') + end if + allocate(elem(ie)%derived%divdp_proj(np,np,nlev), stat=ierr) + if( ierr /= 0 ) then + call endrun('prim_init1: failed to allocate divdp_proj array') + end if + end do end if if (fv_nphys > 0) then From 58252b91f1935e1e2d7ce8601ab3545c39db716c Mon Sep 17 00:00:00 2001 From: Jesse Nusbaumer Date: Tue, 19 Mar 2024 14:47:22 -0600 Subject: [PATCH 283/291] Fix allocation errors found during testing. --- src/dynamics/se/dycore/prim_init.F90 | 37 +++++++++++++++++----------- 1 file changed, 23 insertions(+), 14 deletions(-) diff --git a/src/dynamics/se/dycore/prim_init.F90 b/src/dynamics/se/dycore/prim_init.F90 index ac5450f49e..930b887107 100644 --- a/src/dynamics/se/dycore/prim_init.F90 +++ b/src/dynamics/se/dycore/prim_init.F90 @@ -1,7 +1,7 @@ module prim_init use shr_kind_mod, only: r8=>shr_kind_r8 - use dimensions_mod, only: nc + use dimensions_mod, only: nc, use_cslam use reduction_mod, only: reductionbuffer_ordered_1d_t use quadrature_mod, only: quadrature_t, gausslobatto @@ -22,7 +22,7 @@ subroutine prim_init1(elem, fvm, par, Tl) use cam_logfile, only: iulog use shr_sys_mod, only: shr_sys_flush use thread_mod, only: max_num_threads - use dimensions_mod, only: np, nlev, nelem, nelemd, nelemdmax + use dimensions_mod, only: np, nlev, nelem, nelemd, nelemdmax, qsize_d use dimensions_mod, only: GlobalUniqueCols, fv_nphys,irecons_tracer use control_mod, only: topology, partmethod use element_mod, only: element_t, allocate_element_desc @@ -166,27 +166,36 @@ subroutine prim_init1(elem, fvm, par, Tl) end if call mpi_allreduce(nelemd, nelemdmax, 1, MPI_INTEGER, MPI_MAX, par%comm, ierr) + !Allocate elements: if (nelemd > 0) then allocate(elem(nelemd)) call allocate_element_desc(elem) - if(fv_nphys > 0) then + !Allocate Qdp and derived FQ arrays: + if(fv_nphys > 0) then !SE-CSLAM do ie=1,nelemd allocate(elem(ie)%state%Qdp(np,np,nlev,thermodynamic_active_species_num,1), stat=ierr) if( ierr /= 0 ) then - call endrun('prim_init1: failed to allocate qdp array') + call endrun('prim_init1: failed to allocate Qdp array') + end if + allocate(elem(ie)%derived%FQ(np,np,nlev,thermodynamic_active_species_num), stat=ierr) + if( ierr /= 0 ) then + call endrun('prim_init1: failed to allocate fq array') + end if + end do + else !Regular SE + do ie=1,nelemd + allocate(elem(ie)%state%Qdp(np,np,nlev,qsize_d,2), stat=ierr) + if( ierr /= 0 ) then + call endrun('prim_init1: failed to allocate Qdp array') + end if + allocate(elem(ie)%derived%FQ(np,np,nlev,qsize_d), stat=ierr) + if( ierr /= 0 ) then + call endrun('prim_init1: failed to allocate fq array') end if end do end if - else + !Allocate remaining derived quantity arrays: do ie=1,nelemd - allocate(elem(ie)%state%Qdp(np,np,nlev,thermodynamic_active_species_num,2), stat=ierr) - if( ierr /= 0 ) then - call endrun('prim_init1: failed to allocate qdp array') - end if - allocate(elem(ie)%derived%FQ(np,np,nlev,thermodynamic_active_species_num), stat=ierr) - if( ierr /= 0 ) then - call endrun('prim_init1: failed to allocate fq array') - end if allocate(elem(ie)%derived%FDP(np,np,nlev), stat=ierr) if( ierr /= 0 ) then call endrun('prim_init1: failed to allocate fdp array') @@ -338,7 +347,7 @@ subroutine prim_init1(elem, fvm, par, Tl) elem(ie)%derived%FM=0.0_r8 elem(ie)%derived%FQ=0.0_r8 elem(ie)%derived%FT=0.0_r8 - elem(ie)%derived%FDP=0.0_r8 + elem(ie)%derived%FDP=0.0_r8 elem(ie)%derived%pecnd=0.0_r8 elem(ie)%derived%Omega=0 From b7893ef1de5e4e309a66c9accee718060677b86b Mon Sep 17 00:00:00 2001 From: Brian Eaton Date: Tue, 19 Mar 2024 18:31:31 -0400 Subject: [PATCH 284/291] fix to allow multiple monthly avg history files --- src/control/cam_history.F90 | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/src/control/cam_history.F90 b/src/control/cam_history.F90 index 28e1d848f2..a0b35e5a1d 100644 --- a/src/control/cam_history.F90 +++ b/src/control/cam_history.F90 @@ -5516,6 +5516,7 @@ subroutine wshist (rgnht_in) #endif integer :: yr, mon, day ! year, month, and day components of a date + integer :: yr_mid, mon_mid, day_mid ! year, month, and day components of midpoint date integer :: nstep ! current timestep number integer :: ncdate(maxsplitfiles) ! current (or midpoint) date in integer format [yyyymmdd] integer :: ncsec(maxsplitfiles) ! current (or midpoint) time of day [seconds] @@ -5529,7 +5530,6 @@ subroutine wshist (rgnht_in) logical :: prev ! Label file with previous date rather than current logical :: duplicate ! Flag for duplicate file name integer :: ierr - integer :: ncsec_temp #if ( defined BFB_CAM_SCAM_IOP ) integer :: tsec ! day component of current time integer :: dtime ! seconds component of current time @@ -5583,6 +5583,7 @@ subroutine wshist (rgnht_in) end if end if end if + time = ndcur + nscur/86400._r8 if (is_initfile(file_index=t)) then tdata = time ! Inithist file is always instantanious data @@ -5590,10 +5591,12 @@ subroutine wshist (rgnht_in) tdata(1) = beg_time(t) tdata(2) = time end if + ! Set midpoint date/datesec for accumulated file - call set_date_from_time_float((tdata(1) + tdata(2)) / 2._r8, yr, mon, day, ncsec_temp) - ncsec(accumulated_file_index) = ncsec_temp - ncdate(accumulated_file_index) = yr*10000 + mon*100 + day + call set_date_from_time_float((tdata(1) + tdata(2)) / 2._r8, & + yr_mid, mon_mid, day_mid, ncsec(accumulated_file_index) ) + ncdate(accumulated_file_index) = yr_mid*10000 + mon_mid*100 + day_mid + if (hstwr(t) .or. (restart .and. rgnht(t))) then if(masterproc) then if(is_initfile(file_index=t)) then @@ -5609,7 +5612,7 @@ subroutine wshist (rgnht_in) if (f == instantaneous_file_index) then write(iulog,200) nfils(t),'instantaneous',t,yr,mon,day,ncsec(f) else - write(iulog,200) nfils(t),'accumulated',t,yr,mon,day,ncsec(f) + write(iulog,200) nfils(t),'accumulated',t,yr_mid,mon_mid,day_mid,ncsec(f) end if 200 format('WSHIST: writing time sample ',i3,' to ', a, ' h-file ', & i1,' DATE=',i4.4,'/',i2.2,'/',i2.2,' NCSEC=',i6) From ac729892b98557f4d0b4b5eb3ab67a4adcc24dde Mon Sep 17 00:00:00 2001 From: Brian Eaton Date: Wed, 20 Mar 2024 10:21:30 -0400 Subject: [PATCH 285/291] start ChangeLog entry --- doc/ChangeLog | 52 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 52 insertions(+) diff --git a/doc/ChangeLog b/doc/ChangeLog index 676bcae485..5c229cb0e8 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,5 +1,57 @@ =============================================================== +Tag name: +Originator(s): eaton +Date: +One-line Summary: Bugfix to allow multiple monthly avg history files +Github PR URL: + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +#1000 - Output of more than 1 monthly average history file is broken. + +. resolves #1000 + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +src/control/cam_history.F90 +. subroutine wshist + - add new local variables to store the year, month, and day components of + the time interval midpoint date. + +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: + +izumi/nag/aux_cam: + +izumi/gnu/aux_cam: + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + Tag name: cam6_3_150 Originator(s): megandevlan, peverwhee Date: Feb 23, 2024 From f6cfc5acd3141f46230a0db2f231ded40daf48dd Mon Sep 17 00:00:00 2001 From: Brian Eaton Date: Thu, 21 Mar 2024 11:08:11 -0400 Subject: [PATCH 286/291] update ChangeLog --- doc/ChangeLog | 25 +++++++++++++++++++++---- 1 file changed, 21 insertions(+), 4 deletions(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index 5c229cb0e8..355c7c1133 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,10 +1,10 @@ =============================================================== -Tag name: +Tag name: cam6_3_151 Originator(s): eaton -Date: +Date: Thu 21 Mar 2024 One-line Summary: Bugfix to allow multiple monthly avg history files -Github PR URL: +Github PR URL: https://github.com/ESCOMP/CAM/pull/1003 Purpose of changes (include the issue number and title text for each relevant GitHub issue): @@ -20,7 +20,7 @@ List any changes to the defaults for the boundary datasets: none Describe any substantial timing or memory changes: none -Code reviewed by: +Code reviewed by: cacraigucar, peverwhee List all files eliminated: none @@ -38,11 +38,28 @@ 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. +All tests have a MEMCOMP failure which we are ignoring. +Several tests have a TPUTCOMP failure which we are also ignoring. + derecho/intel/aux_cam: + ERP_Ln9.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 (Overall: FAIL) details: + ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: FAIL) details: + SMS_Lh12.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h (Overall: DIFF) details: + - pre-existing failures izumi/nag/aux_cam: + DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure izumi/gnu/aux_cam: + All PASS. + +TESTING NOTE: None of our regression tests use multiple monthly output +files. The fix was tested in a low res FHS94 compset that specified +monthly output for h0, h1, h2, and h3. The 'T' field was output in each +file. A 1 month test was run and all files had identical output. This is +the same configuration that I used to debug the problem. CAM tag used for the baseline comparison tests if different than previous tag: From b20161cdda768b3d18f631ebb6333d00c45e2fc6 Mon Sep 17 00:00:00 2001 From: Cheryl Craig Date: Thu, 21 Mar 2024 10:46:31 -0600 Subject: [PATCH 287/291] Fix typo --- cime_config/buildnml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cime_config/buildnml b/cime_config/buildnml index 707d830d2d..97563bf59a 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -173,7 +173,7 @@ def buildnml(case, caseroot, compname): buildnl_opts += ["-inputdata", input_data_list] - CAM_NAMELIST_OPTS += " stream_ndep_year_first=" + stream_ndep_year_first + CAM_NAMELIST_OPTS += " stream_ndep_year_first=" + stream_ndep_year_first CAM_NAMELIST_OPTS += " stream_ndep_year_last=" + stream_ndep_year_last CAM_NAMELIST_OPTS += " stream_ndep_year_align=" + stream_ndep_year_align CAM_NAMELIST_OPTS += " stream_ndep_data_filename='" + stream_ndep_data_filename.strip() + "'" @@ -217,7 +217,7 @@ def buildnml(case, caseroot, compname): # ----------------------------------------------------- if os.path.isdir(rundir) \ - and os.path.exists(os.path.join(caseroot, "species_database.yaml"))\ + and os.path.exists(os.path.join(caseroot, "species_database.yml"))\ and '-chem geoschem' in CAM_CONFIG_OPTS: for fname in ['species_database.yml', 'geoschem_config.yml', 'HISTORY.rc', 'HEMCO_Config.rc', 'HEMCO_Diagn.rc']: From c4dc644eb743391f84b82f957af61099694bd0b8 Mon Sep 17 00:00:00 2001 From: PeterHjortLauritzen Date: Thu, 21 Mar 2024 15:24:23 -0600 Subject: [PATCH 288/291] fix bug on sponge settings for WACCM --- src/dynamics/se/dycore/global_norms_mod.F90 | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/src/dynamics/se/dycore/global_norms_mod.F90 b/src/dynamics/se/dycore/global_norms_mod.F90 index 1b052e60af..5290017c8e 100644 --- a/src/dynamics/se/dycore/global_norms_mod.F90 +++ b/src/dynamics/se/dycore/global_norms_mod.F90 @@ -603,26 +603,31 @@ subroutine print_cfl(elem,hybrid,nets,nete,dtnu,ptop,pmid,& ! low top; usually idealized test cases ! top_000_032km = .true. + if (hybrid%masterthread) write(iulog,* )"Model top damping configuration: top_000_032km" else if (ptop>100.0_r8) then ! ! CAM6 top (~225 Pa) or CAM7 low top ! top_032_042km = .true. + if (hybrid%masterthread) write(iulog,* )"Model top damping configuration: top_032_042km" else if (ptop>1e-1_r8) then ! ! CAM7 top (~4.35e-1 Pa) ! top_042_090km = .true. + if (hybrid%masterthread) write(iulog,* )"Model top damping configuration: top_042_090km" else if (ptop>1E-4_r8) then ! ! WACCM top (~4.5e-4 Pa) ! top_090_140km = .true. + if (hybrid%masterthread) write(iulog,* )"Model top damping configuration: top_090_140km" else ! ! WACCM-x - geospace (~4e-7 Pa) ! top_140_600km = .true. + if (hybrid%masterthread) write(iulog,* )"Model top damping configuration: top_140_600km" end if ! ! Logging text for sponge layer configuration @@ -634,14 +639,14 @@ subroutine print_cfl(elem,hybrid,nets,nete,dtnu,ptop,pmid,& ! ! if user or namelist is not specifying sponge del4 settings here are best guesses (empirically determined) ! - if (sponge_del4_lev <0) sponge_del4_lev = 1 - if (sponge_del4_nu_fac <0) sponge_del4_nu_fac = 1.0_r8 - if (sponge_del4_nu_div_fac<0) sponge_del4_nu_div_fac = 1.0_r8 - if (top_090_140km.or.top_140_600km) then ! defaults for waccm(x) if (sponge_del4_lev <0) sponge_del4_lev = 20 if (sponge_del4_nu_fac <0) sponge_del4_nu_fac = 5.0_r8 if (sponge_del4_nu_div_fac<0) sponge_del4_nu_div_fac = 10.0_r8 + else + if (sponge_del4_lev <0) sponge_del4_lev = 1 + if (sponge_del4_nu_fac <0) sponge_del4_nu_fac = 1.0_r8 + if (sponge_del4_nu_div_fac<0) sponge_del4_nu_div_fac = 1.0_r8 end if ! set max wind speed for diagnostics From b4102ae46d48386f55e08e82c42f4b9782513e0e Mon Sep 17 00:00:00 2001 From: Cheryl Craig Date: Fri, 22 Mar 2024 15:10:02 -0600 Subject: [PATCH 289/291] add one more location for setting of dust_emis_fact with SE dycore --- bld/namelist_files/namelist_defaults_cam.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/bld/namelist_files/namelist_defaults_cam.xml b/bld/namelist_files/namelist_defaults_cam.xml index 69ac654b86..953631b9e2 100644 --- a/bld/namelist_files/namelist_defaults_cam.xml +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -2481,7 +2481,7 @@ 0.55D0 0.22D0 0.70D0 -0.80D0 +1.30D0 0.8D0 0.8D0 0.8D0 From 919cce51adcebf61eba635c2aeaaa61a42ce590b Mon Sep 17 00:00:00 2001 From: Jesse Nusbaumer Date: Fri, 22 Mar 2024 15:14:27 -0600 Subject: [PATCH 290/291] Update FADIAB test to use ne5pg3 grid, and finalize ChangeLog. --- cime_config/testdefs/testlist_cam.xml | 2 +- doc/ChangeLog | 83 +++++++++++++++++++++++++-- 2 files changed, 78 insertions(+), 7 deletions(-) diff --git a/cime_config/testdefs/testlist_cam.xml b/cime_config/testdefs/testlist_cam.xml index 0061d5c9ce..7cd5767648 100644 --- a/cime_config/testdefs/testlist_cam.xml +++ b/cime_config/testdefs/testlist_cam.xml @@ -984,7 +984,7 @@ - + diff --git a/doc/ChangeLog b/doc/ChangeLog index 794d003aec..72e73c6a79 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,5 +1,5 @@ =============================================================== -Tag name: cam6_3_xxx +Tag name: cam6_3_152 Originator(s): pel Date: Jan 30, 2024 One-line Summary: "science optimization" for SE-CSLAM and stabilize WACCM @@ -45,6 +45,7 @@ Describe any substantial timing or memory changes: - approximately 30% speed-up of entire CAM model using COMPSET FLTHIST or FMTHIST +Code reviewed by: nusbaume, fvitt List all existing files that have been modified, and describe the changes: @@ -61,6 +62,9 @@ M cime_config/buildlib M cime_config/buildnml - remove deprecated "imp" python module +M cime_config/testdefs/testlist_cam.xml + - replace ne5pg4 FADIAB test with ne5pg3 test + M src/dynamics/se/dp_coupling.F90 M src/dynamics/se/dycore/control_mod.F90 M src/dynamics/se/dycore/fvm_control_volume_mod.F90 @@ -87,11 +91,78 @@ 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. - All spectral-element tests fail due to baseline differences. - The SE-CSLAM tests fail because of no double-advection - change as well as default hyperviscosity change - The SE (not CSLAM) tests fail because default hyperviscosity has changed - All WACCM tests fail due to added sponge layer vertical diffusion +derecho/intel/aux_cam: + ERP_Ln9.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 (Overall: PEND) + ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) + SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: FAIL) + - pre-existing failures + + ERC_D_Ln9.ne16_ne16_mg17.FADIAB.derecho_intel.cam-terminator (Overall: DIFF) + ERC_D_Ln9.ne16_ne16_mg17.QPC5HIST.derecho_intel.cam-outfrq3s_usecase (Overall: DIFF) + ERC_D_Ln9_P144x1.ne16pg3_ne16pg3_mg17.QPC6HIST.derecho_intel.cam-outfrq3s_ttrac_usecase (Overall: DIFF) + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.F2000dev.derecho_intel.cam-outfrq9s (Overall: DIFF) + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) + ERP_Ln9.ne30_ne30_mg17.FCnudged.derecho_intel.cam-outfrq9s (Overall: DIFF) + ERP_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) + ERS_Ln9.ne0TESTONLYne5x4_ne0TESTONLYne5x4_mg37.FADIAB.derecho_intel.cam-outfrq3s_refined (Overall: DIFF) + SMS_D_Ln9.ne16_ne16_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) + SMS_D_Ln9.ne16_ne16_mg17.QPX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) + SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) + SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) + SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) + SMS_D_Ln9_P1280x1.ne30pg3_ne30pg3_mg17.FCLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) + SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s (Overall: DIFF) + SMS_Ld1.ne30pg3_ne30pg3_mg17.FC2010climo.derecho_intel.cam-outfrq1d (Overall: DIFF) + SMS_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) + - expected answer changes + +izumi/nag/aux_cam: + DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) + - pre-existing failure + + ERC_D_Ln9.ne16_ne16_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) + ERC_D_Ln9.ne16pg3_ne16pg3_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) + ERC_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac (Overall: DIFF) + ERI_D_Ln18.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic (Overall: DIFF) + ERI_D_Ln18.ne5pg3_ne5pg3_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic (Overall: DIFF) + ERP_Ln9.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) + ERS_Ln27.ne5pg3_ne5pg3_mg37.FKESSLER.izumi_nag.cam-outfrq9s (Overall: DIFF) + ERS_Ln9.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq9s (Overall: DIFF) + PEM_D_Ln9.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s (Overall: DIFF) + PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: DIFF) + PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: DIFF) + PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: DIFF) + SMS_D_Ln3.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s (Overall: DIFF) + SMS_D_Ln6.ne5_ne5_mg37.QPWmaC4.izumi_nag.cam-outfrq3s_physgrid_tem (Overall: DIFF) + SMS_D_Ln9_P1x1.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s (Overall: DIFF) + - expected answer changes + +izumi/gnu/aux_cam: + + ERC_D_Ln9.ne5_ne5_mg37.QPC4.izumi_gnu.cam-outfrq3s_nudging_ne5_L26 (Overall: DIFF) + ERC_D_Ln9.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq3s_ba (Overall: DIFF) + ERC_D_Ln9.ne5pg2_ne5pg2_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: DIFF) + ERC_D_Ln9.ne5pg3_ne5pg3_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: DIFF) + ERP_D_Ln9.ne3pg3_ne3pg3_mg37.QPC6.izumi_gnu.cam-outfrq9s_rrtmgp (Overall: DIFF) + ERP_Ln9.ne5_ne5_mg37.FHS94.izumi_gnu.cam-outfrq9s (Overall: DIFF) + ERP_Ln9.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq9s (Overall: DIFF) + PEM_D_Ln9.ne5pg3_ne5pg3_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: DIFF) + PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal0 (Overall: DIFF) + PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal1 (Overall: DIFF) + PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal3 (Overall: DIFF) + SMS_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-outfrq3s_ttrac (Overall: DIFF) + - expected answer changes + +Summarize any changes to answers: +All spectral-element tests fail due to baseline differences. + + The SE-CSLAM tests fail because of no double-advection + change as well as default hyperviscosity change + The SE (not CSLAM) tests fail because default + hyperviscosity has changed + All WACCM tests fail due to added sponge layer + vertical diffusion =============================================================== =============================================================== From d2fe0de2bcabec10f4a0331199762ea014900185 Mon Sep 17 00:00:00 2001 From: Cheryl Craig Date: Tue, 26 Mar 2024 11:25:02 -0600 Subject: [PATCH 291/291] Update ChangeLog for cam6_3_153 --- doc/ChangeLog | 80 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 80 insertions(+) diff --git a/doc/ChangeLog b/doc/ChangeLog index 72e73c6a79..4639654c45 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,3 +1,83 @@ + +=============================================================== + +Tag name: cam6_3_153 +Originator(s): cacraig, hannay, jedwards, lizziel +Date: March 26, 2023 +One-line Summary: Update namelist settings +Github PR URL: https://github.com/ESCOMP/CAM/pull/981 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Bring in namelist settings which Cecile is using for current testing: https://github.com/ESCOMP/CAM/issues/976 + - Remove README_EXTERNALS: https://github.com/ESCOMP/CAM/issues/954 + - fix so that all three flavors of intel compiler are recognized: https://github.com/ESCOMP/CAM/pull/990 + - CAM no longer builds with intel-oneapi compilers: https://github.com/ESCOMP/CAM/issues/988 + - GEOS-Chem compsets will fail due to bugs in CAM and CIME: https://github.com/ESCOMP/CAM/issues/1004 + - This fixes the CAM bug. The CIME bug will be addressed the next time externals are updated. + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: Just change default namelist settings as described below + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: nusbaume, adamher + +List all files eliminated: +D README_EXTERNALS + - Remove obsolete file (discussed svn externals, which is no longer used) + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: +M bld/configure + - Fix from Jim to support selecting various intel compilers + +M bld/namelist_files/namelist_defaults_cam.xml + - Change namelist settings to mimic Cecile's settings for cam_dev runs + +M cime_config/buildnml + - Fix typo which prevented GEOS-Chem from finding yml file + + +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: all BFB except: + + + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.F2000dev.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F2000dev.derecho_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERS_Ld3.f10_f10_mg37.F1850.derecho_intel.cam-outfrq1d_14dec_ghg_cam_dev (Overall: DIFF) details: + SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_P1280x1.ne30pg3_ne30pg3_mg17.FCLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_Ld1.f19_f19.F2000dev.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Lh12.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h (Overall: DIFF) details: + - Namelist and baseline differences for all cam_dev runs + + + ERP_Ln9.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 (Overall: PEND) details: + ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + - pre-existing failures + + SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: FAIL) details: + - Current failure, but should be fixed when cime external is next updated + +izumi/nag/aux_cam: all BFB except + DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure + +izumi/gnu/aux_cam: all BFB except: + SMS_D_Ln9.f10_f10_mg37.2000_CAM%DEV%GHGMAM4_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV_SESP.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + - Namelist and baseline differences for all cam_dev runs + +=============================================================== =============================================================== Tag name: cam6_3_152 Originator(s): pel