From 42ee097a09a778a3cda4f30464fa6aee45872341 Mon Sep 17 00:00:00 2001 From: Anne Fouilloux Date: Wed, 5 Feb 2020 19:47:11 +0100 Subject: [PATCH] remove unecessary orig files --- bld/config_files/definition.xml.orig | 316 - bld/configure.orig | 3681 -------- .../namelist_defaults_cam.xml.orig | 1965 ----- .../namelist_definition.xml.orig | 7824 ----------------- cime_config/config_component.xml.orig | 361 - cime_config/config_compsets.xml.orig | 696 -- .../mozart/mo_gas_phase_chemdr.F90.orig | 1175 --- src/chemistry/mozart/mo_waccm_hrates.F90.orig | 461 - .../oslo_aero/mo_gas_phase_chemdr.F90.orig | 1190 --- src/control/cam_history.F90.orig | 5923 ------------- src/dynamics/fv/cd_core.F90.orig | 1967 ----- src/dynamics/fv/ctem.F90.orig | 606 -- src/dynamics/fv/tp_core.F90.orig | 2610 ------ src/physics/cam/cam_diagnostics.F90.orig | 2233 ----- src/physics/cam/check_energy.F90.orig | 976 -- src/physics/cam/micro_mg2_0.F90.orig | 3177 ------- src/physics/cam/phys_control.F90.orig | 403 - src/physics/cam/physics_types.F90.orig | 1943 ---- src/physics/cam/physpkg.F90.orig | 2397 ----- src/physics/camrt/radiation.F90.orig | 1339 --- src/physics/rrtmg/radiation.F90.orig | 1426 --- src/utils/orbit.F90.orig | 56 - 22 files changed, 42725 deletions(-) delete mode 100644 bld/config_files/definition.xml.orig delete mode 100755 bld/configure.orig delete mode 100644 bld/namelist_files/namelist_defaults_cam.xml.orig delete mode 100644 bld/namelist_files/namelist_definition.xml.orig delete mode 100644 cime_config/config_component.xml.orig delete mode 100644 cime_config/config_compsets.xml.orig delete mode 100644 src/chemistry/mozart/mo_gas_phase_chemdr.F90.orig delete mode 100644 src/chemistry/mozart/mo_waccm_hrates.F90.orig delete mode 100644 src/chemistry/oslo_aero/mo_gas_phase_chemdr.F90.orig delete mode 100644 src/control/cam_history.F90.orig delete mode 100644 src/dynamics/fv/cd_core.F90.orig delete mode 100644 src/dynamics/fv/ctem.F90.orig delete mode 100644 src/dynamics/fv/tp_core.F90.orig delete mode 100644 src/physics/cam/cam_diagnostics.F90.orig delete mode 100644 src/physics/cam/check_energy.F90.orig delete mode 100644 src/physics/cam/micro_mg2_0.F90.orig delete mode 100644 src/physics/cam/phys_control.F90.orig delete mode 100644 src/physics/cam/physics_types.F90.orig delete mode 100644 src/physics/cam/physpkg.F90.orig delete mode 100644 src/physics/camrt/radiation.F90.orig delete mode 100644 src/physics/rrtmg/radiation.F90.orig delete mode 100644 src/utils/orbit.F90.orig diff --git a/bld/config_files/definition.xml.orig b/bld/config_files/definition.xml.orig deleted file mode 100644 index 9b373aed22..0000000000 --- a/bld/config_files/definition.xml.orig +++ /dev/null @@ -1,316 +0,0 @@ - - - - - - - -CAM build directory; contains .o and .mod files. - - -Directory where CAM executable will be created. - - -Root directory of CAM source distribution. - - -User source directories to prepend to the filepath. Multiple directories -are specified as a comma separated list with no embedded white space. - - -Switch specifies whether CAM is being built by the CCSM sequential scripts. 0 => no, 1 => yes. - - -Component interfaces: mct or esmf. Default: mct. - - -Dynamics package: eul, fv, or se. - - -Switch to turn on waccm physics: 0 => no, 1 => yes. - - -Switch to turn on FV offline driver: 0 => no, 1 => yes. - - - Offline unit driver: - aur : aurora module unit test - rad : radiation offline unit driver - stub : stub offline unit driver - - -Switch to turn on analytic initial conditions for the dynamics state: - 0 => no - 1 => yes. - - -Option to turn on waccmx thermosphere/ionosphere extension: 0 => no, 1 => yes - - -Ionosphere model used in WACCMX. - - -Physics package: cam3, cam4, cam5, cam6, held_suarez, adiabatic, kessler, tj2016, spcam_sam1mom, spcam_m2005. - - -Microphysics package: rk (Rasch and Kristjansson), mg1 and mg2 (Morrison and Gettelman), -SPCAM_m2005, SPCAM_sam1mom. - - -Macrophysics package: RK, Park, CLUBB_SGS, SPCAM_sam1mom, SPCAM_m2005. - - -Switch to turn on CLUBB_SGS package: 0 => no, 1 => yes - - -Switch to turn on UNICON package: 0 => off, 1 => on - - -Switch to turn on/off advecting CLUBB moments: 0 => no, 1 => yes - - -Switch to turn on/off parameterization for sub-grid scale convective organization for the ZM deep convective scheme based -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). - - -CARMA sectional microphysics: -none (disabled), bc_strat (Stratospheric Black Carbon), cirrus (Cirrus Clouds), -cirrus_dust (Cirrus Clouds with dust), dust (Dust), meteor_impact (Meteor Impact), -meteor_smoke (Meteor Smoke), mixed_sulfate (Meteor Smoke and Sulfate), pmc (Polar Mesospheric Clouds), pmc_sulfate (PMC and Sulfate), sea_salt (Sea Salt), -sulfate (Sulfate Aerosols), tholin (early earth haze), test_detrain (Detrainment), test_growth (Particle Growth), test_passive (Passive Dust), -test_radiative (Radiatively Active Dust), test_swelling (Sea Salt), test_tracers (Asian Monsoon), test_tracers2 (Guam). - -<<<<<<< HEAD - -Chemistry package: trop_mam3 trop_mam4 trop_mam7 trop_mozart trop_strat_mam4_vbs trop_bam trop_ghg waccm_ma waccm_mad_mam4 waccm_ma_mam4 waccm_ma_sulfur waccm_sc waccm_sc_mam4 waccm_tsmlt waccm_tsmlt_mam4 waccm_tsmlt_sulfur super_fast_llnl super_fast_llnl_mam3 terminator trop_mam_oslo 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 none ->>>>>>> origin/featureCESMNCARBeta_trunk2.0-7 - - -Prognostic mozart species packages: list of any subset of the following: DST,SSLT,SO4,GHG,OC,BC,CARBON16 - - -Switch to allow user to edit chem mechanism file: 0 => no, 1 => yes. - - -Path and file name of the user supplied chemistry mechanism file. - - -Switch to force the build of the chemistry preprocessor. - - -Chemistry preprocessor build directory; contains .o and .mod files. - - -Chemistry source directory generated by the chemistry preprocessor; contains F90 files. - - -Chemistry source directory; contains F90 files. - - -Use data ocean model (docn or dom), stub ocean (socn), or aqua planet ocean -(aquaplanet) in cam build. When built from the CESM scripts the value of -ocn may be set to pop. This doesn't impact how CAM is built, only how -attributes are matched when searching for namelist defaults. If ocn is set -to som then the docn component is used. - - -Switch for aquaplanet mode. By default this switch sets the ocn component -to use an analytic expression for SST. To use aquaplanet with time varying -SSTs read from a dataset, or with a slab ocean, the ocean component should -be set to DOCN. - - -Turn on CO2 cycle in biogeochemistry model: 0 => no, 1 => yes. - - -Modifications that allow perturbation growth testing: 0=off, 1=on. - - -Configure CAM for single column mode: 0=off, 1=on. This option only -supported for the Eulerian dycore. - - -Configure CAM to generate an IOP file that can be used to drive SCAM: 0=no, 1=yes. -This option only supported for the Eulerian dycore. - - -Horizontal grid specifier. The recognized values depend on -the dynamics type and are contained in the horiz_grid.xml file. - - -Number of unique longitude points in rectangular lat/lon grid. - - -Number of unique latitude points in rectangular lat/lon grid. - - -Number of elements along one edge of a cubed sphere grid. - - -Number of points on each edge of the elements in a cubed sphere grid. - - -Number of physics grid cells on each edge of the elements in a cubed sphere grid. - - -Number of vertical levels. - - -Total number of advected constituents. By default this is computed by -configure. However, configure has a commandline argument to allow the user -to override the default. - - -Total number of advected test tracers. - - -Switch on (off) age of air tracers: 0=off, 1=on. - - -Maximum number of constituents that are radiatively active or in any one -diagnostic list. - - -Maximum Fourier wavenumber. - - -Highest degree of the Legendre polynomials for m=0. - - -Highest degree of the associated Legendre polynomials. - - -Maximum number of columns in a chunk (physics data structure). - - -Maximum number of sub-columns in a column (physics data structure). - - -Name of CAM executable. - - -User specified CPP defines to append to Makefile defaults. - - -User specified C compiler overrides Makefile default (linux only). - - -User specified C compiler options to append to Makefile defaults. - - -User specified Fortran compiler overrides Makefile default. - - -Type of Fortran compiler. Used when -fc specifies a generic wrapper script -such as mpif90 or ftn. - - -Switch to enable debugging options for Fortran compiler: 0=off, 1=on. - - -User specified Fortran compiler flags to append to Makefile defaults. - - -User specified Fortran optimization flags to override Makefile defaults. - - -User specified linker. Overrides the Makefile default $(FC). - - -User specified load options to append to Makefile defaults. - - -Switch to enable or disable building SPMD version of CAM: 0=off, 1=on. - - -Switch to enable or disable building SMP version (OPENMP) of CAM: 0=off, 1=on. - - -Directory containing NetCDF include files. - - -Directory containing NetCDF library. - - -Arguments for linking NetCDF libraries. - - -Directory containing NetCDF module files. - - -Directory containing pNetCDF include files. - - -Directory containing pNetCDF library. - - -Directory containing LAPACK library. - - -Directory containing ESMF library (for linking to external ESMF). - - -Version of ESMF library. - - -Directory containing MCT library (for linking to external MCT). - - -Directory containing MPI include files. - - -Directory containing MPI library. - - -Name of MPI library. - - -Directory where PIO will be built (pio2 only). - - -Directory containing PIO libraries and include files (pio2 only). - - -Switch to enable building COSP simulator package. 1 => build COSP. - - -Directory containing COSP library. - - -OS for which CAM is being built. The default value is the name contained -in Perl's $OSNAME variable. This parameter allows the user to override -that setting to allow for cross-compilation, and for instances where the -$OSNAME value is too generic. For example, currently on both cray-xt and -bluegene systems $OSNAME has the value "linux". - - -Switch to turn on SPCAM version of CLUBB_SGS package: 0 => no, 1 => yes - - -SPCAM number of grid points in x - - -SPCAM number of grid points in y - - -SPCAM number of grid points in z - - -SPCAM horizontal grid spacing, m - - -SPCAM time step, s - - - diff --git a/bld/configure.orig b/bld/configure.orig deleted file mode 100755 index cdcf59b1c1..0000000000 --- a/bld/configure.orig +++ /dev/null @@ -1,3681 +0,0 @@ -#!/usr/bin/env perl -#----------------------------------------------------------------------------------------------- -# -# configure -# -# -# This utility allows the CAM user to specify compile-time configuration -# options via a commandline interface. The output from configure is a -# Makefile and a cache file that contains all configuration parameters -# required to produce the Makefile. A subsequent invocation of configure -# can use the cache file as input (via the -defaults argument) to reproduce -# the CAM configuration contained in it. Note that when a cache file is -# used to set default values only the model parameters are used. The -# parameters that are platform dependent (e.g., compiler options, library -# locations, etc) are ignored. -# -# As the build time configurable options of CAM are changed, this script -# must also be changed. Thus configure is maintained under revision -# control in the CAM source tree and it is assumed that only the version of -# configure in the source tree will be used to build CAM. Thus we assume -# that the root of the source tree can be derived from the location of this -# script. -# -# configure has an optional test mode to check that the Fortran90 compiler -# works and that external references to the netCDF and MPI libraries can be -# resolved at link time. -# -# -# Date Contributor Modification -# ----------------------------------------------------------------------------------------------------- -# 2012-09-10 Fischer Use MCT configure script, and build as seperate library. -# 2011-08-18 Eaton Produce a config.h file needed by the latest PIO and MCT source. -# -# 2011-08-05 Fischer Set number of instances when running cam stand alone. Otherwise use -# values set by CESM1 scripts. -# -# 2010-01-22 Kay, Eaton Added COSP simulator option. -# -# 2008-09-22 Edwards Removed obsolete macros DYN_STATE_INTERFACE and LSMLON, LSMLAT -# -# 2008-08-26 Edwards Added support for external pnetcdf library (-pnc_inc and -pnc_lib) as -# well as PIO support for Spectral Element dycore -# -# 2008-07-30 Eaton Revise the default calculation of nadv. Add new option to specify -# the number of test tracers. Add new option to specify a non-default -# microphysics option. -# -# 2007-04-13 Eaton Restore the commandline option -phys so that it can be used with the -# adiabatic and held_suarez physics options. -# -# 2007-03-04 Eaton The script has been refactored to move the generic configuration file -# functionality into a separate module (Build::Config). -# -# 2006-09-14 Eaton Add support for linking to external ESMF library. -# Deprecate interactive mode. -# -# 2006-02-14 Eaton Remove -cam_cfg option and CAM_CFGDIR environment variable: require all -# configuration files to be in the same directory as the configure script. -# Remove -cam_root option and CAM_ROOT environment variable: require -# configure to be located in the CAM src tree. -# Modifications for CCSM build: delete setting of locations for all -# external include/mod/lib directories. These are only needed for the -# CAM Makefile which is not produced when doing a CCSM build. -# Remove -esmf_* options. This was used with the ESMF prototype -# library which is no longer supported. Will re-implement ESMF options -# when we start linking the new ESMF library. -# -# 2005-05-05 Eaton Add -lapack_libdir option to specify directory that contains -# lapack and blas libraries. Can also set LAPACK_LIBDIR environment -# variable. Currently only used by waccm_mozart on IBM. -# -# 2004-12-01 Eaton Add phys option waccm. Because this must be consistent -# with the -chem option, remove commandline option -phys. -# phys="waccm" is needed so that WACCM specific initial files -# can be present in DefaultCAMEXPNamelist.xml. -# -# 2004-11-15 Eaton Add -chem options waccm_ghg or waccm_mozart. Remove old code -# for ccm366 and lsm options. -# -# 2002-05-03 Brian Eaton Original version -#----------------------------------------------------------------------------------------------- - -use strict; -#use warnings; -#use diagnostics; - -use Cwd; -use English; -use Getopt::Long; -use IO::File; -use IO::Handle; - -use FindBin qw($Bin); -use lib "$Bin/perl5lib"; -use Build::ChemPreprocess qw(chem_preprocess chem_number_adv); -use File::Copy; - -#----------------------------------------------------------------------------------------------- - -sub usage { - die <). Any value that contains - white-space must be quoted. Long option names may be supplied with either single - or double leading dashes. A consequence of this is that single letter options may - NOT be bundled. - - Options used to determine the CAM model configuration. These options will have an - effect whether running CAM as part of CCSM or running in a CAM standalone mode: - - -[no]age_of_air_trcs Switch on [off] age of air tracers. Default: on for waccm_phys, otherwise off. - -analytic_ic Enables the (namelist controlled) dycore testing infrastructure - -aquaplanet Switch on aqua-planet mode. - -build_chem_proc Switch forces the build of the chemistry preprocessor (primarily for testing). - -carma Build CAM with specified CARMA microphysics model - [ none | bc_strat | cirrus | cirrus_dust | dust | meteor_impact | - meteor_smoke | mixed_sulfate | pmc | pmc_sulfate | sea_salt | sulfate | tholin | - test_detrain | test_growth | test_passive | test_radiative | test_swelling | - test_tracers, test_tracers2]. - Default: none. - -chem Build CAM with specified prognostic chemistry package -<<<<<<< HEAD - [ trop_mam3 | trop_mam4 | trop_mam7 | trop_mozart | trop_strat_mam4_vbs | - trop_bam | trop_ghg | waccm_ma | waccm_mad_mam4 | waccm_ma_mam4 | - waccm_ma_sulfur | waccm_sc | waccm_sc_mam4 | waccm_tsmlt | waccm_tsmlt_mam4 | - waccm_tsmlt_sulfur | super_fast_llnl | super_fast_llnl_mam3 | terminator | trop_mam_oslo | none ]. -======= - [ 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 ]. ->>>>>>> origin/featureCESMNCARBeta_trunk2.0-7 - Default: trop_mam4 for cam6 and trop_mam3 for cam5. - -[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) - -co2_cycle This option is meant to be used with the -ccsm_seq option. It modifies the - CAM configuration by increasing the number of advected constituents by 4. - -cosp Enable the COSP simulator. - -cppdefs A string of user specified CPP defines. Appended to - 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 - -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 - se grids. - -ionosphere Ionophere module used in WACCMX [ none | wxi | wxie ]. - -macrophys Specify the macrophysics option [rk | park | clubb_sgs]. - -max_n_rad_cnst Maximum number of constituents that are either radiatively - active, or in any single diagnostic list for the radiation. - -microphys Specify the microphysics option [mg1 | mg2 | rk]. - -nadv Set total number of advected species to . - -nadv_tt Set number of advected test tracers . - -nlev Set number of levels to . - -offline_dyn Switch enables the use of offline driver for FV dycore. - -pbl Specify the PBL option [uw | hb | hbr]. - -pcols Set maximum number of columns in a chunk to . - -pergro Switch enables building CAM for perturbation growth tests. - -phys Physics option [cam3 | cam4 | cam5 | cam6 | - held_suarez | adiabatic | kessler | tj2016 | - spcam_sam1mom | spcam_m2005]. Default: cam6 - -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] - -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) - -spcam_ny SPCAM y-grid. - defaults to 1 - -spcam_dx SPCAM horizontal grid spacing. - -spcam_dt SPCAM timestep. - -unicon Switch to turn on the UNICON scheme. Default: off. - -usr_mech_infile Path and file name of the user supplied chemistry mechanism file. - -waccm_phys Switch enables the use of WACCM physics in any chemistry configuration. - The user does not need to set this if one of the waccm chemistry options - is chosen. - -waccmx Build CAM/WACCM with WACCM upper Thermosphere/Ionosphere extended package - -zmconv_org Include parameterization for sub-grid scale convective organization for the ZM deep convective scheme based - on Mapes and Neale (2011) - - - Options relevent to SCAM mode: - - -camiop Configure CAM to generate an IOP file that can be used to drive SCAM. - This switch only works with the Eulerian dycore. - -scam Compiles model in single column mode. Only works with Eulerian dycore. - - CAM parallelization: - - -[no]smp Switch on [off] SMP parallelism. - -[no]spmd Switch on [off] SPMD parallelism. - - Configure options: - - -cache Name of output cache file (default: config_cache.xml). - -cachedir Name of directory where output cache file is written (default: CAM build directory). - -ccsm_seq Switch to specify that CAM is being built from within sequential CCSM scripts. - -help [or -h] Print usage to STDOUT. - -silent [or -s] Turns on silent mode - only fatal messages issued. - -test Switch on testing of Fortran compiler and external libraries. - -verbose [or -v] Turn on verbose echoing of settings made by configure. - -version Echo the CVS tag name used to check out this CAM distribution. - - Options for surface components used in standalone CAM mode: - - -ocn Build CAM with ocean model [docn | dom | som | socn | aquaplanet | pop]. Default: aquaplanet - - Options for building CAM via standalone scripts: - - -cam_bld Directory where CAM will be built. This is where configure will write the - output files it generates (Makefile, Filepath, etc...) - -cam_exe Name of the CAM executable (default: cam). - -cam_exedir Directory where CAM executable will be created (default: CAM build directory). - -cc User specified C compiler (linux only). Overrides Makefile default. - -cflags A string of user specified C compiler options. Appended to - Makefile defaults. - -debug Switch to turn on building CAM with debugging compiler options. - -cosp_libdir Directory containing COSP library. - -esmf_libdir Directory containing ESMF library and esmf.mk file. - -fc User specified Fortran compiler. Overrides Makefile default. - -fc_type Type of Fortran compiler [pgi | intel | gnu | pathscale - | ibm | nag]. This argument is used in conjunction - with the -fc argument when the name of the fortran - compiler refers to a wrapper script (e.g., mpif90 - or ftn). In this case the user needs to specify - the type of Fortran compiler that is being invoked - by the wrapper script. Default: pgi - -fflags A string of user specified Fortran compiler flags. Appended to - Makefile defaults. See -fopt to override optimization flags. - -fopt A string of user specified Fortran compiler optimization flags. - Overrides Makefile defaults. - -gmake Name of the GNU make program on your system. Supply the absolute - pathname if the program is not in your path (or fix your path). - -lapack_libdir - Directory containing LAPACK library. - -ldflags A string of user specified load options. Appended to - Makefile defaults. - -linker User specified linker. Overrides Makefile default of \$(FC). - -mct_libdir Directory containing MCT library. Default: build the library from source - in a subdirectory of \$cam_bld. - -mpi_inc Directory containing MPI include files. - -mpi_lib Directory containing MPI library. - -nc_inc Directory containing netCDF include files. - -nc_lib Directory containing netCDF library. - -nc_mod Directory containing netCDF module files. - -pio2 Switch to turn on building PIO2. PIO2 is built as a separate library. - Default: Use PIO1 and build as part of cam executable. - -pio2_install_dir Directory to install PIO2 libraries and include files. If the libraries - already exist then configure will use them in the build. - -pnc_inc Directory containing PnetCDF include files. - -pnc_lib Directory containing PnetCDF library. - -target_os Override the os setting for cross platform compilation [aix | darwin | dec_osf | - irix | linux | solaris | super-ux | unicosmp | bgl | bgp | bgq]. - Default: OS on which configure is executing as defined by the - perl \$OSNAME variable. - -usr_src [,[,[...]]] - Directories containing user source code. - -offline_drv Specify offline unit driver [ aur | rad | stub ] - -EOF -} - -#----------------------------------------------------------------------------------------------- -# Setting autoflush (an IO::Handle method) on STDOUT helps in debugging. It forces the test -# descriptions to be printed to STDOUT before the error messages start. - -*STDOUT->autoflush(); - -#----------------------------------------------------------------------------------------------- -# Set the directory that contains the CAM configuration scripts. If the configure command was -# issued using a relative or absolute path, that path is in $ProgDir. Otherwise assume the -# command was issued from the current working directory. - -(my $ProgName = $0) =~ s!(.*)/!!; # name of this script -my $ProgDir = $1; # name of directory containing this script -- may be a - # relative or absolute path, or null if the script is in - # the user's PATH -my $cwd = getcwd(); # current working directory -my $cfgdir; # absolute pathname of directory that contains this script -if ($ProgDir) { - $cfgdir = absolute_path($ProgDir); -} else { - $cfgdir = $cwd; -} - -#----------------------------------------------------------------------------------------------- -# Save commandline -my $commandline = "$cfgdir/configure @ARGV"; - -#----------------------------------------------------------------------------------------------- -# Parse command-line options. -my %opts = ( - cache => "config_cache.xml", - ); -GetOptions( - "age_of_air_trcs!" => \$opts{'age_of_air_trcs'}, - "analytic_ic" => \$opts{'analytic_ic'}, - "aquaplanet" => \$opts{'aquaplanet'}, - "build_chem_proc" => \$opts{'build_chem_proc'}, - "cache=s" => \$opts{'cache'}, - "cachedir=s" => \$opts{'cachedir'}, - "carma=s" => \$opts{'carma'}, - "cam_bld=s" => \$opts{'cam_bld'}, - "cam_exe=s" => \$opts{'cam_exe'}, - "cam_exedir=s" => \$opts{'cam_exedir'}, - "camiop" => \$opts{'camiop'}, - "cc=s" => \$opts{'cc'}, - "ccsm_seq" => \$opts{'ccsm_seq'}, - "cflags=s" => \$opts{'cflags'}, - "chem=s" => \$opts{'chem'}, - "clubb_sgs!" => \$opts{'clubb_sgs'}, - "clubb_opts=s" => \$opts{'clubb_opts'}, - "co2_cycle" => \$opts{'co2_cycle'}, - "cosp" => \$opts{'cosp'}, - "cosp_libdir=s" => \$opts{'cosp_libdir'}, - "cppdefs=s" => \$opts{'cppdefs'}, - "spcam_clubb_sgs" => \$opts{'spcam_clubb_sgs'}, - "debug" => \$opts{'debug'}, - "dyn=s" => \$opts{'dyn'}, - "edit_chem_mech" => \$opts{'edit_chem_mech'}, - "esmf_libdir=s" => \$opts{'esmf_libdir'}, - "fc=s" => \$opts{'fc'}, - "fc_type=s" => \$opts{'fc_type'}, - "fflags=s" => \$opts{'fflags'}, - "fopt=s" => \$opts{'fopt'}, - "gmake=s" => \$opts{'gmake'}, - "h|help" => \$opts{'help'}, - "hgrid=s" => \$opts{'hgrid'}, - "ionosphere=s" => \$opts{'ionosphere'}, - "lapack_libdir=s" => \$opts{'lapack_libdir'}, - "ldflags=s" => \$opts{'ldflags'}, - "linker=s" => \$opts{'linker'}, - "macrophys=s" => \$opts{'macrophys'}, - "max_n_rad_cnst=s" => \$opts{'max_n_rad_cnst'}, - "mct_libdir=s" => \$opts{'mct_libdir'}, - "microphys=s" => \$opts{'microphys'}, - "mpi_inc=s" => \$opts{'mpi_inc'}, - "mpi_lib=s" => \$opts{'mpi_lib'}, - "nadv=s" => \$opts{'nadv'}, - "nadv_tt=s" => \$opts{'nadv_tt'}, - "nc_inc=s" => \$opts{'nc_inc'}, - "nc_lib=s" => \$opts{'nc_lib'}, - "nc_mod=s" => \$opts{'nc_mod'}, - "nlev=s" => \$opts{'nlev'}, - "ocn=s" => \$opts{'ocn'}, - "offline_dyn" => \$opts{'offline_dyn'}, - "pbl=s" => \$opts{'pbl'}, - "pcols=s" => \$opts{'pcols'}, - "p|pergro" => \$opts{'pergro'}, - "phys=s" => \$opts{'phys'}, - "pio2" => \$opts{'pio2'}, - "pio2_install_dir=s" => \$opts{'pio2_install_dir'}, - "pnc_inc=s" => \$opts{'pnc_inc'}, - "pnc_lib=s" => \$opts{'pnc_lib'}, - "prog_species=s" => \$opts{'prog_species'}, - "psubcols=s" => \$opts{'psubcols'}, - "rad=s" => \$opts{'rad'}, - "offline_drv=s" => \$opts{'offline_drv'}, - "scam" => \$opts{'scam'}, - "s|silent" => \$opts{'silent'}, - "smp!" => \$opts{'smp'}, - "spcam_nx=s" => \$opts{'spcam_nx'}, - "spcam_ny=s" => \$opts{'spcam_ny'}, - "spcam_dx=s" => \$opts{'spcam_dx'}, - "spcam_dt=s" => \$opts{'spcam_dt'}, - "spmd!" => \$opts{'spmd'}, - "target_os=s" => \$opts{'target_os'}, - "test" => \$opts{'test'}, - "unicon" => \$opts{'unicon'}, - "usr_mech_infile=s" => \$opts{'usr_mech_infile'}, - "usr_src=s" => \$opts{'usr_src'}, - "v|verbose" => \$opts{'verbose'}, - "version" => \$opts{'version'}, - "waccm_phys" => \$opts{'waccm_phys'}, - "waccmx" => \$opts{'waccmx'}, - "zmconv_org" => \$opts{'zmconv_org'}, -) or usage(); - -# Give usage message. -usage() if $opts{'help'}; - -# Echo version info. -version($cfgdir) if $opts{'version'}; - -# Check for unparsed argumentss -if (@ARGV) { - print "ERROR: unrecognized arguments: @ARGV\n"; - usage(); -} - -# Define 3 print levels: -# 0 - only issue fatal error messages -# 1 - only informs what files are created (default) -# 2 - verbose -my $print = 1; -if ($opts{'silent'}) { $print = 0; } -if ($opts{'verbose'}) { $print = 2; } -my $eol = "\n"; - -my %cfg = (); # build configuration - -#----------------------------------------------------------------------------------------------- -# Make sure we can find required perl modules and configuration files. -# Look for them in the directory that contains the configure script. - -# Check for the configuration definition file. -my $config_def_file = "config_files/definition.xml"; -(-f "$cfgdir/$config_def_file") or die <<"EOF"; -** Cannot find configuration definition file \"$config_def_file\" in directory \"$cfgdir\" ** -EOF - - -# Horizontal grid and spectral resolution parameters. -my $horiz_grid_file = 'config_files/horiz_grid.xml'; -(-f "$cfgdir/$horiz_grid_file") or die <<"EOF"; -** Cannot find horizonal grid parameters file \"$horiz_grid_file\" in directory \"$cfgdir\" ** -EOF - -# The XML::Lite module is required to parse the XML configuration files. -(-f "$cfgdir/perl5lib/XML/Lite.pm") or die <<"EOF"; -** Cannot find perl module \"XML/Lite.pm\" in directory \"$cfgdir/perl5lib\" ** -EOF - -# The Build::Config module provides utilities to store and manipulate the configuration. -(-f "$cfgdir/perl5lib/Build/Config.pm") or die <<"EOF"; -** Cannot find perl module \"Build/Config.pm\" in directory \"$cfgdir/perl5lib\" ** -EOF - -if ($print>=2) { print "CAM configuration script directory: $cfgdir$eol"; } - -#----------------------------------------------------------------------------------------------- -# Add $cfgdir/perl5lib to the list of paths that Perl searches for modules -unshift @INC, "$cfgdir/perl5lib"; -unshift @INC, "$cfgdir"; -require XML::Lite; -require Build::Config; - -# Initialize the configuration. The $config_def_file provides the definition of a CAM -# configuration. $cfg_ref is a reference to the new configuration object. -my $cfg_ref = Build::Config->new("$cfgdir/$config_def_file"); - -#----------------------------------------------------------------------------------------------- -# Building from within ccsm scripts? -my $ccsm_seq = (defined $opts{'ccsm_seq'}) ? 1 : 0; -$cfg_ref->set('ccsm_seq', $ccsm_seq); - -# Note that when building within the CESM scripts the CAM Makefile is not written -# since the CESM build does not use it. Many of the checks to ensure that a working -# CAM Makefile is produced are disabled when the ccsm option is set. Use the $cam_build -# variable to turn on CAM specific tests. -my $cam_build = 1; -if (($ccsm_seq)) { - $cam_build = 0; -} - -#----------------------------------------------------------------------------------------------- -# CAM root directory. -my $cam_root = absolute_path("$cfgdir/../../.."); - -if (-d "$cam_root/components/cam/src") { - $cfg_ref->set('cam_root', $cam_root); -} else { - die <<"EOF"; -** Invalid CAM root directory: $cam_root -** -** The CAM root directory must contain the subdirectory components/cam/src/. -** It is derived from "config_dir/../../.." where config_dir is the -** directory in the CAM distribution that contains the configuration -** scripts. -EOF -} - -if ($print>=2) { print "CAM root directory: $cam_root$eol"; } - -#----------------------------------------------------------------------------------------------- -# CAM build directory. -my $cam_bld; -if (defined $opts{'cam_bld'}) { - $cam_bld = absolute_path($opts{'cam_bld'}); -} -else { # use default value - $cam_bld = absolute_path($cfg_ref->get('cam_bld')); -} - -if (-d $cam_bld or mkdirp($cam_bld)) { - # If the build directory exists or can be made then set the value... - $cfg_ref->set('cam_bld', $cam_bld); -} -else { - die <<"EOF"; -** Could not create the specified CAM build directory: $cam_bld -EOF -} - -if ($print>=2) { print "CAM build directory: $cam_bld$eol"; } - -#----------------------------------------------------------------------------------------------- -# CAM install directory. -my $cam_exedir; -if (defined $opts{'cam_exedir'}) { - $cam_exedir = absolute_path($opts{'cam_exedir'}); -} -else { # use default value - $cam_exedir = absolute_path($cfg_ref->get('cam_exedir')); -} - -if ($cam_build) { - - if (-d $cam_exedir or mkdirp($cam_exedir)) { - # If the install directory exists or can be made then set the value... - $cfg_ref->set('cam_exedir', $cam_exedir); - } else { - die <<"EOF"; -** Could not create the specified CAM installation directory: $cam_exedir -EOF - } - - if ($print>=2) { print "CAM executable will be created in: $cam_exedir$eol"; } -} - -#----------------------------------------------------------------------------------------------- -# User source directories. -my $usr_src = ''; -if (defined $opts{'usr_src'}) { - my @dirs = split ',', $opts{'usr_src'}; - my @adirs; - while ( my $dir = shift @dirs ) { - if (-d "$dir") { - push @adirs, absolute_path($dir); - } else { - die "** User source directory does not exist: $dir\n"; - } - } - $usr_src = join ',', @adirs; - $cfg_ref->set('usr_src', $usr_src); -} - -if ($print>=2) { print "User source directories: $usr_src$eol"; } - -#----------------------------------------------------------------------------------------------- -# configuration cache directory and file. -my $config_cache_dir; -my $config_cache_file; -if (defined $opts{'cachedir'}) { - $config_cache_dir = absolute_path($opts{'cachedir'}); -} -else { - $config_cache_dir = $cfg_ref->get('cam_bld'); -} - -if (-d $config_cache_dir or mkdirp($config_cache_dir)) { - $config_cache_file = "$config_cache_dir/$opts{'cache'}"; -} else { - die <<"EOF"; -** Could not create the specified directory for configuration cache file: $config_cache_dir -EOF -} - -if ($print>=2) { print "Configuration cache file: $config_cache_file$eol"; } - -#----------------------------------------------------------------------------------------------- -# Platform properties ########################################################################## -#----------------------------------------------------------------------------------------------- - -#----------------------------------------------------------------------------------------------- -# Determine target OS -- allow cross compilation only if target_os is specified on commandline. -my $target_os = $OSNAME; -if (defined $opts{'target_os'}) { - $target_os = $opts{'target_os'}; -} -$cfg_ref->set('target_os', $target_os); - -if ($print>=2) { print "Target OS: $target_os$eol"; } - -#----------------------------------------------------------------------------------------------- -# SPMD -my $spmd_val = 0; -if (defined $opts{'spmd'}) { - $spmd_val = $opts{'spmd'}; -} -$cfg_ref->set('spmd', $spmd_val); - -my $spmd = $spmd_val ? 'ON': 'OFF'; -if ($print>=2) { print "SPMD parallelism: $spmd$eol";} - -#----------------------------------------------------------------------------------------------- -# SMP -my $smp_val = 0; -if (defined $opts{'smp'}) { - $smp_val = $opts{'smp'} -} -$cfg_ref->set('smp', $smp_val); - -my $smp = $smp_val ? 'ON': 'OFF'; -if ($print>=2) { print "SMP parallelism: $smp$eol";} - -#----------------------------------------------------------------------------------------------- -# Determine which packages/component to include ############################################### -#----------------------------------------------------------------------------------------------- - -#----------------------------------------------------------------------------------------------- -# Physics package -# -# The default physics package is cam6. Physics packages >=cam5 use chemistry packages -# that include modal aerosols, i.e., the -chem value matches /_mam/. If the chem_pkg -# name doesn't match /_mam/ then set the default physics package to cam4. -my $phys_pkg = 'cam6'; -if (defined $opts{'chem'} and $opts{'chem'} !~ /_mam/) { - $phys_pkg = 'cam4'; -} -elsif (defined $opts{'waccmx'}) { - $phys_pkg = 'cam4'; -} - -# user override -if (defined $opts{'phys'}) { - $phys_pkg = lc($opts{'phys'}); -} - -# Add to the config object. -$cfg_ref->set('phys', $phys_pkg); - -if ($print>=2) { print "Physics package: $phys_pkg$eol"; } - - -# Set flag to indicate a simple physics option -my $simple_phys = 0; -if ($phys_pkg =~ m/^adiabatic$|^held_suarez$|^kessler$|^tj2016$/) { - $simple_phys = 1; -} - -#----------------------------------------------------------------------------------------------- -# Chemistry package - -my $chem_pkg = 'trop_mam4'; - -# defaults based on physics package -if ($simple_phys or $phys_pkg =~ m/^cam[34]$/ or $phys_pkg eq 'spcam_sam1mom') { - $chem_pkg = 'none'; -} -elsif ($phys_pkg eq 'cam5' or $phys_pkg eq 'spcam_m2005') { - $chem_pkg = 'trop_mam3'; -} - -# some overrides for special configurations -if (defined $opts{'prog_species'}) { - $chem_pkg = 'none'; -} -elsif (defined $opts{'waccmx'}) { - $chem_pkg = 'waccm_ma'; -} - -# Allow the user to override the default chemistry via the commandline. -if (defined $opts{'chem'}) { - $chem_pkg = lc($opts{'chem'}); - - # But do some consistency checks... - - # 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')) { - die "configure ERROR: -phys=$phys_pkg -chem=$chem_pkg\n". - " -chem can only be set to 'none' or 'terminator'.\n"; - } - } - elsif ($phys_pkg =~ m/^cam3$|^cam4$|^spcam_sam1mom$/) { - # The modal aerosols are not valid with cam3 or cam4 physics - if ($chem_pkg =~ /_mam/) { - die "configure ERROR: -phys=$phys_pkg -chem=$chem_pkg\n". - " -chem cannot be set to a modal aerosol option.\n"; - } - } - - if (defined $opts{'prog_species'}) { - if ($chem_pkg !~ /none/) { - die "configure ERROR: -prog_species=$opts{'prog_species'} -chem=$chem_pkg\n". - " -chem must be set 'none' with the prog_species option.\n"; - } - } - - if (defined $opts{'waccmx'}) { - if ($chem_pkg !~ /waccm_ma/) { - die "configure ERROR: -waccmx=$opts{'waccmx'} -chem=$chem_pkg\n". - " -chem must be set 'waccm_ma*' with the waccmx option.\n"; - } - } - -} - -# Add to the config object. -$cfg_ref->set('chem', $chem_pkg); - -if ($print>=2) { print "Chemistry package: $chem_pkg$eol"; } - -#----------------------------------------------------------------------------------------------- -# Dynamics package -$cfg_ref->set('dyn', 'fv'); - -if (defined $opts{'dyn'}) { - $cfg_ref->set('dyn', lc($opts{'dyn'}) ); -} -my $dyn_pkg = $cfg_ref->get('dyn'); - -if ($print>=2) { print "Dynamics package: $dyn_pkg$eol"; } - -$cfg_ref->set('analytic_ic', (defined $opts{'analytic_ic'}) ? $opts{'analytic_ic'} : 0); - -# offline driver -if (defined $opts{'offline_dyn'}) { - $cfg_ref->set('offline_dyn', $opts{'offline_dyn'}); -} -my $offline_dyn = $cfg_ref->get('offline_dyn'); - -# offline driver only runs with FV dycore -if ( ($offline_dyn) and ($dyn_pkg ne 'fv') ) { - die <<"EOF"; -** ERROR: Offline driver only applicable to the FV dycore. -EOF -} - -#----------------------------------------------------------------------------------------------- -# Test tracer package -if (defined $opts{'nadv_tt'}) { - $cfg_ref->set('nadv_tt', $opts{'nadv_tt'}); -} -my $ttrac_nadv = $cfg_ref->get('nadv_tt'); - -if ($print>=2) { print "Number of user requested test tracers: $ttrac_nadv$eol"; } - - -#----------------------------------------------------------------------------------------------- -# Radiatively active constituents. -if (defined $opts{'max_n_rad_cnst'}) { - $cfg_ref->set('max_n_rad_cnst', $opts{'max_n_rad_cnst'}); -} -my $max_n_rad_cnst = $cfg_ref->get('max_n_rad_cnst'); - -if ($print>=2) { print "Maximum radiatively active tracers: $max_n_rad_cnst$eol"; } - -#----------------------------------------------------------------------------------------------- -# waccm physics -my $waccm_phys = 0; -if ($chem_pkg =~ /waccm_/) { - $waccm_phys = 1; -} -$cfg_ref->set('waccm_phys', $waccm_phys); - -# user override -if (defined $opts{'waccm_phys'}) { - $cfg_ref->set('waccm_phys', $opts{'waccm_phys'}); -} -$waccm_phys = $cfg_ref->get('waccm_phys'); - -if ($print>=2) { print "WACCM physics: $waccm_phys$eol"; } - - -# WACCM physics only runs with FV or SE dycores -if ( ($waccm_phys) and ($dyn_pkg ne 'fv') and ($dyn_pkg ne 'se') ) { - die <<"EOF"; -** ERROR: WACCM physics only runs with FV or Spectral Element as the dycore. -EOF -} - -# WACCM includes 4 age of air tracers by default -if ($chem_pkg =~ /waccm_ma/ or $chem_pkg =~ /waccm_tsmlt/) { - $cfg_ref->set('age_of_air_trcs', 1); -} - -# Allow user to override WACCM default, or turn on the age of air tracers -# in non-WACCM runs. -if (defined $opts{'age_of_air_trcs'}) { - $cfg_ref->set('age_of_air_trcs', $opts{'age_of_air_trcs'}); -} -my $age_of_air_trcs = $cfg_ref->get('age_of_air_trcs') ? "ON" : "OFF"; - -if ($print>=2) { print "Age of air tracer package: $age_of_air_trcs$eol"; } - -# waccmx option -if (defined $opts{'waccmx'}) { - $cfg_ref->set('waccmx', $opts{'waccmx'}); - if (defined $opts{'ionosphere'}) { - $cfg_ref->set('ionosphere', $opts{'ionosphere'}); - } -} -my $waccmx = $cfg_ref->get('waccmx'); -my $ionos = $cfg_ref->get('ionosphere'); - -#----------------------------------------------------------------------------------------------- - -# Prognostic species package(s) -if (defined $opts{'prog_species'}) { - $cfg_ref->set('prog_species', $opts{'prog_species'}); - if ($chem_pkg ne 'none'){ - die "ERROR: chem and prog_species cannot be both specified.\n"; - } -} -if (defined $opts{'edit_chem_mech'}) { - $cfg_ref->set('edit_chem_mech', $opts{'edit_chem_mech'}); -} -if (defined $opts{'usr_mech_infile'}) { - $cfg_ref->set('usr_mech_infile', $opts{'usr_mech_infile'}); -} - -#----------------------------------------------------------------------------------------------- -# Prognostic aerosol/GHG package(s) -my $prog_species = $cfg_ref->get('prog_species'); - -if (($waccm_phys) and ($chem_pkg eq 'none') and !($prog_species)) { - die <<"EOF"; -** ERROR: WACCM physics only runs with chemistry. -EOF -} - -#----------------------------------------------------------------------------------------------- -# Biogeochemistry option -if (defined $opts{'co2_cycle'}) { - $cfg_ref->set('co2_cycle', $opts{'co2_cycle'}); -} -my $co2_cycle = $cfg_ref->get('co2_cycle'); - -if ($co2_cycle and $print>=2) { print "co2_cycle option: ON$eol"; } - -#----------------------------------------------------------------------------------------------- -# Superparameterization mode (SPCAM) -# -# These values all default to 1 unless specified by the user during configure - -if ($phys_pkg eq 'spcam_sam1mom' or $phys_pkg eq 'spcam_m2005') { - - if ($smp eq 'ON') { - die "ERROR: SPCAM may not be used with threading $eol"; - } - - if ($print>=2) {print "Configure CAM for SPCAM (superparameterization) mode: $phys_pkg.$eol"; } - - if (defined $opts{'spcam_nx'}) { - $cfg_ref->set('spcam_nx', $opts{'spcam_nx'}); - my $spcam_nx = $cfg_ref->get('spcam_nx'); - if ($spcam_nx < 4) { - die "configure ERROR: spcam_nx must be greater than or equal to 4\n"; - } - if ($print>=2) {print "spcam_nx= $spcam_nx $eol"; } - } - if (defined $opts{'spcam_ny'}) { - $cfg_ref->set('spcam_ny', $opts{'spcam_ny'}); - my $spcam_ny = $cfg_ref->get('spcam_ny'); - if ($print>=2) {print "spcam_ny= $spcam_ny $eol"; } - } - if (defined $opts{'spcam_dx'}) { - $cfg_ref->set('spcam_dx', $opts{'spcam_dx'}); - my $spcam_dx = $cfg_ref->get('spcam_dx'); - if ($print>=2) {print "spcam_nx= $spcam_dx $eol"; } - } - if (defined $opts{'spcam_dt'}) { - $cfg_ref->set('spcam_dt', $opts{'spcam_dt'}); - my $spcam_dt = $cfg_ref->get('spcam_dt'); - if ($print>=2) {print "spcam_nt= $spcam_dt $eol"; } - } - -} - - -#----------------------------------------------------------------------------------------------- -# Micro-physics package - -# Set default -my $microphys_pkg = 'none'; -if ($phys_pkg =~ m/^cam[34]$/) { - $microphys_pkg = 'rk'; -} -elsif ($phys_pkg eq 'cam5') { - $microphys_pkg = 'mg1'; -} -elsif ($phys_pkg eq 'cam6') { - $microphys_pkg = 'mg2'; -} -elsif ($phys_pkg eq 'spcam_sam1mom') { - $microphys_pkg = 'spcam_sam1mom'; -} -elsif ($phys_pkg eq 'spcam_m2005') { - $microphys_pkg = 'spcam_m2005'; -} - -# Allow the user to override the default via the commandline. -if (defined $opts{'microphys'}) { - $microphys_pkg = lc($opts{'microphys'}); -} - -$cfg_ref->set('microphys', $microphys_pkg); - -if ($print>=2) { print "Microphysics package: $microphys_pkg$eol"; } - -#----------------------------------------------------------------------------------------------- -# CARMA sectional microphysics package -# The default for the current physics package is: -my $carma_pkg = 'none'; - -# Allow the user to override the default via the commandline. -if (defined $opts{'carma'}) { - $carma_pkg = lc($opts{'carma'}); -} - -if ($carma_pkg =~ m/cirrus/i) { - unless ($microphys_pkg =~ /^mg/) { - die <<"EOF"; -** ERROR: microphysics package set to: $microphys_pkg -** The CARMA cirrus model only works with MG microphysics. -EOF - } -} - -$cfg_ref->set('carma', $carma_pkg); - -if ($print>=2) { print "CARMA microphysical model: $carma_pkg$eol"; } - -#----------------------------------------------------------------------------------------------- -# CLUBB -my $clubb_sgs = 0; -if ($phys_pkg eq 'cam6') { - $clubb_sgs = 1; -} - -# user override -if (defined $opts{'clubb_sgs'}) { - $clubb_sgs = $opts{'clubb_sgs'}; -} - -# consistency checks... - -# CLUBB_SGS only works with mg microphysics -if ($clubb_sgs and not ($microphys_pkg =~ m/^mg/ )) { - die <<"EOF"; -** ERROR: microphysics package set to: $microphys_pkg -** CLUBB_SGS only works with MG microphysics. -EOF -} - -$cfg_ref->set('clubb_sgs', $clubb_sgs); - -if ($print>=2) { print "clubb_sgs: $clubb_sgs$eol"; } - - -#----------------------------------------------------------------------------------------------- -# SPCAM version of CLUBB -if (defined $opts{'spcam_clubb_sgs'}) { - $cfg_ref->set('spcam_clubb_sgs', $opts{'spcam_clubb_sgs'}); -} -my $spcam_clubb_sgs = $cfg_ref->get('spcam_clubb_sgs'); - - -#----------------------------------------------------------------------------------------------- -# Break apart CLUBB options into separate fields - -if (defined $opts{'clubb_opts'}) { - my @clubb_temp_opts = split /,/, $opts{'clubb_opts'}; - foreach (@clubb_temp_opts) { - $cfg_ref->set("$_", '1'); - } -} -my $clubb_do_adv = $cfg_ref->get('clubb_do_adv'); -if ($print>=2) { print "clubb_do_adv: $clubb_do_adv$eol"; } - -#----------------------------------------------------------------------------------------------- -# ZM convective organization - -if (defined $opts{'zmconv_org'}) { - $cfg_ref->set('zmconv_org', $opts{'zmconv_org'}); -} - -my $zmconv_org = $cfg_ref->get('zmconv_org'); -if ($print>=2) { print "zmconv_org: $zmconv_org$eol"; } - -#----------------------------------------------------------------------------------------------- -# Macro-physics package - -# Set default -my $macrophys_pkg = 'none'; -if ($phys_pkg =~ /cam[34]/) { - $macrophys_pkg = 'rk'; -} -elsif ($phys_pkg =~ /cam5/) { - $macrophys_pkg = 'park'; -} -elsif ($phys_pkg =~ /cam6/ and $clubb_sgs) { - $macrophys_pkg = 'clubb_sgs'; -} -elsif ($phys_pkg =~ /cam6/ and !$clubb_sgs) { - $macrophys_pkg = 'park'; -} -elsif ($phys_pkg eq 'spcam_sam1mom') { - $macrophys_pkg = 'spcam_sam1mom'; -} -elsif ($phys_pkg eq 'spcam_m2005') { - $macrophys_pkg = 'spcam_m2005'; -} - -# user overrides -if ($clubb_sgs or $spcam_clubb_sgs) { - $macrophys_pkg = 'clubb_sgs'; -} - -if (defined $opts{'macrophys'}) { - $macrophys_pkg = lc($opts{'macrophys'}); -} - -$cfg_ref->set('macrophys', $macrophys_pkg); - -if ($print>=2) { print "Macrophysics package: $macrophys_pkg$eol"; } - - -#----------------------------------------------------------------------------------------------- -# PBL package - -# Set default: -my $pbl_pkg = 'none'; -if ($phys_pkg =~ m/^cam[34]$/) { - $pbl_pkg = 'hb'; -} -elsif ($phys_pkg =~ /cam5/) { - $pbl_pkg = 'uw'; -} -elsif ($phys_pkg =~ /cam6/ and $clubb_sgs) { - $pbl_pkg = 'clubb_sgs'; -} -elsif ($phys_pkg =~ /cam6/ and !$clubb_sgs) { - $pbl_pkg = 'uw'; -} -elsif ($phys_pkg eq 'spcam_sam1mom') { - $pbl_pkg = 'spcam_sam1mom'; -} -elsif ($phys_pkg eq 'spcam_m2005') { - $pbl_pkg = 'spcam_m2005'; -} - -# Allow the user to override the default via the commandline. -if ($clubb_sgs == 1) { - $pbl_pkg = 'clubb_sgs'; -} -if (defined $opts{'pbl'}) { - $pbl_pkg = lc($opts{'pbl'}); -} - -# consistency checks... - -# UW PBL only works with mg microphysics -if ($pbl_pkg =~ m/uw/i) { - unless ($microphys_pkg =~ /^mg/) { - die <<"EOF"; -** ERROR: microphysics package set to: $microphys_pkg -** The UW PBL scheme only works with MG microphysics. -EOF - } -} - -$cfg_ref->set('pbl', $pbl_pkg); - -if ($print>=2) { print "PBL package: $pbl_pkg$eol"; } - -#----------------------------------------------------------------------------------------------- -# UNICON - -if (defined $opts{'unicon'}) { - $cfg_ref->set('unicon', $opts{'unicon'}); -} -my $unicon = $cfg_ref->get('unicon'); - -# consistency checks... - -# UNICON assumes park macrophysics, uw pbl, and mg microphysics -if ($unicon and - ($macrophys_pkg ne 'park' or $pbl_pkg ne 'uw' or $microphys_pkg !~ m/^mg/) ) { - die <<"EOF"; -** ERROR: UNICON assumes macrophys='park', pbl='uw', microphys='mg*'. Current values are: -** macrophys: $macrophys_pkg, pbl: $pbl_pkg, microphys: $microphys_pkg. -EOF -} - -if ($unicon and $print>=2) { print "Using UNICON scheme.$eol"; } - -#----------------------------------------------------------------------------------------------- -# Radiation package - -# Set default -my $rad_pkg = 'none'; -if ($phys_pkg =~ m/^cam[34]$|^spcam_sam1mom$/) { - $rad_pkg = 'camrt'; -} -elsif ($phys_pkg =~ m/^cam[56]$|^spcam_m2005$/) { - $rad_pkg = 'rrtmg'; -} - -# Allow the user to override the default via the commandline. -if (defined $opts{'rad'}) { - $rad_pkg = lc($opts{'rad'}); -} - -# consistency checks... - -if ($rad_pkg eq 'camrt') { - - # The camrt radiation doesn't work with the modal aerosols - if ($chem_pkg =~ /_mam/) { - die "configure ERROR: radiation package: $rad_pkg is not compatible\n". - " with aerosol package $chem_pkg\n"; - } -} -elsif ($rad_pkg eq 'rrtmg') { - - # The rrtmg package doesn't work with the CAM3 prescribed aerosols - if ($phys_pkg eq 'cam3') { - die "configure ERROR: radiation package: $rad_pkg is not compatible\n". - " with physics package $phys_pkg\n"; - } -} - -$cfg_ref->set('rad', $rad_pkg); - -if ($print>=2) { print "Radiation package: $rad_pkg$eol"; } - -#----------------------------------------------------------------------------------------------- -# Option to build the COSP simulator -if (defined $opts{'cosp'}) { - $cfg_ref->set('cosp', $opts{'cosp'}); -} -my $cosp = $cfg_ref->get('cosp'); - -# cosp is only implemented with the cam5 and cam6 physics packages -if ($cosp and ($phys_pkg ne 'cam5' and $phys_pkg ne 'cam6')) { - die "configure ERROR: cosp not implemented for the $phys_pkg physics package \n"; -} - -if ($cosp and $print>=2) { print "COSP simulator enabled$eol"; } - -#----------------------------------------------------------------------------------------------- -# Checks for SPCAM compatability - -if ($phys_pkg eq 'spcam_sam1mom') { - if ($rad_pkg ne 'camrt') { - die "configure ERROR: radiation package: $rad_pkg is not compatible\n". - " with sam1mom -- it should be camrt\n"; - } - if ($chem_pkg ne 'none') { - die "configure ERROR: chemistry package: $chem_pkg is not compatible\n". - " with sam1mom -- it should be none\n"; - } -} - -if ($phys_pkg eq 'spcam_m2005') { - if ($rad_pkg ne 'rrtmg') { - die "configure ERROR: radiation package: $rad_pkg is not compatible\n". - " with m2005 -- it should be rrtmg\n"; - } - if ($chem_pkg ne 'trop_mam3') { - die "configure ERROR: chemistry package: $chem_pkg is not compatible\n". - " with m2005 -- it should be trop_mam3\n"; - } -} - -#----------------------------------------------------------------------------------------------- -# offline unit driver -if (defined $opts{'offline_drv'}) { - $cfg_ref->set('offline_drv', $opts{'offline_drv'}); -} - -#----------------------------------------------------------------------------------------------- -# Aquaplanet mode -# This provides a flag to CAM to let it know that it's running in aquaplanet mode. -# This flag is mainly used by the dycore to set the fixed dry mass of the atmosphere. -# It is independent of which model is used to specify the aquaplanet surface properties. -my $aquaplanet = 0; - -# aquaplanet mode is the default for CAM standalone builds unless using -# simple physics -if ($cam_build and !$simple_phys) {$aquaplanet = 1;} - -# user override -if (defined $opts{'aquaplanet'}) { - $aquaplanet = 1; -} - -$cfg_ref->set('aquaplanet', $aquaplanet); - -my $aqua_mode = $aquaplanet ? "ON" : "OFF"; -if ($print>=2) { print "Aqua-planet mode: $aqua_mode$eol"; } - -#----------------------------------------------------------------------------------------------- -# Ocean model -my $ocn_pkg = 'socn'; -if ($aquaplanet) { - # Default for aquaplanet mode is to use an analytic expression for fixed SST. - $ocn_pkg = 'aquaplanet'; -} - -# Allow the user to override the default via the commandline. -# For aquaplanet with SOM the option '-ocn som' should be used to override -# aquaplanet's default ocean component setting. -if (defined $opts{'ocn'}) { - $ocn_pkg = lc($opts{'ocn'}); -} - -$cfg_ref->set('ocn', $ocn_pkg); - -if ($print>=2) { print "Ocean package: $ocn_pkg$eol"; } - -#----------------------------------------------------------------------------------------------- -# Use modifications for perturbation growth testing? -if (defined $opts{'pergro'}) { - $cfg_ref->set('pergro', $opts{'pergro'}); -} -my $pergro = $cfg_ref->get('pergro') ? "ON" : "OFF"; - -if ($print>=2) { print "Perturbation growth testing: $pergro$eol"; } - -#----------------------------------------------------------------------------------------------- -# Single column mode -if (defined $opts{'scam'}) { - $cfg_ref->set('scam', 1); -} -my $scam = $cfg_ref->get('scam') ? "ON" : "OFF"; - -# The only dycore supported in SCAM mode is Eulerian -if ($scam eq 'ON' and $dyn_pkg ne 'eul') { - die <<"EOF"; -** ERROR: SCAM mode only works with Eulerian dycore. -** Requested dycore is: $dyn_pkg -EOF -} - -if ($print>=2) { print "CAM single column mode (SCAM): $scam$eol"; } - -#----------------------------------------------------------------------------------------------- -# Generate IOP -if (defined $opts{'camiop'}) { - $cfg_ref->set('camiop', 1); -} -my $camiop = $cfg_ref->get('camiop') ? "ON" : "OFF"; - -# The only dycore supported in CAMIOP mode is Eulerian -if ($camiop eq 'ON' and $dyn_pkg ne 'eul') { - die <<"EOF"; -** ERROR: CAMIOP mode only works with Eulerian dycore. -** Requested dycore is: $dyn_pkg -EOF -} - -if ($print>=2) { print "Produce IOP file for SCAM: $camiop$eol"; } - -#----------------------------------------------------------------------------------------------- -# Horizontal grid parameters -# Dycore dependent defaults: -my $hgrid; -if ($dyn_pkg eq 'fv') { - $hgrid = '1.9x2.5'; -} -elsif ($dyn_pkg eq 'eul') { - $hgrid = '64x128'; -} -elsif ($dyn_pkg eq 'se') { - $hgrid = 'ne16np4'; -} -$cfg_ref->set('hgrid', $hgrid); - -# User override. -if (defined $opts{'hgrid'}) { - $cfg_ref->set('hgrid', $opts{'hgrid'}); -} -my $hgrid = $cfg_ref->get('hgrid'); - -# set_horiz_grid sets the parameters for specific dycore/hgrid combinations. -set_horiz_grid("$cfgdir/$horiz_grid_file", $cfg_ref); - -if ($print>=2) { print "Horizontal grid specifier: $hgrid$eol"; } - -#----------------------------------------------------------------------------------------------- -# Maximum number of columns in a chunk. -if (defined $opts{'pcols'}) { - $cfg_ref->set('pcols', $opts{'pcols'}); -} -my $pcols = $cfg_ref->get('pcols'); - -# Override PCOLS setting if configuring for SCAM -if ($scam eq 'ON') { - $pcols = 1; - $cfg_ref->set('pcols', $pcols); -} - -# Check valid value of pcols -unless ( $pcols >= 1 ) { - die <<"EOF"; -** ERROR: invalid chunk size: $pcols -EOF -} - -if ($print>=2) { print "Maximum number of columns in a chunk: $pcols$eol"; } - -#----------------------------------------------------------------------------------------------- -# Maximum number of sub-columns in a chunk. -if (defined $opts{'psubcols'}) { - $cfg_ref->set('psubcols', $opts{'psubcols'}); -} -my $psubcols = $cfg_ref->get('psubcols'); - -# Check valid value of psubcols -unless ( $psubcols >= 1 ) { - die <<"EOF"; -** ERROR: invalid size for sub-columns: $psubcols -EOF -} - -if ($print>=2) { print "Maximum number of sub-columns per column: $psubcols$eol"; } - -#----------------------------------------------------------------------------------------------- -# Number of vertical levels -my $nlev = 0; - -# Defaults -if ($waccmx) { - if ($ionos =~ /wxie/) { - $nlev = 126; - } - else { - $nlev = 81; - } -} -elsif ($chem_pkg =~ /waccm_/) { - if ($phys_pkg eq 'cam4') { - $nlev = 66; - } - else { - $nlev = 70; - } -} -elsif ($phys_pkg eq 'cam6') { - $nlev = 32; -} -elsif ($phys_pkg eq 'cam5' or $phys_pkg eq 'spcam_m2005') { - $nlev = 30; -} -elsif ($phys_pkg eq 'cam4' or $phys_pkg eq 'spcam_sam1mom') { - $nlev = 26; -} -elsif ($phys_pkg eq 'cam3') { - $nlev = 26; -} -else { - # This will be used for Held-Suarez and other 'simple' physics - # We may change this to 32 once IC files are available. - $nlev = 30; -} - -# user override -if (defined $opts{'nlev'}) { - $nlev = $opts{'nlev'}; -} - -# Check valid value of nlev -unless ( $nlev >= 1 ) { - die <<"EOF"; -** ERROR: invalid number of vertical levels: $nlev -EOF -} - -$cfg_ref->set('nlev', $nlev); - -if ($print>=2) { print "Number of vertical levels: $nlev$eol"; } - -if ($phys_pkg eq 'spcam_sam1mom' or $phys_pkg eq 'spcam_m2005') { - $cfg_ref->set('spcam_nz', $nlev-2); -} - -#------------------------------------------------------------------------------------------------ -# chemistry preprocessor.... -# -- avoid using the chem_preprocessor unless it's required -#------------------------------------------------------------------------------------------------ -my $chem_nadv = 0; -my $chem_cppdefs = ''; -my $chem_src_dir = ''; - -if (!$prog_species) { - $chem_src_dir = "$cam_root/components/cam/src/chemistry/pp_$chem_pkg"; - $cfg_ref->set('chem_src_dir', $chem_src_dir); -} - -# customize chemistry -my $edit_chem_mech = $cfg_ref->get('edit_chem_mech'); -my $usr_mech_infile = $cfg_ref->get('usr_mech_infile'); -my $customize = $prog_species || $edit_chem_mech || $usr_mech_infile; - -if ($customize) { - # build_chem_proc option used to force a build even if an executable exists - if (defined $opts{'build_chem_proc'}) { - $cfg_ref->set('build_chem_proc', $opts{'build_chem_proc'}); - } else { - $cfg_ref->set('build_chem_proc', 0); - } - my $chem_proc_src ; - $chem_proc_src = "$cam_bld/chem_proc/source"; - $cfg_ref->set('chem_proc_src', $chem_proc_src) ; - my $chemproc_fc; - # determine which fortran compiler to use for building the preprocessor - if (defined $opts{'fc_type'}) { - $chemproc_fc = $opts{'fc_type'}; - if ($print>=2) { print "Chem preprocessor compiler set from fc config opt$eol"; } - } - if ($print>=2) { print "Chem preprocessor compiler: $chemproc_fc $eol"; } - ($chem_nadv) = chem_preprocess($cfg_ref,$print,$chemproc_fc); -} elsif ($chem_pkg ne 'none') { - # 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"; - ($chem_nadv) = chem_number_adv($chem_src_dir); -} - -if ($chem_pkg =~ '_mam3') { - $chem_cppdefs = ' -DMODAL_AERO -DMODAL_AERO_3MODE '; -} elsif ($chem_pkg =~ '_mam4') { - $chem_cppdefs = ' -DMODAL_AERO -DMODAL_AERO_4MODE '; -} elsif ($chem_pkg =~ '_mam7') { - $chem_cppdefs = ' -DMODAL_AERO -DMODAL_AERO_7MODE '; -} - -if ($chem_pkg =~ '_oslo') { - $chem_cppdefs = ' -DOSLO_AERO -DDIRIND' -} - -# CARMA sectional microphysics -# -# New CARMA models need to define the number of advected constituents. -# -# New CARMA models that want to do dry depostion need to provide the ccp_def PROGSSLT, so that -# clm will return aerodynamic resistances and surface friction velocity. -my $carma_nadv = 0; -my $carma_cppdefs = ''; - -if ($carma_pkg eq 'bc_strat') { - $carma_nadv = 1; -} -elsif ($carma_pkg eq 'cirrus') { - $carma_nadv = 84; -} -elsif ($carma_pkg eq 'cirrus_dust') { - $carma_nadv = 140; -} -elsif ($carma_pkg eq 'dust') { - $carma_nadv = 16; -} -elsif ($carma_pkg eq 'meteor_impact') { - $carma_nadv = 42; -} -elsif ($carma_pkg eq 'meteor_smoke') { - $carma_nadv = 28; -} -elsif ($carma_pkg eq 'mixed_sulfate') { - $carma_nadv = 84; -} -elsif ($carma_pkg eq 'pmc') { - $carma_nadv = 84; -} -elsif ($carma_pkg eq 'pmc_sulfate') { - $carma_nadv = 140; -} -elsif ($carma_pkg eq 'sea_salt') { - $carma_nadv = 16; -} -elsif ($carma_pkg eq 'sulfate') { - $carma_nadv = 30; -} -elsif ($carma_pkg eq 'tholin') { - $carma_nadv = 40; -} -elsif ($carma_pkg eq 'test_detrain') { - $carma_nadv = 66; -} -elsif ($carma_pkg eq 'test_growth') { - $carma_nadv = 32; -} -elsif ($carma_pkg eq 'test_passive') { - $carma_nadv = 16; -} -elsif ($carma_pkg eq 'test_radiative') { - $carma_nadv = 16; -} -elsif ($carma_pkg eq 'test_swelling') { - $carma_nadv = 48; -} -elsif ($carma_pkg eq 'test_tracers') { - $carma_nadv = 372; -} -elsif ($carma_pkg eq 'test_tracers2') { - $carma_nadv = 434; -} - - -#----------------------------------------------------------------------------------------------- -# Number of advected constituents -my $nadv; -if (defined $opts{'nadv'}) { - $cfg_ref->set('nadv', $opts{'nadv'}); -} -else { - - # If the user hasn't specified the number of advected constituents via the -nadv - # commandline arg, then determine the default number. - - # There is always at least one advected constituent, the specific humidity, even - # if it's set to zero which is the case for adiabatic or Held-Suarez physics. - $nadv = 1; - - # Chemistry package: - $nadv += $chem_nadv; - if ($print>=2) { print "Advected constituents added by chemistry $chem_pkg: $chem_nadv$eol"; } - - # If no 'simple' (e.g., Held-Suarez) physics package is used, - # then accumulate advected constituents from the moist physics and - # chemistry processes. - - unless ($simple_phys) { - - # Microphysics parameterization - if ($microphys_pkg eq 'rk' or $microphys_pkg eq 'spcam_sam1mom') { - $nadv += 2; - if ($print>=2) { print "Advected constituents added by $microphys_pkg microphysics: 2$eol"; } - } - elsif ($microphys_pkg =~ /^mg1/ or $microphys_pkg eq 'spcam_m2005') { - $nadv += 4; - if ($print>=2) { print "Advected constituents added by $microphys_pkg microphysics: 4$eol"; } - } - elsif ($microphys_pkg =~/^mg2/) { - $nadv += 8; - if ($print>=2) { print "Advected constituents added by $microphys_pkg microphysics: 8$eol"; } - } - - if ($zmconv_org == 1 ) { - $nadv += 1; - if ($print>=2) { print "Advected constituents added by $microphys_pkg microphysics: 8$eol"; } - } - - if ($clubb_do_adv) { - $nadv += 9; - if ($print>=2) { print "Advected constituents added by $microphys_pkg microphysics: 8$eol"; } - } - - # co2_cycle - if ($co2_cycle) { - $nadv += 4; - if ($print>=2) { print "Advected constituents added by co2_cycle: 4$eol"; } - } - - # CARMA package: - if ($carma_nadv > 0) { - $nadv += $carma_nadv; - if ($print>=2) { print "Advected constituents added by CARMA model $carma_pkg: $carma_nadv$eol"; } - } - - # UNICON tracers - if ($unicon) { - $nadv += 5; - if ($print>=2) { print "Advected constituents added by UNICON: 5$eol"; } - } - - } - - # Special case for Kessler physics, need ice and water tracers - if ($phys_pkg eq "kessler") { - $nadv += 2 - } - - # Add in specified test tracers. These may be present with 'simple' (e.g., Held-Suarez) physics. - $nadv += $ttrac_nadv; - if ($print>=2 and $ttrac_nadv) { print "Advected constituents added by test tracer package: $ttrac_nadv$eol"; } - - if ($age_of_air_trcs eq "ON") { - $nadv += 4; - if ($print>=2) { print "Advected constituents added by the age of air tracer package: 4$eol"; } - } - - $cfg_ref->set('nadv', $nadv); -} - -$nadv = $cfg_ref->get('nadv'); -if ($print>=2) { print "Total advected constituents: $nadv$eol"; } - -#----------------------------------------------------------------------------------------------- -# Makefile configuration ####################################################################### -#----------------------------------------------------------------------------------------------- - -#----------------------------------------------------------------------------------------------- -# Check for GNU make in the user's path -if ($print) { print "Looking for a valid GNU make... "; } -my @makenames = qw(gmake gnumake make); -if ($opts{'gmake'}) { unshift @makenames, $opts{'gmake'}; } -my $gmake = get_gmake(@makenames); -if ($gmake) { - if ($print) { print "using $gmake$eol"; } -} else { - print "\n". - "** Cannot find a valid GNU make. Tried:\n". - "@makenames\n"; - die "The name of GNU make on your system can be specified to configure via\n". - "the -gmake option. Make sure this\n". - "name is in your path (add the appropriate directory to your PATH\n". - "environment variable) or specify an absolute pathname.\n"; -} - -#----------------------------------------------------------------------------------------------- -# Name of CAM executable. -if (defined $opts{'cam_exe'}) { - $cfg_ref->set('cam_exe', $opts{'cam_exe'}); -} -my $cam_exe = $cfg_ref->get('cam_exe'); - -if ($print>=2) { print "Name of CAM executable: $cam_exe$eol"; } - -#----------------------------------------------------------------------------------------------- -# Set default Fortran and C compilers -my $fc = ''; -my $fc_type = ''; -my $cc = ''; - -if ($target_os eq 'aix') { - if ($spmd eq 'ON') { - $fc = 'mpxlf95_r'; - } - else { - $fc = 'xlf95_r'; - } - $fc_type = 'ibm'; - $cc = 'mpcc_r'; -} -elsif ($target_os eq 'linux') { - $fc='gfortran'; -} -elsif ($target_os eq 'darwin') { - - my $uname_m = `uname -m`; - if ($uname_m =~ /ppc/) { - - if ($spmd eq 'ON') { - $fc = 'mpxlf95_r;' - } - else { - $fc = 'xlf95_r'; - } - $fc_type = 'ibm'; - $cc = 'xlc'; - } - else { - $fc = 'ifort'; - $cc = 'gcc'; - } -} -elsif ($target_os eq 'bgl') { - $fc = 'blrts_xlf95'; - $cc = 'blrts_xlc'; -} -elsif ($target_os eq 'bgp') { - $fc = 'mpixlf95_r'; - $cc = 'mpixlc_r'; -} -elsif ($target_os eq 'bgq') { - $fc = 'mpixlf2003_r'; - $cc = 'mpixlc_r'; -} - -# User override for Fortran compiler -if (defined $opts{'fc'}) { $fc = $opts{'fc'}; } - -if ($fc) { - $cfg_ref->set('fc', $fc); - if ($print>=2) { print "Fortran compiler: $fc$eol"; } -} -else { - # If no default or user specification for Fortran compiler then die. - die "Default for Fortran compiler not found. Specify using the '-fc' argument.$eol"; -} - -# fc_type is used to identify the type of fortran compiler when it is being invoked -# using a generic name such as mpif90 or ftn. This is currently only used in the Linux -# section of the Makefile. - -if ($fc =~ /pgf/) { $fc_type = 'pgi'; } -elsif ($fc =~ /ifort/) { $fc_type = 'intel'; } -elsif ($fc =~ /^nag/) { $fc_type = 'nag'; } -elsif ($fc =~ /path/) { $fc_type = 'pathscale'; } -elsif ($fc =~ /gfort/) { $fc_type = 'gnu'; } -elsif ($fc =~ /xlf/) { $fc_type = 'ibm'; } - -# User override for Fortran compiler type -if (defined $opts{'fc_type'}) { $fc_type = $opts{'fc_type'}; } - -if ($fc_type) { - $cfg_ref->set('fc_type', $fc_type); - if ($print>=2) { print "Fortran compiler type: $fc_type$eol"; } -} -else { - - # The Linux section of the Makefile depends on the FC_TYPE macro. Fail if - # target_os is linux and fc_type hasn't been set. - if ($target_os eq 'linux') { - die "Fortran compiler type must be set on Linux platform. Specify using the '-fc_type' argument.$eol"; - } -} - -# If a default hasn't been set yet for CC then set one now. -if ($cc eq '') { - - # On platforms where the programming environment is set up using a package managing - # tool like "module" or "dotkit" then the compilers are invoked using scripts with - # generic names like "ftn" and "cc". The following code to set the default CC - # compiler recognizes this special case: - - if ($fc eq 'ftn') { - - $cc = 'cc'; - - } - elsif ($fc eq 'mpif90') { - - $cc = 'mpicc'; - - } - else { - - # Set default C compiler based on fc_type - if ($fc_type eq 'pgi') { $cc = 'pgcc'; } - elsif ($fc_type eq 'intel') { $cc = 'icc'; } - elsif ($fc_type eq 'nag') { $cc = 'gcc'; } - elsif ($fc_type eq 'pathscale') { $cc = 'pathcc'; } - elsif ($fc_type eq 'gnu') { $cc = 'gcc'; } - elsif ($fc_type eq 'ibm') { $cc = 'xlc'; } - } -} - -# User override for C compiler -if (defined $opts{'cc'}) { $cc = $opts{'cc'}; } - -# If the C compiler has not been set yet... -unless ($cc) { $cc = 'cc';} - -$cfg_ref->set('cc', $cc); -if ($print>=2) { print "C compiler: $cc$eol"; } - - -#----------------------------------------------------------------------------------------------- -# Allow override of Makefile default linker -my $linker = ''; -if (defined $opts{'linker'}) { - $linker = $opts{'linker'}; -} -$cfg_ref->set('linker', $linker); - -if ($linker and $print>=2) { print "Setting linker to: $linker$eol"; } - -#----------------------------------------------------------------------------------------------- -# Use compiler debugging options? -my $debug_opt = (defined $opts{'debug'}) ? 1 : 0; -$cfg_ref->set('debug', $debug_opt); -my $debug = $debug_opt ? 'ON': 'OFF'; - -if ($print>=2) { print "Compiler debugging options: $debug$eol"; } - -#----------------------------------------------------------------------------------------------- -# Append to Makefile default C compiler options -my $cflags = ''; -if (defined $opts{'cflags'}) { - $cflags = $opts{'cflags'}; -} -$cfg_ref->set('cflags', $cflags); - -if ($cflags and $print>=2) { print "Setting additional C compiler options: \'$cflags\'$eol"; } - -#----------------------------------------------------------------------------------------------- -# Append to Makefile default Fortran compiler options -my $fflags = ''; -if (defined $opts{'fflags'}) { - $fflags = $opts{'fflags'}; -} -$cfg_ref->set('fflags', $fflags); - -if ($fflags and $print>=2) { print "Setting additional Fortran compiler options: \'$fflags\'$eol"; } - -#----------------------------------------------------------------------------------------------- -# Fortran compiler optimization overrides Makefile defaults -my $fopt = ''; -if (defined $opts{'fopt'}) { - $fopt = $opts{'fopt'}; -} -$cfg_ref->set('fopt', $fopt); - -if ($fopt and $print>=2) { print "Override default Fortran optimization flags with: \'$fopt\'$eol"; } - -#----------------------------------------------------------------------------------------------- -# Load options appended to Makefile defaults -my $ldflags = ''; -my $usr_ldflags = ''; -if (defined $opts{'ldflags'}) { - $ldflags = $opts{'ldflags'}; - # Save off the user specification to pass to the MCT configure - $usr_ldflags = $opts{'ldflags'}; -} -$cfg_ref->set('ldflags', $ldflags); - -if ($ldflags and $print>=2) { print "Load options appended to Makefile defaults: \'$ldflags\'$eol"; } - -#----------------------------------------------------------------------------------------------- -# For the CPP tokens, start with the specifications from the commandline. -my $usr_cppdefs = ' '; -if (defined $opts{'cppdefs'}) { - $usr_cppdefs .= " $opts{'cppdefs'}"; -} -$cfg_ref->set('cppdefs', $usr_cppdefs); - -if ($usr_cppdefs and $print>=2) { print "Commandline CPP definitions: \'$usr_cppdefs\'$eol";} - -# The following CPP macro definitions are used to implement the compile-time options. They are -# determined by the configuration parameters that have been set above. They will be appended to -# the CPP definitions that were explicitly set in the defaults file or by the user on the commandline. -my $cfg_cppdefs = ' '; - -# Fortran name mangling -if ($cam_build) { - if ( $fc_type eq 'ibm') { - $cfg_cppdefs .= " -DFORTRAN_SAME"; - } - else { - $cfg_cppdefs .= " -DFORTRANUNDERSCORE"; - } -} - -# Building for perturbation growth tests -if ($pergro eq "ON") { $cfg_cppdefs .= " -DPERGRO"; } - -# Building for superparameterization -my $spcam_clubb_sgs = $cfg_ref->get('spcam_clubb_sgs'); -my $spcam_nx = $cfg_ref->get('spcam_nx'); -my $spcam_ny = $cfg_ref->get('spcam_ny'); -my $spcam_nz = $cfg_ref->get('spcam_nz'); -my $spcam_dx = $cfg_ref->get('spcam_dx'); -my $spcam_dt = $cfg_ref->get('spcam_dt'); - -my $yes3Dval = 1; # default to 3D for spcam -if ($spcam_ny eq 1) {$yes3Dval = 0;} #Turn off if not using 3D - -if ($phys_pkg eq 'spcam_m2005' or $phys_pkg eq 'spcam_sam1mom') { - $cfg_cppdefs .= " -DSPCAM_NX=$spcam_nx -DSPCAM_NY=$spcam_ny -DSPCAM_NZ=$spcam_nz -DSPCAM_DX=$spcam_dx -DSPCAM_DT=$spcam_dt -DYES3DVAL=$yes3Dval -DCRM "; - if ( $spcam_clubb_sgs == 1 ) { - $cfg_cppdefs .= "-DSPCAM_CLUBB_SGS -DCLUBB_CRM -DCLUBB_REAL_TYPE=dp -DCLUBB_SAM"; ## -DNO_LAPACK_ISNAN"; - } -} - -if ($phys_pkg eq 'spcam_m2005') {$cfg_cppdefs .= " -DECPP -Dm2005";} - -if ($phys_pkg eq 'spcam_sam1mom') {$cfg_cppdefs .= " -Dsam1mom";} - -# Configure CAM to produce IOP files for SCAM -if ($camiop eq 'ON') { $cfg_cppdefs .= " -DBFB_CAM_SCAM_IOP"; } - -# Resolution parameters for rectangular lat/lon grids -my $nlon = $cfg_ref->get('nlon'); -my $nlat = $cfg_ref->get('nlat'); -$cfg_cppdefs .= " -DPLON=$nlon -DPLAT=$nlat"; - -# Parameters for multiple instances -if (!$ccsm_seq){ - $cfg_cppdefs .= " -DNUM_COMP_INST_ATM=1 -DNUM_COMP_INST_LND=1 -DNUM_COMP_INST_OCN=1 -DNUM_COMP_INST_ICE=1"; - $cfg_cppdefs .= " -DNUM_COMP_INST_GLC=1 -DNUM_COMP_INST_ROF=1 -DNUM_COMP_INST_WAV=1 -DNUM_COMP_INST_ESP=1"; -} - -# Parameters for spectral element dycore. -# HAVE_F2003_PTR_BND_REMAP definition turns on standard-conforming method of causing edge -# buffers to overlap. This method works in all CAM compilers. -if ($dyn_pkg eq 'se') { - - my $csnp = $cfg_ref->get('csnp'); - $cfg_cppdefs .= " -DCAM -D_WK_GRAD -DNP=$csnp -DHAVE_F2003_PTR_BND_REMAP"; - - # Check to see if physics grid is being used - my $npg = $cfg_ref->get('npg'); - if ($npg > 0) { - die "CSLAM and FVM physics grid are not currently supported.$eol"; - } - - if ($smp eq 'ON') { - $cfg_cppdefs .= " -D_OPENMP"; - } - - if ($spmd eq 'ON') { - $cfg_cppdefs .= " -D_MPI"; - } -} - -# Resolution parameters for vertical grid, number of constituents, chunk size -my $nlev = $cfg_ref->get('nlev'); -my $nadv = $cfg_ref->get('nadv'); -my $pcols = $cfg_ref->get('pcols'); -my $psubcols = $cfg_ref->get('psubcols'); -$cfg_cppdefs .= " -DPLEV=$nlev -DPCNST=$nadv -DPCOLS=$pcols -DPSUBCOLS=$psubcols"; - -# Radiatively active constituent number -$cfg_cppdefs .= " -DN_RAD_CNST=$max_n_rad_cnst"; - -# Spectral truncation parameters -my $trm = $cfg_ref->get('trm'); -my $trn = $cfg_ref->get('trn'); -my $trk = $cfg_ref->get('trk'); -$cfg_cppdefs .= " -DPTRM=$trm -DPTRN=$trn -DPTRK=$trk"; - -# offline driver for FV dycore -if ($offline_dyn) { $cfg_cppdefs .= ' -DOFFLINE_DYN'; } - -# -DSPMD only added for CESM build. The CAM Makefile has a separate SPMD macro. -if ( ($ccsm_seq) and ($spmd eq 'ON') ) { $cfg_cppdefs .= " -DSPMD"; } - -# Chem CPP defs -$cfg_cppdefs .= $chem_cppdefs; - -# CARMA CPP defs -$cfg_cppdefs .= $carma_cppdefs; - -#Analytic initial conditions for dynamics state? -if ($cfg_ref->get('analytic_ic')) { - $cfg_cppdefs .= ' -DANALYTIC_IC'; -} - -#WACCM-X extended thermosphere/ionosphere model -if ($waccmx) { - $cfg_cppdefs .= ' -DWACCMX_PHYS'; - if (($dyn_pkg ne 'fv') and ($ionos ne 'none')) { - die "ERROR: Ionosphere is only available for FV dycore \n"; - } - if ($ionos =~ /wxi/) { - $cfg_cppdefs .= ' -DWACCMX_IONOS'; - } - if ($ionos =~ /wxie/) { - $cfg_cppdefs .= ' -DWACCMX_EDYN_ESMF'; - } -} - -# PIO -my $pio2_build = (defined $opts{'pio2'}) ? 1 : 0; -if ($cam_build) { - if (!$pio2_build) { - # Only needed for pio1 - $cfg_cppdefs .= " -D_USEBOX"; - } -} - -# COSP simulator -if ($cosp) { $cfg_cppdefs .= ' -DUSE_COSP'; } - -# CLUBB, hardcode CLUBB precision to kind=8 -if ($clubb_sgs == 1) { - $cfg_cppdefs .= ' -DCLUBB_SGS'; - $cfg_cppdefs .= ' -DCLUBB_CAM'; - $cfg_cppdefs .= ' -DNO_LAPACK_ISNAN'; - $cfg_cppdefs .= " -DCLUBB_REAL_TYPE=dp"; -} - -# UNICON -if ($unicon) { $cfg_cppdefs .= ' -DUSE_UNICON'; } - -# GPTL Timing library -# The GPTL configure script in timing/gptl/suggestions may help -# if modifications are needed here. -$cfg_cppdefs .= ' -DHAVE_VPRINTF -DHAVE_TIMES -DHAVE_GETTIMEOFDAY -DHAVE_COMM_F2C'; -unless ($target_os eq 'aix' or $target_os =~ 'bg' or $target_os eq 'darwin') { - $cfg_cppdefs .= ' -DHAVE_NANOTIME -DBIT64 -DHAVE_SLASHPROC'; -} -#----------------------------------------------------------------------------------------------- -# External libraries ########################################################################### -#----------------------------------------------------------------------------------------------- - -#----------------------------------------------------------------------------------------------- -# NetCDF include -my $nc_inc = ''; -if ($cam_build) { - if (defined $opts{'nc_inc'}) { - $nc_inc = $opts{'nc_inc'}; - } - elsif (defined $ENV{INC_NETCDF}) { - $nc_inc = $ENV{INC_NETCDF}; - } - - $cfg_ref->set('nc_inc', $nc_inc); - - if ($nc_inc and $print>=2) { print "Will look for NetCDF include file in: $nc_inc$eol"; } -} - -# NetCDF library -my $nc_lib = ''; -my $nc_ldflags = ''; -if ($cam_build) { - if (defined $opts{'nc_lib'}) { - $nc_lib = $opts{'nc_lib'}; - } - elsif (defined $ENV{LIB_NETCDF}) { - $nc_lib = $ENV{LIB_NETCDF}; - } - - $cfg_ref->set('nc_lib', $nc_lib); - if ($nc_lib and $print>=2) { print "Will look for netCDF library in: $nc_lib$eol"; } - - # If the location of the NetCDF libraries has not been specified, then - # assume the compiler wrapper script is providing the information. - # Otherwise we attempt to set the necessary link arguments in the - # nc_ldflags variable using the nc-config utility. We check that - # nc-config returns at least the netcdff and netcdf libraries, and - # if not then attempt using a generic setting. - - if ($nc_lib ne '') { - if (-f "$nc_lib/../bin/nc-config") { - $nc_ldflags = `$nc_lib/../bin/nc-config --flibs --libs`; - $nc_ldflags =~ s/\n/ /g; # replace newlines with spaces - if ($?) { - if ($print >= 2) {print "INFO: error return from: nc-config --flibs --libs \n";} - $nc_ldflags = ''; - } - } - - # If the nc-config script was not found, or if it returned an error - # status, or if they return a string that doesn't contain two - # library (-l) specifiers, then try default link args. - - if ($nc_ldflags !~ m/-l.*-l/) { - $nc_ldflags = "-L$nc_lib -lnetcdff -lnetcdf"; - } - - # Set rpath for shared libs. First check whether the nc-config script - # has already set an arg to be passed to the linker. - if ($nc_ldflags !~ m/-Wl/) { - if ($fc_type eq 'nag') { - $nc_ldflags .= " -Wl,-Wl,,-rpath -Wl,-Wl,,$nc_lib"; - } - else { - $nc_ldflags .= " -Wl,-rpath -Wl,$nc_lib"; - } - } - - } - - $cfg_ref->set('nc_ldflags', $nc_ldflags); - if ($nc_ldflags and $print>=2) { print "Link flags for netCDF library: $nc_ldflags$eol"; } - - # PIO Support - if (!$pio2_build) { - # Only needed for pio1 - $cfg_cppdefs .= " -D_NETCDF "; - } -} - -# NetCDF module files -my $nc_mod = ''; -if ($cam_build) { - if (defined $opts{'nc_mod'}) { - $nc_mod = $opts{'nc_mod'}; - } - elsif (defined $ENV{MOD_NETCDF}) { - $nc_mod = $ENV{MOD_NETCDF}; - } - - # check for the mod files in the user specified location - if ($nc_mod and (-f "$nc_mod/netcdf.mod" or -f "$nc_mod/NETCDF.mod") - and (-f "$nc_mod/typesizes.mod" or -f "$nc_mod/TYPESIZES.mod") ) { - } - # if not there check in the netcdf lib directory - elsif ($nc_lib and (-f "$nc_lib/netcdf.mod" or -f "$nc_lib/NETCDF.mod") - and (-f "$nc_lib/typesizes.mod" or -f "$nc_lib/TYPESIZES.mod") ) { - $nc_mod = $nc_lib; - } - # then check in the netcdf include directory - elsif ($nc_inc and (-f "$nc_inc/netcdf.mod" or -f "$nc_inc/NETCDF.mod") - and (-f "$nc_inc/typesizes.mod" or -f "$nc_inc/TYPESIZES.mod") ) { - $nc_mod = $nc_inc; - } - else { - $nc_mod = ''; - } - $cfg_ref->set('nc_mod', $nc_mod); - - if ($nc_mod and $print>=2) { print "Found netCDF module files in: $nc_mod$eol"; } -} - -# PNetCDF include -my $pnc_inc = ''; -if ($cam_build) { - if (defined $opts{'pnc_inc'}) { - $pnc_inc = $opts{'pnc_inc'}; - } - elsif (defined $ENV{INC_PNETCDF}) { - $pnc_inc = $ENV{INC_PNETCDF}; - } - else { - $pnc_inc = '/usr/local/include'; - } - - if (-f "$pnc_inc/pnetcdf.inc") { - $cfg_ref->set('pnc_inc', $pnc_inc); - if ($print>=2) { print "Found PnetCDF include file in: $pnc_inc$eol"; } - }else{ - undef $pnc_inc; - } -} - -# PNetCDF library -my $pnc_lib = ''; -if ($cam_build) { - if (defined $opts{'pnc_lib'}) { - $pnc_lib = $opts{'pnc_lib'}; - } - elsif (defined $ENV{LIB_PNETCDF}) { - $pnc_lib = $ENV{LIB_PNETCDF}; - } - else { - $pnc_lib = '/usr/local/lib'; - } - - if (-f "$pnc_lib/libpnetcdf.a" and $spmd eq 'ON') { - $cfg_ref->set('pnc_lib', $pnc_lib); - if ($print>=2) { print "Found PnetCDF library in: $pnc_lib$eol"; } - # PIO Support - $cfg_cppdefs .= " -D_PNETCDF "; - }else{ - undef $pnc_lib; - } -} - -#----------------------------------------------------------------------------------------------- -# LAPACK library -my $lapack_libdir = ''; -if ($cam_build) { - if (defined $opts{'lapack_libdir'}) { - $lapack_libdir = $opts{'lapack_libdir'}; - } - elsif (defined $ENV{LAPACK_LIBDIR}) { - $lapack_libdir = $ENV{LAPACK_LIBDIR}; - } - - if ($lapack_libdir ne '') { - if (-f "$lapack_libdir/liblapack.a") { - $cfg_ref->set('lapack_libdir', $lapack_libdir); - } - elsif (-f "$lapack_libdir/liblapack.so") { - $cfg_ref->set('lapack_libdir', $lapack_libdir); - } - elsif (-f "$lapack_libdir/liblapack.dylib") { - $cfg_ref->set('lapack_libdir', $lapack_libdir); - } - else { - die <<"EOF"; -** Cannot find liblapack.a in specified directory: $lapack_libdir -** -** The LAPACK library directory is determined from the following set of options listed -** from highest to lowest precedence: -** * by the command-line option -lapack_libdir -** * by the environment variable LAPACK_LIBDIR -EOF - } - } - - if ($lapack_libdir and $print>=2) { print "Found LAPACK library in: $lapack_libdir$eol"; } -} - -#----------------------------------------------------------------------------------------------- -# ESSL library -- add this library to the LDFLAGS for CAMChem when we're on an AIX system. -# Assume that the xlf compiler is used to link. -if ($cam_build) { - if ($chem_pkg and $target_os eq 'aix') { - my $ldflags = $cfg_ref->get('ldflags'); - $ldflags .= " -lessl"; - $cfg_ref->set('ldflags', $ldflags); - } -} - -#----------------------------------------------------------------------------------------------- -# MPI -# Only check for the MPI include or library files if the user has explicitly specified -# where to look. Often the Fortran compiler knows where to look for these files and so -# not specifying them is the best strategy. -my $mpi_inc = ''; -my $mpi_lib = ''; -my $mpi_lib_name = ''; -if ($cam_build and $spmd eq 'ON') { - - # MPI include - if (defined $opts{'mpi_inc'}) { - $mpi_inc = $opts{'mpi_inc'}; - } - elsif (defined $ENV{INC_MPI}) { - $mpi_inc = $ENV{INC_MPI}; - } - - if ($mpi_inc eq '' or -f "$mpi_inc/mpif.h") { - $cfg_ref->set('mpi_inc', $mpi_inc); - } - else { - die <<"EOF"; -** Cannot find mpif.h in specified directory: $mpi_inc -** -** The MPI include directory is determined from the following set of options listed -** from highest to lowest precedence: -** * by the command-line option -mpi_inc -** * by the environment variable INC_MPI -EOF - } - - if ($mpi_inc and $print>=2) { print "Found MPI include file in: $mpi_inc$eol"; } - - # MPI library - if (defined $opts{'mpi_lib'}) { - $mpi_lib = $opts{'mpi_lib'}; - } - elsif (defined $ENV{LIB_MPI}) { - $mpi_lib = $ENV{LIB_MPI}; - } - - if ($mpi_lib eq '') { - $cfg_ref->set('mpi_lib', $mpi_lib); - $cfg_ref->set('mpi_lib_name', ''); - } - elsif (-f "$mpi_lib/libmpi.a" or -f "$mpi_lib/libmpi.so") { - $cfg_ref->set('mpi_lib', $mpi_lib); - $cfg_ref->set('mpi_lib_name', 'mpi'); - } - elsif (-f "$mpi_lib/libmpich.a") { - $cfg_ref->set('mpi_lib', $mpi_lib); - $cfg_ref->set('mpi_lib_name', 'mpich'); - if (-f "$mpi_lib/../bin/mpich2version") { - $cfg_cppdefs .= " -DNO_SIZEOF"; - } else { - $cfg_cppdefs .= " -DNO_MPI2 -DNO_MPIMOD -DNO_SIZEOF"; - } - } - else { - die <<"EOF"; -** Cannot find libmpi.a, libmpi.so or libmpich.a in specified directory: $mpi_lib -** -** The MPI library directory is determined from the following set of options listed -** from highest to lowest precedence: -** * by the command-line option -mpi_lib -** * by the environment variable LIB_MPI -EOF - } - - if ($mpi_lib and $print>=2) { print "Found MPI library in: $mpi_lib$eol"; } - -} - -#----------------------------------------------------------------------------------------------- -# ESMF library. - -my $esmf_libdir = ''; -if (defined $opts{'esmf_libdir'}) { - $esmf_libdir = $opts{'esmf_libdir'}; -} -elsif (defined $ENV{ESMF_LIBDIR}) { - $esmf_libdir = $ENV{ESMF_LIBDIR}; -} - -if ($cam_build and $esmf_libdir) { - - # Check that both the library and the esmf.mk file are found. Makefile macros - # defined in esmf.mk are referenced by the Makefile. - if ( (-f "$esmf_libdir/libesmf.a" or -f "$esmf_libdir/libesmf.so") and -f "$esmf_libdir/esmf.mk" ) { - $cfg_ref->set('esmf_libdir', $esmf_libdir); - - $cfg_cppdefs .= " -DUSE_ESMF_LIB"; - - if ($print>=2 ) { print "Found ESMF library in: $esmf_libdir$eol"; } - } - else { - die <<"EOF"; -** Cannot find libesmf.a, libesmf.so, or esmf.mk in specified directory: $esmf_libdir -** -** The ESMF library directory is determined from the following set of options listed -** from highest to lowest precedence: -** * by the command-line option -esmf_libdir -** * by the environment variable ESMF_LIBDIR -EOF - } - -} - -#----------------------------------------------------------------------------------------------- -# CPP defines to put on Makefile - -my $make_cppdefs = "$usr_cppdefs $cfg_cppdefs"; - -if ($print>=2) { print "CPP definitions set by configure: \'$cfg_cppdefs\'$eol"; } - - -#----------------------------------------------------------------------------------------------- -# COSP library. -if ($cosp) { - - # Set the directory used to build cosp. Add location and library name - # to the user specified load flags. - my $cosp_libdir = ''; - if (defined $opts{'cosp_libdir'}) { - $cosp_libdir = $opts{'cosp_libdir'}; - } else - { - $cosp_libdir = "$cam_bld/cosp"; - } - - $cfg_ref->set('cosp_libdir', "$cosp_libdir"); - - my $ldflags = $cfg_ref->get('ldflags'); - $ldflags .= " -L$cosp_libdir -lcosp "; - $cfg_ref->set('ldflags', $ldflags); - - # create the build directory for cosp - my $bld_dir = $cosp_libdir; - unless (-d $bld_dir or mkdirp($bld_dir)) { - die "** Could not create the cosp build directory: $bld_dir\n"; - } - - # Create the COSP Makefile from a template and copy it into the cosp bld directory - write_cosp_makefile("$cfgdir/../src/physics/cosp2/Makefile.in", "$cosp_libdir/Makefile"); - if ($print) { print "creating $cosp_libdir/Makefile\n"; } -} - - -#----------------------------------------------------------------------------------------------- -# MCT library. -# Only build MCT as a separate library if doing a CAM standalone build. -# If -mct_libdir is specified, then check for existing libs and build -# only if necessary. Note that separate versions of the lib must be built -# for parallel and serial use. - -if ($cam_build) { - - my $mct_libdir = "$cam_bld/mct"; - if (defined $opts{'mct_libdir'}) { - $mct_libdir = $opts{'mct_libdir'}; - } - elsif (defined $ENV{MCT_LIBDIR}) { - $mct_libdir = $ENV{MCT_LIBDIR}; - } - - # strip a trailing slash - $mct_libdir =~ s!/$!!; - - # modify the name of the serial version so it can be made in the same - # directory as the parallel version - if ($spmd eq 'OFF') { - $mct_libdir .= '-serial'; - } - $cfg_ref->set('mct_libdir', $mct_libdir); - - my $ldflags = $cfg_ref->get('ldflags'); - $ldflags .= " -L$mct_libdir/mct -lmct -L$mct_libdir/mpeu -lmpeu "; - if ($spmd eq 'OFF') { - $ldflags .= " -L$mct_libdir/mpi-serial -lmpi-serial "; - } - $cfg_ref->set('ldflags', $ldflags); - - # Check whether the MCT libs already exist. The MCT configuration here is - # set up to build mct, mpeu, and mpi-serial libs. So either they all should - # exist, or non of them should exist. Otherwise it's an error. - my $libs_exist = 0; - my $libs_expected = 2; - if (-f "$mct_libdir/mct/libmct.a" or - -f "$mct_libdir/mct/libmct.so") {++$libs_exist;} - if (-f "$mct_libdir/mpeu/libmpeu.a" or - -f "$mct_libdir/mpeu/libmpeu.so") {++$libs_exist;} - if ($spmd eq 'OFF') { - $libs_expected = 3; - if (-f "$mct_libdir/mpi-serial/libmpi-serial.a" or - -f "$mct_libdir/mpi-serial/libmpi-serial.so") {++$libs_exist;} - } - - my $build_mct; - if ($libs_exist == 0) { - $build_mct = 1; - } - elsif ($libs_exist == $libs_expected) { - $build_mct = 0; - } - else { - die <<"EOF"; -** The MCT build in $mct_libdir is incomplete. Remove the contents of - $mct_libdir and run the CAM configure script again. ** -EOF - } - - - if ($build_mct) { - - # If the libdirs do not exist then create them. - if (! -d "$mct_libdir/mct") { - mkdirp("$mct_libdir/mct") or - die "** Could not create the mct build directory: $mct_libdir/mct\n"; - } - if (! -d "$mct_libdir/mpeu") { - mkdirp("$mct_libdir/mpeu") or - die "** Could not create the mct build directory: $mct_libdir/mpeu\n"; - } - - if ($spmd eq 'OFF') { - # The mpi-serial lib is only built when the mct and mpeu libs are configured - # to run in a serial mode (with the --enable-mpiserial option). - if (! -d "$mct_libdir/mpi-serial") { - mkdirp("$mct_libdir/mpi-serial") or - die "** Could not create the mct build directory: $mct_libdir/mpi-serial\n"; - } - } - - system("cp $cam_root/cime/src/externals/mct/Makefile $mct_libdir/.") == 0 - or die "Unable to copy mct top level Makefile\n"; - system("cp $cam_root/cime/src/externals/mct/mct/Makefile $mct_libdir/mct/.") == 0 - or die "Unable to copy mct Makefile\n"; - system("cp $cam_root/cime/src/externals/mct/mpeu/Makefile $mct_libdir/mpeu/.") == 0 - or die "Unable to copy mpeu Makefile\n"; - if ($spmd eq 'OFF') { - system("cp $cam_root/cime/src/externals/mct/mpi-serial/Makefile $mct_libdir/mpi-serial/.") == 0 - or die "Unable to copy mpi-serial Makefile\n"; - system("cp $cam_root/cime/src/externals/mct/mpi-serial/mpif.h $mct_libdir/mpi-serial/.") == 0 - or die "Unable to copy mpi-serial/mpif.h \n"; - system("cp $cam_root/cime/src/externals/mct/mpi-serial/mpi.h $mct_libdir/mpi-serial/.") == 0 - or die "Unable to copy mpi-serial/mpi.h\n"; - } - - my $mct_quiet = '> /dev/null 2>&1'; - if ($print >= 2) {$mct_quiet = '';} - - my $mct_debug = ''; - if ($debug eq 'ON') {$mct_debug = '--enable-debugging';} - - my $mpi_serial = '--enable-mpiserial'; - if ($spmd eq 'ON') {$mpi_serial = '';} - - my $mpi_hdr = ''; - if ($spmd eq 'ON') { - if ($mpi_inc) {$mpi_hdr = "MPIHEADER=-I$mpi_inc"; } - } - - # Set F[C]FLAGS for MCT for compilers where the defaults won't work. - # Blank string does nothing, letting MCT's configure decide. - my $mct_flags_str = " "; - my $mct_ldflags = " "; - if ($fc_type eq "nag") { - # Take options from CESM's Machines directory. - $mct_flags_str = " -O2 -wmismatch=mpi_send,mpi_recv,mpi_bcast,". - "mpi_allreduce,mpi_reduce,mpi_isend,mpi_irecv,mpi_irsend,mpi_rsend,mpi_gatherv,". - "mpi_gather,mpi_scatterv,mpi_allgather,mpi_alltoallv,mpi_file_read_all,". - "mpi_file_write_all,mpibcast,mpiscatterv "; - - if ($debug eq 'ON') { $mct_flags_str .= " -g -gline -time -f95 -C=all "; } - - # Set to both FFLAGS and FCFLAGS to ensure all files use this. - $mct_flags_str = " FFLAGS=\"$mct_flags_str\" ". - "FCFLAGS=\"$mct_flags_str\" "; - - # This workaround tells gcc how to link to the NAG runtime, - # which is the only way to run MCT's configure with runtime - # checks enabled. - # Note that this hard-codes the NAG path, lib62rts for NAG6.2. - if ($debug eq 'ON') { - $mct_flags_str .= " CFLAGS=\" -g -Wl,--as-needed,--allow-shlib-undefined\" "; - $mct_flags_str .= " LIBS=\" -L/usr/local/nag-6.2/lib/NAG_Fortran -lf62rts \" "; - } - } - elsif ($fc_type eq "pgi") { - - # 11 Feb 2014: This is a workaround for a problem with PGI-13 - # on the CGD cluster when pgf90 is invoked by the openmpi - # version of mpif90 (undefined omp_set_schedule in pgf90rtl lib) - $mct_ldflags = "-Wl,--allow-shlib-undefined "; - } - - $mct_ldflags = "LDFLAGS=\'$mct_ldflags\' "; - - my $cfg_cmnd = "$cam_root/cime/src/externals/mct/configure FC=$fc CC=$cc ". - "$mct_flags_str --srcdir=$cam_root/cime/src/externals/mct $mpi_hdr ". - "$mpi_serial $mct_debug $mct_quiet $mct_ldflags "; - - chdir $mct_libdir or die "FAILURE: cd to $mct_libdir\n"; - system($cfg_cmnd) == 0 or die "FAILURE: MCT configure\n"; - chdir $cam_bld or die "FAILURE: cd to $cam_bld\n"; - - if ($print) {print "MCT configure is done.\n";} - } - else { - if ($print) {print "Using MCT libs in $mct_libdir.\n";} - } -} - -#----------------------------------------------------------------------------------------------- -# PIO library. -# Only build PIO as a separate library if doing a CAM standalone build with PIO2. -# If -pio2_install_dir is specified, then check for existing libs and build -# only if necessary. Note that separate versions of the lib must be built -# for parallel and serial use. - -if ($cam_build and $pio2_build) { - - my $pio_build_dir = "$cam_bld/pio_bld"; - my $pio_install_dir = "$cam_bld/pio"; - if (defined $opts{'pio2_install_dir'}) { - $pio_install_dir = $opts{'pio2_install_dir'}; - } - elsif (defined $ENV{PIO2_INSTALL_DIR}) { - $pio_install_dir = $ENV{PIO2_INSTALL_DIR}; - } - - # strip a trailing slash - $pio_install_dir =~ s!/$!!; - - # modify the name of the serial version so it can be made in the same - # directory as the parallel version - if ($spmd eq 'OFF') { - $pio_build_dir .= '-serial'; - $pio_install_dir .= '-serial'; - } - $cfg_ref->set('pio_build_dir', $pio_build_dir); - $cfg_ref->set('pio_install_dir', $pio_install_dir); - - my $ldflags = $cfg_ref->get('ldflags'); - # prepend the pio libs. The serial build which depends on the MCT mpi-serial - # lib needs to come after the pio libs to properly resolve mpi references. - $ldflags = " -L$pio_install_dir/lib -lpiof -lpioc $ldflags "; - $cfg_ref->set('ldflags', $ldflags); - - # Check whether the PIO libs already exist. - my $libs_exist = 0; - my $libs_expected = 2; - if (-f "$pio_install_dir/lib/libpioc.a" or - -f "$pio_install_dir/lib/libpioc.so") {++$libs_exist;} - if (-f "$pio_install_dir/lib/libpiof.a" or - -f "$pio_install_dir/lib/libpiof.so") {++$libs_exist;} - - my $build_pio; - if ($libs_exist == 0) { - $build_pio = 1; - } - elsif ($libs_exist == $libs_expected) { - $build_pio = 0; - } - else { - die <<"EOF"; -** PIO build in $pio_install_dir is incomplete. Remove the contents of - $pio_install_dir and run the CAM configure script again. ** -EOF - } - - if ($build_pio) { - - # The PIO configuration requires CMake. Check return from --version just as a way - # to make sure it is found in user path. - if ($print) { print "Looking for a valid CMake... "; } - my $cmake_ver = get_cmake_version(); - if ($cmake_ver) { - if ($print) { print "using cmake version $cmake_ver$eol"; } - } else { - print "\n** Cannot find a valid CMake.\n"; - die "** CMake must be installed on your system and the cmake command in your PATH\n"; - } - - # If the build directory does not exist then create it. - if (! -d "$pio_build_dir") { - mkdirp("$pio_build_dir") or - die "** Could not create the PIO build directory: $pio_build_dir\n"; - } - - # If the install directory does not exist then create it. - if (! -d "$pio_install_dir") { - mkdirp("$pio_install_dir") or - die "** Could not create the PIO install directory: $pio_install_dir\n"; - } - - # Root directory for PIO source code - my $pio_src_dir = "$cam_root/cime/src/externals/pio2"; - - # Set compilers - my $compilers = "FC=$fc CC=$cc"; - - # Set options - my $opts; - - my $nc_lib = $cfg_ref->get('nc_lib'); - if ($nc_lib) {$opts .= "-DNetCDF_PATH=$nc_lib ";} - - $opts .= '-DCMAKE_VERBOSE_MAKEFILE=1 -DPIO_ENABLE_TIMING=OFF -DWITH_PNETCDF=OFF -DPIO_ENABLE_TESTS=OFF '; - - $opts .= "-DCMAKE_INSTALL_PREFIX=$pio_install_dir "; - - # For serial runs the MPI library is supplied by MCT: - # If the mpi-serial library is already built then specifying MPISERIAL_PATH is - # sufficient since CMake will find what it needs by looking there. But if the - # mpi-serial lib hasn't been built yet, then the MPISERIAL_C_* and MPISERIAL_Fortran_* - # options must be specified to tell CMake where the include and lib files will be - # found after the build is done. - if ($spmd eq 'OFF') { - my $mct_libdir = $cfg_ref->get('mct_libdir'); - $opts .= "-DPIO_USE_MPISERIAL=TRUE "; - $opts .= "-DMPISERIAL_PATH=$mct_libdir/mpi-serial "; - $opts .= "-DMPISERIAL_C_INCLUDE_PATH=$mct_libdir/mpi-serial "; - $opts .= "-DMPISERIAL_C_LIBRARY=$mct_libdir/mpi-serial/libmpi-serial.a "; - $opts .= "-DMPISERIAL_Fortran_INCLUDE_PATH=$mct_libdir/mpi-serial "; - $opts .= "-DMPISERIAL_Fortran_LIBRARY=$mct_libdir/mpi-serial/libmpi-serial.a "; - } - - # Configure command - my $cfg_cmnd = "env $compilers cmake $opts $pio_src_dir >| pio_cmake_log 2>&1 "; - - - chdir $pio_build_dir or die "FAILURE: cd to $pio_build_dir\n"; - system($cfg_cmnd) == 0 or die "FAILURE: PIO configure: see $pio_build_dir/pio_cmake_log \n"; - chdir $cam_bld or die "FAILURE: cd to $cam_bld\n"; - - if ($print) {print "PIO configure is done.\n";} - } - else { - if ($print) {print "Using PIO libs in $pio_install_dir.\n";} - } -} - - -#----------------------------------------------------------------------------------------------- -# Write configuration files #################################################################### -#----------------------------------------------------------------------------------------------- - -my $fp_filename = 'Filepath'; # name of output filepath file -my $cpp_filename = 'CESM_cppdefs'; # name of output file for cam's cppdefs in ccsm - -# Write the filepath file. -write_filepath("$cam_bld/$fp_filename", $cfg_ref); -if ($print) { print "creating $cam_bld/$fp_filename\n"; } - -if (($ccsm_seq)) { - - # Write the file for cam's cppdefs needed in ccsm. - write_cppdefs("$cam_bld/$cpp_filename", $make_cppdefs); - if ($print) { print "creating $cam_bld/$cpp_filename\n"; } - -} else { - - # Write the Makefile. - write_makefile("$cfgdir/Makefile.in", "$cam_bld/Makefile", $cfg_ref, $make_cppdefs); - if ($print) { print "creating $cam_bld/Makefile\n"; } - - # Write the config.h file for PIO and MCT - write_config_h("$cam_bld/config.h"); - if ($print) { print "creating $cam_bld/config.h\n"; } - -} - -# Write the configuration cache file. -$cfg_ref->write_file($config_cache_file, $commandline); -if ($print) { print "creating $config_cache_file\n"; } - -#----------------------------------------------------------------------------------------------- -# Finished unless testing requested ############################################################ -#----------------------------------------------------------------------------------------------- -unless ($cam_build and $opts{'test'}) { - if ($print) { print "CAM configure done.\n"; } - exit; -} - -# create a subdirectory of the current directory for testing -my $test_dir = "$cam_bld/configure-tests"; -unless (-d $test_dir or mkdirp($test_dir)) { - die <<"EOF"; -** Could not create the testing directory: $test_dir -EOF -} -chdir( $test_dir ) || die <<"EOF"; -** Trouble changing directory to $test_dir -** -EOF - -# The CAM Makefile requires a Filepath file. To run the tests construct a Filepath file -# that contains only the test directory. -write_tests_filepath($test_dir); - -# Test for Fortran 90 compatible compiler -if ($print) { print "Testing for Fortran 90 compatible compiler... "; } -my $fc = check_fc($gmake, "$cam_bld/Makefile"); -if ($fc) { - if ($print) { print "using $fc$eol"; } -} - -# Test NetCDF library -if ($print) { print "Test linking to NetCDF library... "; } -if (check_netcdf($gmake, "$cam_bld/Makefile")==0) { if ($print) { print "ok$eol"; } } - -# Test MPI library -if ($spmd eq 'ON') { - if ($print) { print "Test linking to MPI library... "; } - if (check_mpi($gmake, "$cam_bld/Makefile")==0) { if ($print) { print "ok$eol"; } } -} - -# Test ESMF library -if ($esmf_libdir) { - if ($print) { print "Test linking to ESMF library... "; } - if (check_esmf($gmake, "$cam_bld/Makefile")==0) { if ($print) { print "ok$eol"; } } -} - -#----------------------------------------------------------------------------------------------- -# Done testing. -chdir( $cwd ) || die <<"EOF"; -** Trouble changing directory back to $cwd -** -EOF -if ($print) { print "CAM configure done.\n"; } -exit; - -#----------------------------------------------------------------------------------------------- -# REALLY FINISHED ############################################################################## -#----------------------------------------------------------------------------------------------- - -sub write_filepath -{ - my ($file, $cfg_ref) = @_; - my $fh = new IO::File; - - $fh->open(">$file") or die "** can't open filepath file: $file\n"; - - # configuration parameters used to determine paths - my $cam_root = $cfg_ref->get('cam_root'); - my $usr_src = $cfg_ref->get('usr_src'); - my $chem_proc_src = $cfg_ref->get('chem_proc_src'); - my $chem_src_dir = $cfg_ref->get('chem_src_dir'); - my $chem = $cfg_ref->get('chem'); - my $waccm_phys = $cfg_ref->get('waccm_phys'); - my $waccmx = $cfg_ref->get('waccmx'); - my $ionos = $cfg_ref->get('ionosphere'); - my $carma = $cfg_ref->get('carma'); - my $rad = $cfg_ref->get('rad'); - my $dyn = $cfg_ref->get('dyn'); - my $cppdefs = $cfg_ref->get('cppdefs'); - my $cosp = $cfg_ref->get('cosp'); - my $spmd = $cfg_ref->get('spmd'); - my $esmf_libdir = $cfg_ref->get('esmf_libdir'); - my $ocn = $cfg_ref->get('ocn'); - my $offline_drv = $cfg_ref->get('offline_drv'); - my $inic_val = $cfg_ref->get('analytic_ic'); - - # Root directory - my $camsrcdir = "$cam_root/components"; - - # Start writing paths to the file. *** Order is important *** The - # sequence of paths will be used to set the GNU Makefile's VPATH macro - # which tells make where to search for dependencies. - - # User specified source directories. - if ($usr_src =~ /\S+/) { - my @dirs = split ',', $usr_src; - while ( my $dir = shift @dirs ) { - print $fh "$dir\n"; - } - } - - # CESM has a standard source mods location. - if ($ccsm_seq) { - my $CASEROOT = "$ENV{'CASEROOT'}"; - print $fh "$CASEROOT/SourceMods/src.cam\n"; - } - - #NorESM-specific: - #Any files in "NorESM"-folder go before the original CAM-files - #These files MUST give back standard CAM5.3 if a standard CAM5.3 compset is chosen - #Un-commenting this line will give back standard CAM 5.3 (unmodified). - #This is used for testing. - #++djlo - print $fh "$camsrcdir/cam/src/NorESM\n"; - print $fh "$camsrcdir/cam/src/NorESM/$dyn\n"; - #--djlo - - # offline unit driver (defaults to stub) - print $fh "$camsrcdir/cam/src/unit_drivers\n"; - print $fh "$camsrcdir/cam/src/unit_drivers/${offline_drv}\n"; - - if ($simple_phys) { - print $fh "$camsrcdir/cam/src/physics/simple\n"; - } - - if ($carma ne 'none') { - # This directory needs to precede physics/cam/ to replace - # the CARMA stub package with CARMA. Putting it first allows - # any CAM file to be overridden by a particular CARMA model. - print $fh "$camsrcdir/cam/src/physics/carma/models/$carma\n"; - print $fh "$camsrcdir/cam/src/physics/carma/cam\n"; - print $fh "$camsrcdir/cam/src/physics/carma/base\n"; - } - - # CAM chemistry, dynamics, physics, control and shared utilities. - if ($chem_proc_src) { - print $fh "$chem_proc_src\n"; - } - if ($chem_src_dir) { - print $fh "$chem_src_dir\n"; - } - if ($chem =~/_oslo/) { - print $fh "$camsrcdir/cam/src/chemistry/oslo_aero\n"; - print $fh "$camsrcdir/cam/src/physics/cam_oslo\n"; - } - else{ - 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"; - - if ($waccmx) { - print $fh "$camsrcdir/cam/src/physics/waccmx\n"; - if ($ionos =~ /wxi/) { - print $fh "$camsrcdir/cam/src/ionosphere/waccmx\n"; - } - } - if ($waccm_phys) { - print $fh "$camsrcdir/cam/src/physics/waccm\n"; - } - print $fh "$camsrcdir/cam/src/ionosphere\n"; - - print $fh "$camsrcdir/cam/src/chemistry/mozart\n"; - print $fh "$camsrcdir/cam/src/chemistry/utils\n"; - - if ($rad eq 'rrtmg') { - print $fh "$camsrcdir/cam/src/physics/rrtmg\n"; - print $fh "$camsrcdir/cam/src/physics/rrtmg/aer_src\n"; - } - elsif ($rad eq 'camrt') { - print $fh "$camsrcdir/cam/src/physics/camrt\n"; - } - - if ($clubb_sgs eq '1') { - print $fh "$camsrcdir/cam/src/physics/clubb\n"; - } - - # Superparameterization - if ($phys_pkg eq 'spcam_m2005' or $phys_pkg eq 'spcam_sam1mom') { - print $fh "$camsrcdir/cam/src/physics/spcam\n"; - print $fh "$camsrcdir/cam/src/physics/spcam/crm\n"; - - # add additional directories for sam6.10.4 - print $fh "$camsrcdir/cam/src/physics/spcam/crm/ADV_MPDATA\n"; - if ($phys_pkg eq 'spcam_sam1mom') { - print $fh "$camsrcdir/cam/src/physics/spcam/crm/MICRO_SAM1MOM\n"; - } - if ($phys_pkg eq 'spcam_m2005') { - print $fh "$camsrcdir/cam/src/physics/spcam/crm/MICRO_M2005\n"; - print $fh "$camsrcdir/cam/src/physics/spcam/ecpp\n"; - } - if ( $spcam_clubb_sgs == 1 ) { - print $fh "$camsrcdir/cam/src/physics/spcam/crm/CLUBB\n"; - print $fh "$camsrcdir/cam/src/physics/spcam/crm/SGS_CLUBBkvhkvm\n" - } - else { - print $fh "$camsrcdir/cam/src/physics/spcam/crm/SGS_TKE\n"; - } - } - - # This directory contains much of the code for physics packages, - # as well as the cam specific interface modules that may need to - # be overridden by modules from directories that occur earlier - # in the list of filepaths. - print $fh "$camsrcdir/cam/src/physics/cam\n"; - - # Dynamics package and test utilities - print $fh "$camsrcdir/cam/src/dynamics/$dyn\n"; - if($dyn eq 'se') { - print $fh "$camsrcdir/cam/src/dynamics/se/dycore\n"; - } - print $fh "$camsrcdir/cam/src/dynamics/tests\n"; - if($inic_val) { - print $fh "$camsrcdir/cam/src/dynamics/tests/initial_conditions\n"; - } - - # Parallelization utilies - if ($dyn eq 'fv' or $cppdefs =~ /MODCM_DP_TRANSPOSE/) { - print $fh "$camsrcdir/cam/src/utils/pilgrim\n"; - } - - # Advective transport - if ($dyn eq 'eul') { - print $fh "$camsrcdir/cam/src/advection/slt\n"; - } - - print $fh "$camsrcdir/cam/src/cpl\n"; - print $fh "$camsrcdir/cam/src/control\n"; - print $fh "$camsrcdir/cam/src/utils\n"; - - if ($cam_build) { - - # These paths are only needed for CAM standalone builds - - if (!$pio2_build) { - print $fh "$cam_root/cime/src/externals/pio1/pio\n"; - } - - unless ($esmf_libdir) { - print $fh "$cam_root/cime/src/share/esmf_wrf_timemgr\n"; - } - - # Sequential Driver - print $fh "$cam_root/cime/src/drivers/mct/main\n"; - print $fh "$cam_root/cime/src/drivers/mct/shr\n"; - - # Ocean package. - if ($ocn eq 'dom') { - print $fh "$camsrcdir/cam/src/utils/cam_dom\n"; - } - elsif ($ocn eq 'docn' or $ocn eq 'som') { - print $fh "$cam_root/cime/src/components/data_comps/docn\n"; - print $fh "$cam_root/cime/src/components/data_comps/docn/mct\n"; - } - elsif ($ocn eq 'aquaplanet') { - print $fh "$camsrcdir/cam/src/utils/cam_aqua\n"; - print $fh "$camsrcdir/cam/src/utils/cam_aqua/cpl\n"; - } - elsif ($ocn eq 'socn') { - print $fh "$cam_root/cime/src/components/stub_comps/socn/cpl\n"; - } - - # Land package - print $fh "$cam_root/cime/src/components/stub_comps/slnd/cpl\n"; - - # Sea ice package - print $fh "$cam_root/cime/src/components/stub_comps/sice/cpl\n"; - - # Land ice package - print $fh "$cam_root/cime/src/components/stub_comps/sglc/cpl\n"; - - # include stub ESP component - print $fh "$cam_root/cime/src/components/stub_comps/sesp/cpl/\n"; - - # Runoff package - print $fh "$cam_root/cime/src/components/stub_comps/srof/cpl\n"; - - # Wave package - print $fh "$cam_root/cime/src/components/stub_comps/swav/cpl\n"; - - # Share utilities - print $fh "$cam_root/cime/src/share/util\n"; - print $fh "$cam_root/cime/src/share/streams\n"; - print $fh "$cam_root/cime/src/share/include\n"; - print $fh "$cam_root/cime/src/share/RandNum/include\n"; - print $fh "$cam_root/cime/src/share/RandNum/src\n"; - print $fh "$cam_root/cime/src/share/RandNum/src/dsfmt_f03\n"; - print $fh "$cam_root/cime/src/share/RandNum/src/kissvec\n"; - print $fh "$cam_root/cime/src/share/RandNum/src/mt19937\n"; - - # GPTL and timing code -# print $fh "$cam_root/cime/src/externals/pio2/src/gptl\n"; - print $fh "$cam_root/cime/src/share/timing\n"; - - } - - $fh->close; -} - -#------------------------------------------------------------------------------- - -sub write_cppdefs -{ - my ($file, $make_cppdefs) = @_; - my $fh = new IO::File; - - $fh->open(">$file") or die "** can't open cpp defs file: $file\n"; - - print $fh "$make_cppdefs\n"; - - $fh->close; -} - -#------------------------------------------------------------------------------- - -sub write_makefile -{ - # Add macro definitions to the beginning of the Makefile - # in the CAM configuration script directory - - my ($file_in, $file_out, $cfg_ref, $make_cppdefs) = @_; - my $fh_in = new IO::File; - my $fh_out = new IO::File; - - $fh_out->open(">$file_out") or die "** can't open file: $file_out\n"; - - # configuration parameters - my $target_os = $cfg_ref->get('target_os'); - my $cam_root = $cfg_ref->get('cam_root'); - my $cam_exe = $cfg_ref->get('cam_exe'); - my $cam_exedir = $cfg_ref->get('cam_exedir'); - my $nc_inc = $cfg_ref->get('nc_inc'); - my $nc_lib = $cfg_ref->get('nc_lib'); - my $nc_mod = $cfg_ref->get('nc_mod'); - my $mpi_inc = $cfg_ref->get('mpi_inc'); - my $mpi_lib = $cfg_ref->get('mpi_lib'); - my $mpi_lib_name = $cfg_ref->get('mpi_lib_name'); - my $debug = $cfg_ref->get('debug') ? 'TRUE' : 'FALSE'; - my $spmd = $cfg_ref->get('spmd') ? 'TRUE' : 'FALSE'; - my $smp = $cfg_ref->get('smp') ? 'TRUE' : 'FALSE'; - my $fc = $cfg_ref->get('fc'); - my $fc_type = $cfg_ref->get('fc_type'); - my $cc = $cfg_ref->get('cc'); - my $linker = $cfg_ref->get('linker'); - my $cflags = $cfg_ref->get('cflags'); - my $fflags = $cfg_ref->get('fflags'); - my $fopt = $cfg_ref->get('fopt'); - my $ldflags = $cfg_ref->get('ldflags'); - my $cosp_libdir = $cfg_ref->get('cosp_libdir'); - my $mct_libdir = $cfg_ref->get('mct_libdir'); - my $pio_build_dir = $cfg_ref->get('pio_build_dir'); - my $pio_install_dir = $cfg_ref->get('pio_install_dir'); - - # map between local os names ($OSNAME) and names which are - # used in the Makefile (return value from "uname -s" command). - my %uname_map = ( 'aix' => 'AIX', - 'darwin' => 'Darwin', - 'dec_osf' => 'OSF1', - 'es' => 'ES', - 'irix' => 'IRIX64', - 'linux' => 'Linux', - 'solaris' => 'SunOS', - 'super-ux' => 'SUPER-UX', - 'unicosmp' => 'UNICOS/mp', - 'bgl' => 'BGL', - 'bgp' => 'BGP', - 'bgq' => 'BGQ', - ); - - print $fh_out <<"EOF"; -# Make macros for CAM. - -UNAMES := $uname_map{$target_os} -ROOTDIR := $cam_root -EXENAME := $cam_exe -MODEL_EXEDIR := $cam_exedir -INC_NETCDF := $nc_inc -LIB_NETCDF := $nc_lib -NC_LDFLAGS := $nc_ldflags -MOD_NETCDF := $nc_mod -INC_PNETCDF := $pnc_inc -LIB_PNETCDF := $pnc_lib -INC_MPI := $mpi_inc -LIB_MPI := $mpi_lib -MPI_LIB_NAME := $mpi_lib_name -LAPACK_LIBDIR := $lapack_libdir -ESMF_LIBDIR := $esmf_libdir -DEBUG := $debug -SPMD := $spmd -SMP := $smp -FC := $fc -FC_TYPE := $fc_type -CC := $cc -USER_LINKER := $linker -USER_CPPDEFS := $make_cppdefs -USER_CFLAGS := $cflags -USER_FFLAGS := $fflags -F_OPTIMIZATION_OVERRIDE := $fopt -USER_LDFLAGS := $ldflags -COSP_LIBDIR := $cosp_libdir -MCT_LIBDIR := $mct_libdir -PIO_BUILD_DIR := $pio_build_dir -PIO_INSTALL_DIR := $pio_install_dir -#GPTL_SRCDIR := $cam_root/cime/src/externals/pio2/gptl -TIMING_SRCDIR := $cam_root/cime/src/share/timing - -EOF - - # Copy the "template" makefile to the new makefile. - $fh_in->open("<$file_in") or die "** can't open file: $file_in\n"; - while (<$fh_in>) { - print $fh_out $_; - } - - $fh_out->close; - $fh_in->close; -} - -#------------------------------------------------------------------------------- - -sub write_cosp_makefile -{ - - my ($file_in, $file_out) = @_; - my $fh_in = new IO::File; - my $fh_out = new IO::File; - - $fh_out->open(">$file_out") or die "** can't open file: $file_out\n"; - - print $fh_out <<"EOF"; - -CAM_BLD := $cam_bld -COSP_PATH := $cam_root/components/cam/src/physics/cosp2 -ISCCP_PATH := $cam_root/components/cam/src/physics/cosp2/src/simulator/icarus -RS_PATH := $cam_root/components/cam/src/physics/cosp2/src/simulator/quickbeam -RT_PATH := $cam_root/components/cam/src/physics/cosp2/src/simulator/rttov -CS_PATH := $cam_root/components/cam/src/physics/cosp2/src/simulator/actsim -MISR_PATH := $cam_root/components/cam/src/physics/cosp2/src/simulator/MISR_simulator -MODIS_PATH := $cam_root/components/cam/src/physics/cosp2/src/simulator/MODIS_simulator -PARASOL_PATH := $cam_root/components/cam/src/physics/cosp2/src/simulator/parasol - -EOF - - # Copy the "template" makefile to the new makefile. - $fh_in->open("<$file_in") or die "** can't open file: $file_in\n"; - while (<$fh_in>) { - print $fh_out $_; - } - - $fh_out->close; - $fh_in->close; -} - - -#------------------------------------------------------------------------------- - -sub write_config_h -{ - my ($file) = @_; - my $fh = new IO::File; - - $fh->open(">$file") or die "** can't open config.h file for MCT: $file\n"; - - print $fh <<"EOF"; -#ifdef FORTRAN_SAME -#define FC_FUNC(name,NAME) name -#elif FORTRANUNDERSCORE -#define FC_FUNC(name,NAME) name ##_ -#elif FORTRANDOUBLEUNDERSCORE -#define FC_FUNC(name,NAME) name ##__ -#endif -EOF - - $fh->close; -} - -#------------------------------------------------------------------------------- - -sub set_horiz_grid -{ - # Set the parameters for the specified dycore and horizontal grid. The - # parameters are read from an input file, and if no dycore/grid matches are - # found then issue error message. - # This routine uses the configuration defined at the package level ($cfg_ref). - - my ($hgrid_file, $cfg_ref) = @_; - my $xml = XML::Lite->new( $hgrid_file ); - my $root = $xml->root_element(); - - # Check for valid root node - my $name = $root->get_name(); - $name eq "config_horiz_grid" or die - "file $hgrid_file is not a horizontal grid parameters file\n"; - - # Get dycore/grid from the package's configuration - my $dyn_pkg = $cfg_ref->get('dyn'); - my $hgrid = $cfg_ref->get('hgrid'); - - # Read the grid parameters from $hgrid_file. - my @e = $xml->elements_by_name( "horiz_grid" ); - my %a = (); - - # Search for matching dycore/grid. - my $found = 0; - HGRID: - while ( my $e = shift @e ) { - %a = $e->get_attributes(); - if ( $dyn_pkg eq $a{'dyn'} and $hgrid eq $a{'hgrid'} ) { - $found = 1; - last HGRID; - } - } - - # Die unless search was successful. - unless ($found) { die "set_horiz_grid: no match for dycore $dyn_pkg and hgrid $hgrid\n"; } - - # Set parameter values -- dycore specific. - if ( $dyn_pkg =~ m/eul/ ) { - $cfg_ref->set('nlat', $a{'nlat'}); - $cfg_ref->set('nlon', $a{'nlon'}); - $cfg_ref->set('trm', $a{'m'}); - $cfg_ref->set('trn', $a{'n'}); - $cfg_ref->set('trk', $a{'k'}); - } - elsif ( $dyn_pkg eq 'fv' ) { - $cfg_ref->set('nlat', $a{'nlat'}); - $cfg_ref->set('nlon', $a{'nlon'}); - } - elsif ( $dyn_pkg eq 'fvcubed' ) { - $cfg_ref->set('csnp', $a{'csnp'}); - } - elsif ( $dyn_pkg eq 'se') { - $cfg_ref->set('csne', $a{'csne'}); - $cfg_ref->set('csnp', $a{'csnp'}); - $cfg_ref->set('npg', $a{'npg'}); - - # To allow more flexibility when matching grid attributes in the namelist - # defaults file split the GLL and physics grid specifiers in the hgrid - # argument to configure, and just store the GLL part in the hgrid parameter of - # the config_cache file. The physics grid specifier is stored separately - # in the npg parameter. - - $hgrid =~ s/\.pg\d//; # strip the '.pgN' extension - $cfg_ref->set('hgrid', $hgrid); - } - - # Override resolution settings to configure for SCAM mode. The override is needed - # because in SCAM mode the -hgrid option is used to specify the resolution of default - # datasets from which single data columns are extracted. - my $scam = $cfg_ref->get('scam'); - if ($scam) { - $cfg_ref->set('nlat', 1); - $cfg_ref->set('nlon', 1); - $cfg_ref->set('trm', 1); - $cfg_ref->set('trn', 1); - $cfg_ref->set('trk', 1); - } - -} - -#------------------------------------------------------------------------------- - -sub absolute_path { -# -# Convert a pathname into an absolute pathname, expanding any . or .. characters. -# Assumes pathnames refer to a local filesystem. -# Assumes the directory separator is "/". -# - my $path = shift; - my $cwd = getcwd(); # current working directory - my $abspath; # resulting absolute pathname - -# Strip off any leading or trailing whitespace. (This pattern won't match if -# there's embedded whitespace. - $path =~ s!^\s*(\S*)\s*$!$1!; - -# Convert relative to absolute path. - - if ($path =~ m!^\.$!) { # path is "." - return $cwd; - } elsif ($path =~ m!^\./!) { # path starts with "./" - $path =~ s!^\.!$cwd!; - } elsif ($path =~ m!^\.\.$!) { # path is ".." - $path = "$cwd/.."; - } elsif ($path =~ m!^\.\./!) { # path starts with "../" - $path = "$cwd/$path"; - } elsif ($path =~ m!^[^/]!) { # path starts with non-slash character - $path = "$cwd/$path"; - } - - my ($dir, @dirs2); - my @dirs = split "/", $path, -1; # The -1 prevents split from stripping trailing nulls - # This enables correct processing of the input "/". - - # Remove any "" that are not leading. - for (my $i=0; $i<=$#dirs; ++$i) { - if ($i == 0 or $dirs[$i] ne "") { - push @dirs2, $dirs[$i]; - } - } - @dirs = (); - - # Remove any "." - foreach $dir (@dirs2) { - unless ($dir eq ".") { - push @dirs, $dir; - } - } - @dirs2 = (); - - # Remove the "subdir/.." parts. - foreach $dir (@dirs) { - if ( $dir !~ /^\.\.$/ ) { - push @dirs2, $dir; - } else { - pop @dirs2; # remove previous dir when current dir is .. - } - } - if ($#dirs2 == 0 and $dirs2[0] eq "") { return "/"; } - $abspath = join '/', @dirs2; - return( $abspath ); -} - -#------------------------------------------------------------------------------- - -sub subst_env_path { -# -# Substitute for any environment variables contained in a pathname. -# Assumes the directory separator is "/". -# - my $path = shift; - my $newpath; # resulting pathname - -# Strip off any leading or trailing whitespace. (This pattern won't match if -# there's embedded whitespace. - $path =~ s!^\s*(\S*)\s*$!$1!; - - my ($dir, @dirs2); - my @dirs = split "/", $path, -1; # The -1 prevents split from stripping trailing nulls - # This enables correct processing of the input "/". - - foreach $dir (@dirs) { - if ( $dir =~ /^\$(.+)$/ ) { - push @dirs2, $ENV{$1}; - } else { - push @dirs2, $dir; - } - } - $newpath = join '/', @dirs2; - return( $newpath ); -} - -#------------------------------------------------------------------------------- - -sub mkdirp { - my ($dir) = @_; - my (@dirs) = split /\//, $dir; - my (@subdirs, $path); - - # if $dir is absolute pathname then @dirs will start with "" - if ($dirs[0] eq "") { push @subdirs, shift @dirs; } - - while ( @dirs ) { # check that each subdir exists and mkdir if it doesn't - push @subdirs, shift @dirs; - $path = join '/', @subdirs; - unless (-d $path or mkdir($path, 0777)) { return 0; } - } - return 1; -} - -#------------------------------------------------------------------------------- - -sub get_cmake_version { - -# Return CMake version. Null string returned if cmake not found. - - my $retval = `cmake --version 2>&1`; - $retval =~ /cmake version (\d+.*)/; # use loose match for version string - return $1; -} - -#------------------------------------------------------------------------------- - -sub get_gmake { - -# check for a valid version of GNU make in the user's path - - my @makenames = @_; - my ($make, $retval); - - foreach $make (@makenames) { - $retval = `$make -v 2>&1`; - return $make if ($retval =~ /GNU Make/); - } - return; -} - -#------------------------------------------------------------------------------- - -sub write_tests_filepath -{ - my ($test_dir) = @_; - my $fh = new IO::File; - - $fh->open(">Filepath") or die "** can't open file: $test_dir/Filepath\n"; - - print $fh "$test_dir\n"; - - $fh->close; -} - -#------------------------------------------------------------------------------- - -sub run_test -{ - # Return true if the test should be run after a successful build. - # Note that this function is depending on the main package variables - # main::$spmd and main:: $target_os. - - # Default is to try running a test that's been successfully built. - my $result = 1; - - # But don't attempt to run a test if... - if ( $spmd eq 'ON' # SPMD is enabled - or $target_os ne $OSNAME # cross compilation - ) {$result = 0;} - - return $result; -} - -#------------------------------------------------------------------------------- - -sub check_fc { - -# Create a "hello world" test code in Fortran 90 syntax to check the compiler. -# If successful then the name of the compiler used is returned. - - my ($gmake, $makefile) = @_; - my $fh = new IO::File; - my $file = 'test_fc.F90'; - - # create test program - $fh->open(">$file") or die "** can't open file: $file\n"; - print $fh <<"EOF"; -module m1 - private - public :: hello -contains -subroutine hello() - implicit none - print *, 'hello world' -end subroutine hello -end module m1 -program main - use m1, only: hello - implicit none - call hello -end program main -EOF - $fh->close; - - # Build the test_fc target in the CAM Makefile - my $cmd = "$gmake -f $makefile test_fc 2>&1"; - my $out = `$cmd`; - my $cmd_error = $CHILD_ERROR; - my $test_output = "Issued the command:\n$cmd\n\nThe output was:\n$out\n"; - - if ($cmd_error) { - die "**** FAILED ****\n$test_output"; - } elsif ($print>=2) { - print "**** PASS ****\n$test_output"; - } - - # search make output for name of Fortran compiler -- Assume that the Makefile - # rule has the syntax "$(FC) -c ..." - $out =~ m{ ^\s* # leading whitespace - (\w+) # 1st word (name of compiler) - \s+ # followed by one or more spaces - -c # and the -c option - \s - }xm; - - my $fc_compiler_name = $1; - - if (run_test()) { - # Run test_fc. - my $cmd = "./test_fc"; - my $out = `$cmd`; - my $cmd_error = $CHILD_ERROR; - my $test_output = "Issued the command:\n$cmd\n\nThe output was:\n$out\n"; - - if ($cmd_error) { - die "**** FAILED ****\n$test_output"; - } elsif ($print>=2) { - print "**** PASS ****\n$test_output"; - } - } - - # clean-up (Srcfiles and Depends are created by the makefile) - unlink 'test_fc.F90', 'test_fc.o', 'test_fc', 'Depends', 'Srcfiles', glob("[Mm]1.[Mm][Oo][Dd]"); - - return $fc_compiler_name; -} - -#------------------------------------------------------------------------------- - -sub check_netcdf { - -# Create a test code that has an external reference to the netCDF library -# and check that the Makefile can build it. Returns 0 on success. - - my ($gmake, $makefile) = @_; - my $fh = new IO::File; - my $file = 'test_nc.F90'; - - # create test program - $fh->open(">$file") or die "** can't open file: $file\n"; - print $fh <<"EOF"; -program main - use netcdf - implicit none - integer :: ncid, ret - ret = nf90_create('foo.nc', NF90_CLOBBER, ncid) - if ( ret == NF90_NOERR ) then - print *, 'created foo.nc' - else - print *, nf90_strerror( ret ) - end if -end program main -EOF - $fh->close; - - # Build the test_nc target in the CAM Makefile - my $cmd = "$gmake -f $makefile test_nc 2>&1"; - my $out = `$cmd`; - my $cmd_error = $CHILD_ERROR; - my $test_output = "Issued the command:\n$cmd\n\nThe output was:\n$out\n"; - - if ($cmd_error) { - die "**** FAILED ****\n$test_output"; - } elsif ($print>=2) { - print "**** PASS ****\n$test_output"; - } - - if (run_test()) { - # Run test_nc. - my $cmd = "./test_nc"; - my $out = `$cmd`; - my $cmd_error = $CHILD_ERROR; - my $test_output = "Issued the command:\n$cmd\n\nThe output was:\n$out\n"; - - if ($cmd_error) { - die "**** FAILED ****\n$test_output"; - } elsif ($print>=2) { - print "**** PASS ****\n$test_output"; - } - } - - # clean-up - unlink 'test_nc.F90', 'test_nc.o', 'test_nc', 'foo.nc', 'Depends', 'Srcfiles'; - - return 0; -} - -#------------------------------------------------------------------------------- - -sub check_mpi { - -# Create a test code that has an external reference to the MPI library -# and check that the Makefile can build it. Returns 0 on success. - - my ($gmake, $makefile) = @_; - my $fh = new IO::File; - my $file = 'test_mpi.F90'; - - # create the test program - $fh->open(">$file") or die "** can't open file: $file\n"; - print $fh <<"EOF"; - program test_mpi - implicit none -#include - integer :: ierr - call mpi_init(ierr) - if ( ierr == MPI_SUCCESS ) then - print *, 'successfully called mpi_init' - else - print *, 'ERROR returned from mpi_init' - end if - end program test_mpi -EOF - $fh->close; - - # Build the test_mpi target in the CAM Makefile - my $cmd = "$gmake -f $makefile test_mpi 2>&1"; - my $out = `$cmd`; - my $cmd_error = $CHILD_ERROR; - my $test_output = "Issued the command:\n$cmd\n\nThe output was:\n$out\n"; - - if ($cmd_error) { - die "**** FAILED ****\n$test_output"; - } elsif ($print>=2) { - print "**** PASS ****\n$test_output"; - } - - if (run_test()) { - # Run test_mpi. - my $cmd = "./test_mpi"; - my $out = `$cmd`; - my $cmd_error = $CHILD_ERROR; - my $test_output = "Issued the command:\n$cmd\n\nThe output was:\n$out\n"; - - if ($cmd_error) { - die "**** FAILED ****\n$test_output"; - } elsif ($print>=2) { - print "**** PASS ****\n$test_output"; - } - } - - # clean-up - unlink 'test_mpi.F90', 'test_mpi.o', 'test_mpi', 'Depends', 'Srcfiles'; - - return 0; -} - -#------------------------------------------------------------------------------- - -sub check_esmf { - -# Create a test code that has an external reference to the ESMF library -# and check that the Makefile can build it. Returns 0 on success. - - my ($gmake, $makefile) = @_; - my $fh = new IO::File; - my $file = 'test_esmf.F90'; - - # create the test program - $fh->open(">$file") or die "** can't open file: $file\n"; - print $fh <<"EOF"; - program test_esmf - use ESMF - implicit none - integer :: ierr - - ! Writes a log called ESMF_LogFile to bld/configure-tests - call ESMF_Initialize(rc=ierr,logkindflag=ESMF_LOGKIND_SINGLE) - - if ( ierr == ESMF_SUCCESS ) then - print *, 'successfully called ESMF_Initialize' - else - print *, 'ERROR returned from ESMF_Initialize' - end if - - ! Close the log file in order to flush it - call ESMF_Finalize(rc=ierr) - - end program test_esmf -EOF - $fh->close; - - # Build the test_esmf target in the CAM Makefile - my $cmd = "$gmake -f $makefile test_esmf 2>&1"; - my $out = `$cmd`; - my $cmd_error = $CHILD_ERROR; - my $test_output = "Issued the command:\n$cmd\n\nThe output was:\n$out\n"; - - if ($cmd_error) { - die "**** FAILED ****\n$test_output"; - } elsif ($print>=2) { - print "**** PASS ****\n$test_output"; - } - - if (run_test()) { - # Run test_esmf. - $cmd = "./test_esmf"; - my $out = `$cmd`; - my $cmd_error = $CHILD_ERROR; - my $test_output = "Issued the command:\n$cmd\n\nThe output was:\n$out\n"; - - - if ($cmd_error) { - die "**** FAILED ****\n$test_output"; - } elsif ($print>=2) { - print "**** PASS ****\n$test_output"; - } - } - - # clean-up - unlink 'test_esmf.F90', 'test_esmf.o', 'test_esmf', 'Depends', 'Srcfiles'; - - return 0; -} -#------------------------------------------------------------------------------- - -#------------------------------------------------------------------------------- - -sub version { -# The version is found in CAM's ChangeLog file. -# $cfgdir is set by the configure script to the name of its directory. - - my ($cfgdir) = @_; - - my $logfile = "$cfgdir/../doc/ChangeLog"; - - my $fh = IO::File->new($logfile, '<') or die "** can't open ChangeLog file: $logfile\n"; - - while (my $line = <$fh>) { - - if ($line =~ /^Tag name:\s*(\w+)/ ) { - print "$1\n"; - exit; - } - } - -} - - -#------------------------------------------------------------------------------- - -sub print_hash { - my %h = @_; - my ($k, $v); - while ( ($k,$v) = each %h ) { print "$k => $v\n"; } -} diff --git a/bld/namelist_files/namelist_defaults_cam.xml.orig b/bld/namelist_files/namelist_defaults_cam.xml.orig deleted file mode 100644 index f52f4fa473..0000000000 --- a/bld/namelist_files/namelist_defaults_cam.xml.orig +++ /dev/null @@ -1,1965 +0,0 @@ - - - - - -1200 -300 -600 -1200 -1800 -1800 -1800 - -1800 -300 - -1800 -1800 -1800 -1800 -1800 -900 -600 -600 - - - -atm/cam/inic/cam_vcoords_L26_c180105.nc -atm/cam/inic/cam_vcoords_L30_c180105.nc -atm/cam/inic/cam_vcoords_L32_c180105.nc - -atm/cam/inic/fv/cami_0000-01-01_0.23x0.31_L26_c100513.nc -atm/cam/inic/fv/cami_0000-09-01_0.23x0.31_L26_c061106.nc -atm/cam/inic/fv/cami_1980-01-01_0.47x0.63_L26_c071226.nc -atm/cam/inic/fv/cami_0000-09-01_0.47x0.63_L26_c061106.nc -atm/cam/inic/fv/cami_0000-10-01_0.5x0.625_L26_c031204.nc -atm/cam/inic/fv/cami_1987-01-01_0.9x1.25_L26_c060703.nc -atm/cam/inic/fv/cami_0000-09-01_0.9x1.25_L26_c051205.nc -atm/cam/inic/fv/cami_0000-01-01_1.9x2.5_L26_c070408.nc -atm/cam/inic/fv/cami_0000-09-01_1.9x2.5_L26_c040809.nc -atm/cam/inic/fv/cami_0000-01-01_2.5x3.33_L26_c110309.nc -atm/cam/inic/fv/cami_0000-09-01_2.5x3.33_L26_c091007.nc -atm/cam/inic/fv/cami_0001-01-01_4x5_L26_c060608.nc -atm/cam/inic/fv/cami_0000-01-01_10x15_L26_c030918.nc - -atm/cam/inic/fv/cami-mam3_0000-01-01_0.23x0.31_L30_c110527.nc -atm/cam/inic/fv/cami-mam3_0000-01-01_0.47x0.63_L30_c100929.nc -atm/cam/inic/fv/cami-mam3_0000-01-01_0.9x1.25_L30_c100618.nc -atm/cam/inic/fv/cami-mam3_0000-01-01_1.9x2.5_L30_c090306.nc -atm/cam/inic/fv/cami_0000-09-01_1.9x2.5_L30_c070109.nc -atm/cam/inic/fv/cami_0000-01-01_2.5x3.33_L30_c110309.nc -atm/cam/inic/fv/cami_0000-09-01_2.5x3.33_L30_c100831.nc -atm/cam/inic/fv/cami_0000-01-01_4x5_L30_c090108.nc -atm/cam/inic/fv/cami_0000-01-01_10x15_L30_c081013.nc - -atm/cam/inic/fv/cami-mam3_0000-01-01_0.9x1.25_L32_c141031.nc -atm/cam/inic/fv/cami-mam3_0000-01-01_1.9x2.5_L32_c150407.nc -atm/cam/inic/fv/cami-mam4_0000-01-01_10x15_L32_c170914.nc - -atm/cam/inic/fv/cami_0000-01-01_0.47x0.63_L26_APE_c080227.nc -atm/cam/inic/fv/aqua_0006-01-01_0.9x1.25_L26_c161020.nc -atm/cam/inic/fv/aqua_0006-01-01_1.9x2.5_L26_c161020.nc -atm/cam/inic/fv/aqua_0000-01-01_10x15_L26_c161230.nc - -atm/cam/inic/fv/aqua_0006-01-01_0.9x1.25_L30_c161020.nc -atm/cam/inic/fv/aqua_0006-01-01_1.9x2.5_L30_c161020.nc -atm/cam/inic/fv/aqua_0000-01-01_10x15_L30_c170103.nc - -atm/cam/inic/fv/aqua_0006-01-01_0.9x1.25_L32_c161020.nc -atm/cam/inic/fv/aqua_0006-01-01_1.9x2.5_L32_c161020.nc -atm/cam/inic/fv/aqua_0000-01-01_10x15_L32_c170103.nc - -atm/cam/inic/fv/cami-chem_1990-01-01_0.9x1.25_L30_c080724.nc -atm/cam/inic/fv/cami-chem_1990-01-01_1.9x2.5_L26_c080114.nc -atm/cam/inic/fv/cami-chem_1990-01-01_1.9x2.5_L30_c080215.nc - -atm/cam/inic/fv/camchemi_0012-01-01_10x15_L26_c081104.nc -atm/cam/inic/fv/camchemi_0012-01-01_10x15_L30_c081104.nc -atm/cam/inic/fv/camchemi_0012-01-01_4x5_L26_c081104.nc -atm/cam/inic/fv/camchemi_0012-01-01_4x5_L30_c081104.nc -atm/cam/inic/fv/camchemi_0012-01-01_1.9x2.5_L26_c081104.nc -atm/cam/inic/fv/camchemi_0012-01-01_1.9x2.5_L30_c081104.nc - -atm/cam/inic/fv/trop_strat_mam3_chem_2000-01-01_10x15_L30_c121015.nc -atm/cam/inic/fv/trop_strat_mam3_chem_2000-01-01_4x5_L30_c121015.nc -atm/cam/inic/fv/trop_strat_mam3_chem_2000-01-01_1.9x2.5_L30_c121015.nc - -atm/cam/chem/trop_mozart/ic/cami_0000-09-01_4x5_L26_c060217.nc -atm/cam/chem/trop_mozart/ic/cami_0000-09-01_10x15_L26_c060216.nc - -atm/waccm/ic/cami_2000-02-01_0.9x1.25_L66_c040928.nc -atm/waccm/ic/cami_2000-07-01_1.9x2.5_L66_c040928.nc -atm/waccm/ic/FWT2000_f09_spinup01.cam.i.0001-01-02-00000_c160315.nc -atm/waccm/ic/f2000.waccm-mam3_1.9x2.5_L70.cam2.i.0017-01-01.c120410.nc -atm/waccm/ic/aqua.cam6.waccmsc_1.9x2.5_L70.2000-01-01.c170123.nc -atm/waccm/ic/aqua.waccm_tsmlt_1.9x2.5_L70_c170814.nc -atm/waccm/ic/f2000.waccm-mam3_4x5_L70.cam2.i.0017-01-01.c121113.nc -atm/waccm/ic/f2000.waccm-mam3_10x15_L70.cam2.i.0017-01-01.c141016.nc -atm/waccm/ic/b1850.waccm-mam3_1.9x2.5_L70.cam2.i.0156-01-01.c120523.nc -atm/waccm/ic/cami_2000-05-01_1.9x2.5_L103_c040928.nc -atm/waccm/ic/wa3_4x5_1950_spinup.cam2.i.1960-01-01-00000.nc -atm/waccm/ic/cami_2000-01-01_10x15_L66_c041121.nc -atm/waccm/ic/f40.2000.4deg.wcm.carma.sulf.004.cam2.i.0008-01-01-00000.nc -atm/waccm/ic/f40.2deg.wcm.carma.sulf.L66.cam2.i.2010-01-01.nc -atm/waccm/ic/WAX3548T08CO_2003top_f2000.waccm_0017bottom_L81_c110906.nc -atm/waccm/ic/WAX3548T08CO_2003top_f2000.waccm_0017bottom_4x5_L81_c160630.nc -atm/waccm/ic/WAX3548T08CO_2003top_f2000.waccm_0017bottom_10x15_L81_c141027.nc -atm/waccm/ic/waccmx_aqua_4x5_L126_c170705.nc -atm/waccm/ic/fx2000_1deg.cam.i.0001-01-02-00000_c180712.nc - -atm/cam/inic/gaus/T341clim01.cam2.i.0024-01-01-00000.nc -atm/cam/inic/gaus/cami_0000-01-01_256x512_L26_c030918.nc - -atm/cam/inic/gaus/cami_0000-01-01_128x256_L26_c030918.nc -atm/cam/inic/gaus/cami_0000-09-01_128x256_L26_c040422.nc - -atm/cam/inic/gaus/cami_0000-01-01_64x128_T42_L26_c031110.nc -atm/cam/inic/gaus/cami_0000-09-01_64x128_L26_c030918.nc -atm/cam/inic/gaus/cami_0000-01-01_64x128_L30_c090102.nc -atm/cam/inic/gaus/cami_0000-09-01_64x128_L30_c031210.nc -atm/cam/inic/gaus/cami_0000-01-01_64x128_L32_c170510.nc -atm/cam/inic/gaus/cami_0000-01-01_48x96_L26_c091218.nc -atm/cam/inic/gaus/cami_0000-09-01_48x96_L26_c040420.nc -atm/cam/inic/gaus/cami_0000-01-01_48x96_L30_c100426.nc -atm/cam/inic/gaus/cami_0000-09-01_32x64_L26_c030918.nc -atm/cam/inic/gaus/cami_0000-01-01_32x64_L30_c090107.nc -atm/cam/inic/gaus/cami_0000-01-01_8x16_L26_c030228.nc -atm/cam/inic/gaus/cami_0000-09-01_8x16_L26_c030918.nc -atm/cam/inic/gaus/cami_0000-01-01_8x16_L30_c090102.nc - -atm/cam/inic/se/ape_cam4_ne5np4_L26_c170517.nc -atm/cam/inic/se/ape_cam4_ne16np4_L26_c170417.nc -atm/cam/inic/se/ape_cam4_ne30np4_L26_c170417.nc -atm/cam/inic/se/ape_cam4_ne60np4_L26_c171023.nc -atm/cam/inic/se/ape_cam4_ne120np4_L26_c170419.nc -atm/cam/inic/se/ape_cam4_ne240np4_L26_c170613.nc - -atm/cam/inic/se/ape_cam5_ne5np4_L30_c170517.nc -atm/cam/inic/se/ape_cam5_ne16np4_L30_c170417.nc -atm/cam/inic/se/ape_cam5_ne30np4_L30_c170417.nc -atm/cam/inic/se/ape_cam5_ne120np4_L30_c170419.nc - -atm/cam/inic/se/ape_cam6_ne5np4_L32_c170517.nc -atm/cam/inic/se/ape_cam6_ne16np4_L32_c170509.nc -atm/cam/inic/se/ape_cam6_ne30np4_L32_c170509.nc -atm/cam/inic/se/ape_cam6_ne120np4_L32_c170908.nc -atm/cam/inic/se/ape_cam6_ne240np4_L32_c170908.nc - - -atm/cam/topo/topo-from-cami_0000-01-01_256x512_L26_c030918.nc -atm/cam/topo/USGS-gtopo30_128x256_c050520.nc -atm/cam/topo/T42_nc3000_Co060_Fi001_PF_nullRR_Nsw042_20180111.nc -atm/cam/topo/USGS-gtopo30_48x96_c050520.nc -atm/cam/topo/USGS-gtopo30_32x64_c050520.nc -atm/cam/topo/USGS-gtopo30_8x16_c050520.nc - -atm/cam/topo/USGS_gtopo30_0.23x0.31_remap_c061107.nc -atm/cam/topo/USGS_gtopo30_0.47x0.63_remap_c061106.nc -atm/cam/topo/topo-from-cami_0000-10-01_0.5x0.625_L26_c031204.nc -atm/cam/topo/fv_0.9x1.25_nc3000_Nsw042_Nrs008_Co060_Fi001_ZR_sgh30_24km_GRNL_c170103.nc -atm/cam/topo/fv_1.9x2.5_nc3000_Nsw084_Nrs016_Co120_Fi001_ZR_061116.nc -atm/cam/topo/USGS-gtopo30_2.5x3.33_remap_c100204.nc -atm/cam/topo/USGS-gtopo30_4x5_remap_c050520.nc -atm/cam/topo/fv_10x15_nc0540_Nsw042_Nrs008_Co060_Fi001_20171220.nc - - -atm/cam/topo/fv_0.9x1.25_nc3000_Nsw006_Nrs002_Co008_Fi001_ZR_c160505.nc -atm/cam/topo/fv_1.9x2.5_nc3000_Nsw084_Nrs016_Co120_Fi001_ZR_061116.nc - - - .true. - .false. - .false. - .false. - - - none -atm/cam/coords/ne0np4CONUS.ne30x8.g -atm/cam/coords/ne0np4EQFACE.ne5x4.g - - - none - held_suarez_1994 - held_suarez_1994 - moist_baroclinic_wave_dcmip2016 - moist_baroclinic_wave_dcmip2016 - - - - -atm/cam/physprops/sul_cam3_c080918.nc -atm/cam/physprops/dustv1b1_cam3_c080918.nc -atm/cam/physprops/dustv1b2_cam3_c080918.nc -atm/cam/physprops/dustv1b3_cam3_c080918.nc -atm/cam/physprops/dustv1b4_cam3_c080918.nc -atm/cam/physprops/bcpho_cam3_c080918.nc -atm/cam/physprops/bcphi_cam3_c080918.nc -atm/cam/physprops/ocpho_cam3_c080918.nc -atm/cam/physprops/ocphi_cam3_c080918.nc -atm/cam/physprops/ssam_cam3_c080918.nc -atm/cam/physprops/sscm_cam3_c080918.nc - - - -atm/cam/physprops/sulfate_camrt_c080918.nc -atm/cam/physprops/sulfate_camrt_c080918.nc -atm/cam/physprops/dust1_camrt_c120518.nc -atm/cam/physprops/dust1_camrt_c120518.nc -atm/cam/physprops/dust2_camrt_c120518.nc -atm/cam/physprops/dust2_camrt_c120518.nc -atm/cam/physprops/dust3_camrt_c120518.nc -atm/cam/physprops/dust3_camrt_c120518.nc -atm/cam/physprops/dust4_camrt_c120518.nc -atm/cam/physprops/dust4_camrt_c120518.nc -atm/cam/physprops/bcpho_camrt_c080918.nc -atm/cam/physprops/bcpho_camrt_c080918.nc -atm/cam/physprops/bcphi_camrt_c080918.nc -atm/cam/physprops/bcphi_camrt_c080918.nc -atm/cam/physprops/ocpho_camrt_c080918.nc -atm/cam/physprops/ocpho_camrt_c080918.nc -atm/cam/physprops/ocphi_camrt_c080918.nc -atm/cam/physprops/ocphi_camrt_c080918.nc -atm/cam/physprops/ssam_camrt_c080918.nc -atm/cam/physprops/sscm_camrt_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 - - - - -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 -atm/cam/physprops/sulfuricacid_cam3_c080918.nc -atm/cam/physprops/volc_camRRTMG_byradius_sigma1.6_c130724.nc -atm/cam/physprops/volc_camRRTMG_byradius_sigma1.6_mode1_c170214.nc -atm/cam/physprops/volc_camRRTMG_byradius_sigma1.6_mode2_c170214.nc -atm/cam/physprops/volc_camRRTMG_byradius_sigma1.2_mode3_c170214.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 - -.false. -.true. - - -slingo -ebertcurry -gammadist -mitchell -atm/cam/physprops/iceoptics_c080917.nc -atm/cam/physprops/F_nwvl200_mu20_lam50_res64_t298_c080428.nc - - -atm/cam/rad/abs_ems_factors_fastvx.c030508.nc - - -atm/waccm/emis/meteor_smoke_kalashnikova.nc -atm/waccm/emis/smoke_grf_frentzke.nc -atm/waccm/emis/meteor_smoke_kalashnikova.nc -atm/waccm/emis/smoke_grf_frentzke.nc -atm/waccm/emis/meteor_smoke_kalashnikova.nc -atm/waccm/emis/smoke_grf_frentzke.nc -atm/cam/physprops/mice_warren2008.nc -atm/waccm/emis/meteor_smoke_kalashnikova.nc -atm/waccm/emis/smoke_grf_frentzke.nc -atm/cam/physprops/mice_warren2008.nc -atm/cam/dst/soil_erosion_factor_1x1_c120907.nc -atm/cam/dst/soil_erosion_factor_1x1_c120907.nc -atm/waccm/emis/early_earth_haze.nc - - -atm/cam/ozone -ozone_1.9x2.5_L26_2000clim_c091112.nc -O3 -CYCLICAL -2000 - - -ozone_strataero_CAM6chem_2000climo_zm_5day_c171004.nc -ozone_strataero_CAM6chem_2000climo_zm_5day_c171004.nc - -waccm_ozone_c121126.nc -0 -ozone_strataero_WACCM6_L70_zm5day_19750101-20141229_c180216.nc -atm/cam/ozone_strataero - - -atm/cam/chem/trop_mozart_aero/aero -aero_1.9x2.5_L26_2000clim_c091112.nc -CYCLICAL -2000 -aero_1.9x2.5_L26_list_c070514.txt -atm/cam/chem/trop_mam/aero -mam3_1.9x2.5_L30_2000clim_c130319.nc -CYCLICAL -2000 -aero_1.9x2.5_L26_list_c070514.txt - -atm/cam/chem/trop_mam/aero -mam3_1.9x2.5_L30_2000clim_c130319.nc -none -CYCLICAL -2000 -aero_1.9x2.5_L26_list_c070514.txt - -atm/cam/chem/trop_mozart_aero/aero -aerosoldep_monthly_1849-2006_1.9x2.5_c090803.nc -CYCLICAL -2000 -atm/cam/chem/trop_mam/aero -mam3_1.9x2.5_L30_2000clim_c130319.nc -CYCLICAL -2000 - -atm/cam/chem/trop_mam/aero -mam3_1.9x2.5_L30_2000clim_c130319.nc -CYCLICAL -2000 - - -atm/cam/rad/VolcanicMass_1870-1999_64x1_L18_c040115.nc - - -atm/cam/chem/trop_mozart/ub/clim_p_trop.nc - - - -1361.27 -atm/cam/solar/solar_ave_sc19-sc23.c090810.nc -atm/cam/solar/solar_ave_sc19-sc23.c090810.nc -atm/cam/solar/spectral_irradiance_Lean_1610-2009_ann_c100405.nc -atm/cam/solar/spectral_irradiance_Lean_1610-2009_ann_c100405.nc -atm/cam/solar/SolarForcing1995-2005avg_c160929.nc -atm/cam/solar/SolarForcing1995-2005avg_c160929.nc - - - -367.0e-6 -1760.0e-9 -316.0e-9 -653.45e-12 -535.0e-12 - - -atm/cam/ggas/ghg_hist_1765-2005_c091218.nc -atm/waccm/lb/LBC_1765-2100_1.9x2.5_CCMI_RCP60_za_RNOCStrend_c141002.nc - - -atm/cam/ggas/emissions-cmip6_CO2_anthro_surface_175001-201512_fv_0.9x1.25_c20181011.nc -atm/cam/ggas/emissions-cmip6_CO2_anthro_surface_175001-201512_fv_1.9x2.5_c20181011.nc - -ac_CO2_filelist_175001-201512_fv_0.9x1.25_c20181011.txt -ac_CO2_filelist_175001-201512_fv_1.9x2.5_c20181011.txt -atm/cam/ggas -SERIAL - -atm/cam/ggas/emissions-cmip6_CO2_anthro_ac_175001-201512_fv_0.9x1.25_c20181011.nc -atm/cam/ggas/emissions-cmip6_CO2_anthro_ac_175001-201512_fv_1.9x2.5_c20181011.nc - - -atm/cam/scyc/DMS_emissions_128x256_clim_c040122.nc -atm/cam/scyc/DMS_emissions_64x128_c030722.nc -atm/cam/scyc/DMS_emissions_32x64_c030722.nc -atm/cam/scyc/DMS_emissions_4x5_noncon_c050306.nc - - -atm/cam/scyc/oxid_128x256_L26_clim_c040112.nc -atm/cam/scyc/oxid_3d_64x128_L26_c030722.nc -atm/cam/scyc/oxid_3d_32x64_L26_c030722.nc -atm/cam/scyc/oxid_4x5_L26_noncon_c050306.nc - - -atm/cam/scyc/SOx_emissions_128x256_L2_1850-2000_c040321.nc -atm/cam/scyc/SOx_emissions_64x128_L2_c030722.nc -atm/cam/scyc/SOx_emissions_32x64_L2_c030722.nc -atm/cam/scyc/SOx_emissions_4x5_noncon_c050306.nc - - -atm/cam/ggas/noaamisc.r8.nc - - -atm/waccm/phot/xh2o_c080826.nc -atm/waccm/phot/xh2o_c080826.nc - - -atm/waccm/ub -ghg_forcing_2000_c110321.nc -atm/waccm/waccm_forcing -SCWACCM_forcing_WACCM6_zm_5day_L70_1975-2014_c180216.nc - - -atm/waccm/efld/coeff_lflux.dat -atm/waccm/efld/coeff_hflux.dat -atm/waccm/efld/wei96.cofcnts - - -atm/waccm/geomag/igrf_ceofs_c160412.nc - - -atm/waccm/phot/photon_c130710.dat -atm/waccm/phot/electron_121129.dat -atm/waccm/phot/EUVAC_reference_c170222.nc - - -atm/waccm/phot/wasolar_ave.nc - -atm/waccm/solar/wasolar_c140408.nc -atm/waccm/solar/wasolar_c140408.nc -atm/cam/solar/SolarForcing1995-2005avg_c160929.nc - -atm/waccm/solar/solar_wind_imf_OMNI_WACCMX_2000001-2017365_c180731.nc - - -atm/waccm/qbo/qbocyclic28months.nc - - -0.125D0 - -1.D0 -1.5D-3 -1.0D-3 -2.5D-3 - -0.1D0 -12.0D-3 - -1.25D-15 -7.5D-16 -3.0D-15 - - - -.false. -.true. - -.false. -.true. -32 -18 - - -0.1D0 -0.4D0 -0.55D0 -0.5D0 -0.5D0 -0.5D0 -0.0625D0 - - -0.03D0 - - -atm/waccm/gw/newmfspectra40_dc25.nc -atm/waccm/gw/mfspectra_shallow_c140530.nc -0.25d0 -0.5d0 -0.5d0 -0.5d0 -1.d0 -2.d0 -2.d0 -2.d0 -.true. -.false. -.false. -.false. -.false. -.true. -.true. -.true. -.true. -.false. -.false. -.false. - - -.true. -.false. -.true. - 0.0d0 - 2.0d0 - 2.0d0 - 3.0d0 - 2.0d0 - 0.01d0 - 1.0d-3 - 0.002d0 - 0.1d0 - - -15 - - -off -ionosphere -neutral -heelis -atm/waccm/efld/wei05sc_c080415.nc -5 -20 - - -1.00D0 -2.00D0 -1.50D0 -1.30D0 -1.60D0 -0.32D0 - - -atm/cam/chem/trop_mozart/emis/megan21_emis_factors_78pft_c20161108.nc - - -atm/cam/chem/trop_mozart/emis/emissions.aircraft.T42LR.nc -atm/cam/chem/1850-2000_emis/IPCC_emissions_aircraft_NO2_1850-2000_1.9x2.5_c090729.nc -atm/cam/chem/1850-2000_emis/IPCC_emissions_aircraft_BC_1850-2000_1.9x2.5.c090729.nc - -atm/cam/chem/trop_mozart/emis/extfrc.CO.1.9x2.5_c101206.nc -atm/cam/chem/trop_mozart/emis/extfrc.NO.1.9x2.5_c101206.nc -atm/cam/chem/trop_mozart/emis/extfrc.SO2.1.9x2.5_c101206.nc - - -atm/cam/chem/emis/1992-2010/emissions.BIGALK.surface.1.9x2.5_c110426.nc -atm/cam/chem/emis/1992-2010/emissions.BIGENE.surface.1.9x2.5_c110426.nc -atm/cam/chem/emis/1992-2010/emissions.C10H16.surface.1.9x2.5_c110426.nc -atm/cam/chem/emis/1992-2010/emissions.C2H2.surface.1.9x2.5_c110426.nc -atm/cam/chem/emis/1992-2010/emissions.C2H4.surface.1.9x2.5_c110426.nc -atm/cam/chem/emis/1992-2010/emissions.C2H5OH.surface.1.9x2.5_c110426.nc -atm/cam/chem/emis/1992-2010/emissions.C2H6.surface.1.9x2.5_c110426.nc -atm/cam/chem/emis/1992-2010/emissions.C3H6.surface.1.9x2.5_c110426.nc -atm/cam/chem/emis/1992-2010/emissions.C3H8.surface.1.9x2.5_c110426.nc -atm/cam/chem/emis/1992-2010/emissions.CB1.surface.1.9x2.5_c110426.nc -atm/cam/chem/emis/1992-2010/emissions.CB2.surface.1.9x2.5_c110426.nc -atm/cam/chem/emis/1992-2010/emissions.CH2O.surface.1.9x2.5_c110426.nc -atm/cam/chem/emis/1992-2010/emissions.CH3CHO.surface.1.9x2.5_c110426.nc -atm/cam/chem/emis/1992-2010/emissions.CH3CN.surface.1.9x2.5_c110426.nc -atm/cam/chem/emis/1992-2010/emissions.CH3COCH3.surface.1.9x2.5_c110426.nc -atm/cam/chem/emis/1992-2010/emissions.CH3COCH3.surface.1.9x2.5_c110426.nc -atm/cam/chem/emis/1992-2010/emissions.CH3COOH.surface.1.9x2.5_c110426.nc -atm/cam/chem/emis/1992-2010/emissions.CH3OH.surface.1.9x2.5_c110426.nc -atm/cam/chem/emis/1992-2010/emissions.CO.surface.1.9x2.5_c110426.nc -atm/cam/chem/emis/1992-2010/emissions.DMS.surface.1.9x2.5_c110426.nc -atm/cam/chem/emis/1992-2010/emissions.HCN.surface.1.9x2.5_c110426.nc -atm/cam/chem/emis/1992-2010/emissions.HCOOH.surface.1.9x2.5_c110426.nc -atm/cam/chem/emis/1992-2010/emissions.ISOP.surface.1.9x2.5_c110426.nc -atm/cam/chem/emis/1992-2010/emissions.MEK.surface.1.9x2.5_c110426.nc -atm/cam/chem/emis/1992-2010/emissions.NH3.surface.1.9x2.5_c110426.nc -atm/cam/chem/emis/1992-2010/emissions.NO.surface.1.9x2.5_c110426.nc -atm/cam/chem/emis/1992-2010/emissions.NO.surface.1.9x2.5_c110426.nc -atm/cam/chem/emis/1992-2010/emissions.OC1.surface.1.9x2.5_c110426.nc -atm/cam/chem/emis/1992-2010/emissions.OC1.surface.1.9x2.5_c110426.nc -atm/cam/chem/emis/1992-2010/emissions.SO2.surface.1.9x2.5_c110426.nc -atm/cam/chem/emis/1992-2010/emissions.TOLUENE.surface.1.9x2.5_c110426.nc -atm/cam/chem/emis/1992-2010/emissions.SOA_BENZENE.surface.1.9x2.5_c120313.nc -atm/cam/chem/emis/1992-2010/emissions.SOA_XYLENE.surface.1.9x2.5_c120313.nc -atm/cam/chem/emis/1992-2010/emissions.SOA_TOLUENE.surface.1.9x2.5_c120313.nc -atm/cam/chem/2000_emis/IPCC_emissions_houw_BENZENE_2000_1.9x2.5_c120227.nc -atm/cam/chem/2000_emis/IPCC_emissions_houw_XYLENE_2000_1.9x2.5_c120227.nc - - -atm/cam/chem/1850-2000_emis/IPCC_emissions_houw_NOx_1850-2000_1.9x2.5.c090728.nc -atm/cam/chem/1850-2000_emis/IPCC_emissions_houw_CO_1850-2000_1.9x2.5.c090728.nc -atm/cam/chem/1850-2000_emis/IPCC_emissions_houw_CH2O_1850-2000_1.9x2.5.c090728.nc -atm/cam/chem/1850-2000_emis/IPCC_emissions_houw_SO2_1850-2000_1.9x2.5.c090522.nc - -atm/cam/chem/1850-2000_emis/IPCC_emissions_houw_NOx_1850-2000_1.9x2.5.c090728.nc -atm/cam/chem/1850-2000_emis/IPCC_emissions_houw_CO_1850-2000_1.9x2.5.c090728.nc -atm/cam/chem/1850-2000_emis/IPCC_emissions_houw_CH2O_1850-2000_1.9x2.5.c090728.nc -atm/cam/chem/1850-2000_emis/IPCC_emissions_houw_SO2_1850-2000_1.9x2.5.c090522.nc - - -atm/cam/chem/trop_mozart_aero/emis/aerocom_DMS_2000.c080417.nc -atm/cam/chem/trop_mozart_aero/emis/aerocom_CB1_2000.c080807.nc -atm/cam/chem/trop_mozart_aero/emis/aerocom_OC1_2000.nosoa.c080807.nc -atm/cam/chem/trop_mozart_aero/emis/aerocom_SO2_surface_2000.c080807.nc -atm/cam/chem/trop_mozart_aero/emis/aerocom_SO4_surface_2000.c080807.nc - -atm/cam/chem/trop_mozart_aero/emis/aerocom_SO2_vertical_2000.c080807.nc -atm/cam/chem/trop_mozart_aero/emis/aerocom_SO4_vertical_2000.c080807.nc - - -noresm-only/atm/cam/chem/trop_mozart_aero/emis/ipcc_ar5/aerocom_mam3_dms_surf_1849-2006_c090804.nc -noresm-only/atm/cam/chem/trop_mozart_aero/emis/ipcc_ar5/ar5_mam3_so2_surf_1850-2005_c090804.nc -noresm-only/atm/cam/chem/trop_mozart_aero/emis/ipcc_ar5/ar5_mam3_BCFFX_surf_1850-2005_c090804.nc -noresm-only/atm/cam/chem/trop_mozart_aero/emis/ipcc_ar5/ar5_mam3_BCFFN_surf_1850-2005_c090804.nc -noresm-only/atm/cam/chem/trop_mozart_aero/emis/ipcc_ar5/BCBB_ZERO_dummy_surf.nc -noresm-only/atm/cam/chem/trop_mozart_aero/emis/ipcc_ar5/ar5_mam3_so4_pr_surf_1850-2005_c090804.nc -atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_pom_surf_oslo_scaled_1850-2010_c20140421_v12.nc -noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_monoterp_2000.nc -noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_isopr_2000.nc - -noresm-only/atm/cam/chem/trop_mozart_aero/emis/ipcc_ar5/ar5_mam3_so2_elev_1850-2005_c090804.nc -noresm-only/atm/cam/chem/trop_mozart_aero/emis/ipcc_ar5/BCFFX_ZERO_dummy_elev.nc -noresm-only/atm/cam/chem/trop_mozart_aero/emis/ipcc_ar5/BCFFN_ZERO_dummy_elev.nc -noresm-only/atm/cam/chem/trop_mozart_aero/emis/ipcc_ar5/ar5_mam3_bc_elev_1850-2005_c090804.nc -atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_pom_elev_oslo_scaled_1850-2010_c20140421_v12.nc -noresm-only/atm/cam/chem/trop_mozart_aero/emis/ipcc_ar5/ar5_mam3_so4_pr_elev_1850-2005_c090804.nc - - - -atm/cam/chem/trop_mozart_aero/emis/emis_NH3_2000_c111014.nc -atm/cam/chem/trop_mozart_aero/emis/aerocom_mam3_dms_surf_2000_c120315.nc -atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_so2_surf_2000_c120315.nc -atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_soag_1.5_surf_2000_c130422.nc -atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_bc_surf_2000_c120315.nc -atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_bc_surf_2000_c120315.nc -atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_bc_surf_2000_c120315.nc -atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_pom_surf_2000_c130422.nc -atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_pom_surf_2000_c130422.nc -atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_pom_surf_2000_c130422.nc - -atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_so4_a1_surf_2000_c120315.nc -atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_so4_a2_surf_2000_c120315.nc -atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_num_a1_surf_2000_c120315.nc -atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_num_a2_surf_2000_c120315.nc - -atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_so2_elev_2000_c120315.nc -atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_so4_a1_elev_2000_c120315.nc -atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_so4_a2_elev_2000_c120315.nc -atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_num_a1_elev_2000_c120315.nc -atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_num_a2_elev_2000_c120315.nc -atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_pom_elev_2000_c130422.nc -atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_pom_elev_2000_c130422.nc -atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_pom_elev_2000_c130422.nc -atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_bc_elev_2000_c120315.nc -atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_bc_elev_2000_c120315.nc -atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_bc_elev_2000_c120315.nc - - - -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_DMS_other_surface_1750-2015_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_DMS_bb_surface_1750-2015_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_SO2_anthro-ag-ship-res_surface_1750-2015_0.9x1.25_c20170616.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_SO2_anthro-ene_surface_1750-2015_0.9x1.25_c20170616.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_SO2_bb_surface_1750-2015_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_so4_a1_anthro-ag-ship_surface_1750-2015_0.9x1.25_c20170616.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_so4_a1_bb_surface_1750-2015_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_so4_a2_anthro-res_surface_1750-2015_0.9x1.25_c20170616.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_num_so4_a1_anthro-ag-ship_surface_1750-2015_0.9x1.25_c20170616.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_num_so4_a2_anthro-res_surface_1750-2015_0.9x1.25_c20170616.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_bc_a4_anthro_surface_1750-2015_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_num_bc_a4_anthro_surface_1750-2015_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_pom_a4_anthro_surface_1750-2015_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_num_pom_a4_anthro_surface_1750-2015_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_num_so4_a1_bb_surface_1750-2015_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_bc_a4_bb_surface_1750-2015_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_num_bc_a4_bb_surface_1750-2015_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_pom_a4_bb_surface_1750-2015_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_num_pom_a4_bb_surface_1750-2015_0.9x1.25_c20170509.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_SOAGx1.5_anthro_surface_1750-2015_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_SOAGx1.5_biogenic_surface_1750-2015_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_SOAGx1.5_bb_surface_1750-2015_0.9x1.25_c20170322.nc - -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_BENZENE_anthro_surface_1750-2015_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_BENZENE_bb_surface_1750-2015_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_BIGALK_anthro_surface_1750-2015_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_BIGALK_bb_surface_1750-2015_0.9x1.25_c20180611.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_BIGENE_anthro_surface_1750-2015_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_BIGENE_bb_surface_1750-2015_0.9x1.25_c20180611.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_C2H2_anthro_surface_1750-2015_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_C2H2_bb_surface_1750-2015_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_C2H4_anthro_surface_1750-2015_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_C2H4_bb_surface_1750-2015_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_C2H4_other_surface_1750-2015_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_C2H5OH_anthro_surface_1750-2015_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_C2H5OH_bb_surface_1750-2015_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_C2H6_anthro_surface_1750-2015_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_C2H6_bb_surface_1750-2015_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_C2H6_other_surface_1750-2015_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_C3H6_anthro_surface_1750-2015_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_C3H6_bb_surface_1750-2015_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_C3H6_other_surface_1750-2015_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_C3H8_anthro_surface_1750-2015_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_C3H8_bb_surface_1750-2015_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_C3H8_other_surface_1750-2015_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_CH2O_anthro_surface_1750-2015_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_CH2O_bb_surface_1750-2015_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_CH3CHO_anthro_surface_1750-2015_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_CH3CHO_bb_surface_1750-2015_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_CH3CN_anthro_surface_1750-2015_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_CH3CN_bb_surface_1750-2015_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_CH3COCH3_anthro_surface_1750-2015_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_CH3COCH3_bb_surface_1750-2015_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_CH3COCHO_bb_surface_1750-2015_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_CH3COOH_anthro_surface_1750-2015_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_CH3COOH_bb_surface_1750-2015_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_CH3OH_anthro_surface_1750-2015_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_CH3OH_bb_surface_1750-2015_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_CO_anthro_surface_1750-2015_0.9x1.25_c20180504.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_CO_bb_surface_1750-2015_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_CO_other_surface_1750-2015_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_GLYALD_bb_surface_1750-2015_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_HCN_anthro_surface_1750-2015_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_HCN_bb_surface_1750-2015_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_HCOOH_anthro_surface_1750-2015_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_HCOOH_bb_surface_1750-2015_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_ISOP_bb_surface_1750-2015_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_IVOC_anthro_surface_1750-2015_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_IVOC_bb_surface_1750-2015_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_MEK_anthro_surface_1750-2015_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_MEK_bb_surface_1750-2015_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_MTERP_bb_surface_1750-2015_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_NH3_anthro_surface_1750-2015_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_NH3_bb_surface_1750-2015_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_NH3_other_surface_1750-2015_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_NO_anthro_surface_1750-2015_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_NO_bb_surface_1750-2015_0.9x1.25_c20180611.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_NO_other_surface_1750-2015_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_SVOC_anthro_surface_1750-2015_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_SVOC_bb_surface_1750-2015_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_TOLUENE_anthro_surface_1750-2015_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_TOLUENE_bb_surface_1750-2015_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_XYLENES_anthro_surface_1750-2015_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_XYLENES_bb_surface_1750-2015_0.9x1.25_c20170322.nc - -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions_E90global_surface_1750-2100_0.9x1.25_c20170322.nc - -atm/cam/chem/emis/elev/H2OemissionCH4oxidationx2_3D_L70_1849-2015_CMIP6ensAvg_c180927.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_SO2_contvolcano_vertical_850-5000_0.9x1.25_c20170724.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_so4_a1_contvolcano_vertical_850-5000_0.9x1.25_c20170724.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_num_a1_so4_contvolcano_vertical_850-5000_0.9x1.25_c20170724.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_so4_a2_contvolcano_vertical_850-5000_0.9x1.25_c20170724.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_num_a2_so4_contvolcano_vertical_850-5000_0.9x1.25_c20170724.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_so4_a1_anthro-ene_vertical_1750-2015_0.9x1.25_c20170616.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_num_so4_a1_anthro-ene_vertical_1750-2015_0.9x1.25_c20170616.nc - -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_bc_a4_aircraft_vertical_1750-2015_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_NO2_aircraft_vertical_1750-2015_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_num_bc_a4_aircraft_vertical_1750-2015_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_SO2_aircraft_vertical_1750-2015_0.9x1.25_c20170608.nc -atm/cam/chem/stratvolc/VolcanEESMv3.11_SO2_850-2016_Mscale_Zreduc_1deg_c180812.nc -atm/cam/chem/stratvolc/VolcanEESMv3.11_SO2_850-2016_Mscale_Zreduc_2deg_c180812.nc -atm/cam/chem/stratvolc/VolcanEESMv3.10_piControl_SO2_1850-2014average_1deg_ZeroTrop_c180416.nc - - - - - -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_DMS_other_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_DMS_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SO2_anthro-ag-ship-res_surface_2000climo_0.9x1.25_c20170616.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SO2_anthro-ene_surface_2000climo_0.9x1.25_c20170616.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SO2_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_so4_a1_anthro-ag-ship_surface_2000climo_0.9x1.25_c20170616.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_so4_a1_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_so4_a2_anthro-res_surface_2000climo_0.9x1.25_c20170616.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_so4_a1_anthro-ag-ship_surface_2000climo_0.9x1.25_c20170616.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_so4_a2_anthro-res_surface_2000climo_0.9x1.25_c20170616.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_bc_a4_anthro_surface_2000climo_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_bc_a4_anthro_surface_2000climo_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_pom_a4_anthro_surface_2000climo_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_pom_a4_anthro_surface_2000climo_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_so4_a1_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_bc_a4_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_bc_a4_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_pom_a4_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_pom_a4_bb_surface_2000climo_0.9x1.25_c20170509.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SOAGx1.5_anthro_surface_2000climo_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SOAGx1.5_biogenic_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SOAGx1.5_bb_surface_2000climo_0.9x1.25_c20170322.nc - -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_BENZENE_anthro_surface_2000climo_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_BENZENE_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_BIGALK_anthro_surface_2000climo_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_BIGALK_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_BIGENE_anthro_surface_2000climo_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_BIGENE_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C2H2_anthro_surface_2000climo_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C2H2_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C2H4_anthro_surface_2000climo_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C2H4_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C2H4_other_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C2H5OH_anthro_surface_2000climo_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C2H5OH_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C2H6_anthro_surface_2000climo_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C2H6_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C2H6_other_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C3H6_anthro_surface_2000climo_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C3H6_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C3H6_other_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C3H8_anthro_surface_2000climo_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C3H8_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C3H8_other_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH2O_anthro_surface_2000climo_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH2O_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH3CHO_anthro_surface_2000climo_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH3CHO_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH3CN_anthro_surface_2000climo_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH3CN_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH3COCH3_anthro_surface_2000climo_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH3COCH3_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH3COCHO_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH3COOH_anthro_surface_2000climo_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH3COOH_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH3OH_anthro_surface_2000climo_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH3OH_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CO_anthro_surface_2000climo_0.9x1.25_c20180504.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CO_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CO_other_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_GLYALD_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_HCN_anthro_surface_2000climo_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_HCN_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_HCOOH_anthro_surface_2000climo_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_HCOOH_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_ISOP_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_IVOC_anthro_surface_2000climo_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_IVOC_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_MEK_anthro_surface_2000climo_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_MEK_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_MTERP_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_NH3_anthro_surface_2000climo_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_NH3_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_NH3_other_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_NO_anthro_surface_2000climo_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_NO_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_NO_other_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SVOC_anthro_surface_2000climo_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SVOC_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_TOLUENE_anthro_surface_2000climo_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_TOLUENE_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_XYLENES_anthro_surface_2000climo_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_XYLENES_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/elev/H2O_emission_CH4_oxidationx2_elev_2000climo_CCMI_RCP6_0_c160219.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SO2_contvolcano_vertical_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_so4_a1_contvolcano_vertical_2000climo_0.9x1.25_c20170724.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_a1_so4_contvolcano_vertical_2000climo_0.9x1.25_c20170724.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_so4_a2_contvolcano_vertical_2000climo_0.9x1.25_c20170724.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_a2_so4_contvolcano_vertical_2000climo_0.9x1.25_c20170724.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_so4_a1_anthro-ene_vertical_2000climo_0.9x1.25_c20170616.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_so4_a1_anthro-ene_vertical_2000climo_0.9x1.25_c20170616.nc - -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_bc_a4_aircraft_vertical_2000climo_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_NO2_aircraft_vertical_2000climo_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_bc_a4_aircraft_vertical_2000climo_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SO2_aircraft_vertical_2000climo_0.9x1.25_c20170608.nc - - - -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_DMS_other_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_DMS_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SO2_anthro-ag-ship-res_surface_2000climo_0.9x1.25_c20170616.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SO2_anthro-ene_surface_2000climo_0.9x1.25_c20170616.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SO2_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_so4_a1_anthro-ag-ship_surface_2000climo_0.9x1.25_c20170616.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_so4_a1_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_so4_a2_anthro-res_surface_2000climo_0.9x1.25_c20170616.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_so4_a1_anthro-ag-ship_surface_2000climo_0.9x1.25_c20170616.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_so4_a2_anthro-res_surface_2000climo_0.9x1.25_c20170616.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_bc_a4_anthro_surface_2000climo_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_bc_a4_anthro_surface_2000climo_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_pom_a4_anthro_surface_2000climo_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_pom_a4_anthro_surface_2000climo_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_so4_a1_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_bc_a4_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_bc_a4_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_pom_a4_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_pom_a4_bb_surface_2000climo_0.9x1.25_c20170509.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SOAGx1.5_anthro_surface_2000climo_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SOAGx1.5_biogenic_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SOAGx1.5_bb_surface_2000climo_0.9x1.25_c20170322.nc - -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_BENZENE_anthro_surface_2000climo_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_BENZENE_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_BIGALK_anthro_surface_2000climo_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_BIGALK_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_BIGENE_anthro_surface_2000climo_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_BIGENE_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C2H2_anthro_surface_2000climo_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C2H2_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C2H4_anthro_surface_2000climo_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C2H4_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C2H4_other_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C2H5OH_anthro_surface_2000climo_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C2H5OH_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C2H6_anthro_surface_2000climo_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C2H6_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C2H6_other_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C3H6_anthro_surface_2000climo_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C3H6_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C3H6_other_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C3H8_anthro_surface_2000climo_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C3H8_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_C3H8_other_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH2O_anthro_surface_2000climo_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH2O_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH3CHO_anthro_surface_2000climo_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH3CHO_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH3CN_anthro_surface_2000climo_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH3CN_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH3COCH3_anthro_surface_2000climo_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH3COCH3_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH3COCHO_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH3COOH_anthro_surface_2000climo_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH3COOH_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH3OH_anthro_surface_2000climo_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CH3OH_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CO_anthro_surface_2000climo_0.9x1.25_c20180504.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CO_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_CO_other_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_GLYALD_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_HCN_anthro_surface_2000climo_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_HCN_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_HCOOH_anthro_surface_2000climo_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_HCOOH_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_ISOP_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_IVOC_anthro_surface_2000climo_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_IVOC_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_MEK_anthro_surface_2000climo_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_MEK_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_MTERP_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_NH3_anthro_surface_2000climo_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_NH3_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_NH3_other_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_NO_anthro_surface_2000climo_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_NO_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_NO_other_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SVOC_anthro_surface_2000climo_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SVOC_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_TOLUENE_anthro_surface_2000climo_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_TOLUENE_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_XYLENES_anthro_surface_2000climo_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_XYLENES_bb_surface_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/elev/H2O_emission_CH4_oxidationx2_elev_2000climo_CCMI_RCP6_0_c160219.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SO2_contvolcano_vertical_2000climo_0.9x1.25_c20170322.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_so4_a1_contvolcano_vertical_2000climo_0.9x1.25_c20170724.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_a1_so4_contvolcano_vertical_2000climo_0.9x1.25_c20170724.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_so4_a2_contvolcano_vertical_2000climo_0.9x1.25_c20170724.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_a2_so4_contvolcano_vertical_2000climo_0.9x1.25_c20170724.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_so4_a1_anthro-ene_vertical_2000climo_0.9x1.25_c20170616.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_so4_a1_anthro-ene_vertical_2000climo_0.9x1.25_c20170616.nc - -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_bc_a4_aircraft_vertical_2000climo_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_NO2_aircraft_vertical_2000climo_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_bc_a4_aircraft_vertical_2000climo_0.9x1.25_c20170608.nc -atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SO2_aircraft_vertical_2000climo_0.9x1.25_c20170608.nc - - - - - -atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_so2_elev_2000_wofire_c150317.nc -atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_so4_a1_elev_2000_wofire_c150317.nc -atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_num_a1_elev_2000_wofire_c150317.nc -atm/cam/chem/trop_mozart_aero/emis/ar5_mam4_num_a1_elev_2000_wofire_c150722.nc - -atm/cam/chem/emis/elev/SO2_emission_OCS_oxidation_elev_1849-2101_WACCM5_c150302.nc -atm/cam/chem/emis/elev/H2O_emission_CH4_oxidationx2_elev_1850-2100_CCMI_RCP6_0_c160219.nc - -atm/cam/chem/trop_mozart_aero/emis/ar5_mam4_num_a1_surf_2000_c120716.nc -atm/cam/chem/trop_mozart_aero/emis/ar5_mam4_num_a4_surf_2000_c120716.nc -atm/cam/chem/trop_mozart_aero/emis/ar5_mam4_num_a1_elev_2000_c120716.nc -atm/cam/chem/trop_mozart_aero/emis/ar5_mam4_num_a4_elev_2000_c120716.nc - -atm/cam/chem/trop_mozart_aero/emis/ar5_mam7_num_a1_surf_2000_c120716.nc -atm/cam/chem/trop_mozart_aero/emis/ar5_mam7_num_a3_surf_2000_c120716.nc -atm/cam/chem/trop_mozart_aero/emis/ar5_mam7_num_a1_elev_2000_c120716.nc -atm/cam/chem/trop_mozart_aero/emis/ar5_mam7_num_a3_elev_2000_c120716.nc - -atm/cam/chem/emis/rcp85_finn_2002-2013/rcp85_finn_2000.IVOCbb.surface.1.9x2.5_c20150914.nc -atm/cam/chem/emis/rcp85_finn_2002-2013/rcp85_finn_2000.IVOCff.surface.1.9x2.5_c20150914.nc -atm/cam/chem/emis/rcp85_finn_2002-2013/rcp85_finn_2000.IVOCbb.elev.1.9x2.5_mol_c20150914.nc -atm/cam/chem/emis/rcp85_finn_2002-2014/rcp85_finn_2000.SVOCbb.elev.1.9x2.5_c160601.nc - - -oxid_1.9x2.5_L26_1850-2005_c091123.nc - - -oxid_1.9x2.5_L26_1850clim_c091123.nc -1850 -oxid_1.9x2.5_L26_1850clim_c091123.nc -1850 - -atm/cam/chem/trop_mozart_aero/oxid -CYCLICAL -2000 -oxid_1.9x2.5_L26_clim_list.c090805.txt - - -halons_oxid_1.9x2.5zm_L66_1849-2099_c160714.nc -atm/waccm/halons -CYCLICAL -2000 - - -CH4_1990-1999_clim_c090605.nc -filelist_c090605.txt -atm/cam/chem/methane -CYCLICAL -1995 - -tracer_cnst_halons_WACCM6_3Dmonthly_L70_1975-2014_c180216.nc -atm/cam/tracer_cnst -CYCLICAL -2000 - -CH4_1990-1999_clim_c090605.nc -filelist_c090605.txt -atm/cam/chem/methane -CYCLICAL -1995 - - -CESM_1949_2100_sad_V2_c130627.nc -atm/waccm/sulf -CESM_1849_2100_sad_V3_c160211.nc -atm/cam/volc -ozone_strataero_CAM6chem_1849-2014_zm_5day_c170924.nc -atm/cam/ozone -ozone_strataero_WACCM6_L70_zm5day_19750101-20141229_c180216.nc -atm/cam/ozone_strataero - - -atm/waccm/sulf/sulfate.ar5_camchem_c130304.nc - - -NEU -MOZ -OFF - - -xactive_lnd - - -atm/cam/chem/trop_mam/atmsrf_ne5np4_110920.nc -atm/cam/chem/trop_mam/atmsrf_ne16np4_110920.nc -atm/cam/chem/trop_mam/atmsrf_ne30np4_110920.nc -atm/cam/chem/trop_mam/atmsrf_ne60np4_110920.nc -atm/cam/chem/trop_mam/atmsrf_ne120np4_110920.nc -atm/cam/chem/trop_mam/atmsrf_ne240np4_110920.nc - -atm/cam/chem/trop_mam/atmsrf_ne0np4conus30x8_161116.nc - - -atm/cam/chem/trop_mozart/dvel/depvel_monthly.nc -atm/cam/chem/trop_mozart/dvel/regrid_vegetation.nc -atm/cam/chem/trop_mozart/dvel/regrid_vegetation_all_zero_aquaplanet_1deg_regularGrid_c20170421.nc -atm/cam/chem/trop_mozart/dvel/clim_soilw.nc -atm/cam/chem/trop_mozart/dvel/season_wes.nc - - -atm/waccm/phot/effxstex.txt -atm/cam/chem/trop_mozart/phot/tuv_xsect.nc -atm/cam/chem/trop_mozart/phot/o2src.nc -atm/waccm/phot/xs_short_jpl10_c140303.nc -atm/waccm/phot/temp_prs_GT200nm_JPL10_c140624.nc -atm/waccm/phot/RSF_GT200nm_v3.0_c080811.nc -atm/cam/chem/trop_mozart/phot/exo_coldens.nc - - -atm/waccm/ub/tgcm_ubc_1993_c100204.nc -atm/waccm/ub/snoe_eof.nc - - -atm/cam/chem/trop_mozart/ub/ubvals_b40.20th.track1_1996-2005_c110315.nc -atm/cam/chem/trop_mozart/ub -linoz2004_2006jpl_c081216.nc -atm/cam/chem/trop_mozart/ub/EESC_1850-2100_c090603.nc - - - -atm/cam/rad/carbon_penner_cooke_doubled_64x128_c021120.nc -atm/cam/rad/carbon_penner_cooke_doubled_32x64_c021120.nc -atm/cam/rad/carbon_penner_cooke_doubled_4x5_c021120.nc - - -atm/cam/dst/dst_source2x2tunedcam6-2x2-04062017.nc -atm/cam/dst/dst_source2x2_cam5.4_c150327.nc -atm/cam/dst/dst_source2x2tuned-cam4-06132012.nc -atm/cam/dst/dst_source1x1tuned-cam4-06202012.nc - - - .false. - .true. - .true. - .false. - .true. - - 0.075D0 - 0.100D0 - 0.100D0 - - 1.0D0 - - - .false. - .true. - - - .false. - .true. - .true. - .true. - - - 0 - 1 - 1 - 1 - - 0.01d0 - 0.001d0 - - - .false. - .true. - .true. - - - .false. - .false. - - - .false. - .false. - .false. - .true. - .false. - 300.0D0 - 1.0D0 - 0.7D0 - 0.35D0 - 2.2D0 - 0.308 - 0.5 - 0.3 - 2.4 - 1.0 - 1.0 - 1.3 - 4.2 - 0.5 - 0.5 - 0.0 - 1.0D0 - 0.04 - .false. - .false. - .false. - - - -NONE -RK -MG -MG -SPCAM_m2005 -SPCAM_sam1mom - - 1 - 0 - 1 - 400.D-6 - - 2 - 0 - 1 - 500.D-6 - - max_overlap - in_cloud - - 1.0D0 - 1.0D0 - - - - - 1 - 3 - - - 2 - 1 - 1 - - -1.0D0 -1.2D0 -1.2D0 - -1.0D0 -1.2D0 -1.2D0 - -.false. -.true. - -.false. -.true. - -.true. -.false. -1.0D0 -.true. - -.true. - -.false. - - -none -rk -park -CLUBB_SGS -SPCAM_sam1mom -SPCAM_m2005 - - - - 1.D2 - - - - 1.D-4 - - - - -0.D0 - -1.D0 -0.D0 -0.D0 - -1.D0 - -40.D3 - -40.D3 -30.D0 -100.D0 -100.D0 - -100.D3 -100.D0 -100.D0 - -30.D0 -40.D0 - - .false. - - - - 0.1D0 - 50.D0 - - -0.37D0 -0.35D0 -0.35D0 -0.45D0 -0.45D0 -0.45D0 -0.35D0 -0.45D0 -0.45D0 -0.45D0 - -0.55D0 -0.22D0 -0.55D0 -0.70D0 -0.13D0 - -0.26D0 -0.7D0 -0.24D0 -0.9D0 - - - - - - - - - - -1.35D0 -1.62D0 -0.90D0 -1.00D0 -1.2D0 - - -1.0D0 -0.6D0 -1.0D0 - -0.1D0 -1.0D0 - -0.4D0 -1.0D0 - -1.00D0 -1.00D0 - - -.false. -off - - -.false. -.false. -.false. -.false. -.false. - - - 3 - 1 - 10 - - -.true. -4 - - -NONE -diag_TKE -HB -HBR -CLUBB_SGS -SPCAM_m2005 -SPCAM_sam1mom - - -ZM -UNICON -NONE -SPCAM -SPCAM - -NONE -UW -UNICON -Hack -Hack -CLUBB_SGS -SPCAM -SPCAM - - -.true. - -.false. -.true. -.true. - - 0.900D0 - 0.910D0 - 0.850D0 - 0.850D0 - 0.950D0 - 0.8975D0 - 0.8875D0 - 0.9125D0 - - 0.910D0 - 0.950D0 - 0.8975D0 - 0.8875D0 - 0.9125D0 - - 0.910D0 - 0.920D0 - 0.920D0 - - 0.913D0 - 0.903D0 - 0.905D0 - 0.880D0 - 0.910D0 - - 0.100D0 - 0.000D0 - 0.000D0 - - 0.800D0 - 0.770D0 - 0.700D0 - 0.770D0 - 0.500D0 - 0.900D0 - 0.900D0 - 0.680D0 - 0.680D0 - 0.650D0 - - 0.07D0 - 0.04D0 - 0.10D0 - 0.04D0 - - 500.0D0 - - 0.14D0 - 0.10D0 - 0.10D0 - 0.10D0 - 0.10D0 - - 500.0D0 - - 75000.0D0 - 25000.0D0 - 25000.0D0 - 25000.0D0 - 25000.0D0 - 25000.0D0 - 25000.0D0 - 25000.0D0 - 40000.0D0 - 40000.0D0 - 40000.0D0 - 40000.0D0 - 40000.0D0 - 40000.0D0 - 40000.0D0 - 40000.0D0 - - 750.0D2 - 700.0D2 - 700.0D2 - - 1 - 5 - 5 - 4 - 4 - 4 - - 0.95D0 - 0.93D0 - 0.93D0 - 0.70D0 - 0.70D0 - 0.70D0 - - 0.80D0 - 0.85D0 - 0.80D0 - - 1.0D0 - 0.85D0 - - 1.1D0 - 1.0D0 - 1.0D0 - 1.1D0 - 1.0D0 - 1.0D0 - -.false. - -.false. -.true. - - - 5.0e-6 - 9.5e-6 - 45.0e-6 - 45.0e-6 - 45.0e-6 - 18.0e-6 - 18.0e-6 - 9.5e-6 - 9.5e-6 - 9.5e-6 - 9.5e-6 - - 30.0e-6 - 20.0e-6 - 16.0e-6 - 1.0e-6 - 18.0e-6 - - 4.0e-4 - 2.0e-4 - 2.0e-6 - 2.0e-4 - - 10.0e-6 - 5.0e-6 - 5.0e-6 - 5.0e-6 - 5.0e-6 - 5.0e-6 - - 10.0e-6 - 1.0e-6 - - - 1800.0D0 - 1.0e-4 - 5.0e-5 - 5.0e-5 - 5.0e-5 - 2.0e-4 - - 2.0e-4 - 1.0e-5 - 1.0e-5 - 1.0e-4 - 1.0e-4 - 1.0e-4 - - - 10.0 - 5.0 - - 5.0 - - - - 0.4000D0 - 0.7000D0 - - 0.4000D0 - 0.7000D0 - - 0.0030D0 - 0.0059D0 - 0.0035D0 - 0.0075D0 - 0.0059D0 - 0.0035D0 - 0.0075D0 - 0.0035D0 - 0.0035D0 - 0.0020D0 - 0.0040D0 - 0.0040D0 - 0.0040D0 - - 0.0030D0 - 0.0450D0 - 0.0035D0 - 0.0450D0 - 0.0035D0 - 0.0300D0 - 0.0035D0 - 0.0035D0 - 0.0020D0 - 0.0040D0 - 0.0040D0 - 0.0040D0 - - 3.0E-6 - 1.0E-5 - - 3.0E-6 - 5.0E-6 - 5.0E-6 - 5.0E-6 - 5.0E-6 - 5.0E-6 - - .false. - .true. - - .false. - 5 - 1 - - - - 1.0D0 - 0.5D0 - 0.5D0 - - -0 -1 - - 2 - 4 - 4 - 4 -42 -42 -42 -42 -42 -42 -42 -42 -42 -42 - -1 -2 -2 -2 -2 -4 - -2 -4 - - 8 -16 - -3.e+5 - -0 -1 - - -atm/cam/inic/gaus/cami_0000-09-01_64x128_L30_c031210.nc -atm/cam/scam/iop/ARM97_4scam.nc - 36.6 - 262.5 - 19970618 - 84585 - 2088 - 1500 - 9 - nsteps - .true. - slt - - - - 2.5D5 - 2.5D7 - - - 4 - - 4 - - 1.0D18 - 2.0D16 - 2.0D16 - 1.17D16 - 7.14D14 - 1.5D14 - 1.5D13 - - 0.0D0 - 0.06D0 - 5 - - 1 - 12 - - -atm/cam/scam/iop/ARM95_4scam.nc - - - 3 - - - .true. - .false. - .false. - .false. - .false. - .false. - .false. - .true. - .false. - .true. - .true. - .true. - .true. - .false. - - - - - - 0 - 120 - - 2 - - .true. - - 3.322 - - 3.2 - - 3 - 1 - 1 - - 4 - - 1 - - 8 - - 1.0e99 - 1.9 - - none - - 2 - 1 - - 5 - 5 - 10 - 20 - 20 - 25 - - 5 - --1 - 8.0e-8 - 1.0e13 - - -1 - 15.8e-8 - 1.5625e13 - --1 - 8.0e-8 - 1.5625e13 - - 2.5e5 - 1.0e5 - 2.0e5 - - 3 - 3 - 3 - 5 - 1 - 1 - 1 - 1 - - 1 - - .false. - .true. - .true. - - 3 - -3 - - 0 - - 4 - - 1 - - - 2.0e-5 - 2.0e-5 - 0.0 - 0 - - - no - - - 0 - 0 - 0 - - - - - - -camrun - - -startup - - - - - - -ndays -1 - - -'monthly' - - - -101 - - -1990 - -'CESM1_MOD_TIGHT' - - - - - - - -atm/cam/sst/sst_HadOIBl_bc_0.23x0.31_clim_c061106.nc -atm/cam/sst/sst_HadOIBl_bc_0.47x0.63_clim_c061106.nc -atm/cam/sst/sst_HadOIBl_bc_0.9x1.25_clim_c040926a.nc -atm/cam/sst/sst_HadOIBl_bc_1.9x2.5_clim_c061031.nc -atm/cam/sst/sst_HadOIBl_bc_2.5x3.33_clim_c091210.nc -atm/cam/sst/sst_HadOIBl_bc_4x5_clim_c061031.nc -atm/cam/sst/sst_HadOIBl_bc_10x15_clim_c050526.nc - -atm/cam/sst/sst_HadOIBl_bc_256x512_clim_c031031.nc -atm/cam/sst/sst_HadOIBl_bc_128x256_clim_c050526.nc -atm/cam/sst/sst_HadOIBl_bc_64x128_clim_c050526.nc -atm/cam/sst/sst_HadOIBl_bc_48x96_clim_c050526.nc -atm/cam/sst/sst_HadOIBl_bc_32x64_clim_c050526.nc -atm/cam/sst/sst_HadOIBl_bc_8x16_clim_c050526.nc - -atm/cam/sst/sst_HadOIBl_bc_1x1_clim_c101029.nc - - -atm/cam/sst/sst_HadOIBl_bc_0.23x0.31_clim_pi_c091020.nc -atm/cam/sst/sst_HadOIBl_bc_0.47x0.63_clim_pi_c100128.nc -atm/cam/sst/sst_HadOIBl_bc_0.9x1.25_clim_pi_c100127.nc -atm/cam/sst/sst_HadOIBl_bc_1.9x2.5_clim_pi_c100127.nc -atm/cam/sst/sst_HadOIBl_bc_4x5_clim_pi_c100127.nc -atm/cam/sst/sst_HadOIBl_bc_10x15_clim_pi_c100127.nc - -atm/cam/sst/sst_HadOIBl_bc_128x256_clim_pi_c100128.nc -atm/cam/sst/sst_HadOIBl_bc_64x128_clim_pi_c100128.nc -atm/cam/sst/sst_HadOIBl_bc_48x96_clim_pi_c100128.nc -atm/cam/sst/sst_HadOIBl_bc_32x64_clim_pi_c100128.nc -atm/cam/sst/sst_HadOIBl_bc_8x16_clim_pi_c100128.nc - -atm/cam/sst/sst_HadOIBl_bc_1x1_clim_pi_c100129.nc - - -atm/cam/sst/sst_HadOIBl_bc_0.23x0.31_clim_pi_c091020.nc -atm/cam/sst/sst_HadOIBl_bc_0.47x0.63_1850_2012_c130411.nc -atm/cam/sst/sst_HadOIBl_bc_0.9x1.25_1850_2012_c130411.nc -atm/cam/sst/sst_HadOIBl_bc_1.9x2.5_1850_2012_c130411.nc -atm/cam/sst/sst_HadOIBl_bc_4x5_1850_2012_c130411.nc -atm/cam/sst/sst_HadOIBl_bc_10x15_1850_2012_c130411.nc - -atm/cam/sst/sst_HadOIBl_bc_128x256_1850_2012_c130411.nc -atm/cam/sst/sst_HadOIBl_bc_64x128_1850_2012_c130411.nc -atm/cam/sst/sst_HadOIBl_bc_48x96_1850_2008_c100128.nc -atm/cam/sst/sst_HadOIBl_bc_32x64_1850_2012_c130411.nc -atm/cam/sst/sst_HadOIBl_bc_8x16_1850_2012_c130411.nc - -atm/cam/sst/sst_HadOIBl_bc_1x1_1850_2012_c130411.nc - -atm/cam/som/cam4.som.forcing.aquaplanet.QzaFix_h50Fix_TspunFix.fv19.nc - - -ocn/docn7/domain.ocn.1x1.111007.nc - - -atm/cam/ocnfrac/domain.camocn.128x256_USGS_070807.nc -share/domains/domain.ocn.T42_gx1v7.180727.nc -share/domains/domain.ocn.48x96_gx3v7_100114.nc -atm/cam/ocnfrac/domain.camocn.32x64_USGS_070807.nc -atm/cam/ocnfrac/domain.camocn.8x16_USGS_070807.nc - -atm/cam/ocnfrac/domain.camocn.0.23x0.31_gx1v6_101108.nc -atm/cam/ocnfrac/domain.camocn.0.47x0.63_gx1v6_090408.nc -share/domains/domain.ocn.fv0.9x1.25_gx1v7.151020.nc -share/domains/domain.ocn.fv1.9x2.5_gx1v7.170518.nc -share/domains/domain.ocn.4x5_gx3v7_100120.nc -atm/cam/ocnfrac/domain.camocn.10x15_USGS_070807.nc - -share/domains/domain.ocn.ne5np4_gx3v7.140810.nc -share/domains/domain.ocn.ne16np4_gx1v7.171018.nc -share/domains/domain.ocn.ne30_gx1v7.171003.nc -share/domains/domain.ocn.ne60np4_gx1v6.121113.nc -share/domains/domain.ocn.ne120np4_gx1v6.121113.nc -share/domains/domain.ocn.ne240np4_gx1v6.111226.nc -atm/cam/ocnfrac/domain.aqua.fv1.9x2.5.nc - - -.true. -<<<<<<< HEAD -0.0 -======= - - ->>>>>>> origin/featureCESMNCARBeta_trunk2.0-7 - diff --git a/bld/namelist_files/namelist_definition.xml.orig b/bld/namelist_files/namelist_definition.xml.orig deleted file mode 100644 index e22d735090..0000000000 --- a/bld/namelist_files/namelist_definition.xml.orig +++ /dev/null @@ -1,7824 +0,0 @@ - - - - - - - - - - - - Toggle Model Nudging ON/OFF. - - FORCING: - -------- - Nudging tendencies are applied as a relaxation force between the current - model state values and target state values derived from the avalilable - analyses. The form of the target values is selected by the 'Nudge_Force_Opt' - option, the timescale of the forcing is determined from the given - 'Nudge_TimeScale_Opt', and the nudging strength Alpha=[0.,1.] for each - variable is specified by the 'Nudge_Xcoef' values. Where X={U,V,T,Q,PS} - - F_nudge = Alpha*((Target-Model(t_curr))/TimeScale - - WINDOWING: - ---------- - The region of applied nudging can be limited using Horizontal/Vertical - window functions that are constructed using a parameterization of the - Heaviside step function. - - The Heaviside window function is the product of separate horizonal and vertical - windows that are controled via 12 parameters: - - Nudge_Hwin_lat0: Specify the horizontal center of the window in degrees. - Nudge_Hwin_lon0: The longitude must be in the range [0,360] and the - latitude should be [-90,+90]. - Nudge_Hwin_latWidth: Specify the lat and lon widths of the window as positive - Nudge_Hwin_lonWidth: values in degrees.Setting a width to a large value (e.g. 999) - renders the window a constant in that direction. - Nudge_Hwin_latDelta: Controls the sharpness of the window transition with a - Nudge_Hwin_lonDelta: length in degrees. Small non-zero values yeild a step - function while a large value yeilds a smoother transition. - Nudge_Hwin_Invert : A logical flag used to invert the horizontal window function - to get its compliment.(e.g. to nudge outside a given window). - - Nudge_Vwin_Lindex: In the vertical, the window is specified in terms of model - Nudge_Vwin_Ldelta: level indcies. The High and Low transition levels should - Nudge_Vwin_Hindex: range from [0,(NLEV+1)]. The transition lengths are also - Nudge_Vwin_Hdelta: specified in terms of model indices. For a window function - constant in the vertical, the Low index should be set to 0, - the High index should be set to (NLEV+1), and the transition - lengths should be set to 0.001 - Nudge_Vwin_Invert : A logical flag used to invert the vertical window function - to get its compliment. - Default: FALSE - - - - Full pathname of analyses data to use for nudging. - (e.g. '/$DIN_LOC_ROOT/atm/cam/nudging/') - Default: none - - - - Template for Nudging analyses file names. - (e.g. '%y/ERAI_ne30np4_L30.cam2.i.%y-%m-%d-%s.nc') - Default: none - - - - Number of analyses files per day. - (e.g. 4 --> 6 hourly analyses) - Default: none - - - - Number of time to update model data per day. - (e.g. 48 --> 1800 Second timestep) - Default: none - - - - Year at which Nudging Begins. - Default: none - - - - Month at which Nudging Begins. - Default: none - - - - Day at which Nudging Begins. - Default: none - - - - Year at which Nudging Ends. - Default: none - - - - Month at which Nudging Ends. - Default: none - - - - Day at which Nudging Ends. - Default: none - - - - Select the form of nudging forcing, where (t'==Analysis times ; t==Model Times) - 0 -> NEXT-OBS: Target=Anal(t'_next) - 1 -> LINEAR: Target=(F*Anal(t'_curr) +(1-F)*Anal(t'_next)) - F =(t'_next - t_curr )/Tdlt_Anal - Default: 0 - - - - Select the timescale of nudging force, where (t'==Analysis times ; t==Model Times) - 0 --> TimeScale = 1/Tdlt_Anal - 1 --> TimeScale = 1/(t'_next - t_curr ) - Default: 0 - - - - Profile index for U nudging. - 0 == OFF (No Nudging of this variable) - 1 == CONSTANT (Spatially Uniform Nudging) - 2 == HEAVISIDE WINDOW FUNCTION - Default: 0 - - - - Normalized Coeffcient for U nudging. - [0.,1.] fraction of nudging tendency applied. - Default: 0. - - - - Profile index for V nudging. - 0 == OFF (No Nudging of this variable) - 1 == CONSTANT (Spatially Uniform Nudging) - 2 == HEAVISIDE WINDOW FUNCTION - Default: 0 - - - - Normalized Coeffcient for V nudging. - [0.,1.] fraction of nudging tendency applied. - Default: 0. - - - - Profile index for T nudging. - 0 == OFF (No Nudging of this variable) - 1 == CONSTANT (Spatially Uniform Nudging) - 2 == HEAVISIDE WINDOW FUNCTION - Default: 0 - - - - Normalized Coeffcient for T nudging. - [0.,1.] fraction of nudging tendency applied. - Default: 0. - - - - Profile index for Q nudging. - 0 == OFF (No Nudging of this variable) - 1 == CONSTANT (Spatially Uniform Nudging) - 2 == HEAVISIDE WINDOW FUNCTION - Default: 0 - - - - Normalized Coeffcient for Q nudging. - [0.,1.] fraction of nudging tendency applied. - Default: 0. - - - - Profile index for PS nudging. - 0 == OFF (No Nudging of this variable) - 1 == CONSTANT (Spatially Uniform Nudging) - 2 == HEAVISIDE WINDOW FUNCTION - Default: 0 - - - - Normalized Coeffcient for PS nudging. - [0.,1.] fraction of nudging tendency applied. - Default: 0. - - - - LAT0 center of Horizontal Window in degrees [-90.,90.]. - Default: none - - - - Width of LAT Window in degrees. - Default: none - - - - Width of transition which controls the steepness of window transition in latitude. - 0. --> Step function - Default: none - - - - LON0 center of Horizontal Window in degrees [0.,360.]. - Default: none - - - - Width of LON Window in degrees. - Default: none - - - - Width of transition which controls the steepness of window transition in longitude. - 0. --> Step function - Default: none - - - - Invert Horizontal Window Function to its Compliment. - TRUE = value=0 inside the specified window, 1 outside - FALSE = value=1 inside the specified window, 0 outside - Default: FALSE - - - - HIGH Level Index for Verical Window specified in terms of model level indices. - (e.g. For a 30 level model, Nudge_Vwin_Hindex ~ 30 ) - Default: none - - - - Width of transition for HIGH end of Vertical Window. - Default: none - - - - LOW Level Index for Verical Window specified in terms of model level indices. - (e.g. Nudge_Vwin_Lindex ~ 0 ) - Default: none - - - - Width of transition for LOW end of Vertical Window. - Default: none - - - - Invert Vertical Window Function to its Compliment. - TRUE = value=0 inside the specified window, 1 outside - FALSE = value=1 inside the specified window, 0 outside - Default: FALSE - - - - - - -Full pathname of time-variant boundary dataset for aerosol masses. -Default: set by build-namelist. - - - -Add CAM3 prescribed aerosols to the physics buffer. -Default: FALSE - - - - - -Dynamics/physics transpose method for nonlocal load-balance. -0: use mpi_alltoallv. -1: use point-to-point MPI-1 two-sided implementation. -2: use point-to-point MPI-2 one-sided implementation if supported, otherwise use - MPI-1 implementation. -3: use Co-Array Fortran implementation if supported, otherwise use MPI-1 implementation. -11-13: use mod_comm, choosing any of several methods internal to mod_comm. The method - within mod_comm (denoted mod_method) has possible values 0,1,2 and is set according - to mod_method = phys_alltoall - modmin_alltoall, where modmin_alltoall is 11. --1: use option 1 when each process communicates with less than half of the other - processes, otherwise use option 0 (if max_nproc_smpx and nproc_busy_d are both > npes/2). -Default: -1 - - - -Select target number of chunks per thread. Must be positive. -Default: 1 - - - -Physics grid decomposition options. --1: each chunk is a dynamics block. - 0: chunk definitions and assignments do not require interprocess comm. - 1: chunk definitions and assignments do not require internode comm. - 2: optimal diurnal, seasonal, and latitude load-balanced chunk definition and assignments. - 3: chunk definitions and assignments only require communication with one other process. - 4: concatenated blocks, no load balancing, no interprocess communication. -Default: 2 - - - -Physics grid decomposition options. - 0: assign columns to chunks as single columns, wrap mapped across chunks - 1: use (day/night; north/south) twin algorithm to determine load-balanced pairs of - columns and assign columns to chunks in pairs, wrap mapped -Default: 0 for unstructured grid dycores, 1 for lat/lon grid dycores - - - - - -Output constituent tendencies due to convection. Set to -'none', 'q_only' or 'all'. -Default: 'q_only' - - - -Turns on TEM circulation diagnostics history output. Only valid for FV dycore. - -Default: .false., unless it is overridden (WACCM with interactive chemistry and a few other specific - configurations do this) - - - -Turn on verbose output identifying columns that fail energy/water -conservation checks. -Default: FALSE - - - -Control the writing of qneg3 and qneg4 warning messages. -'summary' causes a summary of QNEG3 and QNEG4 errors to be - printed at the end of the run -'timestep' causes a summary of QNEG3 and QNEG4 errors to be printed at the - end of each timestep. The total is reset at the end of each timestep. -'off' causes the qneg3 and qneg4 warnings to be supressed. -Note that these settings do not affect the availability of qneg - history variables. -Default: 'summary' - - - - - -Number of layers from the top of the model over which to do dry convective -adjustment. Must be less than plev (the number of vertical levels). -Default: 3 - - - -The maximum number of iterations to achieve convergence in dry adiabatic adjustment. -For WACCM-X it can be advantageous to use a number which is much higher than the CAM -default. -Default: 15 - - - - - -Number of dynamics timesteps per physics timestep. If zero, a best-estimate -will be automatically calculated. -Default: 0 - - - -Number of tracer advection timesteps per physics timestep. -Nsplit is partitioned into nspltrac and nsplit/nspltrac, -with the latter being the number of dynamics timesteps per -tracer timestep, possibly rounded upward; after initialization, -the code quantity nsplit is redefined to be the number of -dynamics timesteps per tracer timestep. -Default: 0 - - - -Number of vertical re-mapping timesteps per physics timestep. -Nspltrac is partitioned into nspltvrm and nspltrac/nspltvrm, -with the latter being the number of tracer timesteps per -re-mapping timestep, possibly rounded upward; after initialization, -the code quantity nspltrac is redefined to be the number of -tracer timesteps per re-mapping timestep. -Default: 0 - - - -Order (mode) of X interpolation (1,..,6). -East-West transport scheme. - = 1: first order upwind - = 2: 2nd order van Leer (Lin et al 1994) - = 3: standard PPM - = 4: enhanced PPM (default) -Default: 4 - - - -Order (mode) of Y interpolation (1,..,6). -North-South transport scheme. - = 1: first order upwind - = 2: 2nd order van Leer (Lin et al 1994) - = 3: standard PPM - = 4: enhanced PPM (default) -Default: 4 - - - -Scheme to be used for vertical mapping. - = 1: first order upwind - = 2: 2nd order van Leer (Lin et al 1994) - = 3: standard PPM - = 4: enhanced PPM (default) -Default: 4 - - - -Flag indicating whether the dynamics uses internal algorithm for energy -conservation. -Default: .false. - - - -Enables optional filter for intermediate c-grid winds, (courtesy of Bill Putman). -Default: 0 - - - -1 for FFT filter always, 0 for combined algebraic/FFT filter. The value 0 -is used for CAM3, otherwise it is using the value 1. -Default: set by build-namelist - - - -Chooses type of divergence damping and velocity diffusion. -div24del2flag = 2 for ldiv2 (default), - = 4 for ldiv4, - = 42 for ldiv4 + ldel2 -where -ldiv2: 2nd-order divergence damping everywhere and increasing in top layers -ldiv4: 4th-order divergence damping -ldel2: 2nd-order velocity-component damping targetted to top layers, - with coefficient del2coef - -Default: set by build-namelist - - - -Chooses level of velocity diffusion. -Default: 3.0e5 - - - -Flag to turn on corrections that improve angular momentum conservation. -Default: .false. - - - -Flag to apply an arbitrary fix based on solid-body rotation to the zonal -velocity fields to improve conservation of angular momentum. -Default: .false. - - - -Flag to apply the fixer turned on by fv_am_fixer level by level. The -intent is to not contaminate the stratospheric circulation with -tropospheric AM loss, where it is most likely greatest (due to the larger -divergence fields). This option is experimental. -Default: .false. - - - -Flag to turn on a diagnostic calculation of angular momentum which is -written to the log file at each time step. Also enables calculation of -fields written to history file which are used in conjuction with those -enabled by do_circulation_diags for detailed analysis. -Default: .false. - - - -Switch to apply variable physics appropriate for the thermosphere and ionosphere -Default: set by build-namelist - - - -Flag to determine how to handle dpcoup warning messages -Default: off - - - - - -Set to 1 to force the 2D transpose computation when a 1D decomposition is -used. This is intended for debugging purposes only. -Default: 0 - - - -Geopotential method (routines geopk, geopk16, or geopk_d). - =0 for transpose method; - =1 for method using semi-global z communication with optional 16-byte arithmetic; - =2 for method using local z communication; -method 0, method 1 with 16-byte arithmetic and method 2 are all bit-for-bit across decompositions; -method 0 scales better than method 1 with npr_z, and method 1 is superior to method 0 for small npr_z; -The optimum speed is attained using either method 1 with 8-byte -arithmetic (standard for geopk16) or method 2 when utilizing the -optimal value for the associated parameter geopkblocks; for the last -two subcycles of a timestep, method 0 is automatically used; see -geopk.F90 and cd_core.F90. - -Default: 0 - - - -Geopotential method 2 pipeline parameter (routine geopk_d). -geopk_d implements a pipeline algorithm by dividing the -information that must be moved between processes into blocks. geopkblocks -specifies the number of blocks to use. The larger the number of blocks, -the greater the opportunity for overlapping communication with computation -and for decreasing instantaneous bandwidth requirements. The smaller the -number of blocks, the fewer MPI messages sent, decreasing MPI total latency. -See geopk_d within geopk.F90. -Default: 1 - - - -Mod_comm irregular underlying communication method for dyn_run/misc. -0 for original mp_sendirr/mp_recvirr -1 for mp_swapirr and a point-to-point implementation of communication pattern -2 for mp_swapirr and a collective (MPI_Alltoallv) implementation of communication pattern -Default: 0 - - - -True for mod_comm irregular communication handshaking for dyn_run/misc -Default: .true. - - - -True for mod_comm irregular communication blocking send for dyn_run/misc, -false for nonblocking send -Default: .true. - - - -Maximum number of outstanding nonblocking MPI requests to allow when -using mp_swapirr and point-to-point communications for dyn_run/misc. -Setting this less than the maximum can improve robustness for large process -count runs. If set to less than zero, then do not limit the number of -outstanding send/receive requests. -Default: -1 (so no limit) - - - -Mod_comm irregular underlying communication method for cd_core/geopk -0 for original mp_sendirr/mp_recvirr -1 for mp_swapirr and a point-to-point implementation of communication pattern -2 for mp_swapirr and a collective (MPI_Alltoallv) implementation of communication pattern -Default: 0 - - - -True for mod_comm irregular communication handshaking for cd_core/geopk -Default: .true. - - - -True for geopk_d and mod_comm irregular communication blocking send for -cd_core/geopk; false for nonblocking send. -Default: .true. - - - -Maximum number of outstanding nonblocking MPI requests to allow when -using mp_swapirr and point-to-point communications for cd_core/geopk. -Setting this less than the maximum can improve robustness for large process -count runs. If set to less than zero, then do not limit the number of -outstanding send/receive requests. -Default: -1 (so no limit) - - - -Mod_comm irregular underlying communication method for gather -0 for original mp_sendirr/mp_recvirr -1 for mp_swapirr and a point-to-point implementation of communication pattern -2 for mp_swapirr and a collective (MPI_Alltoallv) implementation of communication pattern -Default: 1 - - - -True for mod_comm irregular communication handshaking for gather -Default: .true. - - - -True for mod_comm irregular communication blocking send for gather, -false for nonblocking send -Default: .true. - - - -Maximum number of outstanding nonblocking MPI requests to allow when -using mp_swapirr and point-to-point communications for gather. -Setting this less than the maximum can improve robustness for large process -count runs. If set to less than zero, then do not limit the number of -outstanding send/receive requests. -Default: 64 - - - -Mod_comm irregular underlying communication method for scatter -0 for original mp_sendirr/mp_recvirr -1 for mp_swapirr and a point-to-point implementation of communication pattern -2 for mp_swapirr and a collective (MPI_Alltoallv) implementation of communication pattern -Default: 0 - - - -True for mod_comm irregular communication handshaking for scatter -Default: .false. - - - -True for mod_comm irregular communication blocking send for scatter, -false for nonblocking send -Default: .true. - - - -Maximum number of outstanding nonblocking MPI requests to allow when -using mp_swapirr and point-to-point communications for scatter. -Setting this less than the maximum can improve robustness for large process -count runs. If set to less than zero, then do not limit the number of -outstanding send/receive requests. -Default: -1 (so no limit) - - - -Mod_comm irregular underlying communication method for multiple tracers -0 for original mp_sendtrirr/mp_recvtrirr -1 for mp_swaptrirr and point-to-point communications -2 for mp_swaptrirr and all-to-all communications -Default: 0 - - - -True for mod_comm irregular communication handshaking for multiple tracers -Default: .true. - - - -True for mod_comm irregular communication blocking send for multiple -tracers, false for nonblocking send -Default: .true. - - - -Maximum number of outstanding nonblocking MPI requests to allow when -using mp_swaptrirr and point-to-point communications for multiple tracers. -Setting this less than the maximum can improve robustness for large process -count runs. If set to less than zero, then do not limit the number of -outstanding send/receive requests. -Default: -1 (so no limit) - - - -One or two simultaneous mod_comm irregular communications (excl. tracers) -Default: 2 - - - -Max number of tracers for simultaneous mod_comm irregular communications -Default: 3 - - - -For mod_comm gather/scatters, 0 for temporary contiguous buffers; 1 for mpi derived -types. -Default: 0 - - - -For geopk (geopktrans=1) messages, 0 for temporary contiguous buffers; 1 for mpi derived -types. -Default: 0 - - - -For mod_comm transposes, 0 for temporary contiguous buffers; 1 for mpi derived -types. -Default: 0 - - - -A four element integer array which specifies the YZ and XY decompositions. -The first two elements are the number of Y subdomains and number of Z -subdomains in the YZ decomposition. The second two elements are the number -of X subdomains and the number of Y subdomains in the XY decomposition. -Note that both the X and Y subdomains must contain at least 3 grid points. -For example, a grid with 96 latitudes can contain no more than 32 Y -subdomains. There is no restriction on the number of grid points (levels) -in a Z subdomain, but note that the threading parallelism in the FV dycore -is over levels, so for parallel efficiency it is best to have at least the -number of levels in each Z subdomain as there are threads available. - -There are a couple of rough rules of thumb to follow when setting the 2D -decompositions. The first is that the number of Y subdomains in the YZ -decomposition should be the same as the number of Y subdomains in the XY -decomposition (npr_yz(1) == npr_yz(4)). The second is that the total -number of YZ subdomains (npr_yz(1)*npr_yz(2)) should equal the total number -of XY subdomains (npr_yz(3)*npr_yz(4)). - -Default: ntask,1,1,ntask where ntask is the number of MPI tasks. This is a -1D decomposition in latitude. - - - -Overlapping of trac2d and cd_core subcycles. -Default: 0 - - - -Size of tracer domain decomposition for trac2d. -Default: 1 - - - -Control the writing of filew warning messages. -Default: 'off' - - - - - -TRUE => the offline meteorology winds are defined on the model grid cell walls. -Default: FALSE - - - -Name of file that contains the offline meteorology data. -Default: none - - - -Name of directory that contains the offline meteorology data. -Default: none - - - -Name of file that contains names of the offline meteorology data files. -Default: none - - - -TRUE => the offline meteorology file will be removed from local disk when no longer needed. -Default: FALSE - - - -(km) top of relaxation region of winds for offline waccm -Default: 60. - - - -(km) bottom of relaxation region of winds for offline waccm -Default: 50. - - - -(km) top of ramping relaxation region for metdata at model bottom -Default: 0. - - - -(km) bottom of ramping relaxation region for metdata at model bottom -Default: 0. - - - -Relaxation time (hours) applied to specified meteorology. - - positive values less then time step size gives 100% nudging - - negative values gives 0.0% nudging (infinite relaxation time) -Default: 0.0 - - - -if true, nudge only u, v and ps. If false, nudge other fields as well -(T, Q, TS, SHOWH, TAUX, TAUY, SHFLX, QFLX) -Default: true - - -<<<<<<< HEAD - -======= ->>>>>>> origin/featureCESMNCARBeta_trunk2.0-7 - -switch to turn on/off mass fixer for offline driver -Default: true - - - -srf heat flux field name in met data file -Default: 'SHFLX' - - - -water vapor flux field name in met data file -Default: 'QFLX' - - - -multiplication factor for srf heat flux -Default: 1.0 - - - -multiplication factor for water vapor flux -Default: 1.0 - - - -multiplication factor for snow hieght -Default: 1.0 - - - -If false then do not allow surface models feedbacks influence climate -Default: true - - - -If true nudge meteorology surface fields TAUX, TAUY, SHFLX, QFLX rather than force -Default: true - - - -If true nudge meteorology surface fields over the land. If false, then fields are -still nudged over the ocean. -Default: true - - - -If met_srf_land is false, then determines whether to nudge proportional to the non-land -fraction (i.e. 1 - land fraction) (true), or to nudge everywhere except where land -fraction is 1 (false). -Default: false - - - -If true nudge meteorology surface fields from radiation. These include ASDIR, ASDIF, -ALDIR, ALDIF, and LWUP. -Default: false - - - -If true nudge meteorology reference surface fields. These include TSREF, QREF, and U10. -Default: false - - - -If true nudge meteorology reference for sea surface temperature and sea ice fraction -(SST and SEAICEFRAC). -Default: false - - - -If true nudge surface sheer stress (TAUX, TAUY) from the meteorology. -Default: true - - - -If true nudge atmospheric temperature (T) from the meteorology. -Default: true - - - - - -del^2 horizontal diffusion coefficient. This is used above the Nth order -diffusion. -Default: set by build-namelist - - - -Order (N) of horizontal diffusion operator used below the sponge layers. -N must be a positive multiple of 2. -Default: 4 - - - -The order N horizontal diffusion operator will be used in and below the -layer specified by this variable. -Default: 4 - - - -Nth order horizontal diffusion coefficient. -Default: set by build-namelist - - - -Number of days (from timestep 0) to run divergence damper. Use only if spectral -model becomes dynamicallly unstable during initialization. Suggested value: -2. (Value must be >= 0.) Default: 0. - - - -Time filter coefficient. Default: 0.06 - - - -Number of levels over which to apply Courant limiter, starting at top of -model. -Default: 5 - - - -Number of dynamics timesteps per physics timestep. If zero, a best-estimate -will be automatically calculated. -Default: 1 - - - - - -Spectral dynamics gather option. - 0: use mpi_allgatherv - 1: use point-to-point MPI-1 two-sided implementation - 2: use point-to-point MPI-2 one-sided implementation if supported, - otherwise use MPI-1 implementation - 3: use Co-Array Fortran implementation if supported, - otherwise use MPI-1 implementation -Default: 0 - - - -Spectral dynamics transpose option. - 0: use mpi_alltoallv - 1: use point-to-point MPI-1 two-sided implementation - 2: use point-to-point MPI-2 one-sided implementation if supported, - otherwise use MPI-1 implementation - 3: use Co-Array Fortran implementation if supported, - otherwise use MPI-1 implementation -Default: 0 - - - -Flag indicating whether to assign latitudes to equidistribute columns or -latitudes. This only matters when using a reduced grid. -Default: TRUE - - - -Number of processes assigned to dynamics (SE, EUL and SLD dycores). -Default: Total number of processes assigned to job. - - - -Stride for dynamics processes (EUL and SLD dycores). -E.g., if stride=2, assign every second process to the dynamics. -Default: 1 - - - - - -Whether or not to enable gravity waves produced by orography. -Default: set by build-namelist. - - - -Whether or not to enable gravity waves produced by frontogenesis. -Default: set by build-namelist. - - - -Whether or not to enable inertial gravity waves produced by frontogenesis. -Default: set by build-namelist. - - - -Whether or not to enable gravity waves produced by deep convection. -Default: set by build-namelist. - - - -Whether or not to enable gravity waves produced by shallow convection. -Default: .false. - - - -Gravity wave spectrum dimension (wave numbers are from -pgwv to pgwv). -Default: set by build-namelist. - - - -Width of speed bins (delta c) for gravity wave spectrum (reference wave -speeds are from -pgwv*dc to pgwv*dc). -Default: set by build-namelist. - - - -Dimension for long wavelength gravity wave spectrum (wave numbers are from --pgwv_long to pgwv_long). -Default: set by build-namelist. - - - -Width of speed bins (delta c) for long wavelength gravity wave spectrum -(reference wave speeds are from -pgwv_long*dc_long to pgwv_long*dc_long). -Default: set by build-namelist. - - - -Force the stress due to gravity waves to be zero at the top of the model. -In the low-top model, this helps to conserve momentum and produce a QBO. -Default: set by build-namelist. - - - -Apply limiters to tau before applying the efficiency factor, rather than -afterward. -Default: set by build-namelist - - - -Apply limiter on maximum wind tendency from stress divergence in gravity wave drag scheme. -Default: set by build-namelist - - - -Efficiency associated with convective gravity waves from the Beres -scheme (deep convection). -Default: set by build-namelist. - - - -Efficiency associated with convective gravity waves from the Beres -scheme (shallow convection). -Default: set by build-namelist. - - - -Efficiency associated with gravity waves from frontogenesis. -Default: set by build-namelist. - - - -Efficiency associated with inertial gravity waves from frontogenesis. -Default: set by build-namelist. - - - -Efficiency associated with orographic gravity waves. -Default: set by build-namelist. - - - -Whether or not to enable gravity waves produced by meso-Beta Ridges. -Default: set by build-namelist - - - -Number of meso-Beta ridges (per gridbox) to invoke. -Default: 10 (set by build-namelist) - - - -Efficiency scaling factor associated with anisotropic OGW. -Default: set by build-namelist. - - - -Max efficiency associated with anisotropic OGW. -Default: 1.0 - - - -Drag coefficient for obstacles in low-level flow. -Default: 1.0 - - - -Whether or not to allow trapping for meso-Beta Ridges. -Default: FALSE (set by build-namelist) - - - -Whether or not to enable gravity waves produced by meso-gamma Ridges. -Default: FALSE (set by build-namelist) - - - -Number of meso-gamma ridges (per gridbox) to invoke. -Default: -1 (set by build-namelist) - - - -Efficiency scaling factor associated with anisotropic OGW. -Default: set by build-namelist. - - - -Max efficiency associated with anisotropic OGW. -Default: 1.0 - - - -Drag coefficient for obstacles in low-level flow. -Default: 1.0 - - - -Whether or not to allow trapping for meso-gamma Ridges. -Default: set by build-namelist - - - -Full pathname of boundary dataset for meso-gamma ridges. -Default: set by build-namelist. - - - -Critical Froude number squared (used only for orographic waves). -Default: set by build-namelist. - - - -Factor to multiply tau by, for orographic waves in the southern hemisphere. -Default: 1._r8 - - - -Inverse Prandtl number used in gravity wave diffusion -Default: set by build-namelist - - - -Scaling factor for heating depth in gravity waves from convection. If less than 1.0 -this acts as an effective reduction of the gravity wave phase speeds needed to drive -the QBO. -Default: set by build-namelist - - - -Scale SGH by land fraction in gravity wave drag -Default: set by build-namelist - - - -Frontogenesis function critical threshold. -Default: set by build-namelist. - - - -Full pathname of Beres lookup table data file for gravity waves sourced -from deep convection. -Default: set by build-namelist. - - - -Full pathname of Beres lookup table data file for gravity waves sourced -from shallow convection. -Default: set by build-namelist. - - - -Background source strength (used for waves from frontogenesis). -Default: set by build-namelist. - - - -Background source strength (used for inertial waves from frontogenesis). -Default: set by build-namelist. - - - -Whether or not to use tapering at the poles to reduce the effects of -mid-scale gravity waves from frontogenesis. -Default: set by build-namelist. - - - -Whether or not to apply tapering at the top of the model (above 0.6E-02 Pa) -to reduce undesired effects of gravity waves in the thermosphere/ionosphere. -Default: set by build-namelist - - - - - -If .true. use separate dividing streamlines for downslope wind and flow -splitting regimes ("DS" configuration). -If .false. use single dividing streamline as in Scinocca & McFarlane -2000 ("SM" configuration). -Default: set by build-namelist. - - - -If true, then use smooth regimes -Default: set by build-namelist. - - - -If true, then adujust tauoro -Default: set by build-namelist. - - - -If true, then adjust for bit-for-bit answers with the ("N5") configuration -Default: set by build-namelist. - - - -Enhancement factor for downslope wind stress in DS configuration. -Default: set by build-namelist. - - - -Enhancement factor for depth of downslope wind regime in DS configuration -Default: set by build-namelist. - - - -Lower inverse Froude number limits on linear ramp terminating downslope wind regime for high mountains in DS configuration -Default: set by build-namelist. - - - -Upper inverse Froude number limits on linear ramp terminating downslope wind regime for high mountains in DS configuration -Default: set by build-namelist. - - - -Enhancement factor for downslope wind stress in SM configuration. -Default: set by build-namelist. - - - -Critical inverse4 Froude number -Default: set by build-namelist. - - - -minimum surface displacement height for orographic waves (m) -Default: set by build-namelist. - - - -Minimum wind speed for orographic waves -Default: set by build-namelist. - - - -Minimum stratification allowing wave behavior -Default: set by build-namelist. - - - -Minimum stratification allowing wave behavior -Default: set by build-namelist. - - - -If TRUE gravity wave ridge scheme will contribute to vertical diffusion tendencies. -Default: TRUE - - - - - -Full pathname of time-variant boundary dataset for greenhouse gas surface -values. -Default: set by build-namelist. - - - -CH4 volume mixing ratio. This is used as the time invariant surface value -of CH4 if no time varying values are specified. -Default: set by build-namelist. - - - -CO2 volume mixing ratio. This is used as the time invariant surface value -of CO2 if no time varying values are specified. -Default: set by build-namelist. - - - -User override for the prescribed CO2 volume mixing ratio used by the radiation -calculation. Note however that the prescribed value of CO2 which is sent -to the surface models is still the one that is set using either the -{{ hilight }}co2vmr{{ closehilight }} or the {{ hilight }}scenario_ghg{{ closehilight }} variables. -Default: not used - - - -CFC11 volume mixing ratio adjusted to reflect contributions from many GHG -species. This is used as the time invariant surface value of F11 if no -time varying values are specified. -Default: set by build-namelist. - - - -CFC12 volume mixing ratio. This is used as the time invariant surface value -of CFC12 if no time varying values are specified. -Default: set by build-namelist. - - - -N2O volume mixing ratio. This is used as the time invariant surface value -of N2O if no time varying values are specified. -Default: set by build-namelist - - - -Data start year. Use in conjunction -with {{ hilight }}ghg_yearstart_model{{ closehilight }}. -Default: 0 - - - -Model start year. Use in conjunction -with {{ hilight }}ghg_yearstart_data{{ closehilight }}. -Default: 0 - - - -Amount of co2 ramping per year (percent). Only used -if {{ hilight }}scenario_ghg{{ closehilight }} = 'RAMP_CO2_ONLY' -Default: 1.0 - - - -CO2 cap if > 0, floor otherwise. Specified as multiple or fraction of -inital value; e.g., setting to 4.0 will cap at 4x initial CO2 setting. -Only used if {{ hilight }}scenario_ghg{{ closehilight }} = 'RAMP_CO2_ONLY' -Default: boundless if {{ hilight }}ramp_co2_annual_rate{{ closehilight }} > 0, zero otherwise. - - - -Date on which ramping of co2 begins. The date is encoded as an integer in -the form YYYYMMDD. Only used if {{ hilight }}scenario_ghg{{ closehilight }} = 'RAMP_CO2_ONLY' -Default: 0 - - - -If {{ hilight }}scenario_ghg{{ closehilight }} is set to "RAMPED" then the greenhouse -gas surface values are interpolated between the annual average values -read from the file specified by {{ hilight }}bndtvghg{{ closehilight }}. -In that case, the value of this variable (> 0) fixes the year of the -lower bounding value (i.e., the value for calendar day 1.0) used in the -interpolation. For example, if rampyear_ghg = 1950, then the GHG surface -values will be the result of interpolating between the values for 1950 and -1951 from the dataset. -Default: 0 - - - -Controls treatment of prescribed co2, ch4, n2o, cfc11, cfc12 volume mixing -ratios. May be set to 'FIXED', 'RAMPED', 'RAMP_CO2_ONLY', or 'CHEM_LBC_FILE'. -FIXED => volume mixing ratios are fixed and have either default or namelist - input values. -RAMPED => volume mixing ratios are time interpolated from the dataset - specified by {{ hilight }}bndtvghg{{ closehilight }}. -RAMP_CO2_ONLY => only co2 mixing ratios are ramped at a rate determined by - the variables {{ hilight }}ramp_co2_annual_rate{{ closehilight }}, {{ hilight }}ramp_co2_cap{{ closehilight }}, - and {{ hilight }}ramp_co2_start_ymd{{ closehilight }}. -CHEM_LBC_FILE => volume mixing ratios are set from the chemistry lower boundary - conditions dataset specified by {{ hilight }}flbc_file{{ closehilight }}. -Default: FIXED - - - - - -Full pathname of time-variant boundary dataset for greenhouse gas production/loss -rates. Only used by the simple prognostic GHG chemistry scheme that is -enabled via the argument "-prog_species GHG" to configure. -Default: set by build-namelist. - - - -This variable should not be set by the user. It is set by build-namelist -when the user specifies the argument "-prog_species GHG" to configure which -turns on a simple prognostic chemistry scheme for CH4, N2O, CFC11 and -CFC12. -Default: set by build-namelist - - - - - - -Flag to set rad_climate variable so that the prognostic CO2 controlled by -the co2_cycle module is radiatively passive. -Default: FALSE - - - -If TRUE turn on CO2 code. -Default: set by build-namelist - - - -If TRUE read co2 fuel flux from file. -Default: set by build-namelist - - - -If TRUE read co2 ocn flux from file. -Default: FALSE - - - -If TRUE read co2 aircraft flux from file. -Default: set by build-namelist - - - -Filepath for dataset containing CO2 flux from ocn. -Default: none - - - -Filepath for dataset containing CO2 flux from fossil fuel. -Default: none - - - - - -Sets the averaging flag for all variables on a particular history file -series. Valid values are: - - A ==> Average - B ==> GMT 00:00:00 average - I ==> Instantaneous - M ==> Minimum - X ==> Maximum - L ==> Local-time - S ==> Standard deviation - -The default is to use the averaging flags for each variable that are set in -the code via calls to subroutine addfld. - -Defaults: set in code via the addfld and add_default subroutine calls. - - - -If true don't put any of the variables on the history tapes by -default. Only output the variables that the user explicitly lists in -the {{ hilight }}fincl#{{ closehilight }} namelist items. -Default: FALSE - - - -List of fields to exclude from the 1st history file (by default the name -of this file contains the string "h0"). -Default: none - - -List of fields to exclude from the 2nd history file (by default the name -of this file contains the string "h1"). -Default: none - - -List of fields to exclude from the 3rd history file (by default the name -of this file contains the string "h2"). -Default: none - - -List of fields to exclude from the 4th history file (by default the name -of this file contains the string "h3"). -Default: none - - -List of fields to exclude from the 5th history file (by default the name -of this file contains the string "h4"). -Default: none - - -List of fields to exclude from the 6th history file (by default the name -of this file contains the string "h5"). -Default: none - - -List of fields to exclude from the 7th history file (by default the name -of this file contains the string "h6"). -Default: none - - -List of fields to exclude from the 8th history file (by default the name -of this file contains the string "h7"). -Default: none - - -List of fields to exclude from the 9th history file (by default the name -of this file contains the string "h8"). -Default: none - - -List of fields to exclude from the 10th history file (by default the name -of this file contains the string "h9"). -Default: none - - - -List of fields to include on the first history file (by default the name of -this file contains the string "h0"). The added fields must be in Master -Field List. The averaging flag for the output field can be specified by -appending a ":" and a valid averaging flag to the field name. Valid flags -are: - - A ==> Average - B ==> GMT 00:00:00 average - I ==> Instantaneous - M ==> Minimum - X ==> Maximum - L ==> Local-time - S ==> Standard deviation - -Default: set in code via the addfld and add_default subroutine calls. - - -Same as {{ hilight }}fincl1{{ closehilight }}, but for the 2nd history file (by default -the name of this file contains the string "h1"). -Default: none. - - -Same as {{ hilight }}fincl1{{ closehilight }}, but for the 3rd history file (by default -the name of this file contains the string "h2"). -Default: none. - - -Same as {{ hilight }}fincl1{{ closehilight }}, but for the 4th history file (by default -the name of this file contains the string "h3"). -Default: none. - - -Same as {{ hilight }}fincl1{{ closehilight }}, but for the 5th history file (by default -the name of this file contains the string "h4"). -Default: none. - - -Same as {{ hilight }}fincl1{{ closehilight }}, but for the 6th history file (by default -the name of this file contains the string "h5"). -Default: none. - - - -Same as {{ hilight }}fincl1{{ closehilight }}, but for the 7th history file (by default -the name of this file contains the string "h6"). -Default: none. - - -Same as {{ hilight }}fincl1{{ closehilight }}, but for the 8th history file (by default -the name of this file contains the string "h7"). -Default: none. - - -Same as {{ hilight }}fincl1{{ closehilight }}, but for the 9th history file (by default -the name of this file contains the string "h8"). -Default: none. - - -Same as {{ hilight }}fincl1{{ closehilight }}, but for the 10th history file (by default -the name of this file contains the string "h9"). -Default: none. - - - -if .true. then output CLUBBs history statistics -Default: false - - - -if .true. then output CLUBBs radiative history statistics -Default: false - - - -Same as {{ hilight }}fincl1{{ closehilight }}, but for CLUBB statistics on zt grid. -Default: none. - - - -Same as {{ hilight }}fincl1{{ closehilight }}, but for CLUBB statistics on zm grid. -Default: none. - - - -Same as {{ hilight }}fincl1{{ closehilight }}, but for CLUBB statistics on radiation zt grid. -Default: none. - - - -Same as {{ hilight }}fincl1{{ closehilight }}, but for CLUBB statistics on radiation zm grid. -Default: none. - - - -Same as {{ hilight }}fincl1{{ closehilight }}, but for CLUBB statistics on surface. -Default: none. - - - -Collect all column data into a single field and output in ncol format, -much faster than default when you have a lot of columns. -Default: false - - - -List of columns or contiguous columns at which the fincl1 fields will be -output. Individual columns are specified as a string using a longitude -degree (greater or equal to 0.) followed by a single character -(e)ast/(w)est identifer, an underscore '_' , and a latitude degree followed -by a single character (n)orth/(s)outh identifier. For example, '10e_20n' -would pick the model column closest to 10 degrees east longitude by 20 -degrees north latitude. A group of contiguous columns can be specified -using bounding latitudes and longitudes separated by a colon. For example, -'10e:20e_15n:20n' would select the model columns which fall with in the -longitude range from 10 east to 20 east and the latitude range from 15 -north to 20 north. -Default: none - - -Same as {{ hilight }}fincl1lonlat{{ closehilight }}, but for 2nd history file. - - -Same as {{ hilight }}fincl1lonlat{{ closehilight }}, but for 3rd history file. - - -Same as {{ hilight }}fincl1lonlat{{ closehilight }}, but for 4th history file. - - -Same as {{ hilight }}fincl1lonlat{{ closehilight }}, but for 5th history file. - - -Same as {{ hilight }}fincl1lonlat{{ closehilight }}, but for 6th history file. - - -Same as {{ hilight }}fincl1lonlat{{ closehilight }}, but for 7th history file. - - -Same as {{ hilight }}fincl1lonlat{{ closehilight }}, but for 8th history file. - - -Same as {{ hilight }}fincl1lonlat{{ closehilight }}, but for 9th history file. - - -Same as {{ hilight }}fincl1lonlat{{ closehilight }}, but for 10th history file. - - - -Specific fields which will be written using the non-default precision on -the 1st history file. -Default: none - - -Specific fields which will be written using the non-default precision on -the 2nd history file. -Default: none - - -Specific fields which will be written using the non-default precision on -the 3rd history file. -Default: none - - -Specific fields which will be written using the non-default precision on -the 4th history file. -Default: none - - -Specific fields which will be written using the non-default precision on -the 5th history file. -Default: none - - -Specific fields which will be written using the non-default precision on -the 6th history file. -Default: none - - -Specific fields which will be written using the non-default precision on -the 7th history file. -Default: none - - -Specific fields which will be written using the non-default precision on -the 8th history file. -Default: none - - -Specific fields which will be written using the non-default precision on -the 9th history file. -Default: none - - -Specific fields which will be written using the non-default precision on -the 10th history file. -Default: none - - - - -Array of history filename specifiers. The filenames of up to six history -output files can be controlled via this variable. Filename specifiers give -generic formats for the filenames with specific date and time components, -file series number (0-5), and caseid, filled in when the files are -created. The following strings are expanded when the filename is created: -%c=caseid; %t=file series number (0-5); %y=year (normally 4 digits, more -digits if needed); %m=month; %d=day; %s=seconds into current day; %%=% -symbol. Note that the caseid may be set using the namelist -variable {{ hilight }}case_name{{ closehilight }}. - -For example, for a simulation with caseid="test" and current date and time -of 0000-12-31 0:00UT, a filename specifier of "%c.cam2.h%t.%y-%m.nc" would -expand into "test.cam2.h0.0000-12.nc" for the first history file. The -filename specifier "%c.cam2.h%t.%y-%m-%d-%s.nc" would expand to -"test.cam2.h1.0000-12-31-00000.nc" for the second history file. Spaces are -not allowed in filename specifiers. Although the character "/" is allowed -in the specifier, it will be interpreted as a directory name and the -corresponding directories will have to be created in the model execution -directory (directory given to configure with -cam_exedir option) before -model execution. The first element is for the primary history file which -is output by default as a monthly history file. Entries 2 through 6 are -user specified auxilliary output files. - -Defaults: "%c.cam2.h0.%y-%m.nc", "%c.cam2.h1.%y-%m-%d-%s.nc", ..., - "%c.cam2.h5.%y-%m-%d-%s.nc" - - - -Full pathname of the satellite track data used by the satellite track history -output feature. -Default: none - - -Satellite track history filename specifier. See {{ hilight }}hfilename_spec{{ closehilight }} -Default: "%c.cam2.sat.%y-%m-%d-%s.nc" - - -List of history fields to output along the satellite track specified by {{ hilight }}sathist_track_infile{{ closehilight }} -Default: none - - -Sets the maximum number of observation columns written to the satellite track history file -series. -Default: 100000 - - - -Sets the number of columns closest to the observation that should be output. Setting -this to a number greater than 1 allows for spatial interpolation in the post processing. -Default: 1 - - - -Sets the number of timesteps closest to the observation that should be output. Setting -this to a number greater than 1 allows for temporal interpolation in the post processing. -Default: 1 - - - -Frequency that initial files will be output: 6-hourly, daily, monthly, -yearly, or never. Valid values: 'NONE', '6-HOURLY', 'DAILY', 'MONTHLY', -'YEARLY', 'CAMIOP', 'ENDOFRUN'. -Default: 'YEARLY' - - - -If false then include only REQUIRED fields on IC file. If true then -include required AND optional fields on IC file. -Default: FALSE - - - -Array containing the maximum number of time samples written to a history -file. The first value applies to the primary history file, the second -through tenth to the auxillary history files. -Default: 1,30,30,30,30,30,30,30,30,30 - - - -Array containing the starting time of day for local time history averaging. -Used in conjuction with lcltod_stop. If lcltod_stop is less than lcltod_start, -then the time range wraps around 24 hours. The start time is included in the -interval. Time is in seconds and defaults to 39600 (11:00 AM). The first value -applies to the primary hist. file, the second to the first aux. hist. file, etc. -Default: none - - - -Array containing the stopping time of day for local time history averaging. -Used in conjuction with lcltod_start. If lcltod_stop is less than lcltod_start, -then the time range wraps around 24 hours. The stop time is not included in the -interval. Time is in seconds and defaults to 0 (midnight). The first value -applies to the primary hist. file, the second to the first aux. hist. file, etc. -Default: none - - - - -Array specifying the precision of real data written to each history file -series. Valid values are 1 or 2. '1' implies output real values are 8-byte -and '2' implies output real values are 4-byte. - -Default: 2,2,2,2,2,2,2,2,2,2 - - - - - -Array of write frequencies for each history file series. -If {{ hilight }}nhtfrq(1){{ closehilight }} = 0, the file will be a monthly average. -Only the first file series may be a monthly average. If -{{ hilight }}nhtfrq(i){{ closehilight }} > 0, frequency is specified as number of -timesteps. If {{ hilight }}nhtfrq(i){{ closehilight }} < 0, frequency is specified -as number of hours. - -Default: 0,-24,-24,-24,-24,-24,-24,-24,-24,-24 - - - -If interpolate_output(k) = .true., then the k'th history file will be -interpolated to a lat/lon grid before output. -Default: .false. - - - -Size of latitude dimension of grid for interpolated output. -If interpolate_nlat and interpolate_nlon are zero, reasonable values -will be chosen by the dycore based on the run resolution. -Default: 0 - - - -Size of longitude dimension of grid for interpolated output. -If interpolate_nlat and interpolate_nlon are zero, reasonable values -will be chosen by the dycore based on the run resolution. -Default: 0 - - - -Selects interpolation method for output on lat/lon grid. -0: Use SE's native high-order method. -1: Use a bilinear method. -Default: 1 (bilinear) - - - -Selects output grid type for lat/lon interpolated output. -1: Equally spaced, including poles (FV scalars output grid). -2: Gauss grid (CAM Eulerian). -3: Equally spaced, no poles (FV staggered velocity). -Default: 1 - - - - - -Full pathname of initial atmospheric state dataset (NetCDF format). -Default: set by build-namelist. - - - -Perturb the initial conditions for temperature randomly by up to the given -amount. Only applied for initial simulations. -Default: 0.0 - - - -Full pathname of master restart file from which to branch. Setting is -Required for branch run. -Default: none - - - -If TRUE, try to initialize data for all consituents by reading from the -initial conditions dataset. If variable not found then data will be -initialized using internally-specified default values. If FALSE then don't -try reading constituent data from the IC file; just use the -internally-specified defaults. -Default: TRUE - - - - - - -If true, the COSP cloud simulator is run. -Setting this namelist variable happens automatically if you compile with COSP. -COSP will not run unless this is set to .true. in the namelist! -Turn on the desired simulators using lXXX_sim namelist vars -If no specific simulators are specified, all of the simulators -are run on all columns and all output is saved. (useful for testing). -COSP is available with CAM4, CAM5 and CAM6 physics. -This default logical is set in cospsimulator_intr.F90. -Default: FALSE - - - -If true, COSP cloud simulators are run to produce -all output required for the COSP plots in the AMWG diagnostics package. -sets cosp_ncolumns=10 and cosp_nradsteps=3 -(appropriate for COSP statistics derived from seasonal averages), -and runs MISR, ISCCP, MODIS, CloudSat radar and CALIPSO lidar simulators -(cosp_lmisr_sim=.true.,cosp_lisccp_sim=.true., -cosp_lmodis_sim=.true.,cosp_lradar_sim=.true.,cosp_llidar_sim=.true.). -This default logical is set in cospsimulator_intr.F90. -Default: FALSE - - - -If true, the COSP cloud simulators are run to produce -select output for the AMWG diagnostics package. -sets cosp_ncolumns=10 and cosp_nradsteps=3 -(appropriate for COSP statistics derived from seasonal averages), -and runs MISR, ISCCP, MODIS, and CALIPSO lidar simulators -(cosp_lmisr_sim=.true.,cosp_lisccp_sim=.true., -cosp_lmodis_sim=.true.,cosp_llidar_sim=.true.). -This default logical is set in cospsimulator_intr.F90. -Default: FALSE - - - -If true, the passive COSP cloud simulators are run to produce -select output for the AMWG diagnostics package. -sets cosp_ncolumns=10 and cosp_nradsteps=3 -(appropriate for COSP statistics derived from seasonal averages), -and runs MISR, ISCCP, and MODIS simulators -(cosp_lmisr_sim=.true.,cosp_lisccp_sim=.true.,cosp_lmodis_sim=.true.). -This default logical is set in cospsimulator_intr.F90. -Default: FALSE - - - -If true, the active COSP cloud simulators are run to produce -select output for the AMWG diagnostics package. -sets cosp_ncolumns=10 and cosp_nradsteps=3 -(appropriate for COSP statistics derived from seasonal averages), -and runs CloudSat radar and CALIPSO lidar simulators -(cosp_lradar_sim=.true.,cosp_llidar_sim=.true.). -This default logical is set in cospsimulator_intr.F90. -Default: FALSE - - - -If true, the ISCCP cloud simulator is run to produce -select output for the AMWG diagnostics package. -sets cosp_ncolumns=10 and cosp_nradsteps=3 -(appropriate for COSP statistics derived from seasonal averages), -and runs ISCCP simulator -(cosp_lmisr_sim=.false.,cosp_lisccp_sim=.true., -cosp_lmodis_sim=.false.,cosp_lradar_sim=.false.,cosp_llidar_sim=.false.). -This default logical is set in cospsimulator_intr.F90. -1236: Default: FALSE - - - -If true, run all simulators using the default values cosp_ncolumns=50 and -cosp_nradsteps=1. This option is mainly intended for testing, but it also -must be used in order to output the input fields needed to run the -simulator in an offline mode (via setting cosp_histfile_aux=.true.). -Default: FALSE - - - -If true, COSP radar simulator will be run and all non-subcolumn output -will be saved. -Default: FALSE - - - -If true, COSP lidar simulator will be run and all non-subcolumn output -will be saved -Default: FALSE - - - -If true, COSP ISCCP simulator will be run and all non-subcolumn output -will be saved. ISCCP simulator is run on only daylight -columns. -Default: FALSE - - - -If true, MISR simulator will be run and all non-subcolumn output -will be saved. MISR simulator is run on only daylight -columns. -Default: FALSE - - - -If true, MODIS simulator will be run and all non-subcolumn output -will be saved. - -Default: FALSE - - - - - -If true, the COSP cloud simulator is run for CFMIP 3-hourly -experiments. -This default logical is set in cospsimulator_intr.F90 -Default: FALSE - - - -If true, the COSP cloud simulator is run for CFMIP daily -experiments. -This default logical is set in cospsimulator_intr.F90 -Default: FALSE - - - -If true, the COSP cloud simulator is run for CFMIP off-line -monthly experiments. -This default logical is set in cospsimulator_intr.F90 -Default: FALSE - - - -If true, the COSP cloud simulator is run for CFMIP monthly -experiments. -This default logical is set in cospsimulator_intr.F90 -Default: FALSE - - - - - -Number of subcolumns in SCOPS -This default logical is set in cospsimulator_intr.F90 -Default: 50 - - - - - -Turns on sampling along a-train orbit for radar and lidar simulators. -This default logical is set in cospsimulator_intr.F90 -Default: FALSE - - - -Full pathname for the Atrain orbit data file. -cosp_atrainorbitdata is requiref if cosp_sample_atrain is TRUE. -Default: NONE - - - - - -This specifies the CAM history tape where COSP diagnostics will be written. -Ignored/not used if any of the cosp_cfmip_* namelist variables are invoked. - -This default is set in cospsimulator_intr.F90 -Default: 1 - - -If true, additional output is added to make it possible to -run COSP off-line. - -This default is set in cospsimulator_intr.F90 -Default: FALSE - - -This specifies the CAM history tape where extra COSP diagnostics will be written. - -This default is set in cospsimulator_intr.F90 -Default: -1 - - - -This specifies the frequency at which is COSP is called, -every cosp_nradsteps radiation timestep. - -This default is set in cospsimulator_intr.F90 -Default: 1 - - - -Turns on sub-column output from COSP. -If both the isccp/misr simulators and the lidar/radar simulators -are run, lfrac_out is from the isccp/misr simulators columns. -This default logical is set in cospsimulator_intr.F90 -Default: FALSE - - - - - -Number of macrophysics/microphysics substeps. -Default: 1 - - - - -Threshold for autoconversion of cold ice in RK microphysics scheme. -Default: set by build-namelist - - - -Threshold for autoconversion of warm ice in RK microphysics scheme. -Default: set by build-namelist - - - -Tunable constant for evaporation of precip in RK microphysics scheme. -Default: set by build-namelist - - - -Critical radius at which autoconversion become efficient in RK microphysics -scheme. -Default: set by build-namelist - - - -Relative humidity threshold for stratospheric cloud water condensation in RK microphysics -poleward of 50 degrees. -Default: none - - - - -Switch to control whether Park macrophysics should prognose -cloud ice (cldice). -Default: .true., except for carma=cirrus and carma=carma_dust - - - -Switch to control whether Park macrophysics should prognose -cloud liquid (cldliq). -Default: .true. - - - -Switch to control whether Park macrophysics should perform -detrainment into the stratiform cloud scheme. -Default: .true., except for carma=cirrus and carma=carma_dust - - - - - -Version number for MG microphysics. This value is set automatically based -on settings in configure and passed to build-namelist -Default: 1 for CAM5 and 2 for CAM6 - - - -Sub-version number for MG microphysics -Default: 0 - - - -Autoconversion size threshold -Default: set by build-namelist - - - -Switch to control whether MG microphysics should prognose -cloud ice (cldice). -Default: .true., except for carma=cirrus and carma=carma_dust - - - -Switch to control whether MG microphysics should prognose -cloud liquid (cldliq). -Default: .true. - - - -Number of substeps over MG microphysics. -Default: 1 - - - -Type of precipitation fraction. -Default: for CLUBB runs => in_cloud; - all others => max_overlap - - - -Efficiency factor for berg -Default: 1 - - - -Do Seifert and Behang (2001) autoconversion and accretion physics when set to true. -Default: .false. - - - -Switch to control whether MG microphysics performs a uniform calculation or not -(useful for sub-columns) -Default: .false. unless use_subcol_microp is true - - - -Switch to control whether MG microphysics should adjust the temperature -at the level containing the cold point tropopause by using the value -obtain by extrapolating between levels. -Default: set by build-namelist - - - -Set .true. to hold cloud droplet number constant. -Default: .false. - - - -Set .true. to hold cloud ice number constant. -Default: .false. - - - -In-cloud droplet number concentration when micro_mg_nccons=.true. -Default: 100.e6 m-3 - - - -In-cloud ice number concentration when micro_mg_nicons=.true. -Default: 0.1e6 m-3 - - - - -prescribed aerosol bulk sulfur scale factor -Default: 2 - - - -Switch to turn on heterogeneous freezing code. -Default: .false. - - - -Add diagnostic output for heterogeneous freezing code. -Default: .false. - - - -Switch to turn on treatment of pre-existing ice in the ice nucleation code. -Default: .false., except .true. for CAM6 - - - -Add diagnostics for pre-existing ice option in ice nucleation code to history output. -Default: .false. - - - -Subgrid scaling factor for relative humidity in ice nucleation code. If it has -a value of -1, then indicates that the subgrid scaling factor will be -calculated on the fly as 1 / qsatfac (i.e. the saturation scaling factor). -Default: set by build-namelist - - - -Subgrid scaling factor for relative humidity in ice nucleation code in the -stratosphere. If it has a value of -1, then indicates that the subgrid -scaling factor will be calculated on the fly as 1 / qsatfac (i.e. the -saturation scaling factor). -Default: set by build-namelist - - - -Switch to determine whether ice nucleation happens using the incloud (true) or -the gridbox average (false) relative humidity. When true, it is assumed that -the incloud relative humidity for nucleation is 1. -Default: .true., except .false. for CAM6 - - - -Fraction of Aitken mode sulfate particles assumed to nucleate ice in the polar -stratospheric. Provides an increase in homogeneous freezing over the Liu&Penner method. -Temporary solution to adjust ice surface area density and dehydration in the -polar stratosphere where there doesn't seem to be enough nucleation. A value of -zero means Liu&Penner is used. -Default: 1.0 - - - -Indicates whether to use the tropopause level to determine where to adjust -nucleation for the stratosphere (true) or whether to use a hard coded transition -level from 100 to 125 hPa applied only in the polar regions (false). -Default: .true. - - - - - - - -Characteristic adjustment time scale for Hack shallow scheme. -Default: 1800.0 - - - -Rain water autoconversion coefficient for Hack shallow scheme. -Default: set by build-namelist - - - - -Penetrative entrainment efficiency in UW shallow scheme. -Default: set by build-namelist - - - - - -Switch for Vavrus "freeze dry" adjustment in cloud fraction. Set to FALSE to -turn the adjustment off. -Default: .true. - - - -Switch for ice cloud fraction calculation. -Default: .true. for CAM5 and CAM6, otherwise .false. - - - -Minimum rh for low stable clouds. -Default: set by build-namelist - - - -Adjustment to rhminl for land without snow cover. -Default: 0.0 for CAM6; - all others => 0.10 - - - -Minimum rh for high stable clouds. -Default: set by build-namelist - - - -parameter for shallow convection cloud fraction. -Default: set by build-namelist - - - -parameter for shallow convection cloud fraction. -Default: set by build-namelist - - - -parameter for deep convection cloud fraction. -Default: set by build-namelist - - - -parameter for deep convection cloud fraction. -Default: set by build-namelist - - - -top pressure bound for mid level cloud. -Default: set by build-namelist - - - -Bottom height (Pa) for mid-level liquid stratus fraction. -Default: 700.e2 for CAM5 and CAM6; all others=> 750.e2 - - - -Scheme for ice cloud fraction: 1=wang & sassen, 2=schiller (iciwc), -3=wood & field, 4=Wilson (based on smith), 5=modified slingo (ssat & empyt cloud) -Default: set by build-namelist - - - -Critical RH for ice clouds (Wilson & Ballard scheme). -Default: set by build-namelist - - - -Minimum rh for ice cloud fraction > 0. -Default: set by build-namelist - - - -rhi at which ice cloud fraction = 1. -Default: set by build-namelist - - - -Minimum rh for ice cloud fraction > 0 in the stratosphere. -Default: set by build-namelist - - - -rhi at which ice cloud fraction = 1 in the stratosphere. -Default: set by build-namelist - - - -Use cloud fraction to determine whether to do growth of ice clouds below -RHice of 1 down to RHice = rhmini. -Default: .true. for CAM6; all others => .false. - - - -Convective momentum transport parameter (upward) -Default: set by build-namelist - - - -Convective momentum transport parameter (downward) -Default: set by build-namelist - - - - -Autoconversion coefficient over land in ZM deep convection scheme. -Default: set by build-namelist - - - -Autoconversion coefficient over ocean in ZM deep convection scheme. -Default: set by build-namelist - - - -Tunable evaporation efficiency for land in ZM deep convection scheme. -Default: set by build-namelist - - - -Tunable evaporation efficiency in ZM deep convection scheme. -Default: set by build-namelist - - - -Include organization parameterization in ZM. This value is set to true automatically -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. -Default: => 1 for CAM6; - => 5 for all other - - - - - - -Factor applied to the ice fall velocity computed from -Stokes terminal velocity. -Default: set by build-namelist - - - - - -Type of water vapor saturation vapor pressure scheme employed. 'GoffGratch' for -Goff and Gratch (1946); 'MurphyKoop' for Murphy & Koop (2005) -Default: GoffGratch; except MurphyKoop for carma=cirrus or carma=cirrus_dust - - - - - -Control use of sub-columns within macro/micro physics; -'false' for no subcolumns. -Default: 'false' - - - -Type of sub-column generator scheme employed. - 'SIHLS' Sub-columns generated with Latin Hypercube sampling of the CLUBB PDF; - 'CloudObj' Create sub-columns where most water is assigned to cloud sub-columns; - 'tstcp' testing; - 'vamp' Variation Across Microphysics Profiles simple deterministic scheme; - 'off' None -Default: 'off' - - - -Turns off averaging and assigns first subcolumn back to grid. Needed for BFB comparisons -'true' for no averaging. -Default: '.false.' - - - -Turns on/off filtering during averaing in tstcp -'true' to use filtering. -Default: '.false.' - - - -Turns on/off use of weights during averaging in tstcp -'true' to use weights. -Default: '.false.' - - - -Perturbs the temperatures in state after copying for testing purposes -'true' to perturb temperatures. -Default: '.false.' - - - -Tests the restart capabilities of weights with a more adequate test -'true' to set the weights to a slightly more complicated pattern for restart testing -Default: '.false.' - - - -Turns on/off use of weights during averaging in tstcp -'true' to use weights. -Default: '.true.' - - - -Number of subcolumns/samples to use in this simulation. Must be less than psubcols. -Default: 4 - - - - - -Type of condensate to assume in VAMP Generator -1 Uniform Condensate -2 Variable Condensate Uniform Number -3 Variable Condensate Variable Number -Default: 3 - - - -Type of overlap to assume in VAMP Generator 1 Maximum -Default: 1 - - - -Number of subcolumns in VAMP Generator -Default: 10 - - - - - - - -Type of deep convection scheme employed. 'ZM' for Zhang-McFarlane; -'off' for none; or 'UNICON' which doesn't distinquish shallow and deep. -Default: 'ZM' unless using 'UNICON', 'SPCAM' or 'pbl=none' - - - -Type of microphysics scheme employed. 'RK' for Rasch and Kristjansson -(1998); 'MG' for Morrison and Gettelman (2008), Gettelman et al (2010) -two moment scheme for CAM5 and CAM6 -SPCAM has two different microphysics schemes: SPCAM_m2005 (Morrison et al 2005), -SPCAM_sam1mom (Khairoutinov 2003) -Default: set by build-namelist (depends on value set in configure). - - - -Type of macrophysics scheme employed. 'park' for Park -(1998); 'RK' for Rasch and Kristjansson (1998); 'CLUBB_SGS' clubb. -Default: set by build-namelist - - - -Switch for CLUBB_SGS -Default: set by build-namelist - - - -Type of shallow convection scheme employed. - 'Hack' for Hack shallow convection; - 'UW' for original McCaa UW pbl scheme, modified by Sungsu Park; - 'CLUBB_SGS' for CLUBB_SGS - 'UNICON' which doesn't distinquish shallow and deep. - 'SPCAM_m2005' for SPCAM double moment - 'SPCAM_sam1mom' for SPCAM single moment -Default: set by build-namelist (depends on {{ hilight }}eddy_scheme{{ closehilight }}). - - - -Logical switch to turn on the beljaars scheme -Default: set by build-namelist - - - -Logical switch to turn on turbulent mountain stress calculation in -vertical diffusion routine. -Default: set by build-namelist - - - -Turbulent mountain stress parameter used when turbulent mountain stress calculation -is turned on. See {{ hilight }}do_tms{{ closehilight }}. -Default: 1.0 for CAM, set by build-namelist for WACCM, T31 - - - -Factor determining z_0 from orographic standard deviation [ no unit ] -Used when turbulent mountain stress calc is turned on. See {{ hilight }}do_tms{{ closehilight }}. -Default: set by build-namelist for WACCM, T31 - - - -Maximum master length scale designed to address issues in diag_TKE outside the -boundary layer. -In order not to disturb turbulence characteristics in the lower troposphere, -this should be set at least larger than a few km. However, this does not -significantly improve the values outside of the boundary layer. Smaller values -make some improvement, but it is also noisy. Better results are seen using -eddy_leng_max or kv_freetrop_scale. -Default: 40.e3 (m) - - - -Maximum dissipation length scale designed to address issues with diag_TKE outside -the boundary layer, where the default value generates large diffusivities. A value -of 30 m is consistent with the length scales used in the HB scheme; however, this -will also reduce value in the boundary layer. -Default: 40.e3 (m) - - - -Bottom pressure level at which namelist values for eddy_leng_max and -eddy_lbulk_max are applied. Default values are used at lower levels (i.e. the -boundary layer). -Default: 100.e3 (hPa) - - - -Moist entrainment enhancement parameter. -Default: set by build-namelist - - - -Pressure (Pa) that defined the upper atmosphere for adjustment of -eddy diffusivities from diag_TKE using kv_top_scale. -Default: 0. - - - -Scaling factor that is applied (multiplied) to the eddy diffusivities -in the upper atmosphere (see kv_top_pressure). -Default: 1.0 - - - -Scaling factor that is applied (multiplied) to the eddy diffusivities -in the free troposphere (boundary layer to kv_top_pressure) -Default: 1.0 - - - -Perform mass conservation check on eddy diffusion operation. -Default: FALSE - - - -Logical switch to turn on implicit turbulent surface stress calculation in -diffusion solver routine. -Default: set by build-namelist - - - -Produce output for the offline unicon driver. -Default: .false. - - - -History file number for offline unicon driver output. -Default: 2 (i.e., h1 history file) - - - -Apply cloud top radiative cooling parameterization -Default: .false. - - - -Include effects of precip evaporation on turbulent moments -Default: .false. - - - -Explicit diffusion on temperature and moisture when CLUBB is on -Default: .false. - - - -CLUBB do explicit diffusion with a stability correction -Default: .false. - - - - -CLUBB timestep. -Default: set by build-namelist - - - -Rain evaporation efficiency factor. -Default: set by build-namelist - - - -Switch for CLUBB_ADV -Default: FALSE - - - - -Low Skewness in C11 Skw. Function -Default: 0.7D0 - - - -High Skewness in C11 Skw. Function -Default: 0.35D0 - - - -Constant for u'^2 and v'^2 terms -Default: 2.2D0 - - - -Coef. applied to log(avg dz/thresh) -Default: 1.0D0 - - - -Low Skw.: gamma coef. Skw. Fnct. -Default: 0.308 - - - -Momentum coefficient of Kh_zm -Default: 0.5 - - - -Thermo of Kh_zm -Default: 0.3 - - - -Plume widths for theta_l and rt -Default: 2.4 - - - -C2 coef. for the rtp2_dp1 term -Default: 1.0 - - - -C2 coef. for the thlp2_dp1 term -Default: 1.0 - - - -C2 coef. for the rtpthlp_dp1 term -Default: 1.3 - - - -Coef. #1 in C8 Skewness Equation -Default: 4.2 - - - -Low Skewness in C7 Skw. Function -Default: 0.5 - - - -High Skewness in C7 Skw. Function -Default: 0.5 - - - -Factor to decrease sensitivity in the denominator of Skw calculation -Default: 0.0 - - - -Intensity of stability correction applied to C1 and C6 -Default: 0.04 - - - -Uses PDF to compute perturbed values for l_avg_Lscale code -Default: .false. - - - -Include the effects of ice latent heating in turbulence terms -Default: .false. - - - -Apply liquid supersaturation adjustment code -Default: false - - - -Apply adjustments to dry static energy so that CLUBB conserves -energy. -Default: true - - - - - -The name of the active CARMA microphysics model or none when CARMA -is not active. -Default: none - - - -A fraction that scales how tight the convergence criteria are to -determine that the substepping has resulted in a valid solution. -Smaller values will force more substepping. -CARMA particles. -Default: 0.1 - - - -When non-zero, the largest change in temperature (K) -allowed per substep. -Default: 0. - - - -Flag indicating that the CARMA model is an aerosol model, and -should be called in tphysac. -Default: TRUE - - - -Flag indicating that CARMA is a cloud ice model and should -be called in tphysbc. -Default: FALSE - - - -Flag indicating that CARMA is a cloud liquid model and should -be called in tphysbc. -Default: FALSE - - - -Flag indicating that CARMA should do clear sky calculations for -particles that are not part of a cloud in addition to doing a -separate calculation for incloud particles. Only valid when -carma_do_incloud is true. -Default: FALSE - - - -Flag indicating whether the coagulation process is enabled for -CARMA particles. -Default: FALSE - - - -Flag indicating that CARMA is responsible for detrain condensate -from convection into the model. -Default: FALSE - - - -Flag indicating that the dry deposition process is enabled for -CARMA particles. -Default: FALSE - - - -Flag indicating that the emission of particles is enabled for -CARMA. -Default: FALSE - - - -Flag indicating that sedimentation should be calculated using an -explicit technique where the substepping is used to keep the CFL -condition from being violated rather than the default PPM scheme. -Default: FALSE - - - -Flag indicating CARMA coefficients should only be initialized once from -a fixed temperature profile rather than recomputed for each column. This -improves performance, but reduces accuracy. By default the temperature -profile used is calculated as the average of the initial condition file, -but a predefined profile can be provided. -Default: FALSE - - - -Flag indicating used in cunjunction with carma_do_fixedinit to indicate -that only the coagulation coefficients should only be initialized from -a fixed temperature profile and all other coeeficients will be recalculated. -Coagulation is the slowest initialization, so this improves performance while -still retaining accuracy for most processes. -Default: FALSE - - - -Flag indicating that the condensational growth process is enabled for -CARMA particles. -Default: FALSE - - - -Flag indicating that CARMA sulfate mass mixing ratio will be used -in radiation calculation. -Default: FALSE - - - -Flag indicating that CARMA sulfate surface area density will be used -in heterogeneous chemistry rate calculation. -Default: FALSE - - - -Flag indicating that CARMA should treat cloud particles as incloud -rather than gridbox average calculations. -Default: FALSE - - - -Flag indicating that carma should generate optical properties files -for the CAM radiation code. -Default: FALSE - - - -Flag indicating that particle heating will be used for the condensational -growth process. -Default: FALSE - - - -Flag indicating that particle heating will affect the atmospheric -temperature. -Default: FALSE - - - -Flag indicating that substepping will be used for the condensational -growth process. -Default: FALSE - - - -Flag indicating that changes in heating will be calculated as a result -CARMA processes and will affect the CAM heating tendency. -Default: FALSE - - - -Flag indicating that the wet deposition process is enabled for -CARMA particles. -Default: FALSE - - - -Flag indicating that the effect of Brownian diffusion will be calculated for -CARMA particles. NOTE: This needs to be used in conjunction with CARMA -sedimentation. -Default: FALSE - - - -Flag indicating that the sedimentation process is enabled for -CARMA particles. -Default: FALSE - - - -Flag indicating whether CARMA is enabled. If CARMA has been included -in the build (configure -carma with something other than none), then -this will cause all of the CARMA constituents and field names to be -registered, but no other CARMA process will be preformed. This overrides -the individual CARMA process flags. -Default: FALSE - - - -Specifies the maximum number of retry attempts to be used when -condensational growth requires substepping, but the original estimate -for the amount of substepping was insufficient. -Default: 8 - - - -Specifies the maximum number of substeps that could be used for the -first guess when condensational growth requires substepping. -Default: 1 - - - -Specifies the name of the reference temperature file that will be -used (and created if necessary) for initialization of CARMA to a -fixed temperature profile. -Default: carma_reft.nc - - - -Accommodation coefficient for coagulation. -Default: 1.0 - - - -Accommodation coefficient for growth with ice. -Default: 0.93 - - - -Accommodation coefficient for growth with liquid. -Default: 1.0 - - - -Accommodation coefficient for temperature. -Default: 1.0 - - - -Critical relative humidity for liquid cloud formation, used -for sub-grid scale in-cloud saturation. -Default: 1.0 - - - - - -Global mass of dust emission for the event. -Default: 0. (kg) - - - -Global mass of dust emission for the event. -Default: 0. (kg) - - - -Starting date for emissions in the form of (yyyyddd) where yyyy is a year and -ddd is a day of year. -Default: 1 (yyyyddd) - - - -Starting time for the emission event in GMT. -Default: 0. (s Z) - - - -Stopping date for emissions in the form of (yyyyddd) where yyyy is a year and -ddd is a day of year. -Default: 1 (yyyyddd) - - - -Stoping time for the emission event in GMT. -Default: 0. (s) - - - -Minimum latitude of the area for emssions from the event. -Default: -90. (degrees north) - - - -Maximum latitude of the area for emssions from the event. -Default: 90. (degrees north) - - - -Minimum longitude of the area for emssions from the event. -Default: 0. (degrees east) - - - -Maximum longitude of the area for emssions from the event. -Default: 360. (degrees east) - - - -Are the soot particles treated as fractals? -Default: FALSE - - - - - -Flag indicating that meteor smoke emission will be scaled by a -global relative flux based upon the carma_escale_file. -Default: FALSE - - - -The total meteor smoke emission rate in kt/year. The flux will be -scaled to total that value. -Default: 16.0 - - - -Specifies the name of the file containing the meteor smoke emission -(ablation) profile. -Default: set by build-namelist. - - - -Specifies the name of the file containing the global realtive flux -specification. -Default: set by build-namelist. - - - -Specifies the day of year when tracers will start being emitted for the tracer test. -Default: 1 - - - -The emission rate of inert tracers used in the test. A positive value indicates that -the rate is a column mass (kg/m2/s) and a negative value indicate that it is a mass -mixing ratio (kg/kg/s). -Default: 1e-9 - - - -Flag indicating that h2so4 vapor pressures should be calculated as if they were -over sulfates that have been totally neutralized. -Default: FALSE - - - - - - -Specifies the method to use to get the prescribed sulfate aerosols for use with nucleation -of cirrus clouds. This can be different than the sulfate aerosols that are used with the -climate. -Default: fixed - - - - - -Specifies the name of the file containing ice refrative indicies as a function of wavelength -used for the particle heating calculation. -Default: set by build-namelist. - - - - - -Specifies the name of the file containing soil erosion factors. This is used by -the dust model. -Default: set by build-namelist. - - - - - - -Flag indicating that a calculated Weibull K should be used. -Default: FALSE - - - -Specifies the name of the sea salt emission parameterization. -Default: Gong - - - -======= - - - -Full pathname of time-variant ozone mixing ratio boundary dataset. -Default: set by build-namelist. - - - -Add CAM3 prescribed ozone to the physics buffer. -Default: FALSE - - - -Flag for yearly cycling of ozone data. If set to FALSE, a multi-year -dataset is assumed, otherwise a single-year dataset is assumed, and ozone -will be cycled over the 12 monthly averages in the file. -Default: TRUE - - - - - -String identifying a hardware counter to the papi library. -Default: PAPI_TOT_CYC - - - -String identifying a hardware counter to the papi library. -Default: PAPI_FP_OPS - - - -String identifying a hardware counter to the papi library. -Default: PAPI_FP_INS - - - -String identifying a hardware counter to the papi library. -Default: PAPI_NO_CTR - - - -Flag indicating whether the mpi_barrier in t_barrierf should be called. -Default: FALSE - - - -Maximum number of levels of timer nesting . -Default: 99999 - - - -Maximum detail level to profile. -Default: 1 - - - -Flag indicating whether timers are disabled. -Default: FALSE - - - -Collect and print out global performance statistics (for this component communicator). -Default: FALSE - - - -Maximum number of processes writing out timing data (for this component communicator). -Default: -1 - - - -Separation between process ids for processes that are writing out timing data -(for this component communicator). -Default: 1 - - - -Flag indicating whether the PAPI namelist should be read and HW performance counters -used in profiling. -Default: FALSE - - - -Flag indicating whether the performance timer output should be written to a -single file (per component communicator) or to a separate file for each -process. -Default: TRUE - - - -Initialization of GPTL timing library. -Default: GPTLmpiwtime - - - -Swap communication protocol option (reduced set): - 3, 5: nonblocking send - 2, 3, 4, 5: nonblocking receive - 4, 5: ready send -Default: 4 - - - -Swap communication maximum request count: - <=0: do not limit number of outstanding send/receive requests - >0: do not allow more than swap_comm_maxreq outstanding - nonblocking send requests or nonblocking receive requests -Default: 128 - - - -fc_gather flow control option: - < 0 : use MPI_Gather - >= 0: use point-to-point with handshaking messages and preposting - receive requests up to - max(min(1,fc_gather_flow_cntl),max_gather_block_size) - ahead. Default value is defined by private parameter - max_gather_block_size, which is currently set to 64. -Default: 64 - - - - - -Allocate all buffers as global. This is a performance optimization on -machines for which allocation/deallocation of physpkg scope buffers on -every timestep was slow (Cray-X1). -Default: TRUE - - - - - -Name of the CAM physics package. 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 - - - -Flag for simple physics package. 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 - - - -======= - group="phys_ctl_nl" valid_values="trop_mam3,trop_mam4,trop_mam7,trop_mozart,trop_strat_mam4_vbs,trop_strat_mam4_vbsext, - waccm_ma,waccm_mad_mam4,waccm_ma_mam4,waccm_ma_sulfur,waccm_sc,waccm_sc_mam4,waccm_tsmlt_mam4, - terminator,none" > - ->>>>>>> origin/featureCESMNCARBeta_trunk2.0-7 -Name of the CAM chemistry package. 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 -full ionosphere and neutral thermosphere, 'neutral' for just -neutral thermosphere, and off for no WACCM-X. -Default: 'off' - - - -Limiter for ambipolar diffusion coefficient used in O+ transport in the -ionosphere. -Default: 1.5e+8 - - - -Shapiro constant for spatial smoother used in O+ transport in the -ionosphere. -Default: 0.03 - - - -Switch to apply floor to O+ concentrations within in ionosphere O+ transport. -Default: TRUE - - - -Switch to to turn on/off O+ transport in ionosphere. -Default: set by build-namelist - - - -Number of ion transport steps per physics timestep. -Default: 5 - - - -Switch to invoke electro-dynamo to compute ion drift velocities used in -O+ transport in ionosphere. If false, ExB empirical model is used to -provide the ion drift velocities for O+ transport. -Default: set by build-namelist - - - -Electric potential model used in the waccmx ionosphere. -Default: set by build-namelist - - - -Give the user the ability to input prescribed high-latitude electric potential. -Default: FALSE - - - -Co-latitudes (degrees) of the critical angles where the ionosphere -high-latitude electric potential is merged with the low and middle -latitude electric potential computed by the electro-dynamo of WACCM-X. -Default: none - - - -Full pathname of dataset for coefficient data used in Weimer05 -high latitude electric potential model. -Default: set by build-namelist. - - - -Full pathname of AMIE inputs for northern hemisphere. -Default: NONE. - - - -Full pathname of AMIE inputs for southern hemisphere. -Default: NONE. - - - - - -Switch to use appropriate energy adjustment in dry-mass adjustment at the -end of tphysac. -Default: .false. - - - - - -Troposphere cloud physics will be done only below the top defined -by this pressure (Pa). -Default: set by build-namelist - - - -MAM affects climate only below the top defined by this pressure (Pa). -Default: 0 for non-MAM cases, otherwise set by build-namelist - - - -Molecular diffusion will be done only if the lowest pressure is -below this limit (Pa). -Default: 0.1 - - - -The level closest to this pressure (Pa) is the bottom of the region -where molecular diffusion is done. -Default: 50. - - - - - -Use this variable to specify the latitude (in degrees) of a column to -debug. The closest column in the physics grid will be used. -Default: none - - - -Use this variable to specify the longitude (in degrees) of a column to -debug. The closest column in the physics grid will be used. -Default: none - - - -If set to .true., turns on extra validation of physics_state objects -in physics_update. Used mainly to track down which package is the -source of invalid data in state. -Default: .false. - - - - - - -Switch to turn on adjustment of the surface fluxes to reduce instabilities -in the surface layer. Set to 1 to turn on the adjustments. -Default: 0 - - - -Type of eddy scheme employed by the vertical diffusion package. 'HB' for -Holtslag and Boville; 'diag_TKE' for diagnostic tke version of Grenier and -Bretherton; 'HBR' for Rasch modified version of 'HB'. -Default: set by build-namelist - - - - - -Switch to use new convective scavenging for modal aerosols. This scheme -replaces the call to ZM's convtran for the the modal aerosol number and -mass mixing ratio constituents. -Default: .false. - - - - -Switch to use appropriate energy adjustment in dry-mass adjustment at the -end of tphysac. -Default: .false. - - - - - -Produce output for the AMWG diagnostic package. -Default: .true. - - - -Produce output for the AMWG variability diagnostics. -Default: .false. - - - -Switch for diagnostic output of the aerosol tendencies -Default: .false. - - - -Switch for diagnostic output of the aerosol optics -Default: .false. - - - -Switch for diagnostic output of eddy variables -Default: .false. - - - -Switch for cam4 T/Q budget diagnostic output -Default: .false. - - - -History tape number T/Q budget output is written to. -Default: 1 - - - -Switch for diagnostic output used primarily for WACCM runs. -Default: .true. if WACCM physics is on, .false. otherwise. - - - -Switch for diagnostic output used primarily for WACCM-X runs. -Default: .true. if WACCM-X is on, .false. otherwise. - - - -Switch for diagnostics specific to the current chemistry package or -configuration. -Default: .true. - - - -Switch for diagnostics specific to the current CARMA model. -Default: .true. - - - -Switch for diagnostics specific to CLUBB. -Default: .true. - - - -Switch to turn on/off default output specific to CESM forcings. -Default: .false. - - - -Switch for diagnostics specific to dust. -Default: .false. - - - -Switch to turn on/off default output specific to WACCM-SC forcings. -Default: .false. - - - -Switch to turn on/off default output chemical species mixing ratios in the surface layer. -Default: .false. - - - -True when model is configured to use an offline driver. -Default: Set by build-namelist. - - - - -Type of radiation scheme employed. -Default: set by build-namelist - - - -Convective water used in radiation? -0 ==> No -1 ==> Yes - Arithmetic average. -2 ==> Yes - Average in emissivity. -Default: set by build-namelist - - - -Lower limit of cumulus cloud fraction. -Default: set by build-namelist - - - -Full pathname of absorption/emission dataset. Used only by camrt scheme. -It consists of terms used for determining the absorptivity and -emissivity of water vapor in the longwave parameterization of radiation. -Default: set by build-namelist. - - - -Frequency of absorptivity/emissivity calculations in time steps (if -positive) or model hours (if negative). To avoid having the abs/ems values -saved on the restart output, make sure that the interval of the abs/ems -calculation evenly divides the restart interval. -Default: -12 - - - -Frequency of long-wave radiation calculation in timesteps (if positive) or -model hours (if negative). -Default: -1 - - - -Frequency of short-wave radiation calculation in timesteps (if positive) or -model hours (if negative). -Default: -1 - - - -Specifies length of time in timesteps (positive) or hours (negative) SW/LW -radiation will be run for every timestep from the start of an initial run. -Default: 0 - - - -Return fluxes per band in addition to the total fluxes. -Default: FALSE - - - -If true, then average the zenith angle over the radiation timestep rather -than using instantaneous values. -Default: FALSE - - - -Definitions for the aerosol modes that may be used in the rad_climate and -rad_diag_* variables. -Default: set by build-namelist - - - -A list of the radiatively active species, i.e., species that affect the -climate simulation via the radiative heating rate calculation. -Default: set by build-namelist - - - -A list of species to be used in the first diagnostic radiative heating rate -calculation. These species are not the ones affecting the climate -simulation. This is a hook for performing radiative forcing calculations. -Default: none - - - -Analogous to rad_diag_1, but for the 2nd diagnostic calculation. -Default: none - - - -Analogous to rad_diag_1, but for the 3rd diagnostic calculation. -Default: none - - - -Analogous to rad_diag_1, but for the 4th diagnostic calculation. -Default: none - - - -Analogous to rad_diag_1, but for the 5th diagnostic calculation. -Default: none - - - -Analogous to rad_diag_1, but for the 6th diagnostic calculation. -Default: none - - - -Analogous to rad_diag_1, but for the 7th diagnostic calculation. -Default: none - - - -Analogous to rad_diag_1, but for the 8th diagnostic calculation. -Default: none - - - -Analogous to rad_diag_1, but for the 9th diagnostic calculation. -Default: none - - - -Analogous to rad_diag_1, but for the 10th diagnostic calculation. -Default: none - - - - -output data needed for off-line radiation calculations -Default: FALSE - - - -History tape number radiation driver output data is written to. -Default: 0 - - - -Averaging flag for radiation driver output data. -Default: 'A' - - - -Switch to turn on Fixed Dynamical Heating in the offline radiation tool (PORT). -Default: false - - - - - -Full pathname of dataset for water refractive indices used in modal aerosol optics -Default: none - - - - -Dry deposition surface values interpolated to model grid, required for unstructured atmospheric grids -with modal chemistry. -Default: none - - - -filepath and name for ice optics data for rrtmg -Default: none - - - -filepath and name for ice optics data for rrtmg -Default: none - - - -filepath and name for ice optics data for rrtmg -Default: none - - - -filepath and name for ice optics data for rrtmg -Default: none - - - -filepath and name for liquid cloud (gamma distributed) optics data for rrtmg -Default: none - - - - - - -Variable to specify the vertical index at which the -Rayleigh friction term is centered (the peak value). -Default: 2 - - - -Rayleigh friction parameter to determine the width of the profile. If set -to 0 then a width is chosen by the algorithm (see rayleigh_friction.F90). -Default: 0. - - - -Rayleigh friction parameter to determine the approximate value of the decay -time (days) at model top. If 0.0 then no Rayleigh friction is applied. -Default: 0. - - - - - - -Full pathname of IOP dataset. -Default: set by build-namelist. - - - -Column bfb match with cam generated IOP. -Default: FALSE - - - -Column radiation mode. -Default: FALSE - - - -Use the specified surface properties. -Default: FALSE - - - -IOP name for CLUBB running in single column mode -Default: "" - - - -Use relaxation. -Default: FALSE - - - -List of fields that will be relaxed to obs -Default: none - - - -Use relaxation. Linearly interpolate the timescale within specified -pressure range. (bpm) -Default: FALSE - - - -Upper most pressure that will be relaxed. -Default: 1e36 - - - -Lower most pressure that will be relaxed. -Default: -1e36 - - - -SCAM relaxation time constant in seconds -Default: 10800 - - - -SCAM relaxation time constant in seconds that will be used at -top of pressure range (i.e., the smaller pressure value). Will -be used from top of pressure range to model top. -Default: 10800 - - - -SCAM relaxation time constant in seconds that will be used at -bottom of pressure range (i.e., the larger pressure value). -Default: 10800 - - - -Use the SCAM-IOP specified T instead of using forecasted T at each time step. -Default: FALSE - - - -Use the SCAM-IOP specified u,v instead of using forecasted u,v at each time step. -Default: TRUE - - - -Use specific type of vertical advection for T. Possible choices are 'iop', 'eulc' and 'off' -Default: 'eulc' - - - -Use specific type of vertical advection for uv. Possible choices are 'iop', 'eulc' and 'off' -Default: 'eulc' - - - -Use specific type of vertical advection for q. Possible choices are 'iop', 'eulc', 'slt' and 'off' -Default: 'slt' - - - -Use the SCAM-IOP specified surface LHFLX/SHFLX/ustar/Tg instead of using internally-computed values -Default: FALSE - - - -Use the SCAM-IOP specified observed water vapor at each time step instead of forecast value -Default: FALSE - - - -Force scam to use the lat lon fields specified in the scam namelist not what is closest to IOP avail lat lon -Default: FALSE - - - - - -Total solar irradiance (W/m2). -Default: 1361.27 - - - -Full pathname of dataset for file that contains the solar photon energy spectra or TSI data -as a time series -Default: set by build-namelist - - - -Full pathname of dataset for file that contains the solar EUV data -as a time series -Default: none - - - -Full pathname of time-variant dataset for the time-dependent proxies for -solar and geomagnetic activity( F10.7, F10.7a, Kp, Ap ). -Default: set by build-namelist. - - - -Full pathname of time-variant dataset for the time-dependent solar wind parameters -(solar wind velocity and density; IMF By and Bz components). -Default: set by build-namelist. - - - -Type of time interpolation for data in {{ hilight }}solar_irrad_data_file{{ closehilight }}. -Can be set to "FIXED" or "SERIAL". -Default: SERIAL - - - -If {{ hilight }}solar_data_type{{ closehilight }} is "FIXED" then solar_data_ymd -is the date the solar data is fixed to. If {{ hilight }}solar_data_type{{ closehilight }} -is "SERIAL" the solar_data_ymd is the start date of the time series -of solar data. -Format: YYYYMMDD -Default: none - - - -Seconds of the day corresponding to {{ hilight }}solar_data_ymd{{ closehilight }} -Default: current model time of day - - - -Use spectral scaling in the radiation heating -Default: set by build-namelist - - - - - -User can specify names for test tracers to be read from the initial file. -The number of names specified should be given as the value of the -nadv_tt -option to configure. -Default: '' - - - -This variable should not be set by the user. If configure has been invoked -with the '-nadv_tt N' option then build-namelist will set this variable to -the value N. If {{ hilight }}test_tracer_names{{ closehilight }} have been specified -then N should be the number of names supplied. -If {{ hilight }}test_tracer_names{{ closehilight }} have not been specified, then the -tracer_suite module generates the tracer names and supplies the initial -values. -Default: set by configure - - - -If true age of air tracers are included. This variable should not be set -by the user. It will be set by build-namelist to be consistent with the -'-age_of_air_trcs' argument specified to configure. -Default: set by configure - - - -If true age of air tracers are read from the initial conditions file. -If this is not specified then they are not read from IC file. -Default: TRUE - - - - - -The length (in seconds) of the atm time step, i.e., the driver calls the -atm component once every dtime seconds. This is also the coupling interval -between the dynamics and physics packages. This variable is not actually -used in the atm model, but rather is used by build-namelist to set the -value of {{ hilight }}atm_cpl_dt{{ closehilight }}. So it will have an effect only -when running CAM using standalone scripts. The CESM scripts have their own -method for setting {{ hilight }}atm_cpl_dt{{ closehilight }}. -Default: is resolution and dycore dependent and is set by build-namelist. - - - - - -Full pathname of time-invariant boundary dataset for topography fields. -Default: set by build-namelist. - - - -Setting use_topo_file=.false. allows the user to specify that PHIS, SGH, -SGH30, and LANDM_COSLAT are all zero without having to supply a topo file -full of zeros. -Default: set by build-namelist. - - - - - -Full pathname of boundary dataset for tropopause climatology. -Default: set by build-namelist. - - - - - -Flag to tell build-namelist to use time-dependent external forcing -files for the aircraft emissions. -Default: FALSE - - - -Flag to set rad_climate variable so that the chemical tracers are -radiatively passive. -Default: FALSE - - - -Wet deposition method used - MOZ --> mozart scheme is used - NEU --> J Neu's scheme is used - OFF --> wet deposition is turned off -Default: NEU except for SPCAM runs - - - -List of gas-phase species that undergo wet deposition via the wet deposition scheme. -Default: NONE - - - -Turns on accumulation to coarse mode exchange appropriate for the stratosphere. -This also changes the default mode definitions (widths and edges) via default -aerosol property input files. -Default: FALSE - - - -Turns on prognostic modal sulfate aerosols in the stratosphere. -Default: FALSE - - - -List of aerosol species that undergo wet deposition. -Default: set by build-namelist. - - - -In-cloud solubility factor used in SO4 wet removal -Default: set by build-namelist. - - -Below-cloud solubility factor used in SO4 wet removal -Default: set by build-namelist. - - -In-cloud solubility factor used in NH4 wet removal -Default: set by build-namelist. - - -Below-cloud solubility factor used in NH4 wet removal -Default: set by build-namelist. - - -In-cloud solubility factor used in NH4NO3 wet removal -Default: set by build-namelist. - - -Below-cloud solubility factor used in NH4NO3 wet removal -Default: set by build-namelist. - - -In-cloud solubility factor used in CB2 wet removal -Default: set by build-namelist. - - -Below-cloud solubility factor used in CB2 wet removal -Default: set by build-namelist. - - -In-cloud solubility factor used in OC2 wet removal -Default: set by build-namelist. - - -Below-cloud solubility factor used in OC2 wet removal -Default: set by build-namelist. - - -In-cloud solubility factor used in wet removal of BULK dust -Default: set by build-namelist. - - -Below-cloud solubility factor used in wet removal of BULK dust -Default: set by build-namelist. - - -In-cloud solubility factor used in wet removal of BULK sea salt -Default: set by build-namelist. - - -Below-cloud solubility factor used in wet removal of BULK sea salt -Default: set by build-namelist. - - - -List of aerosol species that undergo sediment (dry deposition). -Default: set by build-namelist. - - - -Tuning for below cloud scavenging of interstitial modal aerosols. -Default: set by build-namelist. - - - -Tuning for in-cloud scavenging of interstitial modal aerosols. -Default: set by build-namelist. - - - -Tuning for in-cloud scavenging of cloud-borne modal aerosols. -Default: set by build-namelist. - - - -Tuning for seasalt_emis -Default: set by build-namelist. - - - -In-cloud solubility factor used in BULK aerosol wet removal -Default: set by build-namelist. - - - -Below-cloud solubility factor used in BULK aerosol wet removal -Default: set by build-namelist. - - - -Scavenging coefficient used in BULK aerosol wet removal -Default: set by build-namelist. - - - -Scavenging coefficient used in the wet removal of SO4 -Default: set by build-namelist. - - - -Scavenging coefficient used in the wet removal of NH4 -Default: set by build-namelist. - - - -Scavenging coefficient used in the wet removal of CB2 -Default: set by build-namelist. - - - -Scavenging coefficient used in the wet removal of OC2 -Default: set by build-namelist. - - - -Scavenging coefficient used in the wet removal of DST01 -Default: set by build-namelist. - - - -Scavenging coefficient used in the wet removal of DST02 -Default: set by build-namelist. - - - -Scavenging coefficient used in the wet removal of DST03 -Default: set by build-namelist. - - - -Scavenging coefficient used in the wet removal of DST04 -Default: set by build-namelist. - - - -Scavenging coefficient used in the wet removal of SSLT01 -Default: set by build-namelist. - - - -Scavenging coefficient used in the wet removal of SSLT02 -Default: set by build-namelist. - - - -Scavenging coefficient used in the wet removal of SSLT03 -Default: set by build-namelist. - - - -Scavenging coefficient used in the wet removal of SSLT04 -Default: set by build-namelist. - - - -Full pathname of boundary dataset for airplane emissions. -Default: set by build-namelist. - - - -Full pathname of dataset containing soil moisture fraction information used in 'xactive_atm' -method of calculating dry deposition of chemical tracers. -Default: set by build-namelist. - - - -Full pathname of dataset which contains the prescribed deposition velocities used -in the 'table' method of calculating dry deposition of chemical tracers. -Default: set by build-namelist. - - - -Full pathname of dataset which contains land vegitation information used in 'xactive_atm' -method of calculating dry deposition of chemical tracers. -Default: set by build-namelist. - - - -Full pathname of dataset which contains season information used in 'xactive_atm' -method of calculating dry deposition of chemical tracers. -Default: set by build-namelist. - - - -Tuning parameter for dust emissions. -Default: set by build-namelist. - - - -If TRUE a steady state solution is used to calculate electron and -ion temperature. -Default: TRUE - - - -Full pathname of dataset for coefficient data used in WACCM to calculate ion drag -for high solar fluxes from the Scherliess low latitude electric potential model. -Default: set by build-namelist. - - - -Full pathname of dataset for coefficient data used in WACCM to calculate ion drag -for low solar fluxes from the Scherliess low latitude electric potential model. -Default: set by build-namelist. - - - -Full pathname of dataset for coefficient data used in WACCM to calculate ion drag -from the Weimer96 high latitude electric potential model. -Default: set by build-namelist. - - - -Switch to turn on empirical ExB ion drift velocities model for use in ion drag -parameterizations. If this is false then it is assumed ion drift velocities are -supplied by an active ionosphere model. -Default: set by build-namelist. - - - -Full pathname of dataset for the neutral species absorption cross sections for EUV -photo reactions producing electrons. -Default: set by build-namelist. - - - -Type of time interpolation of emission datasets specified. -Can be set to 'CYCLICAL', 'SERIAL', 'INTERP_MISSING_MONTHS', or 'FIXED'. -by {{ hilight }}srf_emis_specifier{{ closehilight }}. -Default: 'CYCLICAL' - - - -The cycle year of the surface emissions data -if {{ hilight }}srf_emis_type{{ closehilight }} is 'CYCLICAL'. -Format: YYYY -Default: 0 - - - -The date at which the surface emissions are fixed -if {{ hilight }}srf_emis_type{{ closehilight }} is 'FIXED'. -Format: YYYYMMDD -Default: 0 - - - -The time of day (seconds) corresponding to {{ hilight }}srf_emis_fixed_ymd{{ closehilight }} -at which the surface emissions are fixed -if {{ hilight }}srf_emis_type{{ closehilight }} is 'FIXED'. -Default: 0 seconds - - - -Full pathname of dataset for EUVAC solar EUV model (0.05-121nm). -Default: set by build-namelist. - - - -The cycle year of the external forcings (3D emissions) data -if {{ hilight }}ext_frc_type{{ closehilight }} is 'CYCLICAL'. -Format: YYYY -Default: 0 - - - -Default: current model date -The date at which the external forcings are fixed -if {{ hilight }}ext_frc_type{{ closehilight }} is 'FIXED'. -Format: YYYYMMDD -Default: 0 - - - -The time of day (seconds) corresponding to {{ hilight }}ext_frc_fixed_ymd{{ closehilight }} -at which the external forcings are fixed -if {{ hilight }}ext_frc_type{{ closehilight }} is 'FIXED'. -Default: 0 seconds - - - -List of full pathnames of elevated emission (or external chemical forcings) datasets. - -The chemistry package reads in elevated emission data from a set of netcdf files in -units of "molecules/cm3/s". Each tracer species emissions is read from its -own file as directed by the namelist variable {{ hilight }}ext_frc_specifier{{ closehilight }}. The -{{ hilight }}ext_frc_specifier{{ closehilight }} variable tells the model which species have elevated -emissions and the file path for the corresponding species. That is, the -{{ hilight }}ext_frc_specifier{{ closehilight }} variable is set something like: - - ext_frc_specifier = 'SO2 -> /path/vrt.emis.so2.nc', - 'SO4 -> /path/vrt.emis.so4.nc', etc... - -Each emission file can have more than one source. When the emission are -read in the sources are summed to give a total emission field for the -corresponding species. The emission can be read in as time series of data, -cycle over a given year, or be fixed to a given date. - -The vertical coordinate in these emissions files should be 'altitude' (km) so that the -vertical redistribution to the model layers is done using a mass conserving method. -If the vertical coordinate is altitude then data needs to be ordered from the -surface to the top (increasing altitude). - -Default: set by build-namelist. - - - -Type of time interpolation for fixed lower boundary data. -Can be set to 'CYCLICAL', 'SERIAL', 'INTERP_MISSING_MONTHS', or 'FIXED'. -Default: 'CYCLICAL' - - - -The cycle year of the fixed lower boundary data -if {{ hilight }}flbc_type{{ closehilight }} is 'CYCLICAL'. -Format: YYYY -Default: 0 - - -The date at which the fixed lower boundary data is fixed -if {{ hilight }}flbc_type{{ closehilight }} is 'FIXED'.. -Format: YYYYMMDD -Default: 0 - - -The time of day (seconds) corresponding to {{ hilight }}flbc_fixed_ymd{{ closehilight }} -at which the fixed lower boundary data is fixed -if {{ hilight }}flbc_type{{ closehilight }} is 'FIXED'. -Default: 0 seconds - - - -Full pathname of dataset for fixed lower boundary conditions. -Default: set by build-namelist. - - - -List of species that are fixed at the lower boundary. -Default: set by build-namelist. - - - -Type of time interpolation for fixed lower boundary data. -Default: 'CYCLICAL' - - - -File name of dataset for NOy upper boundary conditions. -Default: set by build-namelist. - - - -Full pathname of the directory that contains the NOy upper boundary conditions files specified in -{{ hilight }}noy_ubc_filelist{{ closehilight }}. -Default: set by build-namelist. - - - -Filename of file that contains a sequence of filenames for prescribed NOy upper boundary conditions. -The filenames in this file are relative to the directory specified by {{ hilight }}noy_ubc_datapath{{ closehilight }}. -Default: set by build-namelist. - - - -Type of time interpolation for NOy upper boundary conditions. -Default: 'SERIAL' - - - -The cycle year of the NOy upper boundary data -if {{ hilight }}flbc_type{{ closehilight }} is 'CYCLICAL'. -Format: YYYY -Default: 0 - - - -The date at which the NOy upper boundary data is fixed -if {{ hilight }}flbc_type{{ closehilight }} is 'FIXED'.. -Format: YYYYMMDD -Default: 0 - - - -The time of day (seconds) corresponding to {{ hilight }}noy_ubc_fixed_ymd{{ closehilight }} -at which the NOy upper boundary data is fixed -if {{ hilight }}flbc_type{{ closehilight }} is 'FIXED'. -Default: 0 seconds - - - -Full pathname of dataset for chemical tracers constrained in the stratosphere -Default: set by build-namelist. - - - -List of species that are constrained in the stratosphere. -Default: set by build-namelist. - - - -Full pathname of dataset for land mask applied to the lighting NOx production -Default: set by build-namelist. - - - -Multiplication factor applied to the lighting NOx production -Default: 1.0. - - - -Multiplication factor applied to the upper boundary NO mass mixing ratio. -Default: 1.0 - - - -Full pathname of dataset for the neutral species absorption cross sections. -Default: set by build-namelist. - - - -Full pathname of dataset for fast-tuv photolysis cross sections -Default: set by build-namelist. - - - -Full pathname of dataset of O2 cross sections for fast-tuv photolysis -Default: set by build-namelist. - - - -Full pathname of dataset of O2 and 03 column densities above the model for look-up-table photolysis -Default: set by build-namelist. - - - -Filename of file that contains aircraft input file lists. The filenames in the files are relative -to the directory specified by {{ hilight }}aircraft_datapath{{ closehilight }}. -Default: set by build-namelist. - - - -Full pathname of the directory that contains the files specified in -{{ hilight }}aircraft_specifier{{ closehilight }}. -Default: set by build-namelist. - - - -Type of time interpolation for data in aircraft aerosol files. -Default: 'CYCLICAL_LIST' - - - -Full pathname of the ac_CO2 file specified in the filelist in -{{ hilight }}aircraft_specifier{{ closehilight }}. This is only to -get this name into the cam.input_data_list for the CESM scripts. -Default: set by build-namelist. - - - - -Full pathname of the directory that contains the files specified in -{{ hilight }}gcr_ionization_filelist{{ closehilight }}. -Default: set by build-namelist. - - - -Filename of dataset for ionization rates by galactic cosmic rays. -Default: set by build-namelist. - - - -Filename of file that contains a sequence of filenames for ionization -rates by galactic cosmic rays. The filenames in this file are relative -to the directory specified by {{ hilight }}gcr_ionization_datapath{{ closehilight }}. -Default: set by build-namelist. - - - -Names of variables containing ionization rates (/cm3/sec) in the cosmic rays datasets. -Default: none - - - -Type of time interpolation for data in gcr_ionization files. -Can be set to 'CYCLICAL', 'SERIAL', 'INTERP_MISSING_MONTHS', or 'FIXED'. -Default: 'SERIAL' - - - -The cycle year of the prescribed green house gas data -if {{ hilight }}gcr_ionization_type{{ closehilight }} is 'CYCLICAL'. -Format: YYYY -Default: 0 - - - -The date at which the prescribed green house gas data is fixed -if {{ hilight }}gcr_ionization_type{{ closehilight }} is 'FIXED'. -Format: YYYYMMDD -Default: 0 - - - -The time of day (seconds) corresponding to {{ hilight }}gcr_ionization_fixed_ymd{{ closehilight }} -at which the prescribed green house gas data is fixed -if {{ hilight }}gcr_ionization_type{{ closehilight }} is 'FIXED'. -Default: 0 seconds - - - - - -Full pathname of the directory that contains the files specified in -{{ hilight }}prescribed_aero_filelist{{ closehilight }}. -Default: set by build-namelist. - - - -Switch used to indicate which type of aerosols are prescribed -- bulk or modal. -This is used to set the default {{ hilight }}prescribed_aero_specifier{{ closehilight }} and -{{ hilight }}aerodep_flx_specifier{{ closehilight }} namelist variables. -Default: set by build-namelist - - - -Filename of dataset for prescribed aerosols. -Default: set by build-namelist. - - - -Filename of file that contains a sequence of filenames for prescribed -aerosols. The filenames in this file are relative to the directory specified -by {{ hilight }}prescribed_aero_datapath{{ closehilight }}. -Default: set by build-namelist. - - - -Remove the file containing prescribed aerosol concentrations from local disk when no longer needed. -Default: FALSE - - - -A list of variable names of the concentration fields in the prescribed aerosol datasets -and corresponding names used in the physics buffer seperated by colons. For example: - - prescribed_aero_specifier = 'pbuf_name1:ncdf_fld_name1','pbuf_name2:ncdf_fld_name2', ... - -If there is no colon seperater then the specified name is used as both the pbuf_name and ncdf_fld_name, - -Default: none - - - -Type of time interpolation for data in prescribed_aero files. -Can be set to 'CYCLICAL', 'SERIAL', 'INTERP_MISSING_MONTHS', or 'FIXED'. -Default: 'SERIAL' - - - -The cycle year of the prescribed aerosol data -if {{ hilight }}prescribed_aero_type{{ closehilight }} is 'CYCLICAL'. -Format: YYYY -Default: 0 - - - -The date at which the prescribed aerosol data is fixed -if {{ hilight }}prescribed_aero_type{{ closehilight }} is 'FIXED'. -Format: YYYYMMDD -Default: 0 - - - -The time of day (seconds) corresponding to {{ hilight }}prescribed_aero_fixed_ymd{{ closehilight }} -at which the prescribed aerosol data is fixed -if {{ hilight }}prescribed_aero_type{{ closehilight }} is 'FIXED'. -Default: 0 seconds - - - -Full pathname of the directory that contains the files specified in -{{ hilight }}aerodep_flx_filelist{{ closehilight }}. -Default: set by build-namelist. - - - -Filename of dataset for prescribed aerosols. -Default: set by build-namelist. - - - -Filename of file that contains a sequence of filenames for prescribed -aerosols. The filenames in this file are relative to the directory specified -by {{ hilight }}aerodep_flx_datapath{{ closehilight }}. -Default: set by build-namelist. - - - -Remove the file containing prescribed aerosol deposition fluxes from local disk when no longer needed. -Default: FALSE - - - -Names of variables containing aerosol data in the prescribed aerosol datasets. -Default: none - - - -Type of time interpolation for data in aerodep_flx files. -Can be set to 'CYCLICAL', 'SERIAL', 'INTERP_MISSING_MONTHS', or 'FIXED'. -Default: 'SERIAL' - - - -The cycle year of the prescribed aerosol flux data -if {{ hilight }}aerodep_flx_type{{ closehilight }} is 'CYCLICAL'. -Format: YYYY -Default: 0 - - - -The date at which the prescribed aerosol flux data is fixed -if {{ hilight }}aerodep_flx_type{{ closehilight }} is 'FIXED'. -Format: YYYYMMDD -Default: 0 - - - -The time of day (seconds) corresponding to {{ hilight }}ssaerodep_flx_fixed_ymd{{ closehilight }} -at which the prescribed aerosol flux data is fixed -if {{ hilight }}saerodep_flx_type{{ closehilight }} is 'FIXED'. -Default: 0 seconds - - - -Full pathname of the directory that contains the files specified in -{{ hilight }}prescribed_ghg_filelist{{ closehilight }}. -Default: set by build-namelist. - - - -Filename of dataset for prescribed GHGs. -Default: set by build-namelist. - - - -Filename of file that contains a sequence of filenames for prescribed -GHGs. The filenames in this file are relative to the directory specified -by {{ hilight }}prescribed_ghg_datapath{{ closehilight }}. -Default: set by build-namelist. - - - -Remove the file containing prescribed green house gas concentrations from local disk when no longer needed. -Default: FALSE - - - -Names of variables containing GHG data in the prescribed GHG datasets. -Default: none - - - -Type of time interpolation for data in prescribed_ghg files. -Can be set to 'CYCLICAL', 'SERIAL', 'INTERP_MISSING_MONTHS', or 'FIXED'. -Default: 'SERIAL' - - - -The cycle year of the prescribed green house gas data -if {{ hilight }}prescribed_ghg_type{{ closehilight }} is 'CYCLICAL'. -Format: YYYY -Default: 0 - - - -The date at which the prescribed green house gas data is fixed -if {{ hilight }}prescribed_ghg_type{{ closehilight }} is 'FIXED'. -Format: YYYYMMDD -Default: 0 - - - -The time of day (seconds) corresponding to {{ hilight }}prescribed_ghg_fixed_ymd{{ closehilight }} -at which the prescribed green house gas data is fixed -if {{ hilight }}prescribed_ghg_type{{ closehilight }} is 'FIXED'. -Default: 0 seconds - - - -Full pathname of the directory that contains the files specified in -{{ hilight }}prescribed_ozone_filelist{{ closehilight }}. -Default: set by build-namelist. - - - -Filename of dataset for prescribed ozone. -Default: set by build-namelist. - - - -Filename of file that contains a sequence of filenames for prescribed -ozone. The filenames in this file are relative to the directory specified -by {{ hilight }}prescribed_ozone_datapath{{ closehilight }}. -Default: set by build-namelist. - - - -Name of variable containing ozone data in the prescribed ozone datasets. -Default: 'ozone' - - - -Remove the file containing prescribed ozone concentrations from local disk when no longer needed. -Default: FALSE - - - -Type of time interpolation for data in prescribed_ozone files. -Can be set to 'CYCLICAL', 'SERIAL', 'INTERP_MISSING_MONTHS', or 'FIXED'. -Default: 'SERIAL' - - - -The cycle year of the prescribed ozone data -if {{ hilight }}prescribed_ozone_type{{ closehilight }} is 'CYCLICAL'. -Format: YYYY -Default: 0 - - - -The date at which the prescribed ozone data is fixed -if {{ hilight }}prescribed_ozone_type{{ closehilight }} is 'FIXED'. -Format: YYYYMMDD -Default: 0 - - - -The time of day (seconds) corresponding to {{ hilight }}prescribed_ozone_fixed_ymd{{ closehilight }} -at which the prescribed ozone data is fixed -if {{ hilight }}prescribed_ozone_type{{ closehilight }} is 'FIXED'. -Default: 0 seconds - - - -Full pathname of the directory that contains the files specified in -{{ hilight }}prescribed_volcaero_filelist{{ closehilight }}. -Default: set by build-namelist. - - - -Filename of dataset for prescribed volcaero. -Default: set by build-namelist. - - - -Filename of file that contains a sequence of filenames for prescribed -volcanic aerosols. The filenames in this file are relative to the directory specified -by {{ hilight }}prescribed_volcaero_datapath{{ closehilight }}. -Default: set by build-namelist. - - - -Name of variable containing volcaero data in the prescribed volcaero datasets. -Default: 'MMRVOLC' - - - -Remove the file containing prescribed volcanic aerosol concentrations from local disk when no longer needed. -Default: FALSE - - - -Type of time interpolation for data in prescribed_volcaero files. -Can be set to 'CYCLICAL', 'SERIAL', 'INTERP_MISSING_MONTHS', or 'FIXED'. -Default: 'SERIAL' - - - -The cycle year of the prescribed volcanic aerosol data -if {{ hilight }}prescribed_volcaero_type{{ closehilight }} is 'CYCLICAL'. -Format: YYYY -Default: 0 - - - -The date at which the prescribed volcanic aerosol data is fixed -if {{ hilight }}prescribed_volcaero_type{{ closehilight }} is 'FIXED'. -Format: YYYYMMDD -Default: 0 - - - -The time of day (seconds) corresponding to {{ hilight }}prescribed_volcaero_fixed_ymd{{ closehilight }} -at which the prescribed volcanic aerosol data is fixed -if {{ hilight }}prescribed_volcaero_type{{ closehilight }} is 'FIXED'. -Default: 0 seconds - - - - -Full pathname of the directory that contains the files specified in -{{ hilight }}prescribed_strataero_filelist{{ closehilight }}. -Default: set by build-namelist. - - - -Filename of dataset for prescribed volcaero. -Default: set by build-namelist. - - - -Filename of file that contains a sequence of filenames for prescribed -stratospheric aerosols. The filenames in this file are relative to the directory specified -by {{ hilight }}prescribed_strataero_datapath{{ closehilight }}. -Default: set by build-namelist. - - - -Name of variable containing prescribed stratospheric aerosol specifiers -Default: set by the CAM program - - - -Remove the file containing prescribed volcanic aerosol concentrations from local disk when no longer needed. -Default: FALSE - - - -Type of time interpolation for data in prescribed_strataero files. -Can be set to 'CYCLICAL', 'SERIAL', 'INTERP_MISSING_MONTHS', or 'FIXED'. -Default: 'SERIAL' - - - -The cycle year of the prescribed volcanic aerosol data -if {{ hilight }}prescribed_strataero_type{{ closehilight }} is 'CYCLICAL'. -Format: YYYY -Default: 0 - - - -The date at which the prescribed volcanic aerosol data is fixed -if {{ hilight }}prescribed_strataero_type{{ closehilight }} is 'FIXED'. -Format: YYYYMMDD -Default: 0 - - - -The time of day (seconds) corresponding to {{ hilight }}prescribed_strataero_fixed_ymd{{ closehilight }} -at which the prescribed volcanic aerosol data is fixed -if {{ hilight }}prescribed_strataero_type{{ closehilight }} is 'FIXED'. -Default: 0 seconds - - - -Switch to turn on climate feed backs due to prescribed stratospheric aerosols via -the rad_climate namelist variable. -Default: false - - - -If true the prescribed stratospheric aerosols have three distribution modes. -Default: true for CAM6, otherwise false - - - -Indicates whether to use the unified chemistry tropopause method to set prescribed -stratospheric aerosols below the tropopause to zero. This has a maximum altitude -level corresponding to 300 hPa for latitudes poleward of 50 degrees. -Default: set by build-namelist - - - -Full pathname of dataset for radiative source function used in look up table photloysis -Default: set by build-namelist. - - - -Full pathname of dataset for the coefficients of the NOEM nitric oxide model used -to calculate its upper boundary concentration. -Default: set by build-namelist. - - - -Full pathname of boundary dataset for soil erodibility factors. -Default: set by build-namelist. - - - -List of full pathnames of surface emission datasets. - -The chemistry package reads in emission data from a set of netcdf files in -units of "molecules/cm2/s". Each tracer species emissions is read from its -own file as directed by the namelist variable {{ hilight }}srf_emis_specifier{{ closehilight }}. The -{{ hilight }}srf_emis_specifier{{ closehilight }} variable tells the model which species have emissions -and the file path for the corresponding species. That is, the -{{ hilight }}srf_emis_specifier{{ closehilight }} variable is set something like: - - srf_emis_specifier = 'CH4 -> /path/emis.ch4.nc', - 'CO -> /path/emis.co.nc', etc... - -Each emission file can have more than one source. When the emission are -read in the sources are summed to give a total emission field for the -corresponding species. The emission can be read in as time series of data, -cycle over a given year, or be fixed to a given date. - -Default: set by build-namelist. - - - - -Full pathname of dataset containing tropopheric sulfate aerosols -Default: set by build-namelist. - - - -Full pathname of the directory that contains the files specified in -{{ hilight }}sulf_filelist{{ closehilight }}. -Default: set by build-namelist. - - - -Filename of file that contains a sequence of filenames for prescribed -sulfate. The filenames in this file are relative to the directory specified -by {{ hilight }}sulf_datapath{{ closehilight }}. -Default: set by build-namelist. - - - -Name of variable containing sulfate data in the prescribed sulfate datasets. -Default: 'SULFATE' - - - -Remove the file containing prescribed sulfate concentrations from local disk when no longer needed. -Default: FALSE - - - -Type of time interpolation for data in prescribed sulfate files. -Can be set to 'CYCLICAL', 'SERIAL', 'INTERP_MISSING_MONTHS', or 'FIXED'. -Default: 'CYCLICAL' - - - -The cycle year of the prescribed sulfate data -if {{ hilight }}sulf_type{{ closehilight }} is 'CYCLICAL'. -Format: YYYY -Default: 0 - - - -The date at which the prescribed sulfate data is fixed -if {{ hilight }}sulf_type{{ closehilight }} is 'FIXED'. -Format: YYYYMMDD -Default: 0 - - - -The time of day (seconds) corresponding to {{ hilight }}sulf_fixed_ymd{{ closehilight }} -at which the prescribed sulfate data is fixed -if {{ hilight }}sulf_type{{ closehilight }} is 'FIXED'. -Default: 0 seconds - - - - - - - - -Full pathname of dataset for TGCM upper boundary -Default: set by build-namelist. - - -Type of time interpolation for data in TGCM upper boundary file. -Can be set to 'CYCLICAL', 'SERIAL', 'INTERP_MISSING_MONTHS', or 'FIXED'. -Default: 'SERIAL' - - - -The cycle year of the TGCM upper boundary data -if {{ hilight }}tgcm_ubc_type{{ closehilight }} is 'CYCLICAL'. -Format: YYYY -Default: 0 - - - -The date at which the TGCM upper boundary data is fixed -if {{ hilight }}tgcm_ubc_type{{ closehilight }} is 'FIXED'. -Format: YYYY -Default: 0 - - - -The time of day (seconds) corresponding to {{ hilight }}tgcm_ubc_fixed_ymd{{ closehilight }} -at which the TGCM upper boundary data is fixed -if {{ hilight }}tgcm_ubc_type{{ closehilight }} is 'FIXED'. -Default: 0 seconds - - - -Perturbation applied to the upper boundary temperature. -Default: 0.0 - - - -Frequency in time steps at which the chemical equations are solved. -Default: 1 - - - -Filename of dataset for linoz cholirine loading. -Default: none. - - -Type of time interpolation type for data in {{ hilight }}chlorine_loading_file{{ closehilight }} -Default: 'SERIAL' - - -The time of day (seconds) corresponding to {{ hilight }}chlorine_loading_fixed_ymd{{ closehilight }} -at which the chlorine loading data is fixed -if {{ hilight }}chlorine_loading_type{{ closehilight }} is 'FIXED'. -Default: 0 seconds - - -The date at which the chlorine loading data is fixed -if {{ hilight }}chlorine_loading_type{{ closehilight }} is 'FIXED'. -Format: YYYYMMDD -Default: 0 - - - - -Full pathname of the directory that contains the files specified in -{{ hilight }}linoz_data_filelist{{ closehilight }}. -Default: none. - - - -Filename of dataset for LINOZ data. -Default: none. - - - -Filename of file that contains a sequence of filenames of the linoz data. -The filenames in this file are relative to the directory specified -by {{ hilight }}linoz_data_datapath{{ closehilight }}. -Default: set by build-namelist. - - - -Type of time interpolation for data in linoz_data files. -Can be set to 'CYCLICAL', 'SERIAL', 'INTERP_MISSING_MONTHS', or 'FIXED'. -Default: 'SERIAL' - - - -Remove the file containing LINOZ data from local disk when no longer needed. -Default: FALSE - - - -The cycle year of the LINOZ data -if {{ hilight }}linoz_data_type{{ closehilight }} is 'CYCLICAL'. -Format: YYYY -Default: 0 - - - -The date at which the LINOZ data is fixed -if {{ hilight }}linoz_data_type{{ closehilight }} is 'FIXED'. -Format: YYYYMMDD -Default: 0 - - - -The time of day (seconds) corresponding to {{ hilight }}linoz_data_fixed_ymd{{ closehilight }} -at which the LINOZ data is fixed -if {{ hilight }}linoz_data_type{{ closehilight }} is 'FIXED'. -Default: 0 seconds - - - -Full pathname of the directory that contains the files specified in -{{ hilight }}tracer_cnst_filelist{{ closehilight }}. -Default: set by build-namelist. - - - -Filename of dataset for the prescribed chemical constituents. -Default: set by build-namelist. - - - -Filename of file that contains a sequence of filenames for the prescribed chemical constituents. -The filenames in this file are relative to the directory specified -by {{ hilight }}tracer_cnst_datapath{{ closehilight }}. -Default: set by build-namelist. - - - -Remove the file containing prescribed chemical constituents from local disk when no longer needed. -Default: FALSE - - - -List of prescribed chemical constituents. -Default: set by build-namelist. - - - -Type of time interpolation for data in tracer_cnst files. -Default: 'SERIAL' - - - -The cycle year of the prescribed chemical constituents data -if {{ hilight }}tracer_cnst_type{{ closehilight }} is 'CYCLICAL'. -Format: YYYY -Default: 0 - - - -The date at which the chemical constituents data is fixed -if {{ hilight }}tracer_cnst_type{{ closehilight }} is 'FIXED'. -Format: YYYYMMDD -Default: 0 - - - -The time of day (seconds) corresponding to {{ hilight }}tracer_cnst_fixed_ymd{{ closehilight }} -at which the chemical constituents data is fixed -if {{ hilight }}tracer_cnst_type{{ closehilight }} is 'FIXED'. -Default: 0 seconds - - - -Full pathname of the directory that contains the files specified in -{{ hilight }}tracer_srcs_filelist{{ closehilight }}. -Default: set by build-namelist. - - - -Filename of dataset for the prescribed chemical sources. -Default: set by build-namelist. - - - -Filename of file that contains a sequence of datasets for the prescribed chemical sources. -The filenames in this file are relative to the directory specified -by {{ hilight }}tracer_srcs_datapath{{ closehilight }}. -Default: set by build-namelist. - - - -Remove the file containing prescribed chemical sources from local disk when no longer needed. -Default: FALSE - - - -List of prescribed chemical sources -Default: set by build-namelist. - - - -Type of time interpolation for data in tracer_srcs files. -Default: 'SERIAL' - - - -The cycle year of the prescribed chemical sources data -if {{ hilight }}tracer_srcs_type{{ closehilight }} is 'CYCLICAL'. -Format: YYYY -Default: 0 - - - -The date at which the chemical sources data is fixed -if {{ hilight }}tracer_srcs_type{{ closehilight }} is 'FIXED'. -Format: YYYYMMDD -Default: 0 - - - -The time of day (seconds) corresponding to {{ hilight }}tracer_srcs_fixed_ymd{{ closehilight }} -at which the chemical sources data is fixed -if {{ hilight }}tracer_srcs_type{{ closehilight }} is 'FIXED'. -Default: 0 seconds - - - -If TRUE then use the FTUV method to calculate the photolysis reactions rates, -otherwise use the look up table method. -Default: FALSE - - - -Full pathname of dataset for Chebyshev polynomial Coeff data used for photolysis -cross sections. -Default: set by build-namelist. - - - -Full pathname of cross section dataset for long wavelengh photolysis -Default: set by build-namelist. - - - -Full pathname of cross section dataset for short wavelengh photolysis -Default: set by build-namelist. - - - - - -List of species that undergo dry deposition. -Default: set by build-namelist. - - - -Dry deposition method used. This specifies the method used to calculate dry -deposition velocities of gas-phase chemical species. The available methods -are: - 'table' - prescribed method in CAM - 'xactive_atm' - interactive method in CAM - 'xactive_lnd' - interactive method in CLM -Default: set by build-namelist - - - - -Give the user the ability to specify rate families (or groupings) diagnostics based -on reaction tag names. These group names can be added to history fincl variables. -A "+" character at the end of a string indicates that the summation will continue with the next string. -Example: - rate_sums = - 'OX_P = NO_HO2 + CH3O2_NO + 2*jo2_b ... ', - 'OX_L = NO2_O_M + HO2_O3 + CLO_O ...', - 'RO2_RO2_sum = CH3O2_CH3O2a + CH3O2_CH3O2b + C2H5O2_CH3O2 + C2H5O2_C2H5O2 + CH3CO3_CH3O2 +', - 'CH3CO3_CH3CO3 + CH3H7O2_CH3O2 + RO2_CH3O2 + MACRO2_CH3O2 ...', - fincl1 = 'OX_P','OX_L', 'RO2_RO2_sum', ... -Default: none - - - -Give the user the ability to specify species families (or groupings) diagnostics in volume mixing ratio. -These group names can be added to history fincl variables. The units are mole/mole. -A "+" character at the end of a string indicates that the summation will continue with the next string. -Example: - vmr_sums = - 'SOAG = SOAG0 + SOAG1 + SOAG2 + SOAG3 + SOAG4', - 'NOy = N + NO + NO2 + NO3 + 2*N2O5 + HNO3 + HO2NO2 + CLONO2 +', - 'BRONO2 + PAN + MPAN + ISOPNO3 + ONITR +', - 'HONITR + ALKNIT + ISOPNITA + ISOPNITB + ISOPNOOH + NC4CH2OH +', - 'NC4CHO + NOA + NTERPOOH + PBZNIT + TERPNIT' - fincl1 = 'NOy','SOAG', ... -Default: none - - - -Give the user the ability to specify species families (or groupings) diagnostics in mass mixing ratio. -These group names can be added to history fincl variables. The units are kg/kg. -A "+" character at the end of a string indicates that the summation will continue with the next string. -Example: - mmr_sums = - 'soa_a1 = soa1_a1 + soa2_a1 + soa3_a1 + soa4_a1 + soa5_a1', - 'soa_a2 = soa1_a2 + soa2_a2 + soa3_a2 + soa4_a2 + soa5_a2' - fincl1 = 'soa_a1','soa_a2', ... -Default: none - - - -Indicates whether to use the unified chemistry tropopause method to set the -tropopause used in gas phase and aerosol chemical processes. This has a maximum altitude -level corresponding to 300 hPa for latitudes poleward of 50 degrees. -Default: set by build-namelist - - - -File containing fire emissions factors. -Default: none - - - -Fire emissions specifier. -Default: none - - - -If true fire emissions are input into atmosphere as elevated forcings. -Otherwise they are treated as surface emissions. -Default: TRUE - - - -List of nitrogen deposition fluxes to be sent from CAM to surface models. -Default: set by build-namelist. - - - -File containing MEGAN emissions factors. -Default: set by build-namelist. - - - -MEGAN specifier. -Default: set by build-namelist. - - - -MEGAN mapped isoprene emissions facters switch -If true then use mapped MEGAN emissions facters for isoprene. -Default: .false. - - - -List of fluxes needed by the CARMA model, from CLM to CAM. -Default: set by build-namelist. - - - - - -Filename of the prescribed waccm forcing data used with waccm_sc chemistry. -This contains prescribed constituents for non-LTE calculations and heating rates -for wavelengths less than 200 nm. -Default: set by build-namelist. - - - -Full pathname of the directory that contains the files specified in -{{ hilight }}waccm_forcing_filelist{{ closehilight }}. -Default: set by build-namelist. - - - -A file that contains a sequence of filenames for prescribed waccm forcing data. -The filenames in this file are relative to the directory specified -by {{ hilight }}waccm_forcing_datapath{{ closehilight }}. -Default: set by build-namelist. - - - -Remove the file containing prescribed waccm forcing data from local disk when no longer needed. -Default: FALSE - - - -Names of variables containing concentrations and heating rate in the prescribed waccm forcing datasets. -Default: none - - - -Type of time interpolation for data in waccm_forcing files. -Can be set to 'CYCLICAL', 'SERIAL', 'INTERP_MISSING_MONTHS', or 'FIXED'. -Default: 'CYCLICAL' - - - -The cycle year of the prescribed waccm forcing data -if {{ hilight }}waccm_forcing_type{{ closehilight }} is 'CYCLICAL'. -Format: YYYY -Default: 0 - - - -The date at which the prescribed waccm forcing data is fixed -if {{ hilight }}waccm_forcing_type{{ closehilight }} is 'FIXED'. -Format: YYYYMMDD -Default: 0 - - - -The time of day (seconds) corresponding to {{ hilight }}waccm_forcing_fixed_ymd{{ closehilight }} -at which the prescribed waccm forcing data is fixed -if {{ hilight }}waccm_forcing_type{{ closehilight }} is 'FIXED'. -Default: 0 seconds - - - -Full pathname of time-variant boundary dataset for H2O production/loss rates. -Default: set by build-namelist. - - - - - -Determines which constituents are used from non-LTE calculations. -TRUE implies use prognostic constituents. -FALSE implies use constituents from dataset specified by {{ hilight }}waccm_forcing_file{{ closehilight }}. -Default: TRUE for full chemistry WACCM; FALSE for WACCM_SC. - - - -If TRUE apply upper limit to CO2 concentrations passed to the Formichev non-LTE cooling calculation -(code not intended for values greater than 720 ppmv). Running with flag set to TRUE could lead to -incorrect cooling rates if model CO2 exceeds 720 ppmv. If FALSE simulation will abort if CO2 levels -exceed this value at altitudes above 1 mbar. The 720 ppmv CO2 limiter in the Formichev non-LTE cooling -scheme is applied to all vertical levels regardless of this setting. -Default: FALSE - - - -TRUE implies assume cyclic qbo data. -Default: FALSE - - - -Filepath for qbo forcing dataset. -Default: Set by build-namelist. - - - -TRUE implies qbo package is active. -Default: FALSE - - - -If set this year is used for setting geomagnetic coordinates through out the -simulation. If not set the model simulation year is used. -Default: none - - - -International Geomagnetic Reference Field (IGRF) coefficients. -Default: None. - - - -Filepath input dataset for ionization due to energetic particle precipitation. -Default: None. - - -Variable name in netCDF file {{ hilight }}epp_all_filepath{{ closehilight }} which contains -ion pairs production rates. -Default: None. - - - -Filepath input dataset for ionization due to solar proton events. -Default: None. - - -Variable name in netCDF file {{ hilight }}epp_spe_filepath{{ closehilight }} which contains -ion pairs production rates. -Default: None. - - - -Filepath input dataset for ionization due to medium energy electrons. -Default: None. - - -Variable name in netCDF file {{ hilight }}epp_mee_filepath{{ closehilight }} which contains -ion pairs production rates. -Default: None. - - - -Filepath input dataset for ionization due to galactic cosmic rays. -Default: None. - - -Variable name in netCDF file {{ hilight }}epp_gcr_filepath{{ closehilight }} which contains -ion pairs production rates. -Default: None. - - - - - -Number of water tracers active in condensate-loading terms in dynamical core -1: water vapor only -2: water vapor and cloud liquid -3: water vapor, cloud liquid and cloud ice -4: water vapor, cloud liquid, cloud ice and rain -5: water vapor, cloud liquid, cloud ice, rain and snow -6: water vapor, cloud liquid, cloud ice, rain, snow and graupel -Default: 3 for CAM4, CAM5; 5 for CAM6; 1 for Held_Suarez, Adiabatic and Kessler - - - -Set for refined exodus meshes (variable viscosity). -Viscosity in namelist specified for regions with a resolution equivilant -to a uniform grid with se_ne = se_fine_ne. -Default: -1 (not used) - - - -CAM physics forcing option: -0: tendencies -1: adjustments -2: hybrid -Default: Set by build-namelist. - - - -Scalar viscosity with variable coefficient. -Use variable hyperviscosity based on element area limited by -se_max_hypervis_courant. -Default: 0 - - - -Use tensor hyperviscosity. -Citation: Guba, O., Taylor, M. A., Ullrich, P. A., Overfelt, J. R., and -Levy, M. N.: The spectral element method (SEM) on variable-resolution -grids: evaluating grid sensitivity and resolution-aware numerical -viscosity, Geosci. Model Dev., 7, 2803-2816, -doi:10.5194/gmd-7-2803-2014, 2014. -Default: 0 (i.e., not used) - - - -Number of hyperviscosity subcycles per dynamics timestep. -Default: Set by build-namelist - - - -Number of hyperviscosity subcycles done in tracer advection code. -The only supported value in CAM is 1. -Default: Set by build-namelist. - - - -Limiter used for horizontal tracer advection: -0: None -4: Sign-preserving limiter. -8: Monotone limiter. -Default: 8 - - - -Upper bound for Courant number, used to limit se_hypervis_power. -Default: 1.0e99 (i.e., not used) unless se_refined_mesh=TRUE - - - -Filename of exodus file to read grid from (generated by CUBIT or SQuadGen). -Default: "" - - - -Number of elements along a cube edge. -Must match value of grid. Set this to zero to use a refined mesh. -Default: Set by build-namelist. - - - -Number of PEs to be used by SE dycore. -Default: Number of PEs used by CAM. - - - -Number of dynamics steps per physics timestep. -Default: Set by build-namelist. - - - -Hyperviscosity coefficient for u,v, T [m^4/s]. -If < 0, se_nu is automatically set. -Default: Set by build-namelist. - - - -Hyperviscosity applied to divergence component of winds [m^4/s]. -If < 0, uses se_nu_p. -Default: Set by build-namelist. - - - -Hyperviscosity coefficient applied to pressure-level thickness [m^4/s]. -If < 0, se_nu_p is automatically set. -Default: Set by build-namelist. - - - -Second-order viscosity applied only near the model top [m^2/s]. -Default: Set by build-namelist. - - - -If TRUE hyperviscosity operators for u,v,T are applied on approximate pressure levels -If TRUE and se_nu_p>0 then hyperviscosity is also applied to difference between a -reference dp and dp -If FALSE all hyperviscosity operators are applied on eta levels -Default: TRUE - - - -Tracer advection is done every qsplit dynamics timesteps. -Default: Set by build-namelist. - - - -TRUE specified use of a refined grid (mesh) for this run. -Default: FALSE - - - -Vertically lagrangian code vertically remaps every rsplit tracer timesteps. -Default: Set by build-namelist. - - - -Frequency with which diagnostic output is written to log (output every -statefreq dynamics timesteps). -Default: Set by build-namelist. - - - -Time stepping method for SE dycore -se_tstep_type=1 RK2 followed by qsplit-1 Leapfrog steps; second-order accurate in time (CESM1.2.0 setting) -se_tstep_type=2 RK2-SSP 3 stage (as used by tracers) -se_tstep_type=3 classic Runga-Kutta (RK) 3 stage -se_tstep_type=4 Kinnmark&Gray Runga-Kutta (RK) 4 stage -Default: 4 - - - -Number of tracers to include in logfile diagnostics for SE dycore -Default: 3 - - - -CAM-SE vertical remap algorithm -0: Zerroukat monotonic splines -1: PPM vertical remap with mirroring at the boundaries - (solid wall bc's, high-order throughout) -2: PPM vertical remap without mirroring at the boundaries - (no bc's enforced, first-order at two cells bordering top and bottom - boundaries) -Default: Set by build-namelist. - - - -Set .true. to allow writing SE dynamics fields to the restart file using the -unstructured grid format. This allows the restart file to be used as an -initial file, but its use as a restart file will introduce roundoff size -differences into the simulation. -Default: .false. - - - - -Nudging factor for prescribed winds in SE dycore -Units: 1/sec -Default: 2e-5 - - - -Nudging factor for prescribed temperature in SE dycore -Units: 1/sec -Default: 2e-5 - - - -Nudging factor for prescribed surface pressure in SE dycore -Units: 1/sec -Default: 0.0 - - - -Switch to turn on/off time evolution of dynamics nudging -Default: 0 - - - - -Number of equally-spaced horizontal physics points per spectral -element. A number greater than zero will define [se_fv_nphys] equally -spaced physics points in each direction (e.g., se_fv_nphys = 3 will -result in 9 equally-spaced physics points per element). -Default: 0 = feature disabled, use dynamics GLL points. - - - - -If 'SCRIP', write a NetCDF file with the grid in SCRIP format. -If using a finite-volume physics grid, write the FVM grid, otherwise -write the native GLL grid. -Note that if this option is used, the simulation will exit after writing. -Default: 'no' - - - -Name of grid file to write if se_write_grid_file is set. -Default: Set according to active grid - - - -Set to true to write the SEMapping.nc file. -Default: .false. - - - -List of SCRIP grid filenames each representing a destination grid. If provided during a CAM simulation running the spectral element dycore, mapping files will be created from the native cubed-sphere grid to each destination grid. Both native mapping (using the internal spectral element basis functions) and bilinear maps are created. -Default: none - - - - -Number of threads to use for loops over elements. -Default: Set by build-namelist. - - - -Number of threads to use when processing vertical loops. Normally -equal to se_tracer_num_threads. -Default: Set by build-namelist. - - - -Number of threads to use when processing loops over threads. -Normally equal to se_vert_num_threads. -Default: Set by build-namelist. - - - - - -Specify the type of analytic initial conditions for an initial run. -held_suarez_1994: Initial conditions specified in Held and Suarez (1994) -moist_baroclinic_wave_dcmip2016: Moist baroclinic wave as used in the DCMIP 2016 experiments -dry_baroclinic_wave_dcmip2016: Dry baroclinic wave as used in the DCMIP 2016 experiments -dry_baroclinic_wave_jw2006: Dry baroclinic wave as specified in Jablonowski and Williamson (2006) -Default: 'none' - - - - - -Default: 4 - - - -Default: 1 - - - -Default: -1 - - - -Default: "netcdf" - - - -Default: .false. - - - -Default: 0 - - - -Default: -1 - - - -Default: 0 - - - -pio_rearranger = 1 for box rearranger - = 2 for subset rearranger -Default: box rearranger used by pio1, subset is default for pio2. - - - - - -Full pathname of docn restart file. -Default: set by build-namelist. - - - -Full pathname of docn restart file. -Default: set by build-namelist. - - - -Default: set by build-namelist. - - - -Default: set by build-namelist. - - - -Default: set by build-namelist. - - - -Default: set by build-namelist. - - - -Default: set by build-namelist. - - - -Default: set by build-namelist. - - - -Default: set by build-namelist. - - - -Default: set by build-namelist. - - - -Default: set by build-namelist. - - - -Default: set by build-namelist. - - - -Default: set by build-namelist. - - - - - - - -Full pathname of time-variant sea-surface temperature and sea-ice -concentration boundary dataset. -Default: set by build-namelist. - - - -Full pathname of -Default: set by build-namelist. - - - -Full pathname of grid file for time-variant sea-surface temperature and sea-ice -concentration boundary dataset. -Default: set by build-namelist. - - - - - - -The first year of the multi-year SST dataset which is read by CICE for -the prescribed ice fraction. This needs to be set for AMIP simulations. -Default: 0 - - - -The last year of the multi-year SST dataset which is read by CICE for -the prescribed ice fraction. This needs to be set for AMIP simulations. -Default: 0 - - - - - -Full pathname of master restart file from which to branch. Setting is -Required for branch run. -Default: none - - - -Flag for yearly cycling of SST data. If set to FALSE, a multi-year dataset -is assumed, otherwise a single-year dataset is assumed, and SSTs will be -cycled over the first 12 values in the file. This variable is only recognized -by the old CAM DOM component. -Default: TRUE - - - - - - -Name of file that the atmosphere component log messages will be written to. By -default all log messages are written to stdout. -Default: "" - - - -Absolute pathname of directory that the file specified by {{ hilight }}atm_logfile{{ closehilight }} -will be written to. -Default: "." - - - -Name of file that the driver component log messages will be written to. By -default all log messages are written to stdout. -Default: "" - - - -Absolute pathname of directory that the file specified by {{ hilight }}cpl_logfile{{ closehilight }} -will be written to. -Default: "." - - - -Name of file that the land component log messages will be written to. By -default all log messages are written to stdout. -Default: "" - - - -Absolute pathname of directory that the file specified by {{ hilight }}lnd_logfile{{ closehilight }} -will be written to. -Default: "." - - - -Name of file that the runoff component log messages will be written to. By -default all log messages are written to stdout. -Default: "" - - - -Absolute pathname of directory that the file specified by {{ hilight }}rof_logfile{{ closehilight }} -will be written to. -Default: "." - - - - - - - -Default: 1 - - - - - -Default: FALSE - - -Default: FALSE - - -Default: FALSE - - -Default: FALSE - -<<<<<<< HEAD -======= - ->>>>>>> origin/featureCESMNCARBeta_trunk2.0-7 - -Default: - - - - - -Stride used in selecting the processes in the atm communicator group. -Default: 1 - - - -Root process of the atm communicator group. -Default: 0 - - - -Number of atm tasks. -Default: total number of tasks assigned to job. - - - -Number of threads in each atm task. -Default: 1 - - - - -Stride used in selecting the processes in the ocn communicator group. -Default: 1 - - - -Root process of the ocn communicator group. -Default: 0 - - - -Number of ocn tasks. -Default: total number of tasks assigned to job. - - - -Number of threads in each ocn task. -Default: 1 - - - -Stride used in selecting the processes in the cpl communicator group. -Default: 1 - - - -Root process of the cpl communicator group. -Default: 0 - - - -Number of cpl tasks. -Default: total number of tasks assigned to job. - - - -Number of threads in each cpl task. -Default: 1 - - - - - -If true, run model in "aqua planet" mode. Only one of -{{ hilight }}atm_adiabatic{{ closehilight }}, {{ hilight }}atm_ideal_phys{{ closehilight }}, or -{{ hilight }}aqua_planet{{ closehilight }} can be true. -Default: FALSE - - - -Set the sst to a particular analytic solution. -Default: 1 - - - -If FALSE then CAM will set the deposition fluxes to zero before sending -them to the coupler. A side effect of setting the -variable {{ hilight }}chem_rad_passive{{ closehilight }} to TRUE is that this variable -will be set to FALSE (the deposition fluxes must be set to zero in order -for the chemistry not to impact the climate). -Default: TRUE - - - -bit for bit flag -Default: FALSE - - - -If TRUE, use the pre-existing case name for a branch run. -Default: FALSE - - - -annual budget level -Default: 1 - - - -daily budget level -Default: 0 - - - -instantaneous budget level -Default: 0 - - - -long term budget level written at end of year -Default: 1 - - - -long term budget level written at end of run -Default: 0 - - - -monthly budget level -Default: 1 - - - -Case title. -Default: none. - - - -cime model version. -Default: cesm. - - - -Enable cold air outbreak modification based on Mahrt and Sun, MWR, 1995. -Default: TRUE - - - -gust_fac value - for CESM is 0 -Default: 0. - - - -Case identifier. The value of {{ hilight }}case_name{{ closehilight }} is used in the -default filenames of both the history and restart files (see -the {{ hilight }}hfilename_spec{{ closehilight }} namelist option). The "%c" string in -the {{ hilight }}hfilename_spec{{ closehilight }} templates are expanded using the -value of {{ hilight }}case_name{{ closehilight }} when history filenames are created. -Default: set by build-namelist. - - - -Use netcdf 64 bit offset, large file support. -Default: FALSE - - - -T => do heat/water budget diagnostics -Default: FALSE - - - -T => enable run time setting of thread count for each component -Default: FALSE - - - -T => no diurnal cycle in ocn albedos. -Default: FALSE - - - -Selects E,P,R adjustment technique. -Default: 'off' - - - -Default: 5 - - - -Current machine. -Default: 'unknown' - - - -Debug flag. -Default: 1 - - - -Postfix for output log files. -Default: '.log' - - - -Model version. -Default: 'unknown' - - - -Coupler sequence option - CESM1_MOD_TIGHT is identical to old ocean_tight_coupling. -Default: 'CESM1_MOD_TIGHT' - - - -Earth's eccentricity of orbit. (unitless: typically 0. to 0.1). Setting is -Required if {{ hilight }}orb_iyear{{ closehilight }} not set. Not used when running -as part of CCSM. -Default: none - - - -Mode to specify how orbital parameters are to be set. -Not used when running as part of CCSM. -Default: fixed_year - - - -Year (AD) used to compute earth's orbital parameters. If not set, then use -the values from -the {{ hilight }}orb_eccen{{ closehilight }}, {{ hilight }}orb_mvelp{{ closehilight }}, -and {{ hilight }}orb_obliq{{ closehilight }} namelist parameters. If only -{{ hilight }}orb_iyear{{ closehilight }} is set, orbital parameters will be computed -automatically (based on Berger, 1977). If one -of {{ hilight }}orb_eccen{{ closehilight }}, {{ hilight }}orb_mvelp{{ closehilight }}, or -{{ hilight }}orb_obliq{{ closehilight }} is set, all three must be set. If all four of -the above are set by the user, {{ hilight }}orb_iyear{{ closehilight }} takes -precedence. Setting is Required -unless {{ hilight }}orb_eccen{{ closehilight }}, {{ hilight }}orb_mvelp{{ closehilight }}, -and {{ hilight }}orb_obliq{{ closehilight }} are set. Not used when running as part of -CCSM. -Default: 1990. - - - -Earth's moving vernal equinox at perihelion (degrees: 0. to 360.0). -Setting is Required if {{ hilight }}orb_iyear{{ closehilight }} not set. Not used -when running as part of CCSM. -Default: none - - - -Earth's orbital angle of obliquity (degrees: -90. to +90., typically 22. to 26.). -Setting is Required if {{ hilight }}orb_iyear{{ closehilight }} not set. Not used -when running as part of CCSM. -Default: none - - - -Root output files -Default: './' - - - -Set to TRUE to specify that the run will use a perpetual calendar, i.e., a -diurnal cycle will be present for the fixed calendar day specified -by {{ hilight }}perpetual_ymd{{ closehilight }}. -Default: FALSE - - - -Perpetual date encoded in an integer as (year*1000 + month*100 + day). -If {{ hilight }}aqua_planet{{ closehilight }} = .true. then perpetual_ymd is ignored -and the perpetual date is set to 321. -Default: none. - - - -Restart filename. -Default: none - - - -List of namelist variables that may be overridden on a restart run. -Default: none - - - -Restart pointer filename. -Default: 'rpointer.drv' - - - -are ocean and ice grids same lat/lon/size -Default: TRUE - - - -Latitude value of single column. -Default: none. - - - -Longitude value of single column. -Default: none. - - - -Set to TRUE to turn on single column mode. -Default: FALSE - - - -Run type. 'startup' is an initial run. 'continue' is a restart run. -'branch' is a restart run in which properties of the output history files -may be changed. -Default: 'startup' - - - -Current user. -Default: 'unknown' - - - -Invoke vector mapping option -Default: 'cart3d' - - - - - -Flag to indicate whether to use the double-double distributed sum algorithm -rather than the (almost) infinite precision reproducible distributed sum algorithm. -Default: FALSE - - - -Flag to indicate whether a distributed sum that violates the difference -tolerance specified by reprosum_diffmax should be recomputed using -a floating point-based (but nonscalable) reproducible algorithm. -Default: FALSE - - - -Relative difference between repro and nonrepro algorithms that will -generate a warning. This will also force a recompute using a nonscalable -algorithm if reprosum_recompute is true. If less than zero, then -the difference will not be evaluated (and the nonrepro algorithm will not -be computed). -Default: -1.0 - - - - - -Coupling interval between the atmosphere and other system components. This -is how frequently information can be communicated between the atmosphere -and the surface models. -Default: set by build-namelist. - - - -Calendar type "NO_LEAP" for consistent 365-days per year or "GREGORIAN" to -include leap-years. Note that if "GREGORIAN" is selected -leap-years will be used in the time manager, but the calculation of the -earth's orbit still assumes 365 day years. Valid values are "NO_LEAP" or -"GREGORIAN". -Default: "NO_LEAP" - - - -Write restart at end of run. -Default: TRUE - - - -Default: set by build-namelist. - - - -Default: - - - -Default: set by build-namelist. - - - -Default: - - - -Default: set by build-namelist. - - - -Default: - - - -Default: set by build-namelist. - - - -Default: - - - -Reference time-of-day expressed as seconds past midnight. Used in -conjuction with {{ hilight }}ref_ymd{{ closehilight }} to set the reference time. -Default: set to {{ hilight }}start_tod{{ closehilight }}. - - - -Reference date encoded in an integer as (year*1000 + month*100 + day). -Used in -conjuction with {{ hilight }}ref_tod{{ closehilight }} to set the reference time which -is used to define a time coordinate for the output history files. The -convention for the unit string of a time coordinate is of the form -"time-unit since reference-time", for example, "days since 1990-01-01 -00:00:00". The reference-time part of this string is specified by the -{{ hilight }}ref_ymd{{ closehilight }} and {{ hilight }}ref_tod{{ closehilight }} variables. - -Default: set to {{ hilight }}start_ymd{{ closehilight }}. - - - -Set the restart interval as a number of elapsed time units which are specified -by {{ hilight }}restart_option{{ closehilight }}. -Default: 1 - - - -Set the interval between writing restart files -using one of the options 'nsteps', -'ndays', 'nmonths', or 'nyears', in conjuction -with {{ hilight }}stop_n{{ closehilight }} to set the number of time units. -A convenience option allows specifying that restart files be written at the -end of each month or at the end of each year by using the options -'monthly' or 'yearly' respectively. It is also possible to request that no -restart files be written via the option 'none', or that restart files be -written only at the end of the run via the option 'end'. -Default: 'monthly' - - - -Start time-of-day expressed as seconds past midnight. Used in -conjuction with {{ hilight }}start_ymd{{ closehilight }} to set the start time. -Default: 0. - - - -Start date encoded in an integer as (year*1000 + month*100 + day). -Used in -conjuction with {{ hilight }}start_tod{{ closehilight }} to set the start date of -the simulation. -Default: set by build-namelist. - - - -Set the length of run as a number of elapsed time units which are specified -by {{ hilight }}stop_option{{ closehilight }}. -Default: 1 - - - -Set the length of run as an elapsed time using one of the options 'nsteps', -'ndays', 'nmonths', or 'nyears', in conjuction -with {{ hilight }}stop_n{{ closehilight }} to set the number of elapsed time units. -Alternatively, set the final simulation time in absolute terms by using the -option 'date' in conjuction with {{ hilight }}stop_ymd{{ closehilight }}, -and {{ hilight }}stop_tod{{ closehilight }} to specify a date and time of day at which -the simulation should stop. -Default: 'ndays' - - - -Stop time-of-day expressed as seconds past midnight. Used in -conjuction with {{ hilight }}stop_ymd{{ closehilight }} to set the stop time. -Default: 0. - - - -Stop date encoded in an integer as (year*1000 + month*100 + day). -Used in -conjuction with {{ hilight }}stop_tod{{ closehilight }} to set the stop date of -the simulation. -Default: none. - - - -This varible is only used internally by build-namelist to determine -appropriate defaults for climatological or transient forcing datasets. -Default: set by build-namelist. - - - - - - -Length of siderial day [seconds]. -Default: set to shr_const value - - - -Radius of Earth [m]. -Default: set to shr_const value - - - -Acceleration of gravity [m/s**2]. -Default: set to shr_const value - - - -Molecular weight of dry air [g/mol] -Default: set to shr_const value - - - -Heat capacity of dry air at constant pressure [J/kg/K]. -Default: set to shr_const value - - - -Molecular weight of water [g/mol]. -Default: set to shr_const value - - - -Heat capacity of water vapor at constant pressure [J/kg/K]. -Default: set to shr_const value - - - -Freezing point of water [K]. -Default: set to shr_const value - - - - - -Filepath for dataset for offline unit driver. -Default: none - - - -List of filepaths for dataset for offline unit driver. -Default: none - - - -<<<<<<< HEAD - -======= - - ->>>>>>> origin/featureCESMNCARBeta_trunk2.0-7 - diff --git a/cime_config/config_component.xml.orig b/cime_config/config_component.xml.orig deleted file mode 100644 index eebcc3df45..0000000000 --- a/cime_config/config_component.xml.orig +++ /dev/null @@ -1,361 +0,0 @@ - - - - - - - CAM cam6 physics: - CAM cam5 physics: - CAM cam4 physics: - CAM simplified and non-versioned physics : - - - abrupt quadrupling of CO2 with other forcings maintained at 1850 piControl levels (CMIP6 DECK abrupt4xCO2 experiment) : - ramped CO2 increasing by 1% per year with other forcings maintained at 1850 piControl levels (CMIP6 DECK 1pctCO2 experiment) : - - cam 5 physics and Production tagged aerosols (OSLO_AERO) - cam 6 and Production tagged aerosols (OSLO_AERO) - cam 5.4+Production tagged aerosols (OSLO_AERO)+clm5 - cam 5 physics and Production tagged aerosols (OSLO_AERO) - cam 6 (no clubb) physics and Production tagged aerosols (OSLO_AERO) - cam 6 physics and Production tagged aerosols (OSLO_AERO) - - - CAM stand-alone single column mode -- need to define usermods directory with IOP settings: - CAM winds and temperature nudged towards prescribed meteorology: - - CAM-Chem troposphere/stratosphere chem with simplified volatility basis set SOA scheme and modal aersols : - 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 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 CLUBB - CAM tropospheric chemistry with bulk aerosols: - - - WACCM with middle atmosphere chemistry: - WACCM with middle atmosphere chemistry with enhanced D-region ion chemistry: - WACCM-X enhanced ionosphere, transport, and electrodynamics: - WACCM-X enhanced ionosphere, transport, and electrodynamics with D-region ion chemistry: - WACCM specified chemistry: - WACCM with tropospheric, stratospheric, mesospheric, and lower thermospheric chemistry: - - - CAM dry adiabatic configurarion (no physics forcing): - 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 moist dynamical core test with Ullrich et al. (2014) baroclinic wave IC, Kessler physics and terminator chemistry: - - - CAM Parallel Offline Radiation Tool: - - - - char - cam - cam - case_comp - env_case.xml - Name of atmospheric component - - - - char - - UNSET - build_component_cam - env_build.xml - CAM cpp definitions (setup automatically - DO NOT EDIT) - - - - char - eul,fv,se - fv - - eul - se - - build_component_cam - env_build.xml - CAM dynamical core - - - - char - - - - -phys cam4 - -phys cam5 - -phys cam6 - - - -chem trop_strat_mam4_vbs - -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 trop_mam3 -spcam_nx 32 -spcam_ny 1 -spcam_dx 4000 -spcam_dt 20 -phys spcam_m2005 -spcam_clubb_sgs - -chem trop_mozart - - -co2_cycle - - - - -age_of_air_trcs - -chem waccm_ma - -chem waccm_ma_mam4 - -chem waccm_mad_mam4 - -chem waccm_sc_mam4 - -chem waccm_tsmlt_mam4 - -waccmx - -ionosphere wxie - -chem waccm_ma - -chem waccm_mad - -chem waccm_mad - - -offline_dyn - -nlev 56 - -nlev 56 - -nlev 88 - -nlev 145 - - - -analytic_ic - -phys adiabatic - -phys adiabatic - -phys tj2016 -analytic_ic - -phys held_suarez - -phys kessler -chem terminator -analytic_ic - - - -aquaplanet - -aquaplanet - - - -offline_drv rad - - -phys cam5 -chem trop_mam_oslo - -chem trop_mam_oslo - -chem trop_mam_oslo - - -phys cam5 -chem trop_mam_oslo -offline_dyn - -chem trop_mam_oslo -offline_dyn - -chem trop_mam_oslo -offline_dyn - - build_component_cam - env_build.xml - - CAM configure options, see CAM configure utility for details - Provides option(s) for the CAM configure utility. - CAM_CONFIG_OPTS are normally set as compset variables (e.g., -phys cam4 -chem waccm_ma) - and in general should not be modified for supported compsets. It is recommended that if you want - to modify this value for your experiment, you should use your own user-defined - component sets via using create_newcase with a compset_file argument - - - - - char - - UNSET - - 1850_cam4 - 1850_cam5 - - 1850_cam6 - waccm_tsmlt_1850_cam6 - waccm_ma_1850_cam6 - waccm_sc_1850_cam6 - - 2000_cam4_trop_chem - waccmxie_ma_2000_cam4 - - 2000_cam6 - waccm_tsmlt_2000_cam6 - waccm_ma_2000_cam6 - waccm_sc_2000_cam6 - 2000_trop_strat_vbs_cam6 - - aquaplanet_cam4 - aquaplanet_cam4 - aquaplanet_cam5 - aquaplanet_cam5 - aquaplanet_cam6 - aquaplanet_cam6 - - 2010_cam6 - 2010_trop_strat_vbs_cam6 - waccm_tsmlt_2010_cam6 - waccm_sc_2010_cam6 - - 1850-2005_cam5 - 1850-2005_cam4 - - 1850-2005_cam4 - 1850-2005_cam4_bgc - 1950-2010_ccmi_refc1_waccmx_ma - 1850-2005_cam5 - hist_cam6 - waccm_tsmlt_hist_cam6 - waccm_sc_hist_cam6 - waccm_ma_hist_cam6 - waccm_ma_hist_cam6 - waccm_ma_hist_cam4 - hist_trop_strat_vbs_cam6 - hist_trop_strat_vbsext_cam6 - hist_trop_strat_vbsfire_cam6 - - 1850-PD_cam5 - - 2005-2100_cam4_rcp26 - 2005-2100_cam4_rcp45 - 2005-2100_cam4_rcp45_bgc - 2005-2100_cam4_rcp60 - 2005-2100_cam4_rcp85 - 2005-2100_cam4_rcp85_bgc - - 2006-2100_cam5_rcp26 - 2006-2100_cam5_rcp45 - 2006-2100_cam5_rcp60 - 2006-2100_cam5_rcp85 - - sd_waccmx_ma_cam4 - sd_waccmx_ma_cam4 - sd_waccm_tsmlt_cam6 - sd_waccm_ma_cam6 - sd_waccm_ma_cam6 - sd_waccm_ma_cam4 - sd_trop_strat_vbs_cam6 - sd_cam6 - - dabi_p2004 - held_suarez_1994 - dctest_tj2016 - dctest_baro_kessler - - - scam_arm97 - 2000_cam6_noclb - 1850_cam54_ptaero - 2000_cam6_noclb_oslo - 2000_cam6_oslo - 1850_cam6_oslo - hist_cam6_oslo - 2000_cam5_oslonudge - cam5_nudge_ptaero_up1 - 2000_cam6_noclb_oslonudge - 2000_cam6_oslonudge - 2000_cam5_oslonudge - cam5_ptaero_up1 - - run_component_cam - env_run.xml - CAM namelist use_case. Provides the use_case option for the - CAM build-namelist utility (which is called from - $CASEROOT/Buildconf/cam.buildnml). The CAM build-namelist - leverages groups of namelist options (use cases) that are often - paired with the CAM configure options. These use cases are xml - files located in - $CIMEROOT/../components/atm/cam/bld/namelist_files/use_cases. - In general, this variable should not be modified for supported - component sets (compsets). Recommendation: If you want to - modify this value for your experiment, use your own user-defined - component sets. - - - - char - - - - scenario_ghg='RAMP_CO2_ONLY'ramp_co2_annual_rate=1 - co2vmr=1138.8e-6 - flbc_cycle_yr=1 - flbc_file='$DIN_LOC_ROOT/atm/waccm/lb/LBC_CMIP6abrupt4xCO2_cyclicalYear1_0p5degLat_c180929.nc' - ncdata='$DIN_LOC_ROOT/atm/waccm/ic/b.e21.BW1850.f09_g17.CMIP6-piControl.001.cam.i.0070-01-01.abrupt4xCO2_c181003.nc' - nlte_limit_co2=.true. - flbc_type='SERIAL' - flbc_file='$DIN_LOC_ROOT/atm/waccm/lb/LBC_CMIP6_1pctCO2_y1-165_GlobAnnAvg_0p5degLat_c180929.nc' - flbc_list='CO2','CH4','N2O','CFC11eq','CFC12' - flbc_type='SERIAL' - flbc_cycle_yr=-1 - flbc_file='$DIN_LOC_ROOT/atm/waccm/lb/LBC_CMIP6_1pctCO2ramp_y1-165_0p5degLat_c180930.nc' - nlte_limit_co2=.true. - co2_cycle_rad_passive=.true. -<<<<<<< HEAD - - ncdata='$DIN_LOC_ROOT/cesm2_init/f.e20.FWSD.f09_f09_mg17.262/2005-01-01/f.e20.FWSD.f09_f09_mg17.262.cam.i.2005-01-01-00000.nc' - - dms_source='ocean_flux' - co2_cycle_rad_passive=.true.,dms_source='ocean_flux' - dms_source='ocean_flux' -======= ->>>>>>> origin/featureCESMNCARBeta_trunk2.0-7 - - run_component_cam - env_run.xml - CAM specific namelist settings for -namelist option Provides - options to the -namelist argument for the CAM build-namelist - utility. This should be reserved for component set - specification. Users should modify CAM namelists only via the - $CASEROOT/user_nl_cam file. - - - - char - - - - $SRCROOT/components/cam/cime_config/usermods_dirs/aquap - $SRCROOT/components/cam/cime_config/usermods_dirs/aquap - $SRCROOT/components/cam/cime_config/usermods_dirs/waccmx - $SRCROOT/components/cam/cime_config/usermods_dirs/scam_mandatory - - run_component_cam - env_case.xml - User mods to apply to specific compset matches. - - - - ========================================= - CAM naming conventions - ========================================= - - - diff --git a/cime_config/config_compsets.xml.orig b/cime_config/config_compsets.xml.orig deleted file mode 100644 index 9f1ea689d9..0000000000 --- a/cime_config/config_compsets.xml.orig +++ /dev/null @@ -1,696 +0,0 @@ - - - - - - ========================================= - compset naming convention - ========================================= - The compset longname below has the specified order - atm, lnd, ice, ocn, river, glc wave cesm-options - - The notation for the compset longname is - TIME_ATM[%phys]_LND[%phys]_ICE[%phys]_OCN[%phys]_ROF[%phys]_GLC[%phys]_WAV[%phys][_BGC%phys] - Where for the CAM specific compsets below the following is supported - TIME = Time period (e.g. 2000, HIST, RCP8...) - ATM = [CAM40, CAM50, CAM60] - LND = [CLM45, CLM50, SLND] - ICE = [CICE, DICE, SICE] - OCN = [DOCN, ,AQUAP, SOCN] - ROF = [RTM, SROF] - GLC = [CISM1, CISM2, SGLC] - WAV = [SWAV] - BGC = optional BGC scenario - - The OPTIONAL %phys attributes specify submodes of the given system - For example DOCN%DOM is the data ocean model for DOCN - ALL the possible %phys choices for each component are listed - with the -list command for create_newcase - ALL data models must have a %phys option that corresponds to the data model mode - - Each compset node is associated with the following elements - - lname - - alias - - support (optional description of the support level for this compset) - Each compset node can also have the following attributes - - grid (optional regular expression match for grid to work with the compset) - - - - - - - - F2000climo - 2000_CAM60_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV - - - - - FHIST - HIST_CAM60_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV - - - - - FHIST_BGC - HIST_CAM60_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV - - - - - - - NF2000climo - 2000_CAM60%PTAERO_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV - - - - - - - FDABIP04 - 2000_CAM%DABIP04_SLND_SICE_SOCN_SROF_SGLC_SWAV - - - - - - - FSCAM - 2000_CAM60%SCAM_CLM50%SP_CICE%PRES_DOCN%DOM_SROF_SGLC_SWAV - - - - - FHS94 - 2000_CAM%HS94_SLND_SICE_SOCN_SROF_SGLC_SWAV - - - - - - - - - QPC6 - 2000_CAM60_SLND_SICE_DOCN%AQP3_SROF_SGLC_SWAV - - - - - - QSC6 - 2000_CAM60_SLND_SICE_DOCN%SOMAQP_SROF_SGLC_SWAV - - - - - - - - - - F2010climo - 2010_CAM60_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV - - - - F1850 - 1850_CAM60_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV - - - - FSPCAMM - 2000_CAM%SPCAMM_CLM50%SP_CICE%PRES_DOCN%DOM_RTM_SGLC_SWAV - - - - FSPCAMS - 2000_CAM%SPCAMS_CLM50%SP_CICE%PRES_DOCN%DOM_RTM_SGLC_SWAV - - - - F1850_BDRD - 1850_CAM60_CLM50%BGC_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV_BGC%BDRD - - - - FHIST_BDRD - HIST_CAM60_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV_BGC%BDRD - - - - - - FADIAB - 2000_CAM%ADIAB_SLND_SICE_SOCN_SROF_SGLC_SWAV - - - - - FHIST_DARTC6 - HIST_CAM60_CLM50%SP_CICE%PRES_DOCN%DOM_SROF_SGLC_SWAV - - - - FTJ16 - 2000_CAM%TJ16_SLND_SICE_SOCN_SROF_SGLC_SWAV - - - - FKESSLER - 2000_CAM%KESSLER_SLND_SICE_SOCN_SROF_SGLC_SWAV - - - - - PC4 - 2000_CAM40%PORT_SLND_SICE_SOCN_SROF_SGLC_SWAV - - - - PC5 - 2000_CAM50%PORT_SLND_SICE_SOCN_SROF_SGLC_SWAV - - - - PC6 - 2000_CAM60%PORT_SLND_SICE_SOCN_SROF_SGLC_SWAV - - - - - - - - - - FSPCAMCLBS - 2000_CAM%SPCAMCLBS_CLM50%SP_CICE%PRES_DOCN%DOM_RTM_SGLC_SWAV - - - - FSPCAMCLBM - 2000_CAM%SPCAMCLBM_CLM50%SP_CICE%PRES_DOCN%DOM_RTM_SGLC_SWAV - - - - - - - FC2000climo - 2000_CAM60%CCTS_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV - - - - FC2010climo - 2010_CAM60%CCTS_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV - - - - FCHIST - HIST_CAM60%CCTS_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV - - - FCvbsxHIST - HIST_CAM60%CVBSX_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV - - - FCfireHIST - HIST_CAM60%CFIRE_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV - - - - FCSD - HIST_CAM60%CCTS%SDYN_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV - - - - FSD - HIST_CAM60%SDYN_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV - - - - FMOZ - 2000_CAM40%TMOZ_CLM45%SP_CICE%PRES_DOCN%DOM_RTM_SGLC_SWAV - - - - - - QPC4 - 2000_CAM40_SLND_SICE_DOCN%AQP3_SROF_SGLC_SWAV - - - - QPC5 - 2000_CAM50_SLND_SICE_DOCN%AQP3_SROF_SGLC_SWAV - - - - QSC4 - 2000_CAM40_SLND_SICE_DOCN%SOMAQP_SROF_SGLC_SWAV - - - - QSC5 - 2000_CAM50_SLND_SICE_DOCN%SOMAQP_SROF_SGLC_SWAV - - - - QSC6O - 2000_CAM60%PTAERO_SLND_SICE_DOCN%SOMAQP_SROF_SGLC_SWAV - - - - NFPTAERO - 2000_CAM5%PTAEROUPD1_CLM40%SP_CICE%PRES_DOCN%DOM_RTM_SGLC_SWAV - - - NFPTAERO60 - - 2000_CAM60%PTAERO_CLM50%BGC_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV - - - NFPTAERO60NC - 2000_CAM54%PTAERO_CLM50%SP_CICE%PRES_DOCN%DOM_RTM_SGLC_SWAV - - - NFAMIPNUDGEPTAEROUPD1 - 2000_CAM5%NUDGEPTAEROUPD1_CLM45%SP_CICE%PRES_DOCN%DOM_RTM_SGLC_SWAV - - - NFAMIPNUDGEPTAERONCLB - 2000_CAM54%NUDGEPTAERO_CLM50%SP_CICE%PRES_DOCN%DOM_RTM_SGLC_SWAV - - - NFAMIPNUDGEPTAEROCLB - 2000_CAM60%NUDGEPTAERO_CLM50%SP_CICE%PRES_DOCN%DOM_RTM_SGLC_SWAV - - - - - - - - - - FWHIST - HIST_CAM60%WCTS_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV - - - - - FWHIST_BGC - HIST_CAM60%WCTS_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV - - - - - FWsc2010climo - 2010_CAM60%WCSC_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV - - - - - FWsc2000climo - 2000_CAM60%WCSC_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV - - - - - FWsc1850 - 1850_CAM60%WCSC_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV - - - - - FWscHIST - HIST_CAM60%WCSC_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV - - - - - FW1850 - 1850_CAM60%WCTS_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV - - - - - - - - - FW2000climo - 2000_CAM60%WCTS_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV - - - - FW2010climo - 2010_CAM60%WCTS_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV - - - - FWSD - HIST_CAM60%WCTS%SDYN_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV - - - - - - - - - FWmaHIST - HIST_CAM60%WCCM_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV - - - - FWmaSD - HIST_CAM60%WCCM%SDYN_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV - - - - FWmadHIST - HIST_CAM60%WCMD_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV - - - - FWmadSD - HIST_CAM60%WCMD%SDYN_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV - - - - FW4madHIST - HIST_CAM40%WCMD_CLM50%SP_CICE%PRES_DOCN%DOM_RTM_SGLC_SWAV - - - FW4madSD - HIST_CAM40%WCMD%SDYN_CLM50%SP_CICE%PRES_DOCN%DOM_RTM_SGLC_SWAV - - - - - - - - FX2000 - 2000_CAM40%WXIE_CLM50%SP_CICE%PRES_DOCN%DOM_RTM_SGLC_SWAV - - - - FXHIST - HIST_CAM40%WXIE_CLM50%SP_CICE%PRES_DOCN%DOM_RTM_SGLC_SWAV - - - - FXmadHIST - HIST_CAM40%WXIED_CLM50%SP_CICE%PRES_DOCN%DOM_RTM_SGLC_SWAV - - - - FXSD - HIST_CAM40%WXIE%SDYN_CLM50%SP_CICE%PRES_DOCN%DOM_RTM_SGLC_SWAV - - - - FXmadSD - HIST_CAM40%WXIED%SDYN_CLM50%SP_CICE%PRES_DOCN%DOM_RTM_SGLC_SWAV - - - - - - - - - 1997-06-18 - 1979-01-01 - 2000-01-01 - 1979-01-01 - 1950-01-01 - 1995-01-01 - 1995-01-01 - 1995-01-01 - 2005-01-01 - 2005-01-01 - 2010-01-01 - 2000-01-01 - - 2004-01-01 - 1950-01-01 - - - - - - 84585 - - - - - - - 288 - - - - - - TRUE - - - - - - - GREGORIAN - GREGORIAN - - - - - $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_48x96_clim_c050526.nc - $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_1.9x2.5_clim_c061031.nc - $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_0.9x1.25_clim_c040926.nc - $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_0.47x0.63_clim_c061106.nc - $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_0.23x0.31_clim_c110526.nc - - $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_1x1_1850_2017_c180507.nc - $DIN_LOC_ROOT/atm/cam/sst/"sst_HadOIBl_bc_48x96_1850_2017_c180507.nc - $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_1.9x2.5_1850_2017_c180507.nc - $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_0.9x1.25_1850_2017_c180507.nc - $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_0.47x0.63_1850_2017_c180507.nc - $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_0.23x0.31_1850_2017_c180507.nc - - $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_1x1_clim_pi_c101029.nc - $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_48x96_clim_pi_c101028.nc - $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_1.9x2.5_clim_pi_c101028.nc - $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_0.9x1.25_clim_pi_c101028.nc - $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_0.47x0.63_clim_pi_c101028.nc - $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_0.23x0.31_clim_pi_c101028.nc - - $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_1x1_2000climo_c180511.nc - $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_48x96_2000climo_c180511.nc - $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_1.9x2.5_2000climo_c180511.nc - $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_0.9x1.25_2000climo_c180511.nc - $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_0.47x0.63_2000climo_c180511.nc - $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_0.23x0.31_2000climo_c180511.nc - - $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_0.9x1.25_clim_c040926.nc - $DIN_LOC_ROOT/atm/cam/sst/f2000.waccm-mam3_1.9x2.5_L70.cam2.i.0017-01-01.c120410.nc - - $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_1x1_2010climo_c180511.nc - $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_48x96_2010climo_c180511.nc - $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_1.9x2.5_2010climo_c180511.nc - $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_0.9x1.25_2010climo_c180511.nc - $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_0.47x0.63_2010climo_c180511.nc - $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_0.23x0.31_2010climo_c180511.nc - - - - - - $DIN_LOC_ROOT/atm/cam/ocnfrac/domain.camocn.48x96_gx3v7_100114.nc - $DIN_LOC_ROOT/atm/cam/ocnfrac/domain.camocn.1.9x2.5_gx1v6_090403.nc - $DIN_LOC_ROOT/atm/cam/ocnfrac/domain.camocn.0.9x1.25_gx1v6_090403.nc - $DIN_LOC_ROOT/share/domains/domain.ocn.fv0.9x1.25_gx1v7.151020.nc - $DIN_LOC_ROOT/atm/cam/ocnfrac/domain.camocn.0.47x0.63_gx1v6_090408.nc - $DIN_LOC_ROOT/atm/cam/ocnfrac/domain.camocn.0.23x0.31_gx1v6_101108.nc - $DIN_LOC_ROOT/ocn/docn7/domain.ocn.1x1.111007.nc - $DIN_LOC_ROOT/atm/cam/ocnfrac/domain.camocn.48x96_gx3v7_100114.nc - $DIN_LOC_ROOT/atm/cam/ocnfrac/domain.camocn.1.9x2.5_gx1v6_090403.nc - $DIN_LOC_ROOT/atm/cam/ocnfrac/domain.camocn.0.9x1.25_gx1v6_090403.nc - $DIN_LOC_ROOT/share/domains/domain.ocn.fv0.9x1.25_gx1v7.151020.nc - $DIN_LOC_ROOT/atm/cam/ocnfrac/domain.camocn.0.47x0.63_gx1v6_090408.nc - $DIN_LOC_ROOT/atm/cam/ocnfrac/domain.camocn.0.23x0.31_gx1v6_101108.nc - $DIN_LOC_ROOT/ocn/docn7/domain.ocn.1x1.111007.nc - $DIN_LOC_ROOT/atm/cam/ocnfrac/domain.camocn.48x96_gx3v7_100114.nc - $DIN_LOC_ROOT/atm/cam/ocnfrac/domain.camocn.1.9x2.5_gx1v6_090403.nc - $DIN_LOC_ROOT/atm/cam/ocnfrac/domain.camocn.0.9x1.25_gx1v6_090403.nc - $DIN_LOC_ROOT/share/domains/domain.ocn.fv0.9x1.25_gx1v7.151020.nc - $DIN_LOC_ROOT/atm/cam/ocnfrac/domain.camocn.0.47x0.63_gx1v6_090408.nc - $DIN_LOC_ROOT/atm/cam/ocnfrac/domain.camocn.0.23x0.31_gx1v6_101108.nc - - - - - 2016 - - - - - - hybrid - hybrid - hybrid - hybrid - hybrid - - hybrid - hybrid - hybrid - - - - - - b.e20.BHIST.f09_g17.20thC.297_01_v2 - b.e20.BHIST.f09_g17.20thC.297_01_v2 - b.e20.BHIST.f09_g17.20thC.297_01_v2 - b.e16.B1850_WW3.f09_g16.lang_redi_2hr_frz_chl.003 - b.e20.B1850.f09_g16.pi_control.all.123 - - b.e16.B1850_WW3.f09_g16.lang_redi_2hr_frz_chl.003 - b.e20.B1850.f09_g16.pi_control.all.123 - b.e21.BWHIST.f09_g17.CMIP6-historical-WACCM.001 - - - - - -<<<<<<< HEAD - 1979-01-01 - 2000-01-01 - 2000-01-01 -======= - 1979-01-01 - 2000-01-01 ->>>>>>> origin/featureCESMNCARBeta_trunk2.0-7 - 0097-01-01 - 0010-01-01 - 0097-01-01 - 0010-01-01 - 1950-01-01 - - - - - -<<<<<<< HEAD - cesm2_init - cesm2_init - cesm2_init - cesm2_init -======= - cesm2_init - cesm2_init ->>>>>>> origin/featureCESMNCARBeta_trunk2.0-7 - cesm2_init - - - - - - 1 - 1 - - - - - - 1 - 1 - - - - - - 1 - 1 - - - - - - 1 - 1 - - - - - - 1 - 1 - - - - - - 1 - 1 - - - - - - 1 - 1 - - - - - - 1 - 1 - - - - - - 1 - 1 - - - - - - 1 - 1 - - - - - - - - TRUE - - - - - - 36.6 - - - - - - 262.5 - - - - - - diff --git a/src/chemistry/mozart/mo_gas_phase_chemdr.F90.orig b/src/chemistry/mozart/mo_gas_phase_chemdr.F90.orig deleted file mode 100644 index afcb13da0e..0000000000 --- a/src/chemistry/mozart/mo_gas_phase_chemdr.F90.orig +++ /dev/null @@ -1,1175 +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 - - 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/mozart/mo_waccm_hrates.F90.orig b/src/chemistry/mozart/mo_waccm_hrates.F90.orig deleted file mode 100644 index 5e7b8a8405..0000000000 --- a/src/chemistry/mozart/mo_waccm_hrates.F90.orig +++ /dev/null @@ -1,461 +0,0 @@ - - module mo_waccm_hrates - - use shr_kind_mod, only : r8 => shr_kind_r8 - use cam_logfile, only : iulog - use physics_buffer, only : pbuf_get_index, pbuf_get_field - - implicit none - - save - - real(r8), parameter :: secpday = 86400._r8 - real(r8), parameter :: daypsec = 1._r8/secpday - real(r8), parameter :: aur_therm = 807._r8 - real(r8), parameter :: jkcal = 4184._r8 - real(r8), parameter :: aur_heat_eff = .05_r8 - real(r8), parameter :: aur_hconst = 1.e3_r8*jkcal*aur_therm*aur_heat_eff - - real(r8) :: max_zen_angle - - private - public :: waccm_hrates, init_hrates, has_hrates - - integer :: id_co2, id_o2, id_o3, id_o2_1d, id_o2_1s, id_o1d, id_h2o, id_o, id_h - logical :: has_hrates - integer :: ele_temp_ndx, ion_temp_ndx - - contains - - subroutine init_hrates( ) - use mo_chem_utls, only : get_spc_ndx - use cam_history, only : addfld - use ref_pres, only : ptop_ref, psurf_ref - - - implicit none - - integer :: ids(9), err - character(len=128) :: attr ! netcdf variable attribute - - id_co2 = get_spc_ndx( 'CO2' ) - id_o2 = get_spc_ndx( 'O2' ) - id_o3 = get_spc_ndx( 'O3' ) - id_o2_1d = get_spc_ndx( 'O2_1D' ) - id_o2_1s = get_spc_ndx( 'O2_1S' ) - id_o1d = get_spc_ndx( 'O1D' ) - id_h2o = get_spc_ndx( 'H2O' ) - id_o = get_spc_ndx( 'O' ) - id_h = get_spc_ndx( 'H' ) - - ids = (/ id_co2, id_o2, id_o3, id_o2_1d, id_o2_1s, id_o1d, id_h2o, id_o, id_h /) - - has_hrates = all( ids(:) > 0 ) .and. ptop_ref < 0.0004_r8 * psurf_ref - - if (.not. has_hrates) return - - call addfld( 'CPAIR', (/ 'lev' /), 'I', 'J/K/kg', 'specific heat cap air' ) - call addfld( 'QRS_AUR', (/ 'lev' /), 'I', 'K/s', 'total auroral heating rate' ) - call addfld( 'QRS_CO2NIR', (/ 'lev' /), 'I', 'K/s', 'co2 nir heating rate' ) - call addfld( 'QTHERMAL', (/ 'lev' /), 'I', 'K/s', 'non-euv photolysis heating rate' ) - call addfld( 'QRS_MLT', (/ 'lev' /), 'I', 'K/s', 'Total heating rate (unmerged with tropospheric RT heating)' ) - - attr = 'O2 + hv -> O1D + O3P solar heating rate < 200nm' - call addfld( 'QRS_SO2A', (/ 'lev' /), 'I', 'K/s', trim(attr) ) - attr = 'O2 + hv -> O3P + O3P solar heating rate < 200nm' - call addfld( 'QRS_SO2B', (/ 'lev' /), 'I', 'K/s', trim(attr) ) - attr = 'O3 + hv -> O1D + O2_1S solar heating rate < 200nm' - call addfld( 'QRS_SO3A', (/ 'lev' /), 'I', 'K/s', trim(attr) ) - attr = 'O3 + hv -> O3P + O2 solar heating rate < 200nm' - call addfld( 'QRS_SO3B', (/ 'lev' /), 'I', 'K/s', trim(attr) ) - attr = 'O2 + hv -> 2*O3P solar heating rate > 200nm' - call addfld( 'QRS_LO2B', (/ 'lev' /), 'I', 'K/s', trim(attr) ) - attr = 'O3 + hv -> O1D + O2_1S solar heating rate > 200nm' - call addfld( 'QRS_LO3A', (/ 'lev' /), 'I', 'K/s', trim(attr) ) - attr = 'O3 + hv -> O3P + O2 solar heating rate > 200nm' - call addfld( 'QRS_LO3B', (/ 'lev' /), 'I', 'K/s', trim(attr) ) - attr = 'Total O3 solar heating > 200nm' - call addfld( 'QRS_LO3', (/ 'lev' /), 'I', 'K/s', trim(attr) ) - attr = 'total euv heating rate' - call addfld( 'QRS_EUV', (/ 'lev' /), 'I', 'K/s', trim(attr) ) - attr = 'total jo2 euv photolysis rate' - call addfld( 'JO2_EUV', (/ 'lev' /), 'I', '/s', trim(attr) ) - - ele_temp_ndx = pbuf_get_index('TElec',errcode=err)! electron temperature index - ion_temp_ndx = pbuf_get_index('TIon',errcode=err) ! ion temperature index - - end subroutine init_hrates - - subroutine waccm_hrates(ncol, state, asdir, bot_mlt_lev, qrs_tot, pbuf ) -!----------------------------------------------------------------------- -! ... computes the short wavelength heating rates -!----------------------------------------------------------------------- - - use chem_mods, only : nabscol, nfs, gas_pcnst, rxntot, indexm - use ppgrid, only : pcols, pver - use physconst, only : rga, mbarv, cpairv - use constituents, only : pcnst - use mo_gas_phase_chemdr,only: map2chm - use mo_photo, only : set_ub_col, setcol - use mo_jlong, only : jlong - use mo_jshort, only : jshort - use mo_jeuv, only : heuv - use mo_cph, only : cph - use mo_heatnirco2, only : heatnirco2 - use mo_airglow, only : airglow - use mo_aurora, only : aurora - use mo_setrxt, only : setrxt_hrates - use mo_adjrxt, only : adjrxt - use mo_usrrxt, only : usrrxt_hrates - use mo_setinv, only : setinv - use mo_mass_xforms, only : mmr2vmr - use physics_types, only : physics_state - 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 set_cp, only : calc_cp - use cam_history, only : outfld - use shr_orb_mod, only : shr_orb_decl - use time_manager, only : get_curr_calday - use cam_control_mod, only : lambm0, eccen, mvelpp, obliqr - use mo_constants, only : r2d - use short_lived_species,only: get_short_lived_species - use physics_buffer, only : physics_buffer_desc - use phys_control, only : waccmx_is - use orbit, only : zenith - -!----------------------------------------------------------------------- -! ... dummy arguments -!----------------------------------------------------------------------- - integer, intent(in) :: ncol ! number columns in chunk - type(physics_state),target, intent(in) :: state ! physics state structure - real(r8), intent(in) :: asdir(pcols) ! shortwave, direct albedo - integer, intent(in) :: bot_mlt_lev ! lowest model level where MLT heating is needed - real(r8), intent(out) :: qrs_tot(pcols,pver) ! total heating (K/s) - type(physics_buffer_desc), pointer :: pbuf(:) - -!----------------------------------------------------------------------- -! ... local variables -!----------------------------------------------------------------------- - integer :: lchnk ! chunk index - real(r8), parameter :: m2km = 1.e-3_r8 - real(r8), parameter :: Pa2mb = 1.e-2_r8 - - integer :: i, k, m, n - integer :: kbot_hrates - real(r8) :: esfact - real(r8) :: sza ! solar zenith angle (degrees) - 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) :: vmr(ncol,pver,gas_pcnst) ! xported species (vmr) - real(r8) :: reaction_rates(ncol,pver,rxntot) ! reaction rates - real(r8) :: mmr(pcols,pver,gas_pcnst) ! chem working concentrations (kg/kg) - real(r8) :: h2ovmr(ncol,pver) ! water vapor concentration (mol/mol) - real(r8) :: mbar(ncol,pver) ! mean wet atmospheric mass (kg/mole) - real(r8) :: zmid(ncol,pver) ! midpoint geopotential (km) - real(r8) :: cpair(ncol,pver) ! specific heat capacity (J/K/kg) - real(r8) :: cphrate(ncol,pver) ! chemical pot heat rate (K/s) - real(r8) :: aghrate(ncol,pver) ! airglow heat rate (K/s) - real(r8) :: qrs_col(pver,4) ! column thermal heating < 200nm - real(r8) :: qrl_col(pver,4) ! column thermal heating > 200nm - real(r8) :: qrs(ncol,pver,4) ! chunk thermal heating < 200nm - real(r8) :: qrl(ncol,pver,4) ! chunk thermal heating > 200nm - real(r8) :: euv_hrate_col(pver) ! column euv thermal heating rate - real(r8) :: co2_hrate_col(pver) ! column co2 nir heating rate - real(r8) :: euv_hrate(ncol,pver) ! chunk euv thermal heating rate - real(r8) :: aur_hrate(ncol,pver) ! chunk auroral heating rate - real(r8) :: co2_hrate(ncol,pver) ! chunk co2 nir heating rate - real(r8) :: colo3(pver) ! vertical o3 column density - real(r8) :: zarg(pver) ! vertical height array - real(r8) :: parg(pver) ! vertical pressure array (hPa) - real(r8) :: tline(pver) ! vertical temperature array - real(r8) :: eff_alb(pver) ! albedo - real(r8) :: mw(pver) ! atms molecular weight - real(r8) :: n2_line(pver) ! n2 density (mol/mol) - real(r8) :: o_line(pver) ! o density (mol/mol) - real(r8) :: o2_line(pver) ! o2 density (mol/mol) - real(r8) :: o3_line(pver) ! o3 density (mol/mol) - real(r8) :: co2_line(pver) ! co2 density (mol/mol) - real(r8) :: scco2(pver) ! co2 slant column concentration (molec/cm^2) - real(r8) :: scco2i(pver) ! co2 slant column concentration (molec/cm^2) - real(r8) :: occ(pver) ! o density (molecules/cm^3) - real(r8) :: o2cc(pver) ! o2 density (molecules/cm^3) - real(r8) :: co2cc(pver) ! co2 density (molecules/cm^3) - real(r8) :: n2cc(pver) ! n2 density (molecules/cm^3) - real(r8) :: o3cc(pver) ! o3 density (molecules/cm^3) - real(r8) :: cparg(pver) ! specific heat capacity - real(r8) :: zen_angle(ncol) ! solar zenith angles (radians) - real(r8) :: zsurf(ncol) ! surface height (m) - real(r8) :: rlats(ncol) ! chunk latitudes (radians) - real(r8) :: rlons(ncol) ! chunk longitudes (radians) - real(r8) :: calday ! day of year - real(r8) :: delta ! solar declination (radians) - logical :: do_diag - - real(r8), pointer :: ele_temp_fld(:,:) ! electron temperature pointer - real(r8), pointer :: ion_temp_fld(:,:) ! ion temperature pointer - - 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 => state%t - ion_temp_fld => state%t - endif - - qrs_tot(:ncol,:) = 0._r8 - if (.not. has_hrates) return - -!------------------------------------------------------------------------- -! ... set maximum zenith angle - higher value for higher top model -!------------------------------------------------------------------------- - if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then - max_zen_angle = 116._r8 - else - max_zen_angle = 97.01_r8 ! degrees - endif - -!----------------------------------------------------------------------- -! ... get chunk latitudes and longitudes -!----------------------------------------------------------------------- - lchnk = state%lchnk - - 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 ) - -!----------------------------------------------------------------------- -! ... set lower limit for heating rates which is now dictated by radheat module -!----------------------------------------------------------------------- - kbot_hrates = bot_mlt_lev - kbot_hrates = min( kbot_hrates,pver ) -! write(iulog,*) 'hrates: kbot_hrates = ',kbot_hrates - -!----------------------------------------------------------------------- -! ... calculate cosine of zenith angle then cast back to angle -!----------------------------------------------------------------------- - calday = get_curr_calday() - call zenith( calday, rlats, rlons, zen_angle, ncol ) - zen_angle(:) = acos( zen_angle(:) ) - -!----------------------------------------------------------------------- -! ... map incoming concentrations to working array -!----------------------------------------------------------------------- - do m = 1,pcnst - n = map2chm(m) - if( n > 0 ) then - do k = 1,pver - mmr(:ncol,k,n) = state%q(:ncol,k,m) - end do - end if - end do - call get_short_lived_species( mmr, lchnk, ncol, pbuf ) - -!----------------------------------------------------------------------- -! ... set atmosphere mean mass -!----------------------------------------------------------------------- - if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then - do k = 1,pver - mbar(:ncol,k) = mbarv(:ncol,k,lchnk) - enddo - else - call set_mean_mass( ncol, mmr, mbar ) - endif -! -!----------------------------------------------------------------------- -! ... xform from mmr to vmr -!----------------------------------------------------------------------- - call mmr2vmr( mmr(:ncol,:,:), vmr(:ncol,:,:), mbar(:ncol,:), ncol ) -!----------------------------------------------------------------------- -! ... xform water vapor from mmr to vmr -!----------------------------------------------------------------------- - do k = 1,pver - h2ovmr(:ncol,k) = vmr(:ncol,k,id_h2o) - end do -!----------------------------------------------------------------------- -! ... xform geopotential height from m to km -! and pressure from Pa to mb -!----------------------------------------------------------------------- - zsurf(:ncol) = rga * state%phis(:ncol) - do k = 1,pver - zmid(:ncol,k) = m2km * (state%zm(:ncol,k) + zsurf(:ncol)) - end do - -!----------------------------------------------------------------------- -! ... set the "invariants" -!----------------------------------------------------------------------- - call setinv( invariants, state%t, h2ovmr, vmr, state%pmid, ncol, lchnk, pbuf ) - -!----------------------------------------------------------------------- -! ... set the column densities at the upper boundary -!----------------------------------------------------------------------- - call set_ub_col( col_delta, vmr, invariants, state%pint(:,1), state%pdel, ncol, lchnk ) - -!----------------------------------------------------------------------- -! ... set rates for "tabular" and user specified reactions -!----------------------------------------------------------------------- - do m = 1,rxntot - do k = 1,pver - reaction_rates(:,k,m) = 0._r8 - end do - end do - call setrxt_hrates( reaction_rates, state%t, invariants(1,1,indexm), ncol, kbot_hrates ) - call usrrxt_hrates( reaction_rates, state%t, ele_temp_fld, ion_temp_fld, & - h2ovmr, invariants(:,:,indexm), ncol, kbot_hrates ) - call adjrxt( reaction_rates, invariants, invariants(1,1,indexm), ncol,pver ) - -!----------------------------------------------------------------------- -! ... set cp array -!----------------------------------------------------------------------- - if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then - do k = 1, pver - cpair(:ncol,k) = cpairv(:ncol,k,lchnk) - enddo - else - call calc_cp( ncol, vmr, cpair ) - endif - - call outfld( 'CPAIR', cpair, ncol, lchnk ) -#ifdef HRATES_DEBUG - write(iulog,*) ' ' - write(iulog,*) '---------------------------------------------' - write(iulog,*) 'waccm_hrates: cp at lchnk = ',lchnk - write(iulog,'(1p,5g15.7)') cpair(1,:) - write(iulog,*) '---------------------------------------------' - write(iulog,*) ' ' -#endif - -!----------------------------------------------------------------------- -! ... set the earth-sun distance factor -!----------------------------------------------------------------------- - call shr_orb_decl( calday, eccen, mvelpp, lambm0, obliqr , & - delta, esfact ) -!----------------------------------------------------------------------- -! ... set the column densities -!----------------------------------------------------------------------- - call setcol( col_delta, col_dens, vmr, state%pdel, ncol ) -!----------------------------------------------------------------------- -! ... compute the thermal heating rates -!----------------------------------------------------------------------- - do m = 1,4 - do k = 1,pver - qrs(:,k,m) = 0._r8 - qrl(:,k,m) = 0._r8 - end do - end do - do k = 1,pver - euv_hrate(:,k) = 0._r8 - co2_hrate(:,k) = 0._r8 - end do -column_loop : & - do i = 1,ncol - sza = zen_angle(i)*r2d - if( sza < max_zen_angle ) then - zarg(:) = zmid(i,:) - parg(:) = Pa2mb*state%pmid(i,:) - colo3(:) = col_dens(i,:,1) - tline(:) = state%t(i,:) - eff_alb(:) = asdir(i) - o_line(:) = vmr(i,:,id_o) - o2_line(:) = vmr(i,:,id_o2) - co2_line(:) = vmr(i,:,id_co2) - n2_line(:) = 1._r8 - (o_line(:) + o2_line(:) + vmr(i,:,id_h)) - o3_line(:) = vmr(i,:,id_o3) - occ(:) = o_line(:) * invariants(i,:,indexm) - o2cc(:) = o2_line(:) * invariants(i,:,indexm) - co2cc(:) = co2_line(:) * invariants(i,:,indexm) - n2cc(:) = n2_line(:) * invariants(i,:,indexm) - o3cc(:) = o3_line(:) * invariants(i,:,indexm) - mw(:) = mbar(i,:) - cparg(:) = cpair(i,:) - do_diag = .false. - call jshort( pver, sza, o2_line, o3_line, o2cc, & - o3cc, tline, zarg, mw, qrs_col, & - cparg, lchnk, i, co2cc, scco2, do_diag ) - call jlong( pver, sza, eff_alb, parg, tline, & - mw, o2_line, o3_line, colo3, qrl_col, & - cparg, kbot_hrates ) - do m = 1,4 - qrs(i,pver:1:-1,m) = qrs_col(:,m) * esfact - end do - do m = 2,4 - qrl(i,:,m) = qrl_col(:,m) * esfact - end do - call heuv( pver, sza, occ, o2cc, n2cc, & - o_line, o2_line, n2_line, cparg, mw, & - zarg, euv_hrate_col, kbot_hrates ) - euv_hrate(i,:) = euv_hrate_col(:) * esfact - scco2i(1:pver) = scco2(pver:1:-1) - call heatnirco2( co2_line, scco2i, state%pmid(i,:kbot_hrates), co2_hrate_col, kbot_hrates, & - zarg, sza ) -#ifdef HRATES_DEBUG - write(iulog,*) '===================================' - write(iulog,*) 'hrates: diagnostics for heatco2nir' - write(iulog,*) 'hrates: co2_line' - write(iulog,'(1p,5g15.7)') co2_line(:) - write(iulog,*) 'hrates: scco2' - write(iulog,'(1p,5g15.7)') scco2i(:) - write(iulog,*) 'hrates: co2_hrate' - write(iulog,'(1p,5g15.7)') co2_hrate_col(:) - write(iulog,*) '===================================' -#endif - co2_hrate(i,:kbot_hrates) = co2_hrate_col(:kbot_hrates) * esfact * daypsec - end if - end do column_loop - - - call outfld( 'QRS_SO2A', qrs(:,:,1), ncol, lchnk ) - call outfld( 'QRS_SO2B', qrs(:,:,2), ncol, lchnk ) - call outfld( 'QRS_SO3A', qrs(:,:,3), ncol, lchnk ) - call outfld( 'QRS_SO3B', qrs(:,:,4), ncol, lchnk ) - call outfld( 'QRS_LO2B', qrl(:,:,2), ncol, lchnk ) - call outfld( 'QRS_LO3A', qrl(:,:,3), ncol, lchnk ) - call outfld( 'QRS_LO3B', qrl(:,:,4), ncol, lchnk ) - call outfld( 'QRS_LO3', qrl(:,:,3)+qrl(:,:,4), ncol, lchnk ) - call outfld( 'QRS_EUV', euv_hrate(:,:), ncol, lchnk ) - call outfld( 'QRS_CO2NIR', co2_hrate(:,:), ncol, lchnk ) - -!----------------------------------------------------------------------- -! ... chemical pot heating rate -!----------------------------------------------------------------------- - call cph( cphrate, vmr, reaction_rates, cpair, mbar, & - kbot_hrates, ncol, lchnk ) - -!----------------------------------------------------------------------- -! ... auroral ion production -!----------------------------------------------------------------------- - call aurora( state%t, mbar, rlats, & - aur_hrate, cpair, state%pmid, lchnk, calday, & - ncol, rlons, pbuf ) - do k = 1,pver - aur_hrate(:,k) = aur_hrate(:,k)/invariants(:,k,indexm) - end do - call outfld( 'QRS_AUR', aur_hrate(:,:), ncol, lchnk ) - -!----------------------------------------------------------------------- -! ... airglow heating rate -!----------------------------------------------------------------------- - call airglow( aghrate, vmr(1,1,id_o2_1s), vmr(1,1,id_o2_1d), vmr(1,1,id_o1d), reaction_rates, cpair, & - ncol, lchnk ) - -!----------------------------------------------------------------------- -! ... form total heating rate -!----------------------------------------------------------------------- - do k = 1,kbot_hrates - qrs_tot(:ncol,k) = qrs(:,k,1) + qrs(:,k,2) + qrs(:,k,3) + qrs(:,k,4) & - + qrl(:,k,1) + qrl(:,k,2) + qrl(:,k,3) + qrl(:,k,4) - end do - call outfld( 'QTHERMAL', qrs_tot, pcols, lchnk ) - do k = 1,kbot_hrates - qrs_tot(:ncol,k) = qrs_tot(:ncol,k) & - + cphrate(:,k) + euv_hrate(:,k) + aur_hrate(:,k) + co2_hrate(:,k) - end do - call outfld( 'QRS_MLT', qrs_tot, pcols, lchnk ) - - end subroutine waccm_hrates - - end module mo_waccm_hrates diff --git a/src/chemistry/oslo_aero/mo_gas_phase_chemdr.F90.orig b/src/chemistry/oslo_aero/mo_gas_phase_chemdr.F90.orig deleted file mode 100644 index f1b63cab39..0000000000 --- a/src/chemistry/oslo_aero/mo_gas_phase_chemdr.F90.orig +++ /dev/null @@ -1,1190 +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 - 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 -#ifdef OSLO_AERO - logical :: inv_o3, inv_oh, inv_no3, inv_ho2 - integer :: id_o3, id_oh, id_no3, id_ho2 -#endif -! -! 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(rxntot-phtcnt) :: rxn_names - character(len=fieldname_len),dimension(phtcnt) :: pht_names - 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_inv_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 - - implicit none - - character(len=3) :: string - integer :: n, m, err - logical :: history_cesm_forcing - logical :: history_aerosol ! Output the MAM aerosol tendencies - - !----------------------------------------------------------------------- - - call phys_getopts( convproc_do_aer_out = convproc_do_aer, history_cesm_forcing_out=history_cesm_forcing, & - history_aerosol_out = history_aerosol ) - -#if defined(OSLO_AERO) - inv_o3 = get_inv_ndx('O3') > 0 - inv_oh = get_inv_ndx('OH') > 0 - inv_no3 = get_inv_ndx('NO3') > 0 - inv_ho2 = get_inv_ndx('HO2') > 0 - if (inv_o3) then - id_o3 = get_inv_ndx('O3') - endif - if (inv_oh) then - id_oh = get_inv_ndx('OH') - endif - if (inv_no3) then - id_no3 = get_inv_ndx('NO3') - endif - if (inv_ho2) then - id_ho2 = get_inv_ndx('HO2') - endif -#endif - - 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' ) - else - call addfld( tag_names(n), (/ 'lev' /), 'I', '/cm3/s', 'reaction rate' ) - endif - enddo - - do n = 1,phtcnt - WRITE(UNIT=string, FMT='(I3.3)') n - pht_names(n) = 'J_' // trim(string) - call addfld( pht_names(n), (/ 'lev' /), 'I', '/s', 'photolysis rate' ) - enddo - - do n = 1,rxntot-phtcnt - WRITE(UNIT=string, FMT='(I3.3)') n - rxn_names(n) = 'R_' // trim(string) - call addfld( rxn_names(n), (/ 'lev' /), 'I', '/cm3/s', 'reaction rate' ) - 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 -#if (defined OSLO_AERO) - use oxi_diurnal_var, only : set_diurnal_invariants -#endif - 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 - use time_manager, only : is_first_step - - 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 .and. .not.is_first_step()) 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 - - 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 .and. nh_5_ndx>0 .and. nh_50_ndx>0 .and. 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_5_ndx) = 100.e-9_r8 - vmr(j,pver,nh_50_ndx) = 100.e-9_r8 - vmr(j,pver,nh_50w_ndx) = 100.e-9_r8 - vmr(j,pver,aoa_nh_ndx) = 0._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 ) - - !----------------------------------------------------------------------- -#if defined (OSLO_AERO) - ! ... Set the "day/night cycle for prescribed oxidants" - !----------------------------------------------------------------------- - if (inv_oh.or.inv_ho2) & - call set_diurnal_invariants(invariants,delt,ncol,lchnk,inv_oh,inv_ho2,id_oh,id_ho2) - -#endif - ! ... 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, ps, & - 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,rxntot - call outfld( rxn_names(i-phtcnt), reaction_rates(:,:,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( pht_names(i), reaction_rates(:ncol,:,i), ncol, lchnk ) - 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 - -! - - do i = phtcnt+1,rxt_tag_cnt - call outfld( tag_names(i), reaction_rates(:ncol,:,rxt_tag_map(i)), ncol, lchnk ) - enddo - - 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/control/cam_history.F90.orig b/src/control/cam_history.F90.orig deleted file mode 100644 index 0f08e35904..0000000000 --- a/src/control/cam_history.F90.orig +++ /dev/null @@ -1,5923 +0,0 @@ -module cam_history - !------------------------------------------------------------------------------------------- - ! - ! The cam_history module provides the user interface for CAM's history output capabilities. - ! It maintains the lists of fields that are written to each history file, and the associated - ! metadata for those fields such as descriptive names, physical units, time axis properties, - ! etc. It also contains the programmer interface which provides routines that are called from - ! the physics and dynamics initialization routines to define the fields that are produced by - ! the model and are available for output, and the routine that is called from the corresponding - ! run method to add the field values into a history buffer so that they may be output to disk. - ! - ! There are two special history files. The initial file and the satellite track file. - ! - ! Public functions/subroutines: - ! addfld, add_default - ! intht - ! history_initialized - ! write_restart_history - ! read_restart_history - ! outfld - ! wshist - !----------------------------------------------------------------------- - - use shr_kind_mod, only: r8 => shr_kind_r8, r4 => shr_kind_r4 - use shr_kind_mod, only: cl=>SHR_KIND_CL - use shr_sys_mod, only: shr_sys_flush - use spmd_utils, only: masterproc - use ppgrid, only: pcols, psubcols - use cam_instance, only: inst_suffix - use cam_control_mod, only: caseid, ctitle - use filenames, only: interpret_filename_spec - use cam_initfiles, only: ncdata, bnd_topo - use cam_abortutils, only: endrun - - use pio, only: file_desc_t, var_desc_t, pio_setframe, pio_write, & - pio_noerr, pio_bcast_error, pio_internal_error, & - pio_seterrorhandling, pio_get_var, pio_clobber, & - pio_int, pio_real, pio_double, pio_char, & - pio_offset_kind, pio_unlimited, pio_global, & - pio_inq_dimlen, pio_def_var, pio_enddef, & - pio_put_att, pio_put_var, pio_get_att - - - use perf_mod, only: t_startf, t_stopf - use cam_logfile, only: iulog - use cam_history_support, only: max_fieldname_len, fieldname_suffix_len, & - max_chars, ptapes, fieldname_len, & - max_string_len, date2yyyymmdd, pflds, & - fieldname_lenp2, sec2hms, & - field_info, active_entry, hentry, & - horiz_only, write_hist_coord_attrs, & - write_hist_coord_vars, interp_info_t, & - lookup_hist_coord_indices, get_hist_coord_index - use sat_hist, only: is_satfile - use solar_parms_data, only: solar_parms_on, kp=>solar_parms_kp, ap=>solar_parms_ap - use solar_parms_data, only: f107=>solar_parms_f107, f107a=>solar_parms_f107a, f107p=>solar_parms_f107p - use solar_wind_data, only: solar_wind_on, byimf=>solar_wind_byimf, bzimf=>solar_wind_bzimf - use solar_wind_data, only: swvel=>solar_wind_swvel, swden=>solar_wind_swden - use epotential_params, only: epot_active, epot_crit_colats - - implicit none - private - save - - ! Forward common parameters to present unified interface to cam_history - public :: fieldname_len, horiz_only - - ! - ! master_entry: elements of an entry in the master field list - ! - type master_entry - type (field_info) :: field ! field information - character(len=max_fieldname_len) :: meridional_field = '' ! for vector fields - character(len=max_fieldname_len) :: zonal_field = '' ! for vector fields - character(len=1) :: avgflag(ptapes) ! averaging flag - character(len=max_chars) :: time_op(ptapes) ! time operator (e.g. max, min, avg) - logical :: act_sometape ! Field is active on some tape - logical :: actflag(ptapes) ! Per tape active/inactive flag - integer :: htapeindx(ptapes)! This field's index on particular history tape - type(master_entry), pointer :: next_entry => null() ! The next master entry - end type master_entry - - type (master_entry), pointer :: masterlinkedlist => null() ! master field linkedlist top - - type master_list - type(master_entry), pointer :: thisentry => null() - end type master_list - - type (master_list), pointer :: masterlist(:) => null() ! master field array for hash lookup of field - - ! history tape info - type (active_entry), pointer :: tape(:) => null() ! history tapes - type (active_entry), target,allocatable :: history_tape(:) ! history tapes - type (active_entry), target, allocatable :: restarthistory_tape(:) ! restart history tapes - - type rvar_id - type(var_desc_t), pointer :: vdesc => null() - integer :: type - integer :: ndims - integer :: dims(4) - character(len=fieldname_lenp2) :: name - end type rvar_id - type rdim_id - integer :: len - integer :: dimid - character(len=fieldname_lenp2) :: name - end type rdim_id - ! - ! The size of these parameters should match the assignments in restart_vars_setnames and restart_dims_setnames below - ! - integer, parameter :: restartvarcnt = 38 - integer, parameter :: restartdimcnt = 10 - type(rvar_id) :: restartvars(restartvarcnt) - type(rdim_id) :: restartdims(restartdimcnt) - integer, parameter :: ptapes_dim_ind = 1 - integer, parameter :: max_string_len_dim_ind = 2 - integer, parameter :: fieldname_lenp2_dim_ind = 3 - integer, parameter :: pflds_dim_ind = 4 - integer, parameter :: max_chars_dim_ind = 5 - integer, parameter :: max_fieldname_len_dim_ind = 6 - integer, parameter :: maxnflds_dim_ind = 7 - integer, parameter :: maxvarmdims_dim_ind = 8 - integer, parameter :: registeredmdims_dim_ind = 9 - integer, parameter :: max_hcoordname_len_dim_ind = 10 - - integer :: nfmaster = 0 ! number of fields in master field list - integer :: nflds(ptapes) ! number of fields per tape - - ! per tape sampling frequency (0=monthly avg) - - integer :: idx ! index for nhtfrq initialization - integer :: nhtfrq(ptapes) = (/0, (-24, idx=2,ptapes)/) ! history write frequency (0 = monthly) - integer :: mfilt(ptapes) = 30 ! number of time samples per tape - integer :: nfils(ptapes) ! Array of no. of files on current h-file - integer :: ndens(ptapes) = 2 ! packing density (double (1) or real (2)) - integer :: ncprec(ptapes) = -999 ! netcdf packing parameter based on ndens - real(r8) :: beg_time(ptapes) ! time at beginning of an averaging interval - - logical :: rgnht(ptapes) = .false. ! flag array indicating regeneration volumes - logical :: hstwr(ptapes) = .false. ! Flag for history writes - logical :: empty_htapes = .false. ! Namelist flag indicates no default history fields - logical :: htapes_defined = .false. ! flag indicates history contents have been defined - - character(len=cl) :: model_doi_url = '' ! Model DOI - ! NB: This name must match the group name in namelist_definition.xml - character(len=*), parameter :: history_namelist = 'cam_history_nl' - character(len=max_string_len) :: hrestpath(ptapes) = (/(' ',idx=1,ptapes)/) ! Full history restart pathnames - character(len=max_string_len) :: nfpath(ptapes) = (/(' ',idx=1,ptapes)/) ! Array of first pathnames, for header - character(len=max_string_len) :: cpath(ptapes) ! Array of current pathnames - character(len=max_string_len) :: nhfil(ptapes) ! Array of current file names - character(len=1) :: avgflag_pertape(ptapes) = (/(' ',idx=1,ptapes)/) ! per tape averaging flag - character(len=16) :: logname ! user name - character(len=16) :: host ! host name - character(len=8) :: inithist = 'YEARLY' ! If set to '6-HOURLY, 'DAILY', 'MONTHLY' or - ! 'YEARLY' then write IC file - logical :: inithist_all = .false. ! Flag to indicate set of fields to be - ! included on IC file - ! .false. include only required fields - ! .true. include required *and* optional fields - character(len=fieldname_lenp2) :: fincl(pflds,ptapes) ! List of fields to add to primary h-file - character(len=max_chars) :: fincllonlat(pflds,ptapes) ! List of fields to add to primary h-file - character(len=fieldname_lenp2) :: fexcl(pflds,ptapes) ! List of fields to rm from primary h-file - character(len=fieldname_lenp2) :: fwrtpr(pflds,ptapes) ! List of fields to change default history output prec - character(len=fieldname_suffix_len ) :: fieldname_suffix = '&IC' ! Suffix appended to field names for IC file - - ! Parameters for interpolated output tapes - logical, public :: interpolate_output(ptapes) = .false. - ! The last two history files are not supported for interpolation - type(interp_info_t) :: interpolate_info(ptapes - 2) - - ! Allowed history averaging flags - ! This should match namelist_definition.xml => avgflag_pertape (+ ' ') - ! The presence of 'ABI' and 'XML' in this string is a coincidence - character(len=7), parameter :: HIST_AVG_FLAGS = ' ABIXML' - character(len=22) ,parameter :: LT_DESC = 'mean (over local time)' ! local time description - logical :: collect_column_output(ptapes) - - integer :: maxvarmdims=1 - ! -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! - ! Hashing. - ! - ! Accelerate outfld processing by using a hash function of the field name - ! to index masterlist and determine whehter the particular field is to - ! be written to any history tape. - ! - ! - ! Note: the outfld hashing logic will fail if any of the following are true: - ! - ! 1) The lower bound on the dimension of 'masterlist' is less than 1. - ! - ! 2) 'outfld' is called with field names that are not defined on - ! masterlist. This applies to both initial/branch and restart - ! runs. - ! - ! 3) An inconsistency between a field's tape active flag - ! 'masterlist(ff)%actflag(t)' and active fields read from - ! restart files. - ! - ! 4) Invoking function 'gen_hash_key' before the primary and secondary - ! hash tables have been created (routine bld_outfld_hash_tbls). - ! -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - ! - ! User definable constants for hash and overflow tables. - ! Define size of primary hash table (specified as 2**size). - ! - integer, parameter :: tbl_hash_pri_sz_lg2 = 16 - ! - ! Define size of overflow hash table % of primary hash table. - ! - integer, parameter :: tbl_hash_oflow_percent = 20 - ! - ! Do *not* modify the parameters below. - ! - integer, parameter :: tbl_hash_pri_sz = 2**tbl_hash_pri_sz_lg2 - integer, parameter :: tbl_hash_oflow_sz = tbl_hash_pri_sz * (tbl_hash_oflow_percent/100.0_r8) - ! - ! The primary and overflow tables are organized to mimimize space (read: - ! try to maximimze cache line usage). - ! - ! gen_hash_key(fieldname) will return an index on the interval - ! [0 ... tbl_hash_pri_sz-1]. - ! - ! - ! Primary: - ! gen_hash_key(fieldname)-------+ +----------+ - ! | | -ii | 1 ------>tbl_hash_oflow(ii) - ! | +----------+ - ! +--> | ff | 2 ------>masterlist(ff) - ! +----------+ - ! | | ... - ! +----------+ - ! | | tbl_hash_pri_sz - ! +----------+ - ! - ! Overflow (if tbl_hash_pri() < 0): - ! tbl_hash_pri(gen_hash_key(fieldname)) - ! | - ! | +----------+ - ! | | 1 | 1 (one entry on O.F. chain) - ! | +----------+ - ! | | ff_m | 2 - ! | +----------+ - ! +---------> | 3 | 3 (three entries on chain) - ! +----------+ - ! | ff_x | 4 - ! +----------+ - ! | ff_y | 5 - ! +----------+ - ! | ff_z | 6 - ! +----------+ - ! | | ... - ! +----------+ - ! | | tbl_hash_oflow_sz - ! +----------+ - ! - ! - integer, dimension(0:tbl_hash_pri_sz-1) :: tbl_hash_pri ! Primary hash table - integer, dimension(tbl_hash_oflow_sz) :: tbl_hash_oflow ! Overflow hash table - ! - ! Constants used in hashing function gen_hash_key. - ! Note: if the constants in table 'tbl_gen_hash_key' below are modified, - ! changes are required to routine 'gen_hash_key' because of specific - ! logic in the routine that optimizes character strings of length 8. - ! - - integer, parameter :: gen_hash_key_offset = z'000053db' - - integer, parameter :: tbl_max_idx = 15 ! 2**N - 1 - integer, dimension(0:tbl_max_idx) :: tbl_gen_hash_key = & - (/61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1/) - - ! - ! Filename specifiers for history, initial files and restart history files - ! (%c = caseid, $y = year, $m = month, $d = day, $s = seconds in day, %t = tape number) - ! - character(len=max_string_len) :: rhfilename_spec = '%c.cam.rh%t.%y-%m-%d-%s.nc' ! history restart - character(len=max_string_len) :: hfilename_spec(ptapes) = (/ (' ', idx=1, ptapes) /) ! filename specifyer - - - interface addfld - module procedure addfld_1d - module procedure addfld_nd - end interface - - ! Needed by cam_diagnostics - public :: inithist_all - - integer :: lcltod_start(ptapes) ! start time of day for local time averaging (sec) - integer :: lcltod_stop(ptapes) ! stop time of day for local time averaging, stop > start is wrap around (sec) - - ! Needed by stepon and cam_restart - public :: hstwr - public :: nfils, mfilt - - ! Functions - public :: history_readnl ! Namelist reader for CAM history - public :: init_restart_history ! Write restart history data - public :: write_restart_history ! Write restart history data - public :: read_restart_history ! Read restart history data - public :: wshist ! Write files out - public :: outfld ! Output a field - public :: intht ! Initialization - public :: history_initialized ! .true. iff cam history initialized - public :: wrapup ! process history files at end of run - public :: write_inithist ! logical flag to allow dump of IC history buffer to IC file - public :: addfld ! Add a field to history file - public :: add_default ! Add the default fields - public :: register_vector_field ! Register vector field set for interpolated output - public :: get_hfilepath ! Return history filename - public :: get_ptapes ! Return the number of tapes being used - public :: get_hist_restart_filepath ! Return the full filepath to the history restart file - public :: hist_fld_active ! Determine if a field is active on any history file - public :: hist_fld_col_active ! Determine if a field is active on any history file at - ! each column in a chunk - -CONTAINS - - subroutine intht (model_doi_url_in) - ! - !----------------------------------------------------------------------- - ! - ! Purpose: Initialize history file handler for initial or continuation run. - ! For example, on an initial run, this routine initializes "ptapes" - ! history files. On a restart or regeneration run, this routine - ! only initializes history files declared beyond what existed on the - ! previous run. Files which already existed on the previous run have - ! already been initialized (i.e. named and opened) in routine RESTRT. - ! - ! Method: Loop over tapes and fields per tape setting appropriate variables and - ! calling appropriate routines - ! - ! Author: CCM Core Group - ! - !----------------------------------------------------------------------- - use shr_sys_mod, only: shr_sys_getenv - use time_manager, only: get_prev_time, get_curr_time - use cam_control_mod, only: restart_run, branch_run - use sat_hist, only: sat_hist_init - use spmd_utils, only: mpicom, masterprocid, mpi_character - ! - !----------------------------------------------------------------------- - ! - ! Dummy argument - ! - character(len=cl), intent(in) :: model_doi_url_in - ! - ! Local workspace - ! - integer :: t, f ! tape, field indices - integer :: begdim1 ! on-node dim1 start index - integer :: enddim1 ! on-node dim1 end index - integer :: begdim2 ! on-node dim2 start index - integer :: enddim2 ! on-node dim2 end index - integer :: begdim3 ! on-node chunk or lat start index - integer :: enddim3 ! on-node chunk or lat end index - integer :: day, sec ! day and seconds from base date - integer :: rcode ! shr_sys_getenv return code - type(master_entry), pointer :: listentry - character(len=32) :: fldname ! temp variable used to produce a left justified field name - ! in the formatted logfile output - - ! - ! Save the DOI - ! - model_doi_url = trim(model_doi_url_in) - - ! - ! Print master field list - ! - - if (masterproc) then - write(iulog,*) ' ' - write(iulog,*)' ******* MASTER FIELD LIST *******' - end if - listentry=>masterlinkedlist - f=0 - do while(associated(listentry)) - f=f+1 - if(masterproc) then - fldname = listentry%field%name - write(iulog,9000) f, fldname, listentry%field%units, listentry%field%numlev, & - listentry%avgflag(1), trim(listentry%field%long_name) -9000 format(i5, 1x, a32, 1x, a16, 1x, i4, 1x, a1, 2x, a) - end if - listentry=>listentry%next_entry - end do - nfmaster = f - if(masterproc) write(iulog,*)'intht:nfmaster=',nfmaster - - ! - ! Now that masterlinkedlist is defined and we are performing a restart run - ! (after all addfld calls), construct primary and secondary hashing tables. - ! - if (restart_run) then - call print_active_fldlst() - call bld_outfld_hash_tbls() - call bld_htapefld_indices() - return - end if - ! - ! Get users logname and machine hostname - ! - if ( masterproc )then - logname = ' ' - call shr_sys_getenv ('LOGNAME',logname,rcode) - host = ' ' - call shr_sys_getenv ('HOST',host,rcode) - end if - ! PIO requires netcdf attributes have consistant values on all tasks - call mpi_bcast(logname, len(logname), mpi_character, masterprocid, mpicom, rcode) - call mpi_bcast(host, len(host), mpi_character, masterprocid, mpicom, rcode) - ! - ! Override averaging flag for all fields on a particular tape if namelist input so specifies - ! - do t=1,ptapes - if (avgflag_pertape(t) /= ' ') then - call h_override (t) - end if - end do - ! - ! Define field list information for all history files. - ! - call fldlst () - ! - ! Loop over max. no. of history files permitted - ! - if (branch_run) then - call get_prev_time(day, sec) ! elapased time since reference date - else - call get_curr_time(day, sec) ! elapased time since reference date - end if - do t=1,ptapes - nfils(t) = 0 ! no. of time samples in hist. file no. t - - ! Time at beginning of current averaging interval. - - beg_time(t) = day + sec/86400._r8 - end do - - ! - ! Initialize history variables - ! - do t=1,ptapes - do f=1,nflds(t) - begdim1 = tape(t)%hlist(f)%field%begdim1 - enddim1 = tape(t)%hlist(f)%field%enddim1 - begdim2 = tape(t)%hlist(f)%field%begdim2 - enddim2 = tape(t)%hlist(f)%field%enddim2 - begdim3 = tape(t)%hlist(f)%field%begdim3 - enddim3 = tape(t)%hlist(f)%field%enddim3 - allocate(tape(t)%hlist(f)%hbuf(begdim1:enddim1,begdim2:enddim2,begdim3:enddim3)) - tape(t)%hlist(f)%hbuf = 0._r8 - if (tape(t)%hlist(f)%avgflag .eq. 'S') then ! allocate the variance buffer for standard dev - allocate(tape(t)%hlist(f)%sbuf(begdim1:enddim1,begdim2:enddim2,begdim3:enddim3)) - tape(t)%hlist(f)%sbuf = 0._r8 - endif - if(tape(t)%hlist(f)%field%flag_xyfill .or. (avgflag_pertape(t) .eq. 'L')) then - allocate (tape(t)%hlist(f)%nacs(begdim1:enddim1,begdim3:enddim3)) - else - allocate (tape(t)%hlist(f)%nacs(1,begdim3:enddim3)) - end if - tape(t)%hlist(f)%nacs(:,:) = 0 - tape(t)%hlist(f)%field%meridional_complement = -1 - tape(t)%hlist(f)%field%zonal_complement = -1 - end do - end do - ! Setup vector pairs for unstructured grid interpolation - call setup_interpolation_and_define_vector_complements() - ! Initialize the sat following history subsystem - call sat_hist_init() - - return - end subroutine intht - - logical function history_initialized() - history_initialized = associated(masterlist) - end function history_initialized - - subroutine history_readnl(nlfile) - - use namelist_utils, only: find_group_name - use units, only: getunit, freeunit - use spmd_utils, only: masterproc, masterprocid, mpicom - use spmd_utils, only: mpi_integer, mpi_logical, mpi_character - use shr_string_mod, only: shr_string_toUpper - use time_manager, only: get_step_size - use sat_hist, only: sat_hist_readnl - - ! Dummy argument - character(len=*), intent(in) :: nlfile ! filepath of namelist input file - - ! - ! Local variables - integer :: dtime ! Step time in seconds - integer :: unitn, ierr, f, t - character(len=8) :: ctemp ! Temporary character string - - character(len=fieldname_lenp2) :: fincl1(pflds) - character(len=fieldname_lenp2) :: fincl2(pflds) - character(len=fieldname_lenp2) :: fincl3(pflds) - character(len=fieldname_lenp2) :: fincl4(pflds) - character(len=fieldname_lenp2) :: fincl5(pflds) - character(len=fieldname_lenp2) :: fincl6(pflds) - character(len=fieldname_lenp2) :: fincl7(pflds) - character(len=fieldname_lenp2) :: fincl8(pflds) - character(len=fieldname_lenp2) :: fincl9(pflds) - character(len=fieldname_lenp2) :: fincl10(pflds) - - character(len=max_chars) :: fincl1lonlat(pflds) - character(len=max_chars) :: fincl2lonlat(pflds) - character(len=max_chars) :: fincl3lonlat(pflds) - character(len=max_chars) :: fincl4lonlat(pflds) - character(len=max_chars) :: fincl5lonlat(pflds) - character(len=max_chars) :: fincl6lonlat(pflds) - character(len=max_chars) :: fincl7lonlat(pflds) - character(len=max_chars) :: fincl8lonlat(pflds) - character(len=max_chars) :: fincl9lonlat(pflds) - character(len=max_chars) :: fincl10lonlat(pflds) - - character(len=fieldname_len) :: fexcl1(pflds) - character(len=fieldname_len) :: fexcl2(pflds) - character(len=fieldname_len) :: fexcl3(pflds) - character(len=fieldname_len) :: fexcl4(pflds) - character(len=fieldname_len) :: fexcl5(pflds) - character(len=fieldname_len) :: fexcl6(pflds) - character(len=fieldname_len) :: fexcl7(pflds) - character(len=fieldname_len) :: fexcl8(pflds) - character(len=fieldname_len) :: fexcl9(pflds) - character(len=fieldname_len) :: fexcl10(pflds) - - character(len=fieldname_lenp2) :: fwrtpr1(pflds) - character(len=fieldname_lenp2) :: fwrtpr2(pflds) - character(len=fieldname_lenp2) :: fwrtpr3(pflds) - character(len=fieldname_lenp2) :: fwrtpr4(pflds) - character(len=fieldname_lenp2) :: fwrtpr5(pflds) - character(len=fieldname_lenp2) :: fwrtpr6(pflds) - character(len=fieldname_lenp2) :: fwrtpr7(pflds) - character(len=fieldname_lenp2) :: fwrtpr8(pflds) - character(len=fieldname_lenp2) :: fwrtpr9(pflds) - character(len=fieldname_lenp2) :: fwrtpr10(pflds) - - integer :: interpolate_nlat(size(interpolate_info)) - integer :: interpolate_nlon(size(interpolate_info)) - integer :: interpolate_gridtype(size(interpolate_info)) - integer :: interpolate_type(size(interpolate_info)) - - ! History namelist items - namelist /cam_history_nl/ ndens, nhtfrq, mfilt, inithist, inithist_all, & - avgflag_pertape, empty_htapes, lcltod_start, lcltod_stop, & - fincl1lonlat, fincl2lonlat, fincl3lonlat, fincl4lonlat, fincl5lonlat, & - fincl6lonlat, fincl7lonlat, fincl8lonlat, fincl9lonlat, & - fincl10lonlat, collect_column_output, hfilename_spec, & - fincl1, fincl2, fincl3, fincl4, fincl5, & - fincl6, fincl7, fincl8, fincl9, fincl10, & - fexcl1, fexcl2, fexcl3, fexcl4, fexcl5, & - fexcl6, fexcl7, fexcl8, fexcl9, fexcl10, & - fwrtpr1, fwrtpr2, fwrtpr3, fwrtpr4, fwrtpr5, & - fwrtpr6, fwrtpr7, fwrtpr8, fwrtpr9, fwrtpr10, & - interpolate_nlat, interpolate_nlon, & - interpolate_gridtype, interpolate_type, interpolate_output - - ! Set namelist defaults (these should match initial values if given) - fincl(:,:) = ' ' - fincllonlat(:,:) = ' ' - fexcl(:,:) = ' ' - fwrtpr(:,:) = ' ' - collect_column_output(:) = .false. - avgflag_pertape(:) = ' ' - ndens = 2 - nhtfrq(1) = 0 - nhtfrq(2:) = -24 - mfilt = 30 - inithist = 'YEARLY' - inithist_all = .false. - empty_htapes = .false. - lcltod_start(:) = 0 - lcltod_stop(:) = 0 - hfilename_spec(:) = ' ' - interpolate_nlat(:) = 0 - interpolate_nlon(:) = 0 - interpolate_gridtype(:) = 1 - interpolate_type(:) = 1 - interpolate_output(:) = .false. - - ! Initialize namelist 'temporary variables' - do f = 1, pflds - fincl1(f) = ' ' - fincl2(f) = ' ' - fincl3(f) = ' ' - fincl4(f) = ' ' - fincl5(f) = ' ' - fincl6(f) = ' ' - fincl7(f) = ' ' - fincl8(f) = ' ' - fincl9(f) = ' ' - fincl10(f) = ' ' - fincl1lonlat(f) = ' ' - fincl2lonlat(f) = ' ' - fincl3lonlat(f) = ' ' - fincl4lonlat(f) = ' ' - fincl5lonlat(f) = ' ' - fincl6lonlat(f) = ' ' - fincl7lonlat(f) = ' ' - fincl8lonlat(f) = ' ' - fincl9lonlat(f) = ' ' - fincl10lonlat(f) = ' ' - fexcl1(f) = ' ' - fexcl2(f) = ' ' - fexcl3(f) = ' ' - fexcl4(f) = ' ' - fexcl5(f) = ' ' - fexcl6(f) = ' ' - fexcl7(f) = ' ' - fexcl8(f) = ' ' - fexcl9(f) = ' ' - fexcl10(f) = ' ' - fwrtpr1(f) = ' ' - fwrtpr2(f) = ' ' - fwrtpr3(f) = ' ' - fwrtpr4(f) = ' ' - fwrtpr5(f) = ' ' - fwrtpr6(f) = ' ' - fwrtpr7(f) = ' ' - fwrtpr8(f) = ' ' - fwrtpr9(f) = ' ' - fwrtpr10(f) = ' ' - end do - - if (trim(history_namelist) /= 'cam_history_nl') then - call endrun('HISTORY_READNL: CAM history namelist mismatch') - end if - if (masterproc) then - write(iulog, *) 'Read in ',history_namelist,' namelist from: ',trim(nlfile) - unitn = getunit() - open(unitn, file=trim(nlfile), status='old') - call find_group_name(unitn, history_namelist, status=ierr) - if (ierr == 0) then - read(unitn, cam_history_nl, iostat=ierr) - if (ierr /= 0) then - call endrun('history_readnl: ERROR reading namelist, '//trim(history_namelist)) - end if - end if - close(unitn) - call freeunit(unitn) - - do f = 1, pflds - fincl(f, 1) = fincl1(f) - fincl(f, 2) = fincl2(f) - fincl(f, 3) = fincl3(f) - fincl(f, 4) = fincl4(f) - fincl(f, 5) = fincl5(f) - fincl(f, 6) = fincl6(f) - fincl(f, 7) = fincl7(f) - fincl(f, 8) = fincl8(f) - fincl(f, 9) = fincl9(f) - fincl(f,10) = fincl10(f) - - fincllonlat(f, 1) = fincl1lonlat(f) - fincllonlat(f, 2) = fincl2lonlat(f) - fincllonlat(f, 3) = fincl3lonlat(f) - fincllonlat(f, 4) = fincl4lonlat(f) - fincllonlat(f, 5) = fincl5lonlat(f) - fincllonlat(f, 6) = fincl6lonlat(f) - fincllonlat(f, 7) = fincl7lonlat(f) - fincllonlat(f, 8) = fincl8lonlat(f) - fincllonlat(f, 9) = fincl9lonlat(f) - fincllonlat(f,10) = fincl10lonlat(f) - - fexcl(f, 1) = fexcl1(f) - fexcl(f, 2) = fexcl2(f) - fexcl(f, 3) = fexcl3(f) - fexcl(f, 4) = fexcl4(f) - fexcl(f, 5) = fexcl5(f) - fexcl(f, 6) = fexcl6(f) - fexcl(f, 7) = fexcl7(f) - fexcl(f, 8) = fexcl8(f) - fexcl(f, 9) = fexcl9(f) - fexcl(f,10) = fexcl10(f) - - fwrtpr(f, 1) = fwrtpr1(f) - fwrtpr(f, 2) = fwrtpr2(f) - fwrtpr(f, 3) = fwrtpr3(f) - fwrtpr(f, 4) = fwrtpr4(f) - fwrtpr(f, 5) = fwrtpr5(f) - fwrtpr(f, 6) = fwrtpr6(f) - fwrtpr(f, 7) = fwrtpr7(f) - fwrtpr(f, 8) = fwrtpr8(f) - fwrtpr(f, 9) = fwrtpr9(f) - fwrtpr(f,10) = fwrtpr10(f) - end do - - ! - ! If generate an initial conditions history file as an auxillary tape: - ! - ctemp = shr_string_toUpper(inithist) - inithist = trim(ctemp) - if ( (inithist /= '6-HOURLY') .and. (inithist /= 'DAILY') .and. & - (inithist /= 'MONTHLY') .and. (inithist /= 'YEARLY') .and. & - (inithist /= 'CAMIOP') .and. (inithist /= 'ENDOFRUN')) then - inithist = 'NONE' - end if - ! - ! History file write times - ! Convert write freq. of hist files from hours to timesteps if necessary. - ! - dtime = get_step_size() - do t = 1, ptapes - if (nhtfrq(t) < 0) then - nhtfrq(t) = nint((-nhtfrq(t) * 3600._r8) / dtime) - end if - end do - ! - ! Initialize the filename specifier if not already set - ! This is the format for the history filenames: - ! %c= caseid, %t=tape no., %y=year, %m=month, %d=day, %s=second, %%=% - ! See the filenames module for more information - ! - do t = 1, ptapes - if ( len_trim(hfilename_spec(t)) == 0 )then - if ( nhtfrq(t) == 0 )then - ! Monthly files - hfilename_spec(t) = '%c.cam' // trim(inst_suffix) // '.h%t.%y-%m.nc' - else - hfilename_spec(t) = '%c.cam' // trim(inst_suffix) // '.h%t.%y-%m-%d-%s.nc' - end if - end if - ! - ! Only one time sample allowed per monthly average file - ! - if (nhtfrq(t) == 0) then - mfilt(t) = 1 - end if - end do - end if ! masterproc - - ! Print per-tape averaging flags - if (masterproc) then - do t = 1, ptapes - if (avgflag_pertape(t) /= ' ') then - write(iulog,*)'Unless overridden by namelist input on a per-field basis (FINCL),' - write(iulog,*)'All fields on history file ',t,' will have averaging flag ',avgflag_pertape(t) - end if - ! Enforce no interpolation for satellite files - if (is_satfile(t) .and. interpolate_output(t)) then - write(iulog, *) 'WARNING: Interpolated output not supported for a satellite history file, ignored' - interpolate_output(t) = .false. - end if - ! Enforce no interpolation for IC files - if (is_initfile(t) .and. interpolate_output(t)) then - write(iulog, *) 'WARNING: Interpolated output not supported for an initial data (IC) history file, ignored' - interpolate_output(t) = .false. - end if - end do - end if - - ! Write out inithist info - if (masterproc) then - if (inithist == '6-HOURLY' ) then - write(iulog,*)'Initial conditions history files will be written 6-hourly.' - else if (inithist == 'DAILY' ) then - write(iulog,*)'Initial conditions history files will be written daily.' - else if (inithist == 'MONTHLY' ) then - write(iulog,*)'Initial conditions history files will be written monthly.' - else if (inithist == 'YEARLY' ) then - write(iulog,*)'Initial conditions history files will be written yearly.' - else if (inithist == 'CAMIOP' ) then - write(iulog,*)'Initial conditions history files will be written for IOP.' - else if (inithist == 'ENDOFRUN' ) then - write(iulog,*)'Initial conditions history files will be written at end of run.' - else - write(iulog,*)'Initial conditions history files will not be created' - end if - end if - - ! Print out column-output information - do t = 1, size(fincllonlat, 2) - if (ANY(len_trim(fincllonlat(:,t)) > 0)) then - if (collect_column_output(t)) then - write(iulog, '(a,i2,a)') 'History file, ',t,', has patch output, columns will be collected into ncol dimension' - else - write(iulog, '(a,i2,a)') 'History file, ',t,', has patch output, patches will be written to individual variables' - end if - end if - end do - - ! Broadcast namelist variables - call mpi_bcast(ndens, ptapes, mpi_integer, masterprocid, mpicom, ierr) - call mpi_bcast(nhtfrq, ptapes, mpi_integer, masterprocid, mpicom, ierr) - call mpi_bcast(mfilt, ptapes, mpi_integer, masterprocid, mpicom, ierr) - call mpi_bcast(inithist,len(inithist), mpi_character, masterprocid, mpicom, ierr) - call mpi_bcast(inithist_all,1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(lcltod_start, ptapes, mpi_integer, masterprocid, mpicom, ierr) - call mpi_bcast(lcltod_stop, ptapes, mpi_integer, masterprocid, mpicom, ierr) - call mpi_bcast(collect_column_output, ptapes, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(empty_htapes,1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(avgflag_pertape, ptapes, mpi_character, masterprocid, mpicom, ierr) - call mpi_bcast(hfilename_spec, len(hfilename_spec(1))*ptapes, mpi_character, masterprocid, mpicom, ierr) - call mpi_bcast(fincl, len(fincl (1,1))*pflds*ptapes, mpi_character, masterprocid, mpicom, ierr) - call mpi_bcast(fexcl, len(fexcl (1,1))*pflds*ptapes, mpi_character, masterprocid, mpicom, ierr) - - call mpi_bcast(fincllonlat, len(fincllonlat (1,1))*pflds*ptapes, mpi_character, masterprocid, mpicom, ierr) - - call mpi_bcast(fwrtpr, len(fwrtpr(1,1))*pflds*ptapes, mpi_character, masterprocid, mpicom, ierr) - t = size(interpolate_nlat, 1) - call mpi_bcast(interpolate_nlat, t, mpi_integer, masterprocid, mpicom, ierr) - call mpi_bcast(interpolate_nlon, t, mpi_integer, masterprocid, mpicom, ierr) - call mpi_bcast(interpolate_gridtype, t, mpi_integer, masterprocid, mpicom, ierr) - call mpi_bcast(interpolate_type, t, mpi_integer, masterprocid, mpicom, ierr) - call mpi_bcast(interpolate_output, ptapes, mpi_logical, masterprocid, mpicom, ierr) - - ! Setup the interpolate_info structures - do t = 1, size(interpolate_info) - interpolate_info(t)%interp_type = interpolate_type(t) - interpolate_info(t)%interp_gridtype = interpolate_gridtype(t) - interpolate_info(t)%interp_nlat = interpolate_nlat(t) - interpolate_info(t)%interp_nlon = interpolate_nlon(t) - end do - - ! separate namelist reader for the satellite history file - call sat_hist_readnl(nlfile, hfilename_spec, mfilt, fincl, nhtfrq, avgflag_pertape) - - end subroutine history_readnl - -!================================================================================================== - - subroutine set_field_dimensions(field) - use cam_history_support, only: hist_coord_size - use cam_grid_support, only: cam_grid_get_array_bounds, cam_grid_is_block_indexed - ! Dummy arguments - type(field_info), intent(inout) :: field - - ! Local variables - integer :: i - integer :: msize - integer :: dimbounds(2,2) - - call cam_grid_get_array_bounds(field%decomp_type, dimbounds) - field%begdim1 = dimbounds(1,1) - field%enddim1 = dimbounds(1,2) - field%begdim2 = 1 - if (associated(field%mdims)) then - if (size(field%mdims) > 0) then - field%enddim2 = 1 - do i = 1, size(field%mdims) - msize = hist_coord_size(field%mdims(i)) - if (msize <= 0) then - call endrun('set_field_dimensions: mdim size must be > 0') - end if - field%enddim2 = field%enddim2 * msize - end do - else - if (field%numlev < 1) then - if (masterproc) then - write(iulog, *) 'SET_FIELD_DIMENSIONS WARNING: illegal numlev for ', trim(field%name) - end if - field%numlev = 1 - end if - field%enddim2 = field%numlev - end if - else - if (field%numlev < 1) then - if (masterproc) then - write(iulog, *) 'SET_FIELD_DIMENSIONS WARNING: illegal numlev for ', trim(field%name) - end if - field%numlev = 1 - end if - field%enddim2 = field%numlev - end if - field%begdim3 = dimbounds(2,1) - field%enddim3 = dimbounds(2,2) - field%colperchunk = cam_grid_is_block_indexed(field%decomp_type) - - end subroutine set_field_dimensions - - subroutine setup_interpolation_and_define_vector_complements() - use interp_mod, only: setup_history_interpolation - - ! Local variables - integer :: hf, f, ff - logical :: interp_ok - character(len=max_fieldname_len) :: mname - character(len=max_fieldname_len) :: zname - character(len=*), parameter :: subname='setup_interpolation_and_define_vector_complements' - - ! Do not interpolate IC history and sat hist files - if (any(interpolate_output)) then - call setup_history_interpolation(interp_ok, ptapes-2, & - interpolate_output, interpolate_info) - do hf = 1, ptapes - 2 - if((.not. is_satfile(hf)) .and. (.not. is_initfile(hf))) then - do f = 1, nflds(hf) - if (field_part_of_vector(trim(tape(hf)%hlist(f)%field%name), & - mname, zname)) then - if (len_trim(mname) > 0) then - ! This field is a zonal part of a set, find the meridional partner - do ff = 1, nflds(hf) - if (trim(mname) == trim(tape(hf)%hlist(ff)%field%name)) then - tape(hf)%hlist(f)%field%meridional_complement = ff - tape(hf)%hlist(ff)%field%zonal_complement = f - exit - end if - if (ff == nflds(hf)) then - call endrun(trim(subname)//': No meridional match for '//trim(tape(hf)%hlist(f)%field%name)) - end if - end do - else if (len_trim(zname) > 0) then - ! This field is a meridional part of a set, find the zonal partner - do ff = 1, nflds(hf) - if (trim(zname) == trim(tape(hf)%hlist(ff)%field%name)) then - tape(hf)%hlist(f)%field%zonal_complement = ff - tape(hf)%hlist(ff)%field%meridional_complement = f - exit - end if - if (ff == nflds(hf)) then - call endrun(trim(subname)//': No zonal match for '//trim(tape(hf)%hlist(f)%field%name)) - end if - end do - else - call endrun(trim(subname)//': INTERNAL ERROR, bad vector field') - end if - end if - end do - end if - end do - end if - end subroutine setup_interpolation_and_define_vector_complements - - subroutine restart_vars_setnames() - - ! Local variable - integer :: rvindex - - rvindex = 1 - restartvars(rvindex)%name = 'rgnht' - restartvars(rvindex)%type = pio_int - restartvars(rvindex)%ndims = 1 - restartvars(rvindex)%dims(1) = ptapes_dim_ind - - rvindex = rvindex + 1 - restartvars(rvindex)%name = 'nhtfrq' - restartvars(rvindex)%type = pio_int - restartvars(rvindex)%ndims = 1 - restartvars(rvindex)%dims(1) = ptapes_dim_ind - - rvindex = rvindex + 1 - restartvars(rvindex)%name = 'nflds' - restartvars(rvindex)%type = pio_int - restartvars(rvindex)%ndims = 1 - restartvars(rvindex)%dims(1) = ptapes_dim_ind - - rvindex = rvindex + 1 - restartvars(rvindex)%name = 'nfils' - restartvars(rvindex)%type = pio_int - restartvars(rvindex)%ndims = 1 - restartvars(rvindex)%dims(1) = ptapes_dim_ind - - rvindex = rvindex + 1 - restartvars(rvindex)%name = 'mfilt' - restartvars(rvindex)%type = pio_int - restartvars(rvindex)%ndims = 1 - restartvars(rvindex)%dims(1) = ptapes_dim_ind - - rvindex = rvindex + 1 - restartvars(rvindex)%name = 'nfpath' - restartvars(rvindex)%type = pio_char - restartvars(rvindex)%ndims = 2 - restartvars(rvindex)%dims(1) = max_string_len_dim_ind - restartvars(rvindex)%dims(2) = ptapes_dim_ind - - rvindex = rvindex + 1 - restartvars(rvindex)%name = 'cpath' - restartvars(rvindex)%type = pio_char - restartvars(rvindex)%ndims = 2 - restartvars(rvindex)%dims(1) = max_string_len_dim_ind - restartvars(rvindex)%dims(2) = ptapes_dim_ind - - rvindex = rvindex + 1 - restartvars(rvindex)%name = 'nhfil' - restartvars(rvindex)%type = pio_char - restartvars(rvindex)%ndims = 2 - restartvars(rvindex)%dims(1) = max_string_len_dim_ind - restartvars(rvindex)%dims(2) = ptapes_dim_ind - - rvindex = rvindex + 1 - restartvars(rvindex)%name = 'ndens' - restartvars(rvindex)%type = pio_int - restartvars(rvindex)%ndims = 1 - restartvars(rvindex)%dims(1) = ptapes_dim_ind - - rvindex = rvindex + 1 - restartvars(rvindex)%name = 'fincllonlat' - restartvars(rvindex)%type = pio_char - restartvars(rvindex)%ndims = 3 - restartvars(rvindex)%dims(1) = max_chars_dim_ind - restartvars(rvindex)%dims(2) = pflds_dim_ind - restartvars(rvindex)%dims(3) = ptapes_dim_ind - - rvindex = rvindex + 1 - restartvars(rvindex)%name = 'ncprec' - restartvars(rvindex)%type = pio_int - restartvars(rvindex)%ndims = 1 - restartvars(rvindex)%dims(1) = ptapes_dim_ind - - rvindex = rvindex + 1 - restartvars(rvindex)%name = 'beg_time' - restartvars(rvindex)%type = pio_double - restartvars(rvindex)%ndims = 1 - restartvars(rvindex)%dims(1) = ptapes_dim_ind - - rvindex = rvindex + 1 - restartvars(rvindex)%name = 'fincl' - restartvars(rvindex)%type = pio_char - restartvars(rvindex)%ndims = 3 - restartvars(rvindex)%dims(1) = fieldname_lenp2_dim_ind - restartvars(rvindex)%dims(2) = pflds_dim_ind - restartvars(rvindex)%dims(3) = ptapes_dim_ind - - rvindex = rvindex + 1 - restartvars(rvindex)%name = 'fexcl' - restartvars(rvindex)%type = pio_char - restartvars(rvindex)%ndims = 3 - restartvars(rvindex)%dims(1) = fieldname_lenp2_dim_ind - restartvars(rvindex)%dims(2) = pflds_dim_ind - restartvars(rvindex)%dims(3) = ptapes_dim_ind - - rvindex = rvindex + 1 - restartvars(rvindex)%name = 'field_name' - restartvars(rvindex)%type = pio_char - restartvars(rvindex)%ndims = 3 - restartvars(rvindex)%dims(1) = max_fieldname_len_dim_ind - restartvars(rvindex)%dims(2) = maxnflds_dim_ind - restartvars(rvindex)%dims(3) = ptapes_dim_ind - - rvindex = rvindex + 1 - restartvars(rvindex)%name = 'decomp_type' - restartvars(rvindex)%type = pio_int - restartvars(rvindex)%ndims = 2 - restartvars(rvindex)%dims(1) = maxnflds_dim_ind - restartvars(rvindex)%dims(2) = ptapes_dim_ind - - rvindex = rvindex + 1 - restartvars(rvindex)%name = 'numlev' - restartvars(rvindex)%type = pio_int - restartvars(rvindex)%ndims = 2 - restartvars(rvindex)%dims(1) = maxnflds_dim_ind - restartvars(rvindex)%dims(2) = ptapes_dim_ind - - rvindex = rvindex + 1 - restartvars(rvindex)%name = 'hrestpath' - restartvars(rvindex)%type = pio_char - restartvars(rvindex)%ndims = 2 - restartvars(rvindex)%dims(1) = max_string_len_dim_ind - restartvars(rvindex)%dims(2) = ptapes_dim_ind - - rvindex = rvindex + 1 - restartvars(rvindex)%name = 'hwrt_prec' - restartvars(rvindex)%type = pio_int - restartvars(rvindex)%ndims = 2 - restartvars(rvindex)%dims(1) = maxnflds_dim_ind - restartvars(rvindex)%dims(2) = ptapes_dim_ind - - rvindex = rvindex + 1 - restartvars(rvindex)%name = 'avgflag' - restartvars(rvindex)%type = pio_char - restartvars(rvindex)%ndims = 2 - restartvars(rvindex)%dims(1) = maxnflds_dim_ind - restartvars(rvindex)%dims(2) = ptapes_dim_ind - - rvindex = rvindex + 1 - restartvars(rvindex)%name = 'sampling_seq' - restartvars(rvindex)%type = pio_char - restartvars(rvindex)%ndims = 3 - restartvars(rvindex)%dims(1) = max_chars_dim_ind - restartvars(rvindex)%dims(2) = maxnflds_dim_ind - restartvars(rvindex)%dims(3) = ptapes_dim_ind - - rvindex = rvindex + 1 - restartvars(rvindex)%name = 'cell_methods' - restartvars(rvindex)%type = pio_char - restartvars(rvindex)%ndims = 3 - restartvars(rvindex)%dims(1) = max_chars_dim_ind - restartvars(rvindex)%dims(2) = maxnflds_dim_ind - restartvars(rvindex)%dims(3) = ptapes_dim_ind - - rvindex = rvindex + 1 - restartvars(rvindex)%name = 'long_name' - restartvars(rvindex)%type = pio_char - restartvars(rvindex)%ndims = 3 - restartvars(rvindex)%dims(1) = max_chars_dim_ind - restartvars(rvindex)%dims(2) = maxnflds_dim_ind - restartvars(rvindex)%dims(3) = ptapes_dim_ind - - rvindex = rvindex + 1 - restartvars(rvindex)%name = 'units' - restartvars(rvindex)%type = pio_char - restartvars(rvindex)%ndims = 3 - restartvars(rvindex)%dims(1) = max_chars_dim_ind - restartvars(rvindex)%dims(2) = maxnflds_dim_ind - restartvars(rvindex)%dims(3) = ptapes_dim_ind - - rvindex = rvindex + 1 - restartvars(rvindex)%name = 'xyfill' - restartvars(rvindex)%type = pio_int - restartvars(rvindex)%ndims = 2 - restartvars(rvindex)%dims(1) = maxnflds_dim_ind - restartvars(rvindex)%dims(2) = ptapes_dim_ind - - rvindex = rvindex + 1 - restartvars(rvindex)%name = 'lcltod_start' - restartvars(rvindex)%type = pio_int - restartvars(rvindex)%ndims = 1 - restartvars(rvindex)%dims(1) = ptapes_dim_ind - - rvindex = rvindex + 1 - restartvars(rvindex)%name = 'lcltod_stop' - restartvars(rvindex)%type = pio_int - restartvars(rvindex)%ndims = 1 - restartvars(rvindex)%dims(1) = ptapes_dim_ind - - rvindex = rvindex + 1 - restartvars(rvindex)%name = 'fillvalue' - restartvars(rvindex)%type = pio_double - restartvars(rvindex)%ndims = 2 - restartvars(rvindex)%dims(1) = maxnflds_dim_ind - restartvars(rvindex)%dims(2) = ptapes_dim_ind - - rvindex = rvindex + 1 - restartvars(rvindex)%name = 'mdims' - restartvars(rvindex)%type = pio_int - restartvars(rvindex)%ndims = 3 - restartvars(rvindex)%dims(1) = maxvarmdims_dim_ind - restartvars(rvindex)%dims(2) = maxnflds_dim_ind - restartvars(rvindex)%dims(3) = ptapes_dim_ind - - rvindex = rvindex + 1 - restartvars(rvindex)%name = 'mdimnames' - restartvars(rvindex)%type = pio_char - restartvars(rvindex)%ndims = 2 - restartvars(rvindex)%dims(1) = max_hcoordname_len_dim_ind - restartvars(rvindex)%dims(2) = registeredmdims_dim_ind - - rvindex = rvindex + 1 - restartvars(rvindex)%name = 'is_subcol' - restartvars(rvindex)%type = pio_int - restartvars(rvindex)%ndims = 2 - restartvars(rvindex)%dims(1) = maxnflds_dim_ind - restartvars(rvindex)%dims(2) = ptapes_dim_ind - - rvindex = rvindex + 1 - restartvars(rvindex)%name = 'interpolate_output' - restartvars(rvindex)%type = pio_int - restartvars(rvindex)%ndims = 1 - restartvars(rvindex)%dims(1) = ptapes_dim_ind - - rvindex = rvindex + 1 - restartvars(rvindex)%name = 'interpolate_type' - restartvars(rvindex)%type = pio_int - restartvars(rvindex)%ndims = 1 - restartvars(rvindex)%dims(1) = ptapes_dim_ind - - rvindex = rvindex + 1 - restartvars(rvindex)%name = 'interpolate_gridtype' - restartvars(rvindex)%type = pio_int - restartvars(rvindex)%ndims = 1 - restartvars(rvindex)%dims(1) = ptapes_dim_ind - - rvindex = rvindex + 1 - restartvars(rvindex)%name = 'interpolate_nlat' - restartvars(rvindex)%type = pio_int - restartvars(rvindex)%ndims = 1 - restartvars(rvindex)%dims(1) = ptapes_dim_ind - - rvindex = rvindex + 1 - restartvars(rvindex)%name = 'interpolate_nlon' - restartvars(rvindex)%type = pio_int - restartvars(rvindex)%ndims = 1 - restartvars(rvindex)%dims(1) = ptapes_dim_ind - - rvindex = rvindex + 1 - restartvars(rvindex)%name = 'meridional_complement' - restartvars(rvindex)%type = pio_int - restartvars(rvindex)%ndims = 2 - restartvars(rvindex)%dims(1) = maxnflds_dim_ind - restartvars(rvindex)%dims(2) = ptapes_dim_ind - - rvindex = rvindex + 1 - restartvars(rvindex)%name = 'zonal_complement' - restartvars(rvindex)%type = pio_int - restartvars(rvindex)%ndims = 2 - restartvars(rvindex)%dims(1) = maxnflds_dim_ind - restartvars(rvindex)%dims(2) = ptapes_dim_ind - - end subroutine restart_vars_setnames - - subroutine restart_dims_setnames() - use cam_grid_support, only: max_hcoordname_len - use cam_history_support, only: registeredmdims - - restartdims(ptapes_dim_ind)%name = 'ptapes' - restartdims(ptapes_dim_ind)%len = ptapes - - restartdims(max_string_len_dim_ind)%name = 'max_string_len' - restartdims(max_string_len_dim_ind)%len = max_string_len - - restartdims(fieldname_lenp2_dim_ind)%name = 'fieldname_lenp2' - restartdims(fieldname_lenp2_dim_ind)%len = fieldname_lenp2 - - restartdims(pflds_dim_ind)%name = 'pflds' - restartdims(pflds_dim_ind)%len = pflds - - restartdims(max_chars_dim_ind)%name = 'max_chars' - restartdims(max_chars_dim_ind)%len = max_chars - - restartdims(max_fieldname_len_dim_ind)%name = 'max_fieldname_len' - restartdims(max_fieldname_len_dim_ind)%len = max_fieldname_len - - restartdims(maxnflds_dim_ind)%name = 'maxnflds' - restartdims(maxnflds_dim_ind)%len = maxval(nflds) - - restartdims(maxvarmdims_dim_ind)%name = 'maxvarmdims' - restartdims(maxvarmdims_dim_ind)%len = maxvarmdims - - restartdims(registeredmdims_dim_ind)%name = 'registeredmdims' - restartdims(registeredmdims_dim_ind)%len = registeredmdims - - restartdims(max_hcoordname_len_dim_ind)%name = 'max_hcoordname_len' - restartdims(max_hcoordname_len_dim_ind)%len = max_hcoordname_len - - end subroutine restart_dims_setnames - - - subroutine init_restart_history (File) - use cam_pio_utils, only: cam_pio_def_dim - use cam_pio_utils, only: cam_pio_handle_error - - !--------------------------------------------------------------------------- - ! - ! Arguments - ! - type(file_desc_t), intent(inout) :: File ! Pio file Handle - ! - ! Local - ! - integer :: dimids(4), ndims - integer :: ierr, i, k - - ! Don't need to write restart data if we have written the file this step - where (hstwr(:)) - rgnht(:) = .false. - elsewhere - rgnht(:) = .true. - end where - - if(maxval(nflds)>0) then - call restart_vars_setnames() - call restart_dims_setnames() - - do i=1,restartdimcnt - ! it's possible that one or more of these have been defined elsewhere - call cam_pio_def_dim(File, restartdims(i)%name, restartdims(i)%len, & - restartdims(i)%dimid, existOK=.true.) - end do - - do i=1,restartvarcnt - ndims= restartvars(i)%ndims - do k=1,ndims - dimids(k)=restartdims(restartvars(i)%dims(k))%dimid - end do - allocate(restartvars(i)%vdesc) - ierr = pio_def_var(File, restartvars(i)%name, restartvars(i)%type, dimids(1:ndims), restartvars(i)%vdesc) - call cam_pio_handle_error(ierr, 'INIT_RESTART_HISTORY: Error defining '//trim(restartvars(i)%name)) - - end do - end if - end subroutine init_restart_history - - function restartvar_getdesc(name) result(vdesc) - character(len=*), intent(in) :: name - type(var_desc_t), pointer :: vdesc - character(len=max_chars) :: errmsg - integer :: i - - nullify(vdesc) - do i=1,restartvarcnt - if(name .eq. restartvars(i)%name) then - vdesc=>restartvars(i)%vdesc - exit - end if - end do - if(.not.associated(vdesc)) then - errmsg = 'Could not find restart variable '//name - call endrun(errmsg) - end if - end function restartvar_getdesc - - - !####################################################################### - - subroutine write_restart_history ( File, & - yr_spec, mon_spec, day_spec, sec_spec ) - use cam_history_support, only: hist_coord_name, registeredmdims - - implicit none - !-------------------------------------------------------------------------------------------------- - ! - ! Arguments - ! - type(file_desc_t), intent(inout) :: file ! PIO restart file pointer - integer, intent(in), optional :: yr_spec ! Simulation year - integer, intent(in), optional :: mon_spec ! Simulation month - integer, intent(in), optional :: day_spec ! Simulation day - integer, intent(in), optional :: sec_spec ! Seconds into current simulation day - ! - ! Local workspace - ! - integer :: ierr, t, f - integer :: rgnht_int(ptapes), start(2), startc(3) - type(var_desc_t), pointer :: vdesc - - ! PIO variable descriptors - type(var_desc_t), pointer :: field_name_desc ! Restart field names - type(var_desc_t), pointer :: decomp_type_desc - type(var_desc_t), pointer :: numlev_desc - type(var_desc_t), pointer :: avgflag_desc - type(var_desc_t), pointer :: sseq_desc - type(var_desc_t), pointer :: cm_desc - type(var_desc_t), pointer :: longname_desc - type(var_desc_t), pointer :: units_desc - type(var_desc_t), pointer :: hwrt_prec_desc - type(var_desc_t), pointer :: xyfill_desc - type(var_desc_t), pointer :: mdims_desc ! mdim name indices - type(var_desc_t), pointer :: mdimname_desc ! mdim names - type(var_desc_t), pointer :: issubcol_desc - type(var_desc_t), pointer :: fillval_desc - type(var_desc_t), pointer :: interpolate_output_desc - type(var_desc_t), pointer :: interpolate_type_desc - type(var_desc_t), pointer :: interpolate_gridtype_desc - type(var_desc_t), pointer :: interpolate_nlat_desc - type(var_desc_t), pointer :: interpolate_nlon_desc - type(var_desc_t), pointer :: meridional_complement_desc - type(var_desc_t), pointer :: zonal_complement_desc - - integer, allocatable :: allmdims(:,:,:) - integer, allocatable :: xyfill(:,:) - integer, allocatable :: is_subcol(:,:) - integer, allocatable :: interp_output(:) - - integer :: maxnflds - - - maxnflds = maxval(nflds) - allocate(xyfill(maxnflds, ptapes)) - xyfill = 0 - allocate(is_subcol(maxnflds, ptapes)) - is_subcol = 0 - allocate(interp_output(ptapes)) - interp_output = 0 - - ! - !----------------------------------------------------------------------- - ! Write the history restart data if necessary - !----------------------------------------------------------------------- - - rgnht_int(:) = 0 - - if(.not.allocated(restarthistory_tape)) allocate(restarthistory_tape(ptapes)) - - do t=1,ptapes - ! No need to write history IC restart because it is always instantaneous - if (is_initfile(file_index=t)) rgnht(t) = .false. - ! No need to write restart data for empty files - if (nflds(t) == 0) rgnht(t) = .false. - if(rgnht(t)) then - rgnht_int(t) = 1 - restarthistory_tape(t)%hlist => history_tape(t)%hlist - - if(associated(history_tape(t)%grid_ids)) then - restarthistory_tape(t)%grid_ids => history_tape(t)%grid_ids - end if - if(associated(history_tape(t)%patches)) then - restarthistory_tape(t)%patches => history_tape(t)%patches - end if - end if - end do - - if(maxval(nflds)<=0) return - - call wshist(rgnht) - - vdesc => restartvar_getdesc('fincl') - ierr= pio_put_var(File, vdesc, fincl(:,1:ptapes)) - - vdesc => restartvar_getdesc('fincllonlat') - ierr= pio_put_var(File, vdesc, fincllonlat(:,1:ptapes)) - - vdesc => restartvar_getdesc('fexcl') - ierr= pio_put_var(File, vdesc, fexcl(:,1:ptapes)) - - vdesc => restartvar_getdesc('rgnht') - ierr= pio_put_var(File, vdesc, rgnht_int(1:ptapes)) - - vdesc => restartvar_getdesc('nhtfrq') - ierr= pio_put_var(File, vdesc, nhtfrq(1:ptapes)) - - vdesc => restartvar_getdesc('nflds') - ierr= pio_put_var(File, vdesc, nflds(1:ptapes)) - - vdesc => restartvar_getdesc('nfils') - ierr= pio_put_var(File, vdesc, nfils(1:ptapes)) - - vdesc => restartvar_getdesc('mfilt') - ierr= pio_put_var(File, vdesc, mfilt(1:ptapes)) - - vdesc => restartvar_getdesc('nfpath') - ierr= pio_put_var(File, vdesc, nfpath(1:ptapes)) - - vdesc => restartvar_getdesc('cpath') - ierr= pio_put_var(File, vdesc, cpath(1:ptapes)) - - vdesc => restartvar_getdesc('nhfil') - ierr= pio_put_var(File, vdesc, nhfil(1:ptapes)) - - vdesc => restartvar_getdesc('ndens') - ierr= pio_put_var(File, vdesc, ndens(1:ptapes)) - vdesc => restartvar_getdesc('ncprec') - ierr= pio_put_var(File, vdesc, ncprec(1:ptapes)) - vdesc => restartvar_getdesc('beg_time') - ierr= pio_put_var(File, vdesc, beg_time(1:ptapes)) - - vdesc => restartvar_getdesc('hrestpath') - ierr = pio_put_var(File, vdesc, hrestpath(1:ptapes)) - - vdesc => restartvar_getdesc('lcltod_start') - ierr = pio_put_var(File, vdesc, lcltod_start(1:ptapes)) - - vdesc => restartvar_getdesc('lcltod_stop') - ierr = pio_put_var(File, vdesc, lcltod_stop(1:ptapes)) - - field_name_desc => restartvar_getdesc('field_name') - decomp_type_desc => restartvar_getdesc('decomp_type') - numlev_desc => restartvar_getdesc('numlev') - hwrt_prec_desc => restartvar_getdesc('hwrt_prec') - - sseq_desc => restartvar_getdesc('sampling_seq') - cm_desc => restartvar_getdesc('cell_methods') - longname_desc => restartvar_getdesc('long_name') - units_desc => restartvar_getdesc('units') - avgflag_desc => restartvar_getdesc('avgflag') - xyfill_desc => restartvar_getdesc('xyfill') - issubcol_desc => restartvar_getdesc('is_subcol') - - interpolate_output_desc => restartvar_getdesc('interpolate_output') - interpolate_type_desc => restartvar_getdesc('interpolate_type') - interpolate_gridtype_desc => restartvar_getdesc('interpolate_gridtype') - interpolate_nlat_desc => restartvar_getdesc('interpolate_nlat') - interpolate_nlon_desc => restartvar_getdesc('interpolate_nlon') - - meridional_complement_desc => restartvar_getdesc('meridional_complement') - zonal_complement_desc => restartvar_getdesc('zonal_complement') - - mdims_desc => restartvar_getdesc('mdims') - mdimname_desc => restartvar_getdesc('mdimnames') - fillval_desc => restartvar_getdesc('fillvalue') - - tape=>history_tape - - ! allmdims specifies the mdim indices for each field - allocate(allmdims(maxvarmdims,maxval(nflds),ptapes)) - allmdims=-1 - - startc(1)=1 - do t = 1,ptapes - start(2)=t - startc(3)=t - do f=1,nflds(t) - start(1)=f - startc(2)=f - ierr = pio_put_var(File, field_name_desc,startc,tape(t)%hlist(f)%field%name) - ierr = pio_put_var(File, decomp_type_desc,start,tape(t)%hlist(f)%field%decomp_type) - ierr = pio_put_var(File, numlev_desc,start,tape(t)%hlist(f)%field%numlev) - - ierr = pio_put_var(File, hwrt_prec_desc,start,tape(t)%hlist(f)%hwrt_prec) - ierr = pio_put_var(File, sseq_desc,startc,tape(t)%hlist(f)%field%sampling_seq) - ierr = pio_put_var(File, cm_desc,startc,tape(t)%hlist(f)%field%cell_methods) - ierr = pio_put_var(File, longname_desc,startc,tape(t)%hlist(f)%field%long_name) - ierr = pio_put_var(File, units_desc,startc,tape(t)%hlist(f)%field%units) - ierr = pio_put_var(File, avgflag_desc,start, tape(t)%hlist(f)%avgflag) - - ierr = pio_put_var(File, fillval_desc,start, tape(t)%hlist(f)%field%fillvalue) - ierr = pio_put_var(File, meridional_complement_desc,start, tape(t)%hlist(f)%field%meridional_complement) - ierr = pio_put_var(File, zonal_complement_desc,start, tape(t)%hlist(f)%field%zonal_complement) - if(associated(tape(t)%hlist(f)%field%mdims)) then - allmdims(1:size(tape(t)%hlist(f)%field%mdims),f,t) = tape(t)%hlist(f)%field%mdims - else - end if - if(tape(t)%hlist(f)%field%flag_xyfill) then - xyfill(f,t) = 1 - end if - if(tape(t)%hlist(f)%field%is_subcol) then - is_subcol(f,t) = 1 - end if - end do - if (interpolate_output(t)) then - interp_output(t) = 1 - end if - end do - ierr = pio_put_var(File, xyfill_desc, xyfill) - ierr = pio_put_var(File, mdims_desc, allmdims) - ierr = pio_put_var(File, issubcol_desc, is_subcol) - !! Interpolated output variables - ierr = pio_put_var(File, interpolate_output_desc, interp_output) - interp_output = 1 - do t = 1, size(interpolate_info) - interp_output(t) = interpolate_info(t)%interp_type - end do - ierr = pio_put_var(File, interpolate_type_desc, interp_output) - interp_output = 1 - do t = 1, size(interpolate_info) - interp_output(t) = interpolate_info(t)%interp_gridtype - end do - ierr = pio_put_var(File, interpolate_gridtype_desc, interp_output) - interp_output = 0 - do t = 1, size(interpolate_info) - interp_output(t) = interpolate_info(t)%interp_nlat - end do - ierr = pio_put_var(File, interpolate_nlat_desc, interp_output) - interp_output = 0 - do t = 1, size(interpolate_info) - interp_output(t) = interpolate_info(t)%interp_nlon - end do - ierr = pio_put_var(File, interpolate_nlon_desc, interp_output) - ! Registered history coordinates - start(1) = 1 - do f = 1, registeredmdims - start(2) = f - ierr = pio_put_var(File, mdimname_desc, start, hist_coord_name(f)) - end do - - deallocate(xyfill, allmdims) - return - - end subroutine write_restart_history - - - !####################################################################### - - subroutine read_restart_history (File) - use pio, only: pio_inq_dimid - use pio, only: pio_inq_varid, pio_inq_dimname - use cam_pio_utils, only: cam_pio_openfile, cam_pio_closefile - use cam_pio_utils, only: cam_pio_var_info - use ioFileMod, only: getfil - use sat_hist, only: sat_hist_define, sat_hist_init - use cam_grid_support, only: cam_grid_read_dist_array, cam_grid_num_grids - use cam_history_support, only: get_hist_coord_index, add_hist_coord - - use shr_sys_mod, only: shr_sys_getenv - use spmd_utils, only: mpicom, mpi_character, masterprocid - ! - !----------------------------------------------------------------------- - ! - ! Arguments - ! - type(file_desc_t), intent(inout) :: File ! unit number - ! - ! Local workspace - ! - integer t, f, ff ! tape, field indices - integer begdim2 ! on-node vert start index - integer enddim2 ! on-node vert end index - integer begdim1 ! on-node dim1 start index - integer enddim1 ! on-node dim1 end index - integer begdim3 ! on-node chunk or lat start index - integer enddim3 ! on-node chunk or lat end index - - - integer rgnht_int(ptapes) - integer :: ierr - - character(len=max_string_len) :: locfn ! Local filename - character(len=max_fieldname_len), allocatable :: tmpname(:,:) - integer, allocatable :: decomp(:,:), tmpnumlev(:,:) - integer, pointer :: nacs(:,:) ! accumulation counter - character(len=max_fieldname_len) :: fname_tmp ! local copy of field name - character(len=max_fieldname_len) :: dname_tmp ! local copy of dim name - - integer :: i, ptapes_dimid - - type(var_desc_t) :: vdesc - type(var_desc_t) :: longname_desc - type(var_desc_t) :: units_desc - type(var_desc_t) :: avgflag_desc - type(var_desc_t) :: sseq_desc - type(var_desc_t) :: cm_desc - type(var_desc_t) :: fillval_desc - type(var_desc_t) :: meridional_complement_desc - type(var_desc_t) :: zonal_complement_desc - integer, allocatable :: tmpprec(:,:) - integer, allocatable :: xyfill(:,:) - integer, allocatable :: allmdims(:,:,:) - integer, allocatable :: is_subcol(:,:) - integer, allocatable :: interp_output(:) - integer :: nacsdimcnt, nacsval - integer :: maxnflds, dimid - - ! List of active grids (first dim) for each tape (second dim) - ! An active grid is one for which there is a least one field being output - ! on that grid. - integer, allocatable :: gridsontape(:,:) - - character(len=16), allocatable :: mdimnames(:) ! Names of all hist coords (inc. vertical) - integer :: ndims, dimids(8) - integer :: tmpdims(8), dimcnt - integer :: dimlens(7) - integer :: mtapes, mdimcnt - integer :: fdims(3) ! Field dims - integer :: nfdims ! 2 or 3 (for 2D,3D) - integer :: fdecomp ! Grid ID for field - - ! - ! Get users logname and machine hostname - ! - if ( masterproc )then - logname = ' ' - call shr_sys_getenv ('LOGNAME',logname,ierr) - host = ' ' - call shr_sys_getenv ('HOST',host,ierr) - end if - ! PIO requires netcdf attributes have consistant values on all tasks - call mpi_bcast(logname, len(logname), mpi_character, masterprocid, mpicom, ierr) - call mpi_bcast(host, len(host), mpi_character, masterprocid, mpicom, ierr) - - call pio_seterrorhandling(File, PIO_BCAST_ERROR) - - ierr = pio_inq_dimid(File, 'ptapes', ptapes_dimid) - if(ierr/= PIO_NOERR) then - if(masterproc) write(iulog,*) 'Not reading history info from restart file', ierr - return ! no history info in restart file - end if - call pio_seterrorhandling(File, PIO_INTERNAL_ERROR) - - ierr = pio_inq_dimlen(File, ptapes_dimid, mtapes) - - ierr = pio_inq_dimid(File, 'maxnflds', dimid) - ierr = pio_inq_dimlen(File, dimid, maxnflds) - - ierr = pio_inq_dimid(File, 'maxvarmdims', dimid) - ierr = pio_inq_dimlen(File, dimid, maxvarmdims) - - ierr = pio_inq_varid(File, 'rgnht', vdesc) - ierr = pio_get_var(File, vdesc, rgnht_int(1:mtapes)) - - ierr = pio_inq_varid(File, 'nhtfrq', vdesc) - ierr = pio_get_var(File, vdesc, nhtfrq(1:mtapes)) - - ierr = pio_inq_varid(File, 'nflds', vdesc) - ierr = pio_get_var(File, vdesc, nflds(1:mtapes)) - ierr = pio_inq_varid(File, 'nfils', vdesc) - ierr = pio_get_var(File, vdesc, nfils(1:mtapes)) - ierr = pio_inq_varid(File, 'mfilt', vdesc) - ierr = pio_get_var(File, vdesc, mfilt(1:mtapes)) - - ierr = pio_inq_varid(File, 'nfpath', vdesc) - ierr = pio_get_var(File, vdesc, nfpath(1:mtapes)) - ierr = pio_inq_varid(File, 'cpath', vdesc) - ierr = pio_get_var(File, vdesc, cpath(1:mtapes)) - ierr = pio_inq_varid(File, 'nhfil', vdesc) - ierr = pio_get_var(File, vdesc, nhfil(1:mtapes)) - ierr = pio_inq_varid(File, 'hrestpath', vdesc) - ierr = pio_get_var(File, vdesc, hrestpath(1:mtapes)) - - - ierr = pio_inq_varid(File, 'ndens', vdesc) - ierr = pio_get_var(File, vdesc, ndens(1:mtapes)) - ierr = pio_inq_varid(File, 'ncprec', vdesc) - ierr = pio_get_var(File, vdesc, ncprec(1:mtapes)) - ierr = pio_inq_varid(File, 'beg_time', vdesc) - ierr = pio_get_var(File, vdesc, beg_time(1:mtapes)) - - - ierr = pio_inq_varid(File, 'fincl', vdesc) - ierr = pio_get_var(File, vdesc, fincl(:,1:mtapes)) - - ierr = pio_inq_varid(File, 'fincllonlat', vdesc) - ierr = pio_get_var(File, vdesc, fincllonlat(:,1:mtapes)) - - ierr = pio_inq_varid(File, 'fexcl', vdesc) - ierr = pio_get_var(File, vdesc, fexcl(:,1:mtapes)) - - ierr = pio_inq_varid(File, 'lcltod_start', vdesc) - ierr = pio_get_var(File, vdesc, lcltod_start(1:mtapes)) - - ierr = pio_inq_varid(File, 'lcltod_stop', vdesc) - ierr = pio_get_var(File, vdesc, lcltod_stop(1:mtapes)) - - - - - allocate(tmpname(maxnflds, mtapes), decomp(maxnflds, mtapes), tmpnumlev(maxnflds,mtapes)) - ierr = pio_inq_varid(File, 'field_name', vdesc) - ierr = pio_get_var(File, vdesc, tmpname) - - ierr = pio_inq_varid(File, 'decomp_type', vdesc) - ierr = pio_get_var(File, vdesc, decomp) - ierr = pio_inq_varid(File, 'numlev', vdesc) - ierr = pio_get_var(File, vdesc, tmpnumlev) - - allocate(tmpprec(maxnflds,mtapes)) - ierr = pio_inq_varid(File, 'hwrt_prec',vdesc) - ierr = pio_get_var(File, vdesc, tmpprec(:,:)) - - allocate(xyfill(maxnflds,mtapes)) - ierr = pio_inq_varid(File, 'xyfill', vdesc) - ierr = pio_get_var(File, vdesc, xyfill) - - allocate(is_subcol(maxnflds,mtapes)) - ierr = pio_inq_varid(File, 'is_subcol', vdesc) - ierr = pio_get_var(File, vdesc, is_subcol) - - !! interpolated output - allocate(interp_output(mtapes)) - ierr = pio_inq_varid(File, 'interpolate_output', vdesc) - ierr = pio_get_var(File, vdesc, interp_output) - interpolate_output(1:mtapes) = interp_output(1:mtapes) > 0 - if (ptapes > mtapes) then - interpolate_output(mtapes+1:ptapes) = .false. - end if - ierr = pio_inq_varid(File, 'interpolate_type', vdesc) - ierr = pio_get_var(File, vdesc, interp_output) - do t = 1, mtapes - if (interpolate_output(t)) then - interpolate_info(t)%interp_type = interp_output(t) - end if - end do - ierr = pio_inq_varid(File, 'interpolate_gridtype', vdesc) - ierr = pio_get_var(File, vdesc, interp_output) - do t = 1, mtapes - if (interpolate_output(t)) then - interpolate_info(t)%interp_gridtype = interp_output(t) - end if - end do - ierr = pio_inq_varid(File, 'interpolate_nlat', vdesc) - ierr = pio_get_var(File, vdesc, interp_output) - do t = 1, mtapes - if (interpolate_output(t)) then - interpolate_info(t)%interp_nlat = interp_output(t) - end if - end do - ierr = pio_inq_varid(File, 'interpolate_nlon', vdesc) - ierr = pio_get_var(File, vdesc, interp_output) - do t = 1, mtapes - if (interpolate_output(t)) then - interpolate_info(t)%interp_nlon = interp_output(t) - end if - end do - - !! mdim indices - allocate(allmdims(maxvarmdims,maxnflds,mtapes)) - ierr = pio_inq_varid(File, 'mdims', vdesc) - ierr = pio_get_var(File, vdesc, allmdims) - - !! mdim names - ! Read the hist coord names to make sure they are all registered - ierr = pio_inq_varid(File, 'mdimnames', vdesc) - call cam_pio_var_info(File, vdesc, ndims, dimids, dimlens) - mdimcnt = dimlens(2) - allocate(mdimnames(mdimcnt)) - ierr = pio_get_var(File, vdesc, mdimnames) - do f = 1, mdimcnt - ! Check to see if the mdim is registered - if (get_hist_coord_index(trim(mdimnames(f))) <= 0) then - ! We need to register this mdim (hist_coord) - call add_hist_coord(trim(mdimnames(f))) - end if - end do - - ierr = pio_inq_varid(File, 'avgflag', avgflag_desc) - - ierr = pio_inq_varid(File, 'long_name', longname_desc) - ierr = pio_inq_varid(File, 'units', units_desc) - ierr = pio_inq_varid(File, 'sampling_seq', sseq_desc) - ierr = pio_inq_varid(File, 'cell_methods', cm_desc) - - ierr = pio_inq_varid(File, 'fillvalue', fillval_desc) - ierr = pio_inq_varid(File, 'meridional_complement', meridional_complement_desc) - ierr = pio_inq_varid(File, 'zonal_complement', zonal_complement_desc) - - rgnht(:)=.false. - - allocate(history_tape(mtapes)) - - tape => history_tape - - do t=1,mtapes - - if(rgnht_int(t)==1) rgnht(t)=.true. - - - call strip_null(nfpath(t)) - call strip_null(cpath(t)) - call strip_null(hrestpath(t)) - allocate(tape(t)%hlist(nflds(t))) - - do f=1,nflds(t) - if (associated(tape(t)%hlist(f)%field%mdims)) then - deallocate(tape(t)%hlist(f)%field%mdims) - end if - nullify(tape(t)%hlist(f)%field%mdims) - ierr = pio_get_var(File,fillval_desc, (/f,t/), tape(t)%hlist(f)%field%fillvalue) - ierr = pio_get_var(File,meridional_complement_desc, (/f,t/), tape(t)%hlist(f)%field%meridional_complement) - ierr = pio_get_var(File,zonal_complement_desc, (/f,t/), tape(t)%hlist(f)%field%zonal_complement) - ierr = pio_get_var(File,avgflag_desc, (/f,t/), tape(t)%hlist(f)%avgflag) - ierr = pio_get_var(File,longname_desc, (/1,f,t/), tape(t)%hlist(f)%field%long_name) - ierr = pio_get_var(File,units_desc, (/1,f,t/), tape(t)%hlist(f)%field%units) - tape(t)%hlist(f)%field%sampling_seq(1:max_chars) = ' ' - ierr = pio_get_var(File,sseq_desc, (/1,f,t/), tape(t)%hlist(f)%field%sampling_seq) - call strip_null(tape(t)%hlist(f)%field%sampling_seq) - tape(t)%hlist(f)%field%cell_methods(1:max_chars) = ' ' - ierr = pio_get_var(File,cm_desc, (/1,f,t/), tape(t)%hlist(f)%field%cell_methods) - call strip_null(tape(t)%hlist(f)%field%cell_methods) - if(xyfill(f,t) ==1) then - tape(t)%hlist(f)%field%flag_xyfill=.true. - else - tape(t)%hlist(f)%field%flag_xyfill=.false. - end if - if(is_subcol(f,t) ==1) then - tape(t)%hlist(f)%field%is_subcol=.true. - else - tape(t)%hlist(f)%field%is_subcol=.false. - end if - call strip_null(tmpname(f,t)) - tape(t)%hlist(f)%field%name = tmpname(f,t) - tape(t)%hlist(f)%field%decomp_type = decomp(f,t) - tape(t)%hlist(f)%field%numlev = tmpnumlev(f,t) - tape(t)%hlist(f)%hwrt_prec = tmpprec(f,t) - - mdimcnt = count(allmdims(:,f,t) > 0) - if(mdimcnt > 0) then - allocate(tape(t)%hlist(f)%field%mdims(mdimcnt)) - do i = 1, mdimcnt - tape(t)%hlist(f)%field%mdims(i) = get_hist_coord_index(mdimnames(allmdims(i,f,t))) - end do - end if - - end do - end do - deallocate(tmpname, tmpnumlev, tmpprec, decomp, xyfill, is_subcol) - deallocate(mdimnames) - - allocate(gridsontape(cam_grid_num_grids() + 1, ptapes)) - gridsontape = -1 - do t = 1, ptapes - do f = 1, nflds(t) - call set_field_dimensions(tape(t)%hlist(f)%field) - - begdim1 = tape(t)%hlist(f)%field%begdim1 - enddim1 = tape(t)%hlist(f)%field%enddim1 - begdim2 = tape(t)%hlist(f)%field%begdim2 - enddim2 = tape(t)%hlist(f)%field%enddim2 - begdim3 = tape(t)%hlist(f)%field%begdim3 - enddim3 = tape(t)%hlist(f)%field%enddim3 - - allocate(tape(t)%hlist(f)%hbuf(begdim1:enddim1,begdim2:enddim2,begdim3:enddim3)) - if (tape(t)%hlist(f)%avgflag .eq. 'S') then ! allocate the variance buffer for standard dev - allocate(tape(t)%hlist(f)%sbuf(begdim1:enddim1,begdim2:enddim2,begdim3:enddim3)) - endif - - if (associated(tape(t)%hlist(f)%varid)) then - deallocate(tape(t)%hlist(f)%varid) - end if - nullify(tape(t)%hlist(f)%varid) - if (associated(tape(t)%hlist(f)%nacs)) then - deallocate(tape(t)%hlist(f)%nacs) - end if - nullify(tape(t)%hlist(f)%nacs) - if(tape(t)%hlist(f)%field%flag_xyfill .or. (avgflag_pertape(t)=='L')) then - allocate (tape(t)%hlist(f)%nacs(begdim1:enddim1,begdim3:enddim3)) - else - allocate(tape(t)%hlist(f)%nacs(1,begdim3:enddim3)) - end if - ! initialize all buffers to zero - this will be overwritten later by the - ! data in the history restart file if it exists. - call h_zero(f,t) - - ! Make sure this field's decomp is listed on the tape - fdecomp = tape(t)%hlist(f)%field%decomp_type - do ff = 1, size(gridsontape, 1) - if (fdecomp == gridsontape(ff, t)) then - exit - else if (gridsontape(ff, t) < 0) then - gridsontape(ff, t) = fdecomp - exit - end if - end do - - end do - end do - ! - !----------------------------------------------------------------------- - ! Read history restart files - !----------------------------------------------------------------------- - ! - ! Loop over the total number of history files declared and - ! read the pathname for any history restart files - ! that are present (if any). Test to see if the run is a restart run - ! AND if any history buffer regen files exist (rgnht=.T.). Note, rgnht - ! is preset to false, reset to true in routine WSDS if hbuf restart files - ! are written and saved in the master restart file. Each history buffer - ! restart file is then obtained. - ! Note: some f90 compilers (e.g. SGI) complain about I/O of - ! derived types which have pointer components, so explicitly read each one. - ! - do t=1,mtapes - if (rgnht(t)) then - ! - ! Open history restart file - ! - call getfil (hrestpath(t), locfn) - call cam_pio_openfile(tape(t)%File, locfn, 0) - ! - ! Read history restart file - ! - do f = 1, nflds(t) - - fname_tmp = strip_suffix(tape(t)%hlist(f)%field%name) - if(masterproc) write(iulog, *) 'Reading history variable ',fname_tmp - ierr = pio_inq_varid(tape(t)%File, fname_tmp, vdesc) - - call cam_pio_var_info(tape(t)%File, vdesc, ndims, dimids, dimlens) - if(.not. associated(tape(t)%hlist(f)%field%mdims)) then - dimcnt = 0 - do i=1,ndims - ierr = pio_inq_dimname(tape(t)%File, dimids(i), dname_tmp) - dimid = get_hist_coord_index(dname_tmp) - if(dimid >= 1) then - dimcnt = dimcnt + 1 - tmpdims(dimcnt) = dimid - ! No else, just looking for mdims (grid dims won't be hist coords) - end if - end do - if(dimcnt > 0) then - allocate(tape(t)%hlist(f)%field%mdims(dimcnt)) - tape(t)%hlist(f)%field%mdims(:) = tmpdims(1:dimcnt) - if(dimcnt > maxvarmdims) maxvarmdims=dimcnt - end if - end if - call set_field_dimensions(tape(t)%hlist(f)%field) - begdim1 = tape(t)%hlist(f)%field%begdim1 - enddim1 = tape(t)%hlist(f)%field%enddim1 - fdims(1) = enddim1 - begdim1 + 1 - begdim2 = tape(t)%hlist(f)%field%begdim2 - enddim2 = tape(t)%hlist(f)%field%enddim2 - fdims(2) = enddim2 - begdim2 + 1 - begdim3 = tape(t)%hlist(f)%field%begdim3 - enddim3 = tape(t)%hlist(f)%field%enddim3 - fdims(3) = enddim3 - begdim3 + 1 - if (fdims(2) > 1) then - nfdims = 3 - else - nfdims = 2 - fdims(2) = fdims(3) - end if - fdecomp = tape(t)%hlist(f)%field%decomp_type - if (nfdims > 2) then - call cam_grid_read_dist_array(tape(t)%File, fdecomp, & - fdims(1:nfdims), dimlens(1:ndims), tape(t)%hlist(f)%hbuf, vdesc) - else - call cam_grid_read_dist_array(tape(t)%File, fdecomp, & - fdims(1:nfdims), dimlens(1:ndims), tape(t)%hlist(f)%hbuf(:,1,:), vdesc) - end if - - if ( associated(tape(t)%hlist(f)%sbuf) ) then - ! read in variance for standard deviation - ierr = pio_inq_varid(tape(t)%File, trim(fname_tmp)//'_var', vdesc) - if (nfdims > 2) then - call cam_grid_read_dist_array(tape(t)%File, fdecomp, & - fdims(1:nfdims), dimlens(1:ndims), tape(t)%hlist(f)%sbuf, vdesc) - else - call cam_grid_read_dist_array(tape(t)%File, fdecomp, & - fdims(1:nfdims), dimlens(1:ndims), tape(t)%hlist(f)%sbuf(:,1,:), vdesc) - end if - endif - - ierr = pio_inq_varid(tape(t)%File, trim(fname_tmp)//'_nacs', vdesc) - call cam_pio_var_info(tape(t)%File, vdesc, nacsdimcnt, dimids, dimlens) - - if(nacsdimcnt > 0) then - if (nfdims > 2) then - ! nacs only has 2 dims (no levels) - fdims(2) = fdims(3) - end if - allocate(tape(t)%hlist(f)%nacs(begdim1:enddim1,begdim3:enddim3)) - nacs => tape(t)%hlist(f)%nacs(:,:) - call cam_grid_read_dist_array(tape(t)%File, fdecomp, fdims(1:2), & - dimlens(1:nacsdimcnt), nacs, vdesc) - else - allocate(tape(t)%hlist(f)%nacs(1,begdim3:enddim3)) - ierr = pio_get_var(tape(t)%File, vdesc, nacsval) - tape(t)%hlist(f)%nacs(1,:)= nacsval - end if - - end do - ! - ! Done reading this history restart file - ! - call cam_pio_closefile(tape(t)%File) - - end if ! rgnht(t) - - ! (re)create the master list of grid IDs - ff = 0 - do f = 1, size(gridsontape, 1) - if (gridsontape(f, t) > 0) then - ff = ff + 1 - end if - end do - allocate(tape(t)%grid_ids(ff)) - ff = 1 - do f = 1, size(gridsontape, 1) - if (gridsontape(f, t) > 0) then - tape(t)%grid_ids(ff) = gridsontape(f, t) - ff = ff + 1 - end if - end do - call patch_init(t) - end do ! end of do mtapes loop - - ! - ! If the history files are partially complete (contain less than - ! mfilt(t) time samples, then get the files and open them.) - ! - ! NOTE: No need to perform this operation for IC history files or empty files - ! - - do t=1,mtapes - if (is_initfile(file_index=t)) then - ! Initialize filename specifier for IC file - hfilename_spec(t) = '%c.cam' // trim(inst_suffix) // '.i.%y-%m-%d-%s.nc' - nfils(t) = 0 - else if (nflds(t) == 0) then - nfils(t) = 0 - else - if (nfils(t) > 0) then - call getfil (cpath(t), locfn) - call cam_pio_openfile(tape(t)%File, locfn, PIO_WRITE) - call h_inquire (t) - if(is_satfile(t)) then - ! Initialize the sat following history subsystem - call sat_hist_init() - call sat_hist_define(tape(t)%File) - end if - end if - ! - ! If the history file is full, close the current unit - ! - if (nfils(t) >= mfilt(t)) then - if (masterproc) then - write(iulog,*)'READ_RESTART_HISTORY: nf_close(',t,')=',nhfil(t), mfilt(t) - end if - do f=1,nflds(t) - deallocate(tape(t)%hlist(f)%varid) - nullify(tape(t)%hlist(f)%varid) - end do - call cam_pio_closefile(tape(t)%File) - nfils(t) = 0 - end if - end if - end do - - ! Setup vector pairs for unstructured grid interpolation - call setup_interpolation_and_define_vector_complements() - - if(mtapes/=ptapes .and. masterproc) then - write(iulog,*) ' WARNING: Restart file ptapes setting ',mtapes,' not equal to model setting ',ptapes - end if - - return - end subroutine read_restart_history - - !####################################################################### - - character(len=max_string_len) function get_hfilepath( tape ) - ! - !----------------------------------------------------------------------- - ! - ! Purpose: Return full filepath of history file for given tape number - ! This allows public read access to the filenames without making - ! the filenames public data. - ! - !----------------------------------------------------------------------- - ! - integer, intent(in) :: tape ! Tape number - - get_hfilepath = cpath( tape ) - end function get_hfilepath - - !####################################################################### - - character(len=max_string_len) function get_hist_restart_filepath( tape ) - ! - !----------------------------------------------------------------------- - ! - ! Purpose: Return full filepath of restart file for given tape number - ! This allows public read access to the filenames without making - ! the filenames public data. - ! - !----------------------------------------------------------------------- - ! - integer, intent(in) :: tape ! Tape number - - get_hist_restart_filepath = hrestpath( tape ) - end function get_hist_restart_filepath - - !####################################################################### - - integer function get_ptapes( ) - ! - !----------------------------------------------------------------------- - ! - ! Purpose: Return the number of tapes being used. - ! This allows public read access to the number of tapes without making - ! ptapes public data. - ! - !----------------------------------------------------------------------- - ! - get_ptapes = ptapes - end function get_ptapes - - !####################################################################### - - recursive function get_entry_by_name(listentry, name) result(entry) - type(master_entry), pointer :: listentry - character(len=*), intent(in) :: name ! variable name - type(master_entry), pointer :: entry - - if(associated(listentry)) then - if(listentry%field%name .eq. name) then - entry => listentry - else - entry=>get_entry_by_name(listentry%next_entry, name) - end if - else - nullify(entry) - end if - end function get_entry_by_name - - !####################################################################### - - subroutine AvgflagToString(avgflag, time_op) - ! Dummy arguments - character(len=1), intent(in) :: avgflag ! averaging flag - character(len=max_chars), intent(out) :: time_op ! time op (e.g. max) - - ! Local variable - character(len=*), parameter :: subname = 'AvgflagToString' - - select case (avgflag) - case ('A') - time_op(:) = 'mean' - case ('B') - time_op(:) = 'mean00z' - case ('I') - time_op(:) = ' ' - case ('X') - time_op(:) = 'maximum' - case ('M') - time_op(:) = 'minimum' - case('L') - time_op(:) = LT_DESC - case ('S') - time_op(:) = 'standard_deviation' - case default - call endrun(subname//': unknown avgflag = '//avgflag) - end select - end subroutine AvgflagToString - - !####################################################################### - - subroutine fldlst () - - use cam_grid_support, only: cam_grid_num_grids - use spmd_utils, only: mpicom - ! - !----------------------------------------------------------------------- - ! - ! Purpose: Define the contents of each history file based on namelist input for initial or branch - ! run, and restart data if a restart run. - ! - ! Method: Use arrays fincl and fexcl to modify default history tape contents. - ! Then sort the result alphanumerically for later use by OUTFLD to - ! allow an n log n search time. - ! - !---------------------------Local variables----------------------------- - ! - integer t, f ! tape, field indices - integer ff ! index into include, exclude and fprec list - character(len=fieldname_len) :: name ! field name portion of fincl (i.e. no avgflag separator) - character(len=max_fieldname_len) :: mastername ! name from masterlist field - character(len=max_chars) :: errormsg ! error output field - character(len=1) :: avgflag ! averaging flag - character(len=1) :: prec_wrt ! history buffer write precision flag - - type (hentry) :: tmp ! temporary used for swapping - - type(master_entry), pointer :: listentry - logical :: fieldontape ! .true. iff field on tape - integer :: errors_found - - ! List of active grids (first dim) for each tape (second dim) - ! An active grid is one for which there is a least one field being output - ! on that grid. - integer, allocatable :: gridsontape(:,:) - - ! - ! First ensure contents of fincl, fexcl, and fwrtpr are all valid names - ! - errors_found = 0 - do t=1,ptapes - f = 1 - do while (f < pflds .and. fincl(f,t) /= ' ') - name = getname (fincl(f,t)) - mastername='' - listentry => get_entry_by_name(masterlinkedlist, name) - if(associated(listentry)) mastername = listentry%field%name - if (name /= mastername) then - write(errormsg,'(3a,2(i0,a))')'FLDLST: ', trim(name), ' in fincl(', f,', ',t, ') not found' - if (masterproc) then - write(iulog,*) trim(errormsg) - call shr_sys_flush(iulog) - end if - errors_found = errors_found + 1 - end if - f = f + 1 - end do - - f = 1 - do while (f < pflds .and. fexcl(f,t) /= ' ') - mastername='' - listentry => get_entry_by_name(masterlinkedlist, fexcl(f,t)) - if(associated(listentry)) mastername = listentry%field%name - - if (fexcl(f,t) /= mastername) then - write(errormsg,'(3a,2(i0,a))')'FLDLST: ', trim(fexcl(f,t)), ' in fexcl(', f,', ',t, ') not found' - if (masterproc) then - write(iulog,*) trim(errormsg) - call shr_sys_flush(iulog) - end if - errors_found = errors_found + 1 - end if - f = f + 1 - end do - - f = 1 - do while (f < pflds .and. fwrtpr(f,t) /= ' ') - name = getname (fwrtpr(f,t)) - mastername='' - listentry => get_entry_by_name(masterlinkedlist, name) - if(associated(listentry)) mastername = listentry%field%name - if (name /= mastername) then - write(errormsg,'(3a,i0,a)')'FLDLST: ', trim(name), ' in fwrtpr(', f, ') not found' - if (masterproc) then - write(iulog,*) trim(errormsg) - call shr_sys_flush(iulog) - end if - errors_found = errors_found + 1 - end if - do ff=1,f-1 ! If duplicate entry is found, stop - if (trim(name) == trim(getname(fwrtpr(ff,t)))) then - write(errormsg,'(3a)')'FLDLST: Duplicate field ', trim(name), ' in fwrtpr' - if (masterproc) then - write(iulog,*) trim(errormsg) - call shr_sys_flush(iulog) - end if - errors_found = errors_found + 1 - end if - end do - f = f + 1 - end do - end do - - if (errors_found > 0) then - ! Give masterproc a chance to write all the log messages - call mpi_barrier(mpicom, t) - write(errormsg, '(a,i0,a)') 'FLDLST: ',errors_found,' errors found, see log' - call endrun(trim(errormsg)) - end if - - nflds(:) = 0 - ! IC history file is to be created, set properties - if(is_initfile()) then - hfilename_spec(ptapes) = '%c.cam' // trim(inst_suffix) // '.i.%y-%m-%d-%s.nc' - - ncprec(ptapes) = pio_double - ndens (ptapes) = 1 - mfilt (ptapes) = 1 - end if - - - - allocate(gridsontape(cam_grid_num_grids() + 1, ptapes)) - gridsontape = -1 - do t=1,ptapes - ! - ! Add the field to the tape if specified via namelist (FINCL[1-ptapes]), or if - ! it is on by default and was not excluded via namelist (FEXCL[1-ptapes]). - ! Also set history buffer accumulation and output precision values according - ! to the values specified via namelist (FWRTPR[1-ptapes]) - ! or, if not on the list, to the default values given by ndens(t). - ! - listentry => masterlinkedlist - do while(associated(listentry)) - mastername = listentry%field%name - call list_index (fincl(1,t), mastername, ff) - - fieldontape = .false. - if (ff > 0) then - fieldontape = .true. - else if ((.not. empty_htapes) .or. (is_initfile(file_index=t))) then - call list_index (fexcl(1,t), mastername, ff) - if (ff == 0 .and. listentry%actflag(t)) then - fieldontape = .true. - end if - end if - if (fieldontape) then - ! The field is active so increment the number fo fields and add - ! its decomp type to the list of decomp types on this tape - nflds(t) = nflds(t) + 1 - do ff = 1, size(gridsontape, 1) - if (listentry%field%decomp_type == gridsontape(ff, t)) then - exit - else if (gridsontape(ff, t) < 0) then - gridsontape(ff, t) = listentry%field%decomp_type - exit - end if - end do - end if - listentry=>listentry%next_entry - end do - end do - ! - ! Determine total number of active history tapes - ! - if (masterproc) then - do t=1,ptapes - if (nflds(t) == 0) then - write(iulog,*)'FLDLST: Tape ',t,' is empty' - end if - end do - endif - allocate(history_tape(ptapes)) - tape=>history_tape - - - do t=1,ptapes - nullify(tape(t)%hlist) - ! Now we have a field count and can allocate - if(nflds(t) > 0) then - ! Allocate the correct number of hentry slots - allocate(tape(t)%hlist(nflds(t))) - ! Count up the number of grids output on this tape - ff = 0 - do f = 1, size(gridsontape, 1) - if (gridsontape(f, t) > 0) then - ff = ff + 1 - end if - end do - allocate(tape(t)%grid_ids(ff)) - ff = 1 - do f = 1, size(gridsontape, 1) - if (gridsontape(f, t) > 0) then - tape(t)%grid_ids(ff) = gridsontape(f, t) - ff = ff + 1 - end if - end do - end if - do ff=1,nflds(t) - nullify(tape(t)%hlist(ff)%hbuf) - nullify(tape(t)%hlist(ff)%sbuf) - nullify(tape(t)%hlist(ff)%nacs) - nullify(tape(t)%hlist(ff)%varid) - end do - - - nflds(t) = 0 ! recount to support array based method - listentry => masterlinkedlist - do while(associated(listentry)) - mastername = listentry%field%name - - call list_index (fwrtpr(1,t), mastername, ff) - if (ff > 0) then - prec_wrt = getflag(fwrtpr(ff,t)) - else - prec_wrt = ' ' - end if - - call list_index (fincl(1,t), mastername, ff) - - if (ff > 0) then - avgflag = getflag (fincl(ff,t)) - call inifld (t, listentry, avgflag, prec_wrt) - else if ((.not. empty_htapes) .or. (is_initfile(file_index=t))) then - call list_index (fexcl(1,t), mastername, ff) - if (ff == 0 .and. listentry%actflag(t)) then - call inifld (t, listentry, ' ', prec_wrt) - else - listentry%actflag(t) = .false. - end if - else - listentry%actflag(t) = .false. - end if - listentry=>listentry%next_entry - - end do - ! - ! If column output is specified make sure there are some fields defined - ! for that tape - ! - if (nflds(t) .eq. 0 .and. fincllonlat(1,t) .ne. ' ') then - write(errormsg,'(a,i2,a)') 'FLDLST: Column output is specified for tape ',t,' but no fields defined for that tape.' - call endrun(errormsg) - else - call patch_init(t) - end if - ! - ! Specification of tape contents now complete. Sort each list of active - ! entries for efficiency in OUTFLD. Simple bubble sort. - ! -!!XXgoldyXX: v In the future, we will sort according to decomp to speed I/O - do f=nflds(t)-1,1,-1 - do ff=1,f - - if (tape(t)%hlist(ff)%field%name > tape(t)%hlist(ff+1)%field%name) then - - tmp = tape(t)%hlist(ff) - tape(t)%hlist(ff ) = tape(t)%hlist(ff+1) - tape(t)%hlist(ff+1) = tmp - - else if (tape(t)%hlist(ff )%field%name == tape(t)%hlist(ff+1)%field%name) then - - write(errormsg,'(2a,2(a,i3))') 'FLDLST: Duplicate field: ', & - trim(tape(t)%hlist(ff)%field%name),', tape = ', t, ', ff = ', ff - call endrun(errormsg) - - end if - - end do - end do - - end do ! do t=1,ptapes - deallocate(gridsontape) - - call print_active_fldlst() - - ! - ! Packing density, ndens: With netcdf, only 1 (nf_double) and 2 (pio_real) - ! are allowed - ! - do t=1,ptapes - if (ndens(t) == 1) then - ncprec(t) = pio_double - else if (ndens(t) == 2) then - ncprec(t) = pio_real - else - call endrun ('FLDLST: ndens must be 1 or 2') - end if - - end do - ! - ! Now that masterlinkedlist is defined, construct primary and secondary hashing - ! tables. - ! - call bld_outfld_hash_tbls() - call bld_htapefld_indices() - - return - end subroutine fldlst - -!######################################################################################### - -subroutine print_active_fldlst() - - integer :: f, ff, i, t - integer :: num_patches - - character(len=6) :: prec_str - character(len=max_chars) :: fldname, fname_tmp - - type(active_entry), pointer :: hfile(:) => null() ! history files - - if (masterproc) then - - hfile=>history_tape - - do t=1,ptapes - - if (nflds(t) > 0) then - write(iulog,*) ' ' - write(iulog,*)'FLDLST: History file ', t, ' contains ', nflds(t), ' fields' - - if (is_initfile(file_index=t)) then - write(iulog,*) ' Write frequency: ',inithist,' (INITIAL CONDITIONS)' - else - if (nhtfrq(t) == 0) then - write(iulog,*) ' Write frequency: MONTHLY' - else - write(iulog,*) ' Write frequency: ',nhtfrq(t) - end if - end if - - write(iulog,*) ' Filename specifier: ', trim(hfilename_spec(t)) - - prec_str = 'double' - if (ndens(t) == 2) prec_str = 'single' - write(iulog,*) ' Output precision: ', prec_str - write(iulog,*) ' Number of time samples per file: ', mfilt(t) - - ! grid info - if (associated(hfile(t)%patches)) then - write(iulog,*) ' Fields are represented on columns (FIELD_LON_LAT)' - else if (associated(hfile(t)%grid_ids)) then - write(iulog,*) ' Fields are represented on global grids:' - do i = 1, size(hfile(t)%grid_ids) - write(iulog,*) ' ', hfile(t)%grid_ids(i) - end do - else - call endrun('print_active_fldlst: error in active_entry object') - end if - - write(iulog,*)' Included fields are:' - - end if - - do f = 1, nflds(t) - if (associated(hfile(t)%patches)) then - num_patches = size(hfile(t)%patches) - fldname = strip_suffix(hfile(t)%hlist(f)%field%name) - do i = 1, num_patches - ff = (f-1)*num_patches + i - fname_tmp = trim(fldname) - call hfile(t)%patches(i)%field_name(fname_tmp) - write(iulog,9000) ff, fname_tmp, hfile(t)%hlist(f)%field%units, & - hfile(t)%hlist(f)%field%numlev, hfile(t)%hlist(f)%avgflag, & - trim(hfile(t)%hlist(f)%field%long_name) - end do - else - fldname = hfile(t)%hlist(f)%field%name - write(iulog,9000) f, fldname, hfile(t)%hlist(f)%field%units, & - hfile(t)%hlist(f)%field%numlev, hfile(t)%hlist(f)%avgflag, & - trim(hfile(t)%hlist(f)%field%long_name) - end if - - end do - - end do - - end if - -9000 format(i5, 1x, a32, 1x, a16, 1x, i4, 1x, a1, 2x, 256a) - -end subroutine print_active_fldlst - -!######################################################################################### - - subroutine inifld (t, listentry, avgflag, prec_wrt) - use cam_grid_support, only: cam_grid_is_zonal - ! - !----------------------------------------------------------------------- - ! - ! Purpose: Add a field to the active list for a history tape - ! - ! Method: Copy the data from the master field list to the active list for the tape - ! Also: define mapping arrays from (col,chunk) -> (lon,lat) - ! - ! Author: CCM Core Group - ! - !----------------------------------------------------------------------- - - - ! - ! Arguments - ! - integer, intent(in) :: t ! history tape index - - type(master_entry), pointer :: listentry - - character(len=1), intent(in) :: avgflag ! averaging flag - character(len=1), intent(in) :: prec_wrt ! history output precision flag - ! - ! Local workspace - ! - integer :: n ! field index on defined tape - - - ! - ! Ensure that it is not to late to add a field to the history tape - ! - if (htapes_defined) then - call endrun ('INIFLD: Attempt to add field '//listentry%field%name//' after history files set') - end if - - nflds(t) = nflds(t) + 1 - n = nflds(t) - ! - ! Copy field info. - ! - if(n > size(tape(t)%hlist)) then - write(iulog,*) 'tape field miscount error ', n, size(tape(t)%hlist) - call endrun() - end if - - tape(t)%hlist(n)%field = listentry%field - - select case (prec_wrt) - case (' ') - if (ndens(t) == 1) then - tape(t)%hlist(n)%hwrt_prec = 8 - else - tape(t)%hlist(n)%hwrt_prec = 4 - end if - case ('4') - tape(t)%hlist(n)%hwrt_prec = 4 - if (masterproc) then - write(iulog,*) 'INIFLD: Output data type for ', tape(t)%hlist(n)%field%name, & - ' is real*4' - end if - case ('8') - tape(t)%hlist(n)%hwrt_prec = 8 - if (masterproc) then - write(iulog,*) 'INIFLD: Output data type for ', tape(t)%hlist(n)%field%name, & - ' is real*8' - end if - case default - call endrun ('INIFLD: unknown prec_wrt='//prec_wrt) - end select - ! - ! Override the default averaging (masterlist) averaging flag if non-blank - ! - if (avgflag == ' ') then - tape(t)%hlist(n)%avgflag = listentry%avgflag(t) - tape(t)%hlist(n)%time_op = listentry%time_op(t) - else - tape(t)%hlist(n)%avgflag = avgflag - call AvgflagToString(avgflag, tape(t)%hlist(n)%time_op) - end if - - ! Some things can't be done with zonal fields - if (cam_grid_is_zonal(listentry%field%decomp_type)) then - if (tape(t)%hlist(n)%avgflag == 'L') then - call endrun("Cannot perform local time processing on zonal data ("//trim(listentry%field%name)//")") - else if (is_satfile(t)) then - call endrun("Zonal data not valid for satellite history ("//trim(listentry%field%name)//")") - end if - end if - -#ifdef HDEBUG - if (masterproc) then - write(iulog,'(a,i0,3a,i0,a,i2)')'HDEBUG: ',__LINE__,' field ', & - trim(tape(t)%hlist(n)%field%name), ' added as field number ', n, & - ' on tape ', t - write(iulog,'(2a)')' units = ',trim(tape(t)%hlist(n)%field%units) - write(iulog,'(a,i0)')' numlev = ',tape(t)%hlist(n)%field%numlev - write(iulog,'(2a)')' avgflag = ',tape(t)%hlist(n)%avgflag - write(iulog,'(3a)')' time_op = "',trim(tape(t)%hlist(n)%time_op),'"' - write(iulog,'(a,i0)')' hwrt_prec = ',tape(t)%hlist(n)%hwrt_prec - end if -#endif - - return - end subroutine inifld - - - subroutine patch_init(t) - use cam_history_support, only: history_patch_t - use cam_grid_support, only: cam_grid_compute_patch - - ! Dummy arguments - integer, intent(in) :: t ! Current tape - - ! Local variables - integer :: ff ! Loop over fincllonlat entries - integer :: i ! General loop index - integer :: npatches - type(history_patch_t), pointer :: patchptr - - character(len=max_chars) :: errormsg - character(len=max_chars) :: lonlatname(pflds) - real(r8) :: beglon, beglat, endlon, endlat - - ! - ! Setup column information if this field will be written as group - ! First verify the column information in the namelist - ! Duplicates are an error, but we can just ignore them - ! - - ! I know, this shouldn't happen . . . yet: (better safe than sorry) - if (associated(tape(t)%patches)) then - do i = 1, size(tape(t)%patches) - call tape(t)%patches(i)%deallocate() - end do - deallocate(tape(t)%patches) - nullify(tape(t)%patches) - end if - - ! First, count the number of patches and check for duplicates - ff = 1 ! Index of fincllonlat entry - npatches = 0 ! Number of unique patches in namelist entry - do while (len_trim(fincllonlat(ff, t)) > 0) - npatches = npatches + 1 - lonlatname(npatches) = trim(fincllonlat(ff, t)) - ! Check for duplicates - do i = 1, npatches - 1 - if (trim(lonlatname(i)) == trim(lonlatname(npatches))) then - write(errormsg, '(a,i0,3a)') 'Duplicate fincl', t, 'lonlat entry.', & - 'Duplicate entry is ', trim(lonlatname(i)) - write(iulog, *) 'patch_init: WARNING: '//errormsg - ! Remove the new entry - lonlatname(npatches) = '' - npatches = npatches - 1 - exit - end if - end do - ff = ff + 1 - end do - - ! Now we know how many patches, allocate space - if (npatches > 0) then - if (collect_column_output(t)) then - allocate(tape(t)%patches(1)) - else - allocate(tape(t)%patches(npatches)) - end if - - ! For each lat/lon specification, parse and create a patch for each grid - do ff = 1, npatches - if (collect_column_output(t)) then - ! For colleccted column output, we only have one patch - patchptr => tape(t)%patches(1) - else - patchptr => tape(t)%patches(ff) - patchptr%namelist_entry = trim(lonlatname(ff)) - end if - ! We need to set up one patch per (active) grid - patchptr%collected_output = collect_column_output(t) - call parseLonLat(lonlatname(ff), & - beglon, endlon, patchptr%lon_axis_name, & - beglat, endlat, patchptr%lat_axis_name) - if (associated(patchptr%patches)) then - ! One last sanity check - if (.not. collect_column_output(t)) then - write(errormsg, '(a,i0,2a)') 'Attempt to overwrite fincl', t, & - 'lonlat entry, ', trim(patchptr%namelist_entry) - call endrun('patch_init: '//errormsg) - end if - else - allocate(patchptr%patches(size(tape(t)%grid_ids))) - end if - do i = 1, size(tape(t)%grid_ids) - call cam_grid_compute_patch(tape(t)%grid_ids(i), patchptr%patches(i),& - beglon, endlon, beglat, endlat, collect_column_output(t)) - end do - nullify(patchptr) - end do - end if - ! We are done processing this tape's fincl#lonlat entries. Now, - ! compact each patch so that the output variables have no holes - ! We wait until now for when collect_column_output(t) is .true. since - ! all the fincl#lonlat entries are concatenated - if (associated(tape(t)%patches)) then - do ff = 1, size(tape(t)%patches) - call tape(t)%patches(ff)%compact() - end do - end if - - end subroutine patch_init - - !####################################################################### - - subroutine strip_null(str) - character(len=*), intent(inout) :: str - integer :: i - do i=1,len(str) - if(ichar(str(i:i))==0) str(i:i)=' ' - end do - end subroutine strip_null - - character(len=max_fieldname_len) function strip_suffix (name) - ! - !---------------------------------------------------------- - ! - ! Purpose: Strip "&IC" suffix from fieldnames if it exists - ! - !---------------------------------------------------------- - ! - ! Arguments - ! - character(len=*), intent(in) :: name - ! - ! Local workspace - ! - integer :: n - ! - !----------------------------------------------------------------------- - ! - strip_suffix = ' ' - - do n = 1,fieldname_len - strip_suffix(n:n) = name(n:n) - if(name(n+1:n+1 ) == ' ' ) return - if(name(n+1:n+fieldname_suffix_len) == fieldname_suffix) return - end do - - strip_suffix(fieldname_len+1:max_fieldname_len) = name(fieldname_len+1:max_fieldname_len) - - return - - end function strip_suffix - - !####################################################################### - - character(len=fieldname_len) function getname (inname) - ! - !----------------------------------------------------------------------- - ! - ! Purpose: retrieve name portion of inname - ! - ! Method: If an averaging flag separater character is present (":") in inname, - ! lop it off - ! - !------------------------------------------------------------------------------- - ! - ! Arguments - ! - character(len=*), intent(in) :: inname - ! - ! Local workspace - ! - integer :: length - integer :: i - - length = len (inname) - - if (length < fieldname_len .or. length > fieldname_lenp2) then - write(iulog,*) 'GETNAME: bad length=',length - call endrun - end if - - getname = ' ' - do i=1,fieldname_len - if (inname(i:i) == ':') exit - getname(i:i) = inname(i:i) - end do - - return - end function getname - - !####################################################################### - - ! parseRangeString: Parse either a coordinate descriptor (e.g., 10S) or a - ! coordinate range (e.g., 10e:20e) - ! chars represents the allowed coordinate character. - ! NB: Does not validate numerical values (e.g., lat <= 90) - subroutine parseRangeString(rangestr, chars, begval, begchar, begname, endval, endchar, endname) - - ! Dummy arguments - character(len=*), intent(in) :: rangestr - character(len=*), intent(in) :: chars - real(r8), intent(out) :: begval - character, intent(out) :: begchar - character(len=*), intent(out) :: begname - real(r8), intent(out) :: endval - character, intent(out) :: endchar - character(len=*), intent(out) :: endname - - ! Local variables - character(len=128) :: errormsg - integer :: colonpos - integer :: beglen, endlen - - ! First, see if we have a position or a range - colonpos = scan(rangestr, ':') - if (colonpos == 0) then - begname = trim(rangestr) - beglen = len_trim(begname) - endname = trim(begname) - else - beglen = colonpos - 1 - begname = rangestr(1:beglen) - endname = trim(rangestr(colonpos+1:)) - endlen = len_trim(endname) - end if - ! begname should be a number (integer or real) followed by a character - if (verify(begname, '0123456789.') /= beglen) then - write(errormsg, *) 'Coordinate range must begin with number, ', begname - call endrun('parseRangeString: '//errormsg) - end if - if (verify(begname(beglen:beglen), chars) /= 0) then - write(errormsg, *) 'Coordinate range must end with character in the ', & - 'set [', trim(chars), '] ', begname - call endrun('parseRangeString: '//errormsg) - end if - ! begname parses so collect the values - read(begname(1:beglen-1), *) begval - begchar = begname(beglen:beglen) - if (colonpos /= 0) then - ! endname should be a number (integer or real) followed by a character - if (verify(endname, '0123456789.') /= endlen) then - write(errormsg, *) 'Coordinate range must begin with number, ', endname - call endrun('parseRangeString: '//errormsg) - end if - if (verify(endname(endlen:endlen), chars) /= 0) then - write(errormsg, *) 'Coordinate range must end with character in the ',& - 'set [', trim(chars), '] ', endname - call endrun('parseRangeString: '//errormsg) - end if - ! endname parses so collect the values - read(endname(1:endlen-1), *) endval - endchar = endname(endlen:endlen) - else - endval = begval - endchar = begchar - end if - - end subroutine parseRangeString - - ! parseLonLat: Parse a lon_lat description allowed by the fincllonlat(n) - ! namelist entries. Returns the starting and ending values of - ! the point or range specified. - ! NB: Does not validate the range against any particular grid - subroutine parseLonLat(lonlatname, beglon, endlon, lonname, beglat, endlat, latname) - - ! Dummy arguments - character(len=*), intent(in) :: lonlatname - real(r8), intent(out) :: beglon - real(r8), intent(out) :: endlon - character(len=*), intent(out) :: lonname - real(r8), intent(out) :: beglat - real(r8), intent(out) :: endlat - character(len=*), intent(out) :: latname - - ! Local variables - character(len=128) :: errormsg - character(len=MAX_CHARS) :: lonstr, latstr - character(len=MAX_CHARS) :: begname, endname - character :: begchar, endchar - integer :: underpos - - ! - ! make sure _ separator is present - ! - underpos = scan(lonlatname, '_') - if (underpos == 0) then - write(errormsg,*) 'Improperly formatted fincllonlat string. ', & - 'Missing underscore character (xxxE_yyyS) ', lonlatname - call endrun('parseLonLat: '//errormsg) - end if - - ! Break out the longitude and latitude sections - lonstr = lonlatname(:underpos-1) - latstr = trim(lonlatname(underpos+1:)) - - ! Parse the longitude section - call parseRangeString(lonstr, 'eEwW', beglon, begchar, begname, endlon, endchar, endname) - ! Convert longitude to degrees East - if ((begchar == 'w') .or. (begchar == 'W')) then - if (beglon > 0.0_r8) then - beglon = 360._r8 - beglon - end if - end if - if ((beglon < 0._r8) .or. (beglon > 360._r8)) then - write(errormsg, *) 'Longitude specification out of range, ', trim(begname) - call endrun('parseLonLat: '//errormsg) - end if - if ((endchar == 'w') .or. (endchar == 'W')) then - if (endlon > 0.0_r8) then - endlon = 360._r8 - endlon - end if - end if - if ((endlon < 0._r8) .or. (endlon > 360._r8)) then - write(errormsg, *) 'Longitude specification out of range, ', trim(endname) - call endrun('parseLonLat: '//errormsg) - end if - if (beglon == endlon) then - lonname = trim(begname) - else - lonname = trim(begname)//'_to_'//trim(endname) - end if - - ! Parse the latitude section - call parseRangeString(latstr, 'nNsS', beglat, begchar, begname, endlat, endchar, endname) - ! Convert longitude to degrees East - if ((begchar == 's') .or. (begchar == 'S')) then - beglat = (-1._r8) * beglat - end if - if ((beglat < -90._r8) .or. (beglat > 90._r8)) then - write(errormsg, *) 'Latitude specification out of range, ', trim(begname) - call endrun('parseLonLat: '//errormsg) - end if - if ((endchar == 's') .or. (endchar == 'S')) then - endlat = (-1._r8) * endlat - end if - if ((endlat < -90._r8) .or. (endlat > 90._r8)) then - write(errormsg, *) 'Latitude specification out of range, ', trim(endname) - call endrun('parseLonLat: '//errormsg) - end if - if (beglat == endlat) then - latname = trim(begname) - else - latname = trim(begname)//'_to_'//trim(endname) - end if - - end subroutine parseLonLat - - - !####################################################################### - - character(len=1) function getflag (inname) - ! - !----------------------------------------------------------------------- - ! - ! Purpose: retrieve flag portion of inname - ! - ! Method: If an averaging flag separater character is present (":") in inname, - ! return the character after it as the flag - ! - !------------------------------------------------------------------------------- - ! - ! Arguments - ! - character(len=*), intent(in) :: inname ! character string - ! - ! Local workspace - ! - integer :: length ! length of inname - integer :: i ! loop index - - length = len (inname) - - if (length /= fieldname_lenp2) then - write(iulog,*) 'GETFLAG: bad length=',length - call endrun - end if - - getflag = ' ' - do i=1,fieldname_lenp2-1 - if (inname(i:i) == ':') then - getflag = inname(i+1:i+1) - exit - end if - end do - - return - end function getflag - - !####################################################################### - - subroutine list_index (list, name, index) - ! - ! Input arguments - ! - character(len=*), intent(in) :: list(pflds) ! input list of names, possibly ":" delimited - character(len=max_fieldname_len), intent(in) :: name ! name to be searched for - ! - ! Output arguments - ! - integer, intent(out) :: index ! index of "name" in "list" - ! - ! Local workspace - ! - character(len=fieldname_len) :: listname ! input name with ":" stripped off. - integer f ! field index - - index = 0 - do f=1,pflds - ! - ! Only list items - ! - listname = getname (list(f)) - if (listname == ' ') exit - if (listname == name) then - index = f - exit - end if - end do - - return - end subroutine list_index - - !####################################################################### - - recursive subroutine outfld (fname, field, idim, c, avg_subcol_field) - use cam_history_buffers, only: hbuf_accum_inst, hbuf_accum_add, hbuf_accum_variance, & - hbuf_accum_add00z, hbuf_accum_max, hbuf_accum_min, & - hbuf_accum_addlcltime - use cam_history_support, only: dim_index_2d - use subcol_pack_mod, only: subcol_unpack - use cam_grid_support, only: cam_grid_id - - interface - subroutine subcol_field_avg_handler(idim, field_in, c, field_out) - use shr_kind_mod, only: r8 => shr_kind_r8 - integer, intent(in) :: idim - real(r8), intent(in) :: field_in(idim, *) - integer, intent(in) :: c - real(r8), intent(out) :: field_out(:,:) - end subroutine subcol_field_avg_handler - end interface - - ! - !----------------------------------------------------------------------- - ! - ! Purpose: Accumulate (or take min, max, etc. as appropriate) input field - ! into its history buffer for appropriate tapes - ! - ! Method: Check 'masterlist' whether the requested field 'fname' is active - ! on one or more history tapes, and if so do the accumulation. - ! If not found, return silently. - ! subcol_field_avg_handler: - ! An interface into subcol_field_avg without creating a dependency as - ! this would cause a dependency loop. See subcol.F90 - ! Note: We cannot know a priori if field is a grid average field or a subcolumn - ! field because many fields passed to outfld are defined on ncol rather - ! than pcols or psetcols. Therefore, we use the avg_subcol_field input - ! to determine whether to average the field input before accumulation. - ! NB: If output is on a subcolumn grid (requested in addfle), it is - ! an error to use avg_subcol_field. A subcolumn field is assumed and - ! subcol_unpack is called before accumulation. - ! - ! Author: CCM Core Group - ! - !----------------------------------------------------------------------- - ! - ! Arguments - ! - character(len=*), intent(in) :: fname ! Field name--should be 8 chars long - - ! For structured grids, idim is the local longitude dimension. - ! For unstructured grids, idim is the local column dimension - ! For phys_decomp, it should be pcols or pcols*psubcols - integer, intent(in) :: idim - real(r8), intent(in) :: field(idim,*) ! Array containing field values - integer, intent(in) :: c ! chunk (physics) or latitude (dynamics) index - logical, optional, intent(in) :: avg_subcol_field - ! - ! Local variables - ! - integer :: t, f ! tape, field indices - - character*1 :: avgflag ! averaging flag - - type (active_entry), pointer :: otape(:) ! Local history_tape pointer - real(r8),pointer :: hbuf(:,:) ! history buffer - real(r8),pointer :: sbuf(:,:) ! variance buffer - integer, pointer :: nacs(:) ! accumulation counter - integer :: begdim2, enddim2, endi - integer :: phys_decomp - type (dim_index_2d) :: dimind ! 2-D dimension index - logical :: flag_xyfill ! non-applicable xy points flagged with fillvalue - real(r8) :: fillvalue - real(r8), allocatable :: afield(:,:) ! Averaged field values - real(r8), allocatable :: ufield(:,:,:) ! Unpacked field values - integer :: ff ! masterlist index pointer - integer :: i, j - logical :: found - logical :: avg_subcols ! average subcols before accum - !----------------------------------------------------------------------- - - call get_field_properties(fname, found, tape_out=otape, ff_out=ff) - phys_decomp = cam_grid_id('physgrid') - - ! If this field is not active, return now - if (.not. found) then - return - end if - - ! - ! Note, the field may be on any or all of the history files (primary - ! and auxiliary). - ! - ! write(iulog,*)'fname_loc=',fname_loc - do t = 1, ptapes - if ( .not. masterlist(ff)%thisentry%actflag(t)) cycle - f = masterlist(ff)%thisentry%htapeindx(t) - ! - ! Update history buffer - ! - flag_xyfill = otape(t)%hlist(f)%field%flag_xyfill - fillvalue = otape(t)%hlist(f)%field%fillvalue - avgflag = otape(t)%hlist(f)%avgflag - nacs => otape(t)%hlist(f)%nacs(:,c) - hbuf => otape(t)%hlist(f)%hbuf(:,:,c) - if (associated(tape(t)%hlist(f)%sbuf)) then - sbuf => otape(t)%hlist(f)%sbuf(:,:,c) - endif - dimind = otape(t)%hlist(f)%field%get_dims(c) - - ! See notes above about validity of avg_subcol_field - if (otape(t)%hlist(f)%field%is_subcol) then - if (present(avg_subcol_field)) then - call endrun('OUTFLD: Cannot average '//trim(fname)//', subcolumn output was requested in addfld') - end if - avg_subcols = .false. - else if (otape(t)%hlist(f)%field%decomp_type == phys_decomp) then - if (present(avg_subcol_field)) then - avg_subcols = avg_subcol_field - else - avg_subcols = .false. - end if - else ! Any dynamics decomposition - if (present(avg_subcol_field)) then - call endrun('OUTFLD: avg_subcol_field only valid for physgrid') - else - avg_subcols = .false. - end if - end if - - begdim2 = otape(t)%hlist(f)%field%begdim2 - enddim2 = otape(t)%hlist(f)%field%enddim2 - if (avg_subcols) then - allocate(afield(pcols, begdim2:enddim2)) - call subcol_field_avg_handler(idim, field, c, afield) - ! Hack! Avoid duplicating select statement below - call outfld(fname, afield, pcols, c) - deallocate(afield) - else if (otape(t)%hlist(f)%field%is_subcol) then - ! We have to assume that using mdimnames (e.g., psubcols) is - ! incompatible with the begdimx, enddimx usage (checked in addfld) - ! Since psubcols is included in levels, take that out - endi = (enddim2 - begdim2 + 1) / psubcols - allocate(ufield(pcols, psubcols, endi)) - allocate(afield(pcols*psubcols, endi)) - do j = 1, endi - do i = 1, idim - afield(i, j) = field(i, j) - end do - end do - ! Initialize unused aray locations. - if (idim < pcols*psubcols) then - if (flag_xyfill) then - afield(idim+1:pcols*psubcols, :) = fillvalue - else - afield(idim+1:pcols*psubcols, :) = 0.0_r8 - end if - end if - if (flag_xyfill) then - call subcol_unpack(c, afield, ufield, fillvalue) - else - call subcol_unpack(c, afield, ufield) - end if - deallocate(afield) - select case (avgflag) - - case ('I') ! Instantaneous - call hbuf_accum_inst(hbuf, ufield, nacs, dimind, pcols, & - flag_xyfill, fillvalue) - - case ('A') ! Time average - call hbuf_accum_add(hbuf, ufield, nacs, dimind, pcols, & - flag_xyfill, fillvalue) - - case ('B') ! Time average only 00z values - call hbuf_accum_add00z(hbuf, ufield, nacs, dimind, pcols, & - flag_xyfill, fillvalue) - - case ('X') ! Maximum over time - call hbuf_accum_max (hbuf, ufield, nacs, dimind, pcols, & - flag_xyfill, fillvalue) - - case ('M') ! Minimum over time - call hbuf_accum_min(hbuf, ufield, nacs, dimind, pcols, & - flag_xyfill, fillvalue) - - case ('L') - call hbuf_accum_addlcltime(hbuf, ufield, nacs, dimind, pcols, & - flag_xyfill, fillvalue, c, & - otape(t)%hlist(f)%field%decomp_type, & - lcltod_start(t), lcltod_stop(t)) - - case ('S') ! Standard deviation - call hbuf_accum_variance(hbuf, sbuf, ufield, nacs, dimind, pcols,& - flag_xyfill, fillvalue) - - case default - call endrun ('OUTFLD: invalid avgflag='//avgflag) - - end select - deallocate(ufield) - else - select case (avgflag) - - case ('I') ! Instantaneous - call hbuf_accum_inst(hbuf, field, nacs, dimind, idim, & - flag_xyfill, fillvalue) - - case ('A') ! Time average - call hbuf_accum_add(hbuf, field, nacs, dimind, idim, & - flag_xyfill, fillvalue) - - case ('B') ! Time average only 00z values - call hbuf_accum_add00z(hbuf, field, nacs, dimind, idim, & - flag_xyfill, fillvalue) - - case ('X') ! Maximum over time - call hbuf_accum_max (hbuf, field, nacs, dimind, idim, & - flag_xyfill, fillvalue) - - case ('M') ! Minimum over time - call hbuf_accum_min(hbuf, field, nacs, dimind, idim, & - flag_xyfill, fillvalue) - - case ('L') - call hbuf_accum_addlcltime(hbuf, field, nacs, dimind, idim, & - flag_xyfill, fillvalue, c, & - otape(t)%hlist(f)%field%decomp_type, & - lcltod_start(t), lcltod_stop(t)) - - case ('S') ! Standard deviation - call hbuf_accum_variance(hbuf, sbuf, field, nacs, dimind, idim,& - flag_xyfill, fillvalue) - - case default - call endrun ('OUTFLD: invalid avgflag='//avgflag) - - end select - end if - - end do - - return - end subroutine outfld - - !####################################################################### - - subroutine get_field_properties(fname, found, tape_out, ff_out) - - implicit none - ! - !----------------------------------------------------------------------- - ! - ! Purpose: If fname is active, lookup and return field information - ! - ! Method: Check 'masterlist' whether the requested field 'fname' is active - ! on one or more history tapes, and if so, return the requested - ! field information - ! - ! Author: goldy - ! - !----------------------------------------------------------------------- - ! - ! Arguments - ! - character(len=*), intent(in) :: fname ! Field name--should be 8 chars long - logical, intent(out) :: found ! Set to true if fname is active - type(active_entry), pointer, optional :: tape_out(:) - integer, intent(out), optional :: ff_out - - ! - ! Local variables - ! - character*(max_fieldname_len) :: fname_loc ! max-char equivalent of fname - integer :: t, ff ! tape, masterindex indices - !----------------------------------------------------------------------- - - ! Need to re-cast the field name so that the hashing works #hackalert - fname_loc = fname - ff = get_masterlist_indx(fname_loc) - - ! Set found to .false. so we can return early if fname is not active - found = .false. - if (present(tape_out)) then - nullify(tape_out) - end if - if (present(ff_out)) then - ff_out = -1 - end if - - ! - ! If ( ff < 0 ), the field is not defined on the masterlist. This check - ! is necessary because of coding errors calling outfld without first defining - ! the field on masterlist. - ! - if ( ff < 0 ) then - return - end if - ! - ! Next, check to see whether this field is active on one or more history - ! tapes. - ! - if ( .not. masterlist(ff)%thisentry%act_sometape ) then - return - end if - ! - ! Note, the field may be on any or all of the history files (primary - ! and auxiliary). - ! - - do t=1, ptapes - if (masterlist(ff)%thisentry%actflag(t)) then - found = .true. - if (present(tape_out)) then - tape_out => history_tape - end if - if (present(ff_out)) then - ff_out = ff - end if - ! We found the info so we are done with the loop - exit - end if - end do - - end subroutine get_field_properties - - !####################################################################### - - logical function is_initfile (file_index) - ! - !------------------------------------------------------------------------ - ! - ! Purpose: to determine: - ! - ! a) if an IC file is active in this model run at all - ! OR, - ! b) if it is active, is the current file index referencing the IC file - ! (IC file is always at ptapes) - ! - !------------------------------------------------------------------------ - ! - ! Arguments - ! - integer, intent(in), optional :: file_index ! index of file in question - - is_initfile = .false. - - if (present(file_index)) then - if (inithist /= 'NONE' .and. file_index == ptapes) is_initfile = .true. - else - if (inithist /= 'NONE' ) is_initfile = .true. - end if - - return - - end function is_initfile - - !####################################################################### - - integer function strcmpf (name1, name2) - ! - !----------------------------------------------------------------------- - ! - ! Purpose: Return the lexical difference between two strings - ! - ! Method: Use ichar() intrinsic as we loop through the names - ! - !----------------------------------------------------------------------- - ! - ! Arguments - ! - character(len=max_fieldname_len), intent(in) :: name1, name2 ! strings to compare - integer n ! loop index - - do n=1,max_fieldname_len - strcmpf = ichar(name1(n:n)) - ichar(name2(n:n)) - if (strcmpf /= 0) exit - end do - - return - end function strcmpf - - !####################################################################### - - subroutine h_inquire (t) - use pio, only: pio_inq_varid, pio_inq_attlen - use cam_pio_utils, only: cam_pio_handle_error - ! - !----------------------------------------------------------------------- - ! - ! Purpose: Ensure that the proper variables are on a history file - ! - ! Method: Issue the appropriate netcdf wrapper calls - ! - !----------------------------------------------------------------------- - ! - ! Arguments - ! - integer, intent(in) :: t ! tape index - ! - ! Local workspace - ! - integer :: f ! field index - integer :: ierr - integer :: i - integer :: num_patches - integer(pio_offset_kind) :: mdimsize - character(len=max_chars) :: fldname, fname_tmp, basename - - ! - ! - ! Dimension id's - ! - tape => history_tape - - - - ! - ! Create variables for model timing and header information - ! - if(.not. is_satfile(t)) then - ierr=pio_inq_varid (tape(t)%File,'ndcur ', tape(t)%ndcurid) - ierr=pio_inq_varid (tape(t)%File,'nscur ', tape(t)%nscurid) - ierr=pio_inq_varid (tape(t)%File,'nsteph ', tape(t)%nstephid) - - ierr=pio_inq_varid (tape(t)%File,'time_bnds', tape(t)%tbndid) - ierr=pio_inq_varid (tape(t)%File,'date_written',tape(t)%date_writtenid) - ierr=pio_inq_varid (tape(t)%File,'time_written',tape(t)%time_writtenid) -#if ( defined BFB_CAM_SCAM_IOP ) - ierr=pio_inq_varid (tape(t)%File,'tsec ',tape(t)%tsecid) - ierr=pio_inq_varid (tape(t)%File,'bdate ',tape(t)%bdateid) -#endif - if (.not. is_initfile(file_index=t) ) then - ! Don't write the GHG/Solar forcing data to the IC file. It is never - ! read from that file so it's confusing to have it there. - ierr=pio_inq_varid (tape(t)%File,'co2vmr ', tape(t)%co2vmrid) - ierr=pio_inq_varid (tape(t)%File,'ch4vmr ', tape(t)%ch4vmrid) - ierr=pio_inq_varid (tape(t)%File,'n2ovmr ', tape(t)%n2ovmrid) - ierr=pio_inq_varid (tape(t)%File,'f11vmr ', tape(t)%f11vmrid) - ierr=pio_inq_varid (tape(t)%File,'f12vmr ', tape(t)%f12vmrid) - ierr=pio_inq_varid (tape(t)%File,'sol_tsi ', tape(t)%sol_tsiid) - if (solar_parms_on) then - ierr=pio_inq_varid (tape(t)%File,'f107 ', tape(t)%f107id) - ierr=pio_inq_varid (tape(t)%File,'f107a ', tape(t)%f107aid) - ierr=pio_inq_varid (tape(t)%File,'f107p ', tape(t)%f107pid) - ierr=pio_inq_varid (tape(t)%File,'kp ', tape(t)%kpid) - ierr=pio_inq_varid (tape(t)%File,'ap ', tape(t)%apid) - endif - if (solar_wind_on) then - ierr=pio_inq_varid (tape(t)%File,'byimf', tape(t)%byimfid) - ierr=pio_inq_varid (tape(t)%File,'bzimf', tape(t)%bzimfid) - ierr=pio_inq_varid (tape(t)%File,'swvel', tape(t)%swvelid) - ierr=pio_inq_varid (tape(t)%File,'swden', tape(t)%swdenid) - endif - if (epot_active) then - ierr=pio_inq_varid (tape(t)%File,'colat_crit1', tape(t)%colat_crit1_id) - ierr=pio_inq_varid (tape(t)%File,'colat_crit2', tape(t)%colat_crit2_id) - endif - end if - end if - ierr=pio_inq_varid (tape(t)%File,'date ', tape(t)%dateid) - ierr=pio_inq_varid (tape(t)%File,'datesec ', tape(t)%datesecid) - ierr=pio_inq_varid (tape(t)%File,'time ', tape(t)%timeid) - - - ! - ! Obtain variable name from ID which was read from restart file - ! - do f=1,nflds(t) - if(.not. associated(tape(t)%hlist(f)%varid)) then - if (associated(tape(t)%patches)) then - allocate(tape(t)%hlist(f)%varid(size(tape(t)%patches))) - else - allocate(tape(t)%hlist(f)%varid(1)) - end if - end if - ! - ! If this field will be put out as columns then get column names for field - ! - if (associated(tape(t)%patches)) then - num_patches = size(tape(t)%patches) - fldname = strip_suffix(tape(t)%hlist(f)%field%name) - do i = 1, num_patches - fname_tmp = trim(fldname) - call tape(t)%patches(i)%field_name(fname_tmp) - ierr = pio_inq_varid(tape(t)%File, trim(fname_tmp), tape(t)%hlist(f)%varid(i)) - call cam_pio_handle_error(ierr, 'H_INQUIRE: Error getting ID for '//trim(fname_tmp)) - ierr = pio_get_att(tape(t)%File, tape(t)%hlist(f)%varid(i), 'basename', basename) - call cam_pio_handle_error(ierr, 'H_INQUIRE: Error getting basename for '//trim(fname_tmp)) - if (trim(fldname) /= trim(basename)) then - call endrun('H_INQUIRE: basename ('//trim(basename)//') does not match fldname ('//trim(fldname)//')') - end if - end do - else - fldname = tape(t)%hlist(f)%field%name - ierr = pio_inq_varid(tape(t)%File, trim(fldname), tape(t)%hlist(f)%varid(1)) - call cam_pio_handle_error(ierr, 'H_INQUIRE: Error getting ID for '//trim(fldname)) - end if - if(tape(t)%hlist(f)%field%numlev>1) then - ierr = pio_inq_attlen(tape(t)%File,tape(t)%hlist(f)%varid(1),'mdims', mdimsize) - if(.not. associated(tape(t)%hlist(f)%field%mdims)) then - allocate(tape(t)%hlist(f)%field%mdims(mdimsize)) - end if - ierr=pio_get_att(tape(t)%File,tape(t)%hlist(f)%varid(1),'mdims', & - tape(t)%hlist(f)%field%mdims(1:mdimsize)) - if(mdimsize>maxvarmdims) maxvarmdims=mdimsize - end if - - end do - - if(masterproc) then - write(iulog,*)'H_INQUIRE: Successfully opened netcdf file ' - end if - - return - end subroutine h_inquire - - !####################################################################### - - subroutine add_default (name, tindex, flag) - ! - !----------------------------------------------------------------------- - ! - ! Purpose: Add a field to the default "on" list for a given history file - ! - ! Method: - ! - !----------------------------------------------------------------------- - ! - ! Arguments - ! - character(len=*), intent(in) :: name ! field name - character(len=1), intent(in) :: flag ! averaging flag - - integer, intent(in) :: tindex ! history tape index - ! - ! Local workspace - ! - integer :: t ! file index - type(master_entry), pointer :: listentry - - if (htapes_defined) then - call endrun ('ADD_DEFAULT: Attempt to add hist default '//trim(name)//' after history files set') - end if - ! - ! Check validity of input arguments - ! - if (tindex > ptapes) then - write(iulog,*)'ADD_DEFAULT: tape index=', tindex, ' is too big' - call endrun - end if - - ! Add to IC file if tindex = 0, reset to ptapes - if (tindex == 0) then - t = ptapes - if ( .not. is_initfile(file_index=t) ) return - else - t = tindex - end if - - if (verify(flag, HIST_AVG_FLAGS) /= 0) then - call endrun ('ADD_DEFAULT: unknown averaging flag='//flag) - end if - ! - ! Look through master list for input field name. When found, set active - ! flag for that tape to true. Also set averaging flag if told to use other - ! than default. - ! - listentry => get_entry_by_name(masterlinkedlist, trim(name)) - if(.not.associated(listentry)) then - call endrun ('ADD_DEFAULT: field = "'//trim(name)//'" not found') - end if - listentry%actflag(t) = .true. - if (flag /= ' ') then - listentry%avgflag(t) = flag - call AvgflagToString(flag, listentry%time_op(t)) - end if - - return - end subroutine add_default - - !####################################################################### - - subroutine h_override (t) - ! - !----------------------------------------------------------------------- - ! - ! Purpose: Override default history tape contents for a specific tape - ! - ! Method: Copy the flag into the master field list - ! - !----------------------------------------------------------------------- - ! - ! Arguments - ! - integer, intent(in) :: t ! history tape index - ! - ! Local workspace - ! - character(len=1) :: avgflg ! lcl equiv of avgflag_pertape(t) (to address xlf90 compiler bug) - - type(master_entry), pointer :: listentry - - - avgflg = avgflag_pertape(t) - - - listentry=>masterlinkedlist - do while(associated(listentry)) - call AvgflagToString(avgflg, listentry%time_op(t)) - listentry%avgflag(t) = avgflag_pertape(t) - listentry=>listentry%next_entry - end do - - end subroutine h_override - - !####################################################################### - - subroutine h_define (t, restart) - ! - !----------------------------------------------------------------------- - ! - ! Purpose: Define contents of history file t - ! - ! Method: Issue the required netcdf wrapper calls to define the history file contents - ! - !----------------------------------------------------------------------- - use cam_grid_support, only: cam_grid_header_info_t - use cam_grid_support, only: cam_grid_write_attr, cam_grid_write_var - use time_manager, only: get_step_size, get_ref_date, timemgr_get_calendar_cf - use cam_abortutils, only: endrun - use cam_pio_utils, only: vdesc_ptr, cam_pio_handle_error, cam_pio_def_dim - use cam_pio_utils, only: cam_pio_createfile, cam_pio_def_var - use sat_hist, only: sat_hist_define - - !----------------------------------------------------------------------- - - ! - ! Input arguments - ! - integer, intent(in) :: t ! tape index - logical, intent(in) :: restart - ! - ! Local workspace - ! - integer :: i, j ! longitude, latitude indices - integer :: grd ! indices for looping through grids - integer :: f ! field index - integer :: ncreal ! real data type for output - integer :: dtime ! timestep size - integer :: sec_nhtfrq ! nhtfrq converted to seconds - integer :: ndbase = 0 ! days component of base time - integer :: nsbase = 0 ! seconds component of base time - integer :: nbdate ! base date in yyyymmdd format - integer :: nbsec ! time of day component of base date [seconds] - integer :: yr, mon, day ! year, month, day components of a date - - character(len=max_chars) :: str ! character temporary - character(len=max_chars) :: fname_tmp ! local copy of field name - character(len=max_chars) :: calendar ! Calendar type - character(len=max_chars) :: cell_methods ! For cell_methods attribute - character(len=16) :: time_per_freq - character(len=128) :: errormsg - - integer :: ret ! function return value - - ! - ! netcdf dimensions - ! - integer :: chardim ! character dimension id - integer :: dimenchar(2) ! character dimension ids - integer :: nacsdims(2) ! dimension ids for nacs (used in restart file) - integer :: bnddim ! bounds dimension id - integer :: timdim ! unlimited dimension id - - integer :: dimindex(8) ! dimension ids for variable declaration - integer :: dimids_tmp(8) ! dimension ids for variable declaration - - ! - ! netcdf variables - ! - ! A structure to hold the horizontal dimension and coordinate info - type(cam_grid_header_info_t), allocatable :: header_info(:) - ! For satellite files and column output - type(vdesc_ptr), allocatable :: latvar(:) ! latitude variable ids - type(vdesc_ptr), allocatable :: lonvar(:) ! longitude variable ids - - type(var_desc_t), pointer :: varid => NULL() ! temporary variable descriptor - integer :: num_hdims, fdims - integer :: num_patches ! How many entries for a field on this tape? - integer, pointer :: mdims(:) => NULL() - integer :: mdimsize - integer :: ierr - integer, allocatable :: mdimids(:) - integer :: amode - logical :: interpolate - logical :: patch_output - - if(restart) then - tape => restarthistory_tape - if(masterproc) write(iulog,*)'Opening netcdf history restart file ', trim(hrestpath(t)) - else - tape => history_tape - if(masterproc) write(iulog,*)'Opening netcdf history file ', trim(nhfil(t)) - end if - - amode = PIO_CLOBBER - - if(restart) then - call cam_pio_createfile (tape(t)%File, hrestpath(t), amode) - else - call cam_pio_createfile (tape(t)%File, nhfil(t), amode) - end if - if(is_satfile(t)) then - interpolate = .false. ! !!XXgoldyXX: Do we ever want to support this? - patch_output = .false. - call cam_pio_def_dim(tape(t)%File, 'ncol', pio_unlimited, timdim) - call cam_pio_def_dim(tape(t)%File, 'nbnd', 2, bnddim) - - allocate(latvar(1), lonvar(1)) - allocate(latvar(1)%vd, lonvar(1)%vd) - call cam_pio_def_var(tape(t)%File, 'lat', pio_double, (/timdim/), & - latvar(1)%vd) - ierr=pio_put_att (tape(t)%File, latvar(1)%vd, 'long_name', 'latitude') - ierr=pio_put_att (tape(t)%File, latvar(1)%vd, 'units', 'degrees_north') - - call cam_pio_def_var(tape(t)%File, 'lon', pio_double, (/timdim/), & - lonvar(1)%vd) - ierr=pio_put_att (tape(t)%File, lonvar(1)%vd,'long_name','longitude') - ierr=pio_put_att (tape(t)%File, lonvar(1)%vd,'units','degrees_east') - - else - ! - ! Setup netcdf file - create the dimensions of lat,lon,time,level - ! - ! interpolate is only supported for unstructured dycores - interpolate = (interpolate_output(t) .and. (.not. restart)) - patch_output = (associated(tape(t)%patches) .and. (.not. restart)) - - ! First define the horizontal grid dims - ! Interpolation is special in that we ignore the native grids - if(interpolate) then - allocate(header_info(1)) - call cam_grid_write_attr(tape(t)%File, interpolate_info(t)%grid_id, header_info(1)) - else if (patch_output) then - ! We are doing patch (column) output - if (allocated(header_info)) then - ! We shouldn't have any header_info yet - call endrun('H_DEFINE: header_info should not be allocated for patch output') - end if - do i = 1, size(tape(t)%patches) - call tape(t)%patches(i)%write_attrs(tape(t)%File) - end do - else - allocate(header_info(size(tape(t)%grid_ids))) - do i = 1, size(tape(t)%grid_ids) - call cam_grid_write_attr(tape(t)%File, tape(t)%grid_ids(i), header_info(i)) - end do - end if ! interpolate - - ! Define the unlimited time dim - call cam_pio_def_dim(tape(t)%File, 'time', pio_unlimited, timdim) - call cam_pio_def_dim(tape(t)%File, 'nbnd', 2, bnddim, existOK=.true.) - call cam_pio_def_dim(tape(t)%File, 'chars', 8, chardim) - end if ! is satfile - - ! Populate the history coordinate (well, mdims anyway) attributes - ! This routine also allocates the mdimids array - call write_hist_coord_attrs(tape(t)%File, bnddim, mdimids, restart) - - call get_ref_date(yr, mon, day, nbsec) - nbdate = yr*10000 + mon*100 + day - ierr=pio_def_var (tape(t)%File,'time',pio_double,(/timdim/),tape(t)%timeid) - ierr=pio_put_att (tape(t)%File, tape(t)%timeid, 'long_name', 'time') - str = 'days since ' // date2yyyymmdd(nbdate) // ' ' // sec2hms(nbsec) - ierr=pio_put_att (tape(t)%File, tape(t)%timeid, 'units', trim(str)) - - calendar = timemgr_get_calendar_cf() - ierr=pio_put_att (tape(t)%File, tape(t)%timeid, 'calendar', trim(calendar)) - - - ierr=pio_def_var (tape(t)%File,'date ',pio_int,(/timdim/),tape(t)%dateid) - str = 'current date (YYYYMMDD)' - ierr=pio_put_att (tape(t)%File, tape(t)%dateid, 'long_name', trim(str)) - - - ierr=pio_def_var (tape(t)%File,'datesec ',pio_int,(/timdim/), tape(t)%datesecid) - str = 'current seconds of current date' - ierr=pio_put_att (tape(t)%File, tape(t)%datesecid, 'long_name', trim(str)) - - ! - ! Character header information - ! - str = 'CF-1.0' - ierr=pio_put_att (tape(t)%File, PIO_GLOBAL, 'Conventions', trim(str)) - ierr=pio_put_att (tape(t)%File, PIO_GLOBAL, 'source', 'CAM') -#if ( defined BFB_CAM_SCAM_IOP ) - ierr=pio_put_att (tape(t)%File, PIO_GLOBAL, 'CAM_GENERATED_FORCING','create SCAM IOP dataset') -#endif - ierr=pio_put_att (tape(t)%File, PIO_GLOBAL, 'case',caseid) - ierr=pio_put_att (tape(t)%File, PIO_GLOBAL, 'logname',logname) - ierr=pio_put_att (tape(t)%File, PIO_GLOBAL, 'host', host) - -! Put these back in when they are filled properly -! ierr=pio_put_att (tape(t)%File, PIO_GLOBAL, 'title',ctitle) -! ierr= pio_put_att (tape(t)%File, PIO_GLOBAL, 'Version', & -! '$Name$') -! ierr= pio_put_att (tape(t)%File, PIO_GLOBAL, 'revision_Id', & -! '$Id$') - - ierr=pio_put_att (tape(t)%File, PIO_GLOBAL, 'initial_file', ncdata) - ierr=pio_put_att (tape(t)%File, PIO_GLOBAL, 'topography_file', bnd_topo) - if (len_trim(model_doi_url) > 0) then - ierr=pio_put_att (tape(t)%File, PIO_GLOBAL, 'model_doi_url', model_doi_url) - end if - - ! Determine what time period frequency is being output for each file - ! Note that nhtfrq is now in timesteps - - sec_nhtfrq = nhtfrq(t) - - ! If nhtfrq is in hours, convert to seconds - if (nhtfrq(t) < 0) then - sec_nhtfrq = abs(nhtfrq(t))*3600 - end if - - dtime = get_step_size() - if (sec_nhtfrq == 0) then !month - time_per_freq = 'month_1' - else if (mod(sec_nhtfrq*dtime,86400) == 0) then ! day - write(time_per_freq,999) 'day_',sec_nhtfrq*dtime/86400 - else if (mod(sec_nhtfrq*dtime,3600) == 0) then ! hour - write(time_per_freq,999) 'hour_',(sec_nhtfrq*dtime)/3600 - else if (mod(sec_nhtfrq*dtime,60) == 0) then ! minute - write(time_per_freq,999) 'minute_',(sec_nhtfrq*dtime)/60 - else ! second - write(time_per_freq,999) 'second_',sec_nhtfrq*dtime - end if -999 format(a,i0) - - ierr=pio_put_att (tape(t)%File, PIO_GLOBAL, 'time_period_freq', trim(time_per_freq)) - - if(.not. is_satfile(t)) then - - ierr=pio_put_att (tape(t)%File, tape(t)%timeid, 'bounds', 'time_bnds') - - ierr=pio_def_var (tape(t)%File,'time_bnds',pio_double,(/bnddim,timdim/),tape(t)%tbndid) - ierr=pio_put_att (tape(t)%File, tape(t)%tbndid, 'long_name', 'time interval endpoints') - ! - ! Character - ! - dimenchar(1) = chardim - dimenchar(2) = timdim - ierr=pio_def_var (tape(t)%File,'date_written',PIO_CHAR,dimenchar, tape(t)%date_writtenid) - ierr=pio_def_var (tape(t)%File,'time_written',PIO_CHAR,dimenchar, tape(t)%time_writtenid) - ! - ! Integer Header - ! - - ierr=pio_def_var (tape(t)%File,'ndbase',PIO_INT,tape(t)%ndbaseid) - str = 'base day' - ierr=pio_put_att (tape(t)%File, tape(t)%ndbaseid, 'long_name', trim(str)) - - ierr=pio_def_var (tape(t)%File,'nsbase',PIO_INT,tape(t)%nsbaseid) - str = 'seconds of base day' - ierr=pio_put_att (tape(t)%File, tape(t)%nsbaseid, 'long_name', trim(str)) - - ierr=pio_def_var (tape(t)%File,'nbdate',PIO_INT,tape(t)%nbdateid) - str = 'base date (YYYYMMDD)' - ierr=pio_put_att (tape(t)%File, tape(t)%nbdateid, 'long_name', trim(str)) - -#if ( defined BFB_CAM_SCAM_IOP ) - ierr=pio_def_var (tape(t)%File,'bdate',PIO_INT,tape(t)%bdateid) - str = 'base date (YYYYMMDD)' - ierr=pio_put_att (tape(t)%File, tape(t)%bdateid, 'long_name', trim(str)) -#endif - ierr=pio_def_var (tape(t)%File,'nbsec',PIO_INT,tape(t)%nbsecid) - str = 'seconds of base date' - ierr=pio_put_att (tape(t)%File, tape(t)%nbsecid, 'long_name', trim(str)) - - ierr=pio_def_var (tape(t)%File,'mdt',PIO_INT,tape(t)%mdtid) - ierr=pio_put_att (tape(t)%File, tape(t)%mdtid, 'long_name', 'timestep') - ierr=pio_put_att (tape(t)%File, tape(t)%mdtid, 'units', 's') - - ! - ! Create variables for model timing and header information - ! - - ierr=pio_def_var (tape(t)%File,'ndcur ',pio_int,(/timdim/),tape(t)%ndcurid) - str = 'current day (from base day)' - ierr=pio_put_att (tape(t)%File, tape(t)%ndcurid, 'long_name', trim(str)) - - ierr=pio_def_var (tape(t)%File,'nscur ',pio_int,(/timdim/),tape(t)%nscurid) - str = 'current seconds of current day' - ierr=pio_put_att (tape(t)%File, tape(t)%nscurid, 'long_name', trim(str)) - - - if (.not. is_initfile(file_index=t)) then - ! Don't write the GHG/Solar forcing data to the IC file. - ierr=pio_def_var (tape(t)%File,'co2vmr ',pio_double,(/timdim/),tape(t)%co2vmrid) - str = 'co2 volume mixing ratio' - ierr=pio_put_att (tape(t)%File, tape(t)%co2vmrid, 'long_name', trim(str)) - - ierr=pio_def_var (tape(t)%File,'ch4vmr ',pio_double,(/timdim/),tape(t)%ch4vmrid) - str = 'ch4 volume mixing ratio' - ierr=pio_put_att (tape(t)%File, tape(t)%ch4vmrid, 'long_name', trim(str)) - - ierr=pio_def_var (tape(t)%File,'n2ovmr ',pio_double,(/timdim/),tape(t)%n2ovmrid) - str = 'n2o volume mixing ratio' - ierr=pio_put_att (tape(t)%File, tape(t)%n2ovmrid, 'long_name', trim(str)) - - ierr=pio_def_var (tape(t)%File,'f11vmr ',pio_double,(/timdim/),tape(t)%f11vmrid) - str = 'f11 volume mixing ratio' - ierr=pio_put_att (tape(t)%File, tape(t)%f11vmrid, 'long_name', trim(str)) - - ierr=pio_def_var (tape(t)%File,'f12vmr ',pio_double,(/timdim/),tape(t)%f12vmrid) - str = 'f12 volume mixing ratio' - ierr=pio_put_att (tape(t)%File, tape(t)%f12vmrid, 'long_name', trim(str)) - - ierr=pio_def_var (tape(t)%File,'sol_tsi ',pio_double,(/timdim/),tape(t)%sol_tsiid) - str = 'total solar irradiance' - ierr=pio_put_att (tape(t)%File, tape(t)%sol_tsiid, 'long_name', trim(str)) - str = 'W/m2' - ierr=pio_put_att (tape(t)%File, tape(t)%sol_tsiid, 'units', trim(str)) - - if (solar_parms_on) then - ! solar / geomagetic activity indices... - ierr=pio_def_var (tape(t)%File,'f107',pio_double,(/timdim/),tape(t)%f107id) - str = '10.7 cm solar radio flux (F10.7)' - ierr=pio_put_att (tape(t)%File, tape(t)%f107id, 'long_name', trim(str)) - str = '10^-22 W m^-2 Hz^-1' - ierr=pio_put_att (tape(t)%File, tape(t)%f107id, 'units', trim(str)) - - ierr=pio_def_var (tape(t)%File,'f107a',pio_double,(/timdim/),tape(t)%f107aid) - str = '81-day centered mean of 10.7 cm solar radio flux (F10.7)' - ierr=pio_put_att (tape(t)%File, tape(t)%f107aid, 'long_name', trim(str)) - - ierr=pio_def_var (tape(t)%File,'f107p',pio_double,(/timdim/),tape(t)%f107pid) - str = 'Pervious day 10.7 cm solar radio flux (F10.7)' - ierr=pio_put_att (tape(t)%File, tape(t)%f107pid, 'long_name', trim(str)) - - ierr=pio_def_var (tape(t)%File,'kp',pio_double,(/timdim/),tape(t)%kpid) - str = 'Daily planetary K geomagnetic index' - ierr=pio_put_att (tape(t)%File, tape(t)%kpid, 'long_name', trim(str)) - - ierr=pio_def_var (tape(t)%File,'ap',pio_double,(/timdim/),tape(t)%apid) - str = 'Daily planetary A geomagnetic index' - ierr=pio_put_att (tape(t)%File, tape(t)%apid, 'long_name', trim(str)) - endif - if (solar_wind_on) then - - ierr=pio_def_var (tape(t)%File,'byimf',pio_double,(/timdim/),tape(t)%byimfid) - str = 'Y component of the interplanetary magnetic field' - ierr=pio_put_att (tape(t)%File, tape(t)%byimfid, 'long_name', trim(str)) - str = 'nT' - ierr=pio_put_att (tape(t)%File, tape(t)%byimfid, 'units', trim(str)) - - ierr=pio_def_var (tape(t)%File,'bzimf',pio_double,(/timdim/),tape(t)%bzimfid) - str = 'Z component of the interplanetary magnetic field' - ierr=pio_put_att (tape(t)%File, tape(t)%bzimfid, 'long_name', trim(str)) - str = 'nT' - ierr=pio_put_att (tape(t)%File, tape(t)%bzimfid, 'units', trim(str)) - - ierr=pio_def_var (tape(t)%File,'swvel',pio_double,(/timdim/),tape(t)%swvelid) - str = 'Solar wind speed' - ierr=pio_put_att (tape(t)%File, tape(t)%swvelid, 'long_name', trim(str)) - str = 'km/sec' - ierr=pio_put_att (tape(t)%File, tape(t)%swvelid, 'units', trim(str)) - - ierr=pio_def_var (tape(t)%File,'swden',pio_double,(/timdim/),tape(t)%swdenid) - str = 'Solar wind ion number density' - ierr=pio_put_att (tape(t)%File, tape(t)%swdenid, 'long_name', trim(str)) - str = 'cm-3' - ierr=pio_put_att (tape(t)%File, tape(t)%swdenid, 'units', trim(str)) - - endif - if (epot_active) then - ierr=pio_def_var (tape(t)%File,'colat_crit1',pio_double,(/timdim/),tape(t)%colat_crit1_id) - ierr=pio_put_att (tape(t)%File, tape(t)%colat_crit1_id, 'long_name', & - 'First co-latitude of electro-potential critical angle') - ierr=pio_put_att (tape(t)%File, tape(t)%colat_crit1_id, 'units', 'degrees') - - ierr=pio_def_var (tape(t)%File,'colat_crit2',pio_double,(/timdim/),tape(t)%colat_crit2_id) - ierr=pio_put_att (tape(t)%File, tape(t)%colat_crit2_id, 'long_name',& - 'Second co-latitude of electro-potential critical angle') - ierr=pio_put_att (tape(t)%File, tape(t)%colat_crit2_id, 'units', 'degrees') - endif - end if - - -#if ( defined BFB_CAM_SCAM_IOP ) - ierr=pio_def_var (tape(t)%File,'tsec ',pio_int,(/timdim/), tape(t)%tsecid) - str = 'current seconds of current date needed for scam' - ierr=pio_put_att (tape(t)%File, tape(t)%tsecid, 'long_name', trim(str)) -#endif - ierr=pio_def_var (tape(t)%File,'nsteph ',pio_int,(/timdim/),tape(t)%nstephid) - str = 'current timestep' - ierr=pio_put_att (tape(t)%File, tape(t)%nstephid, 'long_name', trim(str)) - end if ! .not. is_satfile - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! - ! Create variables and attributes for field list - ! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - do f = 1, nflds(t) - - !! Collect some field properties - call AvgflagToString(tape(t)%hlist(f)%avgflag, tape(t)%hlist(f)%time_op) - - if ((tape(t)%hlist(f)%hwrt_prec == 8) .or. restart) then - ncreal = pio_double - else - ncreal = pio_real - end if - - if(associated(tape(t)%hlist(f)%field%mdims)) then - mdims => tape(t)%hlist(f)%field%mdims - mdimsize = size(mdims) - else if(tape(t)%hlist(f)%field%numlev > 1) then - call endrun('mdims not defined for variable '//trim(tape(t)%hlist(f)%field%name)) - else - mdimsize=0 - end if - - ! num_patches will loop through the number of patches (or just one - ! for the whole grid) for this field for this tape - if (patch_output) then - num_patches = size(tape(t)%patches) - else - num_patches = 1 - end if - if(.not.associated(tape(t)%hlist(f)%varid)) then - allocate(tape(t)%hlist(f)%varid(num_patches)) - end if - fname_tmp = strip_suffix(tape(t)%hlist(f)%field%name) - - if(is_satfile(t)) then - num_hdims=0 - nfils(t)=1 - call sat_hist_define(tape(t)%File) - else if (interpolate) then - ! Interpolate can't use normal grid code since we are forcing fields - ! to use interpolate decomp - if (.not. allocated(header_info)) then - ! Safety check - call endrun('h_define: header_info not allocated') - end if - num_hdims = 2 - do i = 1, num_hdims - dimindex(i) = header_info(1)%get_hdimid(i) - nacsdims(i) = header_info(1)%get_hdimid(i) - end do - else if (patch_output) then - ! All patches for this variable should be on the same grid - num_hdims = tape(t)%patches(1)%num_hdims(tape(t)%hlist(f)%field%decomp_type) - else - ! Normal grid output - ! Find appropriate grid in header_info - if (.not. allocated(header_info)) then - ! Safety check - call endrun('h_define: header_info not allocated') - end if - grd = -1 - do i = 1, size(header_info) - if (header_info(i)%get_gridid() == tape(t)%hlist(f)%field%decomp_type) then - grd = i - exit - end if - end do - if (grd < 0) then - write(errormsg, '(a,i0,2a)') 'grid, ',tape(t)%hlist(f)%field%decomp_type,', not found for ',trim(fname_tmp) - call endrun('H_DEFINE: '//errormsg) - end if - num_hdims = header_info(grd)%num_hdims() - do i = 1, num_hdims - dimindex(i) = header_info(grd)%get_hdimid(i) - nacsdims(i) = header_info(grd)%get_hdimid(i) - end do - end if ! is_satfile - - ! - ! Create variables and atributes for fields written out as columns - ! - - do i = 1, num_patches - fname_tmp = strip_suffix(tape(t)%hlist(f)%field%name) - varid => tape(t)%hlist(f)%varid(i) - dimids_tmp = dimindex - ! Figure the dimension ID array for this field - ! We have defined the horizontal grid dimensions in dimindex - fdims = num_hdims - do j = 1, mdimsize - fdims = fdims + 1 - dimids_tmp(fdims) = mdimids(mdims(j)) - end do - if(.not. restart) then - ! Only add time dimension if this is not a restart history tape - fdims = fdims + 1 - dimids_tmp(fdims) = timdim - end if - if (patch_output) then - ! For patch output, we need new dimension IDs and a different name - call tape(t)%patches(i)%get_var_data(fname_tmp, & - dimids_tmp(1:fdims), tape(t)%hlist(f)%field%decomp_type) - end if - ! Define the variable - call cam_pio_def_var(tape(t)%File, trim(fname_tmp), ncreal, & - dimids_tmp(1:fdims), varid) - if (mdimsize > 0) then - ierr = pio_put_att(tape(t)%File, varid, 'mdims', mdims(1:mdimsize)) - call cam_pio_handle_error(ierr, 'h_define: cannot define mdims for '//trim(fname_tmp)) - end if - str = tape(t)%hlist(f)%field%sampling_seq - if (len_trim(str) > 0) then - ierr = pio_put_att(tape(t)%File, varid, 'Sampling_Sequence', trim(str)) - call cam_pio_handle_error(ierr, 'h_define: cannot define Sampling_Sequence for '//trim(fname_tmp)) - end if - - if (tape(t)%hlist(f)%field%flag_xyfill) then - ! Add both _FillValue and missing_value to cover expectations - ! of various applications. - ! The attribute type must match the data type. - if ((tape(t)%hlist(f)%hwrt_prec == 8) .or. restart) then - ierr = pio_put_att(tape(t)%File, varid, '_FillValue', & - tape(t)%hlist(f)%field%fillvalue) - call cam_pio_handle_error(ierr, & - 'h_define: cannot define _FillValue for '//trim(fname_tmp)) - ierr = pio_put_att(tape(t)%File, varid, 'missing_value', & - tape(t)%hlist(f)%field%fillvalue) - call cam_pio_handle_error(ierr, & - 'h_define: cannot define missing_value for '//trim(fname_tmp)) - else - ierr = pio_put_att(tape(t)%File, varid, '_FillValue', & - REAL(tape(t)%hlist(f)%field%fillvalue,r4)) - call cam_pio_handle_error(ierr, & - 'h_define: cannot define _FillValue for '//trim(fname_tmp)) - ierr = pio_put_att(tape(t)%File, varid, 'missing_value', & - REAL(tape(t)%hlist(f)%field%fillvalue,r4)) - call cam_pio_handle_error(ierr, & - 'h_define: cannot define missing_value for '//trim(fname_tmp)) - end if - end if - - str = tape(t)%hlist(f)%field%units - if (len_trim(str) > 0) then - ierr=pio_put_att (tape(t)%File, varid, 'units', trim(str)) - call cam_pio_handle_error(ierr, & - 'h_define: cannot define units for '//trim(fname_tmp)) - end if - - str = tape(t)%hlist(f)%field%long_name - ierr=pio_put_att (tape(t)%File, varid, 'long_name', trim(str)) - call cam_pio_handle_error(ierr, & - 'h_define: cannot define long_name for '//trim(fname_tmp)) - ! - ! Assign field attributes defining valid levels and averaging info - ! - cell_methods = '' - if (len_trim(tape(t)%hlist(f)%field%cell_methods) > 0) then - if (len_trim(cell_methods) > 0) then - cell_methods = trim(cell_methods)//' '//trim(tape(t)%hlist(f)%field%cell_methods) - else - cell_methods = trim(cell_methods)//trim(tape(t)%hlist(f)%field%cell_methods) - end if - end if - ! Time cell methods is after field method because time averaging is - ! applied later (just before output) than field method which is applied - ! before outfld call. - str = tape(t)%hlist(f)%time_op - select case (str) - case ('mean', 'maximum', 'minimum', 'standard_deviation') - if (len_trim(cell_methods) > 0) then - cell_methods = trim(cell_methods)//' '//'time: '//str - else - cell_methods = trim(cell_methods)//'time: '//str - end if - end select - if (len_trim(cell_methods) > 0) then - ierr = pio_put_att(tape(t)%File, varid, 'cell_methods', trim(cell_methods)) - call cam_pio_handle_error(ierr, & - 'h_define: cannot define cell_methods for '//trim(fname_tmp)) - end if - if (patch_output) then - ierr = pio_put_att(tape(t)%File, varid, 'basename', & - tape(t)%hlist(f)%field%name) - call cam_pio_handle_error(ierr, & - 'h_define: cannot define basename for '//trim(fname_tmp)) - end if - - if (restart) then - ! For restart history files, we need to save accumulation counts - fname_tmp = trim(fname_tmp)//'_nacs' - if (.not. associated(tape(t)%hlist(f)%nacs_varid)) then - allocate(tape(t)%hlist(f)%nacs_varid) - end if - if (size(tape(t)%hlist(f)%nacs, 1) > 1) then - call cam_pio_def_var(tape(t)%File, trim(fname_tmp), pio_int, & - nacsdims(1:num_hdims), tape(t)%hlist(f)%nacs_varid) - else - ! Save just one value representing all chunks - call cam_pio_def_var(tape(t)%File, trim(fname_tmp), pio_int, & - tape(t)%hlist(f)%nacs_varid) - end if - ! for standard deviation - if (associated(tape(t)%hlist(f)%sbuf)) then - fname_tmp = strip_suffix(tape(t)%hlist(f)%field%name) - fname_tmp = trim(fname_tmp)//'_var' - if ( .not.associated(tape(t)%hlist(f)%sbuf_varid)) then - allocate(tape(t)%hlist(f)%sbuf_varid) - endif - call cam_pio_def_var(tape(t)%File, trim(fname_tmp), pio_double, & - dimids_tmp(1:fdims), tape(t)%hlist(f)%sbuf_varid) - endif - end if - end do ! Loop over output patches - end do ! Loop over fields - ! - deallocate(mdimids) - ret = pio_enddef(tape(t)%File) - - if(masterproc) then - write(iulog,*)'H_DEFINE: Successfully opened netcdf file ' - endif - ! - ! Write time-invariant portion of history header - ! - if(.not. is_satfile(t)) then - if(interpolate) then - call cam_grid_write_var(tape(t)%File, interpolate_info(t)%grid_id) - else if((.not. patch_output) .or. restart) then - do i = 1, size(tape(t)%grid_ids) - call cam_grid_write_var(tape(t)%File, tape(t)%grid_ids(i)) - end do - else - ! Patch output - do i = 1, size(tape(t)%patches) - call tape(t)%patches(i)%write_vals(tape(t)%File) - end do - end if ! interpolate - if (allocated(lonvar)) then - deallocate(lonvar) - end if - if (allocated(latvar)) then - deallocate(latvar) - end if - - dtime = get_step_size() - ierr = pio_put_var(tape(t)%File, tape(t)%mdtid, (/dtime/)) - call cam_pio_handle_error(ierr, 'h_define: cannot put mdt') - ! - ! Model date info - ! - ierr = pio_put_var(tape(t)%File, tape(t)%ndbaseid, (/ndbase/)) - call cam_pio_handle_error(ierr, 'h_define: cannot put ndbase') - ierr = pio_put_var(tape(t)%File, tape(t)%nsbaseid, (/nsbase/)) - call cam_pio_handle_error(ierr, 'h_define: cannot put nsbase') - - ierr = pio_put_var(tape(t)%File, tape(t)%nbdateid, (/nbdate/)) - call cam_pio_handle_error(ierr, 'h_define: cannot put nbdate') -#if ( defined BFB_CAM_SCAM_IOP ) - ierr = pio_put_var(tape(t)%File, tape(t)%bdateid, (/nbdate/)) - call cam_pio_handle_error(ierr, 'h_define: cannot put bdate') -#endif - ierr = pio_put_var(tape(t)%File, tape(t)%nbsecid, (/nbsec/)) - call cam_pio_handle_error(ierr, 'h_define: cannot put nbsec') - ! - ! Reduced grid info - ! - - end if ! .not. is_satfile - - if (allocated(header_info)) then - do i = 1, size(header_info) - call header_info(i)%deallocate() - end do - deallocate(header_info) - end if - - ! Write the mdim variable data - call write_hist_coord_vars(tape(t)%File, restart) - - end subroutine h_define - - !####################################################################### - - subroutine h_normalize (f, t) - - use cam_history_support, only: dim_index_2d - - ! - !----------------------------------------------------------------------- - ! - ! Purpose: Normalize fields on a history file by the number of accumulations - ! - ! Method: Loop over fields on the tape. Need averaging flag and number of - ! accumulations to perform normalization. - ! - !----------------------------------------------------------------------- - ! - ! Input arguments - ! - integer, intent(in) :: f ! field index - integer, intent(in) :: t ! tape index - ! - ! Local workspace - ! - type (dim_index_2d) :: dimind ! 2-D dimension index - integer :: c ! chunk (or lat) index - integer :: ib, ie ! beginning and ending indices of first dimension - integer :: jb, je ! beginning and ending indices of second dimension - integer :: begdim3, enddim3 ! Chunk or block bounds - integer :: k ! level - integer :: i, ii - real(r8) :: variance, tmpfill - - logical :: flag_xyfill ! non-applicable xy points flagged with fillvalue - character*1 :: avgflag ! averaging flag - - call t_startf ('h_normalize') - - call tape(t)%hlist(f)%field%get_bounds(3, begdim3, enddim3) - - ! - ! normalize by number of accumulations for averaged case - ! - flag_xyfill = tape(t)%hlist(f)%field%flag_xyfill - avgflag = tape(t)%hlist(f)%avgflag - - do c = begdim3, enddim3 - dimind = tape(t)%hlist(f)%field%get_dims(c) - - ib = dimind%beg1 - ie = dimind%end1 - jb = dimind%beg2 - je = dimind%end2 - - if (flag_xyfill) then - do k = jb, je - where (tape(t)%hlist(f)%nacs(ib:ie, c) == 0) - tape(t)%hlist(f)%hbuf(ib:ie,k,c) = tape(t)%hlist(f)%field%fillvalue - endwhere - end do - end if - - if (avgflag == 'A' .or. avgflag == 'B' .or. avgflag == 'L') then - if (size(tape(t)%hlist(f)%nacs, 1) > 1) then - do k = jb, je - where (tape(t)%hlist(f)%nacs(ib:ie,c) /= 0) - tape(t)%hlist(f)%hbuf(ib:ie,k,c) = & - tape(t)%hlist(f)%hbuf(ib:ie,k,c) & - / tape(t)%hlist(f)%nacs(ib:ie,c) - endwhere - end do - else if(tape(t)%hlist(f)%nacs(1,c) > 0) then - do k=jb,je - tape(t)%hlist(f)%hbuf(ib:ie,k,c) = & - tape(t)%hlist(f)%hbuf(ib:ie,k,c) & - / tape(t)%hlist(f)%nacs(1,c) - end do - end if - end if - if (avgflag == 'S') then - ! standard deviation ... - ! from http://www.johndcook.com/blog/standard_deviation/ - tmpfill = merge(tape(t)%hlist(f)%field%fillvalue,0._r8,flag_xyfill) - do k=jb,je - do i = ib,ie - ii = merge(i,1,flag_xyfill) - if (tape(t)%hlist(f)%nacs(ii,c) > 1) then - variance = tape(t)%hlist(f)%sbuf(i,k,c)/(tape(t)%hlist(f)%nacs(ii,c)-1) - tape(t)%hlist(f)%hbuf(i,k,c) = sqrt(variance) - else - tape(t)%hlist(f)%hbuf(i,k,c) = tmpfill - endif - end do - end do - endif - end do - - call t_stopf ('h_normalize') - - return - end subroutine h_normalize - - !####################################################################### - - subroutine h_zero (f, t) - use cam_history_support, only: dim_index_2d - ! - !----------------------------------------------------------------------- - ! - ! Purpose: Zero out accumulation buffers for a tape - ! - ! Method: Loop through fields on the tape - ! - !----------------------------------------------------------------------- - ! - integer, intent(in) :: f ! field index - integer, intent(in) :: t ! tape index - ! - ! Local workspace - ! - type (dim_index_2d) :: dimind ! 2-D dimension index - integer :: c ! chunk index - integer :: begdim3 ! on-node chunk or lat start index - integer :: enddim3 ! on-node chunk or lat end index - - call t_startf ('h_zero') - - call tape(t)%hlist(f)%field%get_bounds(3, begdim3, enddim3) - - do c = begdim3, enddim3 - dimind = tape(t)%hlist(f)%field%get_dims(c) - tape(t)%hlist(f)%hbuf(dimind%beg1:dimind%end1,dimind%beg2:dimind%end2,c)=0._r8 - if (associated(tape(t)%hlist(f)%sbuf)) then ! zero out variance buffer for standard deviation - tape(t)%hlist(f)%sbuf(dimind%beg1:dimind%end1,dimind%beg2:dimind%end2,c)=0._r8 - endif - end do - tape(t)%hlist(f)%nacs(:,:) = 0 - - call t_stopf ('h_zero') - - return - end subroutine h_zero - - !####################################################################### - - subroutine dump_field (f, t, restart) - use cam_history_support, only: history_patch_t, dim_index_3d - use cam_grid_support, only: cam_grid_write_dist_array, cam_grid_dimensions - use interp_mod, only : write_interpolated - - ! Dummy arguments - integer, intent(in) :: f - integer, intent(in) :: t - logical, intent(in) :: restart - ! - !----------------------------------------------------------------------- - ! - ! Purpose: Write a variable to a history tape using PIO - ! For restart tapes, also write the accumulation buffer (nacs) - ! - !----------------------------------------------------------------------- - ! Local variables - integer :: ierr - type(var_desc_t), pointer :: varid ! PIO ID for var - type(var_desc_t), pointer :: compid ! PIO ID for vector comp. - integer :: compind ! index of vector comp. - integer :: fdims(8) ! Field file dim sizes - integer :: frank ! Field file rank - integer :: nacsrank ! Field file rank for nacs - type(dim_index_3d) :: dimind ! 3-D dimension index - integer :: adims(3) ! Field array dim sizes - integer :: nadims ! # of used adims - integer :: fdecomp - integer :: num_patches - integer :: mdimsize ! Total # on-node elements - logical :: interpolate - logical :: patch_output - type(history_patch_t), pointer :: patchptr - integer :: i - - interpolate = (interpolate_output(t) .and. (.not. restart)) - patch_output = (associated(tape(t)%patches) .and. (.not. restart)) - - !!! Get the field's shape and decomposition - - ! Shape on disk - call tape(t)%hlist(f)%field%get_shape(fdims, frank) - - ! Shape of array - dimind = tape(t)%hlist(f)%field%get_dims() - call dimind%dim_sizes(adims) - if (adims(2) <= 1) then - adims(2) = adims(3) - nadims = 2 - else - nadims = 3 - end if - fdecomp = tape(t)%hlist(f)%field%decomp_type - - ! num_patches will loop through the number of patches (or just one - ! for the whole grid) for this field for this tape - if (patch_output) then - num_patches = size(tape(t)%patches) - else - num_patches = 1 - end if - - do i = 1, num_patches - varid => tape(t)%hlist(f)%varid(i) - - if (restart) then - call pio_setframe(tape(t)%File, varid, int(-1,kind=PIO_OFFSET_KIND)) - else - call pio_setframe(tape(t)%File, varid, int(max(1,nfils(t)),kind=PIO_OFFSET_KIND)) - end if - if (patch_output) then - ! We are outputting patches - patchptr => tape(t)%patches(i) - if (interpolate) then - call endrun('dump_field: interpolate incompatible with regional output') - end if - call patchptr%write_var(tape(t)%File, fdecomp, adims(1:nadims), & - pio_double, tape(t)%hlist(f)%hbuf, varid) - else - ! We are doing output via the field's grid - if (interpolate) then - mdimsize = tape(t)%hlist(f)%field%enddim2 - tape(t)%hlist(f)%field%begdim2 + 1 - if (mdimsize == 0) then - mdimsize = tape(t)%hlist(f)%field%numlev - end if - if (tape(t)%hlist(f)%field%meridional_complement > 0) then - compind = tape(t)%hlist(f)%field%meridional_complement - compid => tape(t)%hlist(compind)%varid(i) - ! We didn't call set frame on the meridional complement field - call pio_setframe(tape(t)%File, compid, int(max(1,nfils(t)),kind=PIO_OFFSET_KIND)) - call write_interpolated(tape(t)%File, varid, compid, & - tape(t)%hlist(f)%hbuf, tape(t)%hlist(compind)%hbuf, & - mdimsize, PIO_DOUBLE, fdecomp) - else if (tape(t)%hlist(f)%field%zonal_complement > 0) then - ! We don't want to double write so do nothing here -! compind = tape(t)%hlist(f)%field%zonal_complement -! compid => tape(t)%hlist(compind)%varid(i) -! call write_interpolated(tape(t)%File, compid, varid, & -! tape(t)%hlist(compind)%hbuf, tape(t)%hlist(f)%hbuf, & -! mdimsize, PIO_DOUBLE, fdecomp) - else - ! Scalar field - call write_interpolated(tape(t)%File, varid, & - tape(t)%hlist(f)%hbuf, mdimsize, PIO_DOUBLE, fdecomp) - end if - else if (nadims == 2) then - ! Special case for 2D field (no levels) due to hbuf structure - call cam_grid_write_dist_array(tape(t)%File, fdecomp, & - adims(1:nadims), fdims(1:frank), tape(t)%hlist(f)%hbuf(:,1,:), varid) - else - call cam_grid_write_dist_array(tape(t)%File, fdecomp, adims, & - fdims(1:frank), tape(t)%hlist(f)%hbuf, varid) - end if - end if - end do - !! write accumulation counter and variance to hist restart file - if(restart) then - if (associated(tape(t)%hlist(f)%sbuf) ) then - ! write variance data to restart file for standard deviation calc - if (nadims == 2) then - ! Special case for 2D field (no levels) due to sbuf structure - call cam_grid_write_dist_array(tape(t)%File, fdecomp, adims(1:nadims), & - fdims(1:frank), tape(t)%hlist(f)%sbuf(:,1,:), tape(t)%hlist(f)%sbuf_varid) - else - call cam_grid_write_dist_array(tape(t)%File, fdecomp, adims, & - fdims(1:frank), tape(t)%hlist(f)%sbuf, tape(t)%hlist(f)%sbuf_varid) - endif - endif - !! NACS - if (size(tape(t)%hlist(f)%nacs, 1) > 1) then - if (nadims > 2) then - adims(2) = adims(3) - nadims = 2 - end if - call cam_grid_dimensions(fdecomp, fdims(1:2), nacsrank) - call cam_grid_write_dist_array(tape(t)%File, fdecomp, adims(1:nadims), & - fdims(1:nacsrank), tape(t)%hlist(f)%nacs, tape(t)%hlist(f)%nacs_varid) - else - ierr = pio_put_var(tape(t)%File, tape(t)%hlist(f)%nacs_varid, & - tape(t)%hlist(f)%nacs(:, tape(t)%hlist(f)%field%begdim3:tape(t)%hlist(f)%field%enddim3)) - end if - end if - - return - end subroutine dump_field - - !####################################################################### - - logical function write_inithist () - ! - !----------------------------------------------------------------------- - ! - ! Purpose: Set flags that will initiate dump to IC file when OUTFLD and - ! WSHIST are called - ! - !----------------------------------------------------------------------- - ! - use time_manager, only: get_nstep, get_curr_date, get_step_size, is_last_step - ! - ! Local workspace - ! - integer :: yr, mon, day ! year, month, and day components of - ! a date - integer :: nstep ! current timestep number - integer :: ncsec ! current time of day [seconds] - integer :: dtime ! timestep size - - !----------------------------------------------------------------------- - - write_inithist = .false. - - if(is_initfile()) then - - nstep = get_nstep() - call get_curr_date(yr, mon, day, ncsec) - - if (inithist == '6-HOURLY') then - dtime = get_step_size() - write_inithist = nstep /= 0 .and. mod( nstep, nint((6._r8*3600._r8)/dtime) ) == 0 - elseif(inithist == 'DAILY' ) then - write_inithist = nstep /= 0 .and. ncsec == 0 - elseif(inithist == 'MONTHLY' ) then - write_inithist = nstep /= 0 .and. ncsec == 0 .and. day == 1 - elseif(inithist == 'YEARLY' ) then - write_inithist = nstep /= 0 .and. ncsec == 0 .and. day == 1 .and. mon == 1 - elseif(inithist == 'CAMIOP' ) then - write_inithist = nstep == 0 - elseif(inithist == 'ENDOFRUN' ) then - write_inithist = nstep /= 0 .and. is_last_step() - end if - end if - - return - end function write_inithist - - !####################################################################### - - subroutine wshist (rgnht_in) - ! - !----------------------------------------------------------------------- - ! - ! Purpose: Driver routine to write fields on history tape t - ! - ! - !----------------------------------------------------------------------- - use time_manager, only: get_nstep, get_curr_date, get_curr_time, get_step_size - use chem_surfvals, only: chem_surfvals_get, chem_surfvals_co2_rad - use solar_irrad_data, only: sol_tsi - use sat_hist, only: sat_hist_write - use interp_mod, only: set_interp_hfile - use datetime_mod, only: datetime - use cam_pio_utils, only: cam_pio_closefile - - logical, intent(in), optional :: rgnht_in(ptapes) - ! - ! Local workspace - ! - character(len=8) :: cdate ! system date - character(len=8) :: ctime ! system time - - logical :: rgnht(ptapes), restart - integer t, f ! tape, field indices - integer start ! starting index required by nf_put_vara - integer count1 ! count values required by nf_put_vara - integer startc(2) ! start values required by nf_put_vara (character) - integer countc(2) ! count values required by nf_put_vara (character) -#ifdef HDEBUG - ! integer begdim3 - ! integer enddim3 -#endif - - integer :: yr, mon, day ! year, month, and day components of a date - integer :: nstep ! current timestep number - integer :: ncdate ! current date in integer format [yyyymmdd] - integer :: ncsec ! current time of day [seconds] - integer :: ndcur ! day component of current time - integer :: nscur ! seconds component of current time - real(r8) :: time ! current time - real(r8) :: tdata(2) ! time interval boundaries - character(len=max_string_len) :: fname ! Filename - logical :: prev ! Label file with previous date rather than current - integer :: ierr -#if ( defined BFB_CAM_SCAM_IOP ) - integer :: tsec ! day component of current time - integer :: dtime ! seconds component of current time -#endif - - if(present(rgnht_in)) then - rgnht=rgnht_in - restart=.true. - tape => restarthistory_tape - else - rgnht=.false. - restart=.false. - tape => history_tape - end if - - nstep = get_nstep() - call get_curr_date(yr, mon, day, ncsec) - ncdate = yr*10000 + mon*100 + day - call get_curr_time(ndcur, nscur) - ! - ! Write time-varying portion of history file header - ! - do t=1,ptapes - if (nflds(t) == 0 .or. (restart .and.(.not.rgnht(t)))) cycle - ! - ! Check if this is the IC file and if it's time to write. - ! Else, use "nhtfrq" to determine if it's time to write - ! the other history files. - ! - if((.not. restart) .or. rgnht(t)) then - if( is_initfile(file_index=t) ) then - hstwr(t) = write_inithist() - prev = .false. - else - if (nhtfrq(t) == 0) then - hstwr(t) = nstep /= 0 .and. day == 1 .and. ncsec == 0 - prev = .true. - else - hstwr(t) = mod(nstep,nhtfrq(t)) == 0 - prev = .false. - end if - end if - end if - if (hstwr(t) .or. (restart .and. rgnht(t))) then - if(masterproc) then - if(is_initfile(file_index=t)) then - write(iulog,100) yr,mon,day,ncsec -100 format('WSHIST: writing time sample to Initial Conditions h-file', & - ' DATE=',i4.4,'/',i2.2,'/',i2.2,' NCSEC=',i6) - else if(is_satfile(t)) then - write(iulog,150) nfils(t),t,yr,mon,day,ncsec -150 format('WSHIST: writing sat columns ',i6,' to h-file ', & - i1,' DATE=',i4.4,'/',i2.2,'/',i2.2,' NCSEC=',i6) - else if(hstwr(t)) then - write(iulog,200) nfils(t),t,yr,mon,day,ncsec -200 format('WSHIST: writing time sample ',i3,' to h-file ', & - i1,' DATE=',i4.4,'/',i2.2,'/',i2.2,' NCSEC=',i6) - else if(restart .and. rgnht(t)) then - write(iulog,300) nfils(t),t,yr,mon,day,ncsec -300 format('WSHIST: writing history restart ',i3,' to hr-file ', & - i1,' DATE=',i4.4,'/',i2.2,'/',i2.2,' NCSEC=',i6) - end if - write(iulog,*) - end if - ! - ! Starting a new volume => define the metadata - ! - if (nfils(t)==0 .or. (restart.and.rgnht(t))) then - if(restart) then - rhfilename_spec = '%c.cam' // trim(inst_suffix) // '.rh%t.%y-%m-%d-%s.nc' - fname = interpret_filename_spec( rhfilename_spec, number=(t-1)) - hrestpath(t)=fname - else if(is_initfile(file_index=t)) then - fname = interpret_filename_spec( hfilename_spec(t) ) - else - fname = interpret_filename_spec( hfilename_spec(t), number=(t-1), & - prev=prev ) - end if - ! - ! Check that this new filename isn't the same as a previous or current filename - ! - do f = 1, ptapes - if (masterproc.and. trim(fname) == trim(nhfil(f)) )then - write(iulog,*)'WSHIST: New filename same as old file = ', trim(fname) - write(iulog,*)'Is there an error in your filename specifiers?' - write(iulog,*)'hfilename_spec(', t, ') = ', hfilename_spec(t) - if ( t /= f )then - write(iulog,*)'hfilename_spec(', f, ') = ', hfilename_spec(f) - end if - call endrun - end if - end do - if(.not. restart) then - nhfil(t) = fname - if(masterproc) write(iulog,*)'WSHIST: nhfil(',t,')=',trim(nhfil(t)) - cpath(t) = nhfil(t) - if ( len_trim(nfpath(t)) == 0 ) nfpath(t) = cpath(t) - end if - call h_define (t, restart) - end if - - if(is_satfile(t)) then - call sat_hist_write( tape(t), nflds(t), nfils(t)) - else - if(restart) then - start=1 - else - nfils(t) = nfils(t) + 1 - start = nfils(t) - end if - count1 = 1 - ! Setup interpolation data if history file is interpolated - if (interpolate_output(t) .and. (.not. restart)) then - call set_interp_hfile(t, interpolate_info) - end if - - ierr = pio_put_var (tape(t)%File, tape(t)%ndcurid,(/start/), (/count1/),(/ndcur/)) - ierr = pio_put_var (tape(t)%File, tape(t)%nscurid,(/start/), (/count1/),(/nscur/)) - ierr = pio_put_var (tape(t)%File, tape(t)%dateid,(/start/), (/count1/),(/ncdate/)) - - if (.not. is_initfile(file_index=t)) then - ! Don't write the GHG/Solar forcing data to the IC file. - ierr=pio_put_var (tape(t)%File, tape(t)%co2vmrid,(/start/), (/count1/),(/chem_surfvals_co2_rad(vmr_in=.true.)/)) - ierr=pio_put_var (tape(t)%File, tape(t)%ch4vmrid,(/start/), (/count1/),(/chem_surfvals_get('CH4VMR')/)) - ierr=pio_put_var (tape(t)%File, tape(t)%n2ovmrid,(/start/), (/count1/),(/chem_surfvals_get('N2OVMR')/)) - ierr=pio_put_var (tape(t)%File, tape(t)%f11vmrid,(/start/), (/count1/),(/chem_surfvals_get('F11VMR')/)) - ierr=pio_put_var (tape(t)%File, tape(t)%f12vmrid,(/start/), (/count1/),(/chem_surfvals_get('F12VMR')/)) - ierr=pio_put_var (tape(t)%File, tape(t)%sol_tsiid,(/start/), (/count1/),(/sol_tsi/)) - - if (solar_parms_on) then - ierr=pio_put_var (tape(t)%File, tape(t)%f107id, (/start/), (/count1/),(/ f107 /) ) - ierr=pio_put_var (tape(t)%File, tape(t)%f107aid,(/start/), (/count1/),(/ f107a /) ) - ierr=pio_put_var (tape(t)%File, tape(t)%f107pid,(/start/), (/count1/),(/ f107p /) ) - ierr=pio_put_var (tape(t)%File, tape(t)%kpid, (/start/), (/count1/),(/ kp /) ) - ierr=pio_put_var (tape(t)%File, tape(t)%apid, (/start/), (/count1/),(/ ap /) ) - endif - if (solar_wind_on) then - ierr=pio_put_var (tape(t)%File, tape(t)%byimfid, (/start/), (/count1/),(/ byimf /) ) - ierr=pio_put_var (tape(t)%File, tape(t)%bzimfid, (/start/), (/count1/),(/ bzimf /) ) - ierr=pio_put_var (tape(t)%File, tape(t)%swvelid, (/start/), (/count1/),(/ swvel /) ) - ierr=pio_put_var (tape(t)%File, tape(t)%swdenid, (/start/), (/count1/),(/ swden /) ) - endif - if (epot_active) then - ierr=pio_put_var (tape(t)%File, tape(t)%colat_crit1_id, (/start/), (/count1/),(/ epot_crit_colats(1) /) ) - ierr=pio_put_var (tape(t)%File, tape(t)%colat_crit2_id, (/start/), (/count1/),(/ epot_crit_colats(2) /) ) - endif - end if - - ierr = pio_put_var (tape(t)%File, tape(t)%datesecid,(/start/),(/count1/),(/ncsec/)) -#if ( defined BFB_CAM_SCAM_IOP ) - dtime = get_step_size() - tsec=dtime*nstep - ierr = pio_put_var (tape(t)%File, tape(t)%tsecid,(/start/),(/count1/),(/tsec/)) -#endif - ierr = pio_put_var (tape(t)%File, tape(t)%nstephid,(/start/),(/count1/),(/nstep/)) - time = ndcur + nscur/86400._r8 - ierr=pio_put_var (tape(t)%File, tape(t)%timeid, (/start/),(/count1/),(/time/)) - - startc(1) = 1 - startc(2) = start - countc(1) = 2 - countc(2) = 1 - if (is_initfile(file_index=t)) then - tdata = time ! Inithist file is always instantanious data - else - tdata(1) = beg_time(t) - tdata(2) = time - end if - ierr=pio_put_var (tape(t)%File, tape(t)%tbndid, startc, countc, tdata) - if(.not.restart) beg_time(t) = time ! update beginning time of next interval - startc(1) = 1 - startc(2) = start - countc(1) = 8 - countc(2) = 1 - call datetime (cdate, ctime) - ierr = pio_put_var (tape(t)%File, tape(t)%date_writtenid, startc, countc, (/cdate/)) - ierr = pio_put_var (tape(t)%File, tape(t)%time_writtenid, startc, countc, (/ctime/)) - - if(.not. restart) then - !$OMP PARALLEL DO PRIVATE (F) - do f=1,nflds(t) - ! Normalized averaged fields - if (tape(t)%hlist(f)%avgflag /= 'I') then - call h_normalize (f, t) - end if - end do - end if - ! - ! Write field to history tape. Note that this is NOT threaded due to netcdf limitations - ! - call t_startf ('dump_field') - do f=1,nflds(t) - call dump_field(f, t, restart) - end do - call t_stopf ('dump_field') - ! - ! Zero history buffers and accumulators now that the fields have been written. - ! - - - - if(restart) then - do f=1,nflds(t) - if(associated(tape(t)%hlist(f)%varid)) then - deallocate(tape(t)%hlist(f)%varid) - nullify(tape(t)%hlist(f)%varid) - end if - end do - call cam_pio_closefile(tape(t)%File) - else - !$OMP PARALLEL DO PRIVATE (F) - do f=1,nflds(t) - call h_zero (f, t) - end do - end if - end if - end if - - end do - - return - end subroutine wshist - - !####################################################################### - - subroutine addfld_1d(fname, vdim_name, avgflag, units, long_name, & - gridname, flag_xyfill, sampling_seq, standard_name, fill_value) - - ! - !----------------------------------------------------------------------- - ! - ! Purpose: Add a field to the master field list - ! - ! Method: Put input arguments of field name, units, number of levels, - ! averaging flag, and long name into a type entry in the global - ! master field list (masterlist). - ! - !----------------------------------------------------------------------- - - ! - ! Arguments - ! - character(len=*), intent(in) :: fname ! field name (max_fieldname_len) - character(len=*), intent(in) :: vdim_name ! NetCDF dimension name (or scalar coordinate) - character(len=1), intent(in) :: avgflag ! averaging flag - character(len=*), intent(in) :: units ! units of fname (max_chars) - character(len=*), intent(in) :: long_name ! long name of field (max_chars) - - character(len=*), intent(in), optional :: gridname ! decomposition type - logical, intent(in), optional :: flag_xyfill ! non-applicable xy points flagged with fillvalue - character(len=*), intent(in), optional :: sampling_seq ! sampling sequence - if not every timestep, - ! how often field is sampled: - ! every other; only during LW/SW radiation calcs, etc. - character(len=*), intent(in), optional :: standard_name ! CF standard name (max_chars) - real(r8), intent(in), optional :: fill_value - - ! - ! Local workspace - ! - character(len=max_chars), allocatable :: dimnames(:) - integer :: index - - if (trim(vdim_name) == trim(horiz_only)) then - allocate(dimnames(0)) - else - index = get_hist_coord_index(trim(vdim_name)) - if (index < 1) then - call endrun('ADDFLD: Invalid coordinate, '//trim(vdim_name)) - end if - allocate(dimnames(1)) - dimnames(1) = trim(vdim_name) - end if - call addfld(fname, dimnames, avgflag, units, long_name, gridname, & - flag_xyfill, sampling_seq, standard_name, fill_value) - - end subroutine addfld_1d - - subroutine addfld_nd(fname, dimnames, avgflag, units, long_name, & - gridname, flag_xyfill, sampling_seq, standard_name, fill_value) - - ! - !----------------------------------------------------------------------- - ! - ! Purpose: Add a field to the master field list - ! - ! Method: Put input arguments of field name, units, number of levels, - ! averaging flag, and long name into a type entry in the global - ! master field list (masterlist). - ! - !----------------------------------------------------------------------- - use cam_history_support, only: fillvalue, hist_coord_find_levels - use cam_grid_support, only: cam_grid_id, cam_grid_is_zonal - use cam_grid_support, only: cam_grid_get_coord_names - - ! - ! Arguments - ! - character(len=*), intent(in) :: fname ! field name (max_fieldname_len) - character(len=*), intent(in) :: dimnames(:) ! NetCDF dimension names (except grid dims) - character(len=1), intent(in) :: avgflag ! averaging flag - character(len=*), intent(in) :: units ! units of fname (max_chars) - character(len=*), intent(in) :: long_name ! long name of field (max_chars) - - character(len=*), intent(in), optional :: gridname ! decomposition type - logical, intent(in), optional :: flag_xyfill ! non-applicable xy points flagged with fillvalue - character(len=*), intent(in), optional :: sampling_seq ! sampling sequence - if not every timestep, - ! how often field is sampled: - ! every other; only during LW/SW radiation calcs, etc. - character(len=*), intent(in), optional :: standard_name ! CF standard name (max_chars) - real(r8), intent(in), optional :: fill_value - - ! - ! Local workspace - ! - character(len=max_fieldname_len) :: fname_tmp ! local copy of fname - character(len=max_fieldname_len) :: coord_name ! for cell_methods - character(len=128) :: errormsg - type(master_entry), pointer :: listentry - - integer :: dimcnt - - if (htapes_defined) then - call endrun ('ADDFLD: Attempt to add field '//trim(fname)//' after history files set') - end if - - ! - ! Ensure that new field name is not all blanks - ! - if (len_trim(fname)==0) then - call endrun('ADDFLD: blank field name not allowed') - end if - ! - ! Ensure that new field name is not longer than allowed - ! (strip "&IC" suffix if it exists) - ! - fname_tmp = fname - fname_tmp = strip_suffix(fname_tmp) - - if (len_trim(fname_tmp) > fieldname_len) then - write(iulog,*)'ADDFLD: field name cannot be longer than ',fieldname_len,' characters long' - write(iulog,*)'Field name: ',fname - write(errormsg, *) 'Field name, "', trim(fname), '" is too long' - call endrun('ADDFLD: '//trim(errormsg)) - end if - ! - ! Ensure that new field doesn't already exist - ! - listentry => get_entry_by_name(masterlinkedlist, fname) - if(associated(listentry)) then - call endrun ('ADDFLD: '//fname//' already on list') - end if - - ! - ! Add field to Master Field List arrays fieldn and iflds - ! - allocate(listentry) - listentry%field%name = fname - listentry%field%long_name = long_name - listentry%field%numlev = 1 ! Will change if lev or ilev in shape - listentry%field%units = units - listentry%field%meridional_complement = -1 - listentry%field%zonal_complement = -1 - listentry%htapeindx(:) = -1 - listentry%act_sometape = .false. - listentry%actflag(:) = .false. - - ! Make sure we have a valid gridname - if (present(gridname)) then - listentry%field%decomp_type = cam_grid_id(trim(gridname)) - else - listentry%field%decomp_type = cam_grid_id('physgrid') - end if - if (listentry%field%decomp_type < 0) then - write(errormsg, *) 'Invalid grid name, "', trim(gridname), '" for ', & - trim(fname) - call endrun('ADDFLD: '//trim(errormsg)) - end if - - ! - ! Indicate sampling sequence of field (i.e., how often "outfld" is called) - ! If not every timestep (default), then give a descriptor indicating the - ! sampling pattern. Currently, the only valid value is "rad_lwsw" for sampling - ! during LW/SW radiation timesteps only - ! - if (present(sampling_seq)) then - listentry%field%sampling_seq = sampling_seq - else - listentry%field%sampling_seq = ' ' - end if - ! Indicate if some field pre-processing occurred (e.g., zonal mean) - if (cam_grid_is_zonal(listentry%field%decomp_type)) then - call cam_grid_get_coord_names(listentry%field%decomp_type, coord_name, errormsg) - ! Zonal method currently hardcoded to 'mean'. - listentry%field%cell_methods = trim(coord_name)//': mean' - else - listentry%field%cell_methods = '' - end if - ! - ! Whether to apply xy fillvalue: default is false - ! - if (present(flag_xyfill)) then - listentry%field%flag_xyfill = flag_xyfill - else - listentry%field%flag_xyfill = .false. - end if - - ! - ! Allow external packages to have fillvalues different than default - ! - - if(present(fill_value)) then - listentry%field%fillvalue = fill_value - else - listentry%field%fillvalue = fillvalue - endif - - ! - ! Process shape - ! - - if (associated(listentry%field%mdims)) then - deallocate(listentry%field%mdims) - end if - nullify(listentry%field%mdims) - dimcnt = size(dimnames) - allocate(listentry%field%mdims(dimcnt)) - call lookup_hist_coord_indices(dimnames, listentry%field%mdims) - if(dimcnt > maxvarmdims) then - maxvarmdims = dimcnt - end if - ! Check for subcols (currently limited to first dimension) - listentry%field%is_subcol = .false. - if (size(dimnames) > 0) then - if (trim(dimnames(1)) == 'psubcols') then - if (listentry%field%decomp_type /= cam_grid_id('physgrid')) then - write(errormsg, *) "Cannot add ", trim(fname), & - "Subcolumn history output only allowed on physgrid" - call endrun("ADDFLD: "//errormsg) - listentry%field%is_subcol = .true. - end if - end if - end if - ! Levels - listentry%field%numlev = hist_coord_find_levels(dimnames) - if (listentry%field%numlev <= 0) then - listentry%field%numlev = 1 - end if - - ! - ! Dimension history info based on decomposition type (grid) - ! - call set_field_dimensions(listentry%field) - - ! - ! These 2 fields are used only in master field list, not runtime field list - ! - listentry%avgflag(:) = avgflag - listentry%actflag(:) = .false. - - do dimcnt = 1, ptapes - call AvgflagToString(avgflag, listentry%time_op(dimcnt)) - end do - - nullify(listentry%next_entry) - - call add_entry_to_master(listentry) - return - end subroutine addfld_nd - - !####################################################################### - - ! field_part_of_vector: Determinie if fname is part of a vector set - ! Optionally fill in the names of the vector set fields - logical function field_part_of_vector(fname, meridional_name, zonal_name) - - ! Dummy arguments - character(len=*), intent(in) :: fname - character(len=*), optional, intent(out) :: meridional_name - character(len=*), optional, intent(out) :: zonal_name - - ! Local variables - type(master_entry), pointer :: listentry - - listentry => get_entry_by_name(masterlinkedlist, fname) - if (associated(listentry)) then - if ( (len_trim(listentry%meridional_field) > 0) .or. & - (len_trim(listentry%zonal_field) > 0)) then - field_part_of_vector = .true. - if (present(meridional_name)) then - meridional_name = listentry%meridional_field - end if - if (present(zonal_name)) then - zonal_name = listentry%zonal_field - end if - else - field_part_of_vector = .false. - end if - else - field_part_of_vector = .false. - end if - if (.not. field_part_of_vector) then - if (present(meridional_name)) then - meridional_name = '' - end if - if (present(zonal_name)) then - zonal_name = '' - end if - end if - - end function field_part_of_vector - - - ! register_vector_field: Register a pair of history field names as - ! being a vector complement set. - ! This information is used to set up interpolated history output. - ! NB: register_vector_field must be called after both fields are defined - ! with addfld - subroutine register_vector_field(zonal_field_name, meridional_field_name) - - ! Dummy arguments - character(len=*), intent(in) :: zonal_field_name - character(len=*), intent(in) :: meridional_field_name - - ! Local variables - type(master_entry), pointer :: mlistentry - type(master_entry), pointer :: zlistentry - character(len=*), parameter :: subname = 'REGISTER_VECTOR_FIELD' - character(len=max_chars) :: errormsg - - if (htapes_defined) then - write(errormsg, '(5a)') ': Attempt to register vector field (', & - trim(zonal_field_name), ', ', trim(meridional_field_name), & - ') after history files set' - call endrun (trim(subname)//errormsg) - end if - - ! Look for the field IDs - zlistentry => get_entry_by_name(masterlinkedlist, zonal_field_name) - mlistentry => get_entry_by_name(masterlinkedlist, meridional_field_name) - ! Has either of these fields been previously registered? - if (associated(mlistentry)) then - if (len_trim(mlistentry%meridional_field) > 0) then - write(errormsg, '(9a)') ': ERROR attempting to register vector ', & - 'field (', trim(zonal_field_name), ', ', & - trim(meridional_field_name), '), ', trim(meridional_field_name), & - ' has been registered as part of a vector field with ', & - trim(mlistentry%meridional_field) - call endrun (trim(subname)//errormsg) - else if (len_trim(mlistentry%zonal_field) > 0) then - write(errormsg, '(9a)') ': ERROR attempting to register vector ', & - 'field (', trim(zonal_field_name), ', ', & - trim(meridional_field_name), '), ', trim(meridional_field_name), & - ' has been registered as part of a vector field with ', & - trim(mlistentry%zonal_field) - call endrun (trim(subname)//errormsg) - end if - end if - if (associated(zlistentry)) then - if (len_trim(zlistentry%meridional_field) > 0) then - write(errormsg, '(9a)') ': ERROR attempting to register vector ', & - 'field (', trim(zonal_field_name), ', ', & - trim(meridional_field_name), '), ', trim(zonal_field_name), & - ' has been registered as part of a vector field with ', & - trim(zlistentry%meridional_field) - call endrun (trim(subname)//errormsg) - else if (len_trim(zlistentry%zonal_field) > 0) then - write(errormsg, '(9a)') ': ERROR attempting to register vector ', & - 'field (', trim(zonal_field_name), ', ', & - trim(meridional_field_name), '), ', trim(zonal_field_name), & - ' has been registered as part of a vector field with ', & - trim(zlistentry%meridional_field) - call endrun (trim(subname)//errormsg) - end if - end if - if(associated(mlistentry) .and. associated(zlistentry)) then - zlistentry%meridional_field = mlistentry%field%name - zlistentry%zonal_field = '' - mlistentry%meridional_field = '' - mlistentry%zonal_field = zlistentry%field%name - else if (associated(mlistentry)) then - write(errormsg, '(7a)') ': ERROR attempting to register vector field (',& - trim(zonal_field_name), ', ', trim(meridional_field_name), & - '), ', trim(zonal_field_name), ' is not defined' - call endrun (trim(subname)//errormsg) - else if (associated(zlistentry)) then - write(errormsg, '(7a)') ': ERROR attempting to register vector field (',& - trim(zonal_field_name), ', ', trim(meridional_field_name), & - '), ', trim(meridional_field_name), ' is not defined' - call endrun (trim(subname)//errormsg) - else - write(errormsg, '(5a)') ': ERROR attempting to register vector field (',& - trim(zonal_field_name), ', ', trim(meridional_field_name), & - '), neither field is defined' - call endrun (trim(subname)//errormsg) - end if - end subroutine register_vector_field - - subroutine add_entry_to_master( newentry) - type(master_entry), target, intent(in) :: newentry - type(master_entry), pointer :: listentry - - if(associated(masterlinkedlist)) then - listentry => masterlinkedlist - do while(associated(listentry%next_entry)) - listentry=>listentry%next_entry - end do - listentry%next_entry=>newentry - else - masterlinkedlist=>newentry - end if - - end subroutine add_entry_to_master - - !####################################################################### - - subroutine wrapup (rstwr, nlend) - ! - !----------------------------------------------------------------------- - ! - ! Purpose: - ! Close history files. - ! - ! Method: - ! This routine will close any full hist. files - ! or any hist. file that has data on it when restart files are being - ! written. - ! If a partially full history file was disposed (for restart - ! purposes), then wrapup will open that unit back up and position - ! it for appending new data. - ! - ! Original version: CCM2 - ! - !----------------------------------------------------------------------- - ! - use pio, only : pio_file_is_open - use shr_kind_mod, only: r8 => shr_kind_r8 - use ioFileMod - use time_manager, only: get_nstep, get_curr_date, get_curr_time - use cam_pio_utils, only: cam_pio_openfile, cam_pio_closefile - - ! - ! Input arguments - ! - logical, intent(in) :: rstwr ! true => restart files are written this timestep - logical, intent(in) :: nlend ! Flag if time to end - - ! - ! Local workspace - ! - integer :: nstep ! current timestep number - integer :: ncsec ! time of day relative to current date [secs] - integer :: ndcur ! days component of current time - integer :: nscur ! seconds component of current time - integer :: yr, mon, day ! year, month, day components of a date - - logical :: lfill (ptapes) ! Is history file ready to dispose? - logical :: lhdisp ! true => history file is disposed - logical :: lhfill ! true => history file is full - - integer :: t ! History file number - integer :: f - real(r8) :: tday ! Model day number for printout - !----------------------------------------------------------------------- - - tape => history_tape - - nstep = get_nstep() - call get_curr_date(yr, mon, day, ncsec) - call get_curr_time(ndcur, nscur) - ! - !----------------------------------------------------------------------- - ! Dispose history files. - !----------------------------------------------------------------------- - ! - ! Begin loop over ptapes (the no. of declared history files - primary - ! and auxiliary). This loop disposes a history file to Mass Store - ! when appropriate. - ! - do t=1,ptapes - if (nflds(t) == 0) cycle - - lfill(t) = .false. - ! - ! Find out if file is full - ! - if (hstwr(t) .and. nfils(t) >= mfilt(t)) then - lfill(t) = .true. - endif - ! - ! Dispose history file if - ! 1) file is filled or - ! 2) this is the end of run and file has data on it or - ! 3) restarts are being put out and history file has data on it - ! - if (lfill(t) .or. (nlend .and. nfils(t) >= 1) .or. (rstwr .and. nfils(t) >= 1)) then - ! - ! Dispose history file - ! - ! - ! Is this the 0 timestep data of a monthly run? - ! If so, just close primary unit do not dispose. - ! - if (masterproc) write(iulog,*)'WRAPUP: nf_close(',t,')=',trim(nhfil(t)) - if(pio_file_is_open(tape(t)%File)) then - if (nlend .or. lfill(t)) then - do f=1,nflds(t) - if (associated(tape(t)%hlist(f)%varid)) then - deallocate(tape(t)%hlist(f)%varid) - nullify(tape(t)%hlist(f)%varid) - end if - end do - end if - call cam_pio_closefile(tape(t)%File) - end if - if (nhtfrq(t) /= 0 .or. nstep > 0) then - - ! - ! Print information concerning model output. - ! Model day number = iteration number of history file data * delta-t / (seconds per day) - ! - tday = ndcur + nscur/86400._r8 - if(masterproc) then - if (t==1) then - write(iulog,*)' Primary history file' - else - write(iulog,*)' Auxiliary history file number ', t-1 - end if - write(iulog,9003)nstep,nfils(t),tday - write(iulog,9004) - end if - ! - ! Auxilary files may have been closed and saved off without being full. - ! We must reopen the files and position them for more data. - ! Must position auxiliary files if not full - ! - if (.not.nlend .and. .not.lfill(t)) then - call cam_PIO_openfile (tape(t)%File, nhfil(t), PIO_WRITE) - call h_inquire(t) - end if - endif ! if 0 timestep of montly run**** - end if ! if time dispose history fiels*** - end do ! do ptapes - ! - ! Reset number of files on each history tape - ! - do t=1,ptapes - if (nflds(t) == 0) cycle - lhfill = hstwr(t) .and. nfils(t) >= mfilt(t) - lhdisp = lhfill .or. (nlend .and. nfils(t) >= 1) .or. & - (rstwr .and. nfils(t) >= 1) - if (lhfill.and.lhdisp) then - nfils(t) = 0 - endif - end do - return -9003 format(' Output at NSTEP = ',i10,/, & - ' Number of time samples on this file = ',i10,/, & - ' Model Day = ',f10.2) -9004 format('---------------------------------------') - end subroutine wrapup - - - integer function gen_hash_key(string) - ! - !----------------------------------------------------------------------- - ! - ! Purpose: Generate a hash key on the interval [0 .. tbl_hash_pri_sz-1] - ! given a character string. - ! - ! Algorithm is a variant of perl's internal hashing function. - ! - !----------------------------------------------------------------------- - ! - implicit none - ! - ! Arguments: - ! - character(len=*), intent(in) :: string - ! - ! Local. - ! - integer :: hash - integer :: i - - hash = gen_hash_key_offset - - if ( len(string) /= 19 ) then - ! - ! Process arbitrary string length. - ! - do i = 1, len(string) - hash = ieor(hash, (ichar(string(i:i)) * tbl_gen_hash_key(iand(i-1,tbl_max_idx)))) - end do - else - ! - ! Special case string length = 19 - ! - hash = ieor(hash , ichar(string(1:1)) * 61) - hash = ieor(hash , ichar(string(2:2)) * 59) - hash = ieor(hash , ichar(string(3:3)) * 53) - hash = ieor(hash , ichar(string(4:4)) * 47) - hash = ieor(hash , ichar(string(5:5)) * 43) - hash = ieor(hash , ichar(string(6:6)) * 41) - hash = ieor(hash , ichar(string(7:7)) * 37) - hash = ieor(hash , ichar(string(8:8)) * 31) - hash = ieor(hash , ichar(string(9:9)) * 29) - hash = ieor(hash , ichar(string(10:10)) * 23) - hash = ieor(hash , ichar(string(11:11)) * 17) - hash = ieor(hash , ichar(string(12:12)) * 13) - hash = ieor(hash , ichar(string(13:13)) * 11) - hash = ieor(hash , ichar(string(14:14)) * 7) - hash = ieor(hash , ichar(string(15:15)) * 3) - hash = ieor(hash , ichar(string(16:16)) * 1) - hash = ieor(hash , ichar(string(17:17)) * 61) - hash = ieor(hash , ichar(string(18:18)) * 59) - hash = ieor(hash , ichar(string(19:19)) * 53) - end if - - gen_hash_key = iand(hash, tbl_hash_pri_sz-1) - - return - - end function gen_hash_key - - !####################################################################### - - integer function get_masterlist_indx(fldname) - ! - !----------------------------------------------------------------------- - ! - ! Purpose: Return the the index of the field's name on the master file list. - ! - ! If the field is not found on the masterlist, return -1. - ! - !----------------------------------------------------------------------- - ! - ! Arguments: - ! - character(len=*), intent(in) :: fldname - ! - ! Local. - ! - integer :: hash_key - integer :: ff - integer :: ii - integer :: io ! Index of overflow chain in overflow table - integer :: in ! Number of entries on overflow chain - - hash_key = gen_hash_key(fldname) - ff = tbl_hash_pri(hash_key) - if ( ff < 0 ) then - io = abs(ff) - in = tbl_hash_oflow(io) - do ii = 1, in - ff = tbl_hash_oflow(io+ii) - if ( masterlist(ff)%thisentry%field%name == fldname ) exit - end do - end if - - if (ff == 0) then - ! fldname generated a hash key that doesn't have an entry in tbl_hash_pri. - ! This means that fldname isn't in the masterlist - call endrun ('GET_MASTERLIST_INDX: attemping to output field '//fldname//' not on master list') - end if - - if (associated(masterlist(ff)%thisentry) .and. masterlist(ff)%thisentry%field%name /= fldname ) then - call endrun ('GET_MASTERLIST_INDX: error finding field '//fldname//' on master list') - end if - - get_masterlist_indx = ff - return - end function get_masterlist_indx - !####################################################################### - - subroutine bld_outfld_hash_tbls() - ! - !----------------------------------------------------------------------- - ! - ! Purpose: Build primary and overflow hash tables for outfld processing. - ! - ! Steps: - ! 1) Foreach field on masterlist, find all collisions. - ! 2) Given the number of collisions, verify overflow table has sufficient - ! space. - ! 3) Build primary and overflow indices. - ! - !----------------------------------------------------------------------- - ! - ! Local. - ! - integer :: ff - integer :: ii - integer :: itemp - integer :: ncollisions - integer :: hash_key - type(master_entry), pointer :: listentry - ! - ! 1) Find all collisions. - ! - tbl_hash_pri = 0 - - ff=0 - allocate(masterlist(nfmaster)) - listentry=>masterlinkedlist - do while(associated(listentry)) - ff=ff+1 - masterlist(ff)%thisentry=>listentry - listentry=>listentry%next_entry - end do - if(ff /= nfmaster) then - write(iulog,*) 'nfmaster = ',nfmaster, ' ff=',ff - call endrun('mismatch in expected size of nfmaster') - end if - - - do ff = 1, nfmaster - hash_key = gen_hash_key(masterlist(ff)%thisentry%field%name) - tbl_hash_pri(hash_key) = tbl_hash_pri(hash_key) + 1 - end do - - ! - ! 2) Count number of collisions and define start of a individual - ! collision's chain in overflow table. A collision is defined to be any - ! location in tbl_hash_pri that has a value > 1. - ! - ncollisions = 0 - do ii = 0, tbl_hash_pri_sz-1 - if ( tbl_hash_pri(ii) > 1 ) then ! Define start of chain in O.F. table - itemp = tbl_hash_pri(ii) - tbl_hash_pri(ii) = -(ncollisions + 1) - ncollisions = ncollisions + itemp + 1 - end if - end do - - if ( ncollisions > tbl_hash_oflow_sz ) then - write(iulog,*) 'BLD_OUTFLD_HASH_TBLS: ncollisions > tbl_hash_oflow_sz', & - ncollisions, tbl_hash_oflow_sz - call endrun() - end if - - ! - ! 3) Build primary and overflow tables. - ! i - set collisions in tbl_hash_pri to point to their respective - ! chain in the overflow table. - ! - tbl_hash_oflow = 0 - - do ff = 1, nfmaster - hash_key = gen_hash_key(masterlist(ff)%thisentry%field%name) - if ( tbl_hash_pri(hash_key) < 0 ) then - ii = abs(tbl_hash_pri(hash_key)) - tbl_hash_oflow(ii) = tbl_hash_oflow(ii) + 1 - tbl_hash_oflow(ii+tbl_hash_oflow(ii)) = ff - else - tbl_hash_pri(hash_key) = ff - end if - end do - - ! - ! Dump out primary and overflow hashing tables. - ! - ! if ( masterproc ) then - ! do ii = 0, tbl_hash_pri_sz-1 - ! if ( tbl_hash_pri(ii) /= 0 ) write(iulog,666) 'tbl_hash_pri', ii, tbl_hash_pri(ii) - ! end do - ! - ! do ii = 1, tbl_hash_oflow_sz - ! if ( tbl_hash_oflow(ii) /= 0 ) write(iulog,666) 'tbl_hash_oflow', ii, tbl_hash_oflow(ii) - ! end do - ! - ! itemp = 0 - ! ii = 1 - ! do - ! if ( tbl_hash_oflow(ii) == 0 ) exit - ! itemp = itemp + 1 - ! write(iulog,*) 'Overflow chain ', itemp, ' has ', tbl_hash_oflow(ii), ' entries:' - ! do ff = 1, tbl_hash_oflow(ii) ! dump out colliding names on this chain - ! write(iulog,*) ' ', ff, ' = ', tbl_hash_oflow(ii+ff), & - ! ' ', masterlist(tbl_hash_oflow(ii+ff))%thisentry%field%name - ! end do - ! ii = ii + tbl_hash_oflow(ii) +1 !advance pointer to start of next chain - ! end do - ! end if - - return -666 format(1x, a, '(', i4, ')', 1x, i6) - - end subroutine bld_outfld_hash_tbls - - !####################################################################### - - subroutine bld_htapefld_indices - ! - !----------------------------------------------------------------------- - ! - ! Purpose: Set history tape field indicies in masterlist for each - ! field defined on every tape. - ! - ! Note: because of restart processing, the actflag field is cleared and - ! then set only for active output fields on the different history - ! tapes. - ! - !----------------------------------------------------------------------- - ! - ! Arguments: - ! - - ! - ! Local. - ! - integer :: f - integer :: t - - ! - ! Initialize htapeindx to an invalid value. - ! - type(master_entry), pointer :: listentry - - ! reset all the active flags to false - ! this is needed so that restarts work properly -- fvitt - listentry=>masterlinkedlist - do while(associated(listentry)) - listentry%actflag(:) = .false. - listentry%act_sometape = .false. - listentry=>listentry%next_entry - end do - - do t = 1, ptapes - do f = 1, nflds(t) - listentry => get_entry_by_name(masterlinkedlist, tape(t)%hlist(f)%field%name) - if(.not.associated(listentry)) then - write(iulog,*) 'BLD_HTAPEFLD_INDICES: something wrong, field not found on masterlist' - write(iulog,*) 'BLD_HTAPEFLD_INDICES: t, f, ff = ', t, f - write(iulog,*) 'BLD_HTAPEFLD_INDICES: tape%name = ', tape(t)%hlist(f)%field%name - call endrun - end if - listentry%act_sometape = .true. - listentry%actflag(t) = .true. - listentry%htapeindx(t) = f - end do - end do - - ! - ! set flag indicating h-tape contents are now defined (needed by addfld) - ! - htapes_defined = .true. - - return - end subroutine bld_htapefld_indices - - !####################################################################### - - logical function hist_fld_active(fname) - ! - !------------------------------------------------------------------------ - ! - ! Purpose: determine if a field is active on any history file - ! - !------------------------------------------------------------------------ - ! - ! Arguments - ! - character(len=*), intent(in) :: fname ! Field name - ! - ! Local variables - ! - character*(max_fieldname_len) :: fname_loc ! max-char equivalent of fname - integer :: ff ! masterlist index pointer - !----------------------------------------------------------------------- - - fname_loc = fname - ff = get_masterlist_indx(fname_loc) - if ( ff < 0 ) then - hist_fld_active = .false. - else - hist_fld_active = masterlist(ff)%thisentry%act_sometape - end if - - end function hist_fld_active - - !####################################################################### - - function hist_fld_col_active(fname, lchnk, numcols) - use cam_history_support, only: history_patch_t - - ! Determine whether each column in a field is active on any history file. - ! The purpose of this routine is to provide information which would allow - ! a diagnostic physics parameterization to only be run on a subset of - ! columns in the case when only column or regional output is requested. - ! - ! **N.B.** The field is assumed to be using the physics decomposition. - - ! Arguments - character(len=*), intent(in) :: fname ! Field name - integer, intent(in) :: lchnk ! chunk ID - integer, intent(in) :: numcols ! Size of return array - - ! Return value - logical :: hist_fld_col_active(numcols) - - ! Local variables - integer :: ff ! masterlist index pointer - integer :: i - integer :: t ! history file (tape) index - integer :: f ! field index - integer :: decomp - logical :: activeloc(numcols) - integer :: num_patches - logical :: patch_output - logical :: found - type(history_patch_t), pointer :: patchptr - - type (active_entry), pointer :: tape(:) - - !----------------------------------------------------------------------- - - ! Initialize to false. Then look to see if and where active. - hist_fld_col_active = .false. - - ! Check for name in the master list. - call get_field_properties(fname, found, tape_out=tape, ff_out=ff) - - ! If not in master list then return. - if (.not. found) return - - ! If in master list, but not active on any file then return - if (.not. masterlist(ff)%thisentry%act_sometape) return - - ! Loop over history files and check for the field/column in each one - do t = 1, ptapes - - ! Is the field active in this file? If not the cycle to next file. - if (.not. masterlist(ff)%thisentry%actflag(t)) cycle - - f = masterlist(ff)%thisentry%htapeindx(t) - decomp = tape(t)%hlist(f)%field%decomp_type - patch_output = associated(tape(t)%patches) - - ! Check whether this file has patch (column) output. - if (patch_output) then - num_patches = size(tape(t)%patches) - - do i = 1, num_patches - patchptr => tape(t)%patches(i) - activeloc = .false. - call patchptr%active_cols(decomp, lchnk, activeloc) - hist_fld_col_active = hist_fld_col_active .or. activeloc - end do - else - - ! No column output has been requested. In that case the field has - ! global output which implies all columns are active. No need to - ! check any other history files. - hist_fld_col_active = .true. - exit - - end if - - end do ! history files - - end function hist_fld_col_active - -end module cam_history diff --git a/src/dynamics/fv/cd_core.F90.orig b/src/dynamics/fv/cd_core.F90.orig deleted file mode 100644 index e679a1d144..0000000000 --- a/src/dynamics/fv/cd_core.F90.orig +++ /dev/null @@ -1,1967 +0,0 @@ -subroutine cd_core(grid, nx, u, v, pt, & - delp, pe, pk, ns, dt, & - ptopin, umax, pi, ae, & - cp3vc, cap3vc, cp3v, cap3v, & - iord_c, jord_c, iord_d, jord_d, ipe, & - div24del2flag, del2coef, & - om, hs, cx3 , cy3, mfx, mfy, & - delpf, uc, vc, ptc, dpt, ptk, & - wz3, pxc, wz, hsxy, ptxy, pkxy, & - pexy, pkcc, wzc, wzxy, delpxy, & - pkkp, wzkp, cx_om, cy_om, filtcw, s_trac, & - mlt, ncx, ncy, nmfx, nmfy, iremote, & - cxtag, cytag, mfxtag, mfytag, & - cxreqs, cyreqs, mfxreqs, mfyreqs, & - kmtp, am_correction, am_fixer, dod, don ,high_order_top) - - ! Dynamical core for both C- and D-grid Lagrangian dynamics - ! - ! DESCRIPTION: - ! Perform a dynamical update for one small time step; the small - ! time step is limitted by the fastest wave within the Lagrangian control- - ! volume - - - use shr_kind_mod, only: r8 => shr_kind_r8 - use sw_core, only: d2a2c_winds, c_sw, d_sw - use pft_module, only: pft2d - use dynamics_vars, only: T_FVDYCORE_GRID - use FVperf_module, only: FVstartclock, FVstopclock, FVbarrierclock - use cam_logfile, only: iulog - use spmd_utils, only: masterproc - use cam_abortutils, only: endrun - -#if defined( SPMD ) - use mod_comm, only : mp_send4d_ns, mp_recv4d_ns, & - mp_send2_ns, mp_recv2_ns, & - mp_send3d_2, mp_recv3d_2, & - mp_send3d, mp_recv3d, mp_sendirr, & - mp_recvirr - use mpishorthand -#endif - -#if defined( OFFLINE_DYN ) - use metdata, only : get_met_fields, met_winds_on_walls -#endif - use metdata, only : met_rlx - - implicit none - - ! INPUT PARAMETERS: - - type (T_FVDYCORE_GRID), intent(inout) :: grid! grid (for YZ decomp) - integer, intent(in) :: nx ! # of split pieces in longitude direction - integer, intent(in) :: ipe ! ipe=1: end of cd_core() - ! ipe=-1,-2: start of cd_core() - ! ipe=-2,2: second to last call to cd_core() - ! ipe=0 : - integer, intent(in) :: ns ! Number of internal time steps (splitting) - integer, intent(in) :: iord_c, jord_c ! scheme order on C grid in X and Y dir. - integer, intent(in) :: iord_d, jord_d ! scheme order on D grid in X and Y dir. - integer, intent(in) :: filtcw ! flag for filtering C-grid winds - - ! ct_overlap data - logical, intent(in) :: s_trac ! true to post send for ct_overlap or - ! tracer decomposition information - integer, intent(in) :: mlt ! multiplicity of sends - integer, intent(in) :: ncx, ncy, nmfx, nmfy ! array sizes - integer, intent(in) :: cxtag(mlt), cytag(mlt) ! tags - integer, intent(in) :: mfxtag(mlt), mfytag(mlt) ! tags - integer, intent(in) :: iremote(mlt) ! target tasks - integer, intent(in) :: cxreqs(mlt), cyreqs(mlt) ! mpi requests - integer, intent(in) :: mfxreqs(mlt), mfyreqs(mlt) ! mpi requests - - - real(r8), intent(in) :: pi - real(r8), intent(in) :: ae ! Radius of the Earth (m) - real(r8), intent(in) :: om ! rotation rate - real(r8), intent(in) :: ptopin - real(r8), intent(in) :: umax - real(r8), intent(in) :: dt !small time step in seconds - integer, intent(in) :: div24del2flag - real(r8), intent(in) :: del2coef - integer, intent(in) :: kmtp ! range of levels (1:kmtp) where order is reduced - logical, intent(in) :: am_correction ! logical switch for correction (applied here) - logical, intent(in) :: am_fixer ! logical switch for fixer (generate out args) - logical, intent(in) :: high_order_top ! use uniform 4th order everywhere (incl. model top) - - real(r8), intent(in) :: & - cp3vc(grid%im,grid%jfirst:grid%jlast,grid%kfirst:grid%klast) !C_p on yz - real(r8), intent(in) :: & - cap3vc(grid%im,grid%jfirst:grid%jlast,grid%kfirst:grid%klast) !cappa on yz - real(r8), intent(in) :: & - cp3v(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,grid%km) ! C_p on xy - real(r8), intent(in) :: & - cap3v(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,grid%km) ! cappa on xy -- on "a" grid - - ! Input time independent arrays: - real(r8), intent(in) :: & - hs(grid%im,grid%jfirst:grid%jlast) !surface geopotential - real(r8), intent(in) :: & - hsxy(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy) !surface geopotential XY-decomp. - - ! INPUT/OUTPUT PARAMETERS: - - real(r8), intent(inout) :: & - u(grid%im,grid%jfirst-grid%ng_d:grid%jlast+grid%ng_s,grid%kfirst:grid%klast) ! u-Wind (m/s) - real(r8), intent(inout) :: & - v(grid%im,grid%jfirst-grid%ng_s:grid%jlast+grid%ng_d,grid%kfirst:grid%klast) ! v-Wind (m/s) - - real(r8), intent(inout) :: & - delp(grid%im,grid%jfirst:grid%jlast,grid%kfirst:grid%klast) ! Delta pressure (pascal) - real(r8), intent(inout) :: & - pt(grid%im,grid%jfirst-grid%ng_d:grid%jlast+grid%ng_d,grid%kfirst:grid%klast)! Scaled-Pot. temp. - - ! Input/output: accumulated winds & mass fluxes on c-grid for large- - ! time-step transport - real(r8), intent(inout) :: & - cx3(grid%im,grid%jfirst-grid%ng_d:grid%jlast+grid%ng_d,grid%kfirst:grid%klast)! Accum. Courant no. in X - real(r8), intent(inout) :: & - cy3(grid%im,grid%jfirst:grid%jlast+1,grid%kfirst:grid%klast) ! Accumulated Courant no. in Y - real(r8), intent(inout) :: & - mfx(grid%im,grid%jfirst:grid%jlast,grid%kfirst:grid%klast) ! Mass flux in X (unghosted) - real(r8), intent(inout) :: & - mfy(grid%im,grid%jfirst:grid%jlast+1,grid%kfirst:grid%klast) ! Mass flux in Y - - ! Input/output work arrays: - real(r8), intent(inout) :: & - delpf(grid%im,grid%jfirst-grid%ng_d:grid%jlast+grid%ng_d,grid%kfirst:grid%klast) ! filtered delp - real(r8), intent(inout) :: & - uc(grid%im,grid%jfirst-grid%ng_d:grid%jlast+grid%ng_d,grid%kfirst:grid%klast) ! u-Winds on C-grid - real(r8), intent(inout) :: & - vc(grid%im,grid%jfirst-2: grid%jlast+2, grid%kfirst:grid%klast) ! v-Winds on C-grid - - real(r8), intent(inout) :: & - dpt(grid%im,grid%jfirst-1:grid%jlast+1,grid%kfirst:grid%klast) - real(r8), intent(inout) :: & - wz3(grid%im,grid%jfirst-1:grid%jlast ,grid%kfirst:grid%klast+1) - real(r8), intent(inout) :: & - pxc(grid%im,grid%jfirst-1:grid%jlast+1,grid%kfirst:grid%klast+1) - real(r8), intent(inout) :: & - wz(grid%im,grid%jfirst-1:grid%jlast+1,grid%kfirst:grid%klast+1) - real(r8), intent(inout) :: & - pkcc(grid%im,grid%jfirst:grid%jlast,grid%kfirst:grid%klast+1) - real(r8), intent(inout) :: & - wzc(grid%im,grid%jfirst:grid%jlast,grid%kfirst:grid%klast+1) - real(r8), intent(inout) :: & - wzxy(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,grid%km+1) - real(r8), intent(inout) :: & - delpxy(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,grid%km) - real(r8), intent(inout) :: & - pkkp(grid%im,grid%jfirst:grid%jlast,grid%kfirst:grid%klast+1) - real(r8), intent(inout) :: & - wzkp(grid%im,grid%jfirst:grid%jlast,grid%kfirst:grid%klast+1) - - ! OUTPUT PARAMETERS: - real(r8), intent(out) :: & - pe(grid%im,grid%kfirst:grid%klast+1,grid%jfirst:grid%jlast) ! Edge pressure (pascal) - real(r8), intent(out) :: & - pk(grid%im,grid%jfirst:grid%jlast,grid%kfirst:grid%klast+1) ! Pressure to the kappa - real(r8), intent(out) :: & - ptxy(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,grid%km) ! Potential temperature XY decomp - real(r8), intent(out) :: & - pkxy(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,grid%km+1) ! P-to-the-kappa XY decomp - real(r8), intent(out) :: & - pexy(grid%ifirstxy:grid%ilastxy,grid%km+1,grid%jfirstxy:grid%jlastxy) ! Edge pressure XY decomp - real(r8), intent(out) :: & - ptc(grid%im,grid%jfirst:grid%jlast,grid%kfirst:grid%klast) - real(r8), intent(out) :: & - ptk(grid%im,grid%jfirst:grid%jlast,grid%kfirst:grid%klast) - -! C.-C. Chen, omega calculation - real(r8), intent(out) :: & - cx_om(grid%im,grid%jfirst:grid%jlast,grid%kfirst:grid%klast) ! Courant in X - real(r8), intent(out) :: & - cy_om(grid%im,grid%jfirst:grid%jlast+1,grid%kfirst:grid%klast) ! Courant in Y - - real(r8), intent(out) :: don(grid%jm,grid%km), & ! num of d(Omega) - dod(grid%jm,grid%km) ! denom of same - - ! Local 2D arrays: - real(r8) :: wk(grid%im+2,grid%jfirst: grid%jlast+2) - real(r8) :: wk1(grid%im,grid%jfirst-1:grid%jlast+1) - real(r8) :: wk2(grid%im+1,grid%jfirst-grid%ng_d:grid%jlast+grid%ng_d) - real(r8) :: wk3(grid%im,grid%jfirst-1:grid%jlast+1) - - real(r8) :: p1d(grid%im) - - ! fvitt cell centered u- and v-Winds (m/s) - real(r8) :: u_cen(grid%im,grid%jfirst-grid%ng_d:grid%jlast+grid%ng_d,grid%kfirst:grid%klast) - real(r8) :: v_cen(grid%im,grid%jfirst-grid%ng_s:grid%jlast+grid%ng_d,grid%kfirst:grid%klast) - real(r8) :: ua(grid%im,grid%jfirst-grid%ng_d:grid%jlast+grid%ng_d,grid%kfirst:grid%klast) - real(r8) :: va(grid%im,grid%jfirst-grid%ng_s:grid%jlast+grid%ng_d,grid%kfirst:grid%klast) - - real(r8) :: pec(grid%im,grid%kfirst:grid%klast+1,grid%jfirst:grid%jlast) - - ! Local scalars - real(r8), parameter :: D0_0 = 0.0_r8 - real(r8), parameter :: D0_1 = 0.1_r8 - real(r8), parameter :: D0_5 = 0.5_r8 - real(r8), parameter :: D1_0 = 1.0_r8 - real(r8), parameter :: D4_0 = 4.0_r8 - real(r8), parameter :: D8_0 = 8.0_r8 - real(r8), parameter :: D10_0 = 10.0_r8 - real(r8), parameter :: D128_0 = 128.0_r8 - real(r8), parameter :: D180_0 = 180.0_r8 - real(r8), parameter :: D1E5 = 1.0e5_r8 - - real(r8), parameter :: ratmax = 0.81_r8 - real(r8), parameter :: tiny = 1.0e-10_r8 - - real(r8) :: press - real(r8) :: rat, ycrit - real(r8) :: dt5 - - integer :: im, jm, km ! problem dimensions - integer :: ifirstxy, jfirstxy ! xy-decomp. lat/long ranges - integer :: ng_c ! ghost latitudes on C grid - integer :: ng_d ! ghost lats on D (Max NS dependencies, ng_d >= ng_c) - integer :: ng_s ! max(ng_c+1,ng_d) significant if ng_c = ng_d - - integer :: jfirst - integer :: jlast - integer :: kfirst - integer :: klast - integer :: klastp ! klast, except km+1 when klast=km - - integer :: iam - integer :: npr_y - integer :: npes_yz - - integer i, j, k, ml - integer js1g1, js2g0, js2g1, jn2g1 ,js4g0,jn3g0 - integer jn2g0, jn1g1 - integer iord , jord - - real(r8) :: tau, fac, px4 - real(r8) :: tau4 ! coefficient for 4th-order divergence damping - -#if defined( SPMD ) - integer dest, src -#endif - - logical :: reset_winds = .false. - logical :: everytime = .false. - - ! set damping options: - ! - ! - ldel2: 2nd-order velocity-component damping targetted to top layers, - ! with coefficient del2coef (default 3E5) - ! - ! - ldiv2: 2nd-order divergence damping everywhere and increasing in top layers - ! (default cam3.5 setting) - ! - ! - ldiv4: 4th-order divergence damping everywhere and increasing in top layers - ! - ! - div24del2flag: 2 for ldiv2 (default), 4 for ldiv4, 42 for ldiv4 + ldel2 - ! - ldiv2 and ldel2 cannot coexist - - logical :: ldiv2 = .true. - logical :: ldiv4 = .false. - logical :: ldel2 = .false. - - ! AM correction and fixer - integer :: iord_c_min - integer :: iord_d_min - integer :: iord_d_low - integer :: jord_c_min - integer :: jord_d_min - integer :: jord_d_low - real(r8) :: oma - real(r8) :: xakap - real(r8), pointer :: cosp(:) - real(r8), pointer :: cose(:) - - real(r8), allocatable :: help(:,:,:) - real(r8), allocatable :: kelp(:,:,:) - real(r8), allocatable :: dpn(:,:,:) - real(r8), allocatable :: dpo(:,:,:) - real(r8), allocatable :: dpr(:,:,:) - real(r8), allocatable :: ddpu(:,:,:) - real(r8), allocatable :: dpns(:,:) - real(r8), allocatable :: ddus(:,:) - - ! referenced outside AM conditional even though it's not used - real(r8) :: ddpa(grid%im,grid%jfirst-1:grid%jlast ,grid%kfirst:grid%klast ) - real(r8) :: ddu( grid%im,grid%jfirst :grid%jlast ,grid%kfirst:grid%klast ) - real(r8) :: vf( grid%im,grid%jfirst-2:grid%jlast+2,grid%kfirst:grid%klast ) ! v-Winds on U points - - ! Used to allow the same code to execute with or without the AM correction - real(r8) :: ptr(grid%im,grid%jfirst-1:grid%jlast+1,grid%kfirst:grid%klast+1) - - logical :: sw_am_corr - - !****************************************************************** - !****************************************************************** - ! - ! IMPORTANT CODE OPTIONS - SEE BELOW - ! - !****************************************************************** - !****************************************************************** - ! Option for which version of geopk to use with yz decomposition. - ! If geopkdist=false, variables are transposed to/from xy decomposition - ! for use in geopk. - ! If geopkdist=true, either geopk_d or geopk16 is used. Both - ! compute local partial sums in z and then communicate those - ! sums to combine them. geopk_d does not try to parallelize in the - ! z-direction except in a pipeline fashion controlled by the - ! parameter geopkblocks, and is bit-for-bit the same as the - ! transpose-based algorithm. geopk16 exploits z-direction - ! parallelism and requires 16-byte arithmetic (DSIZE=16) - ! to reproduce the same numerics (and to be reproducible with - ! respect to process count). The geopk16 default is to use - ! 8-byte arithmetic (DSIZE=8). This is faster than - ! 16-byte, but also gives up reproducibility. On many systems - ! performance of geopk_d is comparable to geopk16 even with - ! 8-byte numerics. - ! On the last two small timesteps (ipe=1,2 or 1,-2) for D-grid, - ! the version of geopk that uses transposes is called regardless, - ! as some transposed quantities are required for the te_map phase - ! and for the calculation of omega. - ! For non-SPMD mode, geopk_[cd]dist are set to false. - - logical geopk_cdist, geopk_ddist - - ! REVISION HISTORY: - ! SJL 99.01.01: Original SMP version - ! WS 99.04.13: Added jfirst:jlast concept - ! SJL 99.07.15: Merged c_core and d_core to this routine - ! WS 99.09.07: Restructuring, cleaning, documentation - ! WS 99.10.18: Walkthrough corrections; frozen for 1.0.7 - ! WS 99.11.23: Pruning of some 2-D arrays - ! SJL 99.12.23: More comments; general optimization; reduction - ! of redundant computation & communication - ! WS 00.05.14: Modified ghost indices per Kevin's definition - ! WS 00.07.13: Changed PILGRIM API - ! WS 00.08.28: Cosmetic changes: removed old loop limit comments - ! AAM 00.08.30: Introduced kfirst,klast - ! WS 00.12.01: Replaced MPI_ON with SPMD; hs now distributed - ! WS 01.04.11: PILGRIM optimizations for begin/endtransfer - ! WS 01.05.08: Optimizations in the call of c_sw and d_sw - ! AAM 01.06.27: Reinstituted 2D decomposition for use in ccm - ! WS 01.12.10: Ghosted PT, code now uses mod_comm primitives - ! WS 01.12.31: Removed vorticity damping, ghosted U,V,PT - ! WS 02.01.15: Completed transition to mod_comm - ! WS 02.07.04: Fixed 2D decomposition bug dest/src for mp_send3d - ! WS 02.09.04: Integrated fvgcm-1_3_71 zero diff. changes by Lin - ! WS 03.07.22: Removed HIGH_P option; this is outdated - ! WS 03.10.15: Fixed hack of 00.04.13 for JORD>1 JCD=1, in clean way - ! WS 03.12.03: Added grid as argument, some dynamics_vars removed - ! WS 04.08.25: Interface simplified with GRID argument - ! WS 04.10.07: Removed dependency on spmd_dyn; info now in GRID - ! WS 05.05.24: Incorporated OFFLINE_DYN; merge of CAM/GEOS5 - ! PW 05.07.26: Changes for Cray X1 - ! PW 05.10.12: More changes for Cray X1(E), avoiding array segment copying - ! WS 06.09.08: Isolated magic numbers as F90 parameters - ! WS 06.09.15: PI now passed as argument - ! CC 07.01.29: Corrected calculation of OMEGA - ! PW 08.06.29: Added options to call geopk_d and swap-based transposes - ! THT 16.11.18: Add options for AM correction and fixer - !-------------------------------------------------------------------------------------- - - logical :: high_alt - high_alt = grid%high_alt - - geopk_cdist = .false. - geopk_ddist = .false. -#if defined( SPMD ) - if (grid%geopkdist) then - geopk_cdist = .true. - if ((ipe == -1) .or. (ipe == 0)) geopk_ddist = .true. - endif -#endif - - npes_yz = grid%npes_yz - - im = grid%im - jm = grid%jm - km = grid%km - - ng_c = grid%ng_c - ng_d = grid%ng_d - ng_s = grid%ng_s - - jfirst = grid%jfirst - jlast = grid%jlast - kfirst = grid%kfirst - klast = grid%klast - klastp = grid%klastp - - iam = grid%iam - npr_y = grid%npr_y - - ifirstxy = grid%ifirstxy - jfirstxy = grid%jfirstxy - - if (am_correction .or. am_fixer) then - allocate( & - help(grid%im,grid%jfirst-1:grid%jlast ,grid%kfirst:grid%klast ), & - kelp(grid%im,grid%jfirst-1:grid%jlast ,grid%kfirst:grid%klast ), & - dpn(grid%im,grid%jfirst :grid%jlast ,grid%kfirst:grid%klast ), & - dpo(grid%im,grid%jfirst :grid%jlast ,grid%kfirst:grid%klast ) ) - endif - if (am_correction) then - allocate( & - dpr(grid%im,grid%jfirst-1:grid%jlast+1,grid%kfirst:grid%klast ), & - ddpu(grid%im,grid%jfirst :grid%jlast ,grid%kfirst:grid%klast ), & - dpns(grid%jfirst:grid%jlast,grid%kfirst:grid%klast), & - ddus(grid%jfirst:grid%jlast,grid%kfirst:grid%klast) ) - xakap = 1._r8/cap3vc(1,jfirst,kfirst) - else - xakap = 1._r8 - endif - - ! maintain consistent accuracy (uniform PPM order) over domain - if (high_order_top) then - iord_c_min = iord_c - jord_c_min = jord_c - iord_d_min = iord_d - jord_d_min = jord_d - iord_d_low = iord_d - jord_d_low = jord_d - else - iord_c_min = 1 - jord_c_min = 1 - iord_d_min = 1 - jord_d_min = 1 - iord_d_low = 2 - jord_d_low = 2 - endif - oma = ae*om - don = 0.0_r8 - dod = 0.0_r8 - cosp => grid%cosp - cose => grid%cose - - if (iam .lt. npes_yz) then - - call FVstartclock(grid,'---PRE_C_CORE') - -#if defined( SPMD ) - call FVstartclock(grid,'---PRE_C_CORE_COMM') - call mp_send4d_ns( grid%commyz, im, jm, km, 1, jfirst, jlast, & - kfirst, klast, ng_d, ng_s, u ) - call mp_send4d_ns( grid%commyz, im, jm, km, 1, jfirst, jlast, & - kfirst, klast, ng_s, ng_d, v ) - call FVstopclock(grid,'---PRE_C_CORE_COMM') -#endif - - ! Set general loop limits - ! jfirst >= 1; jlast <= jm - js1g1 = max(1,jfirst-1) - js2g0 = max(2,jfirst) - js2g1 = max(2,jfirst-1) - jn2g0 = min(jm-1,jlast) - jn1g1 = min(jm,jlast+1) - jn2g1 = min(jm-1,jlast+1) - js4g0 = max(4,jfirst) - jn3g0 = min(jm-2,jlast) - - if ( abs(grid%dt0-dt) > D0_1 ) then - - grid%dt0 = dt - dt5 = D0_5*dt - - grid%rdy = D1_0/(ae*grid%dp) - grid%dtdy = dt *grid%rdy - grid%dtdy5 = dt5*grid%rdy - grid%dydt = (ae*grid%dp) / dt - grid%tdy5 = D0_5/grid%dtdy - - do j = 2, jm-1 - grid%dx(j) = grid%dl*ae*grid%cosp(j) - grid%rdx(j) = D1_0 / grid%dx(j) - grid%dtdx(j) = dt /grid% dx(j) - grid%dxdt(j) = grid%dx(j) / dt - grid%dtdx2(j) = D0_5*grid%dtdx(j) - grid%dtdx4(j) = D0_5*grid%dtdx2(j) - grid%dycp(j) = ae*grid%dp/grid%cosp(j) - grid%cy(j) = grid%rdy * grid%acosp(j) - end do - - do j = 2, jm - grid%dxe(j) = ae*grid%dl*grid%cose(j) - grid%rdxe(j) = D1_0 / grid%dxe(j) - grid%dtdxe(j) = dt / grid%dxe(j) - grid%dtxe5(j) = D0_5*grid%dtdxe(j) - grid%txe5(j) = D0_5/grid%dtdxe(j) - grid%cye(j) = D1_0 / (ae*grid%cose(j)*grid%dp) - grid%dyce(j) = ae*grid%dp/grid%cose(j) - end do - - ! C-grid - if (grid%ptop>1._r8) then - grid%zt_c = abs(umax*dt5) / (grid%dl*ae) - else - grid%zt_c = cos( D10_0 * pi / D180_0 ) - end if - - ! D-grid - if (grid%ptop>1._r8) then - grid%zt_d = abs(umax*dt) / (grid%dl*ae) - else - grid%zt_d = cos( D10_0 * pi / D180_0 ) - end if - - if ( ptopin /= grid%ptop) then - write(iulog,*) 'PTOP as input to cd_core != ptop from T_FVDYCORE_GRID' - call endrun('PTOP as input to cd_core != ptop from T_FVDYCORE_GRID') - end if - - ! damping code - - if (div24del2flag == 2) then - - ! cam3.5 default damping setting - ldiv2 = .true. - ldiv4 = .false. - ldel2 = .false. - if (masterproc) write(iulog,*) 'Divergence damping: use 2nd order damping' - - elseif (div24del2flag == 4) then - - ! fourth order divergence damping and no velocity diffusion - ldiv2 = .false. - ldiv4 = .true. - ldel2 = .false. - if (masterproc) write(iulog,*) 'Divergence damping: use 4th order damping' - - elseif (div24del2flag == 42) then - - ! fourth order divergence damping with velocity diffusion - ldiv2 = .false. - ldiv4 = .true. - ldel2 = .true. - if (masterproc) write(iulog,*) 'Divergence damping: use 4th order damping' - if (masterproc) write(iulog,*) 'Velocity del2 damping with coefficient ', del2coef - - else - - ldiv2 = .true. - ldiv4 = .false. - ldel2 = .false. - if (masterproc) write(iulog,*) 'Inadmissable velocity smoothing option - div24del2flag = ', div24del2flag - call endrun('Inadmissable value of div24del2flag') - end if - - do k = kfirst, klast - - if (ldel2) then - - !*********************************** - ! - ! Laplacian on velocity components - ! - !*********************************** - - press = D0_5 * ( grid%ak(k)+grid%ak(k+1) + & - (grid%bk(k)+grid%bk(k+1))*D1E5 ) - tau = D8_0 * (D1_0+ tanh(D1_0*log(grid%ptop/press)) ) - - ! tau is strength of damping - if (tau < 0.3_r8) then - - ! no del2 damping at lower levels - tau = 0.0_r8 - end if - - do j = js2g0, jn1g1 - - ! fac must include dt for the momentum equation - ! i.e. diffusion coefficient is fac/dt - ! - ! del2 diffusion coefficient in spectral core is 2.5e5 - fac = tau * dt * del2coef - - ! all these coefficients are necessary because of the staggering of the - ! wind components - grid%cdxde(j,k) = fac/(ae*ae*grid%cose(j)*grid%cose(j)*grid%dl*grid%dl) - grid%cdyde(j,k) = fac/(ae*ae*grid%cose(j)*grid%dp*grid%dp) - end do - - do j = js2g0, jn2g1 - fac = tau * dt * del2coef - grid%cdxdp(j,k) = fac/(ae*ae*grid%cosp(j)*grid%cosp(j)*grid%dl*grid%dl) - grid%cdydp(j,k) = fac/(ae*ae*grid%cosp(j)*grid%dp*grid%dp) - end do - end if - - if (ldiv2) then - - !*********************************************** - ! - ! cam3 default second-order divergence damping - ! - !*********************************************** - press = D0_5 * ( grid%ak(k)+grid%ak(k+1) + & - (grid%bk(k)+grid%bk(k+1))*D1E5 ) - tau = D8_0 * (D1_0+ tanh(D1_0*log(grid%ptop/press)) ) - tau = max(D1_0, tau) / (D128_0*abs(dt)) - - do j = js2g0, jn1g1 - - !----------------------------------------- - ! Explanation of divergence damping coeff. - ! ======================================== - ! - ! Divergence damping is added to the momentum - ! equations through a term tau*div where - ! - ! tau = C*L**2/dt - ! - ! where L is the length scale given by - ! - ! L**2 = a**2*dl*dp - ! - ! and divergence is given by - ! - ! div = divx + divy - ! - ! where - ! - ! divx = (1/(a*cos(p)))*du/dl - ! divy = (1/(a*cos(p)))*(d(cos(theta)*v)/dp)) - ! - ! du and (d(cos(theta*v)/dp)) are computed in sw_core - ! - ! The constant terms in divx*tau and divy*tau are - ! - ! cdx = (1/(a*cos(p)))* (1/dl) * C * a**2 * dl * dp / dt = C * (a*dp/(cos(p)))/dt - ! cdy = (1/(a*cos(p)))* (1/dp) * C * a**2 * dl * dp / dt = C * (a*dl/(cos(p)))/dt - ! - !----------------------------------------- - fac = tau * ae / grid%cose(j) !default - grid%cdx(j,k) = fac*grid%dp !default - grid%cdy(j,k) = fac*grid%dl !default - end do - end if - - if (ldiv4) then - - ! 4th-order divergence damping - tau4 = 0.01_r8 / (abs(dt)) - - !************************************** - ! - ! fourth order divergence damping - ! - !************************************** - - do j = 1, jm - - ! divergence computation coefficients - grid%cdxdiv (j,k) = D1_0/(grid%cose(j)*grid%dl) - grid%cdydiv (j,k) = D1_0/(grid%cose(j)*grid%dp) - end do - - do j = js2g0, jn1g1 - - ! div4 coefficients - fac = grid%dl*grid%cose(j)!*ae - grid%cdx4 (j,k) = D1_0/(fac*fac) - fac = grid%dp*grid%dp*grid%cose(j)!*ae*ae - grid%cdy4 (j,k) = D1_0/fac - fac = grid%cose(j)*grid%dp*grid%dl - grid%cdtau4(j,k) = -ae*tau4*fac*fac - end do - end if - - end do ! do k = kfirst, klast - - end if ! if ( abs(grid%dt0-dt) > D0_1 ) - - if ( ipe < 0 .or. ns == 1 ) then ! starting cd_core - call FVstartclock(grid,'---C_DELP_LOOP') -!$omp parallel do private(i, j, k, wk, wk2) - do k = kfirst, klast - do j = jfirst, jlast - do i = 1, im - delpf(i,j,k) = delp(i,j,k) - end do - end do - call pft2d( delpf(1,js2g0,k), grid%sc, & - grid%dc, im, jn2g0-js2g0+1, & - wk, wk2 ) - end do - call FVstopclock(grid,'---C_DELP_LOOP') - - end if - -#if defined( SPMD ) - call FVstartclock(grid,'---PRE_C_CORE_COMM') - call mp_recv4d_ns( grid%commyz, im, jm, km, 1, jfirst, jlast, & - kfirst, klast, ng_d, ng_s, u ) - call mp_recv4d_ns( grid%commyz, im, jm, km, 1, jfirst, jlast, & - kfirst, klast, ng_s, ng_d, v ) - - call mp_send4d_ns( grid%commyz, im, jm, km, 1, jfirst, jlast, & - kfirst, klast, ng_d, ng_d, pt ) - if ( ipe < 0 .or. ns == 1 ) then ! starting cd_core - call mp_send4d_ns( grid%commyz, im, jm, km, 1, jfirst, jlast, & - kfirst, klast, ng_d, ng_d, delpf ) - endif ! end if ipe < 0 check - call mp_recv4d_ns( grid%commyz, im, jm, km, 1, jfirst, jlast, & - kfirst, klast, ng_d, ng_d, pt ) - if ( ipe < 0 .or. ns == 1 ) then ! starting cd_core - call mp_recv4d_ns( grid%commyz, im, jm, km, 1, jfirst, jlast, & - kfirst, klast, ng_d, ng_d, delpf ) - endif ! end if ipe < 0 check - call FVstopclock(grid,'---PRE_C_CORE_COMM') -#endif - - - ! Get the cell centered winds if needed for the sub-step - -#if ( defined OFFLINE_DYN ) - if ( ( (ipe < 0) .or. (everytime) ) .and. (.not. met_winds_on_walls()) ) then - call get_met_fields( grid, u_cen, v_cen ) - reset_winds = .true. - else - reset_winds = .false. - endif -#endif - - - ! Get D-grid V-wind at the poles and interpolate winds to A- and C-grids; - ! This calculation was formerly done in subroutine c_sw but is being done here to - ! avoid communication in OpenMP loops - -!$omp parallel do private(k, wk, wk2) - do k = kfirst, klast - call d2a2c_winds(grid, u(1,jfirst-ng_d,k), v(1,jfirst-ng_s,k), & - ua(1,jfirst-ng_d,k), va(1,jfirst-ng_s,k), & - uc(1,jfirst-ng_d,k), vc(1,jfirst-2,k), & - u_cen(1,jfirst-ng_d,k), v_cen(1,jfirst-ng_s,k), & - reset_winds, met_rlx(k), am_correction) - - ! Optionally filter advecting C-grid winds - if (filtcw .gt. 0) then - call pft2d(uc(1,js2g0,k), grid%sc, grid%dc, im, jn2g0-js2g0+1, wk, wk2 ) - call pft2d(vc(1,js2g0,k), grid%se, grid%de, im, jlast-js2g0+1, wk, wk2 ) - end if - - end do - -#if defined( SPMD ) - ! Fill C-grid advecting winds Halo regions - ! vc only needs to be ghosted at jlast+1 - call mp_send4d_ns( grid%commyz, im, jm, km, 1, jfirst, jlast, & - kfirst, klast, ng_d, ng_d, uc ) - call mp_send4d_ns( grid%commyz, im, jm, km, 1, jfirst, jlast, & - kfirst, klast, 2, 2, vc ) - call mp_recv4d_ns( grid%commyz, im, jm, km, 1, jfirst, jlast, & - kfirst, klast, ng_d, ng_d, uc ) - call mp_recv4d_ns( grid%commyz, im, jm, km, 1, jfirst, jlast, & - kfirst, klast, 2, 2, vc ) -#endif - - call FVstopclock(grid,'---PRE_C_CORE') - - call FVbarrierclock(grid,'sync_c_core', grid%commyz) - call FVstartclock(grid,'---C_CORE') - -!$omp parallel do private(i, j, k, iord, jord) - do k = kfirst, klast - - if ( k <= kmtp ) then - iord = iord_c_min - jord = jord_c_min - else - iord = iord_c - jord = jord_c - end if - - !----------------------------------------------------------------- - ! Call the vertical independent part of the dynamics on the C-grid - !----------------------------------------------------------------- - - call c_sw( grid, u(1,jfirst-ng_d,k), v(1,jfirst-ng_s,k), & - pt(1,jfirst-ng_d,k), delp(1,jfirst,k), & - ua(1,jfirst-ng_d,k), va(1,jfirst-ng_s,k), & - uc(1,jfirst-ng_d,k), vc(1,jfirst-2,k), & - ptc(1,jfirst,k), delpf(1,jfirst-ng_d,k), & - ptk(1,jfirst,k), tiny, iord, jord, am_correction) - end do - - call FVstopclock(grid,'---C_CORE') - -! MPI note: uc, vc, ptk, and ptc computed within the above k-look from jfirst to jlast -! Needed by D-core: uc(jfirst-ng_d:jlast+ng_d), vc(jfirst:jlast+1) - - call FVbarrierclock(grid,'sync_c_geop', grid%commyz) - - end if ! (iam .lt. npes_yz) - - - if (geopk_cdist) then - - if (iam .lt. npes_yz) then - - ! Stay in yz space and use z communications - - if (grid%geopk16byte) then - call FVstartclock(grid,'---C_GEOP16') - call geopk16(grid, pe, ptk, pkcc, wzc, hs, ptc, & - 0, cp3vc(1,jfirst,kfirst), cap3vc(1,jfirst,kfirst) ) - else - call FVstartclock(grid,'---C_GEOP_D') - call geopk_d(grid, pe, ptk, pkcc, wzc, hs, ptc, & - 0, cp3vc(1,jfirst,kfirst), cap3vc(1,jfirst,kfirst) ) - end if - - ! Geopk does not need j ghost zones of pkc and wz - - if (.not.high_alt) then -!$omp parallel do private(i, j, k) - do k = kfirst, klast+1 - do j = jfirst, jlast - do i = 1, im - pxc(i,j,k) = pkcc(i,j,k) - end do - end do - end do - endif - -!$omp parallel do private(i, j, k) - do k = kfirst, klast+1 - do j = jfirst, jlast - do i = 1, im - wz(i,j,k) = wzc(i,j,k) - end do - end do - end do - - if (grid%geopk16byte) then - call FVstopclock(grid,'---C_GEOP16') - else - call FVstopclock(grid,'---C_GEOP_D') - end if - - end if ! (iam .lt. npes_yz) - - else - - ! Begin xy geopotential section - - call FVstartclock(grid,'---C_GEOP') - - if (grid%twod_decomp == 1) then - - ! Transpose to xy decomposition - -#if defined( SPMD ) - call FVstartclock(grid,'YZ_TO_XY_C_GEOP') - if (grid%modc_onetwo .eq. 1) then - call mp_sendirr( grid%commxy, grid%ijk_yz_to_xy%SendDesc, & - grid%ijk_yz_to_xy%RecvDesc, ptk, delpxy, & - modc=grid%modc_cdcore ) - call mp_recvirr( grid%commxy, grid%ijk_yz_to_xy%SendDesc, & - grid%ijk_yz_to_xy%RecvDesc, ptk, delpxy, & - modc=grid%modc_cdcore ) - call mp_sendirr( grid%commxy, grid%ijk_yz_to_xy%SendDesc, & - grid%ijk_yz_to_xy%RecvDesc, ptc, ptxy, & - modc=grid%modc_cdcore ) - call mp_recvirr( grid%commxy, grid%ijk_yz_to_xy%SendDesc, & - grid%ijk_yz_to_xy%RecvDesc, ptc, ptxy, & - modc=grid%modc_cdcore ) - else - call mp_sendirr( grid%commxy, grid%ijk_yz_to_xy%SendDesc, & - grid%ijk_yz_to_xy%RecvDesc, ptk, delpxy, & - ptc, ptxy, & - modc=grid%modc_cdcore ) - call mp_recvirr( grid%commxy, grid%ijk_yz_to_xy%SendDesc, & - grid%ijk_yz_to_xy%RecvDesc, ptk, delpxy, & - ptc, ptxy, & - modc=grid%modc_cdcore ) - end if - call FVstopclock(grid,'YZ_TO_XY_C_GEOP') -#endif - - else - -!$omp parallel do private(i, j, k) - do k = kfirst, klast - do j = jfirst, jlast - do i = 1, im - delpxy(i,j,k) = ptk(i,j,k) - ptxy(i,j,k) = ptc(i,j,k) - end do - end do - end do - - end if - - call geopk(grid, pexy, delpxy, pkxy, wzxy, hsxy, ptxy, & - cp3v, cap3v, nx) - - if (grid%twod_decomp == 1) then - - ! Transpose back to yz decomposition. - ! pexy is not output quantity on this call. - ! pkkp and wzkp are holding arrays, whose specific z-dimensions - ! are required by Pilgrim. - ! Z edge ghost points (klast+1) are automatically filled in - -#if defined( SPMD ) - - call FVstartclock(grid,'XY_TO_YZ_C_GEOP') - if (high_alt) then - call mp_sendirr( grid%commxy, grid%pexy_to_pe%SendDesc, & - grid%pexy_to_pe%RecvDesc, pexy, pec, & - modc=grid%modc_dynrun ) - call mp_recvirr( grid%commxy, grid%pexy_to_pe%SendDesc, & - grid%pexy_to_pe%RecvDesc, pexy, pec, & - modc=grid%modc_dynrun ) - call mp_sendirr( grid%commxy, grid%pkxy_to_pkc%SendDesc, & - grid%pkxy_to_pkc%RecvDesc, wzxy, wzkp, & - modc=grid%modc_cdcore ) - call mp_recvirr( grid%commxy, grid%pkxy_to_pkc%SendDesc, & - grid%pkxy_to_pkc%RecvDesc, wzxy, wzkp, & - modc=grid%modc_cdcore ) - else - if (grid%modc_onetwo .eq. 1) then - call mp_sendirr( grid%commxy, grid%pkxy_to_pkc%SendDesc, & - grid%pkxy_to_pkc%RecvDesc, pkxy, pkkp, & - modc=grid%modc_cdcore ) - call mp_recvirr( grid%commxy, grid%pkxy_to_pkc%SendDesc, & - grid%pkxy_to_pkc%RecvDesc, pkxy, pkkp, & - modc=grid%modc_cdcore ) - call mp_sendirr( grid%commxy, grid%pkxy_to_pkc%SendDesc, & - grid%pkxy_to_pkc%RecvDesc, wzxy, wzkp, & - modc=grid%modc_cdcore ) - call mp_recvirr( grid%commxy, grid%pkxy_to_pkc%SendDesc, & - grid%pkxy_to_pkc%RecvDesc, wzxy, wzkp, & - modc=grid%modc_cdcore ) - else - call mp_sendirr( grid%commxy, grid%pkxy_to_pkc%SendDesc, & - grid%pkxy_to_pkc%RecvDesc, pkxy, pkkp, & - wzxy, wzkp, & - modc=grid%modc_cdcore ) - call mp_recvirr( grid%commxy, grid%pkxy_to_pkc%SendDesc, & - grid%pkxy_to_pkc%RecvDesc, pkxy, pkkp, & - wzxy, wzkp, & - modc=grid%modc_cdcore ) - end if - endif - call FVstopclock(grid,'XY_TO_YZ_C_GEOP') - - if (high_alt) then -!$omp parallel do private(i, j, k) - do k = kfirst, klast+1 - do j = jfirst, jlast - do i = 1, im - pxc(i,j,k) = log(pec(i,k,j)) - end do - end do - end do - else -!$omp parallel do private(i, j, k) - do k = kfirst, klast+1 - do j = jfirst, jlast - do i = 1, im - pxc(i,j,k) = pkkp(i,j,k) - end do - end do - end do - endif -!$omp parallel do private(i, j, k) - do k = kfirst, klast+1 - do j = jfirst, jlast - do i = 1, im - wz(i,j,k) = wzkp(i,j,k) - end do - end do - end do - -#endif - - else - -!$omp parallel do private(i, j, k) - do k = kfirst, klast+1 - do j = jfirst, jlast - do i = 1, im - wz(i,j,k) = wzxy(i,j,k) - end do - end do - end do - if (high_alt) then -!$omp parallel do private(i, j, k) - do k = kfirst, klast+1 - do j = jfirst, jlast - do i = 1, im - pec(i,k,j) = pexy(i,k,j) - pxc(i,j,k) = log(pec(i,k,j)) - end do - end do - end do - else -!$omp parallel do private(i, j, k) - do k = kfirst, klast+1 - do j = jfirst, jlast - do i = 1, im - pxc(i,j,k) = pkxy(i,j,k) - end do - end do - end do - endif - - end if - - call FVstopclock(grid,'---C_GEOP') - - ! End xy geopotential section - end if ! geopk_cdist - - if (iam .lt. npes_yz) then - - call FVbarrierclock(grid,'sync_pre_d_core', grid%commyz) - call FVstartclock(grid,'---PRE_D_CORE') - - ! Upon exit from geopk, the quantities pe, pkc and wz will have been - ! updated at klast+1 - -#if defined( SPMD ) - - ! pkc & wz need to be ghosted only at jfirst-1 - - call FVstartclock(grid,'---PRE_D_CORE_COMM') - dest = iam+1 - src = iam-1 - if ( mod(iam+1,npr_y) == 0 ) dest = -1 - if ( mod(iam,npr_y) == 0 ) src = -1 - call mp_send3d_2( grid%commyz, dest, src, im, jm, km+1, & - 1, im, jfirst-1, jlast+1, kfirst, klast+1, & - 1, im, jlast, jlast, kfirst, klast+1, pxc, wz) - call FVstopclock(grid,'---PRE_D_CORE_COMM') -#endif - - call FVstartclock(grid,'---C_U_LOOP') - - -!$omp parallel do private(i, j, k, p1d, wk, wk2, wk1, wk3) - ! Beware k+1 references directly below (AAM) - do k = kfirst, klast - do j = js2g0, jn2g0 - - if (am_correction) then - - do i = 1, im - ! AM fix: ensure interior pressure torque vanishes - wk1(i,j) = pxc(i,j,k )*max(pxc(i,j,k), tiny)**(xakap - 1.0_r8) - wk3(i,j) = pxc(i,j,k+1)**xakap - p1d(i) = wk3(i,j) - wk1(i,j) - enddo - - uc(1,j,k) = uc(1,j,k) + grid%dtdx2(j) * ( & - (wz(im,j,k+1)-wz(1,j,k))*(wk3(1,j)-wk1(im,j)) & - + (wz(im,j,k)-wz(1,j,k+1))*(wk3(im,j)-wk1(1,j))) & - / (p1d(1)+p1d(im)) - do i = 2, im - uc(i,j,k) = uc(i,j,k) + grid%dtdx2(j) * ( & - (wz(i-1,j,k+1)-wz(i,j,k))*(wk3(i,j)-wk1(i-1,j)) & - + (wz(i-1,j,k)-wz(i,j,k+1))*(wk3(i-1,j)-wk1(i,j))) & - / (p1d(i)+p1d(i-1)) - end do - - else - - do i = 1, im - p1d(i) = pxc(i,j,k+1) - pxc(i,j,k) - enddo - - uc(1,j,k) = uc(1,j,k) + grid%dtdx2(j) * ( & - (wz(im,j,k+1)-wz(1,j,k))*(pxc(1,j,k+1)-pxc(im,j,k)) & - + (wz(im,j,k)-wz(1,j,k+1))*(pxc(im,j,k+1)-pxc(1,j,k))) & - / (p1d(1)+p1d(im)) - do i = 2, im - uc(i,j,k) = uc(i,j,k) + grid%dtdx2(j) * ( & - (wz(i-1,j,k+1)-wz(i,j,k))*(pxc(i,j,k+1)-pxc(i-1,j,k)) & - + (wz(i-1,j,k)-wz(i,j,k+1))*(pxc(i-1,j,k+1)-pxc(i,j,k))) & - / (p1d(i)+p1d(i-1)) - end do - - end if ! (am_correction) - - do i = 1, im - cx_om(i,j,k) = grid%dtdx(j)*uc(i,j,k) - end do - - end do - - call pft2d(uc(1,js2g0,k), grid%sc, & - grid%dc, im, jn2g0-js2g0+1, & - wk, wk2 ) - - if ( jfirst == 1 ) then ! Clean up - do i = 1, im - uc(i,1,k) = D0_0 - cx_om(i,1,k) = D0_0 - end do - end if - - if ( jlast == jm ) then ! Clean up - do i = 1, im - uc(i,jm,k) = D0_0 - cx_om(i,jm,k) = D0_0 - end do - end if - - end do - - call FVstopclock(grid,'---C_U_LOOP') - -#if defined( SPMD ) - call FVstartclock(grid,'---PRE_D_CORE_COMM') - ! pkc and wz need only to be ghosted jfirst-1 - call mp_recv3d_2( grid%commyz, src, im, jm, km+1, & - 1, im, jfirst-1, jlast+1, kfirst, klast+1, & - 1, im, jfirst-1, jfirst-1, kfirst, klast+1, pxc, wz) - - call mp_send4d_ns( grid%commyz, im, jm, km, 1, jfirst, jlast, & - kfirst, klast, ng_d, ng_d, uc ) - call FVstopclock(grid,'---PRE_D_CORE_COMM') -#endif - - call FVstartclock(grid,'---C_V_PGRAD') - - if (am_correction) then -!$omp parallel do private(i, j, k) - ! AM correction (pressure, advective winds): pxc -> ptr - do k = kfirst, klast+1 - do j = js1g1, jlast - do i = 1, im - ptr(i,j,k) = pxc(i,j,k)*max(pxc(i,j,k), tiny)**(xakap - 1.0_r8) - end do - end do - end do - else -!$omp parallel do private(i, j, k) - do k = kfirst, klast+1 - do j = js1g1, jlast - do i = 1, im - ptr(i,j,k) = pxc(i,j,k) - end do - end do - end do - end if - -!$omp parallel do private(i, j, k, wk, wk1 ) - ! Beware k+1 references directly below (AAM) - do k = kfirst, klast - do j = js1g1, jlast - do i = 1, im - wk1(i,j) = ptr(i,j,k+1) - ptr(i,j,k) - end do - end do - - do j = js2g0, jlast - do i = 1, im - vc(i,j,k) = vc(i,j,k) + grid%dtdy5/(wk1(i,j)+wk1(i,j-1)) * & - ( (wz(i,j-1,k+1)-wz(i,j,k))*(ptr(i,j,k+1)-ptr(i,j-1,k)) & - + (wz(i,j-1,k)-wz(i,j,k+1))*(ptr(i,j-1,k+1)-ptr(i,j,k)) ) - - cy_om(i,j,k) = grid%dtdy*vc(i,j,k) - end do - end do - - call pft2d(vc(1,js2g0,k), grid%se, & - grid%de, im, jlast-js2g0+1, wk, wk1 ) - end do - - call FVstopclock(grid,'---C_V_PGRAD') - -#if defined( SPMD ) - call FVstartclock(grid,'---PRE_D_CORE_COMM') - call mp_recv4d_ns( grid%commyz, im, jm, km, 1, jfirst, jlast, & - kfirst, klast, ng_d, ng_d, uc ) - - ! vc only needs to be ghosted at jlast+1 - dest = iam-1 - src = iam+1 - if ( mod(iam,npr_y) == 0 ) dest = -1 - if ( mod(iam+1,npr_y) == 0 ) src = -1 - call mp_send3d( grid%commyz, dest, src, im, jm, km, & - 1, im, jfirst-2, jlast+2, kfirst, klast, & - 1, im, jfirst, jfirst, kfirst, klast, vc ) - call mp_recv3d( grid%commyz, src, im, jm, km, & - 1, im, jfirst-2, jlast+2, kfirst, klast, & - 1, im, jlast+1, jlast+1, kfirst, klast, vc ) - call FVstopclock(grid,'---PRE_D_CORE_COMM') - - call mp_send3d( grid%commyz, dest, src, im, jm, km, & - 1, im, jfirst, jlast+1, kfirst, klast, & - 1, im, jfirst, jfirst, kfirst, klast, cy_om ) - call mp_recv3d( grid%commyz, src, im, jm, km, & - 1, im, jfirst, jlast+1, kfirst, klast, & - 1, im, jlast+1, jlast+1, kfirst, klast, cy_om ) -#endif - - call FVstopclock(grid,'---PRE_D_CORE') - - call FVbarrierclock(grid,'sync_d_core', grid%commyz) - call FVstartclock(grid,'---D_CORE') - -!$omp parallel do private(i, j, k, iord, jord) - do k = kfirst, klast - - if( k <= kmtp ) then - if( k == 1 ) then - iord = iord_d_min - jord = jord_d_min - else - iord = min(iord_d_low, iord_d) - jord = min(jord_d_low, jord_d) - end if - else - iord = iord_d - jord = jord_d - end if - - !----------------------------------------------------------------- - ! Call the vertical independent part of the dynamics on the D-grid - !----------------------------------------------------------------- - - if (am_correction .or. am_fixer) then - do j = jfirst, jlast - do i = 1, im - kelp(i,j,k) = delp(i,j,k) ! un-updated delp on A grid - end do - end do - end if - - ! don't apply correction if order is not 4 - sw_am_corr = am_correction .and. iord.eq.iord_d .and. jord.eq.jord_d - - call d_sw( grid, u(1,jfirst-ng_d,k), v(1,jfirst-ng_s,k), & - uc(1,jfirst-ng_d,k), vc(1,jfirst-2,k), & - pt(1,jfirst-ng_d,k), delp(1,jfirst,k), & - delpf(1,jfirst-ng_d,k), cx3(1,jfirst-ng_d,k), & - cy3(1,jfirst,k), mfx(1,jfirst,k), & - mfy(1,jfirst,k), & - grid%cdx (js2g0:,k),grid%cdy (js2g0:,k), & - grid%cdxde (js2g0:,k),grid%cdxdp (js2g0:,k), & - grid%cdyde(js2g0:,k) ,grid%cdydp(js2g0:,k), & - grid%cdxdiv(:,k),grid%cdydiv(:,k) , & - grid%cdx4 (js2g0:,k),grid%cdy4(js2g0:,k) , & - grid%cdtau4(js2g0:,k), ldiv2, ldiv4, ldel2, & - iord, jord, tiny, sw_am_corr, & - ddpa(1,jfirst,k), ddu(1,jfirst,k), & - vf(1,jfirst-2 ,k) ) - - if (am_correction .or. am_fixer) then - do j = jfirst, jlast - do i = 1, im - help(i,j,k) = delp(i,j,k) ! updated delp on A grid - end do - end do - end if - - end do - - call FVstopclock(grid,'---D_CORE') - - ! AM correction and fixer (main block) - if (am_correction .or. am_fixer) then - - call FVbarrierclock(grid,'sync_dp4corr_1', grid%commyz) - call FVstartclock(grid,'---dp4corr_COMM_1') - -#if defined( SPMD ) - ! only (jfirst-1) halo point required (iam,jlast) -> (iam+1,jfirst-1) - dest = iam+1 - src = iam-1 - if ( mod(iam, npr_y) == 0 ) src = -1 - if ( mod(iam+1,npr_y) == 0 ) dest = -1 - call mp_send3d( grid%commyz, dest, src, im, jm, km, & - 1, im, jfirst-1, jlast, kfirst, klast, & - 1, im, jlast , jlast, kfirst, klast, help ) - call mp_recv3d( grid%commyz, src, im, jm, km, & - 1, im, jfirst-1, jlast , kfirst, klast, & - 1, im, jfirst-1, jfirst-1, kfirst, klast, help ) - call mp_send3d( grid%commyz, dest, src, im, jm, km, & - 1, im, jfirst-1, jlast, kfirst, klast, & - 1, im, jlast , jlast, kfirst, klast, kelp ) - call mp_recv3d( grid%commyz, src, im, jm, km, & - 1, im, jfirst-1, jlast , kfirst, klast, & - 1, im, jfirst-1, jfirst-1, kfirst, klast, kelp ) - - if (am_correction) then - call mp_send3d( grid%commyz, dest, src, im, jm, km, & - 1, im, jfirst-1, jlast, kfirst, klast, & - 1, im, jlast , jlast, kfirst, klast, ddpa ) - call mp_recv3d( grid%commyz, src, im, jm, km, & - 1, im, jfirst-1, jlast , kfirst, klast, & - 1, im, jfirst-1, jfirst-1, kfirst, klast, ddpa ) - end if -#endif - call FVstopclock(grid,'---dp4corr_COMM_1') - - call FVbarrierclock(grid,'sync_dp4corr_2', grid%commyz) - call FVstartclock(grid,'---dp4corr_COMM_2') - -!$omp parallel do private(i, j, k) - do k = kfirst, klast - do j = js2g0, jlast - do i = 1, im - dpn(i,j,k)=(help(i,j,k)*cosp(j)+help(i,j-1,k)*cosp(j-1))/(cosp(j)+cosp(j-1)) ! A->D - dpo(i,j,k)=(kelp(i,j,k)*cosp(j)+kelp(i,j-1,k)*cosp(j-1))/(cosp(j)+cosp(j-1)) ! A->D - end do - end do - end do - - if (am_correction) then -!$omp parallel do private(i, j, k) - do k = kfirst, klast - do j = js2g0, jlast - do i = 1, im - ddpu(i,j,k)=(ddpa(i,j,k)*cosp(j)+ddpa(i,j-1,k)*cosp(j-1))/(cosp(j)+cosp(j-1)) ! A->D - end do - end do - end do - -!$omp parallel do private(i, j, k) - do k = kfirst, klast - do j = js2g0, jlast - do i = 1, im - ddu(i,j,k)=ddu(i,j,k)* D0_5*(dpo(i,j,k)+dpn(i,j,k)*3._r8)*D0_5 - end do - end do - end do - -!$omp parallel do private(i, j, k) - do k = kfirst, klast - do j = js2g0, jlast - ddus(j,k) = ddu(1,j,k) + (u(1,j,k) + uc(1,j,k)/D4_0)*ddpu(1,j,k) - & - vf(1,j,k)*(dpn(1,j,k) - dpo(1,j,k))*D0_5 - dpns(j,k) = dpn(1,j,k) - do i = 2, im - ddus(j,k) = ddus(j,k) + ddu(i,j,k) +(u(i,j,k)+uc(i,j,k)/D4_0)*ddpu(i,j,k) - & - vf(i,j,k)*(dpn(i,j,k)-dpo(i,j,k))*D0_5 - dpns(j,k) = dpns(j,k) + dpn(i,j,k) - end do - ddus(j,k) = ddus(j,k)/dpns(j,k) - end do - end do - -!$omp parallel do private(i, j, k) - do k = kfirst, klast - do j = js4g0, jn3g0 - do i = 1, im !+++++++++++++++++++++++++++++++++++++++++++++ - uc(i,j,k) = uc(i,j,k) + ddus(j,k) ! APPLY AM CORRECTION - enddo !+++++++++++++++++++++++++++++++++++++++++++++ - enddo - enddo - - end if ! (am_correction) - - if (am_fixer) then - -!$omp parallel do private(i, j, k) - do k = kfirst, klast - do j = js2g0, jlast - do i = 1, im - don(j,k) = don(j,k) + (cosp(j) + cosp(j-1))*cose(j) & - *(uc(i,j,k)*dpn(i,j,k) & - + (u(i,j,k) + cose(j)*oma)*(dpn(i,j,k) - dpo(i,j,k))) - dod(j,k) = dod(j,k) + (cosp(j) + cosp(j-1))*cose(j)**2*dpn(i,j,k) - end do - end do - - ! north pole - if (jfirst == 1) then - do i = 1, im - dod(1,k) = dod(1,k) + grid%acap/(D0_5*im)*cose(1)**2*help(i,1,k) - end do - end if - end do - - end if ! (am_fixer) - - call FVstopclock(grid,'---dp4corr_COMM_2') - - endif ! (am_correction .or. am_fixer) - - call FVbarrierclock(grid,'sync_d_geop', grid%commyz) - -#if defined( SPMD ) - if (s_trac) then - ! post sends for ct_overlap or tracer decomposition information - do ml = 1, mlt - call mpiisend(cx3, ncx, mpir8, iremote(ml), cxtag(ml), grid%commnyz, cxreqs(ml)) - call mpiisend(cy3, ncy, mpir8, iremote(ml), cytag(ml), grid%commnyz, cyreqs(ml)) - call mpiisend(mfx, nmfx, mpir8, iremote(ml), mfxtag(ml), grid%commnyz, mfxreqs(ml)) - call mpiisend(mfy, nmfy, mpir8, iremote(ml), mfytag(ml), grid%commnyz, mfyreqs(ml)) - end do - end if -#endif - - end if ! (iam .lt. npes_yz) - - - if (geopk_ddist) then - - if (iam .lt. npes_yz) then - - ! Stay in yz space and use z communications - - if (grid%geopk16byte) then - call FVstartclock(grid,'---D_GEOP16') - call geopk16(grid, pe, delp, pkcc, wzc, hs, pt, & - ng_d, cp3vc(1,jfirst,kfirst), cap3vc(1,jfirst,kfirst)) - else - call FVstartclock(grid,'---D_GEOP_D') - call geopk_d(grid, pe, delp, pkcc, wzc, hs, pt, & - ng_d, cp3vc(1,jfirst,kfirst), cap3vc(1,jfirst,kfirst)) - end if - - ! Geopk does not need j ghost zones of pkc and wz - -!$omp parallel do private(i, j, k) - do k = kfirst, klast+1 - do j = jfirst, jlast - do i = 1, im - wz(i,j,k) = wzc(i,j,k) - end do - end do - end do - if (.not.high_alt) then -!$omp parallel do private(i, j, k) - do k = kfirst, klast+1 - do j = jfirst, jlast - do i = 1, im - pxc(i,j,k) = pkcc(i,j,k) - end do - end do - end do - endif - - if (grid%geopk16byte) then - call FVstopclock(grid,'---D_GEOP16') - else - call FVstopclock(grid,'---D_GEOP_D') - endif - - end if ! (iam .lt. npes_yz) - - else - - ! Begin xy geopotential section - - call FVstartclock(grid,'---D_GEOP') - - if (grid%twod_decomp == 1) then - - ! Transpose to xy decomposition - -#if defined( SPMD ) - -!$omp parallel do private(i,j,k) - do k = kfirst, klast - do j = jfirst, jlast - do i = 1, im - ptc(i,j,k) = pt(i,j,k) - end do - end do - end do - - call FVstartclock(grid,'YZ_TO_XY_D_GEOP') - if (grid%modc_onetwo .eq. 1) then - call mp_sendirr( grid%commxy, grid%ijk_yz_to_xy%SendDesc, & - grid%ijk_yz_to_xy%RecvDesc, delp, delpxy, & - modc=grid%modc_cdcore ) - call mp_recvirr( grid%commxy, grid%ijk_yz_to_xy%SendDesc, & - grid%ijk_yz_to_xy%RecvDesc, delp, delpxy, & - modc=grid%modc_cdcore ) - call mp_sendirr( grid%commxy, grid%ijk_yz_to_xy%SendDesc, & - grid%ijk_yz_to_xy%RecvDesc, ptc, ptxy, & - modc=grid%modc_cdcore ) - call mp_recvirr( grid%commxy, grid%ijk_yz_to_xy%SendDesc, & - grid%ijk_yz_to_xy%RecvDesc, ptc, ptxy, & - modc=grid%modc_cdcore ) - else - call mp_sendirr( grid%commxy, grid%ijk_yz_to_xy%SendDesc, & - grid%ijk_yz_to_xy%RecvDesc, delp, delpxy, & - ptc, ptxy, & - modc=grid%modc_cdcore ) - call mp_recvirr( grid%commxy, grid%ijk_yz_to_xy%SendDesc, & - grid%ijk_yz_to_xy%RecvDesc, delp, delpxy, & - ptc, ptxy, & - modc=grid%modc_cdcore ) - end if - call FVstopclock(grid,'YZ_TO_XY_D_GEOP') -#endif - - else - -!$omp parallel do private(i,j,k) - do k = kfirst, klast - do j = jfirst, jlast - do i = 1, im - delpxy(i,j,k) = delp(i,j,k) - ptxy(i,j,k) = pt(i,j,k) - end do - end do - end do - - end if - - call geopk(grid, pexy, delpxy, pkxy, wzxy, hsxy, ptxy, & - cp3v, cap3v, nx) - - if (grid%twod_decomp == 1) then - - ! Transpose back to yz decomposition - ! Z edge ghost points (klast+1) are automatically filled in - ! pexy is output quantity on last small timestep - -#if defined( SPMD ) - - call FVstartclock(grid,'XY_TO_YZ_D_GEOP') - if (high_alt) then - call mp_sendirr( grid%commxy, grid%pexy_to_pe%SendDesc, & - grid%pexy_to_pe%RecvDesc, pexy, pec, & - modc=grid%modc_dynrun ) - call mp_recvirr( grid%commxy, grid%pexy_to_pe%SendDesc, & - grid%pexy_to_pe%RecvDesc, pexy, pec, & - modc=grid%modc_dynrun ) - call mp_sendirr( grid%commxy, grid%pkxy_to_pkc%SendDesc, & - grid%pkxy_to_pkc%RecvDesc, wzxy, wzkp, & - modc=grid%modc_cdcore ) - call mp_recvirr( grid%commxy, grid%pkxy_to_pkc%SendDesc, & - grid%pkxy_to_pkc%RecvDesc, wzxy, wzkp, & - modc=grid%modc_cdcore ) - else - if (grid%modc_onetwo .eq. 1) then - call mp_sendirr( grid%commxy, grid%pkxy_to_pkc%SendDesc, & - grid%pkxy_to_pkc%RecvDesc, pkxy, pkkp, & - modc=grid%modc_cdcore ) - call mp_recvirr( grid%commxy, grid%pkxy_to_pkc%SendDesc, & - grid%pkxy_to_pkc%RecvDesc, pkxy, pkkp, & - modc=grid%modc_cdcore ) - call mp_sendirr( grid%commxy, grid%pkxy_to_pkc%SendDesc, & - grid%pkxy_to_pkc%RecvDesc, wzxy, wzkp, & - modc=grid%modc_cdcore ) - call mp_recvirr( grid%commxy, grid%pkxy_to_pkc%SendDesc, & - grid%pkxy_to_pkc%RecvDesc, wzxy, wzkp, & - modc=grid%modc_cdcore ) - else - call mp_sendirr( grid%commxy, grid%pkxy_to_pkc%SendDesc, & - grid%pkxy_to_pkc%RecvDesc, pkxy, pkkp, & - wzxy, wzkp, & - modc=grid%modc_cdcore ) - call mp_recvirr( grid%commxy, grid%pkxy_to_pkc%SendDesc, & - grid%pkxy_to_pkc%RecvDesc, pkxy, pkkp, & - wzxy, wzkp, & - modc=grid%modc_cdcore ) - end if - endif - call FVstopclock(grid,'XY_TO_YZ_D_GEOP') - - if (high_alt) then -!$omp parallel do private(i, j, k) - do k = kfirst, klast+1 - do j = jfirst, jlast - do i = 1, im - pxc(i,j,k) = log(pec(i,k,j)) - end do - end do - end do - else -!$omp parallel do private(i, j, k) - do k = kfirst, klast+1 - do j = jfirst, jlast - do i = 1, im - pxc(i,j,k) = pkkp(i,j,k) - end do - end do - end do - endif -!$omp parallel do private(i, j, k) - do k = kfirst, klast+1 - do j = jfirst, jlast - do i = 1, im - wz(i,j,k) = wzkp(i,j,k) - end do - end do - end do - -#endif - - else - -!$omp parallel do private(i, j, k) - do k = kfirst, klast+1 - do j = jfirst, jlast - do i = 1, im - wz(i,j,k) = wzxy(i,j,k) - end do - end do - end do - if (high_alt) then -!$omp parallel do private(i, j, k) - do k = kfirst, klast+1 - do j = jfirst, jlast - do i = 1, im - pec(i,k,j) = pexy(i,k,j) - pxc(i,j,k) = log(pec(i,k,j)) - end do - end do - end do - else -!$omp parallel do private(i, j, k) - do k = kfirst, klast+1 - do j = jfirst, jlast - do i = 1, im - pxc(i,j,k) = pkxy(i,j,k) - end do - end do - end do - endif - - end if - - call FVstopclock(grid,'---D_GEOP') - - ! End xy geopotential section - endif ! geopk_ddist - - if (iam .lt. npes_yz) then - - call FVbarrierclock(grid,'sync_pre_d_pgrad', grid%commyz) - - ! Upon exit from geopk, the quantities pe, pkc and wz will have been - ! updated at klast+1 - - call FVstartclock(grid,'---PRE_D_PGRAD') - -#if defined( SPMD ) - call FVstartclock(grid,'---PRE_D_PGRAD_COMM_1') - ! Exchange boundary regions on north and south for pkc and wz - call mp_send2_ns( grid%commyz, im, jm, km+1, jfirst, jlast, & - kfirst, klast+1, 1, pxc, wz) - call FVstopclock(grid,'---PRE_D_PGRAD_COMM_1') -#endif - - if ( ipe /= 1 ) then ! not the last call - - ! Perform some work while sending data on the way - call FVstartclock(grid,'---D_DELP_LOOP') - -!$omp parallel do private(i, j, k, wk, wk2) - do k = kfirst, klast - do j = jfirst, jlast - do i = 1, im - delpf(i,j,k) = delp(i,j,k) - end do - end do - call pft2d( delpf(1,js2g0,k), grid%sc, & - grid%dc, im, jn2g0-js2g0+1, & - wk, wk2 ) - end do - call FVstopclock(grid,'---D_DELP_LOOP') - - else ! Last call - -!$omp parallel do private(i, j, k) - do k = kfirst, klast+1 - do j = jfirst, jlast - do i = 1, im - pk(i,j,k) = pxc(i,j,k) - end do - end do - end do - end if - -#if defined( SPMD ) - call FVstartclock(grid,'---PRE_D_PGRAD_COMM_1') - call mp_recv2_ns( grid%commyz, im, jm, km+1, jfirst, jlast, & - kfirst, klast+1, 1, pxc, wz) - if ( ipe /= 1 ) then ! not the last call - call mp_send4d_ns( grid%commyz, im, jm, km, 1, jfirst, jlast, & - kfirst, klast, ng_d, ng_d, delpf ) - end if - call FVstopclock(grid,'---PRE_D_PGRAD_COMM_1') -#endif - - if (am_correction) then - ! AM correction (pressure, prognostic winds): pkc -> ptr -!$omp parallel do private(i, j, k) - do k = kfirst, klast+1 - do j = js1g1, jn1g1 ! dpt needed NS - do i = 1,im ! wz, pkc ghosted NS - ptr(i,j,k) = pxc(i,j,k)**xakap - end do - end do - end do - else -!$omp parallel do private(i, j, k) - do k = kfirst, klast+1 - do j = js1g1, jn1g1 - do i = 1,im - ptr(i,j,k) = pxc(i,j,k) - end do - end do - end do - endif - - if (am_correction) then -!$omp parallel do private(i, j, k) - ! Beware k+1 references directly below (AAM) - do k = kfirst, klast - do j = js1g1, jn1g1 - do i = 1, im ! wz, pkc ghosted NS - dpr(i,j,k) = (wz(i,j,k+1) + wz(i,j,k))*(ptr(i,j,k+1) - ptr(i,j,k)) - end do - end do - end do - end if - -!$omp parallel do private(i, j, k) - ! Beware k+1 references directly below (AAM) - do k = kfirst, klast - do j = js1g1, jn1g1 ! dpt needed NS - do i = 1, im ! wz, pkc ghosted NS - dpt(i,j,k) = (wz(i,j,k+1) + wz(i,j,k))*(pxc(i,j,k+1) - pxc(i,j,k)) - end do - end do - end do - - ! GHOSTING: wz (input) NS ; pkc (input) N - ! GHOSTING: dpt (loop 4000) NS ; pkc (loop 4500) N - - call FVstopclock(grid,'---PRE_D_PGRAD') - call FVstartclock(grid,'---D_PGRAD_1') - - if (high_alt) then - px4 = 4.0_r8*log(grid%ptop) - else - px4 = 4.0_r8*grid%ptop**cap3v(ifirstxy,jfirstxy,1) - endif - -!$omp parallel do private(i, j, k, wk3, wk1) - do k = kfirst, klast+1 - - if (k == 1) then - do j = js2g0, jlast - do i = 1, im - wz3(i,j,1) = D0_0 - wz(i,j,1) = D0_0 - end do - end do - do j = js2g0, jn1g1 - do i = 1, im - pxc(i,j,1) = px4 - ptr(i,j,1) = 4.0_r8*grid%ptop - end do - end do - cycle - end if - - if (am_correction) then - do j=js2g1,jn2g0 ! wk3 needed S - wk3(1,j) = (wz(1,j,k)+wz(im,j,k)) * & - (ptr(1,j,k) - ptr(im,j,k)) - do i=2,im - wk3(i,j) = (wz(i,j,k)+wz(i-1,j,k)) * & - (ptr(i,j,k) - ptr(i-1,j,k)) - - enddo - enddo - else - do j=js2g1,jn2g0 ! wk3 needed S - wk3(1,j) = (wz(1,j,k)+wz(im,j,k)) * & - (pxc(1,j,k) - pxc(im,j,k)) - do i=2,im - wk3(i,j) = (wz(i,j,k)+wz(i-1,j,k)) * & - (pxc(i,j,k) - pxc(i-1,j,k)) - - enddo - enddo - end if - - do j=js2g1,jn2g0 - do i=1,im-1 - wk1(i,j) = wk3(i,j) + wk3(i+1,j) - enddo - wk1(im,j) = wk3(im,j) + wk3(1,j) ! wk3 ghosted S - enddo - - if ( jfirst == 1 ) then - do i=1,im - wk1(i, 1) = D0_0 - enddo - endif - - if ( jlast == jm ) then - do i=1,im - wk1(i,jm) = D0_0 - enddo - endif - - do j=js2g0,jlast ! wk1 ghosted S - do i=1,im - wz3(i,j,k) = wk1(i,j) + wk1(i,j-1) - enddo - enddo - -! N-S walls - - do j=js2g0,jn1g1 ! wk1 needed N - if (am_correction) then - do i=1,im - wk1(i,j) = (wz(i,j,k) + wz(i,j-1,k))*(ptr(i,j,k) - ptr(i,j-1,k)) - enddo - else - do i=1,im ! wz, pkc ghosted NS - wk1(i,j) = (wz(i,j,k) + wz(i,j-1,k))*(pxc(i,j,k) - pxc(i,j-1,k)) - enddo - end if - enddo - - do j=js2g0,jn1g1 ! wk3 needed N - wk3(1,j) = wk1(1,j) + wk1(im,j) ! wk1 ghosted N - do i=2,im - wk3(i,j) = wk1(i,j) + wk1(i-1,j) ! wk1 ghosted N - enddo - enddo - - do j=js2g0,jn2g0 - do i=1,im - wz(i,j,k) = wk3(i,j) + wk3(i,j+1) ! wk3 ghosted N - enddo - enddo - - ! preserve this section to leave pkc inchanged in output of cd_core - do j=js1g1,jn1g1 - wk1(1,j) = pxc(1,j,k) + pxc(im,j,k) - do i=2,im - wk1(i,j) = pxc(i,j,k) + pxc(i-1,j,k) - enddo - enddo - - do j=js2g0,jn1g1 - do i=1,im - pxc(i,j,k) = wk1(i,j) + wk1(i,j-1) - enddo - enddo - - if (am_correction) then - - ! use true pressure for wk1, then update it - do j = js1g1, jn1g1 - wk1(1,j) = ptr(1,j,k) + ptr(im,j,k) - do i = 2, im - wk1(i,j) = ptr(i,j,k) + ptr(i-1,j,k) - end do - end do - - ! apply cos-weighted avg'ing - do j = js2g0, jn1g1 - do i = 1, im - ptr(i,j,k) = (wk1(i,j)*cosp(j) + wk1(i,j-1)*cosp(j-1))/(cosp(j) + cosp(j-1))/0.5_r8 - end do - end do - - end if - - end do ! k = kfirst, klast+1 - - call FVstopclock(grid,'---D_PGRAD_1') - call FVstartclock(grid,'---D_PGRAD_2') - -!$omp parallel do private(i, j, k, wk, wk1, wk2, wk3) - do k = kfirst, klast - - if (am_correction) then - do j = js1g1, jn1g1 - wk1(1,j) = dpr(1,j,k) + dpr(im,j,k) - do i = 2, im - wk1(i,j) = dpr(i,j,k) + dpr(i-1,j,k) - end do - end do - - do j = js2g0, jn1g1 - do i = 1, im - wk2(i,j) = wk1(i,j) + wk1(i,j-1) - wk(i,j) = ptr(i,j,k+1) - ptr(i,j,k) - end do - end do - else - do j = js1g1, jn1g1 - wk1(1,j) = dpt(1,j,k) + dpt(im,j,k) - do i = 2, im - wk1(i,j) = dpt(i,j,k) + dpt(i-1,j,k) - end do - end do - - do j = js2g0, jn1g1 - do i = 1, im - wk2(i,j) = wk1(i,j) + wk1(i,j-1) - wk(i,j) = pxc(i,j,k+1) - pxc(i,j,k) - end do - end do - end if - - ! Beware k+1 references directly below (AAM) - do j = js2g0, jlast - do i = 1, im-1 - wk3(i,j) = uc(i,j,k) + grid%dtdxe(j)/(wk(i,j) + wk(i+1,j)) & - * (wk2(i,j)-wk2(i+1,j)+wz3(i,j,k+1)-wz3(i,j,k)) - end do - wk3(im,j) = uc(im,j,k) + grid%dtdxe(j)/(wk(im,j) + wk(1,j)) & - * (wk2(im,j)-wk2(1,j)+wz3(im,j,k+1)-wz3(im,j,k)) - end do - - if (am_correction) then - ! apply cos-weighted avg'ing - do j = js2g0, jn2g0 ! Assumes wk2 ghosted on N - do i = 1, im - wk1(i,j) = vc(i,j,k) + grid%dtdy/(wk(i,j)*cose(j) + wk(i,j+1)*cose(j+1))*cosp(j) * & - (wk2(i,j) - wk2(i,j+1) + wz(i,j,k+1) - wz(i,j,k)) - end do - end do - else - do j = js2g0, jn2g0 ! Assumes wk2 ghosted on N - do i = 1, im - wk1(i,j) = vc(i,j,k) + grid%dtdy/(wk(i,j) + wk(i,j+1)) * & - (wk2(i,j) - wk2(i,j+1) + wz(i,j,k+1) - wz(i,j,k)) - enddo - enddo - endif - - call pft2d( wk3(1,js2g0), grid%se, & - grid%de, im, jlast-js2g0+1, & - wk, wk2 ) - call pft2d( wk1(1,js2g0), grid%sc, & - grid%dc, im, jn2g0-js2g0+1, & - wk, wk2 ) - - do j = js2g0, jn2g0 - do i = 1, im - v(i,j,k) = v(i,j,k) + wk1(i,j) - u(i,j,k) = u(i,j,k) + wk3(i,j) - end do - end do - - if ( jlast == jm ) then - do i = 1, im - u(i,jlast,k) = u(i,jlast,k) + wk3(i,jlast) - end do - end if - - end do ! k = kfirst, klast - call FVstopclock(grid,'---D_PGRAD_2') - -#if defined( SPMD ) - if ( ipe /= 1 ) then - call FVstartclock(grid,'---PRE_D_PGRAD_COMM_2') - call mp_recv4d_ns( grid%commyz, im, jm, km, 1, jfirst, jlast, & - kfirst, klast, ng_d, ng_d, delpf ) - call FVstopclock(grid,'---PRE_D_PGRAD_COMM_2') - end if -#endif - - end if ! (iam .lt. npes_yz) - -end subroutine cd_core diff --git a/src/dynamics/fv/ctem.F90.orig b/src/dynamics/fv/ctem.F90.orig deleted file mode 100644 index 4d39bb6105..0000000000 --- a/src/dynamics/fv/ctem.F90.orig +++ /dev/null @@ -1,606 +0,0 @@ -!----------------------------------------------------------------------------- -! circulation diagnostics -- terms of the Transformed Eulerian Mean (TEM) equation -!----------------------------------------------------------------------------- -module ctem - - use shr_kind_mod, only: r8 => shr_kind_r8 - use spmd_utils, only: masterproc - use pmgrid, only: plon, plev, plevp - use cam_logfile, only: iulog - use cam_history, only: addfld, outfld, add_default, horiz_only - use cam_abortutils, only: endrun - - implicit none - private - - public :: ctem_readnl - public :: ctem_init - public :: ctem_diags - public :: do_circulation_diags - - real(r8) :: rplon - real(r8) :: iref_p(plevp) ! interface reference pressure for vertical interpolation - integer :: ip_b ! level index where hybrid levels become purely pressure - integer :: zm_limit - - logical :: do_circulation_diags = .false. - -contains - -!================================================================================ - - subroutine ctem_diags( u3, v3, omga, pt, h2o, ps, pe, grid) - - use physconst, only : zvir, cappa - use dynamics_vars, only : T_FVDYCORE_GRID - use hycoef, only : ps0 - use interpolate_data, only : vertinterp -#ifdef SPMD - use mpishorthand, only : mpilog, mpiint - use parutilitiesmodule, only : pargatherint -#endif - -!------------------------------------------------------------- -! ... dummy arguments -!------------------------------------------------------------- - type(T_FVDYCORE_GRID), intent(in) :: grid ! FV Dynamics grid - - real(r8), intent(in) :: ps(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy) ! surface pressure (pa) - real(r8), intent(in) :: u3(grid%ifirstxy:grid%ilastxy,plev,grid%jfirstxy:grid%jlastxy) ! zonal velocity (m/s) - real(r8), intent(in) :: v3(grid%ifirstxy:grid%ilastxy,plev,grid%jfirstxy:grid%jlastxy) ! meridional velocity (m/s) - real(r8), intent(in) :: omga(grid%ifirstxy:grid%ilastxy,plev,grid%jfirstxy:grid%jlastxy) ! pressure velocity - real(r8), intent(in) :: pe(grid%ifirstxy:grid%ilastxy,plevp,grid%jfirstxy:grid%jlastxy) ! interface pressure (pa) - real(r8), intent(in) :: pt(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,plev) ! virtual temperature - real(r8), intent(in) :: h2o(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,plev) ! water constituent (kg/kg) - -!------------------------------------------------------------- -! ... local variables -!------------------------------------------------------------- - real(r8), parameter :: hscale = 7000._r8 ! pressure scale height - real(r8), parameter :: navp = 1.e35_r8 - - real(r8) :: pinterp - real(r8) :: w(grid%ifirstxy:grid%ilastxy,plev,grid%jfirstxy:grid%jlastxy) ! vertical velocity - real(r8) :: th(grid%ifirstxy:grid%ilastxy,plev,grid%jfirstxy:grid%jlastxy) ! pot. temperature - - real(r8) :: pm(grid%ifirstxy:grid%ilastxy,plev,grid%jfirstxy:grid%jlastxy) ! mid-point pressure - - real(r8) :: pexf ! Exner function - real(r8) :: psurf - - real(r8) :: ui(grid%ifirstxy:grid%ilastxy,plevp) ! interpolated zonal velocity - real(r8) :: vi(grid%ifirstxy:grid%ilastxy,plevp) ! interpolated meridional velocity - real(r8) :: wi(grid%ifirstxy:grid%ilastxy,plevp) ! interpolated vertical velocity - real(r8) :: thi(grid%ifirstxy:grid%ilastxy,plevp) ! interpolated pot. temperature - - real(r8) :: um(plevp) ! zonal mean zonal velocity - real(r8) :: vm(plevp) ! zonal mean meridional velocity - real(r8) :: wm(plevp) ! zonal mean vertical velocity - real(r8) :: thm(plevp) ! zonal mean pot. temperature - - real(r8) :: ud(grid%ifirstxy:grid%ilastxy,plevp) ! zonal deviation of zonal velocity - real(r8) :: vd(grid%ifirstxy:grid%ilastxy,plevp) ! zonal deviation of meridional velocity - real(r8) :: wd(grid%ifirstxy:grid%ilastxy,plevp) ! zonal deviation of vertical velocity - real(r8) :: thd(grid%ifirstxy:grid%ilastxy,plevp) ! zonal deviation of pot. temperature - - real(r8) :: vthp(grid%ifirstxy:grid%ilastxy,plevp) ! zonal deviation of zonal velocity - real(r8) :: wthp(grid%ifirstxy:grid%ilastxy,plevp) ! zonal deviation of meridional velocity - real(r8) :: uvp(grid%ifirstxy:grid%ilastxy,plevp) ! zonal deviation of vertical velocity - real(r8) :: uwp(grid%ifirstxy:grid%ilastxy,plevp) ! zonal deviation of pot. temperature - - real(r8) :: rdiv(plevp) - - integer :: ip_gm1g(plon,grid%jfirstxy:grid%jlastxy) ! contains level index-1 where blocked points begin - integer :: zm_cnt(plevp) ! counter - integer :: i,j,k - integer :: nlons - - logical :: has_zm(plevp,grid%jfirstxy:grid%jlastxy) ! .true. the (z,y) point is a valid zonal mean - integer :: ip_gm1(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy) ! contains level index-1 where blocked points begin - - real(r8) :: vth(plevp,grid%jfirstxy:grid%jlastxy) ! VTH flux - real(r8) :: uv(plevp,grid%jfirstxy:grid%jlastxy) ! UV flux - real(r8) :: wth(plevp,grid%jfirstxy:grid%jlastxy) ! WTH flux - real(r8) :: uw(plevp,grid%jfirstxy:grid%jlastxy) ! UW flux - real(r8) :: u2d(plevp,grid%jfirstxy:grid%jlastxy) ! zonally averaged U - real(r8) :: v2d(plevp,grid%jfirstxy:grid%jlastxy) ! zonally averaged V - real(r8) :: th2d(plevp,grid%jfirstxy:grid%jlastxy) ! zonally averaged TH - real(r8) :: w2d(plevp,grid%jfirstxy:grid%jlastxy) ! zonally averaged W - real(r8) :: thig(grid%ifirstxy:grid%ilastxy,plevp,grid%jfirstxy:grid%jlastxy) ! interpolated pot. temperature - - real(r8) :: tmp2(grid%ifirstxy:grid%ilastxy) - real(r8) :: tmp3(grid%ifirstxy:grid%ilastxy,plevp) - - integer :: beglat, endlat ! begin,end latitude indicies - integer :: beglon, endlon ! begin,end longitude indicies - - beglon = grid%ifirstxy - endlon = grid%ilastxy - beglat = grid%jfirstxy - endlat = grid%jlastxy - -!omp parallel do private (i,j,k,pexf,psurf) -lat_loop1 : & - do j = beglat, endlat - do k = 1, plev - do i = beglon, endlon -!------------------------------------------------------------- -! Calculate pressure and Exner function -!------------------------------------------------------------- - pm(i,k,j) = 0.5_r8 * ( pe(i,k,j) + pe(i,k+1,j) ) - pexf = (ps0 / pm(i,k,j))**cappa -!------------------------------------------------------------- -! Convert virtual temperature to temperature and calculate potential temperature -!------------------------------------------------------------- - th(i,k,j) = pt(i,j,k) / (1._r8 + zvir*h2o(i,j,k)) - th(i,k,j) = th(i,k,j) * pexf -!------------------------------------------------------------- -! Calculate vertical velocity -!------------------------------------------------------------- - w(i,k,j) = - hscale * omga(i,k,j) / pm(i,k,j) - end do - end do -!------------------------------------------------------------- -! Keep track of where the bottom is in each column -! (i.e., largest index for which P(k) <= PS) -!------------------------------------------------------------- - ip_gm1(:,j) = plevp - do i = beglon, endlon - psurf = ps(i,j) - do k = ip_b+1, plevp - if( iref_p(k) <= psurf ) then - ip_gm1(i,j) = k - end if - end do - end do - end do lat_loop1 - - nlons = endlon - beglon + 1 - -#ifdef SPMD - if( grid%twod_decomp == 1 ) then - if (grid%iam .lt. grid%npes_xy) then - call pargatherint( grid%commxy_x, 0, ip_gm1, grid%strip2dx, ip_gm1g ) - endif - else - ip_gm1g(:,:) = ip_gm1(:,:) - end if -#else - ip_gm1g(:,:) = ip_gm1(:,:) -#endif -#ifdef CTEM_DIAGS - write(iulog,*) '====================================================' - do j = beglat,endlat - write(iulog,'(''iam,myidxy_x,myidxy_y,j = '',4i4)') grid%iam,grid%myidxy_x,grid%myidxy_y,j - write(iulog,'(20i3)') ip_gm1(:,j) - end do - if( grid%myidxy_x == 0 ) then - do j = beglat,endlat - write(iulog,*) '====================================================' - write(iulog,'(''iam,myidxy_x,myidxy_y,j = '',4i4)') grid%iam,grid%myidxy_x,grid%myidxy_y,j - write(iulog,'(20i3)') ip_gm1g(:,j) - end do - write(iulog,*) '====================================================' -#else -#ifdef SPMD - if( grid%myidxy_x == 0 ) then -#endif -#endif -lat_loop2 : & - do j = beglat, endlat - zm_cnt(:ip_b) = plon - do k = ip_b+1, plevp - zm_cnt(k) = count( ip_gm1g(:,j) >= k ) - end do - has_zm(:ip_b,j) = .true. - do k = ip_b+1, plevp - has_zm(k,j) = zm_cnt(k) >= zm_limit - end do - end do lat_loop2 -#ifdef SPMD - end if - if( grid%twod_decomp == 1 ) then - call mpibcast( has_zm, plevp*(endlat-beglat+1), mpilog, 0, grid%commxy_x ) - call mpibcast( ip_gm1g, plon*(endlat-beglat+1), mpiint, 0, grid%commxy_x ) - end if -#endif - -#ifdef CTEM_DIAGS - if( grid%myidxy_y == 12 ) then - write(iulog,*) '^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^' - write(iulog,'(''iam,myidxy_x,myidxy_y,j = '',4i4)') grid%iam,grid%myidxy_x,grid%myidxy_y,beglat - write(iulog,*) 'has_zm' - write(iulog,'(20l2)') has_zm(:,beglat) - write(iulog,*) 'ip_gm1g' - write(iulog,'(20i4)') ip_gm1g(:,beglat) - write(iulog,*) '^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^' - end if -#endif - -lat_loop3 : & - do j = beglat, endlat -!------------------------------------------------------------- -! Vertical interpolation -!------------------------------------------------------------- - do k = 1, plevp - pinterp = iref_p(k) -!------------------------------------------------------------- -! Zonal velocity -!------------------------------------------------------------- - call vertinterp( nlons, nlons, plev, pm(beglon,1,j), pinterp, & - u3(beglon,1,j), ui(beglon,k) ) -!------------------------------------------------------------- -! Meridional velocity -!------------------------------------------------------------- - call vertinterp( nlons, nlons, plev, pm(beglon,1,j), pinterp, & - v3(beglon,1,j), vi(beglon,k) ) -!------------------------------------------------------------- -! Vertical velocity -!------------------------------------------------------------- - call vertinterp( nlons, nlons, plev, pm(beglon,1,j), pinterp, & - w(beglon,1,j), wi(beglon,k) ) -!------------------------------------------------------------- -! Pot. Temperature -!------------------------------------------------------------- - call vertinterp( nlons, nlons, plev, pm(beglon,1,j), pinterp, & - th(beglon,1,j), thi(beglon,k) ) - end do -#ifdef CTEM_DIAGS - if( j == endlat ) then - write(iulog,*) '^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^' - write(iulog,'(''iam,myidxy_x,myidxy_y,j = '',4i4)') grid%iam,grid%myidxy_x,grid%myidxy_y,j - write(iulog,*) 'iref_p' - write(iulog,'(5g15.7)') iref_p(:) - write(iulog,'(''pm(endlon,:,'',i2,'')'')') j - write(iulog,'(5g15.7)') pm(endlon,:,j) - write(iulog,'(''u3(endlon,:,'',i2,'')'')') j - write(iulog,'(5g15.7)') u3(endlon,:,j) - write(iulog,*) 'ui(endlon,:)' - write(iulog,'(5g15.7)') ui(endlon,:) - write(iulog,*) '^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^' - end if -#endif - -!------------------------------------------------------------- -! Calculate zonal averages -!------------------------------------------------------------- - do k = ip_b+1, plevp - if( has_zm(k,j) ) then - where( ip_gm1(beglon:endlon,j) < k ) - ui(beglon:endlon,k) = 0._r8 - vi(beglon:endlon,k) = 0._r8 - wi(beglon:endlon,k) = 0._r8 - thi(beglon:endlon,k) = 0._r8 - endwhere - end if - end do - - call par_xsum( grid, ui, plevp, um ) - call par_xsum( grid, vi, plevp, vm ) - call par_xsum( grid, wi, plevp, wm ) - call par_xsum( grid, thi, plevp, thm ) -#ifdef CTEM_DIAGS - if( j == endlat .and. grid%myidxy_y == 12 ) then - write(iulog,*) '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$' - write(iulog,'(''iam,myidxy_x,myidxy_y,j = '',4i4)') grid%iam,grid%myidxy_x,grid%myidxy_y,j - write(iulog,*) 'um after par_xsum' - write(iulog,'(5g15.7)') um(:) - write(iulog,*) '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$' - end if -#endif - do k = 1, ip_b - um(k) = um(k) * rplon - vm(k) = vm(k) * rplon - wm(k) = wm(k) * rplon - thm(k) = thm(k) * rplon - u2d(k,j) = um(k) - v2d(k,j) = vm(k) - th2d(k,j) = thm(k) - w2d(k,j) = wm(k) - end do - do k = ip_b+1, plevp - if( has_zm(k,j) ) then - rdiv(k) = 1._r8/count( ip_gm1g(:,j) >= k ) - um(k) = um(k) * rdiv(k) - vm(k) = vm(k) * rdiv(k) - wm(k) = wm(k) * rdiv(k) - thm(k) = thm(k) * rdiv(k) - u2d(k,j) = um(k) - v2d(k,j) = vm(k) - th2d(k,j) = thm(k) - w2d(k,j) = wm(k) - else - u2d(k,j) = navp - v2d(k,j) = navp - th2d(k,j) = navp - w2d(k,j) = navp - end if - end do - -!------------------------------------------------------------- -! Calculate zonal deviations -!------------------------------------------------------------- - do k = 1, ip_b - ud(beglon:endlon,k) = ui(beglon:endlon,k) - um(k) - vd(beglon:endlon,k) = vi(beglon:endlon,k) - vm(k) - wd(beglon:endlon,k) = wi(beglon:endlon,k) - wm(k) - thd(beglon:endlon,k) = thi(beglon:endlon,k) - thm(k) - end do - - do k = ip_b+1, plevp - if( has_zm(k,j) ) then - where( ip_gm1g(beglon:endlon,j) >= k ) - ud(beglon:endlon,k) = ui(beglon:endlon,k) - um(k) - vd(beglon:endlon,k) = vi(beglon:endlon,k) - vm(k) - wd(beglon:endlon,k) = wi(beglon:endlon,k) - wm(k) - thd(beglon:endlon,k) = thi(beglon:endlon,k) - thm(k) - elsewhere - ud(beglon:endlon,k) = 0._r8 - vd(beglon:endlon,k) = 0._r8 - wd(beglon:endlon,k) = 0._r8 - thd(beglon:endlon,k) = 0._r8 - endwhere - end if - end do - -!------------------------------------------------------------- -! Calculate fluxes -!------------------------------------------------------------- - do k = 1, ip_b - vthp(:,k) = vd(:,k) * thd(:,k) - wthp(:,k) = wd(:,k) * thd(:,k) - uwp(:,k) = wd(:,k) * ud(:,k) - uvp(:,k) = vd(:,k) * ud(:,k) - end do - - do k = ip_b+1, plevp - if( has_zm(k,j) ) then - vthp(:,k) = vd(:,k) * thd(:,k) - wthp(:,k) = wd(:,k) * thd(:,k) - uwp(:,k) = wd(:,k) * ud(:,k) - uvp(:,k) = vd(:,k) * ud(:,k) - else - vthp(:,k) = 0._r8 - wthp(:,k) = 0._r8 - uwp(:,k) = 0._r8 - uvp(:,k) = 0._r8 - end if - end do - -#ifdef CTEM_DIAGS - if( j == endlat .and. grid%myidxy_y == 12 ) then - write(iulog,*) '#################################################' - write(iulog,*) 'DIAGNOSTICS before par_xsum' - write(iulog,'(''iam,myidxy_x,myidxy_y,j = '',4i4)') grid%iam,grid%myidxy_x,grid%myidxy_y,j - write(iulog,*) 'has_zm' - write(iulog,*) has_zm(:,j) - write(iulog,*) 'rdiv' - write(iulog,'(5g15.7)') rdiv(:) - write(iulog,*) 'wm' - write(iulog,'(5g15.7)') wm(:) - write(iulog,*) 'um' - write(iulog,'(5g15.7)') um(:) - write(iulog,*) 'uw' - write(iulog,'(5g15.7)') uw(:) - write(iulog,*) '#################################################' - end if -#endif - call par_xsum( grid, vthp, plevp, vth(1,j) ) - call par_xsum( grid, wthp, plevp, wth(1,j) ) - call par_xsum( grid, uvp, plevp, uv(1,j) ) - call par_xsum( grid, uwp, plevp, uw(1,j) ) -#ifdef CTEM_DIAGS - if( j == endlat .and. grid%myidxy_y == 12 ) then - write(iulog,*) '#################################################' - write(iulog,'(''iam,myidxy_x,myidxy_y,j = '',4i4)') grid%iam,grid%myidxy_x,grid%myidxy_y,j - write(iulog,*) 'uw after par_xsum' - write(iulog,'(5g15.7)') uw(:,j) - write(iulog,*) '#################################################' - end if -#endif - do k = 1, ip_b - vth(k,j) = vth(k,j) * rplon - wth(k,j) = wth(k,j) * rplon - uw(k,j) = uw(k,j) * rplon - uv(k,j) = uv(k,j) * rplon - end do - do k = ip_b+1, plevp - if( has_zm(k,j) ) then - vth(k,j) = vth(k,j) * rdiv(k) - wth(k,j) = wth(k,j) * rdiv(k) - uw(k,j) = uw(k,j) * rdiv(k) - uv(k,j) = uv(k,j) * rdiv(k) - else - vth(k,j) = navp - wth(k,j) = navp - uw(k,j) = navp - uv(k,j) = navp - end if - end do - - thig(:,:,j) = thi(:,:) - end do lat_loop3 - -!------------------------------------------------------------- -! Do the output -!------------------------------------------------------------- - latloop: do j = beglat,endlat - -!------------------------------------------------------------- -! zonal-mean output -!------------------------------------------------------------- - do k = 1,plevp - tmp3(grid%ifirstxy,k) = vth(k,j) - enddo - call outfld( 'VTHzm', tmp3(grid%ifirstxy,:), 1, j ) - - do k = 1,plevp - tmp3(grid%ifirstxy,k) = wth(k,j) - enddo - call outfld( 'WTHzm', tmp3(grid%ifirstxy,:), 1, j ) - - do k = 1,plevp - tmp3(grid%ifirstxy,k) = uv(k,j) - enddo - call outfld( 'UVzm', tmp3(grid%ifirstxy,:), 1, j ) - - do k = 1,plevp - tmp3(grid%ifirstxy,k) = uw(k,j) - enddo - call outfld( 'UWzm', tmp3(grid%ifirstxy,:), 1, j ) - do k = 1,plevp - tmp3(grid%ifirstxy,k) = u2d(k,j) - enddo - call outfld( 'Uzm', tmp3(grid%ifirstxy,:), 1, j ) - do k = 1,plevp - tmp3(grid%ifirstxy,k) = v2d(k,j) - enddo - call outfld( 'Vzm', tmp3(grid%ifirstxy,:), 1, j ) - do k = 1,plevp - tmp3(grid%ifirstxy,k) = w2d(k,j) - enddo - call outfld( 'Wzm', tmp3(grid%ifirstxy,:), 1, j ) - do k = 1,plevp - tmp3(grid%ifirstxy,k) = th2d(k,j) - enddo - call outfld( 'THzm', tmp3(grid%ifirstxy,:), 1, j ) - -!------------------------------------------------------------- -! 3D output -!------------------------------------------------------------- - do k = 1,plevp - do i = beglon,endlon - tmp3(i,k) = thig(i,k,j) - enddo - enddo - call outfld( 'TH', tmp3, nlons, j ) - -!------------------------------------------------------------- -! horizontal output -!------------------------------------------------------------- - tmp2(beglon:endlon) = ip_gm1(beglon:endlon,j) - call outfld( 'MSKtem', tmp2, nlons, j ) - - enddo latloop - - end subroutine ctem_diags - -!================================================================================= - - subroutine ctem_init() - - use hycoef, only : hyai, hybi, ps0 - use phys_control, only : phys_getopts - -!------------------------------------------------------------- -! ... local variables -!------------------------------------------------------------- - integer :: k - logical :: history_waccm - - if (.not.do_circulation_diags) return - - rplon = 1._r8/plon - zm_limit = plon/3 - -!------------------------------------------------------------- -! Calculate reference pressure -!------------------------------------------------------------- - do k = 1, plevp - iref_p(k) = (hyai(k) + hybi(k)) * ps0 - end do - if( masterproc ) then - write(iulog,*) 'ctem_inti: iref_p' - write(iulog,'(1p5g15.7)') iref_p(:) - end if - -!------------------------------------------------------------- -! Find level where hybrid levels become purely pressure -!------------------------------------------------------------- - ip_b = -1 - do k = 1,plev - if( hybi(k) == 0._r8 ) ip_b = k - end do - - call phys_getopts( history_waccm_out = history_waccm ) - -!------------------------------------------------------------- -! Initialize output buffer -!------------------------------------------------------------- - call addfld ('VTHzm',(/ 'ilev' /),'A','MK/S','Meridional Heat Flux: 3D zon. mean', gridname='fv_centers_zonal' ) - call addfld ('WTHzm',(/ 'ilev' /),'A','MK/S','Vertical Heat Flux: 3D zon. mean', gridname='fv_centers_zonal' ) - call addfld ('UVzm', (/ 'ilev' /),'A','M2/S2','Meridional Flux of Zonal Momentum: 3D zon. mean', gridname='fv_centers_zonal' ) - call addfld ('UWzm', (/ 'ilev' /),'A','M2/S2','Vertical Flux of Zonal Momentum: 3D zon. mean', gridname='fv_centers_zonal' ) - - call addfld ('Uzm', (/ 'ilev' /),'A','M/S','Zonal-Mean zonal wind - defined on ilev', gridname='fv_centers_zonal' ) - call addfld ('Vzm', (/ 'ilev' /),'A','M/S','Zonal-Mean meridional wind - defined on ilev', gridname='fv_centers_zonal' ) - call addfld ('Wzm', (/ 'ilev' /),'A','M/S','Zonal-Mean vertical wind - defined on ilev', gridname='fv_centers_zonal' ) - call addfld ('THzm', (/ 'ilev' /),'A', 'K','Zonal-Mean potential temp - defined on ilev', gridname='fv_centers_zonal' ) - - call addfld ('TH', (/ 'ilev' /),'A','K', 'Potential Temperature', gridname='fv_centers' ) - call addfld ('MSKtem',horiz_only, 'A','1', 'TEM mask', gridname='fv_centers' ) - -!------------------------------------------------------------- -! primary tapes: 3D fields -!------------------------------------------------------------- - call add_default ('VTHzm', 1, ' ') - call add_default ('WTHzm', 1, ' ') - call add_default ('UVzm' , 1, ' ') - call add_default ('UWzm' , 1, ' ') - call add_default ('TH' , 1, ' ') - call add_default ('MSKtem',1, ' ') - - if (history_waccm) then - call add_default ('MSKtem',7, ' ') - call add_default ('VTHzm', 7, ' ') - call add_default ('UVzm', 7, ' ') - call add_default ('UWzm', 7, ' ') - call add_default ('Uzm', 7, ' ') - call add_default ('Vzm', 7, ' ') - call add_default ('Wzm', 7, ' ') - call add_default ('THzm', 7, ' ') - end if - - if (masterproc) then - write(iulog,*) 'ctem_inti: do_circulation_diags = ',do_circulation_diags - endif - - end subroutine ctem_init - -!================================================================================ - -subroutine ctem_readnl(nlfile) - - use namelist_utils, only: find_group_name - use units, only: getunit, freeunit - use spmd_utils, only: mpicom, mstrid=>masterprocid, mpi_logical - - character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input - - ! Local variables - integer :: unitn, ierr - character(len=*), parameter :: subname = 'ctem_readnl' - - namelist /circ_diag_nl/ do_circulation_diags - !----------------------------------------------------------------------------- - - if (masterproc) then - unitn = getunit() - open( unitn, file=trim(nlfile), status='old' ) - call find_group_name(unitn, 'circ_diag_nl', status=ierr) - if (ierr == 0) then - read(unitn, circ_diag_nl, iostat=ierr) - if (ierr /= 0) then - call endrun(subname // ':: ERROR reading namelist') - end if - end if - close(unitn) - call freeunit(unitn) - end if - - call mpi_bcast(do_circulation_diags, 1, mpi_logical, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: do_circulation_diags") - -end subroutine ctem_readnl - -end module ctem diff --git a/src/dynamics/fv/tp_core.F90.orig b/src/dynamics/fv/tp_core.F90.orig deleted file mode 100644 index 1265dc1582..0000000000 --- a/src/dynamics/fv/tp_core.F90.orig +++ /dev/null @@ -1,2610 +0,0 @@ -#if defined( UNICOSMP ) || defined ( NEC_SX ) -#define VECTORIZE -#endif -module tp_core -!BOP -! -! !MODULE: tp_core --- Utilities for the transport core -! -! !USES: - use shr_kind_mod, only : r8 => shr_kind_r8 - -! -! !PUBLIC MEMBER FUNCTIONS: - public tp2c, tp2d, xtp, xtpv, fxppm, xmist, steepx, lmppm - public huynh, ytp, ymist, fyppm, tpcc, ycc -! -! !DESCRIPTION: -! -! This module provides -! -! \begin{tabular}{|l|l|} \hline \hline -! tp2c & \\ \hline -! tp2d & \\ \hline -! xtp & \\ \hline -! fxppm & \\ \hline -! xmist & \\ \hline -! steepx & \\ \hline -! lmppm & \\ \hline -! huynh & \\ \hline -! ytp & \\ \hline -! ymist & \\ \hline -! fyppm & \\ \hline -! tpcc & \\ \hline -! ycc & \\ \hline -! \hline -! \end{tabular} -! -! !REVISION HISTORY: -! 01.01.15 Lin Routines coalesced into this module -! 01.03.26 Sawyer Additional ProTeX documentation -! 03.11.19 Sawyer Merged in CAM changes by Mirin -! 04.10.07 Sawyer ompinner now from dynamics_vars -! 05.03.25 Todling shr_kind_r8 can only be referenced once (MIPSpro-7.4.2) -! 05.05.25 Sawyer Merged CAM and GEOS5 versions (mostly CAM) -! 06.09.06 Sawyer Turned "magic numbers" into F90 parameters -! -!EOP -!----------------------------------------------------------------------- - -! Magic numbers used in this module - - private - real(r8), parameter :: D0_0 = 0.0_r8 - real(r8), parameter :: D0_05 = 0.05_r8 - real(r8), parameter :: D0_25 = 0.25_r8 - real(r8), parameter :: D0_5 = 0.5_r8 - real(r8), parameter :: D1_0 = 1.0_r8 - real(r8), parameter :: D2_0 = 2.0_r8 - real(r8), parameter :: D3_0 = 3.0_r8 - real(r8), parameter :: D4_0 = 4.0_r8 - real(r8), parameter :: D8_0 = 8.0_r8 - real(r8), parameter :: D12_0 = 12.0_r8 - real(r8), parameter :: D24_0 = 24.0_r8 - -CONTAINS - -!----------------------------------------------------------------------- -!BOP -! !IROUTINE: tp2c --- Perform transport on a C grid -! -! !INTERFACE: - subroutine tp2c(dh, va, h, crx, cry, im, jm, & - iord, jord, ng, fx, fy, ffsl, & - rcap, acosp, xfx, yfx, cosp, id, jfirst, jlast) -!----------------------------------------------------------------------- - - implicit none - -! !INPUT PARAMETERS: - integer im, jm ! Dimensions - integer jfirst, jlast ! Latitude strip - integer iord, jord ! Interpolation order in x,y - integer ng ! Max. NS dependencies - integer id ! density (0) (mfx = C) - real (r8) rcap ! Ask S.-J. (polar constant?) - real (r8) acosp(jm) ! Ask S.-J. (difference to cosp??) - logical ffsl(jm) ! Use flux-form semi-Lagrangian trans.? - ! (N*NG S*NG) - real (r8) cosp(jm) ! Critical angle - real (r8) va(im,jfirst:jlast) ! Courant (unghosted) - real (r8) h(im,jfirst-ng:jlast+ng) ! Pressure ( N*NG S*NG ) - real (r8) crx(im,jfirst-ng:jlast+ng) ! Ask S.-J. ( N*NG S*NG ) - real (r8) cry(im,jfirst:jlast+1) ! Ask S.-J. ( N like FY ) - real (r8) xfx(im,jfirst:jlast) ! Ask S.-J. ( unghosted like FX ) - real (r8) yfx(im,jfirst:jlast+1) ! Ask S.-J. ( N like FY ) - -! !OUTPUT PARAMETERS: - real (r8) dh(im,jfirst:jlast) ! Ask S.-J. ( unghosted ) - real (r8) fx(im,jfirst:jlast) ! Flux in x ( unghosted ) - real (r8) fy(im,jfirst:jlast+1) ! Flux in y ( N, see tp2c ) - -! !DESCRIPTION: -! Perform transport on a C grid. The number of ghost -! latitudes (NG) depends on what method (JORD) will be used -! subsequentally. NG is equal to MIN(ABS(JORD),3). -! Ask S.-J. how exactly this differs from TP2C. -! -! !REVISION HISTORY: -! -!EOP -!----------------------------------------------------------------------- -!BOC - integer i, j, js2g0, jn2g0 - real (r8) sum1 - - js2g0 = max(2,jfirst) ! No ghosting - jn2g0 = min(jm-1,jlast) ! No ghosting - - call tp2d(va, h, crx, cry, im, jm, iord, jord, ng,fx, fy, ffsl, & - xfx, yfx, cosp, id, jfirst, jlast) - - do j=js2g0,jn2g0 - do i=1,im-1 - dh(i,j) = fx(i,j) - fx(i+1,j) + (fy(i,j)-fy(i,j+1))*acosp(j) - enddo - dh(im,j) = fx(im,j) - fx(1,j) + (fy(im,j)-fy(im,j+1))*acosp(j) - enddo - -! Poles - if ( jfirst == 1 ) then -! sum1 = - SUM( fy(1:im, 2) ) * rcap - sum1 = D0_0 - do i=1,im - sum1 = sum1 + fy(i,2) - enddo - sum1 = -sum1*rcap - do i=1,im - dh(i, 1) = sum1 - enddo - endif - - if ( jlast == jm ) then -! sum1 = SUM( fy(1:im,jm) ) * rcap - sum1 = D0_0 - do i=1,im - sum1 = sum1 + fy(i,jm) - enddo - sum1 = sum1*rcap - do i=1,im - dh(i,jm) = sum1 - enddo - endif - return -!EOC - end subroutine tp2c -!----------------------------------------------------------------------- - -!----------------------------------------------------------------------- -!BOP -! !IROUTINE: tp2d --- Perform transport on a D grid -! -! !INTERFACE: - subroutine tp2d(va, q, crx, cry, im, jm, iord, jord, ng, fx, fy, & - ffsl, xfx, yfx, cosp, id, jfirst, jlast) -!----------------------------------------------------------------------- -! !USES: - - implicit none - -! !INPUT PARAMETERS: - integer im, jm ! Dimensions - integer jfirst, jlast ! Latitude strip - integer iord, jord ! Interpolation order in x,y - integer ng ! Max. NS dependencies - integer id ! density (0) (mfx = C) - ! mixing ratio (1) (mfx = mass flux) - logical ffsl(jm) ! Use flux-form semi-Lagrangian trans.? - ! ghosted N*ng S*ng - real (r8) cosp(jm) ! Critical angle - real (r8) va(im,jfirst:jlast) ! Courant (unghosted) - real (r8) q(im,jfirst-ng:jlast+ng) ! transported scalar ( N*NG S*NG ) - real (r8) crx(im,jfirst-ng:jlast+ng) ! Ask S.-J. ( N*NG S*NG ) - real (r8) cry(im,jfirst:jlast+1) ! Ask S.-J. ( N like FY ) - real (r8) xfx(im,jfirst:jlast) ! Ask S.-J. ( unghosted like FX ) - real (r8) yfx(im,jfirst:jlast+1) ! Ask S.-J. ( N like FY ) - -! !OUTPUT PARAMETERS: - real (r8) fx(im,jfirst:jlast) ! Flux in x ( unghosted ) - real (r8) fy(im,jfirst:jlast+1) ! Flux in y ( N, see tp2c ) - -! !DESCRIPTION: -! Perform transport on a D grid. The number of ghost -! latitudes (NG) depends on what method (JORD) will be used -! subsequentally. NG is equal to MIN(ABS(JORD),3). -! -! -! !REVISION HISTORY: -! WS 99.04.13: Added jfirst:jlast concept -! 99.04.21: Removed j1 and j2 (j1=2, j2=jm-1 consistently) -! 99.04.27: Removed dc, wk2 as arguments (local to YTP) -! 99.04.27: Removed adx as arguments (local here) -! SJL 99.07.26: ffsl flag added -! WS 99.09.07: Restructuring, cleaning, documentation -! WS 99.10.22: NG now argument; arrays pruned -! WS 00.05.14: Renamed ghost indices as per Kevin's definitions -! -!EOP -!--------------------------------------------------------------------- -!BOC - -! Local: - integer i, j, iad, jp, js2g0, js2gng, jn2g0, jn2gng - real (r8) adx(im,jfirst-ng:jlast+ng) - real (r8) wk1v(im,jfirst-ng:jlast+ng) - real (r8) dm(-im/3:im+im/3) - real (r8) qtmpv(-im/3:im+im/3,jfirst-ng:jlast+ng) - real (r8) al(-im/3:im+im/3) - real (r8) ar(-im/3:im+im/3) - real (r8) a6(-im/3:im+im/3) - -! Number of ghost latitudes - js2g0 = max(2,jfirst) ! No ghosting - js2gng = max(2,jfirst-ng) ! Number needed on S - jn2g0 = min(jm-1,jlast) ! No ghosting - jn2gng = min(jm-1,jlast+ng) ! Number needed on N - iad = 1 - - call xtpv(im, ffsl, wk1v, q, crx, iad, crx, & - cosp, 0, dm, qtmpv, al, ar, a6, & - jfirst, jlast, js2gng, jn2gng, jm, & - 1, jm, jfirst-ng, jlast+ng, & - jfirst-ng, jlast+ng, jfirst-ng, jlast+ng, & - jfirst-ng, jlast+ng, jfirst-ng, jlast+ng) - - do j=js2gng,jn2gng ! adx needed on N*ng S*ng - - do i=1,im-1 - adx(i,j) = q(i,j) + D0_5 * & - (wk1v(i,j)-wk1v(i+1,j) + q(i,j)*(crx(i+1,j)-crx(i,j))) - enddo - adx(im,j) = q(im,j) + D0_5 * & - (wk1v(im,j)-wk1v(1,j) + q(im,j)*(crx(1,j)-crx(im,j))) - enddo - -! WS 99.09.07 : Split up north and south pole - - if ( jfirst-ng <= 1 ) then - do i=1,im - adx(i, 1) = q(i,1) - enddo - endif - if ( jlast+ng >= jm ) then - do i=1,im - adx(i,jm) = q(i,jm) - enddo - endif - - call ytp(im,jm,fy, adx,cry,yfx,ng,jord,0,jfirst,jlast) - - do j=js2g0,jn2g0 - do i=1,im - jp = j-va(i,j) - wk1v(i,j) = q(i,j) +D0_5*va(i,j)*(q(i,jp)-q(i,jp+1)) - enddo - enddo - - call xtpv(im, ffsl, fx, wk1v, crx, iord, xfx, & - cosp, id, dm, qtmpv, al, ar, a6, & - jfirst, jlast, js2g0, jn2g0, jm, & - 1, jm, jfirst, jlast, & - jfirst-ng, jlast+ng, jfirst-ng, jlast+ng, & - jfirst, jlast, jfirst-ng, jlast+ng) - - return -!EOC - end subroutine tp2d -!----------------------------------------------------------------------- - -#ifndef VECTORIZE -!----------------------------------------------------------------------- -!BOP -! !IROUTINE: xtpv -! -! !INTERFACE: - subroutine xtpv(im, ffslv, fxv, qv, cv, iord, mfxv, & - cosav, id, dmw, qtmpv, alw, arw, a6w, & - jfirst, jlast, jlow, jhigh, jm, & - jl2, jh2, jl3, jh3, & - jl4, jh4, jl5, jh5, & - jl7, jh7, jl11, jh11) -!----------------------------------------------------------------------- - - implicit none - -! !INPUT PARAMETERS: - integer id ! ID = 0: density (mfx = C) - ! ID = 1: mixing ratio (mfx is mass flux) - - integer im ! Total longitudes - integer iord - integer jfirst, jlast, jlow, jhigh, jm - integer jl2, jh2, jl3, jh3, jl4, jh4, jl5, jh5 - integer jl7, jh7, jl11, jh11 - real (r8) cv(im,jl5:jh5) ! Courant numbers - real (r8) qv(im,jl4:jh4) - real (r8) mfxv(im,jl7:jh7) - logical ffslv(jl2:jh2) - real (r8) cosav(jm) - -! !INPUT/OUTPUT PARAMETERS: - real (r8) qtmpv(-im/3:im+im/3,jl11:jh11) ! Input work arrays: - real (r8) dmw(-im/3:im+im/3) - real (r8) alw(-im/3:im+im/3) - real (r8) arw(-im/3:im+im/3) - real (r8) a6w(-im/3:im+im/3) - -! !OUTPUT PARAMETERS: - real (r8) fxv(im,jl3:jh3) - -! !DESCRIPTION: -! -! -! !REVISION HISTORY: -! 99.01.01 Lin Creation -! 01.03.27 Sawyer Additional ProTeX documentation -! -!EOP -!----------------------------------------------------------------------- -!BOC - -! Local: - real (r8) cos_upw !critical cosine for upwind - real (r8) cos_van !critical cosine for van Leer - real (r8) cos_ppm !critical cosine for ppm - - parameter (cos_upw = D0_05) !roughly at 87 deg. - parameter (cos_van = D0_25) !roughly at 75 deg. - parameter (cos_ppm = D0_25) - - integer i, imp, j - real (r8) qmax, qmin - real (r8) rut, tmp - integer iu, itmp, ist - integer isave(im) - integer iuw, iue - real (r8) dm(-im/3:im+im/3) - real (r8) al(-im/3:im+im/3) - real (r8) ar(-im/3:im+im/3) - real (r8) a6(-im/3:im+im/3) - - imp = im + 1 - - do j = jlow, jhigh - - do i=1,im - qtmpv(i,j) = qv(i,j) - enddo - - if( ffslv(j) ) then -! Flux-Form Semi-Lagrangian transport - -! Figure out ghost zone for the western edge: - iuw = -cv(1,j) - iuw = min(0, iuw) - - do i=iuw, 0 - qtmpv(i,j) = qv(im+i,j) - enddo - -! Figure out ghost zone for the eastern edge: - iue = im - cv(im,j) - iue = max(imp, iue) - - do i=imp, iue - qtmpv(i,j) = qv(i-im,j) - enddo - - if( iord == 1 .or. cosav(j) < cos_upw) then - do i=1,im - iu = cv(i,j) - if(cv(i,j) .le. D0_0) then - itmp = i - iu - isave(i) = itmp - 1 - else - itmp = i - iu - 1 - isave(i) = itmp + 1 - endif - fxv(i,j) = (cv(i,j)-iu) * qtmpv(itmp,j) - enddo - else - - do i=1,im -! 2nd order slope - tmp = D0_25*(qtmpv(i+1,j) - qtmpv(i-1,j)) - qmax = max(qtmpv(i-1,j), qtmpv(i,j), qtmpv(i+1,j)) - qtmpv(i,j) - qmin = qtmpv(i,j) - min(qtmpv(i-1,j), qtmpv(i,j), qtmpv(i+1,j)) - dm(i) = sign(min(abs(tmp),qmax,qmin), tmp) - enddo - - - do i=iuw, 0 - dm(i) = dm(im+i) - enddo - - do i=imp, iue - dm(i) = dm(i-im) - enddo - - if(iord .ge. 3 .and. cosav(j) .gt. cos_ppm) then - call fxppm(im, cv(:,j), mfxv(:,j), qtmpv(:,j), dm, fxv(:,j), iord, al, ar, a6, & - iuw, iue, ffslv(j), isave) - else - do i=1,im - iu = cv(i,j) - rut = cv(i,j) - iu - if(cv(i,j) .le. D0_0) then - itmp = i - iu - isave(i) = itmp - 1 - fxv(i,j) = rut*(qtmpv(itmp,j)-dm(itmp)*(D1_0+rut)) - else - itmp = i - iu - 1 - isave(i) = itmp + 1 - fxv(i,j) = rut*(qtmpv(itmp,j)+dm(itmp)*(D1_0-rut)) - endif - enddo - endif - - endif - - do i=1,im - if(cv(i,j) .ge. D1_0) then - do ist = isave(i),i-1 - fxv(i,j) = fxv(i,j) + qtmpv(ist,j) - enddo - elseif(cv(i,j) .le. -D1_0) then - do ist = i,isave(i) - fxv(i,j) = fxv(i,j) - qtmpv(ist,j) - enddo - endif - enddo - - if(id .ne. 0) then - do i=1,im - fxv(i,j) = fxv(i,j)*mfxv(i,j) - enddo - endif - - else -! Regular PPM (Eulerian without FFSL extension) - - qtmpv(imp,j) = qv(1,j) - qtmpv( 0,j) = qv(im,j) - - if(iord == 1 .or. cosav(j) < cos_upw) then - do i=1,im - iu = real(i,r8) - cv(i,j) - fxv(i,j) = mfxv(i,j)*qtmpv(iu,j) - enddo - else - - qtmpv(-1,j) = qv(im-1,j) - qtmpv(imp+1,j) = qv(2,j) - - if(iord > 0 .or. cosav(j) < cos_van) then - call xmist(im, qtmpv(:,j), dm, 2) - else - call xmist(im, qtmpv(:,j), dm, iord) - endif - - dm(0) = dm(im) - - if( abs(iord).eq.2 .or. cosav(j) .lt. cos_van ) then - do i=1,im - iu = real(i,r8) - cv(i,j) - fxv(i,j) = mfxv(i,j)*(qtmpv(iu,j)+dm(iu)*(sign(D1_0,cv(i,j))-cv(i,j))) - -! if(cv(i,j) .le. 0.) then -! fxv(i,j) = qtmpv(i,j) - dm(i)*(1.+cv(i,j)) -! else -! fxv(i,j) = qtmpv(i-1,j) + dm(i-1)*(1.-cv(i,j)) -! endif -! fxv(i,j) = fxv(i,j)*mfxv(i,j) - - enddo - else - call fxppm(im, cv(:,j), mfxv(:,j), qtmpv(:,j), dm, fxv(:,j), iord, al, ar, a6, & - iuw, iue, ffslv(j), isave) - endif - endif - - endif - - enddo - - return -!EOC - end subroutine xtpv -!----------------------------------------------------------------------- - -!----------------------------------------------------------------------- -!BOP -! !IROUTINE: xmist -! -! !INTERFACE: - subroutine xmist(im, q, dm, id) -!----------------------------------------------------------------------- - - implicit none - -! !INPUT PARAMETERS: - integer im ! Total number of longitudes - integer id ! ID = 0: density (mfx = C) - ! ID = 1: mixing ratio (mfx is mass flux) - real(r8) q(-im/3:im+im/3) ! Input latitude - -! !OUTPUT PARAMETERS: - real(r8) dm(-im/3:im+im/3) ! - -! !DESCRIPTION: -! -! -! !REVISION HISTORY: -! 99.01.01 Lin Creation -! 01.03.27 Sawyer Additional ProTeX documentation -! -!EOP -!----------------------------------------------------------------------- -!BOC - - real(r8) r24 - parameter( r24 = D1_0/D24_0) - - integer i - real(r8) qmin, qmax - - if(id .le. 2) then - do i=1,im - dm(i) = r24*(D8_0*(q(i+1) - q(i-1)) + q(i-2) - q(i+2)) - enddo - else - do i=1,im - dm(i) = D0_25*(q(i+1) - q(i-1)) - enddo - endif - - if( id < 0 ) return - -! Apply monotonicity constraint (Lin et al. 1994, MWR) - do i=1,im - qmax = max( q(i-1), q(i), q(i+1) ) - q(i) - qmin = q(i) - min( q(i-1), q(i), q(i+1) ) - dm(i) = sign( min(abs(dm(i)), qmax, qmin), dm(i) ) - enddo - return -!EOC - end subroutine xmist -!----------------------------------------------------------------------- - -!----------------------------------------------------------------------- -!BOP -! !IROUTINE: fxppm -! -! !INTERFACE: - subroutine fxppm(im, c, mfx, p, dm, fx, iord, al, ar, a6, & - iuw, iue, ffsl, isave) -!----------------------------------------------------------------------- -! -! !USES: - implicit none - -! !INPUT PARAMETERS: - integer im, iord - real (r8) c(im) - real (r8) p(-im/3:im+im/3) - real (r8) dm(-im/3:im+im/3) - real (r8) mfx(im) - integer iuw, iue - logical ffsl - integer isave(im) - -! !INPUT/OUTPUT PARAMETERS: - real (r8) al(-im/3:im+im/3) - real (r8) ar(-im/3:im+im/3) - real (r8) a6(-im/3:im+im/3) - -! !OUTPUT PARAMETERS: - real (r8) fx(im) - -! !DESCRIPTION: -! -! -! !REVISION HISTORY: -! 99.01.01 Lin Creation -! 01.03.27 Sawyer Additional ProTeX documentation -! -!EOP -!----------------------------------------------------------------------- -!BOC -! -! !LOCAL VARIABLES: - real (r8) r3, r23 - parameter ( r3 = D1_0/D3_0, r23 = D2_0/D3_0 ) - - integer i, lmt - integer iu, itmp - real (r8) ru - logical steep - - if( iord == 6 ) then - steep = .true. - else - steep = .false. - endif - - do i=1,im - al(i) = D0_5*(p(i-1)+p(i)) + (dm(i-1) - dm(i))*r3 - enddo - - if( steep ) call steepx( im, p, al(1), dm ) - - do i=1,im-1 - ar(i) = al(i+1) - enddo - ar(im) = al(1) - - if(iord == 7) then - call huynh(im, ar(1), al(1), p(1), a6(1), dm(1)) - else - if(iord .eq. 3 .or. iord .eq. 5) then - do i=1,im - a6(i) = D3_0*(p(i)+p(i) - (al(i)+ar(i))) - enddo - endif - lmt = iord - 3 - call lmppm( dm(1), a6(1), ar(1), al(1), p(1), im, lmt ) - endif - - if( ffsl ) then - - do i=iuw, 0 - al(i) = al(im+i) - ar(i) = ar(im+i) - a6(i) = a6(im+i) - enddo - - do i=im+1, iue - al(i) = al(i-im) - ar(i) = ar(i-im) - a6(i) = a6(i-im) - enddo - - do i=1,im - iu = c(i) - ru = c(i) - iu - if(c(i) .gt. D0_0) then - itmp = i - iu - 1 - isave(i) = itmp + 1 - fx(i) = ru*(ar(itmp)+D0_5*ru*(al(itmp)-ar(itmp) + & - a6(itmp)*(D1_0-r23*ru)) ) - else - itmp = i - iu - isave(i) = itmp - 1 - fx(i) = ru*(al(itmp)-D0_5*ru*(ar(itmp)-al(itmp) + & - a6(itmp)*(D1_0+r23*ru)) ) - endif - enddo - - else - al(0) = al(im) - ar(0) = ar(im) - a6(0) = a6(im) - do i=1,im - if(c(i) .gt. D0_0) then - fx(i) = ar(i-1) + D0_5*c(i)*(al(i-1) - ar(i-1) + & - a6(i-1)*(D1_0-r23*c(i)) ) - else - fx(i) = al(i) - D0_5*c(i)*(ar(i) - al(i) + & - a6(i)*(D1_0+r23*c(i))) - endif - fx(i) = mfx(i) * fx(i) - enddo - endif - return -!EOC - end subroutine fxppm -!----------------------------------------------------------------------- - -!----------------------------------------------------------------------- -!BOP -! !IROUTINE: steepx -! -! !INTERFACE: - subroutine steepx(im, p, al, dm) -!----------------------------------------------------------------------- - -! !USES: - implicit none - -! !INPUT PARAMETERS: - integer im - real (r8) p(-im/3:im+im/3) - real (r8) dm(-im/3:im+im/3) - -! !INPUT/OUTPUT PARAMETERS: - real (r8) al(im) - -! !DESCRIPTION: -! -! -! !REVISION HISTORY: -! 99.01.01 Lin Creation -! 01.03.27 Sawyer Additional ProTeX documentation -! -!EOP -!----------------------------------------------------------------------- -!BOC -! -! !LOCAL VARIABLES: - integer i - real (r8) r3 - parameter ( r3 = D1_0/D3_0 ) - - real (r8) dh(0:im) - real (r8) d2(0:im+1) - real (r8) eta(0:im) - real (r8) xxx, bbb, ccc - - do i=0,im - dh(i) = p(i+1) - p(i) - enddo - -! Needs dh(0:im) - do i=1,im - d2(i) = dh(i) - dh(i-1) - enddo - d2(0) = d2(im) - d2(im+1) = d2(1) - -! needs p(-1:im+2), d2(0:im+1) - do i=1,im - if( d2(i+1)*d2(i-1).lt.D0_0 .and. p(i+1).ne.p(i-1) ) then - xxx = D1_0 - D0_5 * ( p(i+2) - p(i-2) ) / ( p(i+1) - p(i-1) ) - eta(i) = max(D0_0, min(xxx, D0_5) ) - else - eta(i) = D0_0 - endif - enddo - - eta(0) = eta(im) - -! needs eta(0:im), dh(0:im-1), dm(0:im) - do i=1,im - bbb = ( D2_0*eta(i ) - eta(i-1) ) * dm(i-1) - ccc = ( D2_0*eta(i-1) - eta(i ) ) * dm(i ) - al(i) = al(i) + D0_5*( eta(i-1) - eta(i)) * dh(i-1) + (bbb - ccc) * r3 - enddo - return -!EOC - end subroutine steepx -!----------------------------------------------------------------------- - -!----------------------------------------------------------------------- -!BOP -! !IROUTINE: lmppm -! -! !INTERFACE: - subroutine lmppm(dm, a6, ar, al, p, im, lmt) -!----------------------------------------------------------------------- - - implicit none - -! !INPUT PARAMETERS: - integer im ! Total longitudes - integer lmt ! LMT = 0: full monotonicity - ! LMT = 1: Improved and simplified full monotonic constraint - ! LMT = 2: positive-definite constraint - ! LMT = 3: Quasi-monotone constraint - real(r8) p(im) - real(r8) dm(im) - -! !OUTPUT PARAMETERS: - real(r8) a6(im) - real(r8) ar(im) - real(r8) al(im) - -! !DESCRIPTION: -! -! -! !REVISION HISTORY: -! 99.01.01 Lin Creation -! 01.03.27 Sawyer Additional ProTeX documentation -! -!EOP -!----------------------------------------------------------------------- -!BOC -! -! !LOCAL VARIABLES: - real (r8) r12 - parameter ( r12 = D1_0/D12_0 ) - - real (r8) da1, da2, fmin, a6da - real (r8) dr, dl - - integer i - -! LMT = 0: full monotonicity -! LMT = 1: Improved and simplified full monotonic constraint -! LMT = 2: positive-definite constraint -! LMT = 3: Quasi-monotone constraint - - if( lmt == 0 ) then - -! Full constraint - do i=1,im - if(dm(i) .eq. D0_0) then - ar(i) = p(i) - al(i) = p(i) - a6(i) = D0_0 - else - da1 = ar(i) - al(i) - da2 = da1**2 - a6da = a6(i)*da1 - if(a6da .lt. -da2) then - a6(i) = D3_0*(al(i)-p(i)) - ar(i) = al(i) - a6(i) - elseif(a6da .gt. da2) then - a6(i) = D3_0*(ar(i)-p(i)) - al(i) = ar(i) - a6(i) - endif - endif - enddo - - elseif( lmt == 1 ) then - -! Improved (Lin 2001?) full constraint - do i=1,im - da1 = dm(i) + dm(i) - dl = sign(min(abs(da1),abs(al(i)-p(i))), da1) - dr = sign(min(abs(da1),abs(ar(i)-p(i))), da1) - ar(i) = p(i) + dr - al(i) = p(i) - dl - a6(i) = D3_0*(dl-dr) - enddo - - elseif( lmt == 2 ) then -! Positive definite constraint - do 250 i=1,im - if(abs(ar(i)-al(i)) .ge. -a6(i)) go to 250 - fmin = p(i) + D0_25*(ar(i)-al(i))**2/a6(i) + a6(i)*r12 - if(fmin.ge.D0_0) go to 250 - if(p(i).lt.ar(i) .and. p(i).lt.al(i)) then - ar(i) = p(i) - al(i) = p(i) - a6(i) = D0_0 - elseif(ar(i) .gt. al(i)) then - a6(i) = D3_0*(al(i)-p(i)) - ar(i) = al(i) - a6(i) - else - a6(i) = D3_0*(ar(i)-p(i)) - al(i) = ar(i) - a6(i) - endif -250 continue - - elseif(lmt .eq. 3) then -! Quasi-monotone constraint - do i=1,im - da1 = D4_0*dm(i) - dl = sign(min(abs(da1),abs(al(i)-p(i))), da1) - dr = sign(min(abs(da1),abs(ar(i)-p(i))), da1) - ar(i) = p(i) + dr - al(i) = p(i) - dl - a6(i) = D3_0*(dl-dr) - enddo - endif - return -!EOC - end subroutine lmppm -!----------------------------------------------------------------------- - -!----------------------------------------------------------------------- -!BOP -! !IROUTINE: huynh --- Enforce Huynh's 2nd constraint in 1D periodic domain -! -! !INTERFACE: - subroutine huynh(im, ar, al, p, d2, d1) -!----------------------------------------------------------------------- - -! !USES: - - implicit none - -! !INPUT PARAMETERS: - integer im - real(r8) p(im) - -! !OUTPUT PARAMETERS: - real(r8) ar(im) - real(r8) al(im) - real(r8) d2(im) - real(r8) d1(im) - -! !DESCRIPTION: -! -! Enforce Huynh's 2nd constraint in 1D periodic domain -! -! !REVISION HISTORY: -! 99.01.01 Lin Creation -! 01.03.27 Sawyer Additional ProTeX documentation -! -!EOP -!----------------------------------------------------------------------- -!BOC -! -! !LOCAL VARIABLES: - integer i - real(r8) pmp - real(r8) lac - real(r8) pmin - real(r8) pmax - -! Compute d1 and d2 - d1(1) = p(1) - p(im) - do i=2,im - d1(i) = p(i) - p(i-1) - enddo - - do i=1,im-1 - d2(i) = d1(i+1) - d1(i) - enddo - d2(im) = d1(1) - d1(im) - -! Constraint for AR -! i = 1 - pmp = p(1) + D2_0 * d1(1) - lac = p(1) + D0_5 * (d1(1)+d2(im)) + d2(im) - pmin = min(p(1), pmp, lac) - pmax = max(p(1), pmp, lac) - ar(1) = min(pmax, max(ar(1), pmin)) - - do i=2, im - pmp = p(i) + D2_0*d1(i) - lac = p(i) + D0_5*(d1(i)+d2(i-1)) + d2(i-1) - pmin = min(p(i), pmp, lac) - pmax = max(p(i), pmp, lac) - ar(i) = min(pmax, max(ar(i), pmin)) - enddo - -! Constraint for AL - do i=1, im-1 - pmp = p(i) - D2_0*d1(i+1) - lac = p(i) + D0_5*(d2(i+1)-d1(i+1)) + d2(i+1) - pmin = min(p(i), pmp, lac) - pmax = max(p(i), pmp, lac) - al(i) = min(pmax, max(al(i), pmin)) - enddo - -! i=im - i = im - pmp = p(im) - D2_0*d1(1) - lac = p(im) + D0_5*(d2(1)-d1(1)) + d2(1) - pmin = min(p(im), pmp, lac) - pmax = max(p(im), pmp, lac) - al(im) = min(pmax, max(al(im), pmin)) - -! compute A6 (d2) - do i=1, im - d2(i) = D3_0*(p(i)+p(i) - (al(i)+ar(i))) - enddo - return -!EOC - end subroutine huynh -!----------------------------------------------------------------------- -#endif - -!----------------------------------------------------------------------- -!BOP -! !IROUTINE: ytp -! -! !INTERFACE: - subroutine ytp(im, jm, fy, q, c, yfx, ng, jord, iv, jfirst, jlast) -!----------------------------------------------------------------------- - -! !USES: - implicit none - -! !INPUT PARAMETERS: - integer im, jm ! Dimensions - integer jfirst, jlast ! Latitude strip - integer ng ! Max. NS dependencies - integer jord ! order of subgrid dist - integer iv ! Scalar=0, Vector=1 - real (r8) q(im,jfirst-ng:jlast+ng) ! advected scalar N*jord S*jord - real (r8) c(im,jfirst:jlast+1) ! Courant N (like FY) - real (r8) yfx(im,jfirst:jlast+1) ! Backgrond mass flux - -! !OUTPUT PARAMETERS: - real (r8) fy(im,jfirst:jlast+1) ! Flux N (see tp2c) - -! !DESCRIPTION: -! This routine calculates the flux FX. The method chosen -! depends on the order of the calculation JORD (currently -! 1, 2 or 3). -! -! !CALLED FROM: -! cd_core -! tp2d -! -! !REVISION HISTORY: -! -! SJL 99.04.13: Delivery -! WS 99.04.13: Added jfirst:jlast concept -! WS 99.04.21: Removed j1 and j2 (j1=2, j2=jm-1 consistently) -! removed a6,ar,al from argument list -! WS 99.04.27: DM made local to this routine -! WS 99.09.09: Documentation; indentation; cleaning -! WS 99.10.22: Added NG as argument; pruned arrays -! SJL 99.12.24: Revised documentation; optimized for better cache usage -! WS 00.05.14: Renamed ghost indices as per Kevin's definitions -! -!EOP -!--------------------------------------------------------------------- -!BOC -! -! !LOCAL VARIABLES: - integer i, j, jt - integer js2g0, jn1g1 - -! work arrays (should pass in eventually for performance enhancement): - real (r8) dm(im,jfirst-ng:jlast+ng) - -! real (r8) ar(im,jfirst-1:jlast+1) ! AR needs to be ghosted on NS -! real (r8) al(im,jfirst-1:jlast+2) ! AL needs to be ghosted on N2S -! real (r8) a6(im,jfirst-1:jlast+1) ! A6 needs to be ghosted on NS - - js2g0 = max(2,jfirst) ! No ghosting - jn1g1 = min(jm,jlast+1) ! Ghost N*1 - - if(jord == 1) then - do j=js2g0,jn1g1 - do i=1,im - jt = real(j,r8) - c(i,j) - fy(i,j) = q(i,jt) - enddo - enddo - else - -! -! YMIST requires q on NS; Only call to YMIST here -! - call ymist(im, jm, q, dm, ng, jord, iv, jfirst, jlast) - - if( abs(jord) .ge. 3 ) then - - call fyppm(c,q,dm,fy,im,jm,ng,jord,iv,jfirst,jlast) - - else -! -! JORD can either have the value 2 or -2 at this point -! - do j=js2g0,jn1g1 - do i=1,im - jt = real(j,r8) - c(i,j) - fy(i,j) = q(i,jt) + (sign(D1_0,c(i,j))-c(i,j))*dm(i,jt) - enddo - enddo - endif - endif - - do j=js2g0,jn1g1 - do i=1,im - fy(i,j) = fy(i,j)*yfx(i,j) - enddo - enddo - return -!EOC - end subroutine ytp -!----------------------------------------------------------------------- - -!----------------------------------------------------------------------- -!BOP -! !IROUTINE: ymist -! -! !INTERFACE: - subroutine ymist(im, jm, q, dm, ng, jord, iv, jfirst, jlast) -!----------------------------------------------------------------------- - -! !USES: - implicit none - -! !INPUT PARAMETERS: - integer im, jm ! Dimensions - integer jfirst, jlast ! Latitude strip - integer ng ! NS dependencies - integer jord ! order of subgrid distribution - integer iv ! Scalar (==0) Vector (==1) - real (r8) q(im,jfirst-ng:jlast+ng) ! transported scalar N*ng S*ng - -! !OUTPUT PARAMETERS: - real (r8) dm(im,jfirst-ng:jlast+ng) ! Slope only N*(ng-1) S*(ng-1) used - -! !DESCRIPTION: -! Calculate the slope of the pressure. The number of ghost -! latitudes (NG) depends on what method (JORD) will be used -! subsequentally. NG is equal to MIN(ABS(JORD),3). -! -! !CALLED FROM: -! ytp -! -! !REVISION HISTORY: -! -! SJL 99.04.13: Delivery -! WS 99.04.13: Added jfirst:jlast concept -! WS 99.09.09: Documentation; indentation; cleaning -! SJL 00.01.06: Documentation -! WS 00.05.14: Renamed ghost indices as per Kevin's definitions -! -!EOP -!--------------------------------------------------------------------- -!BOC - -! Local variables - - integer i, j, jm1, im2, js2gng1, jn2gng1 - real (r8) qmax, qmin, tmp - - js2gng1 = max(2, jfirst-ng+1) ! Number needed on S - jn2gng1 = min(jm-1,jlast+ng-1) ! Number needed on N - - jm1 = jm - 1 - im2 = im / 2 - - do j=js2gng1,jn2gng1 - do i=1,im - dm(i,j) = D0_25*(q(i,j+1) - q(i,j-1)) - enddo - enddo - - if( iv == 0 ) then - - if ( jfirst-ng <= 1 ) then -! S pole - do i=1,im2 - tmp = D0_25*(q(i,2)-q(i+im2,2)) - qmax = max(q(i,2),q(i,1), q(i+im2,2)) - q(i,1) - qmin = q(i,1) - min(q(i,2),q(i,1), q(i+im2,2)) - dm(i,1) = sign(min(abs(tmp),qmax,qmin),tmp) - enddo - - do i=im2+1,im - dm(i, 1) = - dm(i-im2, 1) - enddo - endif - - if ( jlast+ng >= jm ) then -! N pole - do i=1,im2 - tmp = D0_25*(q(i+im2,jm1)-q(i,jm1)) - qmax = max(q(i+im2,jm1),q(i,jm), q(i,jm1)) - q(i,jm) - qmin = q(i,jm) - min(q(i+im2,jm1),q(i,jm), q(i,jm1)) - dm(i,jm) = sign(min(abs(tmp),qmax,qmin),tmp) - enddo - - do i=im2+1,im - dm(i,jm) = - dm(i-im2,jm) - enddo - endif - - else - - if ( jfirst-ng <= 1 ) then -! South - do i=1,im2 - tmp = D0_25*(q(i,2)+q(i+im2,2)) - qmax = max(q(i,2),q(i,1), -q(i+im2,2)) - q(i,1) - qmin = q(i,1) - min(q(i,2),q(i,1),-q(i+im2,2)) - dm(i,1) = sign(min(abs(tmp),qmax,qmin),tmp) - enddo - - do i=im2+1,im - dm(i, 1) = dm(i-im2, 1) - enddo - endif - - if ( jlast+ng >= jm ) then -! North - do i=1,im2 - tmp = -D0_25*(q(i+im2,jm1)+q(i,jm1)) - qmax = max(-q(i+im2,jm1),q(i,jm), q(i,jm1)) - q(i,jm) - qmin = q(i,jm) - min(-q(i+im2,jm1),q(i,jm), q(i,jm1)) - dm(i,jm) = sign(min(abs(tmp),qmax,qmin),tmp) - enddo - - do i=im2+1,im - dm(i,jm) = dm(i-im2,jm) - enddo - endif - - endif - - if( jord > 0 ) then -! -! Applies monotonic slope constraint (off if jord less than zero) -! - do j=js2gng1,jn2gng1 - do i=1,im - qmax = max(q(i,j-1),q(i,j),q(i,j+1)) - q(i,j) - qmin = q(i,j) - min(q(i,j-1),q(i,j),q(i,j+1)) - dm(i,j) = sign(min(abs(dm(i,j)),qmin,qmax),dm(i,j)) - enddo - enddo - endif - return -!EOC - end subroutine ymist -!----------------------------------------------------------------------- - -!----------------------------------------------------------------------- -!BOP -! !IROUTINE: fyppm -! -! !INTERFACE: - subroutine fyppm(c, q, dm, flux, im, jm, ng, jord, iv, jfirst, jlast) -!----------------------------------------------------------------------- - -! !USES: - implicit none - -! !INPUT PARAMETERS: - integer im, jm ! Dimensions - integer jfirst, jlast ! Latitude strip - integer ng ! Max. NS dependencies - integer jord ! Approximation order - integer iv ! Scalar=0, Vector=1 - real (r8) q(im,jfirst-ng:jlast+ng) ! mean value needed only N*2 S*2 - real (r8) dm(im,jfirst-ng:jlast+ng) ! Slope needed only N*2 S*2 - real (r8) c(im,jfirst:jlast+1) ! Courant N (like FLUX) - -! !INPUT/OUTPUT PARAMETERS: - real (r8) ar(im,jfirst-1:jlast+1) ! AR needs to be ghosted on NS - real (r8) al(im,jfirst-1:jlast+2) ! AL needs to be ghosted on N2S - real (r8) a6(im,jfirst-1:jlast+1) ! A6 needs to be ghosted on NS - -! !OUTPUT PARAMETERS: - real (r8) flux(im,jfirst:jlast+1) ! Flux N (see tp2c) - -! !DESCRIPTION: -! -! NG is passed from YTP for convenience -- it is actually 1 more in NS -! than the actual number of latitudes needed here. But in the shared-memory -! case it becomes 0, which is much cleaner. -! -! !CALLED FROM: -! ytp -! -! !REVISION HISTORY: -! -! SJL 99.04.13: Delivery -! WS 99.04.19: Added jfirst:jlast concept; FYPPM only called from YTP -! WS 99.04.21: Removed j1, j2 (j1=2, j2=jm-1 consistently) -! removed a6,ar,al from argument list -! WS 99.09.09: Documentation; indentation; cleaning -! WS 99.10.22: Added ng as argument; Pruned arrays -! WS 00.05.14: Renamed ghost indices as per Kevin's definitions -! -!EOP -!--------------------------------------------------------------------- -!BOC - real (r8) r3, r23 - parameter ( r3 = D1_0/D3_0, r23 = D2_0/D3_0 ) - integer i, j, imh, jm1, lmt - integer js1g1, js2g0, js2g1, jn1g2, jn1g1, jn2g1 - integer jan, jlow, jhigh, ilow, ihigh - integer ja(jlast-jfirst+3) -! logical steep - -! if(jord .eq. 6) then -! steep = .true. -! else -! steep = .false. -! endif - - imh = im / 2 - jm1 = jm - 1 - - js1g1 = max(1,jfirst-1) ! Ghost S*1 - js2g0 = max(2,jfirst) ! No ghosting - js2g1 = max(2,jfirst-1) ! Ghost S*1 - jn1g1 = min(jm,jlast+1) ! Ghost N*1 - jn1g2 = min(jm,jlast+2) ! Ghost N*2 - jn2g1 = min(jm-1,jlast+1) ! Ghost N*1 - - do j=js2g1,jn1g2 ! AL needed N2S - do i=1,im ! P, dm ghosted N2S2 (at least) - al(i,j) = D0_5*(q(i,j-1)+q(i,j)) + r3*(dm(i,j-1) - dm(i,j)) - enddo - enddo - -! Yeh's steepening procedure; to be implemented -! if(steep) call steepy(im, jm, jfirst, jlast, & -! ng, q, al, dm ) - - do j=js1g1,jn2g1 ! AR needed NS - do i=1,im - ar(i,j) = al(i,j+1) ! AL ghosted N2S - enddo - enddo - -! WS 990726 : Added condition to decide if poles are on this processor - -! Poles: - - if( iv == 0 ) then - - if ( jfirst == 1 ) then - do i=1,imh - al(i, 1) = al(i+imh,2) - al(i+imh,1) = al(i, 2) - enddo - endif - - if ( jlast == jm ) then - do i=1,imh - ar(i, jm) = ar(i+imh,jm1) - ar(i+imh,jm) = ar(i, jm1) - enddo - endif - - else - - if ( jfirst == 1 ) then - do i=1,imh - al(i, 1) = -al(i+imh,2) - al(i+imh,1) = -al(i, 2) - enddo - endif - - if ( jlast == jm ) then - do i=1,imh - ar(i, jm) = -ar(i+imh,jm1) - ar(i+imh,jm) = -ar(i, jm1) - enddo - endif - - endif - - if( jord == 3 .or. jord == 5 ) then - do j=js1g1,jn1g1 ! A6 needed NS - do i=1,im - a6(i,j) = D3_0*(q(i,j)+q(i,j) - (al(i,j)+ar(i,j))) - enddo - enddo - endif - - lmt = jord - 3 - -! do j=js1g1,jn1g1 ! A6, AR, AL needed NS -! call lmppm(dm(1,j),a6(1,j),ar(1,j),al(1,j),q(1,j),im,lmt) -! enddo - -#ifdef VECTORIZE - jan = 1 - ja(1) = 1 - ilow = 1 - ihigh = im*(jn1g1-js1g1+1) - jlow = 1 - jhigh = 1 - call lmppmv(dm(1,js1g1), a6(1,js1g1), ar(1,js1g1), & - al(1,js1g1), q(1,js1g1), im*(jn1g1-js1g1+1), lmt, & - jan, ja, ilow, ihigh, jlow, jhigh, jlow, jhigh) -#else - call lmppm(dm(1,js1g1), a6(1,js1g1), ar(1,js1g1), & - al(1,js1g1), q(1,js1g1), im*(jn1g1-js1g1+1), lmt) -#endif - - do j=js2g0,jn1g1 ! flux needed N - do i=1,im - if(c(i,j).gt.D0_0) then - flux(i,j) = ar(i,j-1) + D0_5*c(i,j)*(al(i,j-1) - ar(i,j-1) + & - a6(i,j-1)*(D1_0-r23*c(i,j)) ) - else - flux(i,j) = al(i,j) - D0_5*c(i,j)*(ar(i,j) - al(i,j) + & - a6(i,j)*(D1_0+r23*c(i,j))) - endif - enddo - enddo - return -!EOC - end subroutine fyppm -!----------------------------------------------------------------------- - -!----------------------------------------------------------------------- -!BOP -! !IROUTINE: tpcc -! -! !INTERFACE: - subroutine tpcc(va, ymass, q, crx, cry, im, jm, ng_c, ng_d, & - iord, jord, fx, fy, ffsl, cose, jfirst, jlast, & - dm, qtmp, al, ar, a6 ) -!----------------------------------------------------------------------- - -! !USES: - implicit none - -! !INPUT PARAMETERS: - integer im, jm ! Dimensions - integer ng_c ! - integer ng_d ! - integer jfirst, jlast ! Latitude strip - integer iord, jord ! Interpolation order in x,y - logical ffsl(jm) ! Flux-form semi-Lagrangian transport? - real (r8) cose(jm) ! Critical cosine (replicated) - real (r8) va(im,jfirst:jlast) ! Courant (unghosted like FX) - real (r8) q(im,jfirst-ng_d:jlast+ng_d) ! - real (r8) crx(im,jfirst-ng_c:jlast+ng_c) - real (r8) cry(im,jfirst:jlast) ! Courant # (ghosted like FY) - real (r8) ymass(im,jfirst:jlast) ! Background y-mass-flux (ghosted like FY) - -! Input 1D work arrays: - real (r8) dm(-im/3:im+im/3) - real (r8) qtmp(-im/3:im+im/3) - real (r8) al(-im/3:im+im/3) - real (r8) ar(-im/3:im+im/3) - real (r8) a6(-im/3:im+im/3) - -! !OUTPUT PARAMETERS: - real (r8) fx(im,jfirst:jlast) ! Flux in x (unghosted) - real (r8) fy(im,jfirst:jlast) ! Flux in y (unghosted since iv==0) - -! !DESCRIPTION: -! In this routine the number -! of north ghosted latitude min(abs(jord),2), and south ghosted -! latitudes is XXXX -! -! !CALLED FROM: -! cd_core -! -! !REVISION HISTORY: -! SJL 99.04.13: Delivery -! WS 99.04.13: Added jfirst:jlast concept -! WS 99.05.10: Replaced JNP with JM, JMR with JM-1, IMR with IM -! WS 99.05.10: Removed fvcore.h and JNP, IMH, IML definitions -! WS 99.10.20: Pruned arrays -! WS 00.05.14: Renamed ghost indices as per Kevin's definitions -! -!EOP -!----------------------------------------------------------------------- -!BOC -! -! !LOCAL VARIABLES: - - real (r8) adx(im,jfirst-1:jlast+2) - integer north, south - integer i, j, jp, im2, js2g0, js2gs, jn2g0, jn1g0, jn1gn - real (r8) wk1v(im,jfirst-1:jlast+2) - real (r8) fx1(im) - real (r8) qtmpv(-im/3:im+im/3,jfirst-1:jlast+2) - - im2 = im/2 - north = min(2,abs(jord)) ! north == 1 or 2 - south = north-1 ! south == 0 or 1 - js2g0 = max(2,jfirst) - js2gs = max(2,jfirst-south) - jn2g0 = min(jm-1,jlast) - jn1gn = min(jm,jlast+north) - jn1g0 = min(jm,jlast) - -! This loop must be ghosted N*NG, S*NG - - call xtpv( im, ffsl, wk1v, q, crx, 1, crx, & - cose, 0, dm, qtmpv, al, ar, a6, & - jfirst, jlast, js2gs, jn1gn, jm, & - 1, jm, jfirst-1, jlast+2, & - jfirst-ng_d, jlast+ng_d, jfirst-ng_c, jlast+ng_c, & - jfirst-ng_c, jlast+ng_c, jfirst-1, jlast+2) - - do j=js2gs,jn1gn - - do i=1,im-1 - adx(i,j) = q(i,j) + D0_5 * & - (wk1v(i,j)-wk1v(i+1,j) + q(i,j)*(crx(i+1,j)-crx(i,j))) - enddo - - adx(im,j) = q(im,j) + D0_5 * & - (wk1v(im,j)-wk1v(1,j) + q(im,j)*(crx(1,j)-crx(im,j))) - enddo - - call ycc(im, jm, fy, adx, cry, ymass, jord, 0,jfirst,jlast) - -! For Scalar only!!! - if ( jfirst == 1 ) then ! ( jfirst -ng_d <= 1 ) fails when - ! ng_d=3, ng_c=2, jlast-jfirst+1 = 3 - do i=1,im2 - q(i,1) = q(i+im2, 2) - enddo - do i=im2+1,im - q(i,1) = q(i-im2, 2) - enddo - endif - - if ( jlast == jm ) then - do i=1,im2 - fx1(i) = q(i+im2,jm) - enddo - do i=im2+1,im - fx1(i) = q(i-im2,jm) - enddo - - do i=1,im - if(va(i,jm) .gt. D0_0) then - adx(i,jm) = q(i,jm) + D0_5*va(i,jm)*(q(i,jm-1)-q(i,jm)) - else - adx(i,jm) = q(i,jm) + D0_5*va(i,jm)*(q(i,jm)-fx1(i)) - endif - enddo - endif - - do j=js2g0,jn2g0 - do i=1,im - jp = j-va(i,j) -! jp = j if va < 0 -! jp = j -1 if va < 0 -! q needed max(1, jfirst-1) - adx(i,j) = q(i,j) + D0_5*va(i,j)*(q(i,jp)-q(i,jp+1)) - enddo - enddo - - call xtpv( im, ffsl, fx, adx, crx, iord, crx, & - cose, 0, dm, qtmpv, al, ar, a6, & - jfirst, jlast, js2g0, jn1g0, jm, & - 1, jm, jfirst, jlast, & - jfirst-1, jlast+2,jfirst-ng_c, jlast+ng_c, & - jfirst-ng_c, jlast+ng_c, jfirst-1, jlast+2) - - return -!EOC - end subroutine tpcc -!----------------------------------------------------------------------- - -!----------------------------------------------------------------------- -!BOP -! !IROUTINE: ycc -! -! !INTERFACE: - subroutine ycc(im, jm, fy, q, vc, ymass, jord, iv, jfirst, jlast) -!----------------------------------------------------------------------- - -! !USES: - implicit none - -! !INPUT PARAMETERS: - integer im, jm ! Dimensions - integer jfirst, jlast ! Latitude strip - integer jord ! Approximation order - integer iv ! Scalar=0, Vector=1 - real (r8) q(im,jfirst-1-iv:jlast+2) ! Field (N*2 S*(iv+1)) - real (r8) vc(im,jfirst-iv:jlast) ! Courant (like FY) - real (r8) ymass(im,jfirst-iv:jlast) ! background mass flux - -! !OUTPUT PARAMETERS: - real (r8) fy(im,jfirst-iv:jlast) ! Flux (S if iv=1) - -! !DESCRIPTION: -! Will Sawyer's note: In this routine the number -! of ghosted latitudes NG is min(abs(jord),2). The scalar/vector -! flag determines whether the flux FY needs to be ghosted on the -! south. If called from CD\_CORE (iv==1) then it does, if called -! from TPCC (iv==0) it does not. -! -! !CALLED FROM: -! cd_core -! tpcc -! -! !REVISION HISTORY: -! -! SJL 99.04.13: Delivery -! WS 99.04.19: Added jfirst:jlast concept -! WS 99.04.27: DC removed as argument (local to this routine); DC on N -! WS 99.05.10: Replaced JNP with JM, JMR with JM-1, IMR with IM -! WS 99.05.10: Removed fvcore.h -! WS 99.07.27: Built in tests for SP or NP -! WS 99.09.09: Documentation; indentation; cleaning; pole treatment -! WS 99.09.14: Loop limits -! WS 00.05.14: Renamed ghost indices as per Kevin's definitions -! -!EOP -!--------------------------------------------------------------------- -!BOC - -! !LOCAL VARIABLES: - real (r8) dc(im,jfirst-iv:jlast+1) - real (r8) qmax, qmin - integer i, j, jt, im2, js2giv, js3giv, jn2g1, jn2g0 - - - im2 = im/2 - - js2giv = max(2,jfirst-iv) - js3giv = max(3,jfirst-iv) - jn2g1 = min(jm-1,jlast+1) - jn2g0 = min(jm-1,jlast) - - if(jord == 1) then - do j=js2giv,jn2g0 ! FY needed on S*iv - do i=1,im -! jt=j if vc > 0; jt=j+1 if vc <=0 - jt = real(j+1,r8) - vc(i,j) ! VC ghosted like fy - fy(i,j) = q(i,jt)*ymass(i,j) ! ymass ghosted like fy - enddo ! q ghosted N*1, S*iv - enddo - - else - - do j=js3giv,jn2g1 ! dc needed N*1, S*iv - do i=1,im - dc(i,j) = D0_25*(q(i,j+1)-q(i,j-1)) ! q ghosted N*2, S*(iv+1) - enddo - enddo - - if(iv.eq.0) then -! Scalar. - -! WS 99.07.27 : Split loops in SP and NP regions, added SP/NP tests - - if ( jfirst-iv <= 2 ) then - do i=1,im2 - dc(i, 2) = D0_25 * ( q(i,3) - q(i+im2,2) ) - enddo - - do i=im2+1,im - dc(i, 2) = D0_25 * ( q(i,3) - q(i-im2,2) ) - enddo - endif - - if ( jlast == jm ) then - do i=1,im2 - dc(i,jm) = D0_25 * ( q(i+im2,jm) - q(i,jm-1) ) - enddo - - do i=im2+1,im - dc(i,jm) = D0_25 * ( q(i-im2,jm) - q(i,jm-1) ) - enddo - endif - - else -! Vector winds - -! WS 99.07.27 : Split loops in SP and NP regions, added SP/NP tests - - if ( jfirst-iv <= 2 ) then - do i=1,im2 - dc(i, 2) = D0_25 * ( q(i,3) + q(i+im2,2) ) - enddo - - do i=im2+1,im - dc(i, 2) = D0_25 * ( q(i,3) + q(i-im2,2) ) - enddo - endif - - if ( jlast == jm ) then - do i=1,im2 - dc(i,jm) = -D0_25 * ( q(i,jm-1) + q(i+im2,jm) ) - enddo - - do i=im2+1,im - dc(i,jm) = -D0_25 * ( q(i,jm-1) + q(i-im2,jm) ) - enddo - endif - - endif - - if( jord > 0 ) then -! Monotonic constraint - do j=js3giv,jn2g1 ! DC needed N*1, S*iv - do i=1,im ! P ghosted N*2, S*(iv+1) - qmax = max(q(i,j-1),q(i,j),q(i,j+1)) - q(i,j) - qmin = q(i,j) - min(q(i,j-1),q(i,j),q(i,j+1)) - dc(i,j) = sign(min(abs(dc(i,j)),qmin,qmax),dc(i,j)) - enddo - enddo -! -! WS 99.08.03 : Following loop split into SP and NP part -! - if ( jfirst-iv <= 2 ) then - do i=1,im - dc(i, 2) = D0_0 - enddo - endif - if ( jlast == jm ) then - do i=1,im - dc(i,jm) = D0_0 - enddo - endif - endif - - do j=js2giv,jn2g0 ! fy needed S*iv - do i=1,im - jt = real(j+1,r8) - vc(i,j) ! vc, ymass ghosted like fy - fy(i,j) = (q(i,jt)+(sign(D1_0,vc(i,j))-vc(i,j))*dc(i,jt))*ymass(i,j) - enddo - enddo - endif - return -!EOC - end subroutine ycc -!----------------------------------------------------------------------- - -#ifdef VECTORIZE -!----------------------------------------------------------------------- -!BOP -! !IROUTINE: xtpv -! -! !INTERFACE: - subroutine xtpv(im, ffslv, fxv, qv, cv, iord, mfxv, & - cosav, id, dm, qtmpv, al, ar, a6, & - jfirst, jlast, jlow, jhigh, jm, & - jl2, jh2, jl3, jh3, & - jl4, jh4, jl5, jh5, & - jl7, jh7, jl11, jh11) -!----------------------------------------------------------------------- - - implicit none - -! !INPUT PARAMETERS: - integer id ! ID = 0: density (mfx = C) - ! ID = 1: mixing ratio (mfx is mass flux) - - integer im ! Total longitudes - real (r8) cv(im,jl5:jh5) ! Courant numbers - real (r8) qv(im,jl4:jh4) - real (r8) mfxv(im,jl7:jh7) - logical ffslv(jl2:jh2) - integer iord - integer jfirst, jlast, jlow, jhigh, jm - integer jl2, jh2, jl3, jh3, jl4, jh4, jl5, jh5 - integer jl7, jh7, jl11, jh11 - real (r8) cosav(jm) - -! !INPUT/OUTPUT PARAMETERS: - real (r8) qtmpv(-im/3:im+im/3,jl11:jh11) ! Input work arrays: - real (r8) dm(-im/3:im+im/3) - real (r8) al(-im/3:im+im/3) - real (r8) ar(-im/3:im+im/3) - real (r8) a6(-im/3:im+im/3) - -! !OUTPUT PARAMETERS: - real (r8) fxv(im,jl3:jh3) - -! !DESCRIPTION: -! -! -! !REVISION HISTORY: -! 99.01.01 Lin Creation -! 01.03.27 Sawyer Additional ProTeX documentation -! -!EOP -!----------------------------------------------------------------------- -!BOC - -! Local: - real (r8) cos_upw !critical cosine for upwind - real (r8) cos_van !critical cosine for van Leer - real (r8) cos_ppm !critical cosine for ppm - - parameter (cos_upw = D0_05) !roughly at 87 deg. - parameter (cos_van = D0_25) !roughly at 75 deg. - parameter (cos_ppm = D0_25) - - real (r8) r24 - parameter (r24 = D1_0/D24_0) - - integer i, imp, j - real (r8) qmax, qmin - real (r8) rut, tmp - real (r8) dmv(-im/3:im+im/3,jlow:jhigh) - integer iu, itmp, ist - integer isave(im,jlow:jhigh) - integer iuwv(jlow:jhigh), iuev(jlow:jhigh) - - integer jatn, jafn, ja - integer jat(jhigh-jlow+1), jaf(jhigh-jlow+1) - integer jattn, jatfn, jaftn, jaffn - integer jatt(jhigh-jlow+1), jatf(jhigh-jlow+1) - integer jaft(jhigh-jlow+1), jaff(jhigh-jlow+1) - integer jatftn, jatffn - integer jatft(jhigh-jlow+1), jatff(jhigh-jlow+1) - integer jafftn1, jafffn1 - integer jafft1(jhigh-jlow+1), jafff1(jhigh-jlow+1) - integer jafftn2, jafffn2 - integer jafft2(jhigh-jlow+1), jafff2(jhigh-jlow+1) - real (r8) qsum((-im/3)-1:im+im/3,jlow:jhigh) ! work arrays - - - jatn = 0 - jafn = 0 - jattn = 0 - jatfn = 0 - jaftn = 0 - jaffn = 0 - jatftn = 0 - jatffn = 0 - jafftn1 = 0 - jafffn1 = 0 - jafftn2 = 0 - jafffn2 = 0 -!call ftrace_region_begin("xtpv_1") - do j = jlow, jhigh - if (ffslv(j)) then - jatn = jatn + 1 - jat(jatn) = j - if( iord == 1 .or. cosav(j) < cos_upw) then - jattn = jattn + 1 - jatt(jattn) = j - else - jatfn = jatfn + 1 - jatf(jatfn) = j - if(iord .ge. 3 .and. cosav(j) .gt. cos_ppm) then - jatftn = jatftn + 1 - jatft(jatftn) = j - else - jatffn = jatffn + 1 - jatff(jatffn) = j - endif - endif - else - jafn = jafn + 1 - jaf(jafn) = j - if( iord == 1 .or. cosav(j) < cos_upw) then - jaftn = jaftn + 1 - jaft(jaftn) = j - else - jaffn = jaffn + 1 - jaff(jaffn) = j - if(iord > 0 .or. cosav(j) < cos_van) then - jafftn1 = jafftn1 + 1 - jafft1(jafftn1) = j - else - jafffn1 = jafffn1 + 1 - jafff1(jafffn1) = j - endif - if( abs(iord).eq.2 .or. cosav(j) .lt. cos_van ) then - jafftn2 = jafftn2 + 1 - jafft2(jafftn2) = j - else - jafffn2 = jafffn2 + 1 - jafff2(jafffn2) = j - endif - endif - endif - enddo -!call ftrace_region_end("xtpv_1") - - imp = im + 1 - - do j = jlow, jhigh - do i=1,im - qtmpv(i,j) = qv(i,j) - enddo - enddo - -! Flux-Form Semi-Lagrangian transport - -!call ftrace_region_begin("xtpv_2") - do ja = 1, jatn - j = jat(ja) - -! Figure out ghost zone for the western edge: - iuwv(j) = -cv(1,j) - iuwv(j) = min(0, iuwv(j)) - - do i=iuwv(j), 0 - qtmpv(i,j) = qv(im+i,j) - enddo - -! Figure out ghost zone for the eastern edge: - iuev(j) = im - cv(im,j) - iuev(j) = max(imp, iuev(j)) - - do i=imp, iuev(j) - qtmpv(i,j) = qv(i-im,j) - enddo - - enddo -!call ftrace_region_end("xtpv_2") - -!call ftrace_region_begin("xtpv_3") - do ja = 1, jattn - j = jatt(ja) - - do i=1,im - iu = cv(i,j) - if(cv(i,j) .le. D0_0) then - itmp = i - iu - isave(i,j) = itmp - 1 - else - itmp = i - iu - 1 - isave(i,j) = itmp + 1 - endif - fxv(i,j) = (cv(i,j)-iu) * qtmpv(itmp,j) - enddo - - enddo -!call ftrace_region_end("xtpv_3") - -!call ftrace_region_begin("xtpv_4") - do ja = 1, jatfn - j = jatf(ja) - - do i=1,im -! 2nd order slope - tmp = D0_25*(qtmpv(i+1,j) - qtmpv(i-1,j)) - qmax = max(qtmpv(i-1,j), qtmpv(i,j), qtmpv(i+1,j)) - qtmpv(i,j) - qmin = qtmpv(i,j) - min(qtmpv(i-1,j), qtmpv(i,j), qtmpv(i+1,j)) - dmv(i,j) = sign(min(abs(tmp),qmax,qmin), tmp) - enddo - - do i=iuwv(j), 0 - dmv(i,j) = dmv(im+i,j) - enddo - - do i=imp, iuev(j) - dmv(i,j) = dmv(i-im,j) - enddo - - enddo -!call ftrace_region_end("xtpv_4") - - call fxppmv(im, cv, mfxv, qtmpv, dmv, fxv, iord, & - iuwv, iuev, ffslv, isave, jatftn, jatft, jlow, jhigh, & - jl2, jh2, jl3, jh3, jl5, jh5, jl7, jh7, jl11, jh11) - -!call ftrace_region_begin("xtpv_5") - do ja = 1, jatffn - j = jatff(ja) - - do i=1,im - iu = cv(i,j) - rut = cv(i,j) - iu - if(cv(i,j) .le. D0_0) then - itmp = i - iu - isave(i,j) = itmp - 1 - fxv(i,j) = rut*(qtmpv(itmp,j)-dmv(itmp,j)*(D1_0+rut)) - else - itmp = i - iu - 1 - isave(i,j) = itmp + 1 - fxv(i,j) = rut*(qtmpv(itmp,j)+dmv(itmp,j)*(D1_0-rut)) - endif - enddo - - enddo -!call ftrace_region_end("xtpv_5") - -!call ftrace_region_begin("xtpv_6") - do ja = 1, jatn - j = jat(ja) - qsum(iuwv(j)-1,j) = D0_0 - do i = iuwv(j), iuev(j) - qsum(i,j) = qsum(i-1,j) + qtmpv(i,j) - end do - -! -! The boolean terms: -! a) .and. (isave(i,j) < i) -! b) .and. (i <= isave(i,j)) -! are needed in the IF statements below because I cannot prove to myself -! that the relationship between i and isave are such to guarantee that -! there is always at least one term from qsum (qtmpv,j) contributed to fxv. -! - - do i=1,im - if(cv(i,j) >= D1_0 .and. (isave(i,j) < i) ) then - fxv(i,j) = fxv(i,j) + (qsum(i-1,j) - qsum(isave(i,j) - 1,j)) - else if (cv(i,j) <= -D1_0 .and. (i <= isave(i,j)) ) then - fxv(i,j) = fxv(i,j) - (qsum(isave(i,j),j) - qsum(i-1,j)) - end if - end do - - if(id .ne. 0) then - do i=1,im - fxv(i,j) = fxv(i,j)*mfxv(i,j) - enddo - endif - - enddo -!call ftrace_region_end("xtpv_6") - -! Regular PPM (Eulerian without FFSL extension) - -!call ftrace_region_begin("xtpv_7") - do ja = 1, jafn - j = jaf(ja) - - qtmpv(imp,j) = qv(1,j) - qtmpv( 0,j) = qv(im,j) - enddo - - do ja = 1, jaftn - j = jaft(ja) - - do i=1,im - iu = real(i,r8) - cv(i,j) - fxv(i,j) = mfxv(i,j)*qtmpv(iu,j) - enddo - enddo - - do ja = 1, jaffn - j = jaff(ja) - - qtmpv(-1,j) = qv(im-1,j) - qtmpv(imp+1,j) = qv(2,j) - - enddo -!call ftrace_region_end("xtpv_7") - -!call ftrace_region_begin("xtpv_8") - do ja = 1, jafftn1 - j = jafft1(ja) - -! In-line xmist - - do i=1,im - dmv(i,j) = r24*(D8_0*(qtmpv(i+1,j) - qtmpv(i-1,j)) + qtmpv(i-2,j) - qtmpv(i+2,j)) - enddo - -! Apply monotonicity constraint (Lin et al. 1994, MWR) - do i=1,im - qmax = max( qtmpv(i-1,j), qtmpv(i,j), qtmpv(i+1,j) ) - qtmpv(i,j) - qmin = qtmpv(i,j) - min( qtmpv(i-1,j), qtmpv(i,j), qtmpv(i+1,j) ) - dmv(i,j) = sign( min(abs(dmv(i,j)), qmax, qmin), dmv(i,j) ) - enddo - - enddo -!call ftrace_region_end("xtpv_8") - -!call ftrace_region_begin("xtpv_9") - do ja = 1, jafffn1 - j = jafff1(ja) - -! In-line xmist - - if(iord .le. 2) then - do i=1,im - dmv(i,j) = r24*(D8_0*(qtmpv(i+1,j) - qtmpv(i-1,j)) + qtmpv(i-2,j) - qtmpv(i+2,j)) - enddo - else - do i=1,im - dmv(i,j) = D0_25*(qtmpv(i+1,j) - qtmpv(i-1,j)) - enddo - endif - - if( iord >= 0 ) then - -! Apply monotonicity constraint (Lin et al. 1994, MWR) - do i=1,im - qmax = max( qtmpv(i-1,j), qtmpv(i,j), qtmpv(i+1,j) ) - qtmpv(i,j) - qmin = qtmpv(i,j) - min( qtmpv(i-1,j), qtmpv(i,j), qtmpv(i+1,j) ) - dmv(i,j) = sign( min(abs(dmv(i,j)), qmax, qmin), dmv(i,j) ) - enddo - endif - - enddo -!call ftrace_region_end("xtpv_9") - -!call ftrace_region_begin("xtpv_10") - do ja = 1, jaffn - j = jaff(ja) - - dmv(0,j) = dmv(im,j) - - enddo -!call ftrace_region_end("xtpv_10") - -!call ftrace_region_begin("xtpv_11") - do ja = 1, jafftn2 - j = jafft2(ja) - - do i=1,im - iu = real(i,r8) - cv(i,j) - fxv(i,j) = mfxv(i,j)*(qtmpv(iu,j)+dmv(iu,j)*(sign(D1_0,cv(i,j))-cv(i,j))) - enddo - - enddo -!call ftrace_region_end("xtpv_11") - - call fxppmv(im, cv, mfxv, qtmpv, dmv, fxv, iord, & - iuwv, iuev, ffslv, isave, jafffn2, jafff2, jlow, jhigh, & - jl2, jh2, jl3, jh3, jl5, jh5, jl7, jh7, jl11, jh11) - - return -!EOC - end subroutine xtpv -!----------------------------------------------------------------------- - -!----------------------------------------------------------------------- -!BOP -! !IROUTINE: fxppmv -! -! !INTERFACE: - - subroutine fxppmv(im, c, mfx, p, dm, fx, iord, & - iuw, iue, ffsl, isave, jan, ja, jlow, jhigh, & - jl2, jh2, jl3, jh3, jl5, jh5, jl7, jh7, jl11, jh11) -!----------------------------------------------------------------------- -! -! !USES: - implicit none - -! !INPUT PARAMETERS: - integer jan, ja(jan), jlow, jhigh, jj, j - integer jl2, jh2, jl3, jh3, jl5, jh5, jl7, jh7, jl11, jh11 - integer im, iord - real (r8) c(im,jl5:jh5) - real (r8) p(-im/3:im+im/3,jl11:jh11) - real (r8) dm(-im/3:im+im/3,jlow:jhigh) - real (r8) mfx(im,jl7:jh7) - integer iuw(jlow:jhigh), iue(jlow:jhigh) - logical ffsl(jl2:jh2) - integer isave(im,jlow:jhigh) - -! !OUTPUT PARAMETERS: - real (r8) fx(im,jl3:jh3) - -! !DESCRIPTION: -! -! -! !REVISION HISTORY: -! 99.01.01 Lin Creation -! 01.03.27 Sawyer Additional ProTeX documentation -! -!EOP -!----------------------------------------------------------------------- -!BOC -! -! !LOCAL VARIABLES: - real (r8) r3, r23 - parameter ( r3 = D1_0/D3_0, r23 = D2_0/D3_0 ) - - integer i, lmt - integer iu, itmp - real (r8) ru - logical steep - real (r8) al(-im/3:im+im/3,jlow:jhigh) - real (r8) ar(-im/3:im+im/3,jlow:jhigh) - real (r8) a6(-im/3:im+im/3,jlow:jhigh) - - integer jbtn, jbfn - integer jbt(jan), jbf(jan) - integer ilow, ihigh - - ilow = -im/3 - ihigh = im + im/3 - - if( iord == 6 ) then - steep = .true. - else - steep = .false. - endif - - do jj = 1, jan - j = ja(jj) - - do i=1,im - al(i,j) = D0_5*(p(i-1,j)+p(i,j)) + (dm(i-1,j) - dm(i,j))*r3 - enddo - - enddo - - if (steep) then - - call steepxv( im, p, al, dm, jan, ja, jlow, jhigh, jl11, jh11 ) - - endif - - do jj = 1, jan - j = ja(jj) - - do i=1,im-1 - ar(i,j) = al(i+1,j) - enddo - ar(im,j) = al(1,j) - - enddo - - if(iord == 7) then - - call huynhv(im, ar, al, p, a6, dm, jan, ja, jlow, jhigh, jl11, jh11 ) - - else - - if(iord .eq. 3 .or. iord .eq. 5) then - - do jj = 1, jan - j = ja(jj) - - do i=1,im - a6(i,j) = D3_0*(p(i,j)+p(i,j) - (al(i,j)+ar(i,j))) - enddo - - enddo - endif - - lmt = iord - 3 - - call lmppmv( dm, a6, ar, al, p, im, lmt, jan, ja, ilow, ihigh, & - jlow, jhigh, jl11, jh11 ) - - endif - - jbtn = 0 - jbfn = 0 - do jj = 1, jan - j = ja(jj) - if( ffsl(j) ) then - jbtn = jbtn + 1 - jbt(jbtn) = j - else - jbfn = jbfn + 1 - jbf(jbfn) = j - endif - enddo - - do jj = 1, jbtn - j = jbt(jj) - - do i=iuw(j), 0 - al(i,j) = al(im+i,j) - ar(i,j) = ar(im+i,j) - a6(i,j) = a6(im+i,j) - enddo - - do i=im+1, iue(j) - al(i,j) = al(i-im,j) - ar(i,j) = ar(i-im,j) - a6(i,j) = a6(i-im,j) - enddo - - do i=1,im - iu = c(i,j) - ru = c(i,j) - iu - if(c(i,j) .gt. D0_0) then - itmp = i - iu - 1 - isave(i,j) = itmp + 1 - fx(i,j) = ru*(ar(itmp,j)+D0_5*ru*(al(itmp,j)-ar(itmp,j) + & - a6(itmp,j)*(D1_0-r23*ru)) ) - else - itmp = i - iu - isave(i,j) = itmp - 1 - fx(i,j) = ru*(al(itmp,j)-D0_5*ru*(ar(itmp,j)-al(itmp,j) + & - a6(itmp,j)*(D1_0+r23*ru)) ) - endif - enddo - - enddo - - do jj = 1, jbfn - j = jbf(jj) - - al(0,j) = al(im,j) - ar(0,j) = ar(im,j) - a6(0,j) = a6(im,j) - do i=1,im - if(c(i,j) .gt. D0_0) then - fx(i,j) = ar(i-1,j) + D0_5*c(i,j)*(al(i-1,j) - ar(i-1,j) + & - a6(i-1,j)*(D1_0-r23*c(i,j)) ) - else - fx(i,j) = al(i,j) - D0_5*c(i,j)*(ar(i,j) - al(i,j) + & - a6(i,j)*(D1_0+r23*c(i,j))) - endif - fx(i,j) = mfx(i,j) * fx(i,j) - enddo - - enddo - - return -!EOC - end subroutine fxppmv -!----------------------------------------------------------------------- - -!----------------------------------------------------------------------- -!BOP -! !IROUTINE: steepxv -! -! !INTERFACE: - subroutine steepxv(im, p, al, dm, jan, ja, jlow, jhigh, jl11, jh11 ) -!----------------------------------------------------------------------- - -! !USES: - implicit none - -! !INPUT PARAMETERS: - integer im - integer jan, ja(jan), jlow, jhigh, jl11, jh11 - real (r8) p(-im/3:im+im/3,jl11:jh11) - real (r8) dm(-im/3:im+im/3,jlow:jhigh) - -! !INPUT/OUTPUT PARAMETERS: - real (r8) al(im,jlow:jhigh) - -! !DESCRIPTION: -! -! -! !REVISION HISTORY: -! 99.01.01 Lin Creation -! 01.03.27 Sawyer Additional ProTeX documentation -! -!EOP -!----------------------------------------------------------------------- -!BOC -! -! !LOCAL VARIABLES: - integer i, jj, j - real (r8) r3 - parameter ( r3 = D1_0/D3_0 ) - - real (r8) dh(0:im,jlow:jhigh) - real (r8) d2(0:im+1,jlow:jhigh) - real (r8) eta(0:im,jlow:jhigh) - real (r8) xxx, bbb, ccc - - do jj = 1, jan - j = ja(jj) - - do i=0,im - dh(i,j) = p(i+1,j) - p(i,j) - enddo - -! Needs dh(0:im,j) - do i=1,im - d2(i,j) = dh(i,j) - dh(i-1,j) - enddo - d2(0,j) = d2(im,j) - d2(im+1,j) = d2(1,j) - -! needs p(-1:im+2,j), d2(0:im+1,j) - do i=1,im - if( d2(i+1,j)*d2(i-1,j).lt.D0_0 .and. p(i+1,j).ne.p(i-1,j) ) then - xxx = D1_0 - D0_5 * ( p(i+2,j) - p(i-2,j) ) / ( p(i+1,j) - p(i-1,j) ) - eta(i,j) = max(D0_0, min(xxx, D0_5) ) - else - eta(i,j) = D0_0 - endif - enddo - - eta(0,j) = eta(im,j) - -! needs eta(0:im,j), dh(0:im-1,j), dm(0:im,j) - do i=1,im - bbb = ( D2_0*eta(i,j ) - eta(i-1,j) ) * dm(i-1,j) - ccc = ( D2_0*eta(i-1,j) - eta(i,j ) ) * dm(i,j ) - al(i,j) = al(i,j) + D0_5*( eta(i-1,j) - eta(i,j)) * dh(i-1,j) + (bbb - ccc) * r3 - enddo - - enddo - - return -!EOC - end subroutine steepxv -!----------------------------------------------------------------------- - -!----------------------------------------------------------------------- -!BOP -! !IROUTINE: huynhv --- Enforce Huynh's 2nd constraint in 1D periodic domain -! -! !INTERFACE: - subroutine huynhv(im, ar, al, p, d2, d1, jan, ja, jlow, jhigh, jl11, jh11) -!----------------------------------------------------------------------- - -! !USES: - - implicit none - -! !INPUT PARAMETERS: - integer im - integer jan, ja(jan), jlow, jhigh, jl11, jh11 - real(r8) p(im,jl11:jh11) - -! !OUTPUT PARAMETERS: - real(r8) ar(im,jlow:jhigh) - real(r8) al(im,jlow:jhigh) - real(r8) d2(im,jlow:jhigh) - real(r8) d1(im,jlow:jhigh) - -! !DESCRIPTION: -! -! Enforce Huynh's 2nd constraint in 1D periodic domain -! -! !REVISION HISTORY: -! 99.01.01 Lin Creation -! 01.03.27 Sawyer Additional ProTeX documentation -! -!EOP -!----------------------------------------------------------------------- -!BOC -! -! !LOCAL VARIABLES: - integer i, jj, j - real(r8) pmp - real(r8) lac - real(r8) pmin - real(r8) pmax - - do jj = 1, jan - j = ja(jj) - -! Compute d1 and d2 - d1(1,j) = p(1,j) - p(im,j) - do i=2,im - d1(i,j) = p(i,j) - p(i-1,j) - enddo - - do i=1,im-1 - d2(i,j) = d1(i+1,j) - d1(i,j) - enddo - d2(im,j) = d1(1,j) - d1(im,j) - -! Constraint for AR -! i = 1 - pmp = p(1,j) + D2_0 * d1(1,j) - lac = p(1,j) + D0_5 * (d1(1,j)+d2(im,j)) + d2(im,j) - pmin = min(p(1,j), pmp, lac) - pmax = max(p(1,j), pmp, lac) - ar(1,j) = min(pmax, max(ar(1,j), pmin)) - - do i=2, im - pmp = p(i,j) + D2_0*d1(i,j) - lac = p(i,j) + D0_5*(d1(i,j)+d2(i-1,j)) + d2(i-1,j) - pmin = min(p(i,j), pmp, lac) - pmax = max(p(i,j), pmp, lac) - ar(i,j) = min(pmax, max(ar(i,j), pmin)) - enddo - -! Constraint for AL - do i=1, im-1 - pmp = p(i,j) - D2_0*d1(i+1,j) - lac = p(i,j) + D0_5*(d2(i+1,j)-d1(i+1,j)) + d2(i+1,j) - pmin = min(p(i,j), pmp, lac) - pmax = max(p(i,j), pmp, lac) - al(i,j) = min(pmax, max(al(i,j), pmin)) - enddo - -! i=im - i = im - pmp = p(im,j) - D2_0*d1(1,j) - lac = p(im,j) + D0_5*(d2(1,j)-d1(1,j)) + d2(1,j) - pmin = min(p(im,j), pmp, lac) - pmax = max(p(im,j), pmp, lac) - al(im,j) = min(pmax, max(al(im,j), pmin)) - -! compute A6 (d2) - do i=1, im - d2(i,j) = D3_0*(p(i,j)+p(i,j) - (al(i,j)+ar(i,j))) - enddo - - enddo - - return -!EOC - end subroutine huynhv -!----------------------------------------------------------------------- - -!----------------------------------------------------------------------- -!BOP -! !IROUTINE: lmppmv -! -! !INTERFACE: - subroutine lmppmv(dm, a6, ar, al, p, im, lmt, jan, ja, & - ilow, ihigh, jlow, jhigh, jl11, jh11) -!----------------------------------------------------------------------- - - implicit none - -! !INPUT PARAMETERS: - integer im ! Total longitudes - integer jan, ja(jan), ilow, ihigh, jlow, jhigh, jl11, jh11 - integer lmt ! LMT = 0: full monotonicity - ! LMT = 1: Improved and simplified full monotonic constraint - ! LMT = 2: positive-definite constraint - ! LMT = 3: Quasi-monotone constraint - real(r8) p(ilow:ihigh,jl11:jh11) - real(r8) dm(ilow:ihigh,jlow:jhigh) - -! !OUTPUT PARAMETERS: - real(r8) a6(ilow:ihigh,jlow:jhigh) - real(r8) ar(ilow:ihigh,jlow:jhigh) - real(r8) al(ilow:ihigh,jlow:jhigh) - -! !DESCRIPTION: -! -! -! !REVISION HISTORY: -! 99.01.01 Lin Creation -! 01.03.27 Sawyer Additional ProTeX documentation -! -!EOP -!----------------------------------------------------------------------- -!BOC -! -! !LOCAL VARIABLES: - real (r8) r12 - parameter ( r12 = D1_0/D12_0 ) - - real (r8) da1, da2, fmin, a6da - real (r8) dr, dl - - integer i, jj, j - -! LMT = 0: full monotonicity -! LMT = 1: Improved and simplified full monotonic constraint -! LMT = 2: positive-definite constraint -! LMT = 3: Quasi-monotone constraint - - if( lmt == 0 ) then - -! Full constraint - - do jj = 1, jan - j = ja(jj) - - do i=1,im - if(dm(i,j) .eq. D0_0) then - ar(i,j) = p(i,j) - al(i,j) = p(i,j) - a6(i,j) = D0_0 - else - da1 = ar(i,j) - al(i,j) - da2 = da1**2 - a6da = a6(i,j)*da1 - if(a6da .lt. -da2) then - a6(i,j) = D3_0*(al(i,j)-p(i,j)) - ar(i,j) = al(i,j) - a6(i,j) - elseif(a6da .gt. da2) then - a6(i,j) = D3_0*(ar(i,j)-p(i,j)) - al(i,j) = ar(i,j) - a6(i,j) - endif - endif - enddo - - enddo - - elseif( lmt == 1 ) then - -! Improved (Lin 2001?) full constraint - - do jj = 1, jan - j = ja(jj) - - do i=1,im - da1 = dm(i,j) + dm(i,j) - dl = sign(min(abs(da1),abs(al(i,j)-p(i,j))), da1) - dr = sign(min(abs(da1),abs(ar(i,j)-p(i,j))), da1) - ar(i,j) = p(i,j) + dr - al(i,j) = p(i,j) - dl - a6(i,j) = D3_0*(dl-dr) - enddo - - enddo - - elseif( lmt == 2 ) then - -! Positive definite constraint - - do jj = 1, jan - j = ja(jj) - - do i=1,im - if(abs(ar(i,j)-al(i,j)) .lt. -a6(i,j)) then - fmin = p(i,j) + D0_25*(ar(i,j)-al(i,j))**2/a6(i,j) + a6(i,j)*r12 - if(fmin.lt.D0_0) then - if(p(i,j).lt.ar(i,j) .and. p(i,j).lt.al(i,j)) then - ar(i,j) = p(i,j) - al(i,j) = p(i,j) - a6(i,j) = D0_0 - elseif(ar(i,j) .gt. al(i,j)) then - a6(i,j) = D3_0*(al(i,j)-p(i,j)) - ar(i,j) = al(i,j) - a6(i,j) - else - a6(i,j) = D3_0*(ar(i,j)-p(i,j)) - al(i,j) = ar(i,j) - a6(i,j) - endif - endif - endif - enddo - - enddo - - elseif(lmt .eq. 3) then - -! Quasi-monotone constraint - - do jj = 1, jan - j = ja(jj) - - do i=1,im - da1 = D4_0*dm(i,j) - dl = sign(min(abs(da1),abs(al(i,j)-p(i,j))), da1) - dr = sign(min(abs(da1),abs(ar(i,j)-p(i,j))), da1) - ar(i,j) = p(i,j) + dr - al(i,j) = p(i,j) - dl - a6(i,j) = D3_0*(dl-dr) - enddo - - enddo - - endif - return -!EOC - end subroutine lmppmv -!----------------------------------------------------------------------- -#endif - -end module tp_core diff --git a/src/physics/cam/cam_diagnostics.F90.orig b/src/physics/cam/cam_diagnostics.F90.orig deleted file mode 100644 index 8b046924d1..0000000000 --- a/src/physics/cam/cam_diagnostics.F90.orig +++ /dev/null @@ -1,2233 +0,0 @@ -module cam_diagnostics - -!--------------------------------------------------------------------------------- -! Module to compute a variety of diagnostics quantities for history files -!--------------------------------------------------------------------------------- - -use shr_kind_mod, only: r8 => shr_kind_r8 -use camsrfexch, only: cam_in_t, cam_out_t -use cam_control_mod, only: moist_physics -use physics_types, only: physics_state, physics_tend -use ppgrid, only: pcols, pver, begchunk, endchunk -use physics_buffer, only: physics_buffer_desc, pbuf_add_field, dtype_r8 -use physics_buffer, only: dyn_time_lvls, pbuf_get_field, pbuf_get_index, pbuf_old_tim_idx - -use cam_history, only: outfld, write_inithist, hist_fld_active, inithist_all -use constituents, only: pcnst, cnst_name, cnst_longname, cnst_cam_outfld -use constituents, only: ptendnam, dmetendnam, apcnst, bpcnst, cnst_get_ind -use dycore, only: dycore_is -use phys_control, only: phys_getopts -use wv_saturation, only: qsat, qsat_water, svp_ice -use time_manager, only: is_first_step - -use scamMod, only: single_column, wfld -use cam_abortutils, only: endrun - -implicit none -private -save - -! Public interfaces - -public :: & - diag_readnl, &! read namelist options - diag_register, &! register pbuf space - diag_init, &! initialization - diag_allocate, &! allocate memory for module variables - diag_deallocate, &! deallocate memory for module variables - diag_conv_tend_ini, &! initialize convective tendency calcs - diag_phys_writeout, &! output diagnostics of the dynamics - diag_phys_tend_writeout, &! output physics tendencies - diag_state_b4_phys_write, &! output state before physics execution - diag_conv, &! output diagnostics of convective processes - diag_surf, &! output diagnostics of the surface - diag_export, &! output export state - diag_physvar_ic, & - nsurf - - -! Private data - -integer :: dqcond_num ! number of constituents to compute convective -character(len=16) :: dcconnam(pcnst) ! names of convection tendencies - ! tendencies for -real(r8), allocatable :: dtcond(:,:,:) ! temperature tendency due to convection -type dqcond_t - real(r8), allocatable :: cnst(:,:,:) ! constituent tendency due to convection -end type dqcond_t -type(dqcond_t), allocatable :: dqcond(:) - -character(len=8) :: diag_cnst_conv_tend = 'q_only' ! output constituent tendencies due to convection - ! 'none', 'q_only' or 'all' - -integer, parameter :: surf_100000 = 1 -integer, parameter :: surf_092500 = 2 -integer, parameter :: surf_085000 = 3 -integer, parameter :: surf_070000 = 4 -integer, parameter :: nsurf = 4 - -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_eddy ! output the eddy variables -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 -logical :: history_waccm ! outputs typically used for WACCM - -! Physics buffer indices - -integer :: psl_idx = 0 -integer :: relhum_idx = 0 -integer :: qcwat_idx = 0 -integer :: tcwat_idx = 0 -integer :: lcwat_idx = 0 -integer :: cld_idx = 0 -integer :: concld_idx = 0 -integer :: tke_idx = 0 -integer :: kvm_idx = 0 -integer :: kvh_idx = 0 -integer :: cush_idx = 0 -integer :: t_ttend_idx = 0 - -integer :: prec_dp_idx = 0 -integer :: snow_dp_idx = 0 -integer :: prec_sh_idx = 0 -integer :: snow_sh_idx = 0 -integer :: prec_sed_idx = 0 -integer :: snow_sed_idx = 0 -integer :: prec_pcw_idx = 0 -integer :: snow_pcw_idx = 0 - - -integer :: tpert_idx=-1, qpert_idx=-1, pblh_idx=-1 - -integer :: trefmxav_idx = -1, trefmnav_idx = -1 - -contains - -!============================================================================== - - subroutine diag_readnl(nlfile) - use namelist_utils, only: find_group_name - use units, only: getunit, freeunit - use spmd_utils, only: masterproc, masterprocid, mpi_character, mpicom - - character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input - - ! Local variables - integer :: unitn, ierr - character(len=*), parameter :: subname = 'diag_readnl' - - namelist /cam_diag_opts/ diag_cnst_conv_tend - !-------------------------------------------------------------------------- - - if (masterproc) then - unitn = getunit() - open( unitn, file=trim(nlfile), status='old' ) - call find_group_name(unitn, 'cam_diag_opts', status=ierr) - if (ierr == 0) then - read(unitn, cam_diag_opts, 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(diag_cnst_conv_tend, len(diag_cnst_conv_tend), mpi_character, masterprocid, mpicom, ierr) - - end subroutine diag_readnl - -!============================================================================== - - subroutine diag_register_dry() - - call pbuf_add_field('PSL', 'physpkg', dtype_r8, (/pcols/), psl_idx) - - ! Request physics buffer space for fields that persist across timesteps. - call pbuf_add_field('T_TTEND', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), t_ttend_idx) - end subroutine diag_register_dry - - subroutine diag_register_moist() - ! Request physics buffer space for fields that persist across timesteps. - call pbuf_add_field('TREFMXAV', 'global', dtype_r8, (/pcols/), trefmxav_idx) - call pbuf_add_field('TREFMNAV', 'global', dtype_r8, (/pcols/), trefmnav_idx) - end subroutine diag_register_moist - - subroutine diag_register() - call diag_register_dry() - if (moist_physics) then - call diag_register_moist() - end if - end subroutine diag_register - -!============================================================================== - - subroutine diag_init_dry(pbuf2d) - ! Declare the history fields for which this module contains outfld calls. - - use cam_history, only: addfld, add_default, horiz_only - use cam_history, only: register_vector_field - use constituent_burden, only: constituent_burden_init - use physics_buffer, only: pbuf_set_field - use tidal_diag, only: tidal_diag_init - - type(physics_buffer_desc), pointer, intent(in) :: pbuf2d(:,:) - - integer :: k, m - integer :: ierr - - ! outfld calls in diag_phys_writeout - call addfld (cnst_name(1), (/ 'lev' /), 'A', 'kg/kg', cnst_longname(1)) - call addfld ('NSTEP', horiz_only, 'A', 'timestep', 'Model timestep') - call addfld ('PHIS', horiz_only, 'I', 'm2/s2', 'Surface geopotential') - - call addfld ('PS', horiz_only, 'A', 'Pa', 'Surface pressure') - call addfld ('T', (/ 'lev' /), 'A', 'K', 'Temperature') - call addfld ('U', (/ 'lev' /), 'A', 'm/s', 'Zonal wind') - call addfld ('V', (/ 'lev' /), 'A', 'm/s', 'Meridional wind') - - call register_vector_field('U','V') - - ! State before physics - call addfld ('TBP', (/ 'lev' /), 'A','K', 'Temperature (before physics)') - call addfld (bpcnst(1), (/ 'lev' /), 'A','kg/kg', trim(cnst_longname(1))//' (before physics)') - ! State after physics - call addfld ('TAP', (/ 'lev' /), 'A','K', 'Temperature (after physics)' ) - call addfld ('UAP', (/ 'lev' /), 'A','m/s', 'Zonal wind (after physics)' ) - call addfld ('VAP', (/ 'lev' /), 'A','m/s', 'Meridional wind (after physics)' ) - - call register_vector_field('UAP','VAP') - - call addfld (apcnst(1), (/ 'lev' /), 'A','kg/kg', trim(cnst_longname(1))//' (after physics)') - if ( dycore_is('LR') .or. dycore_is('SE') ) then - call addfld ('TFIX', horiz_only, 'A', 'K/s', 'T fixer (T equivalent of Energy correction)') - end if - call addfld ('TTEND_TOT', (/ 'lev' /), 'A', 'K/s', 'Total temperature tendency') - - call addfld ('Z3', (/ 'lev' /), 'A', 'm', 'Geopotential Height (above sea level)') - call addfld ('Z1000', horiz_only, 'A', 'm', 'Geopotential Z at 1000 mbar pressure surface') - call addfld ('Z700', horiz_only, 'A', 'm', 'Geopotential Z at 700 mbar pressure surface') - call addfld ('Z500', horiz_only, 'A', 'm', 'Geopotential Z at 500 mbar pressure surface') - call addfld ('Z300', horiz_only, 'A', 'm', 'Geopotential Z at 300 mbar pressure surface') - call addfld ('Z200', horiz_only, 'A', 'm', 'Geopotential Z at 200 mbar pressure surface') - call addfld ('Z100', horiz_only, 'A', 'm', 'Geopotential Z at 100 mbar pressure surface') - call addfld ('Z050', horiz_only, 'A', 'm', 'Geopotential Z at 50 mbar pressure surface') - - call addfld ('ZZ', (/ 'lev' /), 'A', 'm2', 'Eddy height variance' ) - call addfld ('VZ', (/ 'lev' /), 'A', 'm2/s', 'Meridional transport of geopotential height') - call addfld ('VT', (/ 'lev' /), 'A', 'K m/s ', 'Meridional heat transport') - call addfld ('VU', (/ 'lev' /), 'A', 'm2/s2', 'Meridional flux of zonal momentum' ) - call addfld ('VV', (/ 'lev' /), 'A', 'm2/s2', 'Meridional velocity squared' ) - call addfld ('OMEGAV', (/ 'lev' /), 'A', 'm Pa/s2 ', 'Vertical flux of meridional momentum' ) - call addfld ('OMGAOMGA', (/ 'lev' /), 'A', 'Pa2/s2', 'Vertical flux of vertical momentum' ) - - call addfld ('UU', (/ 'lev' /), 'A', 'm2/s2', 'Zonal velocity squared' ) - call addfld ('WSPEED', (/ 'lev' /), 'X', 'm/s', 'Horizontal total wind speed maximum' ) - call addfld ('WSPDSRFMX', horiz_only, 'X', 'm/s', 'Horizontal total wind speed maximum at the surface' ) - call addfld ('WSPDSRFAV', horiz_only, 'A', 'm/s', 'Horizontal total wind speed average at the surface' ) - - call addfld ('OMEGA', (/ 'lev' /), 'A', 'Pa/s', 'Vertical velocity (pressure)') - call addfld ('OMEGAT', (/ 'lev' /), 'A', 'K Pa/s ', 'Vertical heat flux' ) - call addfld ('OMEGAU', (/ 'lev' /), 'A', 'm Pa/s2 ', 'Vertical flux of zonal momentum' ) - call addfld ('OMEGA850', horiz_only, 'A', 'Pa/s', 'Vertical velocity at 850 mbar pressure surface') - call addfld ('OMEGA500', horiz_only, 'A', 'Pa/s', 'Vertical velocity at 500 mbar pressure surface') - - call addfld ('PSL', horiz_only, 'A', 'Pa','Sea level pressure') - - call addfld ('T1000', horiz_only, 'A', 'K','Temperature at 1000 mbar pressure surface') - call addfld ('T925', horiz_only, 'A', 'K','Temperature at 925 mbar pressure surface') - call addfld ('T850', horiz_only, 'A', 'K','Temperature at 850 mbar pressure surface') - call addfld ('T700', horiz_only, 'A', 'K','Temperature at 700 mbar pressure surface') - call addfld ('T500', horiz_only, 'A', 'K','Temperature at 500 mbar pressure surface') - call addfld ('T400', horiz_only, 'A', 'K','Temperature at 400 mbar pressure surface') - call addfld ('T300', horiz_only, 'A', 'K','Temperature at 300 mbar pressure surface') - call addfld ('T200', horiz_only, 'A', 'K','Temperature at 200 mbar pressure surface') - call addfld ('T010', horiz_only, 'A', 'K','Temperature at 10 mbar pressure surface') - - call addfld ('T7001000', horiz_only, 'A', 'K','Temperature difference 700 mb - 1000 mb') - call addfld ('TH7001000', horiz_only, 'A', 'K','Theta difference 700 mb - 1000 mb') - call addfld ('THE7001000', horiz_only, 'A', 'K','ThetaE difference 700 mb - 1000 mb') - - call addfld ('T8501000', horiz_only, 'A', 'K','Temperature difference 850 mb - 1000 mb') - call addfld ('TH8501000', horiz_only, 'A', 'K','Theta difference 850 mb - 1000 mb') - call addfld ('T9251000', horiz_only, 'A', 'K','Temperature difference 925 mb - 1000 mb') - call addfld ('TH9251000', horiz_only, 'A', 'K','Theta difference 925 mb - 1000 mb') - - call addfld ('TT', (/ 'lev' /), 'A', 'K2','Eddy temperature variance' ) - - call addfld ('U850', horiz_only, 'A', 'm/s','Zonal wind at 850 mbar pressure surface') - call addfld ('U500', horiz_only, 'A', 'm/s','Zonal wind at 500 mbar pressure surface') - call addfld ('U250', horiz_only, 'A', 'm/s','Zonal wind at 250 mbar pressure surface') - call addfld ('U200', horiz_only, 'A', 'm/s','Zonal wind at 200 mbar pressure surface') - call addfld ('U010', horiz_only, 'A', 'm/s','Zonal wind at 10 mbar pressure surface') - call addfld ('V850', horiz_only, 'A', 'm/s','Meridional wind at 850 mbar pressure surface') - call addfld ('V500', horiz_only, 'A', 'm/s','Meridional wind at 500 mbar pressure surface') - call addfld ('V250', horiz_only, 'A', 'm/s','Meridional wind at 250 mbar pressure surface') - call addfld ('V200', horiz_only, 'A', 'm/s','Meridional wind at 200 mbar pressure surface') - - call register_vector_field('U850', 'V850') - call register_vector_field('U500', 'V500') - call register_vector_field('U250', 'V250') - call register_vector_field('U200', 'V200') - - call addfld ('UBOT', horiz_only, 'A', 'm/s','Lowest model level zonal wind') - call addfld ('VBOT', horiz_only, 'A', 'm/s','Lowest model level meridional wind') - call register_vector_field('UBOT', 'VBOT') - - call addfld ('ZBOT', horiz_only, 'A', 'm','Lowest model level height') - - call addfld ('ATMEINT', horiz_only, 'A', 'J/m2','Vertically integrated total atmospheric energy ') - - if (history_amwg) then - call add_default ('PHIS ' , 1, ' ') - call add_default ('PS ' , 1, ' ') - call add_default ('T ' , 1, ' ') - call add_default ('U ' , 1, ' ') - call add_default ('V ' , 1, ' ') - call add_default ('Z3 ' , 1, ' ') - call add_default ('OMEGA ' , 1, ' ') - call add_default ('VT ', 1, ' ') - call add_default ('VU ', 1, ' ') - call add_default ('VV ', 1, ' ') - call add_default ('UU ', 1, ' ') - call add_default ('OMEGAT ', 1, ' ') - call add_default ('PSL ', 1, ' ') - end if - - if (history_vdiag) then - call add_default ('U200', 2, ' ') - call add_default ('V200', 2, ' ') - call add_default ('U850', 2, ' ') - call add_default ('U200', 3, ' ') - call add_default ('U850', 3, ' ') - call add_default ('OMEGA500', 3, ' ') - end if - - if (history_eddy) then - call add_default ('VT ', 1, ' ') - call add_default ('VU ', 1, ' ') - call add_default ('VV ', 1, ' ') - call add_default ('UU ', 1, ' ') - call add_default ('OMEGAT ', 1, ' ') - call add_default ('OMEGAU ', 1, ' ') - call add_default ('OMEGAV ', 1, ' ') - endif - - if ( history_budget ) then - call add_default ('PHIS ' , history_budget_histfile_num, ' ') - call add_default ('PS ' , history_budget_histfile_num, ' ') - call add_default ('T ' , history_budget_histfile_num, ' ') - call add_default ('U ' , history_budget_histfile_num, ' ') - call add_default ('V ' , history_budget_histfile_num, ' ') - call add_default ('TTEND_TOT' , history_budget_histfile_num, ' ') - - ! State before physics (FV) - call add_default ('TBP ' , history_budget_histfile_num, ' ') - call add_default (bpcnst(1) , history_budget_histfile_num, ' ') - ! State after physics (FV) - call add_default ('TAP ' , history_budget_histfile_num, ' ') - call add_default ('UAP ' , history_budget_histfile_num, ' ') - call add_default ('VAP ' , history_budget_histfile_num, ' ') - call add_default (apcnst(1) , history_budget_histfile_num, ' ') - if ( dycore_is('LR') .or. dycore_is('SE') ) then - call add_default ('TFIX ' , history_budget_histfile_num, ' ') - end if - end if - - if (history_waccm) then - call add_default ('PHIS', 7, ' ') - call add_default ('PS', 7, ' ') - call add_default ('PSL', 7, ' ') - end if - - ! outfld calls in diag_phys_tend_writeout - call addfld ('PTTEND', (/ 'lev' /), 'A', 'K/s','T total physics tendency' ) - if ( history_budget ) then - call add_default ('PTTEND' , history_budget_histfile_num, ' ') - end if - - ! create history variables for fourier coefficients of the diurnal - ! and semidiurnal tide in T, U, V, and Z3 - call tidal_diag_init() - - ! - ! energy diagnostics - ! - call addfld ('SE_pBF', horiz_only, 'A', 'J/m2','Dry Static Energy before energy fixer') - call addfld ('SE_pBP', horiz_only, 'A', 'J/m2','Dry Static Energy before parameterizations') - call addfld ('SE_pAP', horiz_only, 'A', 'J/m2','Dry Static Energy after parameterizations') - call addfld ('SE_pAM', horiz_only, 'A', 'J/m2','Dry Static Energy after dry mass correction') - - call addfld ('KE_pBF', horiz_only, 'A', 'J/m2','Kinetic Energy before energy fixer') - call addfld ('KE_pBP', horiz_only, 'A', 'J/m2','Kinetic Energy before parameterizations') - call addfld ('KE_pAP', horiz_only, 'A', 'J/m2','Kinetic Energy after parameterizations') - call addfld ('KE_pAM', horiz_only, 'A', 'J/m2','Kinetic Energy after dry mass correction') - - call addfld ('TT_pBF', horiz_only, 'A', 'kg/m2','Total column test tracer before energy fixer') - call addfld ('TT_pBP', horiz_only, 'A', 'kg/m2','Total column test tracer before parameterizations') - call addfld ('TT_pAP', horiz_only, 'A', 'kg/m2','Total column test tracer after parameterizations') - call addfld ('TT_pAM', horiz_only, 'A', 'kg/m2','Total column test tracer after dry mass correction') - - call addfld ('WV_pBF', horiz_only, 'A', 'kg/m2','Total column water vapor before energy fixer') - call addfld ('WV_pBP', horiz_only, 'A', 'kg/m2','Total column water vapor before parameterizations') - call addfld ('WV_pAP', horiz_only, 'A', 'kg/m2','Total column water vapor after parameterizations') - call addfld ('WV_pAM', horiz_only, 'A', 'kg/m2','Total column water vapor after dry mass correction') - - call addfld ('WL_pBF', horiz_only, 'A', 'kg/m2','Total column cloud water before energy fixer') - call addfld ('WL_pBP', horiz_only, 'A', 'kg/m2','Total column cloud water before parameterizations') - call addfld ('WL_pAP', horiz_only, 'A', 'kg/m2','Total column cloud water after parameterizations') - call addfld ('WL_pAM', horiz_only, 'A', 'kg/m2','Total column cloud water after dry mass correction') - - call addfld ('WI_pBF', horiz_only, 'A', 'kg/m2','Total column cloud ice before energy fixer') - call addfld ('WI_pBP', horiz_only, 'A', 'kg/m2','Total column cloud ice before parameterizations') - call addfld ('WI_pAP', horiz_only, 'A', 'kg/m2','Total column cloud ice after parameterizations') - call addfld ('WI_pAM', horiz_only, 'A', 'kg/m2','Total column cloud ice after dry mass correction') - ! - ! Axial Angular Momentum diagnostics - ! - call addfld ('MR_pBF', horiz_only, 'A', 'kg*m2/s*rad2',& - 'Total column wind axial angular momentum before energy fixer') - call addfld ('MR_pBP', horiz_only, 'A', 'kg*m2/s*rad2',& - 'Total column wind axial angular momentum before parameterizations') - call addfld ('MR_pAP', horiz_only, 'A', 'kg*m2/s*rad2',& - 'Total column wind axial angular momentum after parameterizations') - call addfld ('MR_pAM', horiz_only, 'A', 'kg*m2/s*rad2',& - 'Total column wind axial angular momentum after dry mass correction') - - call addfld ('MO_pBF', horiz_only, 'A', 'kg*m2/s*rad2',& - 'Total column mass axial angular momentum before energy fixer') - call addfld ('MO_pBP', horiz_only, 'A', 'kg*m2/s*rad2',& - 'Total column mass axial angular momentum before parameterizations') - call addfld ('MO_pAP', horiz_only, 'A', 'kg*m2/s*rad2',& - 'Total column mass axial angular momentum after parameterizations') - call addfld ('MO_pAM', horiz_only, 'A', 'kg*m2/s*rad2',& - 'Total column mass axial angular momentum after dry mass correction') - - end subroutine diag_init_dry - - subroutine diag_init_moist(pbuf2d) - - ! Declare the history fields for which this module contains outfld calls. - - use cam_history, only: addfld, add_default, horiz_only - use cam_history, only: register_vector_field - use constituent_burden, only: constituent_burden_init - use physics_buffer, only: pbuf_set_field - - type(physics_buffer_desc), pointer, intent(in) :: pbuf2d(:,:) - - integer :: k, m - integer :: ixcldice, ixcldliq ! constituent indices for cloud liquid and ice water. - integer :: ierr - ! column burdens for all constituents except water vapor - call constituent_burden_init - - call cnst_get_ind('CLDLIQ', ixcldliq, abort=.false.) - call cnst_get_ind('CLDICE', ixcldice, abort=.false.) - - ! outfld calls in diag_phys_writeout - call addfld ('OMEGAQ', (/ 'lev' /), 'A', 'kgPa/kgs', 'Vertical water transport' ) - call addfld ('VQ', (/ 'lev' /), 'A', 'm/skg/kg', 'Meridional water transport') - call addfld ('QQ', (/ 'lev' /), 'A', 'kg2/kg2', 'Eddy moisture variance') - - call addfld ('MQ', (/ 'lev' /), 'A', 'kg/m2','Water vapor mass in layer') - call addfld ('TMQ', horiz_only, 'A', 'kg/m2','Total (vertically integrated) precipitable water') - call addfld ('RELHUM', (/ 'lev' /), 'A', 'percent','Relative humidity') - call addfld ('RHW', (/ 'lev' /), 'A', 'percent','Relative humidity with respect to liquid') - call addfld ('RHI', (/ 'lev' /), 'A', 'percent','Relative humidity with respect to ice') - call addfld ('RHCFMIP', (/ 'lev' /), 'A', 'percent','Relative humidity with respect to water above 273 K, ice below 273 K') - - call addfld ('THE8501000', horiz_only, 'A', 'K','ThetaE difference 850 mb - 1000 mb') - call addfld ('THE9251000', horiz_only, 'A', 'K','ThetaE difference 925 mb - 1000 mb') - - call addfld ('Q1000', horiz_only, 'A', 'kg/kg','Specific Humidity at 1000 mbar pressure surface') - call addfld ('Q925', horiz_only, 'A', 'kg/kg','Specific Humidity at 925 mbar pressure surface') - call addfld ('Q850', horiz_only, 'A', 'kg/kg','Specific Humidity at 850 mbar pressure surface') - call addfld ('Q200', horiz_only, 'A', 'kg/kg','Specific Humidity at 700 mbar pressure surface') - call addfld ('QBOT', horiz_only, 'A', 'kg/kg','Lowest model level water vapor mixing ratio') - - call addfld ('PSDRY', horiz_only, 'A', 'Pa', 'Dry surface pressure') - call addfld ('PMID', (/ 'lev' /), 'A', 'Pa', 'Pressure at layer midpoints') - call addfld ('PDELDRY', (/ 'lev' /), 'A', 'Pa', 'Dry pressure difference between levels') - - ! outfld calls in diag_conv - - call addfld ('DTCOND', (/ 'lev' /), 'A','K/s','T tendency - moist processes') - call addfld ('DTCOND_24_COS',(/ 'lev' /), 'A','K/s','T tendency - moist processes 24hr. cos coeff.') - call addfld ('DTCOND_24_SIN',(/ 'lev' /), 'A','K/s','T tendency - moist processes 24hr. sin coeff.') - call addfld ('DTCOND_12_COS',(/ 'lev' /), 'A','K/s','T tendency - moist processes 12hr. cos coeff.') - call addfld ('DTCOND_12_SIN',(/ 'lev' /), 'A','K/s','T tendency - moist processes 12hr. sin coeff.') - call addfld ('DTCOND_08_COS',(/ 'lev' /), 'A','K/s','T tendency - moist processes 8hr. cos coeff.') - call addfld ('DTCOND_08_SIN',(/ 'lev' /), 'A','K/s','T tendency - moist processes 8hr. sin coeff.') - - call addfld ('PRECL', horiz_only, 'A', 'm/s','Large-scale (stable) precipitation rate (liq + ice)' ) - call addfld ('PRECC', horiz_only, 'A', 'm/s','Convective precipitation rate (liq + ice)' ) - call addfld ('PRECT', horiz_only, 'A', 'm/s','Total (convective and large-scale) precipitation rate (liq + ice)' ) - call addfld ('PREC_PCW', horiz_only, 'A', 'm/s','LS_pcw precipitation rate') - call addfld ('PREC_zmc', horiz_only, 'A', 'm/s','CV_zmc precipitation rate') - call addfld ('PRECTMX', horiz_only, 'X','m/s','Maximum (convective and large-scale) precipitation rate (liq+ice)' ) - call addfld ('PRECSL', horiz_only, 'A', 'm/s','Large-scale (stable) snow rate (water equivalent)' ) - call addfld ('PRECSC', horiz_only, 'A', 'm/s','Convective snow rate (water equivalent)' ) - call addfld ('PRECCav', horiz_only, 'A', 'm/s','Average large-scale precipitation (liq + ice)' ) - call addfld ('PRECLav', horiz_only, 'A', 'm/s','Average convective precipitation (liq + ice)' ) - - ! outfld calls in diag_surf - - call addfld ('SHFLX', horiz_only, 'A', 'W/m2','Surface sensible heat flux') - call addfld ('LHFLX', horiz_only, 'A', 'W/m2','Surface latent heat flux') - call addfld ('QFLX', horiz_only, 'A', 'kg/m2/s','Surface water flux') - - call addfld ('TAUX', horiz_only, 'A', 'N/m2','Zonal surface stress') - call addfld ('TAUY', horiz_only, 'A', 'N/m2','Meridional surface stress') - call addfld ('TREFHT', horiz_only, 'A', 'K','Reference height temperature') - call addfld ('TREFHTMN', horiz_only, 'M','K','Minimum reference height temperature over output period') - 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 ('RHREFHT', horiz_only, 'A', 'fraction','Reference height relative humidity') - - call addfld ('LANDFRAC', horiz_only, 'A', 'fraction','Fraction of sfc area covered by land') - call addfld ('ICEFRAC', horiz_only, 'A', 'fraction','Fraction of sfc area covered by sea-ice') - call addfld ('OCNFRAC', horiz_only, 'A', 'fraction','Fraction of sfc area covered by ocean') - - call addfld ('TREFMNAV', horiz_only, 'A', 'K','Average of TREFHT daily minimum') - call addfld ('TREFMXAV', horiz_only, 'A', 'K','Average of TREFHT daily maximum') - - call addfld ('TS', horiz_only, 'A', 'K','Surface temperature (radiative)') - call addfld ('TSMN', horiz_only, 'M','K','Minimum surface temperature over output period') - call addfld ('TSMX', horiz_only, 'X','K','Maximum surface temperature over output period') - call addfld ('SNOWHLND', horiz_only, 'A', 'm','Water equivalent snow depth') - call addfld ('SNOWHICE', horiz_only, 'A', 'm','Snow depth over ice', fill_value = 1.e30_r8) - call addfld ('TBOT', horiz_only, 'A', 'K','Lowest model level temperature') - - call addfld ('ASDIR', horiz_only, 'A', '1','albedo: shortwave, direct') - call addfld ('ASDIF', horiz_only, 'A', '1','albedo: shortwave, diffuse') - call addfld ('ALDIR', horiz_only, 'A', '1','albedo: longwave, direct') - call addfld ('ALDIF', horiz_only, 'A', '1','albedo: longwave, diffuse') - call addfld ('SST', horiz_only, 'A', 'K','sea surface temperature') - - - ! outfld calls in diag_phys_tend_writeout - - call addfld (ptendnam( 1),(/ 'lev' /), 'A', 'kg/kg/s',trim(cnst_name( 1))//' total physics tendency ' ) - - if (ixcldliq > 0) then - call addfld (ptendnam(ixcldliq),(/ 'lev' /), 'A', 'kg/kg/s',trim(cnst_name(ixcldliq))//' total physics tendency ' ) - end if - if (ixcldice > 0) then - call addfld (ptendnam(ixcldice),(/ 'lev' /), 'A', 'kg/kg/s',trim(cnst_name(ixcldice))//' total physics tendency ') - end if - if ( dycore_is('LR') )then - call addfld (dmetendnam( 1),(/ 'lev' /), 'A','kg/kg/s', & - trim(cnst_name( 1))//' dme adjustment tendency (FV) ') - if (ixcldliq > 0) then - call addfld (dmetendnam(ixcldliq),(/ 'lev' /), 'A','kg/kg/s', & - trim(cnst_name(ixcldliq))//' dme adjustment tendency (FV) ') - end if - if (ixcldice > 0) then - call addfld (dmetendnam(ixcldice),(/ 'lev' /), 'A','kg/kg/s', & - trim(cnst_name(ixcldice))//' dme adjustment tendency (FV) ') - end if - end if - - ! outfld calls in diag_physvar_ic - - call addfld ('QCWAT&IC', (/ 'lev' /), 'I','kg/kg','q associated with cloud water' ) - call addfld ('TCWAT&IC', (/ 'lev' /), 'I','kg/kg','T associated with cloud water' ) - call addfld ('LCWAT&IC', (/ 'lev' /), 'I','kg/kg','Cloud water (ice + liq' ) - call addfld ('CLOUD&IC', (/ 'lev' /), 'I','fraction','Cloud fraction' ) - call addfld ('CONCLD&IC', (/ 'lev' /), 'I','fraction','Convective cloud fraction' ) - call addfld ('TKE&IC', (/ 'ilev' /), 'I','m2/s2','Turbulent Kinetic Energy' ) - call addfld ('CUSH&IC', horiz_only, 'I','m','Convective Scale Height' ) - call addfld ('KVH&IC', (/ 'ilev' /), 'I','m2/s','Vertical diffusion diffusivities (heat/moisture)' ) - call addfld ('KVM&IC', (/ 'ilev' /), 'I','m2/s','Vertical diffusion diffusivities (momentum)' ) - call addfld ('PBLH&IC', horiz_only, 'I','m','PBL height' ) - call addfld ('TPERT&IC', horiz_only, 'I','K','Perturbation temperature (eddies in PBL)' ) - call addfld ('QPERT&IC', horiz_only, 'I','kg/kg','Perturbation specific humidity (eddies in PBL)' ) - - ! CAM export state - call addfld('a2x_BCPHIWET', horiz_only, 'A', 'kg/m2/s', 'wetdep of hydrophilic black carbon') - call addfld('a2x_BCPHIDRY', horiz_only, 'A', 'kg/m2/s', 'drydep of hydrophilic black carbon') - call addfld('a2x_BCPHODRY', horiz_only, 'A', 'kg/m2/s', 'drydep of hydrophobic black carbon') - call addfld('a2x_OCPHIWET', horiz_only, 'A', 'kg/m2/s', 'wetdep of hydrophilic organic carbon') - call addfld('a2x_OCPHIDRY', horiz_only, 'A', 'kg/m2/s', 'drydep of hydrophilic organic carbon') - call addfld('a2x_OCPHODRY', horiz_only, 'A', 'kg/m2/s', 'drydep of hydrophobic organic carbon') - call addfld('a2x_DSTWET1', horiz_only, 'A', 'kg/m2/s', 'wetdep of dust (bin1)') - call addfld('a2x_DSTDRY1', horiz_only, 'A', 'kg/m2/s', 'drydep of dust (bin1)') - call addfld('a2x_DSTWET2', horiz_only, 'A', 'kg/m2/s', 'wetdep of dust (bin2)') - call addfld('a2x_DSTDRY2', horiz_only, 'A', 'kg/m2/s', 'drydep of dust (bin2)') - call addfld('a2x_DSTWET3', horiz_only, 'A', 'kg/m2/s', 'wetdep of dust (bin3)') - call addfld('a2x_DSTDRY3', horiz_only, 'A', 'kg/m2/s', 'drydep of dust (bin3)') - call addfld('a2x_DSTWET4', horiz_only, 'A', 'kg/m2/s', 'wetdep of dust (bin4)') - call addfld('a2x_DSTDRY4', horiz_only, 'A', 'kg/m2/s', 'drydep of dust (bin4)') - - ! defaults - if (history_amwg) then - call add_default (cnst_name(1), 1, ' ') - call add_default ('VQ ', 1, ' ') - call add_default ('TMQ ', 1, ' ') - call add_default ('PSL ', 1, ' ') - call add_default ('RELHUM ', 1, ' ') - - call add_default ('DTCOND ', 1, ' ') - call add_default ('PRECL ', 1, ' ') - call add_default ('PRECC ', 1, ' ') - call add_default ('PRECSL ', 1, ' ') - call add_default ('PRECSC ', 1, ' ') - call add_default ('SHFLX ', 1, ' ') - call add_default ('LHFLX ', 1, ' ') - call add_default ('QFLX ', 1, ' ') - call add_default ('TAUX ', 1, ' ') - call add_default ('TAUY ', 1, ' ') - call add_default ('TREFHT ', 1, ' ') - call add_default ('LANDFRAC', 1, ' ') - call add_default ('OCNFRAC ', 1, ' ') - call add_default ('QREFHT ', 1, ' ') - call add_default ('U10 ', 1, ' ') - call add_default ('ICEFRAC ', 1, ' ') - call add_default ('TS ', 1, ' ') - call add_default ('TSMN ', 1, ' ') - call add_default ('TSMX ', 1, ' ') - call add_default ('SNOWHLND', 1, ' ') - call add_default ('SNOWHICE', 1, ' ') - end if - - if (dycore_is('SE')) then - call add_default ('PSDRY', 1, ' ') - call add_default ('PMID', 1, ' ') - end if - - if (history_eddy) then - call add_default ('VQ ', 1, ' ') - endif - - if ( history_budget ) then - call add_default (cnst_name(1), history_budget_histfile_num, ' ') - call add_default ('PTTEND' , history_budget_histfile_num, ' ') - call add_default (ptendnam( 1), history_budget_histfile_num, ' ') - if (ixcldliq > 0) then - call add_default (ptendnam(ixcldliq), history_budget_histfile_num, ' ') - end if - if (ixcldice > 0) then - call add_default (ptendnam(ixcldice), history_budget_histfile_num, ' ') - end if - if ( dycore_is('LR') )then - call add_default(dmetendnam(1) , history_budget_histfile_num, ' ') - if (ixcldliq > 0) then - call add_default(dmetendnam(ixcldliq), history_budget_histfile_num, ' ') - end if - if (ixcldice > 0) then - call add_default(dmetendnam(ixcldice), history_budget_histfile_num, ' ') - end if - end if - if( history_budget_histfile_num > 1 ) then - call add_default ('DTCOND ' , history_budget_histfile_num, ' ') - end if - end if - - if (history_vdiag) then - call add_default ('PRECT ', 2, ' ') - call add_default ('PRECT ', 3, ' ') - call add_default ('PRECT ', 4, ' ') - end if - - ! Initial file - Optional fields - if (inithist_all.or.single_column) then - call add_default ('CONCLD&IC ',0, 'I') - call add_default ('QCWAT&IC ',0, 'I') - call add_default ('TCWAT&IC ',0, 'I') - call add_default ('LCWAT&IC ',0, 'I') - call add_default ('PBLH&IC ',0, 'I') - call add_default ('TPERT&IC ',0, 'I') - call add_default ('QPERT&IC ',0, 'I') - call add_default ('CLOUD&IC ',0, 'I') - call add_default ('TKE&IC ',0, 'I') - call add_default ('CUSH&IC ',0, 'I') - call add_default ('KVH&IC ',0, 'I') - call add_default ('KVM&IC ',0, 'I') - end if - - ! determine number of constituents for which convective tendencies must be computed - if (history_budget) then - dqcond_num = pcnst - else - if (diag_cnst_conv_tend == 'none') dqcond_num = 0 - if (diag_cnst_conv_tend == 'q_only') dqcond_num = 1 - if (diag_cnst_conv_tend == 'all') dqcond_num = pcnst - end if - - do m = 1, dqcond_num - dcconnam(m) = 'DC'//cnst_name(m) - end do - - if ((diag_cnst_conv_tend == 'q_only') .or. (diag_cnst_conv_tend == 'all') .or. history_budget) then - call addfld (dcconnam(1),(/ 'lev' /),'A', 'kg/kg/s',trim(cnst_name(1))//' tendency due to moist processes') - if ( diag_cnst_conv_tend == 'q_only' .or. diag_cnst_conv_tend == 'all' ) then - call add_default (dcconnam(1), 1, ' ') - end if - if( history_budget ) then - call add_default (dcconnam(1), history_budget_histfile_num, ' ') - end if - if (diag_cnst_conv_tend == 'all' .or. history_budget) then - do m = 2, pcnst - call addfld (dcconnam(m),(/ 'lev' /),'A', 'kg/kg/s',trim(cnst_name(m))//' tendency due to moist processes') - if( diag_cnst_conv_tend == 'all' ) then - call add_default (dcconnam(m), 1, ' ') - end if - if( history_budget .and. (m == ixcldliq .or. m == ixcldice) ) then - call add_default (dcconnam(m), history_budget_histfile_num, ' ') - end if - end do - end if - end if - - ! Pbuf field indices for collecting output data - relhum_idx = pbuf_get_index('RELHUM', errcode=ierr) - qcwat_idx = pbuf_get_index('QCWAT', errcode=ierr) - tcwat_idx = pbuf_get_index('TCWAT', errcode=ierr) - lcwat_idx = pbuf_get_index('LCWAT', errcode=ierr) - cld_idx = pbuf_get_index('CLD', errcode=ierr) - concld_idx = pbuf_get_index('CONCLD', errcode=ierr) - - tke_idx = pbuf_get_index('tke', errcode=ierr) - kvm_idx = pbuf_get_index('kvm', errcode=ierr) - kvh_idx = pbuf_get_index('kvh', errcode=ierr) - cush_idx = pbuf_get_index('cush', errcode=ierr) - - pblh_idx = pbuf_get_index('pblh', errcode=ierr) - tpert_idx = pbuf_get_index('tpert', errcode=ierr) - qpert_idx = pbuf_get_index('qpert', errcode=ierr) - - prec_dp_idx = pbuf_get_index('PREC_DP', errcode=ierr) - snow_dp_idx = pbuf_get_index('SNOW_DP', errcode=ierr) - prec_sh_idx = pbuf_get_index('PREC_SH', errcode=ierr) - snow_sh_idx = pbuf_get_index('SNOW_SH', errcode=ierr) - prec_sed_idx = pbuf_get_index('PREC_SED', errcode=ierr) - snow_sed_idx = pbuf_get_index('SNOW_SED', errcode=ierr) - prec_pcw_idx = pbuf_get_index('PREC_PCW', errcode=ierr) - snow_pcw_idx = pbuf_get_index('SNOW_PCW', errcode=ierr) - - if (is_first_step()) then - call pbuf_set_field(pbuf2d, trefmxav_idx, -1.0e36_r8) - call pbuf_set_field(pbuf2d, trefmnav_idx, 1.0e36_r8) - end if - - end subroutine diag_init_moist - - subroutine diag_init(pbuf2d) - use cam_history, only: addfld - - ! Declare the history fields for which this module contains outfld calls. - - type(physics_buffer_desc), pointer, intent(in) :: pbuf2d(:,:) - - ! ---------------------------- - ! determine default variables - ! ---------------------------- - call phys_getopts(history_amwg_out = history_amwg , & - history_vdiag_out = history_vdiag , & - history_eddy_out = history_eddy , & - history_budget_out = history_budget , & - history_budget_histfile_num_out = history_budget_histfile_num, & - history_waccm_out = history_waccm) - - call diag_init_dry(pbuf2d) - if (moist_physics) then - call diag_init_moist(pbuf2d) - end if - - end subroutine diag_init - -!=============================================================================== - - subroutine diag_allocate_dry() - use infnan, only: nan, assignment(=) - - ! Allocate memory for module variables. - ! Done at the begining of a physics step at same point as the pbuf allocate - ! for variables with "physpkg" scope. - - ! Local variables - character(len=*), parameter :: sub = 'diag_allocate_dry' - character(len=128) :: errmsg - integer :: istat - - allocate(dtcond(pcols,pver,begchunk:endchunk), stat=istat) - if ( istat /= 0 ) then - write(errmsg, '(2a,i0)') sub, ': allocate failed, stat = ',istat - call endrun (errmsg) - end if - dtcond = nan - end subroutine diag_allocate_dry - - subroutine diag_allocate_moist() - use infnan, only: nan, assignment(=) - - ! Allocate memory for module variables. - ! Done at the begining of a physics step at same point as the pbuf allocate - ! for variables with "physpkg" scope. - - ! Local variables - character(len=*), parameter :: sub = 'diag_allocate_moist' - character(len=128) :: errmsg - integer :: i, istat - - if (dqcond_num > 0) then - allocate(dqcond(dqcond_num)) - do i = 1, dqcond_num - allocate(dqcond(i)%cnst(pcols,pver,begchunk:endchunk), stat=istat) - if ( istat /= 0 ) then - write(errmsg, '(2a,i0)') sub, ': allocate failed, stat = ',istat - call endrun (errmsg) - end if - dqcond(i)%cnst = nan - end do - end if - - end subroutine diag_allocate_moist - - subroutine diag_allocate() - - call diag_allocate_dry() - if (moist_physics) then - call diag_allocate_moist() - end if - - end subroutine diag_allocate - -!=============================================================================== - - subroutine diag_deallocate_dry() - ! Deallocate memory for module variables. - ! Done at the end of a physics step at same point as the pbuf deallocate for - ! variables with "physpkg" scope. - - ! Local variables - character(len=*), parameter :: sub = 'diag_deallocate_dry' - integer :: istat - - deallocate(dtcond, stat=istat) - if ( istat /= 0 ) call endrun (sub//': ERROR: deallocate failed') - end subroutine diag_deallocate_dry - - subroutine diag_deallocate_moist() - - ! Deallocate memory for module variables. - ! Done at the end of a physics step at same point as the pbuf deallocate for - ! variables with "physpkg" scope. - - ! Local variables - character(len=*), parameter :: sub = 'diag_deallocate_moist' - integer :: i, istat - - if (dqcond_num > 0) then - do i = 1, dqcond_num - deallocate(dqcond(i)%cnst, stat=istat) - if ( istat /= 0 ) call endrun (sub//': ERROR: deallocate failed') - end do - deallocate(dqcond, stat=istat) - if ( istat /= 0 ) call endrun (sub//': ERROR: deallocate failed') - end if - end subroutine diag_deallocate_moist - - subroutine diag_deallocate() - - call diag_deallocate_dry() - if (moist_physics) then - call diag_deallocate_moist() - end if - - end subroutine diag_deallocate - -!=============================================================================== - - subroutine diag_conv_tend_ini(state,pbuf) - - ! Initialize convective tendency calcs. - - ! Arguments: - type(physics_state), intent(in) :: state - type(physics_buffer_desc), pointer :: pbuf(:) - - ! Local variables: - - integer :: i, k, m, lchnk, ncol - real(r8), pointer, dimension(:,:) :: t_ttend - - lchnk = state%lchnk - ncol = state%ncol - - do k = 1, pver - do i = 1, ncol - dtcond(i,k,lchnk) = state%t(i,k) - end do - end do - - do m = 1, dqcond_num - do k = 1, pver - do i = 1, ncol - dqcond(m)%cnst(i,k,lchnk) = state%q(i,k,m) - end do - end do - end do - - !! initialize to pbuf T_TTEND to temperature at first timestep - if (is_first_step()) then - do m = 1, dyn_time_lvls - call pbuf_get_field(pbuf, t_ttend_idx, t_ttend, start=(/1,1,m/), kount=(/pcols,pver,1/)) - t_ttend(:ncol,:) = state%t(:ncol,:) - end do - end if - - end subroutine diag_conv_tend_ini - -!=============================================================================== - - subroutine diag_phys_writeout_dry(state, pbuf, p_surf_t) - - !----------------------------------------------------------------------- - ! - ! Purpose: output dry physics diagnostics - ! - !----------------------------------------------------------------------- - use physconst, only: gravit, rga, rair, cpair, latvap, rearth, pi, cappa - use time_manager, only: get_nstep - use interpolate_data, only: vertinterp - use constituent_burden, only: constituent_burden_comp - use co2_cycle, only: c_i, co2_transport - - use tidal_diag, only: tidal_diag_write - !----------------------------------------------------------------------- - ! - ! Arguments - ! - type(physics_state), intent(inout) :: state - type(physics_buffer_desc), pointer :: pbuf(:) - real(r8), intent(out) :: p_surf_t(pcols, nsurf) ! data interpolated to a pressure surface - ! - !---------------------------Local workspace----------------------------- - ! - real(r8) :: ftem(pcols,pver) ! temporary workspace - real(r8) :: ftem1(pcols,pver) ! another temporary workspace - real(r8) :: ftem2(pcols,pver) ! another temporary workspace - real(r8) :: z3(pcols,pver) ! geo-potential height - real(r8) :: p_surf(pcols) ! data interpolated to a pressure surface - real(r8) :: tem2(pcols,pver) ! temporary workspace - real(r8) :: timestep(pcols) ! used for outfld call - real(r8) :: esl(pcols,pver) ! saturation vapor pressures - real(r8) :: esi(pcols,pver) ! - real(r8) :: dlon(pcols) ! width of grid cell (meters) - - real(r8), pointer :: psl(:) ! Sea Level Pressure - - integer :: i, k, m, lchnk, ncol, nstep - ! - !----------------------------------------------------------------------- - ! - lchnk = state%lchnk - ncol = state%ncol - - ! Output NSTEP for debugging - nstep = get_nstep() - timestep(:ncol) = nstep - call outfld ('NSTEP ',timestep, pcols, lchnk) - - call outfld('T ',state%t , pcols ,lchnk ) - call outfld('PS ',state%ps, pcols ,lchnk ) - call outfld('U ',state%u , pcols ,lchnk ) - call outfld('V ',state%v , pcols ,lchnk ) - - call outfld('PHIS ',state%phis, pcols, lchnk ) - -#if (defined BFB_CAM_SCAM_IOP ) - call outfld('phis ',state%phis, pcols, lchnk ) -#endif - - do m = 1, pcnst - if (cnst_cam_outfld(m)) then - call outfld(cnst_name(m), state%q(1,1,m), pcols, lchnk) - end if - end do - - ! - ! Add height of surface to midpoint height above surface - ! - do k = 1, pver - z3(:ncol,k) = state%zm(:ncol,k) + state%phis(:ncol)*rga - end do - call outfld('Z3 ',z3,pcols,lchnk) - ! - ! Output Z3 on pressure surfaces - ! - if (hist_fld_active('Z1000')) then - call vertinterp(ncol, pcols, pver, state%pmid, 100000._r8, z3, p_surf, & - extrapolate='Z', ln_interp=.true., ps=state%ps, phis=state%phis, tbot=state%t(:,pver)) - call outfld('Z1000 ', p_surf, pcols, lchnk) - end if - if (hist_fld_active('Z700')) then - call vertinterp(ncol, pcols, pver, state%pmid, 70000._r8, z3, p_surf, & - extrapolate='Z', ln_interp=.true., ps=state%ps, phis=state%phis, tbot=state%t(:,pver)) - call outfld('Z700 ', p_surf, pcols, lchnk) - end if - if (hist_fld_active('Z500')) then - call vertinterp(ncol, pcols, pver, state%pmid, 50000._r8, z3, p_surf, & - extrapolate='Z', ln_interp=.true., ps=state%ps, phis=state%phis, tbot=state%t(:,pver)) - call outfld('Z500 ', p_surf, pcols, lchnk) - end if - if (hist_fld_active('Z300')) then - call vertinterp(ncol, pcols, pver, state%pmid, 30000._r8, z3, p_surf, ln_interp=.true.) - call outfld('Z300 ', p_surf, pcols, lchnk) - end if - if (hist_fld_active('Z200')) then - call vertinterp(ncol, pcols, pver, state%pmid, 20000._r8, z3, p_surf, ln_interp=.true.) - call outfld('Z200 ', p_surf, pcols, lchnk) - end if - if (hist_fld_active('Z100')) then - call vertinterp(ncol, pcols, pver, state%pmid, 10000._r8, z3, p_surf, ln_interp=.true.) - call outfld('Z100 ', p_surf, pcols, lchnk) - end if - if (hist_fld_active('Z050')) then - call vertinterp(ncol, pcols, pver, state%pmid, 5000._r8, z3, p_surf, ln_interp=.true.) - call outfld('Z050 ', p_surf, pcols, lchnk) - end if - ! - ! Quadratic height fiels Z3*Z3 - ! - ftem(:ncol,:) = z3(:ncol,:)*z3(:ncol,:) - call outfld('ZZ ',ftem,pcols,lchnk) - - ftem(:ncol,:) = z3(:ncol,:)*state%v(:ncol,:) - call outfld('VZ ',ftem, pcols,lchnk) - ! - ! Meridional advection fields - ! - ftem(:ncol,:) = state%v(:ncol,:)*state%t(:ncol,:) - call outfld ('VT ',ftem ,pcols ,lchnk ) - - ftem(:ncol,:) = state%v(:ncol,:)**2 - call outfld ('VV ',ftem ,pcols ,lchnk ) - - ftem(:ncol,:) = state%v(:ncol,:) * state%u(:ncol,:) - call outfld ('VU ',ftem ,pcols ,lchnk ) - ! - ! zonal advection - ! - ftem(:ncol,:) = state%u(:ncol,:)**2 - call outfld ('UU ',ftem ,pcols ,lchnk ) - - ! Wind speed - ftem(:ncol,:) = sqrt( state%u(:ncol,:)**2 + state%v(:ncol,:)**2) - call outfld ('WSPEED ',ftem ,pcols ,lchnk ) - call outfld ('WSPDSRFMX',ftem(:,pver) ,pcols ,lchnk ) - call outfld ('WSPDSRFAV',ftem(:,pver) ,pcols ,lchnk ) - - ! Vertical velocity and advection - - if (single_column) then - call outfld('OMEGA ',wfld, pcols, lchnk ) - else - call outfld('OMEGA ',state%omega, pcols, lchnk ) - endif - -#if (defined BFB_CAM_SCAM_IOP ) - call outfld('omega ',state%omega, pcols, lchnk ) -#endif - - ftem(:ncol,:) = state%omega(:ncol,:)*state%t(:ncol,:) - call outfld('OMEGAT ',ftem, pcols, lchnk ) - ftem(:ncol,:) = state%omega(:ncol,:)*state%u(:ncol,:) - call outfld('OMEGAU ',ftem, pcols, lchnk ) - ftem(:ncol,:) = state%omega(:ncol,:)*state%v(:ncol,:) - call outfld('OMEGAV ',ftem, pcols, lchnk ) - ftem(:ncol,:) = state%omega(:ncol,:)*state%omega(:ncol,:) - call outfld('OMGAOMGA',ftem, pcols, lchnk ) - ! - ! Output omega at 850 and 500 mb pressure levels - ! - if (hist_fld_active('OMEGA850')) then - call vertinterp(ncol, pcols, pver, state%pmid, 85000._r8, state%omega, p_surf) - call outfld('OMEGA850', p_surf, pcols, lchnk) - end if - if (hist_fld_active('OMEGA500')) then - call vertinterp(ncol, pcols, pver, state%pmid, 50000._r8, state%omega, p_surf) - call outfld('OMEGA500', p_surf, pcols, lchnk) - end if - - ! Sea level pressure - call pbuf_get_field(pbuf, psl_idx, psl) - call cpslec(ncol, state%pmid, state%phis, state%ps, state%t, psl, gravit, rair) - call outfld('PSL', psl, pcols, lchnk) - - ! Output T,u,v fields on pressure surfaces - ! - if (hist_fld_active('T850')) then - call vertinterp(ncol, pcols, pver, state%pmid, 85000._r8, state%t, p_surf, & - extrapolate='T', ps=state%ps, phis=state%phis) - call outfld('T850 ', p_surf, pcols, lchnk ) - end if - if (hist_fld_active('T500')) then - call vertinterp(ncol, pcols, pver, state%pmid, 50000._r8, state%t, p_surf, & - extrapolate='T', ps=state%ps, phis=state%phis) - call outfld('T500 ', p_surf, pcols, lchnk ) - end if - if (hist_fld_active('T400')) then - call vertinterp(ncol, pcols, pver, state%pmid, 40000._r8, state%t, p_surf, & - extrapolate='T', ps=state%ps, phis=state%phis) - call outfld('T400 ', p_surf, pcols, lchnk ) - end if - if (hist_fld_active('T300')) then - call vertinterp(ncol, pcols, pver, state%pmid, 30000._r8, state%t, p_surf) - call outfld('T300 ', p_surf, pcols, lchnk ) - end if - if (hist_fld_active('T200')) then - call vertinterp(ncol, pcols, pver, state%pmid, 20000._r8, state%t, p_surf) - call outfld('T200 ', p_surf, pcols, lchnk ) - end if - if (hist_fld_active('U850')) then - call vertinterp(ncol, pcols, pver, state%pmid, 85000._r8, state%u, p_surf) - call outfld('U850 ', p_surf, pcols, lchnk ) - end if - if (hist_fld_active('U500')) then - call vertinterp(ncol, pcols, pver, state%pmid, 50000._r8, state%u, p_surf) - call outfld('U500 ', p_surf, pcols, lchnk ) - end if - if (hist_fld_active('U250')) then - call vertinterp(ncol, pcols, pver, state%pmid, 25000._r8, state%u, p_surf) - call outfld('U250 ', p_surf, pcols, lchnk ) - end if - if (hist_fld_active('U200')) then - call vertinterp(ncol, pcols, pver, state%pmid, 20000._r8, state%u, p_surf) - call outfld('U200 ', p_surf, pcols, lchnk ) - end if - if (hist_fld_active('U010')) then - call vertinterp(ncol, pcols, pver, state%pmid, 1000._r8, state%u, p_surf) - call outfld('U010 ', p_surf, pcols, lchnk ) - end if - if (hist_fld_active('V850')) then - call vertinterp(ncol, pcols, pver, state%pmid, 85000._r8, state%v, p_surf) - call outfld('V850 ', p_surf, pcols, lchnk ) - end if - if (hist_fld_active('V500')) then - call vertinterp(ncol, pcols, pver, state%pmid, 50000._r8, state%v, p_surf) - call outfld('V500 ', p_surf, pcols, lchnk ) - end if - if (hist_fld_active('V250')) then - call vertinterp(ncol, pcols, pver, state%pmid, 25000._r8, state%v, p_surf) - call outfld('V250 ', p_surf, pcols, lchnk ) - end if - if (hist_fld_active('V200')) then - call vertinterp(ncol, pcols, pver, state%pmid, 20000._r8, state%v, p_surf) - call outfld('V200 ', p_surf, pcols, lchnk ) - end if - - ftem(:ncol,:) = state%t(:ncol,:)*state%t(:ncol,:) - call outfld('TT ',ftem ,pcols ,lchnk ) - ! - ! Output U, V, T, P and Z at bottom level - ! - call outfld ('UBOT ', state%u(1,pver) , pcols, lchnk) - call outfld ('VBOT ', state%v(1,pver) , pcols, lchnk) - call outfld ('ZBOT ', state%zm(1,pver) , pcols, lchnk) - - !! Boundary layer atmospheric stability, temperature, water vapor diagnostics - - p_surf_t = -99.0_r8 ! Uninitialized to impossible value - if (hist_fld_active('T1000') .or. & - hist_fld_active('T9251000') .or. & - hist_fld_active('TH9251000') .or. & - hist_fld_active('T8501000') .or. & - hist_fld_active('TH8501000') .or. & - hist_fld_active('T7001000') .or. & - hist_fld_active('TH7001000')) then - call vertinterp(ncol, pcols, pver, state%pmid, 100000._r8, state%t, p_surf_t(:,surf_100000)) - end if - - if ( hist_fld_active('T925') .or. & - hist_fld_active('T9251000') .or. & - hist_fld_active('TH9251000')) then - call vertinterp(ncol, pcols, pver, state%pmid, 92500._r8, state%t, p_surf_t(:,surf_092500)) - end if - -!!! at 1000 mb and 925 mb - if (hist_fld_active('T1000')) then - call outfld('T1000 ', p_surf_t(:,surf_100000), pcols, lchnk ) - end if - - if (hist_fld_active('T925')) then - call outfld('T925 ', p_surf_t(:,surf_092500), pcols, lchnk ) - end if - - if (hist_fld_active('T9251000')) then - p_surf = p_surf_t(:,surf_092500) - p_surf_t(:,surf_100000) - call outfld('T9251000 ', p_surf, pcols, lchnk ) - end if - - if (hist_fld_active('TH9251000')) then - p_surf = (p_surf_t(:,surf_092500)*(1000.0_r8/925.0_r8)**cappa) - (p_surf_t(:,surf_100000)*(1.0_r8)**cappa) - call outfld('TH9251000 ', p_surf, pcols, lchnk ) - end if - - if (hist_fld_active('T8501000') .or. & - hist_fld_active('TH8501000')) then - call vertinterp(ncol, pcols, pver, state%pmid, 85000._r8, state%t, p_surf_t(:,surf_085000)) - end if - -!!! at 1000 mb and 850 mb - if (hist_fld_active('T8501000')) then - p_surf = p_surf_t(:,surf_085000)-p_surf_t(:,surf_100000) - call outfld('T8501000 ', p_surf, pcols, lchnk ) - end if - - if (hist_fld_active('TH8501000')) then - p_surf = (p_surf_t(:,surf_085000)*(1000.0_r8/850.0_r8)**cappa)-(p_surf_t(:,surf_100000)*(1.0_r8)**cappa) - call outfld('TH8501000 ', p_surf, pcols, lchnk ) - end if - - if (hist_fld_active('T7001000') .or. & - hist_fld_active('TH7001000') .or. & - hist_fld_active('T700')) then - call vertinterp(ncol, pcols, pver, state%pmid, 70000._r8, state%t, p_surf_t(:,surf_070000)) - end if - -!!! at 700 mb - if (hist_fld_active('T700')) then - call outfld('T700 ', p_surf_t(:,surf_070000), pcols, lchnk ) - end if - -!!! at 1000 mb and 700 mb - if (hist_fld_active('T7001000')) then - p_surf = p_surf_t(:,surf_070000)-p_surf_t(:,surf_100000) - call outfld('T7001000 ', p_surf, pcols, lchnk ) - end if - - if (hist_fld_active('TH7001000')) then - p_surf = (p_surf_t(:,surf_070000)*(1000.0_r8/700.0_r8)**cappa)-(p_surf_t(:,surf_100000)*(1.0_r8)**cappa) - call outfld('TH7001000 ', p_surf, pcols, lchnk ) - end if - - if (hist_fld_active('T010')) then - call vertinterp(ncol, pcols, pver, state%pmid, 1000._r8, state%t, p_surf) - call outfld('T010 ', p_surf, pcols, lchnk ) - end if - - !--------------------------------------------------------- - ! tidal diagnostics - !--------------------------------------------------------- - call tidal_diag_write(state) - - return - end subroutine diag_phys_writeout_dry - -!=============================================================================== - - subroutine diag_phys_writeout_moist(state, pbuf, p_surf_t) - - !----------------------------------------------------------------------- - ! - ! Purpose: record dynamics variables on physics grid - ! - !----------------------------------------------------------------------- - use physconst, only: gravit, rga, rair, cpair, latvap, rearth, pi, cappa, & - epsilo, rh2o - use interpolate_data, only: vertinterp - use constituent_burden, only: constituent_burden_comp - use co2_cycle, only: c_i, co2_transport - !----------------------------------------------------------------------- - ! - ! Arguments - ! - type(physics_state), intent(inout) :: state - type(physics_buffer_desc), pointer :: pbuf(:) - real(r8), intent(inout) :: p_surf_t(pcols, nsurf) ! data interpolated to a pressure surface - ! - !---------------------------Local workspace----------------------------- - ! - real(r8) :: ftem(pcols,pver) ! temporary workspace - real(r8) :: ftem1(pcols,pver) ! another temporary workspace - real(r8) :: ftem2(pcols,pver) ! another temporary workspace - real(r8) :: z3(pcols,pver) ! geo-potential height - real(r8) :: p_surf(pcols) ! data interpolated to a pressure surface - real(r8) :: p_surf_q1(pcols) ! data interpolated to a pressure surface - real(r8) :: p_surf_q2(pcols) ! data interpolated to a pressure surface - real(r8) :: tem2(pcols,pver) ! temporary workspace - real(r8) :: esl(pcols,pver) ! saturation vapor pressures - real(r8) :: esi(pcols,pver) ! - - real(r8), pointer :: ftem_ptr(:,:) - - integer :: i, k, m, lchnk, ncol - ! - !----------------------------------------------------------------------- - ! - lchnk = state%lchnk - ncol = state%ncol - - if (co2_transport()) then - do m = 1,4 - call outfld(trim(cnst_name(c_i(m)))//'_BOT', state%q(1,pver,c_i(m)), pcols, lchnk) - end do - end if - - ! column burdens of all constituents except water vapor - call constituent_burden_comp(state) - - call outfld('PSDRY', state%psdry, pcols, lchnk) - call outfld('PMID', state%pmid, pcols, lchnk) - call outfld('PDELDRY', state%pdeldry, pcols, lchnk) - - ! - ! Meridional advection fields - ! - ftem(:ncol,:) = state%v(:ncol,:)*state%q(:ncol,:,1) - call outfld ('VQ ',ftem ,pcols ,lchnk ) - - ftem(:ncol,:) = state%q(:ncol,:,1)*state%q(:ncol,:,1) - call outfld ('QQ ',ftem ,pcols ,lchnk ) - - ! Vertical velocity and advection - ftem(:ncol,:) = state%omega(:ncol,:)*state%q(:ncol,:,1) - call outfld('OMEGAQ ',ftem, pcols, lchnk ) - ! - ! Mass of q, by layer and vertically integrated - ! - ftem(:ncol,:) = state%q(:ncol,:,1) * state%pdel(:ncol,:) * rga - call outfld ('MQ ',ftem ,pcols ,lchnk ) - - do k=2,pver - ftem(:ncol,1) = ftem(:ncol,1) + ftem(:ncol,k) - end do - call outfld ('TMQ ',ftem, pcols ,lchnk ) - - ! Relative humidity - if (hist_fld_active('RELHUM')) then - if (relhum_idx > 0) then - call pbuf_get_field(pbuf, relhum_idx, ftem_ptr) - ftem(:ncol,:) = ftem_ptr(:ncol,:) - else - call qsat(state%t(:ncol,:), state%pmid(:ncol,:), & - tem2(:ncol,:), ftem(:ncol,:)) - ftem(:ncol,:) = state%q(:ncol,:,1)/ftem(:ncol,:)*100._r8 - end if - call outfld ('RELHUM ',ftem ,pcols ,lchnk ) - end if - - if (hist_fld_active('RHW') .or. hist_fld_active('RHI') .or. hist_fld_active('RHCFMIP') ) then - - ! RH w.r.t liquid (water) - call qsat_water (state%t(:ncol,:), state%pmid(:ncol,:), & - esl(:ncol,:), ftem(:ncol,:)) - ftem(:ncol,:) = state%q(:ncol,:,1)/ftem(:ncol,:)*100._r8 - call outfld ('RHW ',ftem ,pcols ,lchnk ) - - ! Convert to RHI (ice) - do i=1,ncol - do k=1,pver - esi(i,k)=svp_ice(state%t(i,k)) - ftem1(i,k)=ftem(i,k)*esl(i,k)/esi(i,k) - end do - end do - call outfld ('RHI ',ftem1 ,pcols ,lchnk ) - - ! use temperature to decide if you populate with ftem (liquid, above 0 C) or ftem1 (ice, below 0 C) - - ftem2(:ncol,:)=ftem(:ncol,:) - - do i=1,ncol - do k=1,pver - if (state%t(i,k) .gt. 273) then - ftem2(i,k)=ftem(i,k) !!wrt water - else - ftem2(i,k)=ftem1(i,k) !!wrt ice - end if - end do - end do - - call outfld ('RHCFMIP ',ftem2 ,pcols ,lchnk ) - - end if - ! - ! Output q field on pressure surfaces - ! - if (hist_fld_active('Q850')) then - call vertinterp(ncol, pcols, pver, state%pmid, 85000._r8, state%q(1,1,1), p_surf) - call outfld('Q850 ', p_surf, pcols, lchnk ) - end if - if (hist_fld_active('Q200')) then - call vertinterp(ncol, pcols, pver, state%pmid, 20000._r8, state%q(1,1,1), p_surf) - call outfld('Q200 ', p_surf, pcols, lchnk ) - end if - ! - ! Output Q at bottom level - ! - call outfld ('QBOT ', state%q(1,pver,1), pcols, lchnk) - - ! Total energy of the atmospheric column for atmospheric heat storage calculations - - !! temporary variable to get surface geopotential in dimensions of (ncol,pver) - do k=1,pver - ftem1(:ncol,k)=state%phis(:ncol) !! surface geopotential in units (m2/s2) - end do - - !! calculate sum of sensible, kinetic, latent, and surface geopotential energy - !! E=CpT+PHIS+Lv*q+(0.5)*(u^2+v^2) - ftem(:ncol,:) = (cpair*state%t(:ncol,:) + ftem1(:ncol,:) + latvap*state%q(:ncol,:,1) + & - 0.5_r8*(state%u(:ncol,:)**2+state%v(:ncol,:)**2))*(state%pdel(:ncol,:)/gravit) - !! vertically integrate - do k=2,pver - ftem(:ncol,1) = ftem(:ncol,1) + ftem(:ncol,k) - end do - call outfld ('ATMEINT ',ftem(:ncol,1) ,pcols ,lchnk ) - - !! Boundary layer atmospheric stability, temperature, water vapor diagnostics - - if ( hist_fld_active('THE9251000') .or. & - hist_fld_active('THE8501000') .or. & - hist_fld_active('THE7001000')) then - if (p_surf_t(1, surf_100000) < 0.0_r8) then - call vertinterp(ncol, pcols, pver, state%pmid, 100000._r8, state%t, p_surf_t(:, surf_100000)) - end if - end if - - if ( hist_fld_active('TH9251000') .or. & - hist_fld_active('THE9251000')) then - if (p_surf_t(1, surf_092500) < 0.0_r8) then - call vertinterp(ncol, pcols, pver, state%pmid, 92500._r8, state%t, p_surf_t(:, surf_092500)) - end if - end if - - if ( hist_fld_active('Q1000') .or. & - hist_fld_active('THE9251000') .or. & - hist_fld_active('THE8501000') .or. & - hist_fld_active('THE7001000')) then - call vertinterp(ncol, pcols, pver, state%pmid, 100000._r8, state%q(1,1,1), p_surf_q1) - end if - - if (hist_fld_active('THE9251000')) then - call vertinterp(ncol, pcols, pver, state%pmid, 92500._r8, state%q(1,1,1), p_surf_q2) - end if - -!!! at 1000 mb and 925 mb - if (hist_fld_active('Q1000')) then - call outfld('Q1000 ', p_surf_q1, pcols, lchnk ) - end if - - if (hist_fld_active('Q925')) then - call outfld('Q925 ', p_surf_q2, pcols, lchnk ) - end if - - if (hist_fld_active('THE9251000')) then - p_surf = ((p_surf_t(:, surf_092500)*(1000.0_r8/925.0_r8)**cappa) * & - exp((2500000.0_r8*p_surf_q2)/(1004.0_r8*p_surf_t(:, surf_092500)))) - & - (p_surf_t(:,surf_100000)*(1.0_r8)**cappa)*exp((2500000.0_r8*p_surf_q1)/(1004.0_r8*p_surf_t(:,surf_100000))) - call outfld('THE9251000 ', p_surf, pcols, lchnk ) - end if - - if (hist_fld_active('THE8501000')) then - if (p_surf_t(1, surf_085000) < 0.0_r8) then - call vertinterp(ncol, pcols, pver, state%pmid, 85000._r8, state%t, p_surf_t(:, surf_085000)) - end if - end if - -!!! at 1000 mb and 850 mb - if (hist_fld_active('THE8501000')) then - call vertinterp(ncol, pcols, pver, state%pmid, 85000._r8, state%q(1,1,1), p_surf_q2) - p_surf = ((p_surf_t(:, surf_085000)*(1000.0_r8/850.0_r8)**cappa) * & - exp((2500000.0_r8*p_surf_q2)/(1004.0_r8*p_surf_t(:, surf_085000)))) - & - (p_surf_t(:,surf_100000)*(1.0_r8)**cappa)*exp((2500000.0_r8*p_surf_q1)/(1004.0_r8*p_surf_t(:,surf_100000))) - call outfld('THE8501000 ', p_surf, pcols, lchnk ) - end if - - if (hist_fld_active('THE7001000')) then - if (p_surf_t(1, surf_070000) < 0.0_r8) then - call vertinterp(ncol, pcols, pver, state%pmid, 70000._r8, state%t, p_surf_t(:, surf_070000)) - end if - end if - -!!! at 1000 mb and 700 mb - if (hist_fld_active('THE7001000')) then - call vertinterp(ncol, pcols, pver, state%pmid, 70000._r8, state%q(1,1,1), p_surf_q2) - p_surf = ((p_surf_t(:, surf_070000)*(1000.0_r8/700.0_r8)**cappa) * & - exp((2500000.0_r8*p_surf_q2)/(1004.0_r8*p_surf_t(:, surf_070000)))) - & - (p_surf_t(:,surf_100000)*(1.0_r8)**cappa)*exp((2500000.0_r8*p_surf_q1)/(1004.0_r8*p_surf_t(:,surf_100000))) - call outfld('THE7001000 ', p_surf, pcols, lchnk ) - end if - - return - end subroutine diag_phys_writeout_moist - -!=============================================================================== - - subroutine diag_phys_writeout(state, pbuf) - - !----------------------------------------------------------------------- - ! - ! Arguments - ! - type(physics_state), intent(inout) :: state - type(physics_buffer_desc), pointer :: pbuf(:) - - ! Local variable - real(r8) :: p_surf_t(pcols, nsurf) ! data interpolated to a pressure surface - - call diag_phys_writeout_dry(state, pbuf, p_surf_t) - - if (moist_physics) then - call diag_phys_writeout_moist(state, pbuf, p_surf_t) - end if - - end subroutine diag_phys_writeout - -!=============================================================================== - - subroutine diag_conv(state, ztodt, pbuf) - - !----------------------------------------------------------------------- - ! - ! Output diagnostics associated with all convective processes. - ! - !----------------------------------------------------------------------- - use physconst, only: cpair - use tidal_diag, only: get_tidal_coeffs - - ! Arguments: - - real(r8), intent(in) :: ztodt ! timestep for computing physics tendencies - type(physics_state), intent(in) :: state - type(physics_buffer_desc), pointer :: pbuf(:) - - ! convective precipitation variables - real(r8), pointer :: prec_dp(:) ! total precipitation from ZM convection - real(r8), pointer :: snow_dp(:) ! snow from ZM convection - real(r8), pointer :: prec_sh(:) ! total precipitation from Hack convection - real(r8), pointer :: snow_sh(:) ! snow from Hack convection - real(r8), pointer :: prec_sed(:) ! total precipitation from ZM convection - real(r8), pointer :: snow_sed(:) ! snow from ZM convection - real(r8), pointer :: prec_pcw(:) ! total precipitation from Hack convection - real(r8), pointer :: snow_pcw(:) ! snow from Hack convection - - ! Local variables: - - integer :: i, k, m, lchnk, ncol - - real(r8) :: rtdt - - real(r8):: precc(pcols) ! convective precip rate - real(r8):: precl(pcols) ! stratiform precip rate - real(r8):: snowc(pcols) ! convective snow rate - real(r8):: snowl(pcols) ! stratiform snow rate - real(r8):: prect(pcols) ! total (conv+large scale) precip rate - real(r8) :: dcoef(6) ! for tidal component of T tend - - lchnk = state%lchnk - ncol = state%ncol - - rtdt = 1._r8/ztodt - - if (moist_physics) then - if (prec_dp_idx > 0) then - call pbuf_get_field(pbuf, prec_dp_idx, prec_dp) - else - nullify(prec_dp) - end if - if (snow_dp_idx > 0) then - call pbuf_get_field(pbuf, snow_dp_idx, snow_dp) - else - nullify(snow_dp) - end if - if (prec_sh_idx > 0) then - call pbuf_get_field(pbuf, prec_sh_idx, prec_sh) - else - nullify(prec_sh) - end if - if (snow_sh_idx > 0) then - call pbuf_get_field(pbuf, snow_sh_idx, snow_sh) - else - nullify(snow_sh) - end if - if (prec_sed_idx > 0) then - call pbuf_get_field(pbuf, prec_sed_idx, prec_sed) - else - nullify(prec_sed) - end if - if (snow_sed_idx > 0) then - call pbuf_get_field(pbuf, snow_sed_idx, snow_sed) - else - nullify(snow_sed) - end if - if (prec_pcw_idx > 0) then - call pbuf_get_field(pbuf, prec_pcw_idx, prec_pcw) - else - nullify(prec_pcw) - end if - if (snow_pcw_idx > 0) then - call pbuf_get_field(pbuf, snow_pcw_idx, snow_pcw) - else - nullify(snow_pcw) - end if - - ! Precipitation rates (multi-process) - if (associated(prec_dp) .and. associated(prec_sh)) then - precc(:ncol) = prec_dp(:ncol) + prec_sh(:ncol) - else if (associated(prec_dp)) then - precc(:ncol) = prec_dp(:ncol) - else if (associated(prec_sh)) then - precc(:ncol) = prec_sh(:ncol) - else - precc(:ncol) = 0._r8 - end if - if (associated(prec_sed) .and. associated(prec_pcw)) then - precl(:ncol) = prec_sed(:ncol) + prec_pcw(:ncol) - else if (associated(prec_sed)) then - precl(:ncol) = prec_sed(:ncol) - else if (associated(prec_pcw)) then - precl(:ncol) = prec_pcw(:ncol) - else - precl(:ncol) = 0._r8 - end if - if (associated(snow_dp) .and. associated(snow_sh)) then - snowc(:ncol) = snow_dp(:ncol) + snow_sh(:ncol) - else if (associated(snow_dp)) then - snowc(:ncol) = snow_dp(:ncol) - else if (associated(snow_sh)) then - snowc(:ncol) = snow_sh(:ncol) - else - snowc(:ncol) = 0._r8 - end if - if (associated(snow_sed) .and. associated(snow_pcw)) then - snowl(:ncol) = snow_sed(:ncol) + snow_pcw(:ncol) - else if (associated(snow_sed)) then - snowl(:ncol) = snow_sed(:ncol) - else if (associated(snow_pcw)) then - snowl(:ncol) = snow_pcw(:ncol) - else - snowl(:ncol) = 0._r8 - end if - prect(:ncol) = precc(:ncol) + precl(:ncol) - - call outfld('PRECC ', precc, pcols, lchnk ) - call outfld('PRECL ', precl, pcols, lchnk ) - if (associated(prec_pcw)) then - call outfld('PREC_PCW', prec_pcw,pcols ,lchnk ) - end if - if (associated(prec_dp)) then - call outfld('PREC_zmc', prec_dp ,pcols ,lchnk ) - end if - call outfld('PRECSC ', snowc, pcols, lchnk ) - call outfld('PRECSL ', snowl, pcols, lchnk ) - call outfld('PRECT ', prect, pcols, lchnk ) - call outfld('PRECTMX ', prect, pcols, lchnk ) - - call outfld('PRECLav ', precl, pcols, lchnk ) - call outfld('PRECCav ', precc, pcols, lchnk ) - -#if ( defined BFB_CAM_SCAM_IOP ) - call outfld('Prec ' , prect, pcols, lchnk ) -#endif - - ! Total convection tendencies. - - do k = 1, pver - do i = 1, ncol - dtcond(i,k,lchnk) = (state%t(i,k) - dtcond(i,k,lchnk))*rtdt - end do - end do - call outfld('DTCOND ', dtcond(:,:,lchnk), pcols, lchnk) - - ! output tidal coefficients - call get_tidal_coeffs( dcoef ) - call outfld( 'DTCOND_24_SIN', dtcond(:ncol,:,lchnk)*dcoef(1), ncol, lchnk ) - call outfld( 'DTCOND_24_COS', dtcond(:ncol,:,lchnk)*dcoef(2), ncol, lchnk ) - call outfld( 'DTCOND_12_SIN', dtcond(:ncol,:,lchnk)*dcoef(3), ncol, lchnk ) - call outfld( 'DTCOND_12_COS', dtcond(:ncol,:,lchnk)*dcoef(4), ncol, lchnk ) - call outfld( 'DTCOND_08_SIN', dtcond(:ncol,:,lchnk)*dcoef(5), ncol, lchnk ) - call outfld( 'DTCOND_08_COS', dtcond(:ncol,:,lchnk)*dcoef(6), ncol, lchnk ) - - do m = 1, dqcond_num - if ( cnst_cam_outfld(m) ) then - do k = 1, pver - do i = 1, ncol - dqcond(m)%cnst(i,k,lchnk) = (state%q(i,k,m) - dqcond(m)%cnst(i,k,lchnk))*rtdt - end do - end do - call outfld(dcconnam(m), dqcond(m)%cnst(:,:,lchnk), pcols, lchnk) - end if - end do - - end if - end subroutine diag_conv - -!=============================================================================== - - subroutine diag_surf (cam_in, cam_out, state, pbuf) - - !----------------------------------------------------------------------- - ! - ! Purpose: record surface diagnostics - ! - !----------------------------------------------------------------------- - - use time_manager, only: is_end_curr_day - use co2_cycle, only: c_i, co2_transport - use constituents, only: sflxnam - - !----------------------------------------------------------------------- - ! - ! Input arguments - ! - type(cam_in_t), intent(in) :: cam_in - type(cam_out_t), intent(in) :: cam_out - type(physics_state), intent(in) :: state - type(physics_buffer_desc), pointer :: pbuf(:) - ! - !---------------------------Local workspace----------------------------- - ! - integer :: i, k, m ! indexes - integer :: lchnk ! chunk identifier - integer :: ncol ! longitude dimension - real(r8) tem2(pcols) ! temporary workspace - real(r8) ftem(pcols) ! temporary workspace - - real(r8), pointer :: trefmnav(:) ! daily minimum tref - real(r8), pointer :: trefmxav(:) ! daily maximum tref - - ! - !----------------------------------------------------------------------- - ! - lchnk = cam_in%lchnk - ncol = cam_in%ncol - - if (moist_physics) then - call outfld('SHFLX', cam_in%shf, pcols, lchnk) - call outfld('LHFLX', cam_in%lhf, pcols, lchnk) - call outfld('QFLX', cam_in%cflx(1,1), pcols, lchnk) - - call outfld('TAUX', cam_in%wsx, pcols, lchnk) - call outfld('TAUY', cam_in%wsy, pcols, lchnk) - call outfld('TREFHT ', cam_in%tref, pcols, lchnk) - call outfld('TREFHTMX', cam_in%tref, pcols, lchnk) - call outfld('TREFHTMN', cam_in%tref, pcols, lchnk) - call outfld('QREFHT', cam_in%qref, pcols, lchnk) - call outfld('U10', cam_in%u10, pcols, lchnk) - ! - ! Calculate and output reference height RH (RHREFHT) - - call qsat(cam_in%tref(:ncol), state%ps(:ncol), tem2(:ncol), ftem(:ncol)) - ftem(:ncol) = cam_in%qref(:ncol)/ftem(:ncol)*100._r8 - - - call outfld('RHREFHT', ftem, pcols, lchnk) - - -#if (defined BFB_CAM_SCAM_IOP ) - call outfld('shflx ',cam_in%shf, pcols, lchnk) - call outfld('lhflx ',cam_in%lhf, pcols, lchnk) - call outfld('trefht ',cam_in%tref, pcols, lchnk) -#endif - ! - ! Ouput ocn and ice fractions - ! - call outfld('LANDFRAC', cam_in%landfrac, pcols, lchnk) - call outfld('ICEFRAC', cam_in%icefrac, pcols, lchnk) - call outfld('OCNFRAC', cam_in%ocnfrac, pcols, lchnk) - ! - ! Compute daily minimum and maximum of TREF - ! - call pbuf_get_field(pbuf, trefmxav_idx, trefmxav) - call pbuf_get_field(pbuf, trefmnav_idx, trefmnav) - do i = 1,ncol - trefmxav(i) = max(cam_in%tref(i),trefmxav(i)) - trefmnav(i) = min(cam_in%tref(i),trefmnav(i)) - end do - if (is_end_curr_day()) then - call outfld('TREFMXAV', trefmxav,pcols, lchnk ) - call outfld('TREFMNAV', trefmnav,pcols, lchnk ) - trefmxav(:ncol) = -1.0e36_r8 - trefmnav(:ncol) = 1.0e36_r8 - endif - - call outfld('TBOT', cam_out%tbot, pcols, lchnk) - call outfld('TS', cam_in%ts, pcols, lchnk) - call outfld('TSMN', cam_in%ts, pcols, lchnk) - call outfld('TSMX', cam_in%ts, pcols, lchnk) - call outfld('SNOWHLND', cam_in%snowhland, pcols, lchnk) - call outfld('SNOWHICE', cam_in%snowhice, pcols, lchnk) - call outfld('ASDIR', cam_in%asdir, pcols, lchnk) - call outfld('ASDIF', cam_in%asdif, pcols, lchnk) - call outfld('ALDIR', cam_in%aldir, pcols, lchnk) - call outfld('ALDIF', cam_in%aldif, pcols, lchnk) - call outfld('SST', cam_in%sst, pcols, lchnk) - - if (co2_transport()) then - do m = 1,4 - call outfld(sflxnam(c_i(m)), cam_in%cflx(:,c_i(m)), pcols, lchnk) - end do - end if - end if - - end subroutine diag_surf - -!=============================================================================== - - subroutine diag_export(cam_out) - - !----------------------------------------------------------------------- - ! - ! Purpose: Write export state to history file - ! - !----------------------------------------------------------------------- - - ! arguments - type(cam_out_t), intent(inout) :: cam_out - - ! Local variables: - integer :: lchnk ! chunk identifier - logical :: atm_dep_flux ! true ==> sending deposition fluxes to coupler. - ! Otherwise, set them to zero. - !----------------------------------------------------------------------- - - lchnk = cam_out%lchnk - - call phys_getopts(atm_dep_flux_out=atm_dep_flux) - - if (.not. atm_dep_flux) then - ! set the fluxes to zero before outfld and sending them to the - ! coupler - cam_out%bcphiwet = 0.0_r8 - cam_out%bcphidry = 0.0_r8 - cam_out%bcphodry = 0.0_r8 - cam_out%ocphiwet = 0.0_r8 - cam_out%ocphidry = 0.0_r8 - cam_out%ocphodry = 0.0_r8 - cam_out%dstwet1 = 0.0_r8 - cam_out%dstdry1 = 0.0_r8 - cam_out%dstwet2 = 0.0_r8 - cam_out%dstdry2 = 0.0_r8 - cam_out%dstwet3 = 0.0_r8 - cam_out%dstdry3 = 0.0_r8 - cam_out%dstwet4 = 0.0_r8 - cam_out%dstdry4 = 0.0_r8 - end if - - if (moist_physics) then - call outfld('a2x_BCPHIWET', cam_out%bcphiwet, pcols, lchnk) - call outfld('a2x_BCPHIDRY', cam_out%bcphidry, pcols, lchnk) - call outfld('a2x_BCPHODRY', cam_out%bcphodry, pcols, lchnk) - call outfld('a2x_OCPHIWET', cam_out%ocphiwet, pcols, lchnk) - call outfld('a2x_OCPHIDRY', cam_out%ocphidry, pcols, lchnk) - call outfld('a2x_OCPHODRY', cam_out%ocphodry, pcols, lchnk) - call outfld('a2x_DSTWET1', cam_out%dstwet1, pcols, lchnk) - call outfld('a2x_DSTDRY1', cam_out%dstdry1, pcols, lchnk) - call outfld('a2x_DSTWET2', cam_out%dstwet2, pcols, lchnk) - call outfld('a2x_DSTDRY2', cam_out%dstdry2, pcols, lchnk) - call outfld('a2x_DSTWET3', cam_out%dstwet3, pcols, lchnk) - call outfld('a2x_DSTDRY3', cam_out%dstdry3, pcols, lchnk) - call outfld('a2x_DSTWET4', cam_out%dstwet4, pcols, lchnk) - call outfld('a2x_DSTDRY4', cam_out%dstdry4, pcols, lchnk) - end if - - end subroutine diag_export - -!####################################################################### - - subroutine diag_physvar_ic (lchnk, pbuf, cam_out, cam_in) - ! - !--------------------------------------------- - ! - ! Purpose: record physics variables on IC file - ! - !--------------------------------------------- - ! - - ! - ! Arguments - ! - integer , intent(in) :: lchnk ! chunk identifier - type(physics_buffer_desc), pointer :: pbuf(:) - - type(cam_out_t), intent(inout) :: cam_out - type(cam_in_t), intent(inout) :: cam_in - ! - !---------------------------Local workspace----------------------------- - ! - integer :: k ! indices - integer :: itim_old ! indices - - real(r8), pointer, dimension(:,:) :: cwat_var - real(r8), pointer, dimension(:,:) :: conv_var_3d - real(r8), pointer, dimension(: ) :: conv_var_2d - real(r8), pointer :: tpert(:), pblh(:), qpert(:) - ! - !----------------------------------------------------------------------- - ! - if( write_inithist() .and. moist_physics ) then - - ! - ! Associate pointers with physics buffer fields - ! - itim_old = pbuf_old_tim_idx() - - if (qcwat_idx > 0) then - call pbuf_get_field(pbuf, qcwat_idx, cwat_var, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) - call outfld('QCWAT&IC ',cwat_var, pcols,lchnk) - end if - - if (tcwat_idx > 0) then - call pbuf_get_field(pbuf, tcwat_idx, cwat_var, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) - call outfld('TCWAT&IC ',cwat_var, pcols,lchnk) - end if - - if (lcwat_idx > 0) then - call pbuf_get_field(pbuf, lcwat_idx, cwat_var, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) - call outfld('LCWAT&IC ',cwat_var, pcols,lchnk) - end if - - if (cld_idx > 0) then - call pbuf_get_field(pbuf, cld_idx, cwat_var, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) - call outfld('CLOUD&IC ',cwat_var, pcols,lchnk) - end if - - if (concld_idx > 0) then - call pbuf_get_field(pbuf, concld_idx, cwat_var, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) - call outfld('CONCLD&IC ',cwat_var, pcols,lchnk) - end if - - if (cush_idx > 0) then - call pbuf_get_field(pbuf, cush_idx, conv_var_2d ,(/1,itim_old/), (/pcols,1/)) - call outfld('CUSH&IC ',conv_var_2d, pcols,lchnk) - - end if - - if (tke_idx > 0) then - call pbuf_get_field(pbuf, tke_idx, conv_var_3d) - call outfld('TKE&IC ',conv_var_3d, pcols,lchnk) - end if - - if (kvm_idx > 0) then - call pbuf_get_field(pbuf, kvm_idx, conv_var_3d) - call outfld('KVM&IC ',conv_var_3d, pcols,lchnk) - end if - - if (kvh_idx > 0) then - call pbuf_get_field(pbuf, kvh_idx, conv_var_3d) - call outfld('KVH&IC ',conv_var_3d, pcols,lchnk) - end if - - if (qpert_idx > 0) then - call pbuf_get_field(pbuf, qpert_idx, qpert) - call outfld('QPERT&IC ', qpert, pcols, lchnk) - end if - - if (pblh_idx > 0) then - call pbuf_get_field(pbuf, pblh_idx, pblh) - call outfld('PBLH&IC ', pblh, pcols, lchnk) - end if - - if (tpert_idx > 0) then - call pbuf_get_field(pbuf, tpert_idx, tpert) - call outfld('TPERT&IC ', tpert, pcols, lchnk) - end if - - end if - - end subroutine diag_physvar_ic - - -!####################################################################### - - subroutine diag_phys_tend_writeout_dry(state, pbuf, tend, ztodt) - - !--------------------------------------------------------------- - ! - ! Purpose: Dump physics tendencies for temperature - ! - !--------------------------------------------------------------- - - use check_energy, only: check_energy_get_integrals - use physconst, only: cpair - - ! Arguments - - type(physics_state), intent(in) :: state - - type(physics_buffer_desc), pointer :: pbuf(:) - type(physics_tend ), intent(in) :: tend - real(r8), intent(in) :: ztodt ! physics timestep - - !---------------------------Local workspace----------------------------- - - integer :: lchnk ! chunk index - integer :: ncol ! number of columns in chunk - real(r8) :: ftem2(pcols) ! Temporary workspace for outfld variables - real(r8) :: ftem3(pcols,pver) ! Temporary workspace for outfld variables - real(r8) :: heat_glob ! global energy integral (FV only) - ! CAM pointers to get variables from the physics buffer - real(r8), pointer, dimension(:,:) :: t_ttend - integer :: itim_old,m - - !----------------------------------------------------------------------- - - lchnk = state%lchnk - ncol = state%ncol - - ! Dump out post-physics state (FV only) - - call outfld('TAP', state%t, pcols, lchnk ) - call outfld('UAP', state%u, pcols, lchnk ) - call outfld('VAP', state%v, pcols, lchnk ) - - ! Total physics tendency for Temperature - ! (remove global fixer tendency from total for FV and SE dycores) - - if (dycore_is('LR') .or. dycore_is('SE')) then - call check_energy_get_integrals( heat_glob_out=heat_glob ) - ftem2(:ncol) = heat_glob/cpair - call outfld('TFIX', ftem2, pcols, lchnk ) - ftem3(:ncol,:pver) = tend%dtdt(:ncol,:pver) - heat_glob/cpair - else - ftem3(:ncol,:pver) = tend%dtdt(:ncol,:pver) - end if - call outfld('PTTEND',ftem3, pcols, lchnk ) - - ! Total (physics+dynamics, everything!) tendency for Temperature - - !! get temperature stored in physics buffer - itim_old = pbuf_old_tim_idx() - call pbuf_get_field(pbuf, t_ttend_idx, t_ttend, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) - - !! calculate and outfld the total temperature tendency - ftem3(:ncol,:) = (state%t(:ncol,:) - t_ttend(:ncol,:))/ztodt - call outfld('TTEND_TOT', ftem3, pcols, lchnk) - - !! update physics buffer with this time-step's temperature - t_ttend(:ncol,:) = state%t(:ncol,:) - - end subroutine diag_phys_tend_writeout_dry - -!####################################################################### - - subroutine diag_phys_tend_writeout_moist(state, pbuf, tend, ztodt, & - tmp_q, tmp_cldliq, tmp_cldice, qini, cldliqini, cldiceini) - - !--------------------------------------------------------------- - ! - ! Purpose: Dump physics tendencies for moisture - ! - !--------------------------------------------------------------- - - ! Arguments - - type(physics_state), intent(in) :: state - - type(physics_buffer_desc), pointer :: pbuf(:) - type(physics_tend ), intent(in) :: tend - real(r8), intent(in) :: ztodt ! physics timestep - real(r8), intent(inout) :: tmp_q (pcols,pver) ! As input, holds pre-adjusted tracers (FV) - real(r8), intent(inout) :: tmp_cldliq(pcols,pver) ! As input, holds pre-adjusted tracers (FV) - real(r8), intent(inout) :: tmp_cldice(pcols,pver) ! As input, holds pre-adjusted tracers (FV) - real(r8), intent(in) :: qini (pcols,pver) ! tracer fields at beginning of physics - real(r8), intent(in) :: cldliqini (pcols,pver) ! tracer fields at beginning of physics - real(r8), intent(in) :: cldiceini (pcols,pver) ! tracer fields at beginning of physics - - !---------------------------Local workspace----------------------------- - - integer :: lchnk ! chunk index - integer :: ncol ! number of columns in chunk - real(r8) :: ftem3(pcols,pver) ! Temporary workspace for outfld variables - real(r8) :: rtdt - integer :: ixcldice, ixcldliq! constituent indices for cloud liquid and ice water. - - lchnk = state%lchnk - ncol = state%ncol - rtdt = 1._r8/ztodt - call cnst_get_ind('CLDLIQ', ixcldliq, abort=.false.) - call cnst_get_ind('CLDICE', ixcldice, abort=.false.) - - if ( cnst_cam_outfld( 1) ) then - call outfld (apcnst( 1), state%q(1,1, 1), pcols, lchnk) - end if - if (ixcldliq > 0) then - if (cnst_cam_outfld(ixcldliq)) then - call outfld (apcnst(ixcldliq), state%q(1,1,ixcldliq), pcols, lchnk) - end if - end if - if (ixcldice > 0) then - if ( cnst_cam_outfld(ixcldice) ) then - call outfld (apcnst(ixcldice), state%q(1,1,ixcldice), pcols, lchnk) - end if - end if - - ! Tendency for dry mass adjustment of q (FV only) - - if (dycore_is('LR')) then - tmp_q (:ncol,:pver) = (state%q(:ncol,:pver, 1) - tmp_q (:ncol,:pver))*rtdt - if (ixcldliq > 0) then - tmp_cldliq(:ncol,:pver) = (state%q(:ncol,:pver,ixcldliq) - tmp_cldliq(:ncol,:pver))*rtdt - else - tmp_cldliq(:ncol,:pver) = 0.0_r8 - end if - if (ixcldice > 0) then - tmp_cldice(:ncol,:pver) = (state%q(:ncol,:pver,ixcldice) - tmp_cldice(:ncol,:pver))*rtdt - else - tmp_cldice(:ncol,:pver) = 0.0_r8 - end if - if ( cnst_cam_outfld( 1) ) then - call outfld (dmetendnam( 1), tmp_q , pcols, lchnk) - end if - if (ixcldliq > 0) then - if ( cnst_cam_outfld(ixcldliq) ) then - call outfld (dmetendnam(ixcldliq), tmp_cldliq, pcols, lchnk) - end if - end if - if (ixcldice > 0) then - if ( cnst_cam_outfld(ixcldice) ) then - call outfld (dmetendnam(ixcldice), tmp_cldice, pcols, lchnk) - end if - end if - end if - - ! Total physics tendency for moisture and other tracers - - if ( cnst_cam_outfld( 1) ) then - ftem3(:ncol,:pver) = (state%q(:ncol,:pver, 1) - qini (:ncol,:pver) )*rtdt - call outfld (ptendnam( 1), ftem3, pcols, lchnk) - end if - if (ixcldliq > 0) then - if (cnst_cam_outfld(ixcldliq) ) then - ftem3(:ncol,:pver) = (state%q(:ncol,:pver,ixcldliq) - cldliqini(:ncol,:pver) )*rtdt - call outfld (ptendnam(ixcldliq), ftem3, pcols, lchnk) - end if - end if - if (ixcldice > 0) then - if ( cnst_cam_outfld(ixcldice) ) then - ftem3(:ncol,:pver) = (state%q(:ncol,:pver,ixcldice) - cldiceini(:ncol,:pver) )*rtdt - call outfld (ptendnam(ixcldice), ftem3, pcols, lchnk) - end if - end if - - end subroutine diag_phys_tend_writeout_moist - -!####################################################################### - - subroutine diag_phys_tend_writeout(state, pbuf, tend, ztodt, & - tmp_q, tmp_cldliq, tmp_cldice, qini, cldliqini, cldiceini) - - !--------------------------------------------------------------- - ! - ! Purpose: Dump physics tendencies for moisture and temperature - ! - !--------------------------------------------------------------- - - ! Arguments - - type(physics_state), intent(in) :: state - - type(physics_buffer_desc), pointer :: pbuf(:) - type(physics_tend ), intent(in) :: tend - real(r8), intent(in) :: ztodt ! physics timestep - real(r8) , intent(inout) :: tmp_q (pcols,pver) ! As input, holds pre-adjusted tracers (FV) - real(r8), intent(inout) :: tmp_cldliq(pcols,pver) ! As input, holds pre-adjusted tracers (FV) - real(r8), intent(inout) :: tmp_cldice(pcols,pver) ! As input, holds pre-adjusted tracers (FV) - real(r8), intent(in) :: qini (pcols,pver) ! tracer fields at beginning of physics - real(r8), intent(in) :: cldliqini (pcols,pver) ! tracer fields at beginning of physics - real(r8), intent(in) :: cldiceini (pcols,pver) ! tracer fields at beginning of physics - - !----------------------------------------------------------------------- - - call diag_phys_tend_writeout_dry(state, pbuf, tend, ztodt) - if (moist_physics) then - call diag_phys_tend_writeout_moist(state, pbuf, tend, ztodt, & - tmp_q, tmp_cldliq, tmp_cldice, qini, cldliqini, cldiceini) - end if - - end subroutine diag_phys_tend_writeout - -!####################################################################### - - subroutine diag_state_b4_phys_write_dry (state) - ! - !--------------------------------------------------------------- - ! - ! Purpose: Dump dry state just prior to executing physics - ! - !--------------------------------------------------------------- - ! - ! Arguments - ! - type(physics_state), intent(in) :: state - ! - !---------------------------Local workspace----------------------------- - ! - integer :: lchnk ! chunk index - ! - !----------------------------------------------------------------------- - ! - lchnk = state%lchnk - - call outfld('TBP', state%t, pcols, lchnk ) - - end subroutine diag_state_b4_phys_write_dry - - subroutine diag_state_b4_phys_write_moist (state) - ! - !--------------------------------------------------------------- - ! - ! Purpose: Dump moist state just prior to executing physics - ! - !--------------------------------------------------------------- - ! - ! Arguments - ! - type(physics_state), intent(in) :: state - ! - !---------------------------Local workspace----------------------------- - ! - integer :: ixcldice, ixcldliq ! constituent indices for cloud liquid and ice water. - integer :: lchnk ! chunk index - ! - !----------------------------------------------------------------------- - ! - lchnk = state%lchnk - - call cnst_get_ind('CLDLIQ', ixcldliq, abort=.false.) - call cnst_get_ind('CLDICE', ixcldice, abort=.false.) - - if ( cnst_cam_outfld( 1) ) then - call outfld (bpcnst( 1), state%q(1,1, 1), pcols, lchnk) - end if - if (ixcldliq > 0) then - if (cnst_cam_outfld(ixcldliq)) then - call outfld (bpcnst(ixcldliq), state%q(1,1,ixcldliq), pcols, lchnk) - end if - end if - if (ixcldice > 0) then - if (cnst_cam_outfld(ixcldice)) then - call outfld (bpcnst(ixcldice), state%q(1,1,ixcldice), pcols, lchnk) - end if - end if - - end subroutine diag_state_b4_phys_write_moist - - subroutine diag_state_b4_phys_write (state) - ! - !--------------------------------------------------------------- - ! - ! Purpose: Dump state just prior to executing physics - ! - !--------------------------------------------------------------- - ! - ! Arguments - ! - type(physics_state), intent(in) :: state - ! - - call diag_state_b4_phys_write_dry(state) - if (moist_physics) then - call diag_state_b4_phys_write_moist(state) - end if - end subroutine diag_state_b4_phys_write - -end module cam_diagnostics diff --git a/src/physics/cam/check_energy.F90.orig b/src/physics/cam/check_energy.F90.orig deleted file mode 100644 index 52ed54066f..0000000000 --- a/src/physics/cam/check_energy.F90.orig +++ /dev/null @@ -1,976 +0,0 @@ - -module check_energy - -!--------------------------------------------------------------------------------- -! Purpose: -! -! Module to check -! 1. vertically integrated total energy and water conservation for each -! column within the physical parameterizations -! -! 2. global mean total energy conservation between the physics output state -! and the input state on the next time step. -! -! 3. add a globally uniform heating term to account for any change of total energy in 2. -! -! Author: Byron Boville Oct 31, 2002 -! -! Modifications: -! 03.03.29 Boville Add global energy check and fixer. -! -!--------------------------------------------------------------------------------- - - use shr_kind_mod, only: r8 => shr_kind_r8 - use ppgrid, only: pcols, pver, begchunk, endchunk - use spmd_utils, only: masterproc - - use gmean_mod, only: gmean - use physconst, only: gravit, latvap, latice, cpair, cpairv - use physics_types, only: physics_state, physics_tend, physics_ptend, physics_ptend_init - use constituents, only: cnst_get_ind, pcnst, cnst_name, cnst_get_type_byind - use time_manager, only: is_first_step - use cam_logfile, only: iulog - - implicit none - private - -! Public types: - public check_tracers_data - -! Public methods - public :: check_energy_readnl ! read namelist values - public :: check_energy_register ! register fields in physics buffer - public :: check_energy_get_integrals ! get energy integrals computed in check_energy_gmean - public :: check_energy_init ! initialization of module - public :: check_energy_timestep_init ! timestep initialization of energy integrals and cumulative boundary fluxes - public :: check_energy_chng ! check changes in integrals against cumulative boundary fluxes - public :: check_energy_gmean ! global means of physics input and output total energy - public :: check_energy_fix ! add global mean energy difference as a heating - public :: check_tracers_init ! initialize tracer integrals and cumulative boundary fluxes - public :: check_tracers_chng ! check changes in integrals against cumulative boundary fluxes - - public :: calc_te_and_aam_budgets ! calculate and output total energy and axial angular momentum diagnostics - -! Private module data - - logical :: print_energy_errors = .false. - - real(r8) :: teout_glob ! global mean energy of output state - real(r8) :: teinp_glob ! global mean energy of input state - real(r8) :: tedif_glob ! global mean energy difference - real(r8) :: psurf_glob ! global mean surface pressure - real(r8) :: ptopb_glob ! global mean top boundary pressure - real(r8) :: heat_glob ! global mean heating rate - -! Physics buffer indices - - integer :: teout_idx = 0 ! teout index in physics buffer - integer :: dtcore_idx = 0 ! dtcore index in physics buffer - - type check_tracers_data - real(r8) :: tracer(pcols,pcnst) ! initial vertically integrated total (kinetic + static) energy - real(r8) :: tracer_tnd(pcols,pcnst) ! cumulative boundary flux of total energy - integer :: count(pcnst) ! count of values with significant imbalances - end type check_tracers_data - - -!=============================================================================== -contains -!=============================================================================== - -subroutine check_energy_readnl(nlfile) - - use namelist_utils, only: find_group_name - use units, only: getunit, freeunit - use spmd_utils, only: mpicom, mstrid=>masterprocid, mpi_logical - use cam_abortutils, only: endrun - - character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input - - ! Local variables - integer :: unitn, ierr - character(len=*), parameter :: sub = 'check_energy_readnl' - - namelist /check_energy_nl/ print_energy_errors - !----------------------------------------------------------------------------- - - ! Read namelist - if (masterproc) then - unitn = getunit() - open( unitn, file=trim(nlfile), status='old' ) - call find_group_name(unitn, 'check_energy_nl', status=ierr) - if (ierr == 0) then - read(unitn, check_energy_nl, iostat=ierr) - if (ierr /= 0) then - call endrun(sub//': FATAL: reading namelist') - end if - end if - close(unitn) - call freeunit(unitn) - end if - - call mpi_bcast(print_energy_errors, 1, mpi_logical, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: print_energy_errors") - - if (masterproc) then - write(iulog,*) 'check_energy options:' - write(iulog,*) ' print_energy_errors =', print_energy_errors - end if - -end subroutine check_energy_readnl - -!=============================================================================== - - subroutine check_energy_register() -! -! Register fields in the physics buffer. -! -!----------------------------------------------------------------------- - - use physics_buffer, only : pbuf_add_field, dtype_r8, dyn_time_lvls - use physics_buffer, only : pbuf_register_subcol - use subcol_utils, only : is_subcol_on - -!----------------------------------------------------------------------- - -! Request physics buffer space for fields that persist across timesteps. - - call pbuf_add_field('TEOUT', 'global',dtype_r8 , (/pcols,dyn_time_lvls/), teout_idx) - call pbuf_add_field('DTCORE','global',dtype_r8, (/pcols,pver,dyn_time_lvls/),dtcore_idx) - if(is_subcol_on()) then - call pbuf_register_subcol('TEOUT', 'phys_register', teout_idx) - call pbuf_register_subcol('DTCORE', 'phys_register', dtcore_idx) - end if - - end subroutine check_energy_register - -!=============================================================================== - -subroutine check_energy_get_integrals( tedif_glob_out, heat_glob_out ) - -!----------------------------------------------------------------------- -! Purpose: Return energy integrals -!----------------------------------------------------------------------- - - real(r8), intent(out), optional :: tedif_glob_out - real(r8), intent(out), optional :: heat_glob_out - -!----------------------------------------------------------------------- - - if ( present(tedif_glob_out) ) then - tedif_glob_out = tedif_glob - endif - if ( present(heat_glob_out) ) then - heat_glob_out = heat_glob - endif - -end subroutine check_energy_get_integrals - -!================================================================================================ - - subroutine check_energy_init() -! -! Initialize the energy conservation module -! -!----------------------------------------------------------------------- - use cam_history, only: addfld, add_default, horiz_only - use phys_control, only: phys_getopts - - implicit none - - logical :: history_budget, history_waccm - integer :: history_budget_histfile_num ! output history file number for budget fields - -!----------------------------------------------------------------------- - - call phys_getopts( history_budget_out = history_budget, & - history_budget_histfile_num_out = history_budget_histfile_num, & - history_waccm_out = history_waccm ) - -! register history variables - call addfld('TEINP', horiz_only, 'A', 'J/m2', 'Total energy of physics input') - call addfld('TEOUT', horiz_only, 'A', 'J/m2', 'Total energy of physics output') - call addfld('TEFIX', horiz_only, 'A', 'J/m2', 'Total energy after fixer') - call addfld('EFIX', horiz_only, 'A', 'W/m2', 'Effective sensible heat flux due to energy fixer') - call addfld('DTCORE', (/ 'lev' /), 'A', 'K/s' , 'T tendency due to dynamical core') - - if ( history_budget ) then - call add_default ('DTCORE', history_budget_histfile_num, ' ') - end if - if ( history_waccm ) then - call add_default ('DTCORE', 1, ' ') - end if - - end subroutine check_energy_init - -!=============================================================================== - - subroutine check_energy_timestep_init(state, tend, pbuf, col_type) - use physics_buffer, only : physics_buffer_desc, pbuf_set_field - use cam_abortutils, only: endrun -!----------------------------------------------------------------------- -! Compute initial values of energy and water integrals, -! zero cumulative tendencies -!----------------------------------------------------------------------- -!------------------------------Arguments-------------------------------- - - type(physics_state), intent(inout) :: state - type(physics_tend ), intent(inout) :: tend - type(physics_buffer_desc), pointer :: pbuf(:) - integer, optional :: col_type ! Flag inidicating whether using grid or subcolumns -!---------------------------Local storage------------------------------- - - real(r8) :: ke(state%ncol) ! vertical integral of kinetic energy - real(r8) :: se(state%ncol) ! vertical integral of static energy - real(r8) :: wv(state%ncol) ! vertical integral of water (vapor) - real(r8) :: wl(state%ncol) ! vertical integral of water (liquid) - real(r8) :: wi(state%ncol) ! vertical integral of water (ice) - - real(r8),allocatable :: cpairv_loc(:,:,:) - - integer lchnk ! chunk identifier - integer ncol ! number of atmospheric columns - integer i,k ! column, level indices - integer :: ixcldice, ixcldliq ! CLDICE and CLDLIQ indices - integer :: ixrain, ixsnow ! RAINQM and SNOWQM indices -!----------------------------------------------------------------------- - - lchnk = state%lchnk - ncol = state%ncol - call cnst_get_ind('CLDICE', ixcldice, abort=.false.) - call cnst_get_ind('CLDLIQ', ixcldliq, abort=.false.) - call cnst_get_ind('RAINQM', ixrain, abort=.false.) - call cnst_get_ind('SNOWQM', ixsnow, abort=.false.) - - ! cpairv_loc needs to be allocated to a size which matches state and ptend - ! If psetcols == pcols, cpairv is the correct size and just copy into cpairv_loc - ! If psetcols > pcols and all cpairv match cpair, then assign the constant cpair - - if (state%psetcols == pcols) then - allocate (cpairv_loc(state%psetcols,pver,begchunk:endchunk)) - cpairv_loc(:,:,:) = cpairv(:,:,:) - else if (state%psetcols > pcols .and. all(cpairv(:,:,:) == cpair)) then - allocate(cpairv_loc(state%psetcols,pver,begchunk:endchunk)) - cpairv_loc(:,:,:) = cpair - else - call endrun('check_energy_timestep_init: cpairv is not allowed to vary when subcolumns are turned on') - end if - - ! Compute vertical integrals of dry static energy (modified), kinetic energy and water (vapor, liquid, ice) - ke = 0._r8 - se = 0._r8 - wv = 0._r8 - wl = 0._r8 - wi = 0._r8 - do k = 1, pver - do i = 1, ncol - ke(i) = ke(i) + 0.5_r8*(state%u(i,k)**2 + state%v(i,k)**2)*state%pdel(i,k)/gravit - se(i) = se(i) + state%t(i,k)*cpairv_loc(i,k,lchnk)*state%pdel(i,k)/gravit - wv(i) = wv(i) + state%q(i,k,1) *state%pdel(i,k)/gravit - end do - end do - do i = 1, ncol - se(i) = se(i) + state%phis(i)*state%ps(i)/gravit - end do - - ! Don't require cloud liq/ice to be present. Allows for adiabatic/ideal phys. - if (ixcldliq > 1 .and. ixcldice > 1) then - do k = 1, pver - do i = 1, ncol - wl(i) = wl(i) + state%q(i,k,ixcldliq)*state%pdel(i,k)/gravit - wi(i) = wi(i) + state%q(i,k,ixcldice)*state%pdel(i,k)/gravit - end do - end do - end if - - ! Don't require precip either, if microphysics doesn't add it. - if (ixrain > 1 .and. ixsnow > 1) then - do k = 1, pver - do i = 1, ncol - wl(i) = wl(i) + state%q(i,k,ixrain)*state%pdel(i,k)/gravit - wi(i) = wi(i) + state%q(i,k,ixsnow)*state%pdel(i,k)/gravit - end do - end do - end if - -! Compute vertical integrals of frozen static energy and total water. - do i = 1, ncol - state%te_ini(i) = se(i) + ke(i) + (latvap+latice)*wv(i) + latice*wl(i) - state%tw_ini(i) = wv(i) + wl(i) + wi(i) - - state%te_cur(i) = state%te_ini(i) - state%tw_cur(i) = state%tw_ini(i) - end do - -! zero cummulative boundary fluxes - tend%te_tnd(:ncol) = 0._r8 - tend%tw_tnd(:ncol) = 0._r8 - - state%count = 0 - -! initialize physics buffer - if (is_first_step()) then - call pbuf_set_field(pbuf, teout_idx, state%te_ini, col_type=col_type) - end if - - deallocate(cpairv_loc) - - end subroutine check_energy_timestep_init - -!=============================================================================== - - subroutine check_energy_chng(state, tend, name, nstep, ztodt, & - flx_vap, flx_cnd, flx_ice, flx_sen) - use cam_abortutils, only: endrun - -!----------------------------------------------------------------------- -! Check that the energy and water change matches the boundary fluxes -!----------------------------------------------------------------------- -!------------------------------Arguments-------------------------------- - - type(physics_state) , intent(inout) :: state - type(physics_tend ) , intent(inout) :: tend - character*(*),intent(in) :: name ! parameterization name for fluxes - integer , intent(in ) :: nstep ! current timestep number - real(r8), intent(in ) :: ztodt ! 2 delta t (model time increment) - real(r8), intent(in ) :: flx_vap(:) ! (pcols) - boundary flux of vapor (kg/m2/s) - real(r8), intent(in ) :: flx_cnd(:) ! (pcols) -boundary flux of liquid+ice (m/s) (precip?) - real(r8), intent(in ) :: flx_ice(:) ! (pcols) -boundary flux of ice (m/s) (snow?) - real(r8), intent(in ) :: flx_sen(:) ! (pcols) -boundary flux of sensible heat (w/m2) - -!******************** BAB ****************************************************** -!******* Note that the precip and ice fluxes are in precip units (m/s). ******** -!******* I would prefer to have kg/m2/s. ******** -!******* I would also prefer liquid (not total) and ice fluxes ******** -!******************************************************************************* - -!---------------------------Local storage------------------------------- - - real(r8) :: te_xpd(state%ncol) ! expected value (f0 + dt*boundary_flux) - real(r8) :: te_dif(state%ncol) ! energy of input state - original energy - real(r8) :: te_tnd(state%ncol) ! tendency from last process - real(r8) :: te_rer(state%ncol) ! relative error in energy column - - real(r8) :: tw_xpd(state%ncol) ! expected value (w0 + dt*boundary_flux) - real(r8) :: tw_dif(state%ncol) ! tw_inp - original water - real(r8) :: tw_tnd(state%ncol) ! tendency from last process - real(r8) :: tw_rer(state%ncol) ! relative error in water column - - real(r8) :: ke(state%ncol) ! vertical integral of kinetic energy - real(r8) :: se(state%ncol) ! vertical integral of static energy - real(r8) :: wv(state%ncol) ! vertical integral of water (vapor) - real(r8) :: wl(state%ncol) ! vertical integral of water (liquid) - real(r8) :: wi(state%ncol) ! vertical integral of water (ice) - - real(r8) :: te(state%ncol) ! vertical integral of total energy - real(r8) :: tw(state%ncol) ! vertical integral of total water - - real(r8),allocatable :: cpairv_loc(:,:,:) - - integer lchnk ! chunk identifier - integer ncol ! number of atmospheric columns - integer i,k ! column, level indices - integer :: ixcldice, ixcldliq ! CLDICE and CLDLIQ indices - integer :: ixrain, ixsnow ! RAINQM and SNOWQM indices -!----------------------------------------------------------------------- - - lchnk = state%lchnk - ncol = state%ncol - call cnst_get_ind('CLDICE', ixcldice, abort=.false.) - call cnst_get_ind('CLDLIQ', ixcldliq, abort=.false.) - call cnst_get_ind('RAINQM', ixrain, abort=.false.) - call cnst_get_ind('SNOWQM', ixsnow, abort=.false.) - - ! cpairv_loc needs to be allocated to a size which matches state and ptend - ! If psetcols == pcols, cpairv is the correct size and just copy into cpairv_loc - ! If psetcols > pcols and all cpairv match cpair, then assign the constant cpair - - if (state%psetcols == pcols) then - allocate (cpairv_loc(state%psetcols,pver,begchunk:endchunk)) - cpairv_loc(:,:,:) = cpairv(:,:,:) - else if (state%psetcols > pcols .and. all(cpairv(:,:,:) == cpair)) then - allocate(cpairv_loc(state%psetcols,pver,begchunk:endchunk)) - cpairv_loc(:,:,:) = cpair - else - call endrun('check_energy_chng: cpairv is not allowed to vary when subcolumns are turned on') - end if - - ! Compute vertical integrals of dry static energy (modified), kinetic energy and water (vapor, liquid, ice) - ke = 0._r8 - se = 0._r8 - wv = 0._r8 - wl = 0._r8 - wi = 0._r8 - do k = 1, pver - do i = 1, ncol - ke(i) = ke(i) + 0.5_r8*(state%u(i,k)**2 + state%v(i,k)**2)*state%pdel(i,k)/gravit - se(i) = se(i) + state%t(i,k)*cpairv_loc(i,k,lchnk)*state%pdel(i,k)/gravit - wv(i) = wv(i) + state%q(i,k,1) *state%pdel(i,k)/gravit - end do - end do - do i = 1, ncol - se(i) = se(i) + state%phis(i)*state%ps(i)/gravit - end do - - ! Don't require cloud liq/ice to be present. Allows for adiabatic/ideal phys. - if (ixcldliq > 1 .and. ixcldice > 1) then - do k = 1, pver - do i = 1, ncol - wl(i) = wl(i) + state%q(i,k,ixcldliq)*state%pdel(i,k)/gravit - wi(i) = wi(i) + state%q(i,k,ixcldice)*state%pdel(i,k)/gravit - end do - end do - end if - - ! Don't require precip either, if microphysics doesn't add it. - if (ixrain > 1 .and. ixsnow > 1) then - do k = 1, pver - do i = 1, ncol - wl(i) = wl(i) + state%q(i,k,ixrain)*state%pdel(i,k)/gravit - wi(i) = wi(i) + state%q(i,k,ixsnow)*state%pdel(i,k)/gravit - end do - end do - end if - - ! Compute vertical integrals of frozen static energy and total water. - do i = 1, ncol - te(i) = se(i) + ke(i) + (latvap+latice)*wv(i) + latice*wl(i) - tw(i) = wv(i) + wl(i) + wi(i) - end do - - ! compute expected values and tendencies - do i = 1, ncol - ! change in static energy and total water - te_dif(i) = te(i) - state%te_cur(i) - tw_dif(i) = tw(i) - state%tw_cur(i) - - ! expected tendencies from boundary fluxes for last process - te_tnd(i) = flx_vap(i)*(latvap+latice) - (flx_cnd(i) - flx_ice(i))*1000._r8*latice + flx_sen(i) - tw_tnd(i) = flx_vap(i) - flx_cnd(i) *1000._r8 - - ! cummulative tendencies from boundary fluxes - tend%te_tnd(i) = tend%te_tnd(i) + te_tnd(i) - tend%tw_tnd(i) = tend%tw_tnd(i) + tw_tnd(i) - - ! expected new values from previous state plus boundary fluxes - te_xpd(i) = state%te_cur(i) + te_tnd(i)*ztodt - tw_xpd(i) = state%tw_cur(i) + tw_tnd(i)*ztodt - - ! relative error, expected value - input state / previous state - te_rer(i) = (te_xpd(i) - te(i)) / state%te_cur(i) - end do - - ! relative error for total water (allow for dry atmosphere) - tw_rer = 0._r8 - where (state%tw_cur(:ncol) > 0._r8) - tw_rer(:ncol) = (tw_xpd(:ncol) - tw(:ncol)) / state%tw_cur(:ncol) - end where - - ! error checking - if (print_energy_errors) then - if (any(abs(te_rer(1:ncol)) > 1.E-14_r8 .or. abs(tw_rer(1:ncol)) > 1.E-10_r8)) then - do i = 1, ncol - ! the relative error threshold for the water budget has been reduced to 1.e-10 - ! to avoid messages generated by QNEG3 calls - ! PJR- change to identify if error in energy or water - if (abs(te_rer(i)) > 1.E-14_r8 ) then - state%count = state%count + 1 - write(iulog,*) "significant energy conservation error after ", name, & - " count", state%count, " nstep", nstep, "chunk", lchnk, "col", i - write(iulog,*) te(i),te_xpd(i),te_dif(i),tend%te_tnd(i)*ztodt, & - te_tnd(i)*ztodt,te_rer(i) - endif - if ( abs(tw_rer(i)) > 1.E-10_r8) then - state%count = state%count + 1 - write(iulog,*) "significant water conservation error after ", name, & - " count", state%count, " nstep", nstep, "chunk", lchnk, "col", i - write(iulog,*) tw(i),tw_xpd(i),tw_dif(i),tend%tw_tnd(i)*ztodt, & - tw_tnd(i)*ztodt,tw_rer(i) - end if - end do - end if - end if - - ! copy new value to state - do i = 1, ncol - state%te_cur(i) = te(i) - state%tw_cur(i) = tw(i) - end do - - deallocate(cpairv_loc) - - end subroutine check_energy_chng - - -!=============================================================================== - subroutine check_energy_gmean(state, pbuf2d, dtime, nstep) - - use physics_buffer, only : physics_buffer_desc, pbuf_get_field, pbuf_get_chunk - -!----------------------------------------------------------------------- -! Compute global mean total energy of physics input and output states -!----------------------------------------------------------------------- -!------------------------------Arguments-------------------------------- - - type(physics_state), intent(in ), dimension(begchunk:endchunk) :: state - type(physics_buffer_desc), pointer :: pbuf2d(:,:) - - real(r8), intent(in) :: dtime ! physics time step - integer , intent(in) :: nstep ! current timestep number - -!---------------------------Local storage------------------------------- - integer :: ncol ! number of active columns - integer :: lchnk ! chunk index - - real(r8) :: te(pcols,begchunk:endchunk,3) - ! total energy of input/output states (copy) - real(r8) :: te_glob(3) ! global means of total energy - real(r8), pointer :: teout(:) -!----------------------------------------------------------------------- - - ! Copy total energy out of input and output states - do lchnk = begchunk, endchunk - ncol = state(lchnk)%ncol - ! input energy - te(:ncol,lchnk,1) = state(lchnk)%te_ini(:ncol) - ! output energy - call pbuf_get_field(pbuf_get_chunk(pbuf2d,lchnk),teout_idx, teout) - - te(:ncol,lchnk,2) = teout(1:ncol) - ! surface pressure for heating rate - te(:ncol,lchnk,3) = state(lchnk)%pint(:ncol,pver+1) - end do - - ! Compute global means of input and output energies and of - ! surface pressure for heating rate (assume uniform ptop) - call gmean(te, te_glob, 3) - - if (begchunk .le. endchunk) then - teinp_glob = te_glob(1) - teout_glob = te_glob(2) - psurf_glob = te_glob(3) - ptopb_glob = state(begchunk)%pint(1,1) - - ! Global mean total energy difference - tedif_glob = teinp_glob - teout_glob - heat_glob = -tedif_glob/dtime * gravit / (psurf_glob - ptopb_glob) - - if (masterproc) then - write(iulog,'(1x,a9,1x,i8,4(1x,e25.17))') "nstep, te", nstep, teinp_glob, teout_glob, heat_glob, psurf_glob - end if - else - heat_glob = 0._r8 - end if ! (begchunk .le. endchunk) - - end subroutine check_energy_gmean - -!=============================================================================== - subroutine check_energy_fix(state, ptend, nstep, eshflx) - -!----------------------------------------------------------------------- -! Add heating rate required for global mean total energy conservation -!----------------------------------------------------------------------- -!------------------------------Arguments-------------------------------- - - type(physics_state), intent(in ) :: state - type(physics_ptend), intent(out) :: ptend - - integer , intent(in ) :: nstep ! time step number - real(r8), intent(out ) :: eshflx(pcols) ! effective sensible heat flux - -!---------------------------Local storage------------------------------- - integer :: i ! column - integer :: ncol ! number of atmospheric columns in chunk -!----------------------------------------------------------------------- - ncol = state%ncol - - call physics_ptend_init(ptend, state%psetcols, 'chkenergyfix', ls=.true.) - -#if ( defined OFFLINE_DYN ) - ! disable the energy fix for offline driver - heat_glob = 0._r8 -#endif -! add (-) global mean total energy difference as heating - ptend%s(:ncol,:pver) = heat_glob -!!$ write(iulog,*) "chk_fix: heat", state%lchnk, ncol, heat_glob - -! compute effective sensible heat flux - do i = 1, ncol - eshflx(i) = heat_glob * (state%pint(i,pver+1) - state%pint(i,1)) / gravit - end do -!!! if (nstep > 0) write(iulog,*) "heat", heat_glob, eshflx(1) - - return - end subroutine check_energy_fix - - -!=============================================================================== - subroutine check_tracers_init(state, tracerint) - -!----------------------------------------------------------------------- -! Compute initial values of tracers integrals, -! zero cumulative tendencies -!----------------------------------------------------------------------- - -!------------------------------Arguments-------------------------------- - - type(physics_state), intent(in) :: state - type(check_tracers_data), intent(out) :: tracerint - -!---------------------------Local storage------------------------------- - - real(r8) :: tr(pcols) ! vertical integral of tracer - real(r8) :: trpdel(pcols, pver) ! pdel for tracer - - integer ncol ! number of atmospheric columns - integer i,k,m ! column, level,constituent indices - integer :: ixcldice, ixcldliq ! CLDICE and CLDLIQ indices - integer :: ixrain, ixsnow ! RAINQM and SNOWQM indices - -!----------------------------------------------------------------------- - - ncol = state%ncol - call cnst_get_ind('CLDICE', ixcldice, abort=.false.) - call cnst_get_ind('CLDLIQ', ixcldliq, abort=.false.) - call cnst_get_ind('RAINQM', ixrain, abort=.false.) - call cnst_get_ind('SNOWQM', ixsnow, abort=.false.) - - do m = 1,pcnst - - if ( any(m == (/ 1, ixcldliq, ixcldice, & - ixrain, ixsnow /)) ) exit ! dont process water substances - ! they are checked in check_energy - if (cnst_get_type_byind(m).eq.'dry') then - trpdel(:ncol,:) = state%pdeldry(:ncol,:) - else - trpdel(:ncol,:) = state%pdel(:ncol,:) - endif - - ! Compute vertical integrals of tracer - tr = 0._r8 - do k = 1, pver - do i = 1, ncol - tr(i) = tr(i) + state%q(i,k,m)*trpdel(i,k)/gravit - end do - end do - - ! Compute vertical integrals of frozen static tracers and total water. - do i = 1, ncol - tracerint%tracer(i,m) = tr(i) - end do - - ! zero cummulative boundary fluxes - tracerint%tracer_tnd(:ncol,m) = 0._r8 - - tracerint%count(m) = 0 - - end do - - return - end subroutine check_tracers_init - -!=============================================================================== - subroutine check_tracers_chng(state, tracerint, name, nstep, ztodt, cflx) - -!----------------------------------------------------------------------- -! Check that the tracers and water change matches the boundary fluxes -! these checks are not save when there are tracers transformations, as -! they only check to see whether a mass change in the column is -! associated with a flux -!----------------------------------------------------------------------- - - use cam_abortutils, only: endrun - - - implicit none - -!------------------------------Arguments-------------------------------- - - type(physics_state) , intent(in ) :: state - type(check_tracers_data), intent(inout) :: tracerint! tracers integrals and boundary fluxes - character*(*),intent(in) :: name ! parameterization name for fluxes - integer , intent(in ) :: nstep ! current timestep number - real(r8), intent(in ) :: ztodt ! 2 delta t (model time increment) - real(r8), intent(in ) :: cflx(pcols,pcnst) ! boundary flux of tracers (kg/m2/s) - -!---------------------------Local storage------------------------------- - - real(r8) :: tracer_inp(pcols,pcnst) ! total tracer of new (input) state - real(r8) :: tracer_xpd(pcols,pcnst) ! expected value (w0 + dt*boundary_flux) - real(r8) :: tracer_dif(pcols,pcnst) ! tracer_inp - original tracer - real(r8) :: tracer_tnd(pcols,pcnst) ! tendency from last process - real(r8) :: tracer_rer(pcols,pcnst) ! relative error in tracer column - - real(r8) :: tr(pcols) ! vertical integral of tracer - real(r8) :: trpdel(pcols, pver) ! pdel for tracer - - integer lchnk ! chunk identifier - integer ncol ! number of atmospheric columns - integer i,k ! column, level indices - integer :: ixcldice, ixcldliq ! CLDICE and CLDLIQ indices - integer :: ixrain, ixsnow ! RAINQM and SNOWQM indices - integer :: m ! tracer index - character(len=8) :: tracname ! tracername -!----------------------------------------------------------------------- -!!$ if (.true.) return - - lchnk = state%lchnk - ncol = state%ncol - call cnst_get_ind('CLDICE', ixcldice, abort=.false.) - call cnst_get_ind('CLDLIQ', ixcldliq, abort=.false.) - call cnst_get_ind('RAINQM', ixrain, abort=.false.) - call cnst_get_ind('SNOWQM', ixsnow, abort=.false.) - - do m = 1,pcnst - - if ( any(m == (/ 1, ixcldliq, ixcldice, & - ixrain, ixsnow /)) ) exit ! dont process water substances - ! they are checked in check_energy - - tracname = cnst_name(m) - if (cnst_get_type_byind(m).eq.'dry') then - trpdel(:ncol,:) = state%pdeldry(:ncol,:) - else - trpdel(:ncol,:) = state%pdel(:ncol,:) - endif - - ! Compute vertical integrals tracers - tr = 0._r8 - do k = 1, pver - do i = 1, ncol - tr(i) = tr(i) + state%q(i,k,m)*trpdel(i,k)/gravit - end do - end do - - ! Compute vertical integrals of tracer - do i = 1, ncol - tracer_inp(i,m) = tr(i) - end do - - ! compute expected values and tendencies - do i = 1, ncol - ! change in tracers - tracer_dif(i,m) = tracer_inp(i,m) - tracerint%tracer(i,m) - - ! expected tendencies from boundary fluxes for last process - tracer_tnd(i,m) = cflx(i,m) - - ! cummulative tendencies from boundary fluxes - tracerint%tracer_tnd(i,m) = tracerint%tracer_tnd(i,m) + tracer_tnd(i,m) - - ! expected new values from original values plus boundary fluxes - tracer_xpd(i,m) = tracerint%tracer(i,m) + tracerint%tracer_tnd(i,m)*ztodt - - ! relative error, expected value - input value / original - tracer_rer(i,m) = (tracer_xpd(i,m) - tracer_inp(i,m)) / tracerint%tracer(i,m) - end do - -!! final loop for error checking -! do i = 1, ncol - -!! error messages -! if (abs(enrgy_rer(i)) > 1.E-14 .or. abs(water_rer(i)) > 1.E-14) then -! tracerint%count = tracerint%count + 1 -! write(iulog,*) "significant conservations error after ", name, & -! " count", tracerint%count, " nstep", nstep, "chunk", lchnk, "col", i -! write(iulog,*) enrgy_inp(i),enrgy_xpd(i),enrgy_dif(i),tracerint%enrgy_tnd(i)*ztodt, & -! enrgy_tnd(i)*ztodt,enrgy_rer(i) -! write(iulog,*) water_inp(i),water_xpd(i),water_dif(i),tracerint%water_tnd(i)*ztodt, & -! water_tnd(i)*ztodt,water_rer(i) -! end if -! end do - - - ! final loop for error checking - if ( maxval(tracer_rer) > 1.E-14_r8 ) then - write(iulog,*) "CHECK_TRACERS TRACER large rel error" - write(iulog,*) tracer_rer - endif - - do i = 1, ncol - ! error messages - if (abs(tracer_rer(i,m)) > 1.E-14_r8 ) then - tracerint%count = tracerint%count + 1 - write(iulog,*) "CHECK_TRACERS TRACER significant conservation error after ", name, & - " count", tracerint%count, " nstep", nstep, "chunk", lchnk, "col",i - write(iulog,*)' process name, tracname, index ', name, tracname, m - write(iulog,*)" input integral ",tracer_inp(i,m) - write(iulog,*)" expected integral ", tracer_xpd(i,m) - write(iulog,*)" input - inital integral ",tracer_dif(i,m) - write(iulog,*)" cumulative tend ",tracerint%tracer_tnd(i,m)*ztodt - write(iulog,*)" process tend ",tracer_tnd(i,m)*ztodt - write(iulog,*)" relative error ",tracer_rer(i,m) - call endrun() - end if - end do - end do - - return - end subroutine check_tracers_chng - -!####################################################################### - - subroutine calc_te_and_aam_budgets(state, outfld_name_suffix) - use physconst, only: gravit,cpair,pi,rearth,omega - use cam_history, only: hist_fld_active, outfld - -!------------------------------Arguments-------------------------------- - - type(physics_state), intent(inout) :: state - character*(*),intent(in) :: outfld_name_suffix ! suffix for "outfld" names - -!---------------------------Local storage------------------------------- - - real(r8) :: se(pcols) ! Dry Static energy (J/m2) - real(r8) :: ke(pcols) ! kinetic energy (J/m2) - real(r8) :: wv(pcols) ! column integrated vapor (kg/m2) - real(r8) :: wl(pcols) ! column integrated liquid (kg/m2) - real(r8) :: wi(pcols) ! column integrated ice (kg/m2) - real(r8) :: tt(pcols) ! column integrated test tracer (kg/m2) - real(r8) :: mr(pcols) ! column integrated wind axial angular momentum (kg*m2/s) - real(r8) :: mo(pcols) ! column integrated mass axial angular momentum (kg*m2/s) - real(r8) :: se_tmp,ke_tmp,wv_tmp,wl_tmp,wi_tmp,tt_tmp,mr_tmp,mo_tmp,cos_lat - real(r8) :: mr_cnst, mo_cnst - - integer lchnk ! chunk identifier - integer ncol ! number of atmospheric columns - integer i,k ! column, level indices - integer :: ixcldice, ixcldliq,ixtt ! CLDICE and CLDLIQ indices - character(len=16) :: name_out1,name_out2,name_out3,name_out4,name_out5,name_out6 -!----------------------------------------------------------------------- - - name_out1 = 'SE_' //trim(outfld_name_suffix) - name_out2 = 'KE_' //trim(outfld_name_suffix) - name_out3 = 'WV_' //trim(outfld_name_suffix) - name_out4 = 'WL_' //trim(outfld_name_suffix) - name_out5 = 'WI_' //trim(outfld_name_suffix) - name_out6 = 'TT_' //trim(outfld_name_suffix) - - if ( hist_fld_active(name_out1).or.hist_fld_active(name_out2).or.hist_fld_active(name_out3).or.& - hist_fld_active(name_out4).or.hist_fld_active(name_out5).or.hist_fld_active(name_out6)) then - - lchnk = state%lchnk - ncol = state%ncol - call cnst_get_ind('CLDICE', ixcldice, abort=.false.) - call cnst_get_ind('CLDLIQ', ixcldliq, abort=.false.) - call cnst_get_ind('TT_LW' , ixtt , abort=.false.) - - ! Compute frozen static energy in 3 parts: KE, SE, and energy associated with vapor and liquid - - se = 0._r8 - ke = 0._r8 - wv = 0._r8 - wl = 0._r8 - wi = 0._r8 - tt = 0._r8 - - do k = 1, pver - do i = 1, ncol - ke_tmp = 0.5_r8*(state%u(i,k)**2 + state%v(i,k)**2)*state%pdel(i,k)/gravit - se_tmp = cpair*state%t(i,k) *state%pdel(i,k)/gravit - wv_tmp = state%q(i,k,1 ) *state%pdel(i,k)/gravit - - se (i) = se (i) + se_tmp - ke (i) = ke (i) + ke_tmp - wv (i) = wv (i) + wv_tmp - end do - end do - do i = 1, ncol - se(i) = se(i) + state%phis(i)*state%ps(i)/gravit - end do - - ! Don't require cloud liq/ice to be present. Allows for adiabatic/ideal phys. - - if (ixcldliq > 1) then - do k = 1, pver - do i = 1, ncol - wl_tmp = state%q(i,k,ixcldliq)*state%pdel(i,k)/gravit - wl (i) = wl(i) + wl_tmp - end do - end do - end if - - if (ixcldice > 1) then - do k = 1, pver - do i = 1, ncol - wi_tmp = state%q(i,k,ixcldice)*state%pdel(i,k)/gravit - wi(i) = wi(i) + wi_tmp - end do - end do - end if - - if (ixtt > 1) then - if (name_out6 == 'TT_pAM') then - ! - ! after dme_adjust mixing ratios are all wet - ! - do k = 1, pver - do i = 1, ncol - tt_tmp = state%q(i,k,ixtt)*state%pdel(i,k)/gravit - tt (i) = tt(i) + tt_tmp - end do - end do - else - do k = 1, pver - do i = 1, ncol - tt_tmp = state%q(i,k,ixtt)*state%pdeldry(i,k)/gravit - tt (i) = tt(i) + tt_tmp - end do - end do - end if - end if - - ! Output energy diagnostics - - call outfld(name_out1 ,se , pcols ,lchnk ) - call outfld(name_out2 ,ke , pcols ,lchnk ) - call outfld(name_out3 ,wv , pcols ,lchnk ) - call outfld(name_out4 ,wl , pcols ,lchnk ) - call outfld(name_out5 ,wi , pcols ,lchnk ) - call outfld(name_out6 ,tt , pcols ,lchnk ) - end if - - - ! - ! Axial angular momentum diagnostics - ! - ! Code follows - ! - ! Lauritzen et al., (2014): Held-Suarez simulations with the Community Atmosphere Model - ! Spectral Element (CAM-SE) dynamical core: A global axial angularmomentum analysis using Eulerian - ! and floating Lagrangian vertical coordinates. J. Adv. Model. Earth Syst. 6,129-140, - ! doi:10.1002/2013MS000268 - ! - ! MR is equation (6) without \Delta A and sum over areas (areas are in units of radians**2) - ! MO is equation (7) without \Delta A and sum over areas (areas are in units of radians**2) - ! - name_out1 = 'MR_' //trim(outfld_name_suffix) - name_out2 = 'MO_' //trim(outfld_name_suffix) - - if ( hist_fld_active(name_out1).or.hist_fld_active(name_out2)) then - lchnk = state%lchnk - ncol = state%ncol - - mr_cnst = rearth**3/gravit - mo_cnst = omega*rearth**4/gravit - do k = 1, pver - do i = 1, ncol -<<<<<<< HEAD - cos_lat = cos(state%lat(i)) ! *180._r8/pi) !+tht bug fix -======= - cos_lat = cos(state%lat(i)) ->>>>>>> origin/featureCESMNCARBeta_trunk2.0-7 - mr_tmp = mr_cnst*state%u(i,k)*state%pdel(i,k)*cos_lat - mo_tmp = mo_cnst*state%pdel(i,k)*cos_lat**2 - - mr(i) = mr(i) + mr_tmp - mo(i) = mo(i) + mo_tmp - end do - end do - call outfld(name_out1 ,mr, pcols,lchnk ) - call outfld(name_out1 ,mo, pcols,lchnk ) - end if - end subroutine calc_te_and_aam_budgets - - -end module check_energy diff --git a/src/physics/cam/micro_mg2_0.F90.orig b/src/physics/cam/micro_mg2_0.F90.orig deleted file mode 100644 index fb0ed43875..0000000000 --- a/src/physics/cam/micro_mg2_0.F90.orig +++ /dev/null @@ -1,3177 +0,0 @@ -module micro_mg2_0 -!--------------------------------------------------------------------------------- -! Purpose: -! MG microphysics version 2.0 - Update of MG microphysics with -! prognostic precipitation. -! -! Author: Andrew Gettelman, Hugh Morrison, Sean Santos -! Contributions from: Peter Caldwell, Xiaohong Liu and Steve Ghan -! Version 2 history: Sep 2011: Development begun. -! Feb 2013: Added of prognostic precipitation. -! Aug 2015: Published and released version -! -! invoked in CAM by specifying -microphys=mg2.0 -! -! References: -! -! Gettelman, A. and H. Morrison, Advanced Two-Moment Microphysics for Global Models. -! -! Part I: Off line tests and comparisons with other schemes. -! -! J. Climate, 28, 1268-1287. doi: 10.1175/JCLI-D-14-00102.1, 2015. -! -! -! -! Gettelman, A., H. Morrison, S. Santos, P. Bogenschutz and P. H. Caldwell -! -! Advanced Two-Moment Microphysics for Global Models. -! -! Part II: Global model solutions and Aerosol-Cloud Interactions. -! -! J. Climate, 28, 1288-1307. doi:10.1175/JCLI-D-14-00103.1 , 2015. -! -! for questions contact Hugh Morrison, Andrew Gettelman -! e-mail: morrison@ucar.edu, andrew@ucar.edu -!--------------------------------------------------------------------------------- -! -! NOTE: Modified to allow other microphysics packages (e.g. CARMA) to do ice -! microphysics in cooperation with the MG liquid microphysics. This is -! controlled by the do_cldice variable. -! -! If do_cldice is false, then MG microphysics should not update CLDICE or -! NUMICE; it is assumed that the other microphysics scheme will have updated -! CLDICE and NUMICE. The other microphysics should handle the following -! processes that would have been done by MG: -! - Detrainment (liquid and ice) -! - Homogeneous ice nucleation -! - Heterogeneous ice nucleation -! - Bergeron process -! - Melting of ice -! - Freezing of cloud drops -! - Autoconversion (ice -> snow) -! - Growth/Sublimation of ice -! - Sedimentation of ice -! -! This option has not been updated since the introduction of prognostic -! precipitation, and probably should be adjusted to cover snow as well. -! -!--------------------------------------------------------------------------------- -! Based on micro_mg (restructuring of former cldwat2m_micro) -! Author: Andrew Gettelman, Hugh Morrison. -! Contributions from: Xiaohong Liu and Steve Ghan -! December 2005-May 2010 -! Description in: Morrison and Gettelman, 2008. J. Climate (MG2008) -! Gettelman et al., 2010 J. Geophys. Res. - Atmospheres (G2010) -! for questions contact Hugh Morrison, Andrew Gettelman -! e-mail: morrison@ucar.edu, andrew@ucar.edu -!--------------------------------------------------------------------------------- -! Code comments added by HM, 093011 -! General code structure: -! -! Code is divided into two main subroutines: -! subroutine micro_mg_init --> initializes microphysics routine, should be called -! once at start of simulation -! subroutine micro_mg_tend --> main microphysics routine to be called each time step -! this also calls several smaller subroutines to calculate -! microphysical processes and other utilities -! -! List of external functions: -! qsat_water --> for calculating saturation vapor pressure with respect to liquid water -! qsat_ice --> for calculating saturation vapor pressure with respect to ice -! gamma --> standard mathematical gamma function -! ......................................................................... -! List of inputs through use statement in fortran90: -! Variable Name Description Units -! ......................................................................... -! gravit acceleration due to gravity m s-2 -! rair dry air gas constant for air J kg-1 K-1 -! tmelt temperature of melting point for water K -! cpair specific heat at constant pressure for dry air J kg-1 K-1 -! rh2o gas constant for water vapor J kg-1 K-1 -! latvap latent heat of vaporization J kg-1 -! latice latent heat of fusion J kg-1 -! qsat_water external function for calculating liquid water -! saturation vapor pressure/humidity - -! qsat_ice external function for calculating ice -! saturation vapor pressure/humidity pa -! rhmini relative humidity threshold parameter for -! nucleating ice - -! ......................................................................... -! NOTE: List of all inputs/outputs passed through the call/subroutine statement -! for micro_mg_tend is given below at the start of subroutine micro_mg_tend. -!--------------------------------------------------------------------------------- - -! Procedures required: -! 1) An implementation of the gamma function (if not intrinsic). -! 2) saturation vapor pressure and specific humidity over water -! 3) svp over ice - -#ifndef HAVE_GAMMA_INTRINSICS -use shr_spfn_mod, only: gamma => shr_spfn_gamma -#endif - -use wv_sat_methods, only: & - qsat_water => wv_sat_qsat_water, & - qsat_ice => wv_sat_qsat_ice - -! Parameters from the utilities module. -use micro_mg_utils, only: & - r8, & - pi, & - omsm, & - qsmall, & - mincld, & - rhosn, & - rhoi, & - rhow, & - rhows, & - ac, bc, & - ai, bi, & - aj, bj, & - ar, br, & - as, bs, & - mi0, & - rising_factorial - -implicit none -private -save - -public :: & - micro_mg_init, & - micro_mg_get_cols, & - micro_mg_tend - -! Switches for specification rather than prediction of droplet and crystal number -! note: number will be adjusted as needed to keep mean size within bounds, -! even when specified droplet or ice number is used -! -! If constant cloud ice number is set (nicons = .true.), -! then all microphysical processes except mass transfer due to ice nucleation -! (mnuccd) are based on the fixed cloud ice number. Calculation of -! mnuccd follows from the prognosed ice crystal number ni. - -logical :: nccons ! nccons = .true. to specify constant cloud droplet number -logical :: nicons ! nicons = .true. to specify constant cloud ice number - -! specified ice and droplet number concentrations -! note: these are local in-cloud values, not grid-mean -real(r8) :: ncnst ! droplet num concentration when nccons=.true. (m-3) -real(r8) :: ninst ! ice num concentration when nicons=.true. (m-3) - -!========================================================= -! Private module parameters -!========================================================= - -!Range of cloudsat reflectivities (dBz) for analytic simulator -real(r8), parameter :: csmin = -30._r8 -real(r8), parameter :: csmax = 26._r8 -real(r8), parameter :: mindbz = -99._r8 -real(r8), parameter :: minrefl = 1.26e-10_r8 ! minrefl = 10._r8**(mindbz/10._r8) - -! autoconversion size threshold for cloud ice to snow (m) -real(r8) :: dcs - -! minimum mass of new crystal due to freezing of cloud droplets done -! externally (kg) -real(r8), parameter :: mi0l_min = 4._r8/3._r8*pi*rhow*(4.e-6_r8)**3 - -! Ice number sublimation parameter. Assume some decrease in ice number with sublimation if non-zero. Else, no decrease in number with sublimation. - real(r8), parameter :: sublim_factor =0.0_r8 !number sublimation factor. - - -!========================================================= -! Constants set in initialization -!========================================================= - -! Set using arguments to micro_mg_init -real(r8) :: g ! gravity -real(r8) :: r ! dry air gas constant -real(r8) :: rv ! water vapor gas constant -real(r8) :: cpp ! specific heat of dry air -real(r8) :: tmelt ! freezing point of water (K) - -! latent heats of: -real(r8) :: xxlv ! vaporization -real(r8) :: xlf ! freezing -real(r8) :: xxls ! sublimation - -real(r8) :: rhmini ! Minimum rh for ice cloud fraction > 0. - -! flags -logical :: microp_uniform -logical :: do_cldice -logical :: use_hetfrz_classnuc - -real(r8) :: rhosu ! typical 850mn air density - -real(r8) :: icenuct ! ice nucleation temperature: currently -5 degrees C - -real(r8) :: snowmelt ! what temp to melt all snow: currently 2 degrees C -real(r8) :: rainfrze ! what temp to freeze all rain: currently -5 degrees C - -! additional constants to help speed up code -real(r8) :: gamma_br_plus1 -real(r8) :: gamma_br_plus4 -real(r8) :: gamma_bs_plus1 -real(r8) :: gamma_bs_plus4 -real(r8) :: gamma_bi_plus1 -real(r8) :: gamma_bi_plus4 -real(r8) :: gamma_bj_plus1 -real(r8) :: gamma_bj_plus4 -real(r8) :: xxlv_squared -real(r8) :: xxls_squared - -character(len=16) :: micro_mg_precip_frac_method ! type of precipitation fraction method -real(r8) :: micro_mg_berg_eff_factor ! berg efficiency factor - -logical :: allow_sed_supersat ! Allow supersaturated conditions after sedimentation loop -logical :: do_sb_physics ! do SB 2001 autoconversion or accretion physics - -!=============================================================================== -contains -!=============================================================================== - -subroutine micro_mg_init( & - kind, gravit, rair, rh2o, cpair, & - tmelt_in, latvap, latice, & - rhmini_in, micro_mg_dcs, & - microp_uniform_in, do_cldice_in, use_hetfrz_classnuc_in, & - micro_mg_precip_frac_method_in, micro_mg_berg_eff_factor_in, & - allow_sed_supersat_in, do_sb_physics_in, & - nccons_in, nicons_in, ncnst_in, ninst_in, errstring) - - use micro_mg_utils, only: micro_mg_utils_init - - !----------------------------------------------------------------------- - ! - ! Purpose: - ! initialize constants for MG microphysics - ! - ! Author: Andrew Gettelman Dec 2005 - ! - !----------------------------------------------------------------------- - - integer, intent(in) :: kind ! Kind used for reals - real(r8), intent(in) :: gravit - real(r8), intent(in) :: rair - real(r8), intent(in) :: rh2o - real(r8), intent(in) :: cpair - real(r8), intent(in) :: tmelt_in ! Freezing point of water (K) - real(r8), intent(in) :: latvap - real(r8), intent(in) :: latice - real(r8), intent(in) :: rhmini_in ! Minimum rh for ice cloud fraction > 0. - real(r8), intent(in) :: micro_mg_dcs - - logical, intent(in) :: microp_uniform_in ! .true. = configure uniform for sub-columns - ! .false. = use w/o sub-columns (standard) - logical, intent(in) :: do_cldice_in ! .true. = do all processes (standard) - ! .false. = skip all processes affecting - ! cloud ice - logical, intent(in) :: use_hetfrz_classnuc_in ! use heterogeneous freezing - - character(len=16),intent(in) :: micro_mg_precip_frac_method_in ! type of precipitation fraction method - real(r8), intent(in) :: micro_mg_berg_eff_factor_in ! berg efficiency factor - logical, intent(in) :: allow_sed_supersat_in ! allow supersaturated conditions after sedimentation loop - logical, intent(in) :: do_sb_physics_in ! do SB autoconversion and accretion physics - - logical, intent(in) :: nccons_in - logical, intent(in) :: nicons_in - real(r8), intent(in) :: ncnst_in - real(r8), intent(in) :: ninst_in - - character(128), intent(out) :: errstring ! Output status (non-blank for error return) - - !----------------------------------------------------------------------- - - dcs = micro_mg_dcs - - ! Initialize subordinate utilities module. - call micro_mg_utils_init(kind, rh2o, cpair, tmelt_in, latvap, latice, & - dcs, errstring) - - if (trim(errstring) /= "") return - - ! declarations for MG code (transforms variable names) - - g= gravit ! gravity - r= rair ! dry air gas constant: note units(phys_constants are in J/K/kmol) - rv= rh2o ! water vapor gas constant - cpp = cpair ! specific heat of dry air - tmelt = tmelt_in - rhmini = rhmini_in - micro_mg_precip_frac_method = micro_mg_precip_frac_method_in - micro_mg_berg_eff_factor = micro_mg_berg_eff_factor_in - allow_sed_supersat = allow_sed_supersat_in - do_sb_physics = do_sb_physics_in - - nccons = nccons_in - nicons = nicons_in - ncnst = ncnst_in - ninst = ninst_in - - ! latent heats - - xxlv = latvap ! latent heat vaporization - xlf = latice ! latent heat freezing - xxls = xxlv + xlf ! latent heat of sublimation - - ! flags - microp_uniform = microp_uniform_in - do_cldice = do_cldice_in - use_hetfrz_classnuc = use_hetfrz_classnuc_in - - ! typical air density at 850 mb - - rhosu = 85000._r8/(rair * tmelt) - - ! Maximum temperature at which snow is allowed to exist - snowmelt = tmelt + 2._r8 - ! Minimum temperature at which rain is allowed to exist - rainfrze = tmelt - 40._r8 - - ! Ice nucleation temperature - icenuct = tmelt - 5._r8 - - ! Define constants to help speed up code (this limits calls to gamma function) - gamma_br_plus1=gamma(1._r8+br) - gamma_br_plus4=gamma(4._r8+br) - gamma_bs_plus1=gamma(1._r8+bs) - gamma_bs_plus4=gamma(4._r8+bs) - gamma_bi_plus1=gamma(1._r8+bi) - gamma_bi_plus4=gamma(4._r8+bi) - gamma_bj_plus1=gamma(1._r8+bj) - gamma_bj_plus4=gamma(4._r8+bj) - - xxlv_squared=xxlv**2 - xxls_squared=xxls**2 - -end subroutine micro_mg_init - -!=============================================================================== -!microphysics routine for each timestep goes here... - -subroutine micro_mg_tend ( & - mgncol, nlev, deltatin, & - t, q, & - qcn, qin, & - ncn, nin, & - qrn, qsn, & - nrn, nsn, & - relvar, accre_enhan, & - p, pdel, & - cldn, liqcldf, icecldf, qsatfac, & - qcsinksum_rate1ord, & - naai, npccn, & - rndst, nacon, & - tlat, qvlat, & - qctend, qitend, & - nctend, nitend, & - qrtend, qstend, & - nrtend, nstend, & - effc, effc_fn, effi, & - sadice, sadsnow, & - prect, preci, & - nevapr, evapsnow, & - am_evp_st, & - prain, prodsnow, & - cmeout, deffi, & - pgamrad, lamcrad, & - qsout, dsout, & - lflx, iflx, & - rflx, sflx, qrout, & - reff_rain, reff_snow, & - qcsevap, qisevap, qvres, & - cmeitot, vtrmc, vtrmi, & - umr, ums, & - qcsedten, qisedten, & - qrsedten, qssedten, & - pratot, prctot, & - mnuccctot, mnuccttot, msacwitot, & - psacwstot, bergstot, bergtot, & - melttot, homotot, & - qcrestot, prcitot, praitot, & - qirestot, mnuccrtot, pracstot, & - meltsdttot, frzrdttot, mnuccdtot, & - nrout, nsout, & - refl, arefl, areflz, & - frefl, csrfl, acsrfl, & - fcsrfl, rercld, & - ncai, ncal, & - qrout2, qsout2, & - nrout2, nsout2, & - drout2, dsout2, & - freqs, freqr, & - nfice, qcrat, & - errstring, & ! Below arguments are "optional" (pass null pointers to omit). - tnd_qsnow, tnd_nsnow, re_ice, & - prer_evap, & - frzimm, frzcnt, frzdep) - - ! Constituent properties. - use micro_mg_utils, only: & - mg_liq_props, & - mg_ice_props, & - mg_rain_props, & - mg_snow_props - - ! Size calculation functions. - use micro_mg_utils, only: & - size_dist_param_liq, & - size_dist_param_basic, & - avg_diameter - - ! Microphysical processes. - use micro_mg_utils, only: & - ice_deposition_sublimation, & - sb2001v2_liq_autoconversion,& - sb2001v2_accre_cld_water_rain,& - kk2000_liq_autoconversion, & - ice_autoconversion, & - immersion_freezing, & - contact_freezing, & - 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, & - evaporate_sublimate_precip, & - bergeron_process_snow - - !Authors: Hugh Morrison, Andrew Gettelman, NCAR, Peter Caldwell, LLNL - ! e-mail: morrison@ucar.edu, andrew@ucar.edu - - ! input arguments - integer, intent(in) :: mgncol ! number of microphysics columns - integer, intent(in) :: nlev ! number of layers - real(r8), intent(in) :: deltatin ! time step (s) - real(r8), intent(in) :: t(mgncol,nlev) ! input temperature (K) - real(r8), intent(in) :: q(mgncol,nlev) ! input h20 vapor mixing ratio (kg/kg) - - ! note: all input cloud variables are grid-averaged - real(r8), intent(in) :: qcn(mgncol,nlev) ! cloud water mixing ratio (kg/kg) - real(r8), intent(in) :: qin(mgncol,nlev) ! cloud ice mixing ratio (kg/kg) - real(r8), intent(in) :: ncn(mgncol,nlev) ! cloud water number conc (1/kg) - real(r8), intent(in) :: nin(mgncol,nlev) ! cloud ice number conc (1/kg) - - real(r8), intent(in) :: qrn(mgncol,nlev) ! rain mixing ratio (kg/kg) - real(r8), intent(in) :: qsn(mgncol,nlev) ! snow mixing ratio (kg/kg) - real(r8), intent(in) :: nrn(mgncol,nlev) ! rain number conc (1/kg) - real(r8), intent(in) :: nsn(mgncol,nlev) ! snow number conc (1/kg) - - real(r8), intent(in) :: relvar(mgncol,nlev) ! cloud water relative variance (-) - real(r8), intent(in) :: accre_enhan(mgncol,nlev) ! optional accretion - ! enhancement factor (-) - - real(r8), intent(in) :: p(mgncol,nlev) ! air pressure (pa) - real(r8), intent(in) :: pdel(mgncol,nlev) ! pressure difference across level (pa) - - real(r8), intent(in) :: cldn(mgncol,nlev) ! cloud fraction (no units) - real(r8), intent(in) :: liqcldf(mgncol,nlev) ! liquid cloud fraction (no units) - real(r8), intent(in) :: icecldf(mgncol,nlev) ! ice cloud fraction (no units) - real(r8), intent(in) :: qsatfac(mgncol,nlev) ! subgrid cloud water saturation scaling factor (no units) - - ! used for scavenging - ! Inputs for aerosol activation - real(r8), intent(in) :: naai(mgncol,nlev) ! ice nucleation number (from microp_aero_ts) (1/kg) - real(r8), intent(in) :: npccn(mgncol,nlev) ! ccn activated number tendency (from microp_aero_ts) (1/kg*s) - - ! Note that for these variables, the dust bin is assumed to be the last index. - ! (For example, in CAM, the last dimension is always size 4.) - real(r8), intent(in) :: rndst(:,:,:) ! radius of each dust bin, for contact freezing (from microp_aero_ts) (m) - real(r8), intent(in) :: nacon(:,:,:) ! number in each dust bin, for contact freezing (from microp_aero_ts) (1/m^3) - - ! output arguments - - real(r8), intent(out) :: qcsinksum_rate1ord(mgncol,nlev) ! 1st order rate for - ! direct cw to precip conversion - real(r8), intent(out) :: tlat(mgncol,nlev) ! latent heating rate (W/kg) - real(r8), intent(out) :: qvlat(mgncol,nlev) ! microphysical tendency qv (1/s) - real(r8), intent(out) :: qctend(mgncol,nlev) ! microphysical tendency qc (1/s) - real(r8), intent(out) :: qitend(mgncol,nlev) ! microphysical tendency qi (1/s) - real(r8), intent(out) :: nctend(mgncol,nlev) ! microphysical tendency nc (1/(kg*s)) - real(r8), intent(out) :: nitend(mgncol,nlev) ! microphysical tendency ni (1/(kg*s)) - - real(r8), intent(out) :: qrtend(mgncol,nlev) ! microphysical tendency qr (1/s) - real(r8), intent(out) :: qstend(mgncol,nlev) ! microphysical tendency qs (1/s) - real(r8), intent(out) :: nrtend(mgncol,nlev) ! microphysical tendency nr (1/(kg*s)) - real(r8), intent(out) :: nstend(mgncol,nlev) ! microphysical tendency ns (1/(kg*s)) - real(r8), intent(out) :: effc(mgncol,nlev) ! droplet effective radius (micron) - real(r8), intent(out) :: effc_fn(mgncol,nlev) ! droplet effective radius, assuming nc = 1.e8 kg-1 - real(r8), intent(out) :: effi(mgncol,nlev) ! cloud ice effective radius (micron) - real(r8), intent(out) :: sadice(mgncol,nlev) ! cloud ice surface area density (cm2/cm3) - real(r8), intent(out) :: sadsnow(mgncol,nlev) ! cloud snow surface area density (cm2/cm3) - real(r8), intent(out) :: prect(mgncol) ! surface precip rate (m/s) - real(r8), intent(out) :: preci(mgncol) ! cloud ice/snow precip rate (m/s) - real(r8), intent(out) :: nevapr(mgncol,nlev) ! evaporation rate of rain + snow (1/s) - real(r8), intent(out) :: evapsnow(mgncol,nlev) ! sublimation rate of snow (1/s) - real(r8), intent(out) :: am_evp_st(mgncol,nlev) ! stratiform evaporation area (frac) - real(r8), intent(out) :: prain(mgncol,nlev) ! production of rain + snow (1/s) - real(r8), intent(out) :: prodsnow(mgncol,nlev) ! production of snow (1/s) - real(r8), intent(out) :: cmeout(mgncol,nlev) ! evap/sub of cloud (1/s) - real(r8), intent(out) :: deffi(mgncol,nlev) ! ice effective diameter for optics (radiation) (micron) - real(r8), intent(out) :: pgamrad(mgncol,nlev) ! ice gamma parameter for optics (radiation) (no units) - real(r8), intent(out) :: lamcrad(mgncol,nlev) ! slope of droplet distribution for optics (radiation) (1/m) - real(r8), intent(out) :: qsout(mgncol,nlev) ! snow mixing ratio (kg/kg) - real(r8), intent(out) :: dsout(mgncol,nlev) ! snow diameter (m) - real(r8), intent(out) :: lflx(mgncol,nlev+1) ! grid-box average liquid condensate flux (kg m^-2 s^-1) - real(r8), intent(out) :: iflx(mgncol,nlev+1) ! grid-box average ice condensate flux (kg m^-2 s^-1) - real(r8), intent(out) :: rflx(mgncol,nlev+1) ! grid-box average rain flux (kg m^-2 s^-1) - real(r8), intent(out) :: sflx(mgncol,nlev+1) ! grid-box average snow flux (kg m^-2 s^-1) - real(r8), intent(out) :: qrout(mgncol,nlev) ! grid-box average rain mixing ratio (kg/kg) - real(r8), intent(out) :: reff_rain(mgncol,nlev) ! rain effective radius (micron) - real(r8), intent(out) :: reff_snow(mgncol,nlev) ! snow effective radius (micron) - real(r8), intent(out) :: qcsevap(mgncol,nlev) ! cloud water evaporation due to sedimentation (1/s) - real(r8), intent(out) :: qisevap(mgncol,nlev) ! cloud ice sublimation due to sublimation (1/s) - real(r8), intent(out) :: qvres(mgncol,nlev) ! residual condensation term to ensure RH < 100% (1/s) - real(r8), intent(out) :: cmeitot(mgncol,nlev) ! grid-mean cloud ice sub/dep (1/s) - real(r8), intent(out) :: vtrmc(mgncol,nlev) ! mass-weighted cloud water fallspeed (m/s) - real(r8), intent(out) :: vtrmi(mgncol,nlev) ! mass-weighted cloud ice fallspeed (m/s) - real(r8), intent(out) :: umr(mgncol,nlev) ! mass weighted rain fallspeed (m/s) - real(r8), intent(out) :: ums(mgncol,nlev) ! mass weighted snow fallspeed (m/s) - real(r8), intent(out) :: qcsedten(mgncol,nlev) ! qc sedimentation tendency (1/s) - real(r8), intent(out) :: qisedten(mgncol,nlev) ! qi sedimentation tendency (1/s) - real(r8), intent(out) :: qrsedten(mgncol,nlev) ! qr sedimentation tendency (1/s) - real(r8), intent(out) :: qssedten(mgncol,nlev) ! qs sedimentation tendency (1/s) - - ! microphysical process rates for output (mixing ratio tendencies) (all have units of 1/s) - real(r8), intent(out) :: pratot(mgncol,nlev) ! accretion of cloud by rain - real(r8), intent(out) :: prctot(mgncol,nlev) ! autoconversion of cloud to rain - real(r8), intent(out) :: mnuccctot(mgncol,nlev) ! mixing ratio tend due to immersion freezing - real(r8), intent(out) :: mnuccttot(mgncol,nlev) ! mixing ratio tend due to contact freezing - real(r8), intent(out) :: msacwitot(mgncol,nlev) ! mixing ratio tend due to H-M splintering - real(r8), intent(out) :: psacwstot(mgncol,nlev) ! collection of cloud water by snow - real(r8), intent(out) :: bergstot(mgncol,nlev) ! bergeron process on snow - real(r8), intent(out) :: bergtot(mgncol,nlev) ! bergeron process on cloud ice - real(r8), intent(out) :: melttot(mgncol,nlev) ! melting of cloud ice - real(r8), intent(out) :: homotot(mgncol,nlev) ! homogeneous freezing cloud water - real(r8), intent(out) :: qcrestot(mgncol,nlev) ! residual cloud condensation due to removal of excess supersat - real(r8), intent(out) :: prcitot(mgncol,nlev) ! autoconversion of cloud ice to snow - real(r8), intent(out) :: praitot(mgncol,nlev) ! accretion of cloud ice by snow - real(r8), intent(out) :: qirestot(mgncol,nlev) ! residual ice deposition due to removal of excess supersat - real(r8), intent(out) :: mnuccrtot(mgncol,nlev) ! mixing ratio tendency due to heterogeneous freezing of rain to snow (1/s) - real(r8), intent(out) :: pracstot(mgncol,nlev) ! mixing ratio tendency due to accretion of rain by snow (1/s) - real(r8), intent(out) :: meltsdttot(mgncol,nlev) ! latent heating rate due to melting of snow (W/kg) - real(r8), intent(out) :: frzrdttot(mgncol,nlev) ! latent heating rate due to homogeneous freezing of rain (W/kg) - real(r8), intent(out) :: mnuccdtot(mgncol,nlev) ! mass tendency from ice nucleation - real(r8), intent(out) :: nrout(mgncol,nlev) ! rain number concentration (1/m3) - real(r8), intent(out) :: nsout(mgncol,nlev) ! snow number concentration (1/m3) - real(r8), intent(out) :: refl(mgncol,nlev) ! analytic radar reflectivity - real(r8), intent(out) :: arefl(mgncol,nlev) ! average reflectivity will zero points outside valid range - real(r8), intent(out) :: areflz(mgncol,nlev) ! average reflectivity in z. - real(r8), intent(out) :: frefl(mgncol,nlev) ! fractional occurrence of radar reflectivity - real(r8), intent(out) :: csrfl(mgncol,nlev) ! cloudsat reflectivity - real(r8), intent(out) :: acsrfl(mgncol,nlev) ! cloudsat average - real(r8), intent(out) :: fcsrfl(mgncol,nlev) ! cloudsat fractional occurrence of radar reflectivity - real(r8), intent(out) :: rercld(mgncol,nlev) ! effective radius calculation for rain + cloud - real(r8), intent(out) :: ncai(mgncol,nlev) ! output number conc of ice nuclei available (1/m3) - real(r8), intent(out) :: ncal(mgncol,nlev) ! output number conc of CCN (1/m3) - real(r8), intent(out) :: qrout2(mgncol,nlev) ! copy of qrout as used to compute drout2 - real(r8), intent(out) :: qsout2(mgncol,nlev) ! copy of qsout as used to compute dsout2 - real(r8), intent(out) :: nrout2(mgncol,nlev) ! copy of nrout as used to compute drout2 - real(r8), intent(out) :: nsout2(mgncol,nlev) ! copy of nsout as used to compute dsout2 - real(r8), intent(out) :: drout2(mgncol,nlev) ! mean rain particle diameter (m) - real(r8), intent(out) :: dsout2(mgncol,nlev) ! mean snow particle diameter (m) - real(r8), intent(out) :: freqs(mgncol,nlev) ! fractional occurrence of snow - real(r8), intent(out) :: freqr(mgncol,nlev) ! fractional occurrence of rain - real(r8), intent(out) :: nfice(mgncol,nlev) ! fractional occurrence of ice - real(r8), intent(out) :: qcrat(mgncol,nlev) ! limiter for qc process rates (1=no limit --> 0. no qc) - - real(r8), intent(out) :: prer_evap(mgncol,nlev) - - character(128), intent(out) :: errstring ! output status (non-blank for error return) - - ! Tendencies calculated by external schemes that can replace MG's native - ! process tendencies. - - ! Used with CARMA cirrus microphysics - ! (or similar external microphysics model) - real(r8), intent(in) :: tnd_qsnow(:,:) ! snow mass tendency (kg/kg/s) - real(r8), intent(in) :: tnd_nsnow(:,:) ! snow number tendency (#/kg/s) - real(r8), intent(in) :: re_ice(:,:) ! ice effective radius (m) - - ! From external ice nucleation. - real(r8), intent(in) :: frzimm(:,:) ! Number tendency due to immersion freezing (1/cm3) - real(r8), intent(in) :: frzcnt(:,:) ! Number tendency due to contact freezing (1/cm3) - real(r8), intent(in) :: frzdep(:,:) ! Number tendency due to deposition nucleation (1/cm3) - - ! local workspace - ! all units mks unless otherwise stated - - ! local copies of input variables - real(r8) :: qc(mgncol,nlev) ! cloud liquid mixing ratio (kg/kg) - real(r8) :: qi(mgncol,nlev) ! cloud ice mixing ratio (kg/kg) - real(r8) :: nc(mgncol,nlev) ! cloud liquid number concentration (1/kg) - real(r8) :: ni(mgncol,nlev) ! cloud liquid number concentration (1/kg) - real(r8) :: qr(mgncol,nlev) ! rain mixing ratio (kg/kg) - real(r8) :: qs(mgncol,nlev) ! snow mixing ratio (kg/kg) - real(r8) :: nr(mgncol,nlev) ! rain number concentration (1/kg) - real(r8) :: ns(mgncol,nlev) ! snow number concentration (1/kg) - - ! general purpose variables - real(r8) :: deltat ! sub-time step (s) - real(r8) :: mtime ! the assumed ice nucleation timescale - - ! physical properties of the air at a given point - real(r8) :: rho(mgncol,nlev) ! density (kg m-3) - real(r8) :: dv(mgncol,nlev) ! diffusivity of water vapor - real(r8) :: mu(mgncol,nlev) ! viscosity - real(r8) :: sc(mgncol,nlev) ! schmidt number - real(r8) :: rhof(mgncol,nlev) ! density correction factor for fallspeed - - ! cloud fractions - real(r8) :: precip_frac(mgncol,nlev) ! precip fraction assuming maximum overlap - real(r8) :: cldm(mgncol,nlev) ! cloud fraction - real(r8) :: icldm(mgncol,nlev) ! ice cloud fraction - real(r8) :: lcldm(mgncol,nlev) ! liq cloud fraction - real(r8) :: qsfm(mgncol,nlev) ! subgrid cloud water saturation scaling factor - - ! mass mixing ratios - real(r8) :: qcic(mgncol,nlev) ! in-cloud cloud liquid - real(r8) :: qiic(mgncol,nlev) ! in-cloud cloud ice - real(r8) :: qsic(mgncol,nlev) ! in-precip snow - real(r8) :: qric(mgncol,nlev) ! in-precip rain - - ! number concentrations - real(r8) :: ncic(mgncol,nlev) ! in-cloud droplet - real(r8) :: niic(mgncol,nlev) ! in-cloud cloud ice - real(r8) :: nsic(mgncol,nlev) ! in-precip snow - real(r8) :: nric(mgncol,nlev) ! in-precip rain - ! maximum allowed ni value - real(r8) :: nimax(mgncol,nlev) - - ! Size distribution parameters for: - ! cloud ice - real(r8) :: lami(mgncol,nlev) ! slope - real(r8) :: n0i(mgncol,nlev) ! intercept - ! cloud liquid - real(r8) :: lamc(mgncol,nlev) ! slope - real(r8) :: pgam(mgncol,nlev) ! spectral width parameter - ! snow - real(r8) :: lams(mgncol,nlev) ! slope - real(r8) :: n0s(mgncol,nlev) ! intercept - ! rain - real(r8) :: lamr(mgncol,nlev) ! slope - real(r8) :: n0r(mgncol,nlev) ! intercept - - ! Rates/tendencies due to: - - ! Instantaneous snow melting - real(r8) :: minstsm(mgncol,nlev) ! mass mixing ratio - real(r8) :: ninstsm(mgncol,nlev) ! number concentration - ! Instantaneous rain freezing - real(r8) :: minstrf(mgncol,nlev) ! mass mixing ratio - real(r8) :: ninstrf(mgncol,nlev) ! number concentration - - ! deposition of cloud ice - real(r8) :: vap_dep(mgncol,nlev) ! deposition from vapor to ice PMC 12/3/12 - ! sublimation of cloud ice - real(r8) :: ice_sublim(mgncol,nlev) ! sublimation from ice to vapor PMC 12/3/12 - ! ice nucleation - real(r8) :: nnuccd(mgncol,nlev) ! number rate from deposition/cond.-freezing - real(r8) :: mnuccd(mgncol,nlev) ! mass mixing ratio - ! freezing of cloud water - real(r8) :: mnuccc(mgncol,nlev) ! mass mixing ratio - real(r8) :: nnuccc(mgncol,nlev) ! number concentration - ! contact freezing of cloud water - real(r8) :: mnucct(mgncol,nlev) ! mass mixing ratio - real(r8) :: nnucct(mgncol,nlev) ! number concentration - ! deposition nucleation in mixed-phase clouds (from external scheme) - real(r8) :: mnudep(mgncol,nlev) ! mass mixing ratio - real(r8) :: nnudep(mgncol,nlev) ! number concentration - ! ice multiplication - real(r8) :: msacwi(mgncol,nlev) ! mass mixing ratio - real(r8) :: nsacwi(mgncol,nlev) ! number concentration - ! autoconversion of cloud droplets - real(r8) :: prc(mgncol,nlev) ! mass mixing ratio - real(r8) :: nprc(mgncol,nlev) ! number concentration (rain) - real(r8) :: nprc1(mgncol,nlev) ! number concentration (cloud droplets) - ! self-aggregation of snow - real(r8) :: nsagg(mgncol,nlev) ! number concentration - ! self-collection of rain - real(r8) :: nragg(mgncol,nlev) ! number concentration - ! collection of droplets by snow - real(r8) :: psacws(mgncol,nlev) ! mass mixing ratio - real(r8) :: npsacws(mgncol,nlev) ! number concentration - ! collection of rain by snow - real(r8) :: pracs(mgncol,nlev) ! mass mixing ratio - real(r8) :: npracs(mgncol,nlev) ! number concentration - ! freezing of rain - real(r8) :: mnuccr(mgncol,nlev) ! mass mixing ratio - real(r8) :: nnuccr(mgncol,nlev) ! number concentration - ! freezing of rain to form ice (mg add 4/26/13) - real(r8) :: mnuccri(mgncol,nlev) ! mass mixing ratio - real(r8) :: nnuccri(mgncol,nlev) ! number concentration - ! accretion of droplets by rain - real(r8) :: pra(mgncol,nlev) ! mass mixing ratio - real(r8) :: npra(mgncol,nlev) ! number concentration - ! autoconversion of cloud ice to snow - real(r8) :: prci(mgncol,nlev) ! mass mixing ratio - real(r8) :: nprci(mgncol,nlev) ! number concentration - ! accretion of cloud ice by snow - real(r8) :: prai(mgncol,nlev) ! mass mixing ratio - real(r8) :: nprai(mgncol,nlev) ! number concentration - ! evaporation of rain - real(r8) :: pre(mgncol,nlev) ! mass mixing ratio - ! sublimation of snow - real(r8) :: prds(mgncol,nlev) ! mass mixing ratio - ! number evaporation - real(r8) :: nsubi(mgncol,nlev) ! cloud ice - real(r8) :: nsubc(mgncol,nlev) ! droplet - real(r8) :: nsubs(mgncol,nlev) ! snow - real(r8) :: nsubr(mgncol,nlev) ! rain - ! bergeron process - real(r8) :: berg(mgncol,nlev) ! mass mixing ratio (cloud ice) - real(r8) :: bergs(mgncol,nlev) ! mass mixing ratio (snow) - - ! fallspeeds - ! number-weighted - real(r8) :: uns(mgncol,nlev) ! snow - real(r8) :: unr(mgncol,nlev) ! rain - ! air density corrected fallspeed parameters - real(r8) :: arn(mgncol,nlev) ! rain - real(r8) :: asn(mgncol,nlev) ! snow - real(r8) :: acn(mgncol,nlev) ! cloud droplet - real(r8) :: ain(mgncol,nlev) ! cloud ice - real(r8) :: ajn(mgncol,nlev) ! cloud small ice - - ! Mass of liquid droplets used with external heterogeneous freezing. - real(r8) :: mi0l(mgncol) - - ! saturation vapor pressures - real(r8) :: esl(mgncol,nlev) ! liquid - real(r8) :: esi(mgncol,nlev) ! ice - real(r8) :: esn ! checking for RH after rain evap - - ! saturation vapor mixing ratios - real(r8) :: qvl(mgncol,nlev) ! liquid - real(r8) :: qvi(mgncol,nlev) ! ice - real(r8) :: qvn ! checking for RH after rain evap - - ! relative humidity - real(r8) :: relhum(mgncol,nlev) - - ! parameters for cloud water and cloud ice sedimentation calculations - real(r8) :: fc(mgncol,nlev) - real(r8) :: fnc(mgncol,nlev) - real(r8) :: fi(mgncol,nlev) - real(r8) :: fni(mgncol,nlev) - - real(r8) :: fr(mgncol,nlev) - real(r8) :: fnr(mgncol,nlev) - real(r8) :: fs(mgncol,nlev) - real(r8) :: fns(mgncol,nlev) - - real(r8) :: faloutc(nlev) - real(r8) :: faloutnc(nlev) - real(r8) :: falouti(nlev) - real(r8) :: faloutni(nlev) - - real(r8) :: faloutr(nlev) - real(r8) :: faloutnr(nlev) - real(r8) :: falouts(nlev) - real(r8) :: faloutns(nlev) - - real(r8) :: faltndc - real(r8) :: faltndnc - real(r8) :: faltndi - real(r8) :: faltndni - real(r8) :: faltndqie - real(r8) :: faltndqce - - real(r8) :: faltndr - real(r8) :: faltndnr - real(r8) :: faltnds - real(r8) :: faltndns - - real(r8) :: rainrt(mgncol,nlev) ! rain rate for reflectivity calculation - - ! dummy variables - real(r8) :: dum - real(r8) :: dum1 - real(r8) :: dum2 - real(r8) :: dumni0 - real(r8) :: dumns0 - ! dummies for checking RH - real(r8) :: qtmp - real(r8) :: ttmp - ! dummies for conservation check - real(r8) :: ratio - real(r8) :: tmpfrz - ! dummies for in-cloud variables - real(r8) :: dumc(mgncol,nlev) ! qc - real(r8) :: dumnc(mgncol,nlev) ! nc - real(r8) :: dumi(mgncol,nlev) ! qi - real(r8) :: dumni(mgncol,nlev) ! ni - real(r8) :: dumr(mgncol,nlev) ! rain mixing ratio - real(r8) :: dumnr(mgncol,nlev) ! rain number concentration - real(r8) :: dums(mgncol,nlev) ! snow mixing ratio - real(r8) :: dumns(mgncol,nlev) ! snow number concentration - ! Array dummy variable - real(r8) :: dum_2D(mgncol,nlev) - real(r8) :: pdel_inv(mgncol,nlev) - - ! loop array variables - ! "i" and "k" are column/level iterators for internal (MG) variables - ! "n" is used for other looping (currently just sedimentation) - integer i, k, n - - ! number of sub-steps for loops over "n" (for sedimentation) - integer nstep - integer mdust - - ! Varaibles to scale fall velocity between small and regular ice regimes. - real(r8) :: irad - real(r8) :: ifrac - - !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc - - ! Return error message - errstring = ' ' - - ! Process inputs - - ! assign variable deltat to deltatin - deltat = deltatin - - ! Copies of input concentrations that may be changed internally. - qc = qcn - nc = ncn - qi = qin - ni = nin - qr = qrn - nr = nrn - qs = qsn - ns = nsn - - ! cldn: used to set cldm, unused for subcolumns - ! liqcldf: used to set lcldm, unused for subcolumns - ! icecldf: used to set icldm, unused for subcolumns - - if (microp_uniform) then - ! subcolumns, set cloud fraction variables to one - ! if cloud water or ice is present, if not present - ! set to mincld (mincld used instead of zero, to prevent - ! possible division by zero errors). - - where (qc >= qsmall) - lcldm = 1._r8 - elsewhere - lcldm = mincld - end where - - where (qi >= qsmall) - icldm = 1._r8 - elsewhere - icldm = mincld - end where - - cldm = max(icldm, lcldm) - qsfm = 1._r8 - - else - ! get cloud fraction, check for minimum - cldm = max(cldn,mincld) - lcldm = max(liqcldf,mincld) - icldm = max(icecldf,mincld) - qsfm = qsatfac - end if - - ! Initialize local variables - - ! local physical properties - rho = p/(r*t) - dv = 8.794E-5_r8 * t**1.81_r8 / p - mu = 1.496E-6_r8 * t**1.5_r8 / (t + 120._r8) - sc = mu/(rho*dv) - - ! air density adjustment for fallspeed parameters - ! includes air density correction factor to the - ! power of 0.54 following Heymsfield and Bansemer 2007 - - rhof=(rhosu/rho)**0.54_r8 - - arn=ar*rhof - asn=as*rhof - acn=g*rhow/(18._r8*mu) - ain=ai*(rhosu/rho)**0.35_r8 - ajn=aj*(rhosu/rho)**0.35_r8 - - !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc - ! Get humidity and saturation vapor pressures - - do k=1,nlev - do i=1,mgncol - - call qsat_water(t(i,k), p(i,k), esl(i,k), qvl(i,k)) - - ! make sure when above freezing that esi=esl, not active yet - if (t(i,k) >= tmelt) then - esi(i,k)=esl(i,k) - qvi(i,k)=qvl(i,k) - else - call qsat_ice(t(i,k), p(i,k), esi(i,k), qvi(i,k)) - - ! Scale the water saturation values to reflect subgrid scale - ! ice cloud fraction, where ice clouds begin forming at a - ! gridbox average relative humidity of rhmini (not 1). - ! - ! NOTE: For subcolumns and other non-subgrid clouds, qsfm willi - ! be 1. - qvi(i,k) = qsfm(i,k) * qvi(i,k) - esi(i,k) = qsfm(i,k) * esi(i,k) - qvl(i,k) = qsfm(i,k) * qvl(i,k) - esl(i,k) = qsfm(i,k) * esl(i,k) - end if - - end do - end do - - relhum = q / max(qvl, qsmall) - - !=============================================== - - ! set mtime here to avoid answer-changing - mtime=deltat - - ! initialize microphysics output - qcsevap=0._r8 - qisevap=0._r8 - qvres =0._r8 - cmeitot =0._r8 - vtrmc =0._r8 - vtrmi =0._r8 - qcsedten =0._r8 - qisedten =0._r8 - qrsedten =0._r8 - qssedten =0._r8 - - pratot=0._r8 - prctot=0._r8 - mnuccctot=0._r8 - mnuccttot=0._r8 - msacwitot=0._r8 - psacwstot=0._r8 - bergstot=0._r8 - bergtot=0._r8 - melttot=0._r8 - homotot=0._r8 - qcrestot=0._r8 - prcitot=0._r8 - praitot=0._r8 - qirestot=0._r8 - mnuccrtot=0._r8 - pracstot=0._r8 - meltsdttot=0._r8 - frzrdttot=0._r8 - mnuccdtot=0._r8 - - rflx=0._r8 - sflx=0._r8 - lflx=0._r8 - iflx=0._r8 - - ! initialize precip output - - qrout=0._r8 - qsout=0._r8 - nrout=0._r8 - nsout=0._r8 - - ! for refl calc - rainrt = 0._r8 - - ! initialize rain size - rercld=0._r8 - - qcsinksum_rate1ord = 0._r8 - - ! initialize variables for trop_mozart - nevapr = 0._r8 - prer_evap = 0._r8 - evapsnow = 0._r8 - am_evp_st = 0._r8 - prain = 0._r8 - prodsnow = 0._r8 - cmeout = 0._r8 - - precip_frac = mincld - - lamc=0._r8 - - ! initialize microphysical tendencies - - tlat=0._r8 - qvlat=0._r8 - qctend=0._r8 - qitend=0._r8 - qstend = 0._r8 - qrtend = 0._r8 - nctend=0._r8 - nitend=0._r8 - nrtend = 0._r8 - nstend = 0._r8 - - ! initialize in-cloud and in-precip quantities to zero - qcic = 0._r8 - qiic = 0._r8 - qsic = 0._r8 - qric = 0._r8 - - ncic = 0._r8 - niic = 0._r8 - nsic = 0._r8 - nric = 0._r8 - - ! initialize precip at surface - - prect = 0._r8 - preci = 0._r8 - - ! initialize precip fallspeeds to zero - ums = 0._r8 - uns = 0._r8 - umr = 0._r8 - unr = 0._r8 - - ! initialize limiter for output - qcrat = 1._r8 - - ! Many outputs have to be initialized here at the top to work around - ! ifort problems, even if they are always overwritten later. - effc = 10._r8 - lamcrad = 0._r8 - pgamrad = 0._r8 - effc_fn = 10._r8 - effi = 25._r8 - sadice = 0._r8 - sadsnow = 0._r8 - deffi = 50._r8 - - qrout2 = 0._r8 - nrout2 = 0._r8 - drout2 = 0._r8 - qsout2 = 0._r8 - nsout2 = 0._r8 - dsout = 0._r8 - dsout2 = 0._r8 - - freqr = 0._r8 - freqs = 0._r8 - - reff_rain = 0._r8 - reff_snow = 0._r8 - - refl = -9999._r8 - arefl = 0._r8 - areflz = 0._r8 - frefl = 0._r8 - csrfl = 0._r8 - acsrfl = 0._r8 - fcsrfl = 0._r8 - - ncal = 0._r8 - ncai = 0._r8 - - nfice = 0._r8 - - !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc - ! droplet activation - ! get provisional droplet number after activation. This is used for - ! all microphysical process calculations, for consistency with update of - ! droplet mass before microphysics - - ! calculate potential for droplet activation if cloud water is present - ! tendency from activation (npccn) is read in from companion routine - - ! output activated liquid and ice (convert from #/kg -> #/m3) - !-------------------------------------------------- - where (qc >= qsmall) - nc = max(nc + npccn*deltat, 0._r8) - ncal = nc*rho/lcldm ! sghan minimum in #/cm3 - elsewhere - ncal = 0._r8 - end where - - where (t < icenuct) - ncai = naai*rho - elsewhere - ncai = 0._r8 - end where - - !=============================================== - - ! ice nucleation if activated nuclei exist at t<-5C AND rhmini + 5% - ! - ! NOTE: If using gridbox average values, condensation will not occur until rh=1, - ! so the threshold seems like it should be 1.05 and not rhmini + 0.05. For subgrid - ! clouds (using rhmini and qsfacm), the relhum has already been adjusted, and thus - ! the nucleation threshold should also be 1.05 and not rhmini + 0.05. - - !------------------------------------------------------- - - if (do_cldice) then - where (naai > 0._r8 .and. t < icenuct .and. & - relhum*esl/esi > 1.05_r8) - - !if NAAI > 0. then set numice = naai (as before) - !note: this is gridbox averaged - nnuccd = (naai-ni/icldm)/mtime*icldm - nnuccd = max(nnuccd,0._r8) - nimax = naai*icldm - - !Calc mass of new particles using new crystal mass... - !also this will be multiplied by mtime as nnuccd is... - - mnuccd = nnuccd * mi0 - - elsewhere - nnuccd = 0._r8 - nimax = 0._r8 - mnuccd = 0._r8 - end where - - end if - - - !============================================================================= - do k=1,nlev - - do i=1,mgncol - - ! calculate instantaneous precip processes (melting and homogeneous freezing) - - ! melting of snow at +2 C - - if (t(i,k) > snowmelt) then - if (qs(i,k) > 0._r8) then - - ! make sure melting snow doesn't reduce temperature below threshold - dum = -xlf/cpp*qs(i,k) - if (t(i,k)+dum < snowmelt) then - dum = (t(i,k)-snowmelt)*cpp/xlf - dum = dum/qs(i,k) - dum = max(0._r8,dum) - dum = min(1._r8,dum) - else - dum = 1._r8 - end if - - minstsm(i,k) = dum*qs(i,k) - ninstsm(i,k) = dum*ns(i,k) - - dum1=-xlf*minstsm(i,k)/deltat - tlat(i,k)=tlat(i,k)+dum1 - meltsdttot(i,k)=meltsdttot(i,k) + dum1 - - qs(i,k) = max(qs(i,k) - minstsm(i,k), 0._r8) - ns(i,k) = max(ns(i,k) - ninstsm(i,k), 0._r8) - qr(i,k) = max(qr(i,k) + minstsm(i,k), 0._r8) - nr(i,k) = max(nr(i,k) + ninstsm(i,k), 0._r8) - end if - end if - - end do - end do - - do k=1,nlev - do i=1,mgncol - ! freezing of rain at -5 C - - if (t(i,k) < rainfrze) then - - if (qr(i,k) > 0._r8) then - - ! make sure freezing rain doesn't increase temperature above threshold - dum = xlf/cpp*qr(i,k) - if (t(i,k)+dum > rainfrze) then - dum = -(t(i,k)-rainfrze)*cpp/xlf - dum = dum/qr(i,k) - dum = max(0._r8,dum) - dum = min(1._r8,dum) - else - dum = 1._r8 - end if - - minstrf(i,k) = dum*qr(i,k) - ninstrf(i,k) = dum*nr(i,k) - - ! heating tendency - dum1 = xlf*minstrf(i,k)/deltat - tlat(i,k)=tlat(i,k)+dum1 - frzrdttot(i,k)=frzrdttot(i,k) + dum1 - - qr(i,k) = max(qr(i,k) - minstrf(i,k), 0._r8) - nr(i,k) = max(nr(i,k) - ninstrf(i,k), 0._r8) - qs(i,k) = max(qs(i,k) + minstrf(i,k), 0._r8) - ns(i,k) = max(ns(i,k) + ninstrf(i,k), 0._r8) - - end if - end if - end do - end do - - do k=1,nlev - do i=1,mgncol - ! obtain in-cloud values of cloud water/ice mixing ratios and number concentrations - !------------------------------------------------------- - ! for microphysical process calculations - ! units are kg/kg for mixing ratio, 1/kg for number conc - - if (qc(i,k).ge.qsmall) then - ! limit in-cloud values to 0.005 kg/kg - qcic(i,k)=min(qc(i,k)/lcldm(i,k),5.e-3_r8) - ncic(i,k)=max(nc(i,k)/lcldm(i,k),0._r8) - - ! specify droplet concentration - if (nccons) then - ncic(i,k)=ncnst/rho(i,k) - end if - else - qcic(i,k)=0._r8 - ncic(i,k)=0._r8 - end if - - if (qi(i,k).ge.qsmall) then - ! limit in-cloud values to 0.005 kg/kg - qiic(i,k)=min(qi(i,k)/icldm(i,k),5.e-3_r8) - niic(i,k)=max(ni(i,k)/icldm(i,k),0._r8) - - ! switch for specification of cloud ice number - if (nicons) then - niic(i,k)=ninst/rho(i,k) - end if - else - qiic(i,k)=0._r8 - niic(i,k)=0._r8 - end if - - end do - end do - - !======================================================================== - - ! for sub-columns cldm has already been set to 1 if cloud - ! water or ice is present, so precip_frac will be correctly set below - ! and nothing extra needs to be done here - - precip_frac = cldm - - micro_vert_loop: do k=1,nlev - - if (trim(micro_mg_precip_frac_method) == 'in_cloud') then - - if (k /= 1) then - where (qc(:,k) < qsmall .and. qi(:,k) < qsmall) - precip_frac(:,k) = precip_frac(:,k-1) - end where - endif - - else if (trim(micro_mg_precip_frac_method) == 'max_overlap') then - - ! calculate precip fraction based on maximum overlap assumption - - ! if rain or snow mix ratios are smaller than threshold, - ! then leave precip_frac as cloud fraction at current level - if (k /= 1) then - where (qr(:,k-1) >= qsmall .or. qs(:,k-1) >= qsmall) - precip_frac(:,k)=max(precip_frac(:,k-1),precip_frac(:,k)) - end where - end if - - endif - - - !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc - ! get size distribution parameters based on in-cloud cloud water - ! these calculations also ensure consistency between number and mixing ratio - !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc - - ! cloud liquid - !------------------------------------------- - - call size_dist_param_liq(mg_liq_props, qcic(1:mgncol,k), ncic(1:mgncol,k),& - rho(1:mgncol,k), pgam(1:mgncol,k), lamc(1:mgncol,k), mgncol) - - - !======================================================================== - ! autoconversion of cloud liquid water to rain - ! formula from Khrouditnov and Kogan (2000), modified for sub-grid distribution of qc - ! minimum qc of 1 x 10^-8 prevents floating point error - - if (.not. do_sb_physics) then - call kk2000_liq_autoconversion(microp_uniform, qcic(1:mgncol,k), & - ncic(:,k), rho(:,k), relvar(:,k), prc(:,k), nprc(:,k), nprc1(:,k), mgncol) - endif - - ! assign qric based on prognostic qr, using assumed precip fraction - ! note: this could be moved above for consistency with qcic and qiic calculations - qric(:,k) = qr(:,k)/precip_frac(:,k) - nric(:,k) = nr(:,k)/precip_frac(:,k) - - ! limit in-precip mixing ratios to 10 g/kg - qric(:,k)=min(qric(:,k),0.01_r8) - - ! add autoconversion to precip from above to get provisional rain mixing ratio - ! and number concentration (qric and nric) - - where (qric(:,k).lt.qsmall) - qric(:,k)=0._r8 - nric(:,k)=0._r8 - end where - - ! make sure number concentration is a positive number to avoid - ! taking root of negative later - - nric(:,k)=max(nric(:,k),0._r8) - - ! Get size distribution parameters for cloud ice - - call size_dist_param_basic(mg_ice_props, qiic(:,k), niic(:,k), & - lami(:,k), mgncol, n0=n0i(:,k)) - - ! Alternative autoconversion - if (do_sb_physics) then - call sb2001v2_liq_autoconversion(pgam(:,k),qcic(1:mgncol,k),ncic(:,k), & - qric(:,k),rho(:,k),relvar(:,k),prc(:,k),nprc(:,k),nprc1(:,k), mgncol) - endif - - !....................................................................... - ! Autoconversion of cloud ice to snow - ! similar to Ferrier (1994) - - if (do_cldice) then - call ice_autoconversion(t(:,k), qiic(:,k), lami(:,k), n0i(:,k), & - dcs, prci(:,k), nprci(:,k), mgncol) - else - ! Add in the particles that we have already converted to snow, and - ! don't do any further autoconversion of ice. - prci(:,k) = tnd_qsnow(:,k) / cldm(:,k) - nprci(:,k) = tnd_nsnow(:,k) / cldm(:,k) - end if - - ! note, currently we don't have this - ! inside the do_cldice block, should be changed later - ! assign qsic based on prognostic qs, using assumed precip fraction - qsic(:,k) = qs(:,k)/precip_frac(:,k) - nsic(:,k) = ns(:,k)/precip_frac(:,k) - - ! limit in-precip mixing ratios to 10 g/kg - qsic(:,k)=min(qsic(:,k),0.01_r8) - - ! if precip mix ratio is zero so should number concentration - - where (qsic(:,k) < qsmall) - qsic(:,k)=0._r8 - nsic(:,k)=0._r8 - end where - - ! make sure number concentration is a positive number to avoid - ! taking root of negative later - - nsic(:,k)=max(nsic(:,k),0._r8) - - !....................................................................... - ! get size distribution parameters for precip - !...................................................................... - ! rain - - call size_dist_param_basic(mg_rain_props, qric(:,k), nric(:,k), & - lamr(:,k), mgncol, n0=n0r(:,k)) - - where (lamr(:,k) >= qsmall) - - ! provisional rain number and mass weighted mean fallspeed (m/s) - - unr(:,k) = min(arn(:,k)*gamma_br_plus1/lamr(:,k)**br,9.1_r8*rhof(:,k)) - umr(:,k) = min(arn(:,k)*gamma_br_plus4/(6._r8*lamr(:,k)**br),9.1_r8*rhof(:,k)) - - elsewhere - umr(:,k) = 0._r8 - unr(:,k) = 0._r8 - end where - - !...................................................................... - ! snow - - call size_dist_param_basic(mg_snow_props, qsic(:,k), nsic(:,k), & - lams(:,k), mgncol, n0=n0s(:,k)) - - where (lams(:,k) > 0._r8) - - ! provisional snow number and mass weighted mean fallspeed (m/s) - - ums(:,k) = min(asn(:,k)*gamma_bs_plus4/(6._r8*lams(:,k)**bs),1.2_r8*rhof(:,k)) - uns(:,k) = min(asn(:,k)*gamma_bs_plus1/lams(:,k)**bs,1.2_r8*rhof(:,k)) - - elsewhere - ums(:,k) = 0._r8 - uns(:,k) = 0._r8 - end where - - if (do_cldice) then - if (.not. use_hetfrz_classnuc) then - - ! heterogeneous freezing of cloud water - !---------------------------------------------- - - call immersion_freezing(microp_uniform, t(:,k), pgam(:,k), lamc(:,k), & - qcic(1:mgncol,k), ncic(:,k), relvar(:,k), mnuccc(:,k), nnuccc(:,k), mgncol) - - ! make sure number of droplets frozen does not exceed available ice nuclei concentration - ! this prevents 'runaway' droplet freezing - - where (qcic(1:mgncol,k).ge.qsmall .and. t(:,k).lt.269.15_r8) - where (nnuccc(:,k)*lcldm(:,k).gt.nnuccd(:,k)) - ! scale mixing ratio of droplet freezing with limit - mnuccc(:,k)=mnuccc(:,k)*(nnuccd(:,k)/(nnuccc(:,k)*lcldm(:,k))) - nnuccc(:,k)=nnuccd(:,k)/lcldm(:,k) - end where - end where - - mdust = size(rndst,3) - call contact_freezing(microp_uniform, t(:,k), p(:,k), rndst(:,k,:), & - nacon(:,k,:), pgam(:,k), lamc(:,k), qcic(1:mgncol,k), ncic(:,k), & - relvar(:,k), mnucct(:,k), nnucct(:,k), mgncol, mdust) - - mnudep(:,k)=0._r8 - nnudep(:,k)=0._r8 - - else - - ! Mass of droplets frozen is the average droplet mass, except - ! with two limiters: concentration must be at least 1/cm^3, and - ! mass must be at least the minimum defined above. - mi0l = qcic(1:mgncol,k)/max(ncic(:,k), 1.0e6_r8/rho(:,k)) - mi0l = max(mi0l_min, mi0l) - - where (qcic(1:mgncol,k) >= qsmall) - nnuccc(:,k) = frzimm(:,k)*1.0e6_r8/rho(:,k) - mnuccc(:,k) = nnuccc(:,k)*mi0l - - nnucct(:,k) = frzcnt(:,k)*1.0e6_r8/rho(:,k) - mnucct(:,k) = nnucct(:,k)*mi0l - - nnudep(:,k) = frzdep(:,k)*1.0e6_r8/rho(:,k) - mnudep(:,k) = nnudep(:,k)*mi0 - elsewhere - nnuccc(:,k) = 0._r8 - mnuccc(:,k) = 0._r8 - - nnucct(:,k) = 0._r8 - mnucct(:,k) = 0._r8 - - nnudep(:,k) = 0._r8 - mnudep(:,k) = 0._r8 - end where - - end if - - else - mnuccc(:,k)=0._r8 - nnuccc(:,k)=0._r8 - mnucct(:,k)=0._r8 - nnucct(:,k)=0._r8 - mnudep(:,k)=0._r8 - nnudep(:,k)=0._r8 - end if - - call snow_self_aggregation(t(:,k), rho(:,k), asn(:,k), rhosn, qsic(:,k), nsic(:,k), & - nsagg(:,k), mgncol) - - call accrete_cloud_water_snow(t(:,k), rho(:,k), asn(:,k), uns(:,k), mu(:,k), & - qcic(1:mgncol,k), ncic(:,k), qsic(:,k), pgam(:,k), lamc(:,k), lams(:,k), n0s(:,k), & - psacws(:,k), npsacws(:,k), mgncol) - - if (do_cldice) then - call secondary_ice_production(t(:,k), psacws(:,k), msacwi(:,k), nsacwi(:,k), mgncol) - else - nsacwi(:,k) = 0.0_r8 - msacwi(:,k) = 0.0_r8 - end if - - call accrete_rain_snow(t(:,k), rho(:,k), umr(:,k), ums(:,k), unr(:,k), uns(:,k), & - qric(:,k), qsic(:,k), lamr(:,k), n0r(:,k), lams(:,k), n0s(:,k), & - pracs(:,k), npracs(:,k), mgncol) - - call heterogeneous_rain_freezing(t(:,k), qric(:,k), nric(:,k), lamr(:,k), & - mnuccr(:,k), nnuccr(:,k), mgncol) - - if (do_sb_physics) then - call sb2001v2_accre_cld_water_rain(qcic(1:mgncol,k), ncic(:,k), qric(:,k), & - rho(:,k), relvar(:,k), pra(:,k), npra(:,k), mgncol) - else - call accrete_cloud_water_rain(microp_uniform, qric(:,k), qcic(1:mgncol,k), & - ncic(:,k), relvar(:,k), accre_enhan(:,k), pra(:,k), npra(:,k), mgncol) - endif - - call self_collection_rain(rho(:,k), qric(:,k), nric(:,k), nragg(:,k), mgncol) - - if (do_cldice) then - call accrete_cloud_ice_snow(t(:,k), rho(:,k), asn(:,k), qiic(:,k), niic(:,k), & - qsic(:,k), lams(:,k), n0s(:,k), prai(:,k), nprai(:,k), mgncol) - else - prai(:,k) = 0._r8 - nprai(:,k) = 0._r8 - end if - - call evaporate_sublimate_precip(t(:,k), rho(:,k), & - dv(:,k), mu(:,k), sc(:,k), q(:,k), qvl(:,k), qvi(:,k), & - lcldm(:,k), precip_frac(:,k), arn(:,k), asn(:,k), qcic(1:mgncol,k), qiic(:,k), & - qric(:,k), qsic(:,k), lamr(:,k), n0r(:,k), lams(:,k), n0s(:,k), & - pre(:,k), prds(:,k), am_evp_st(:,k), mgncol) - - call bergeron_process_snow(t(:,k), rho(:,k), dv(:,k), mu(:,k), sc(:,k), & - qvl(:,k), qvi(:,k), asn(:,k), qcic(1:mgncol,k), qsic(:,k), lams(:,k), n0s(:,k), & - bergs(:,k), mgncol) - - bergs(:,k)=bergs(:,k)*micro_mg_berg_eff_factor - - !+++PMC 12/3/12 - NEW VAPOR DEP/SUBLIMATION GOES HERE!!! - if (do_cldice) then - - call ice_deposition_sublimation(t(:,k), q(:,k), qi(:,k), ni(:,k), & - icldm(:,k), rho(:,k), dv(:,k), qvl(:,k), qvi(:,k), & - berg(:,k), vap_dep(:,k), ice_sublim(:,k), mgncol) - - berg(:,k)=berg(:,k)*micro_mg_berg_eff_factor - - where (ice_sublim(:,k) < 0._r8 .and. qi(:,k) > qsmall .and. icldm(:,k) > mincld) - nsubi(:,k) = sublim_factor*ice_sublim(:,k) / qi(:,k) * ni(:,k) / icldm(:,k) - - elsewhere - nsubi(:,k) = 0._r8 - end where - - ! bergeron process should not reduce nc unless - ! all ql is removed (which is handled elsewhere) - !in fact, nothing in this entire file makes nsubc nonzero. - nsubc(:,k) = 0._r8 - - end if !do_cldice - !---PMC 12/3/12 - - do i=1,mgncol - - ! 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 - - ! conservation of qc - !------------------------------------------------------------------- - - dum = ((prc(i,k)+pra(i,k)+mnuccc(i,k)+mnucct(i,k)+msacwi(i,k)+ & - psacws(i,k)+bergs(i,k))*lcldm(i,k)+berg(i,k))*deltat - - if (dum.gt.qc(i,k)) then - ratio = qc(i,k)/deltat/((prc(i,k)+pra(i,k)+mnuccc(i,k)+mnucct(i,k)+ & - msacwi(i,k)+psacws(i,k)+bergs(i,k))*lcldm(i,k)+berg(i,k))*omsm - prc(i,k) = prc(i,k)*ratio - pra(i,k) = pra(i,k)*ratio - mnuccc(i,k) = mnuccc(i,k)*ratio - mnucct(i,k) = mnucct(i,k)*ratio - msacwi(i,k) = msacwi(i,k)*ratio - psacws(i,k) = psacws(i,k)*ratio - bergs(i,k) = bergs(i,k)*ratio - berg(i,k) = berg(i,k)*ratio - qcrat(i,k) = ratio - else - qcrat(i,k) = 1._r8 - end if - - !PMC 12/3/12: ratio is also frac of step w/ liquid. - !thus we apply berg for "ratio" of timestep and vapor - !deposition for the remaining frac of the timestep. - if (qc(i,k) >= qsmall) then - vap_dep(i,k) = vap_dep(i,k)*(1._r8-qcrat(i,k)) - end if - - end do - - do i=1,mgncol - - !================================================================= - ! apply limiter to ensure that ice/snow sublimation and rain evap - ! don't push conditions into supersaturation, and ice deposition/nucleation don't - ! push conditions into sub-saturation - ! note this is done after qc conservation since we don't know how large - ! vap_dep is before then - ! estimates are only approximate since other process terms haven't been limited - ! for conservation yet - - ! first limit ice deposition/nucleation vap_dep + mnuccd - dum1 = vap_dep(i,k) + mnuccd(i,k) - if (dum1 > 1.e-20_r8) then - dum = (q(i,k)-qvi(i,k))/(1._r8 + xxls_squared*qvi(i,k)/(cpp*rv*t(i,k)**2))/deltat - dum = max(dum,0._r8) - if (dum1 > dum) then - ! Allocate the limited "dum" tendency to mnuccd and vap_dep - ! processes. Don't divide by cloud fraction; these are grid- - ! mean rates. - dum1 = mnuccd(i,k) / (vap_dep(i,k)+mnuccd(i,k)) - mnuccd(i,k) = dum*dum1 - vap_dep(i,k) = dum - mnuccd(i,k) - end if - end if - - end do - - do i=1,mgncol - - !=================================================================== - ! conservation of nc - !------------------------------------------------------------------- - dum = (nprc1(i,k)+npra(i,k)+nnuccc(i,k)+nnucct(i,k)+ & - npsacws(i,k)-nsubc(i,k))*lcldm(i,k)*deltat - - if (dum.gt.nc(i,k)) then - ratio = nc(i,k)/deltat/((nprc1(i,k)+npra(i,k)+nnuccc(i,k)+nnucct(i,k)+& - npsacws(i,k)-nsubc(i,k))*lcldm(i,k))*omsm - - nprc1(i,k) = nprc1(i,k)*ratio - npra(i,k) = npra(i,k)*ratio - nnuccc(i,k) = nnuccc(i,k)*ratio - nnucct(i,k) = nnucct(i,k)*ratio - npsacws(i,k) = npsacws(i,k)*ratio - nsubc(i,k)=nsubc(i,k)*ratio - end if - - mnuccri(i,k)=0._r8 - nnuccri(i,k)=0._r8 - - if (do_cldice) then - - ! freezing of rain to produce ice if mean rain size is smaller than Dcs - if (lamr(i,k) > qsmall .and. 1._r8/lamr(i,k) < Dcs) then - mnuccri(i,k)=mnuccr(i,k) - nnuccri(i,k)=nnuccr(i,k) - mnuccr(i,k)=0._r8 - nnuccr(i,k)=0._r8 - end if - end if - - end do - - do i=1,mgncol - - ! conservation of rain mixing ratio - !------------------------------------------------------------------- - dum = ((-pre(i,k)+pracs(i,k)+mnuccr(i,k)+mnuccri(i,k))*precip_frac(i,k)- & - (pra(i,k)+prc(i,k))*lcldm(i,k))*deltat - - ! note that qrtend is included below because of instantaneous freezing/melt - if (dum.gt.qr(i,k).and. & - (-pre(i,k)+pracs(i,k)+mnuccr(i,k)+mnuccri(i,k)).ge.qsmall) then - ratio = (qr(i,k)/deltat+(pra(i,k)+prc(i,k))*lcldm(i,k))/ & - precip_frac(i,k)/(-pre(i,k)+pracs(i,k)+mnuccr(i,k)+mnuccri(i,k))*omsm - pre(i,k)=pre(i,k)*ratio - pracs(i,k)=pracs(i,k)*ratio - mnuccr(i,k)=mnuccr(i,k)*ratio - mnuccri(i,k)=mnuccri(i,k)*ratio - end if - - end do - - do i=1,mgncol - - ! conservation of rain number - !------------------------------------------------------------------- - - ! Add evaporation of rain number. - if (pre(i,k) < 0._r8) then -<<<<<<< HEAD -!++ag -! dum = pre(i,k)*deltat/qr(i,k) -! dum = max(-1._r8,dum) -! nsubr(i,k) = dum*nr(i,k)/deltat - nsubr(i,k) = pre(i,k)*nr(i,k)/qr(i,k) -!--ag -======= - nsubr(i,k) = pre(i,k)*nr(i,k)/qr(i,k) ->>>>>>> origin/featureCESMNCARBeta_trunk2.0-7 - else - nsubr(i,k) = 0._r8 - end if - - end do - - do i=1,mgncol - - dum = ((-nsubr(i,k)+npracs(i,k)+nnuccr(i,k)+nnuccri(i,k)-nragg(i,k))*precip_frac(i,k)- & - nprc(i,k)*lcldm(i,k))*deltat - - if (dum.gt.nr(i,k)) then - ratio = (nr(i,k)/deltat+nprc(i,k)*lcldm(i,k))/precip_frac(i,k)/ & - (-nsubr(i,k)+npracs(i,k)+nnuccr(i,k)+nnuccri(i,k)-nragg(i,k))*omsm - - nragg(i,k)=nragg(i,k)*ratio - npracs(i,k)=npracs(i,k)*ratio - nnuccr(i,k)=nnuccr(i,k)*ratio - nsubr(i,k)=nsubr(i,k)*ratio - nnuccri(i,k)=nnuccri(i,k)*ratio - end if - - end do - - if (do_cldice) then - - do i=1,mgncol - - ! conservation of qi - !------------------------------------------------------------------- - - dum = ((-mnuccc(i,k)-mnucct(i,k)-mnudep(i,k)-msacwi(i,k))*lcldm(i,k)+(prci(i,k)+ & - prai(i,k))*icldm(i,k)-mnuccri(i,k)*precip_frac(i,k) & - -ice_sublim(i,k)-vap_dep(i,k)-berg(i,k)-mnuccd(i,k))*deltat - - if (dum.gt.qi(i,k)) then - ratio = (qi(i,k)/deltat+vap_dep(i,k)+berg(i,k)+mnuccd(i,k)+ & - (mnuccc(i,k)+mnucct(i,k)+mnudep(i,k)+msacwi(i,k))*lcldm(i,k)+ & - mnuccri(i,k)*precip_frac(i,k))/ & - ((prci(i,k)+prai(i,k))*icldm(i,k)-ice_sublim(i,k))*omsm - prci(i,k) = prci(i,k)*ratio - prai(i,k) = prai(i,k)*ratio - ice_sublim(i,k) = ice_sublim(i,k)*ratio - end if - - end do - - end if - - if (do_cldice) then - - do i=1,mgncol - - ! conservation of ni - !------------------------------------------------------------------- - if (use_hetfrz_classnuc) then - tmpfrz = nnuccc(i,k) - else - tmpfrz = 0._r8 - end if - dum = ((-nnucct(i,k)-tmpfrz-nnudep(i,k)-nsacwi(i,k))*lcldm(i,k)+(nprci(i,k)+ & - nprai(i,k)-nsubi(i,k))*icldm(i,k)-nnuccri(i,k)*precip_frac(i,k)- & - nnuccd(i,k))*deltat - - if (dum.gt.ni(i,k)) then - ratio = (ni(i,k)/deltat+nnuccd(i,k)+ & - (nnucct(i,k)+tmpfrz+nnudep(i,k)+nsacwi(i,k))*lcldm(i,k)+ & - nnuccri(i,k)*precip_frac(i,k))/ & - ((nprci(i,k)+nprai(i,k)-nsubi(i,k))*icldm(i,k))*omsm - nprci(i,k) = nprci(i,k)*ratio - nprai(i,k) = nprai(i,k)*ratio - nsubi(i,k) = nsubi(i,k)*ratio - end if - - end do - - end if - - do i=1,mgncol - - ! conservation of snow mixing ratio - !------------------------------------------------------------------- - dum = (-(prds(i,k)+pracs(i,k)+mnuccr(i,k))*precip_frac(i,k)-(prai(i,k)+prci(i,k))*icldm(i,k) & - -(bergs(i,k)+psacws(i,k))*lcldm(i,k))*deltat - - if (dum.gt.qs(i,k).and.-prds(i,k).ge.qsmall) then - ratio = (qs(i,k)/deltat+(prai(i,k)+prci(i,k))*icldm(i,k)+ & - (bergs(i,k)+psacws(i,k))*lcldm(i,k)+(pracs(i,k)+mnuccr(i,k))*precip_frac(i,k))/ & - precip_frac(i,k)/(-prds(i,k))*omsm - prds(i,k)=prds(i,k)*ratio - end if - - end do - - do i=1,mgncol - - ! conservation of snow number - !------------------------------------------------------------------- - ! calculate loss of number due to sublimation - ! for now neglect sublimation of ns - nsubs(i,k)=0._r8 - - dum = ((-nsagg(i,k)-nsubs(i,k)-nnuccr(i,k))*precip_frac(i,k)-nprci(i,k)*icldm(i,k))*deltat - - if (dum.gt.ns(i,k)) then - ratio = (ns(i,k)/deltat+nnuccr(i,k)* & - precip_frac(i,k)+nprci(i,k)*icldm(i,k))/precip_frac(i,k)/ & - (-nsubs(i,k)-nsagg(i,k))*omsm - nsubs(i,k)=nsubs(i,k)*ratio - nsagg(i,k)=nsagg(i,k)*ratio - end if - - end do - - do i=1,mgncol - - ! next limit ice and snow sublimation and rain evaporation - ! get estimate of q and t at end of time step - ! don't include other microphysical processes since they haven't - ! been limited via conservation checks yet - - if ((pre(i,k)+prds(i,k))*precip_frac(i,k)+ice_sublim(i,k) < -1.e-20_r8) then - - qtmp=q(i,k)-(ice_sublim(i,k)+vap_dep(i,k)+mnuccd(i,k)+ & - (pre(i,k)+prds(i,k))*precip_frac(i,k))*deltat - ttmp=t(i,k)+((pre(i,k)*precip_frac(i,k))*xxlv+ & - (prds(i,k)*precip_frac(i,k)+vap_dep(i,k)+ice_sublim(i,k)+mnuccd(i,k))*xxls)*deltat/cpp - - ! use rhw to allow ice supersaturation - call qsat_water(ttmp, p(i,k), esn, qvn) - - ! modify ice/precip evaporation rate if q > qsat - if (qtmp > qvn) then - - dum1=pre(i,k)*precip_frac(i,k)/((pre(i,k)+prds(i,k))*precip_frac(i,k)+ice_sublim(i,k)) - dum2=prds(i,k)*precip_frac(i,k)/((pre(i,k)+prds(i,k))*precip_frac(i,k)+ice_sublim(i,k)) - ! recalculate q and t after vap_dep and mnuccd but without evap or sublim - qtmp=q(i,k)-(vap_dep(i,k)+mnuccd(i,k))*deltat - ttmp=t(i,k)+((vap_dep(i,k)+mnuccd(i,k))*xxls)*deltat/cpp - - ! use rhw to allow ice supersaturation - call qsat_water(ttmp, p(i,k), esn, qvn) - - dum=(qtmp-qvn)/(1._r8 + xxlv_squared*qvn/(cpp*rv*ttmp**2)) - dum=min(dum,0._r8) - - ! modify rates if needed, divide by precip_frac to get local (in-precip) value - pre(i,k)=dum*dum1/deltat/precip_frac(i,k) - - ! do separately using RHI for prds and ice_sublim - call qsat_ice(ttmp, p(i,k), esn, qvn) - - dum=(qtmp-qvn)/(1._r8 + xxls_squared*qvn/(cpp*rv*ttmp**2)) - dum=min(dum,0._r8) - - ! modify rates if needed, divide by precip_frac to get local (in-precip) value - prds(i,k) = dum*dum2/deltat/precip_frac(i,k) - - ! don't divide ice_sublim by cloud fraction since it is grid-averaged - dum1 = (1._r8-dum1-dum2) - ice_sublim(i,k) = dum*dum1/deltat - end if - end if - - end do - - ! Big "administration" loop enforces conservation, updates variables - ! that accumulate over substeps, and sets output variables. - - do i=1,mgncol - - ! get tendencies due to microphysical conversion processes - !========================================================== - ! note: tendencies are multiplied by appropriate cloud/precip - ! fraction to get grid-scale values - ! note: vap_dep is already grid-average values - - ! The net tendencies need to be added to rather than overwritten, - ! because they may have a value already set for instantaneous - ! melting/freezing. - - qvlat(i,k) = qvlat(i,k)-(pre(i,k)+prds(i,k))*precip_frac(i,k)-& - vap_dep(i,k)-ice_sublim(i,k)-mnuccd(i,k)-mnudep(i,k)*lcldm(i,k) - - tlat(i,k) = tlat(i,k)+((pre(i,k)*precip_frac(i,k)) & - *xxlv+(prds(i,k)*precip_frac(i,k)+vap_dep(i,k)+ice_sublim(i,k)+mnuccd(i,k)+mnudep(i,k)*lcldm(i,k))*xxls+ & - ((bergs(i,k)+psacws(i,k)+mnuccc(i,k)+mnucct(i,k)+msacwi(i,k))*lcldm(i,k)+(mnuccr(i,k)+ & - pracs(i,k)+mnuccri(i,k))*precip_frac(i,k)+berg(i,k))*xlf) - - qctend(i,k) = qctend(i,k)+ & - (-pra(i,k)-prc(i,k)-mnuccc(i,k)-mnucct(i,k)-msacwi(i,k)- & - psacws(i,k)-bergs(i,k))*lcldm(i,k)-berg(i,k) - - if (do_cldice) then - qitend(i,k) = qitend(i,k)+ & - (mnuccc(i,k)+mnucct(i,k)+mnudep(i,k)+msacwi(i,k))*lcldm(i,k)+(-prci(i,k)- & - prai(i,k))*icldm(i,k)+vap_dep(i,k)+berg(i,k)+ice_sublim(i,k)+ & - mnuccd(i,k)+mnuccri(i,k)*precip_frac(i,k) - end if - - qrtend(i,k) = qrtend(i,k)+ & - (pra(i,k)+prc(i,k))*lcldm(i,k)+(pre(i,k)-pracs(i,k)- & - mnuccr(i,k)-mnuccri(i,k))*precip_frac(i,k) - - qstend(i,k) = qstend(i,k)+ & - (prai(i,k)+prci(i,k))*icldm(i,k)+(psacws(i,k)+bergs(i,k))*lcldm(i,k)+(prds(i,k)+ & - pracs(i,k)+mnuccr(i,k))*precip_frac(i,k) - - - cmeout(i,k) = vap_dep(i,k) + ice_sublim(i,k) + mnuccd(i,k) - - ! add output for cmei (accumulate) - cmeitot(i,k) = vap_dep(i,k) + ice_sublim(i,k) + mnuccd(i,k) - - ! assign variables for trop_mozart, these are grid-average - !------------------------------------------------------------------- - ! evaporation/sublimation is stored here as positive term - - evapsnow(i,k) = -prds(i,k)*precip_frac(i,k) - nevapr(i,k) = -pre(i,k)*precip_frac(i,k) - prer_evap(i,k) = -pre(i,k)*precip_frac(i,k) - - ! change to make sure prain is positive: do not remove snow from - ! prain used for wet deposition - prain(i,k) = (pra(i,k)+prc(i,k))*lcldm(i,k)+(-pracs(i,k)- & - mnuccr(i,k)-mnuccri(i,k))*precip_frac(i,k) - prodsnow(i,k) = (prai(i,k)+prci(i,k))*icldm(i,k)+(psacws(i,k)+bergs(i,k))*lcldm(i,k)+(& - pracs(i,k)+mnuccr(i,k))*precip_frac(i,k) - - ! following are used to calculate 1st order conversion rate of cloud water - ! to rain and snow (1/s), for later use in aerosol wet removal routine - ! previously, wetdepa used (prain/qc) for this, and the qc in wetdepa may be smaller than the qc - ! used to calculate pra, prc, ... in this routine - ! qcsinksum_rate1ord = { rate of direct transfer of cloud water to rain & snow } - ! (no cloud ice or bergeron terms) - qcsinksum_rate1ord(i,k) = (pra(i,k)+prc(i,k)+psacws(i,k))*lcldm(i,k) - ! Avoid zero/near-zero division. - qcsinksum_rate1ord(i,k) = qcsinksum_rate1ord(i,k) / & - max(qc(i,k),1.0e-30_r8) - - - ! microphysics output, note this is grid-averaged - pratot(i,k) = pra(i,k)*lcldm(i,k) - prctot(i,k) = prc(i,k)*lcldm(i,k) - mnuccctot(i,k) = mnuccc(i,k)*lcldm(i,k) - mnuccttot(i,k) = mnucct(i,k)*lcldm(i,k) - msacwitot(i,k) = msacwi(i,k)*lcldm(i,k) - psacwstot(i,k) = psacws(i,k)*lcldm(i,k) - bergstot(i,k) = bergs(i,k)*lcldm(i,k) - bergtot(i,k) = berg(i,k) - prcitot(i,k) = prci(i,k)*icldm(i,k) - praitot(i,k) = prai(i,k)*icldm(i,k) - mnuccdtot(i,k) = mnuccd(i,k)*icldm(i,k) - - pracstot(i,k) = pracs(i,k)*precip_frac(i,k) - mnuccrtot(i,k) = mnuccr(i,k)*precip_frac(i,k) - - - nctend(i,k) = nctend(i,k)+& - (-nnuccc(i,k)-nnucct(i,k)-npsacws(i,k)+nsubc(i,k) & - -npra(i,k)-nprc1(i,k))*lcldm(i,k) - - if (do_cldice) then - if (use_hetfrz_classnuc) then - tmpfrz = nnuccc(i,k) - else - tmpfrz = 0._r8 - end if - nitend(i,k) = nitend(i,k)+ nnuccd(i,k)+ & - (nnucct(i,k)+tmpfrz+nnudep(i,k)+nsacwi(i,k))*lcldm(i,k)+(nsubi(i,k)-nprci(i,k)- & - nprai(i,k))*icldm(i,k)+nnuccri(i,k)*precip_frac(i,k) - end if - - nstend(i,k) = nstend(i,k)+(nsubs(i,k)+ & - nsagg(i,k)+nnuccr(i,k))*precip_frac(i,k)+nprci(i,k)*icldm(i,k) - - nrtend(i,k) = nrtend(i,k)+ & - nprc(i,k)*lcldm(i,k)+(nsubr(i,k)-npracs(i,k)-nnuccr(i,k) & - -nnuccri(i,k)+nragg(i,k))*precip_frac(i,k) - - ! make sure that ni at advanced time step does not exceed - ! maximum (existing N + source terms*dt), which is possible if mtime < deltat - ! note that currently mtime = deltat - !================================================================ - - if (do_cldice .and. nitend(i,k).gt.0._r8.and.ni(i,k)+nitend(i,k)*deltat.gt.nimax(i,k)) then - nitend(i,k)=max(0._r8,(nimax(i,k)-ni(i,k))/deltat) - end if - - end do - - ! End of "administration" loop - - end do micro_vert_loop ! end k loop - - !----------------------------------------------------- - ! convert rain/snow q and N for output to history, note, - ! output is for gridbox average - - qrout = qr - nrout = nr * rho - qsout = qs - nsout = ns * rho - - ! calculate n0r and lamr from rain mass and number - ! divide by precip fraction to get in-precip (local) values of - ! rain mass and number, divide by rhow to get rain number in kg^-1 - - do k=1,nlev - - call size_dist_param_basic(mg_rain_props, qric(:,k), nric(:,k), lamr(:,k), mgncol, n0=n0r(:,k)) - - ! Calculate rercld - - ! calculate mean size of combined rain and cloud water - - call calc_rercld(lamr(:,k), n0r(:,k), lamc(:,k), pgam(:,k), qric(:,k), qcic(1:mgncol,k), ncic(:,k), & - rercld(:,k), mgncol) - - enddo - - ! Assign variables back to start-of-timestep values - ! Some state variables are changed before the main microphysics loop - ! to make "instantaneous" adjustments. Afterward, we must move those changes - ! back into the tendencies. - ! These processes: - ! - Droplet activation (npccn, impacts nc) - ! - Instantaneous snow melting (minstsm/ninstsm, impacts qr/qs/nr/ns) - ! - Instantaneous rain freezing (minstfr/ninstrf, impacts qr/qs/nr/ns) - !================================================================================ - - ! Re-apply droplet activation tendency - nc = ncn - nctend = nctend + npccn - - ! Re-apply rain freezing and snow melting. - dum_2D = qs - qs = qsn - qstend = qstend + (dum_2D-qs)/deltat - - dum_2D = ns - ns = nsn - nstend = nstend + (dum_2D-ns)/deltat - - dum_2D = qr - qr = qrn - qrtend = qrtend + (dum_2D-qr)/deltat - - dum_2D = nr - nr = nrn - nrtend = nrtend + (dum_2D-nr)/deltat - - !............................................................................. - - !================================================================================ - - ! modify to include snow. in prain & evap (diagnostic here: for wet dep) - nevapr = nevapr + evapsnow - prain = prain + prodsnow - - - - do k=1,nlev - - do i=1,mgncol - - ! calculate sedimentation for cloud water and ice - !================================================================================ - - ! update in-cloud cloud mixing ratio and number concentration - ! with microphysical tendencies to calculate sedimentation, assign to dummy vars - ! note: these are in-cloud values***, hence we divide by cloud fraction - - dumc(i,k) = (qc(i,k)+qctend(i,k)*deltat)/lcldm(i,k) - dumi(i,k) = (qi(i,k)+qitend(i,k)*deltat)/icldm(i,k) - dumnc(i,k) = max((nc(i,k)+nctend(i,k)*deltat)/lcldm(i,k),0._r8) - dumni(i,k) = max((ni(i,k)+nitend(i,k)*deltat)/icldm(i,k),0._r8) - - dumr(i,k) = (qr(i,k)+qrtend(i,k)*deltat)/precip_frac(i,k) - dumnr(i,k) = max((nr(i,k)+nrtend(i,k)*deltat)/precip_frac(i,k),0._r8) - dums(i,k) = (qs(i,k)+qstend(i,k)*deltat)/precip_frac(i,k) - dumns(i,k) = max((ns(i,k)+nstend(i,k)*deltat)/precip_frac(i,k),0._r8) - - - ! switch for specification of droplet and crystal number - if (nccons) then - dumnc(i,k)=ncnst/rho(i,k) - end if - - ! switch for specification of cloud ice number - if (nicons) then - dumni(i,k)=ninst/rho(i,k) - end if - enddo - enddo - - do k=1,nlev - - ! obtain new slope parameter to avoid possible singularity - - call size_dist_param_basic(mg_ice_props, dumi(:,k), dumni(:,k), & - lami(:,k), mgncol) - - call size_dist_param_liq(mg_liq_props, dumc(:,k), dumnc(:,k), rho(:,k), & - pgam(:,k), lamc(:,k), mgncol) - - enddo - - do k=1,nlev - do i=1,mgncol - - ! calculate number and mass weighted fall velocity for droplets and cloud ice - !------------------------------------------------------------------- - - - if (dumc(i,k).ge.qsmall) then - - vtrmc(i,k)=acn(i,k)*gamma(4._r8+bc+pgam(i,k))/ & - (lamc(i,k)**bc*gamma(pgam(i,k)+4._r8)) - - fc(i,k) = g*rho(i,k)*vtrmc(i,k) - - fnc(i,k) = g*rho(i,k)* & - acn(i,k)*gamma(1._r8+bc+pgam(i,k))/ & - (lamc(i,k)**bc*gamma(pgam(i,k)+1._r8)) - else - fc(i,k) = 0._r8 - fnc(i,k)= 0._r8 - end if - - ! calculate number and mass weighted fall velocity for cloud ice - - if (dumi(i,k).ge.qsmall) then - - vtrmi(i,k)=min(ain(i,k)*gamma_bi_plus4/(6._r8*lami(i,k)**bi), & - 1.2_r8*rhof(i,k)) - - fi(i,k) = g*rho(i,k)*vtrmi(i,k) - fni(i,k) = g*rho(i,k)* & - min(ain(i,k)*gamma_bi_plus1/lami(i,k)**bi,1.2_r8*rhof(i,k)) - - ! adjust the ice fall velocity for smaller (r < 20 um) ice - ! particles (blend over 18-20 um) - irad = 1.5_r8 / lami(i,k) * 1e6_r8 - ifrac = min(1._r8, max(0._r8, (irad - 18._r8) / 2._r8)) - - if (ifrac .lt. 1._r8) then - vtrmi(i,k) = ifrac * vtrmi(i,k) + & - (1._r8 - ifrac) * & - min(ajn(i,k)*gamma_bj_plus4/(6._r8*lami(i,k)**bj), & - 1.2_r8*rhof(i,k)) - - fi(i,k) = g*rho(i,k)*vtrmi(i,k) - fni(i,k) = ifrac * fni(i,k) + & - (1._r8 - ifrac) * & - g*rho(i,k)* & - min(ajn(i,k)*gamma_bj_plus1/lami(i,k)**bj,1.2_r8*rhof(i,k)) - end if - else - fi(i,k) = 0._r8 - fni(i,k)= 0._r8 - end if - - enddo - - enddo - - do k=1,nlev - - ! fallspeed for rain - - call size_dist_param_basic(mg_rain_props, dumr(:,k), dumnr(:,k), & - lamr(:,k), mgncol) - enddo - - do k=1,nlev - - do i=1,mgncol - if (lamr(i,k).ge.qsmall) then - - ! 'final' values of number and mass weighted mean fallspeed for rain (m/s) - - unr(i,k) = min(arn(i,k)*gamma_br_plus1/lamr(i,k)**br,9.1_r8*rhof(i,k)) - umr(i,k) = min(arn(i,k)*gamma_br_plus4/(6._r8*lamr(i,k)**br),9.1_r8*rhof(i,k)) - - fr(i,k) = g*rho(i,k)*umr(i,k) - fnr(i,k) = g*rho(i,k)*unr(i,k) - - else - fr(i,k)=0._r8 - fnr(i,k)=0._r8 - end if - - ! fallspeed for snow - - call size_dist_param_basic(mg_snow_props, dums(i,k), dumns(i,k), & - lams(i,k)) - - if (lams(i,k).ge.qsmall) then - - ! 'final' values of number and mass weighted mean fallspeed for snow (m/s) - ums(i,k) = min(asn(i,k)*gamma_bs_plus4/(6._r8*lams(i,k)**bs),1.2_r8*rhof(i,k)) - uns(i,k) = min(asn(i,k)*gamma_bs_plus1/lams(i,k)**bs,1.2_r8*rhof(i,k)) - - fs(i,k) = g*rho(i,k)*ums(i,k) - fns(i,k) = g*rho(i,k)*uns(i,k) - - else - fs(i,k)=0._r8 - fns(i,k)=0._r8 - end if - - ! redefine dummy variables - sedimentation is calculated over grid-scale - ! quantities to ensure conservation - - dumc(i,k) = (qc(i,k)+qctend(i,k)*deltat) - dumnc(i,k) = max((nc(i,k)+nctend(i,k)*deltat),0._r8) - dumi(i,k) = (qi(i,k)+qitend(i,k)*deltat) - dumni(i,k) = max((ni(i,k)+nitend(i,k)*deltat),0._r8) - dumr(i,k) = (qr(i,k)+qrtend(i,k)*deltat) - dumnr(i,k) = max((nr(i,k)+nrtend(i,k)*deltat),0._r8) - dums(i,k) = (qs(i,k)+qstend(i,k)*deltat) - dumns(i,k) = max((ns(i,k)+nstend(i,k)*deltat),0._r8) - - if (dumc(i,k).lt.qsmall) dumnc(i,k)=0._r8 - if (dumi(i,k).lt.qsmall) dumni(i,k)=0._r8 - if (dumr(i,k).lt.qsmall) dumnr(i,k)=0._r8 - if (dums(i,k).lt.qsmall) dumns(i,k)=0._r8 - - enddo - end do !!! vertical loop - - do k=1,nlev - do i=1,mgncol - pdel_inv(i,k) = 1._r8/pdel(i,k) - enddo - enddo - - ! initialize nstep for sedimentation sub-steps - - ! calculate number of split time steps to ensure courant stability criteria - ! for sedimentation calculations - !------------------------------------------------------------------- - do i=1,mgncol - nstep = 1 + int(max( & - maxval( fi(i,:)*pdel_inv(i,:)), & - maxval(fni(i,:)*pdel_inv(i,:))) & - * deltat) - - - ! loop over sedimentation sub-time step to ensure stability - !============================================================== - do n = 1,nstep - - if (do_cldice) then - falouti = fi(i,:) * dumi(i,:) - faloutni = fni(i,:) * dumni(i,:) - else - falouti = 0._r8 - faloutni = 0._r8 - end if - - ! top of model - - k = 1 - - ! add fallout terms to microphysical tendencies - faltndi = falouti(k)/pdel(i,k) - faltndni = faloutni(k)/pdel(i,k) - qitend(i,k) = qitend(i,k)-faltndi/nstep - nitend(i,k) = nitend(i,k)-faltndni/nstep - - ! sedimentation tendency for output - qisedten(i,k)=qisedten(i,k)-faltndi/nstep - - dumi(i,k) = dumi(i,k)-faltndi*deltat/nstep - dumni(i,k) = dumni(i,k)-faltndni*deltat/nstep - - do k = 2,nlev - - ! for cloud liquid and ice, if cloud fraction increases with height - ! then add flux from above to both vapor and cloud water of current level - ! this means that flux entering clear portion of cell from above evaporates - ! instantly - - ! note: this is not an issue with precip, since we assume max overlap - dum1=icldm(i,k)/icldm(i,k-1) - dum1=min(dum1,1._r8) - - faltndqie=(falouti(k)-falouti(k-1))/pdel(i,k) - faltndi=(falouti(k)-dum1*falouti(k-1))/pdel(i,k) - faltndni=(faloutni(k)-dum1*faloutni(k-1))/pdel(i,k) - - ! add fallout terms to eulerian tendencies - - qitend(i,k) = qitend(i,k)-faltndi/nstep - nitend(i,k) = nitend(i,k)-faltndni/nstep - - ! sedimentation tendency for output - qisedten(i,k)=qisedten(i,k)-faltndi/nstep - - ! add terms to to evap/sub of cloud water - - qvlat(i,k)=qvlat(i,k)-(faltndqie-faltndi)/nstep - ! for output - qisevap(i,k)=qisevap(i,k)-(faltndqie-faltndi)/nstep - - tlat(i,k)=tlat(i,k)+(faltndqie-faltndi)*xxls/nstep - - dumi(i,k) = dumi(i,k)-faltndi*deltat/nstep - dumni(i,k) = dumni(i,k)-faltndni*deltat/nstep - - end do - - ! Ice flux - do k = 1,nlev - iflx(i,k+1) = iflx(i,k+1) + falouti(k) / g / real(nstep) - end do - - ! units below are m/s - ! sedimentation flux at surface is added to precip flux at surface - ! to get total precip (cloud + precip water) rate - - prect(i) = prect(i)+falouti(nlev)/g/real(nstep)/1000._r8 - preci(i) = preci(i)+falouti(nlev)/g/real(nstep)/1000._r8 - - end do - - ! calculate number of split time steps to ensure courant stability criteria - ! for sedimentation calculations - !------------------------------------------------------------------- - nstep = 1 + int(max( & - maxval( fc(i,:)*pdel_inv(i,:)), & - maxval(fnc(i,:)*pdel_inv(i,:))) & - * deltat) - - ! loop over sedimentation sub-time step to ensure stability - !============================================================== - do n = 1,nstep - - faloutc = fc(i,:) * dumc(i,:) - faloutnc = fnc(i,:) * dumnc(i,:) - - ! top of model - k = 1 - - ! add fallout terms to microphysical tendencies - faltndc = faloutc(k)/pdel(i,k) - faltndnc = faloutnc(k)/pdel(i,k) - qctend(i,k) = qctend(i,k)-faltndc/nstep - nctend(i,k) = nctend(i,k)-faltndnc/nstep - - ! sedimentation tendency for output - qcsedten(i,k)=qcsedten(i,k)-faltndc/nstep - - dumc(i,k) = dumc(i,k)-faltndc*deltat/nstep - dumnc(i,k) = dumnc(i,k)-faltndnc*deltat/nstep - - do k = 2,nlev - - dum=lcldm(i,k)/lcldm(i,k-1) - dum=min(dum,1._r8) - faltndqce=(faloutc(k)-faloutc(k-1))/pdel(i,k) - faltndc=(faloutc(k)-dum*faloutc(k-1))/pdel(i,k) - faltndnc=(faloutnc(k)-dum*faloutnc(k-1))/pdel(i,k) - - ! add fallout terms to eulerian tendencies - qctend(i,k) = qctend(i,k)-faltndc/nstep - nctend(i,k) = nctend(i,k)-faltndnc/nstep - - ! sedimentation tendency for output - qcsedten(i,k)=qcsedten(i,k)-faltndc/nstep - - ! add terms to to evap/sub of cloud water - qvlat(i,k)=qvlat(i,k)-(faltndqce-faltndc)/nstep - ! for output - qcsevap(i,k)=qcsevap(i,k)-(faltndqce-faltndc)/nstep - - tlat(i,k)=tlat(i,k)+(faltndqce-faltndc)*xxlv/nstep - - dumc(i,k) = dumc(i,k)-faltndc*deltat/nstep - dumnc(i,k) = dumnc(i,k)-faltndnc*deltat/nstep - - end do - - !Liquid condensate flux here - do k = 1,nlev - lflx(i,k+1) = lflx(i,k+1) + faloutc(k) / g / real(nstep) - end do - - prect(i) = prect(i)+faloutc(nlev)/g/real(nstep)/1000._r8 - - end do - - ! calculate number of split time steps to ensure courant stability criteria - ! for sedimentation calculations - !------------------------------------------------------------------- - nstep = 1 + int(max( & - maxval( fr(i,:)*pdel_inv(i,:)), & - maxval(fnr(i,:)*pdel_inv(i,:))) & - * deltat) - - ! loop over sedimentation sub-time step to ensure stability - !============================================================== - do n = 1,nstep - - faloutr = fr(i,:) * dumr(i,:) - faloutnr = fnr(i,:) * dumnr(i,:) - - ! top of model - k = 1 - - ! add fallout terms to microphysical tendencies - faltndr = faloutr(k)/pdel(i,k) - faltndnr = faloutnr(k)/pdel(i,k) - qrtend(i,k) = qrtend(i,k)-faltndr/nstep - nrtend(i,k) = nrtend(i,k)-faltndnr/nstep - - ! sedimentation tendency for output - qrsedten(i,k)=qrsedten(i,k)-faltndr/nstep - - dumr(i,k) = dumr(i,k)-faltndr*deltat/real(nstep) - dumnr(i,k) = dumnr(i,k)-faltndnr*deltat/real(nstep) - - do k = 2,nlev - - faltndr=(faloutr(k)-faloutr(k-1))/pdel(i,k) - faltndnr=(faloutnr(k)-faloutnr(k-1))/pdel(i,k) - - ! add fallout terms to eulerian tendencies - qrtend(i,k) = qrtend(i,k)-faltndr/nstep - nrtend(i,k) = nrtend(i,k)-faltndnr/nstep - - ! sedimentation tendency for output - qrsedten(i,k)=qrsedten(i,k)-faltndr/nstep - - dumr(i,k) = dumr(i,k)-faltndr*deltat/real(nstep) - dumnr(i,k) = dumnr(i,k)-faltndnr*deltat/real(nstep) - - end do - - ! Rain Flux - do k = 1,nlev - rflx(i,k+1) = rflx(i,k+1) + faloutr(k) / g / real(nstep) - end do - - prect(i) = prect(i)+faloutr(nlev)/g/real(nstep)/1000._r8 - - end do - - ! calculate number of split time steps to ensure courant stability criteria - ! for sedimentation calculations - !------------------------------------------------------------------- - nstep = 1 + int(max( & - maxval( fs(i,:)*pdel_inv(i,:)), & - maxval(fns(i,:)*pdel_inv(i,:))) & - * deltat) - - ! loop over sedimentation sub-time step to ensure stability - !============================================================== - do n = 1,nstep - - falouts = fs(i,:) * dums(i,:) - faloutns = fns(i,:) * dumns(i,:) - - ! top of model - k = 1 - - ! add fallout terms to microphysical tendencies - faltnds = falouts(k)/pdel(i,k) - faltndns = faloutns(k)/pdel(i,k) - qstend(i,k) = qstend(i,k)-faltnds/nstep - nstend(i,k) = nstend(i,k)-faltndns/nstep - - ! sedimentation tendency for output - qssedten(i,k)=qssedten(i,k)-faltnds/nstep - - dums(i,k) = dums(i,k)-faltnds*deltat/real(nstep) - dumns(i,k) = dumns(i,k)-faltndns*deltat/real(nstep) - - do k = 2,nlev - - faltnds=(falouts(k)-falouts(k-1))/pdel(i,k) - faltndns=(faloutns(k)-faloutns(k-1))/pdel(i,k) - - ! add fallout terms to eulerian tendencies - qstend(i,k) = qstend(i,k)-faltnds/nstep - nstend(i,k) = nstend(i,k)-faltndns/nstep - - ! sedimentation tendency for output - qssedten(i,k)=qssedten(i,k)-faltnds/nstep - - dums(i,k) = dums(i,k)-faltnds*deltat/real(nstep) - dumns(i,k) = dumns(i,k)-faltndns*deltat/real(nstep) - - end do !! k loop - - ! Snow Flux - do k = 1,nlev - sflx(i,k+1) = sflx(i,k+1) + falouts(k) / g / real(nstep) - end do - - prect(i) = prect(i)+falouts(nlev)/g/real(nstep)/1000._r8 - preci(i) = preci(i)+falouts(nlev)/g/real(nstep)/1000._r8 - - end do !! nstep loop - - enddo - ! end sedimentation - - !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc - - ! get new update for variables that includes sedimentation tendency - ! note : here dum variables are grid-average, NOT in-cloud - - do k=1,nlev - do i=1,mgncol - dumc(i,k) = max(qc(i,k)+qctend(i,k)*deltat,0._r8) - dumi(i,k) = max(qi(i,k)+qitend(i,k)*deltat,0._r8) - dumnc(i,k) = max(nc(i,k)+nctend(i,k)*deltat,0._r8) - dumni(i,k) = max(ni(i,k)+nitend(i,k)*deltat,0._r8) - - dumr(i,k) = max(qr(i,k)+qrtend(i,k)*deltat,0._r8) - dumnr(i,k) = max(nr(i,k)+nrtend(i,k)*deltat,0._r8) - dums(i,k) = max(qs(i,k)+qstend(i,k)*deltat,0._r8) - dumns(i,k) = max(ns(i,k)+nstend(i,k)*deltat,0._r8) - - ! switch for specification of droplet and crystal number - if (nccons) then - dumnc(i,k)=ncnst/rho(i,k)*lcldm(i,k) - end if - - ! switch for specification of cloud ice number - if (nicons) then - dumni(i,k)=ninst/rho(i,k)*icldm(i,k) - end if - - if (dumc(i,k).lt.qsmall) dumnc(i,k)=0._r8 - if (dumi(i,k).lt.qsmall) dumni(i,k)=0._r8 - if (dumr(i,k).lt.qsmall) dumnr(i,k)=0._r8 - if (dums(i,k).lt.qsmall) dumns(i,k)=0._r8 - - enddo - - enddo - - ! calculate instantaneous processes (melting, homogeneous freezing) - !==================================================================== - - ! melting of snow at +2 C - do k=1,nlev - - do i=1,mgncol - - if (t(i,k)+tlat(i,k)/cpp*deltat > snowmelt) then - if (dums(i,k) > 0._r8) then - - ! make sure melting snow doesn't reduce temperature below threshold - dum = -xlf/cpp*dums(i,k) - if (t(i,k)+tlat(i,k)/cpp*deltat+dum.lt. snowmelt) then - dum = (t(i,k)+tlat(i,k)/cpp*deltat-snowmelt)*cpp/xlf - dum = dum/dums(i,k) - dum = max(0._r8,dum) - dum = min(1._r8,dum) - else - dum = 1._r8 - end if - - qstend(i,k)=qstend(i,k)-dum*dums(i,k)/deltat - nstend(i,k)=nstend(i,k)-dum*dumns(i,k)/deltat - qrtend(i,k)=qrtend(i,k)+dum*dums(i,k)/deltat - nrtend(i,k)=nrtend(i,k)+dum*dumns(i,k)/deltat - - dum1=-xlf*dum*dums(i,k)/deltat - tlat(i,k)=tlat(i,k)+dum1 - meltsdttot(i,k)=meltsdttot(i,k) + dum1 - end if - end if - enddo - enddo - do k=1,nlev - do i=1,mgncol - - ! freezing of rain at -5 C - - if (t(i,k)+tlat(i,k)/cpp*deltat < rainfrze) then - - if (dumr(i,k) > 0._r8) then - - ! make sure freezing rain doesn't increase temperature above threshold - dum = xlf/cpp*dumr(i,k) - if (t(i,k)+tlat(i,k)/cpp*deltat+dum.gt.rainfrze) then - dum = -(t(i,k)+tlat(i,k)/cpp*deltat-rainfrze)*cpp/xlf - dum = dum/dumr(i,k) - dum = max(0._r8,dum) - dum = min(1._r8,dum) - else - dum = 1._r8 - end if - - qrtend(i,k)=qrtend(i,k)-dum*dumr(i,k)/deltat - nrtend(i,k)=nrtend(i,k)-dum*dumnr(i,k)/deltat - - ! get mean size of rain = 1/lamr, add frozen rain to either snow or cloud ice - ! depending on mean rain size - - call size_dist_param_basic(mg_rain_props, dumr(i,k), dumnr(i,k), & - lamr(i,k)) - - if (lamr(i,k) < 1._r8/Dcs) then - qstend(i,k)=qstend(i,k)+dum*dumr(i,k)/deltat - nstend(i,k)=nstend(i,k)+dum*dumnr(i,k)/deltat - else - qitend(i,k)=qitend(i,k)+dum*dumr(i,k)/deltat - nitend(i,k)=nitend(i,k)+dum*dumnr(i,k)/deltat - end if - - ! heating tendency - dum1 = xlf*dum*dumr(i,k)/deltat - frzrdttot(i,k)=frzrdttot(i,k) + dum1 - tlat(i,k)=tlat(i,k)+dum1 - - end if - end if - - enddo - enddo - if (do_cldice) then - do k=1,nlev - do i=1,mgncol - if (t(i,k)+tlat(i,k)/cpp*deltat > tmelt) then - if (dumi(i,k) > 0._r8) then - - ! limit so that melting does not push temperature below freezing - !----------------------------------------------------------------- - dum = -dumi(i,k)*xlf/cpp - if (t(i,k)+tlat(i,k)/cpp*deltat+dum.lt.tmelt) then - dum = (t(i,k)+tlat(i,k)/cpp*deltat-tmelt)*cpp/xlf - dum = dum/dumi(i,k) - dum = max(0._r8,dum) - dum = min(1._r8,dum) - else - dum = 1._r8 - end if - - qctend(i,k)=qctend(i,k)+dum*dumi(i,k)/deltat - - ! for output - melttot(i,k)=dum*dumi(i,k)/deltat - - ! assume melting ice produces droplet - ! mean volume radius of 8 micron - - nctend(i,k)=nctend(i,k)+3._r8*dum*dumi(i,k)/deltat/ & - (4._r8*pi*5.12e-16_r8*rhow) - - qitend(i,k)=((1._r8-dum)*dumi(i,k)-qi(i,k))/deltat - nitend(i,k)=((1._r8-dum)*dumni(i,k)-ni(i,k))/deltat - tlat(i,k)=tlat(i,k)-xlf*dum*dumi(i,k)/deltat - end if - end if - enddo - enddo - - ! homogeneously freeze droplets at -40 C - !----------------------------------------------------------------- - - do k=1,nlev - do i=1,mgncol - if (t(i,k)+tlat(i,k)/cpp*deltat < 233.15_r8) then - if (dumc(i,k) > 0._r8) then - - ! limit so that freezing does not push temperature above threshold - dum = dumc(i,k)*xlf/cpp - if (t(i,k)+tlat(i,k)/cpp*deltat+dum.gt.233.15_r8) then - dum = -(t(i,k)+tlat(i,k)/cpp*deltat-233.15_r8)*cpp/xlf - dum = dum/dumc(i,k) - dum = max(0._r8,dum) - dum = min(1._r8,dum) - else - dum = 1._r8 - end if - - qitend(i,k)=qitend(i,k)+dum*dumc(i,k)/deltat - ! for output - homotot(i,k)=dum*dumc(i,k)/deltat - - ! assume 25 micron mean volume radius of homogeneously frozen droplets - ! consistent with size of detrained ice in stratiform.F90 - nitend(i,k)=nitend(i,k)+dum*3._r8*dumc(i,k)/(4._r8*3.14_r8*1.563e-14_r8* & - 500._r8)/deltat - qctend(i,k)=((1._r8-dum)*dumc(i,k)-qc(i,k))/deltat - nctend(i,k)=((1._r8-dum)*dumnc(i,k)-nc(i,k))/deltat - tlat(i,k)=tlat(i,k)+xlf*dum*dumc(i,k)/deltat - end if - end if - enddo - enddo - ! remove any excess over-saturation, which is possible due to non-linearity when adding - ! together all microphysical processes - !----------------------------------------------------------------- - ! follow code similar to old CAM scheme - do k=1,nlev - do i=1,mgncol - - qtmp=q(i,k)+qvlat(i,k)*deltat - ttmp=t(i,k)+tlat(i,k)/cpp*deltat - - ! use rhw to allow ice supersaturation - call qsat_water(ttmp, p(i,k), esn, qvn) - - if (qtmp > qvn .and. qvn > 0 .and. allow_sed_supersat) then - ! expression below is approximate since there may be ice deposition - dum = (qtmp-qvn)/(1._r8+xxlv_squared*qvn/(cpp*rv*ttmp**2))/deltat - ! add to output cme - cmeout(i,k) = cmeout(i,k)+dum - ! now add to tendencies, partition between liquid and ice based on temperature - if (ttmp > 268.15_r8) then - dum1=0.0_r8 - ! now add to tendencies, partition between liquid and ice based on te - !------------------------------------------------------- - else if (ttmp < 238.15_r8) then - dum1=1.0_r8 - else - dum1=(268.15_r8-ttmp)/30._r8 - end if - - dum = (qtmp-qvn)/(1._r8+(xxls*dum1+xxlv*(1._r8-dum1))**2 & - *qvn/(cpp*rv*ttmp**2))/deltat - qctend(i,k)=qctend(i,k)+dum*(1._r8-dum1) - ! for output - qcrestot(i,k)=dum*(1._r8-dum1) - qitend(i,k)=qitend(i,k)+dum*dum1 - qirestot(i,k)=dum*dum1 - qvlat(i,k)=qvlat(i,k)-dum - ! for output - qvres(i,k)=-dum - tlat(i,k)=tlat(i,k)+dum*(1._r8-dum1)*xxlv+dum*dum1*xxls - end if - enddo - enddo - end if - - ! calculate effective radius for pass to radiation code - !========================================================= - ! if no cloud water, default value is 10 micron for droplets, - ! 25 micron for cloud ice - - ! update cloud variables after instantaneous processes to get effective radius - ! variables are in-cloud to calculate size dist parameters - do k=1,nlev - do i=1,mgncol - dumc(i,k) = max(qc(i,k)+qctend(i,k)*deltat,0._r8)/lcldm(i,k) - dumi(i,k) = max(qi(i,k)+qitend(i,k)*deltat,0._r8)/icldm(i,k) - dumnc(i,k) = max(nc(i,k)+nctend(i,k)*deltat,0._r8)/lcldm(i,k) - dumni(i,k) = max(ni(i,k)+nitend(i,k)*deltat,0._r8)/icldm(i,k) - - dumr(i,k) = max(qr(i,k)+qrtend(i,k)*deltat,0._r8)/precip_frac(i,k) - dumnr(i,k) = max(nr(i,k)+nrtend(i,k)*deltat,0._r8)/precip_frac(i,k) - dums(i,k) = max(qs(i,k)+qstend(i,k)*deltat,0._r8)/precip_frac(i,k) - dumns(i,k) = max(ns(i,k)+nstend(i,k)*deltat,0._r8)/precip_frac(i,k) - - ! switch for specification of droplet and crystal number - if (nccons) then - dumnc(i,k)=ncnst/rho(i,k) - end if - - ! switch for specification of cloud ice number - if (nicons) then - dumni(i,k)=ninst/rho(i,k) - end if - - ! limit in-cloud mixing ratio to reasonable value of 5 g kg-1 - dumc(i,k)=min(dumc(i,k),5.e-3_r8) - dumi(i,k)=min(dumi(i,k),5.e-3_r8) - ! limit in-precip mixing ratios - dumr(i,k)=min(dumr(i,k),10.e-3_r8) - dums(i,k)=min(dums(i,k),10.e-3_r8) - enddo - enddo - ! cloud ice effective radius - !----------------------------------------------------------------- - - if (do_cldice) then - do k=1,nlev - do i=1,mgncol - if (dumi(i,k).ge.qsmall) then - - dum_2D(i,k) = dumni(i,k) - call size_dist_param_basic(mg_ice_props, dumi(i,k), dumni(i,k), & - lami(i,k), dumni0) - - if (dumni(i,k) /=dum_2D(i,k)) then - ! adjust number conc if needed to keep mean size in reasonable range - nitend(i,k)=(dumni(i,k)*icldm(i,k)-ni(i,k))/deltat - end if - - effi(i,k) = 1.5_r8/lami(i,k)*1.e6_r8 - sadice(i,k) = 2._r8*pi*(lami(i,k)**(-3))*dumni0*rho(i,k)*1.e-2_r8 ! m2/m3 -> cm2/cm3 - - else - effi(i,k) = 25._r8 - sadice(i,k) = 0._r8 - end if - - ! ice effective diameter for david mitchell's optics - deffi(i,k)=effi(i,k)*rhoi/rhows*2._r8 - enddo - enddo - else - do k=1,nlev - do i=1,mgncol - ! NOTE: If CARMA is doing the ice microphysics, then the ice effective - ! radius has already been determined from the size distribution. - effi(i,k) = re_ice(i,k) * 1.e6_r8 ! m -> um - deffi(i,k)=effi(i,k) * 2._r8 - sadice(i,k) = 4._r8*pi*(effi(i,k)**2)*ni(i,k)*rho(i,k)*1e-2_r8 - enddo - enddo - end if - - ! cloud droplet effective radius - !----------------------------------------------------------------- - do k=1,nlev - do i=1,mgncol - if (dumc(i,k).ge.qsmall) then - - - ! switch for specification of droplet and crystal number - if (nccons) then - ! make sure nc is consistence with the constant N by adjusting tendency, need - ! to multiply by cloud fraction - ! note that nctend may be further adjusted below if mean droplet size is - ! out of bounds - - nctend(i,k)=(ncnst/rho(i,k)*lcldm(i,k)-nc(i,k))/deltat - - end if - - dum = dumnc(i,k) - - call size_dist_param_liq(mg_liq_props, dumc(i,k), dumnc(i,k), rho(i,k), & - pgam(i,k), lamc(i,k)) - - if (dum /= dumnc(i,k)) then - ! adjust number conc if needed to keep mean size in reasonable range - nctend(i,k)=(dumnc(i,k)*lcldm(i,k)-nc(i,k))/deltat - end if - - effc(i,k) = (pgam(i,k)+3._r8)/lamc(i,k)/2._r8*1.e6_r8 - !assign output fields for shape here - lamcrad(i,k)=lamc(i,k) - pgamrad(i,k)=pgam(i,k) - - - ! recalculate effective radius for constant number, in order to separate - ! first and second indirect effects - !====================================== - ! assume constant number of 10^8 kg-1 - - dumnc(i,k)=1.e8_r8 - - ! Pass in "false" adjust flag to prevent number from being changed within - ! size distribution subroutine. - call size_dist_param_liq(mg_liq_props, dumc(i,k), dumnc(i,k), rho(i,k), & - pgam(i,k), lamc(i,k)) - - effc_fn(i,k) = (pgam(i,k)+3._r8)/lamc(i,k)/2._r8*1.e6_r8 - - else - effc(i,k) = 10._r8 - lamcrad(i,k)=0._r8 - pgamrad(i,k)=0._r8 - effc_fn(i,k) = 10._r8 - end if - enddo - enddo - ! recalculate 'final' rain size distribution parameters - ! to ensure that rain size is in bounds, adjust rain number if needed - do k=1,nlev - do i=1,mgncol - - if (dumr(i,k).ge.qsmall) then - - dum = dumnr(i,k) - - call size_dist_param_basic(mg_rain_props, dumr(i,k), dumnr(i,k), & - lamr(i,k)) - - if (dum /= dumnr(i,k)) then - ! adjust number conc if needed to keep mean size in reasonable range - nrtend(i,k)=(dumnr(i,k)*precip_frac(i,k)-nr(i,k))/deltat - end if - - end if - enddo - enddo - ! recalculate 'final' snow size distribution parameters - ! to ensure that snow size is in bounds, adjust snow number if needed - do k=1,nlev - do i=1,mgncol - if (dums(i,k).ge.qsmall) then - - dum = dumns(i,k) - - call size_dist_param_basic(mg_snow_props, dums(i,k), dumns(i,k), & - lams(i,k), n0=dumns0) - - if (dum /= dumns(i,k)) then - ! adjust number conc if needed to keep mean size in reasonable range - nstend(i,k)=(dumns(i,k)*precip_frac(i,k)-ns(i,k))/deltat - end if - - sadsnow(i,k) = 2._r8*pi*(lams(i,k)**(-3))*dumns0*rho(i,k)*1.e-2_r8 ! m2/m3 -> cm2/cm3 - - end if - - - end do ! vertical k loop - enddo - do k=1,nlev - do i=1,mgncol - ! if updated q (after microphysics) is zero, then ensure updated n is also zero - !================================================================================= - if (qc(i,k)+qctend(i,k)*deltat.lt.qsmall) nctend(i,k)=-nc(i,k)/deltat - if (do_cldice .and. qi(i,k)+qitend(i,k)*deltat.lt.qsmall) nitend(i,k)=-ni(i,k)/deltat - if (qr(i,k)+qrtend(i,k)*deltat.lt.qsmall) nrtend(i,k)=-nr(i,k)/deltat - if (qs(i,k)+qstend(i,k)*deltat.lt.qsmall) nstend(i,k)=-ns(i,k)/deltat - - end do - - end do - - ! DO STUFF FOR OUTPUT: - !================================================== - - ! qc and qi are only used for output calculations past here, - ! so add qctend and qitend back in one more time - qc = qc + qctend*deltat - qi = qi + qitend*deltat - - ! averaging for snow and rain number and diameter - !-------------------------------------------------- - - ! drout2/dsout2: - ! diameter of rain and snow - ! dsout: - ! scaled diameter of snow (passed to radiation in CAM) - ! reff_rain/reff_snow: - ! calculate effective radius of rain and snow in microns for COSP using Eq. 9 of COSP v1.3 manual - - where (qrout .gt. 1.e-7_r8 & - .and. nrout.gt.0._r8) - qrout2 = qrout * precip_frac - nrout2 = nrout * precip_frac - ! The avg_diameter call does the actual calculation; other diameter - ! outputs are just drout2 times constants. - drout2 = avg_diameter(qrout, nrout, rho, rhow) - freqr = precip_frac - - reff_rain=1.5_r8*drout2*1.e6_r8 - elsewhere - qrout2 = 0._r8 - nrout2 = 0._r8 - drout2 = 0._r8 - freqr = 0._r8 - reff_rain = 0._r8 - end where - - where (qsout .gt. 1.e-7_r8 & - .and. nsout.gt.0._r8) - qsout2 = qsout * precip_frac - nsout2 = nsout * precip_frac - ! The avg_diameter call does the actual calculation; other diameter - ! outputs are just dsout2 times constants. - dsout2 = avg_diameter(qsout, nsout, rho, rhosn) - freqs = precip_frac - - dsout=3._r8*rhosn/rhows*dsout2 - - reff_snow=1.5_r8*dsout2*1.e6_r8 - elsewhere - dsout = 0._r8 - qsout2 = 0._r8 - nsout2 = 0._r8 - dsout2 = 0._r8 - freqs = 0._r8 - reff_snow=0._r8 - end where - - ! analytic radar reflectivity - !-------------------------------------------------- - ! formulas from Matthew Shupe, NOAA/CERES - ! *****note: radar reflectivity is local (in-precip average) - ! units of mm^6/m^3 - - do i = 1,mgncol - do k=1,nlev - if (qc(i,k).ge.qsmall .and. (nc(i,k)+nctend(i,k)*deltat).gt.10._r8) then - dum=(qc(i,k)/lcldm(i,k)*rho(i,k)*1000._r8)**2 & - /(0.109_r8*(nc(i,k)+nctend(i,k)*deltat)/lcldm(i,k)*rho(i,k)/1.e6_r8)*lcldm(i,k)/precip_frac(i,k) - else - dum=0._r8 - end if - if (qi(i,k).ge.qsmall) then - dum1=(qi(i,k)*rho(i,k)/icldm(i,k)*1000._r8/0.1_r8)**(1._r8/0.63_r8)*icldm(i,k)/precip_frac(i,k) - else - dum1=0._r8 - end if - - if (qsout(i,k).ge.qsmall) then - dum1=dum1+(qsout(i,k)*rho(i,k)*1000._r8/0.1_r8)**(1._r8/0.63_r8) - end if - - refl(i,k)=dum+dum1 - - ! add rain rate, but for 37 GHz formulation instead of 94 GHz - ! formula approximated from data of Matrasov (2007) - ! rainrt is the rain rate in mm/hr - ! reflectivity (dum) is in DBz - - if (rainrt(i,k).ge.0.001_r8) then - dum=log10(rainrt(i,k)**6._r8)+16._r8 - - ! convert from DBz to mm^6/m^3 - - dum = 10._r8**(dum/10._r8) - else - ! don't include rain rate in R calculation for values less than 0.001 mm/hr - dum=0._r8 - end if - - ! add to refl - - refl(i,k)=refl(i,k)+dum - - !output reflectivity in Z. - areflz(i,k)=refl(i,k) * precip_frac(i,k) - - ! convert back to DBz - - if (refl(i,k).gt.minrefl) then - refl(i,k)=10._r8*log10(refl(i,k)) - else - refl(i,k)=-9999._r8 - end if - - !set averaging flag - if (refl(i,k).gt.mindbz) then - arefl(i,k)=refl(i,k) * precip_frac(i,k) - frefl(i,k)=precip_frac(i,k) - else - arefl(i,k)=0._r8 - areflz(i,k)=0._r8 - frefl(i,k)=0._r8 - end if - - ! bound cloudsat reflectivity - - csrfl(i,k)=min(csmax,refl(i,k)) - - !set averaging flag - if (csrfl(i,k).gt.csmin) then - acsrfl(i,k)=refl(i,k) * precip_frac(i,k) - fcsrfl(i,k)=precip_frac(i,k) - else - acsrfl(i,k)=0._r8 - fcsrfl(i,k)=0._r8 - end if - - end do - end do - - !redefine fice here.... - dum_2D = qsout + qrout + qc + qi - dumi = qsout + qi - where (dumi .gt. qsmall .and. dum_2D .gt. qsmall) - nfice=min(dumi/dum_2D,1._r8) - elsewhere - nfice=0._r8 - end where - -end subroutine micro_mg_tend - -!======================================================================== -!OUTPUT CALCULATIONS -!======================================================================== - -subroutine calc_rercld(lamr, n0r, lamc, pgam, qric, qcic, ncic, rercld, mgncol) - integer, intent(in) :: mgncol - real(r8), dimension(mgncol), intent(in) :: lamr ! rain size parameter (slope) - real(r8), dimension(mgncol), intent(in) :: n0r ! rain size parameter (intercept) - real(r8), dimension(mgncol), intent(in) :: lamc ! size distribution parameter (slope) - real(r8), dimension(mgncol), intent(in) :: pgam ! droplet size parameter - real(r8), dimension(mgncol), intent(in) :: qric ! in-cloud rain mass mixing ratio - real(r8), dimension(mgncol), intent(in) :: qcic ! in-cloud cloud liquid - real(r8), dimension(mgncol), intent(in) :: ncic ! in-cloud droplet number concentration - - real(r8), dimension(mgncol), intent(inout) :: rercld ! effective radius calculation for rain + cloud - - ! combined size of precip & cloud drops - real(r8) :: Atmp - - integer :: i - - do i=1,mgncol - ! Rain drops - if (lamr(i) > 0._r8) then - Atmp = n0r(i) * pi / (2._r8 * lamr(i)**3._r8) - else - Atmp = 0._r8 - end if - - ! Add cloud drops - if (lamc(i) > 0._r8) then - Atmp = Atmp + & - ncic(i) * pi * rising_factorial(pgam(i)+1._r8, 2)/(4._r8 * lamc(i)**2._r8) - end if - - if (Atmp > 0._r8) then - rercld(i) = rercld(i) + 3._r8 *(qric(i) + qcic(i)) / (4._r8 * rhow * Atmp) - end if - enddo -end subroutine calc_rercld - -!======================================================================== -!UTILITIES -!======================================================================== - -pure subroutine micro_mg_get_cols(ncol, nlev, top_lev, qcn, qin, & - qrn, qsn, mgncol, mgcols) - - ! Determines which columns microphysics should operate over by - ! checking for non-zero cloud water/ice. - - integer, intent(in) :: ncol ! Number of columns with meaningful data - integer, intent(in) :: nlev ! Number of levels to use - integer, intent(in) :: top_lev ! Top level for microphysics - - real(r8), intent(in) :: qcn(:,:) ! cloud water mixing ratio (kg/kg) - real(r8), intent(in) :: qin(:,:) ! cloud ice mixing ratio (kg/kg) - real(r8), intent(in) :: qrn(:,:) ! rain mixing ratio (kg/kg) - real(r8), intent(in) :: qsn(:,:) ! snow mixing ratio (kg/kg) - - integer, intent(out) :: mgncol ! Number of columns MG will use - integer, allocatable, intent(out) :: mgcols(:) ! column indices - - integer :: lev_offset ! top_lev - 1 (defined here for consistency) - logical :: ltrue(ncol) ! store tests for each column - - integer :: i, ii ! column indices - - if (allocated(mgcols)) deallocate(mgcols) - - lev_offset = top_lev - 1 - - ! Using "any" along dimension 2 collapses across levels, but - ! not columns, so we know if water is present at any level - ! in each column. - - ltrue = any(qcn(:ncol,top_lev:(nlev+lev_offset)) >= qsmall, 2) - ltrue = ltrue .or. any(qin(:ncol,top_lev:(nlev+lev_offset)) >= qsmall, 2) - ltrue = ltrue .or. any(qrn(:ncol,top_lev:(nlev+lev_offset)) >= qsmall, 2) - ltrue = ltrue .or. any(qsn(:ncol,top_lev:(nlev+lev_offset)) >= qsmall, 2) - - ! Scan for true values to get a usable list of indices. - - mgncol = count(ltrue) - allocate(mgcols(mgncol)) - i = 0 - do ii = 1,ncol - if (ltrue(ii)) then - i = i + 1 - mgcols(i) = ii - end if - end do - -end subroutine micro_mg_get_cols - -end module micro_mg2_0 diff --git a/src/physics/cam/phys_control.F90.orig b/src/physics/cam/phys_control.F90.orig deleted file mode 100644 index 743bcf80ff..0000000000 --- a/src/physics/cam/phys_control.F90.orig +++ /dev/null @@ -1,403 +0,0 @@ -module phys_control -!----------------------------------------------------------------------- -! Purpose: -! -! Provides a control interface to CAM physics packages -! -! Revision history: -! 2006-05-01 D. B. Coleman, Creation of module -! 2009-02-13 Eaton Replace *_{default,set}opts methods with module namelist. -! Add vars to indicate physics version and chemistry type. -!----------------------------------------------------------------------- - -use spmd_utils, only: masterproc -use cam_logfile, only: iulog -use cam_abortutils, only: endrun -use shr_kind_mod, only: r8 => shr_kind_r8 - -implicit none -private -save - -public :: & - phys_ctl_readnl, &! read namelist from file - phys_getopts, &! generic query method - phys_setopts, &! generic set method - phys_deepconv_pbl, &! return true if deep convection is allowed in the PBL - phys_do_flux_avg, &! return true to average surface fluxes - cam_physpkg_is, &! query for the name of the physics package - cam_chempkg_is, &! query for the name of the chemistry package - waccmx_is - -! Private module data - -character(len=16), parameter :: unset_str = 'UNSET' -integer, parameter :: unset_int = huge(1) - -! Namelist variables: -character(len=16) :: cam_physpkg = unset_str ! CAM physics package -character(len=32) :: cam_chempkg = unset_str ! CAM chemistry package -character(len=16) :: waccmx_opt = unset_str ! WACCMX run option [ionosphere | neutral | off -character(len=16) :: deep_scheme = unset_str ! deep convection package -character(len=16) :: shallow_scheme = unset_str ! shallow convection package -character(len=16) :: eddy_scheme = unset_str ! vertical diffusion package -character(len=16) :: microp_scheme = unset_str ! microphysics package -character(len=16) :: macrop_scheme = unset_str ! macrophysics package -character(len=16) :: radiation_scheme = unset_str ! radiation package -integer :: srf_flux_avg = unset_int ! 1 => smooth surface fluxes, 0 otherwise - -logical :: use_subcol_microp = .false. ! if .true. then use sub-columns in microphysics - -logical :: atm_dep_flux = .true. ! true => deposition fluxes will be provided - ! to the coupler -logical :: history_amwg = .true. ! output the variables used by the AMWG diag package -logical :: history_vdiag = .false. ! output the variables used by the AMWG variability diag package -logical :: history_aerosol = .false. ! output the MAM aerosol variables and tendencies -logical :: history_aero_optics = .false. ! output the aerosol -logical :: history_eddy = .false. ! output the eddy variables -logical :: history_budget = .false. ! output tendencies and state variables for CAM4 - ! temperature, water vapor, cloud ice and cloud - ! liquid budgets. -logical :: convproc_do_aer = .false. ! switch for new convective scavenging treatment for modal aerosols - -integer :: history_budget_histfile_num = 1 ! output history file number for budget fields -logical :: history_waccm = .false. ! output variables of interest for WACCM runs -logical :: history_waccmx = .false. ! output variables of interest for WACCM-X runs -logical :: history_chemistry = .true. ! output default chemistry-related variables -logical :: history_carma = .false. ! output default CARMA-related variables -logical :: history_clubb = .true. ! output default CLUBB-related variables -logical :: history_cesm_forcing = .false. -logical :: history_dust = .false. -logical :: history_scwaccm_forcing = .false. -logical :: history_chemspecies_srf = .false. - -logical :: do_clubb_sgs -! Check validity of physics_state objects in physics_update. -logical :: state_debug_checks = .false. - -! Macro/micro-physics co-substeps -integer :: cld_macmic_num_steps = 1 - -logical :: offline_driver = .false. ! true => offline driver is being used - - -logical, public, protected :: use_simple_phys = .false. ! true => simple physics configuration - -logical :: use_spcam ! true => use super parameterized CAM - -logical :: prog_modal_aero ! determines whether prognostic modal aerosols are present in the run. - -! Option to use heterogeneous freezing -logical, public, protected :: use_hetfrz_classnuc = .false. - -! Which gravity wave sources are used? -logical, public, protected :: use_gw_oro = .true. ! Orography. -logical, public, protected :: use_gw_front = .false. ! Frontogenesis. -logical, public, protected :: use_gw_front_igw = .false. ! Frontogenesis to inertial spectrum. -logical, public, protected :: use_gw_convect_dp = .false. ! Deep convection. -logical, public, protected :: use_gw_convect_sh = .false. ! Shallow convection. - -! FV dycore angular momentum correction -logical, public, protected :: fv_am_correction = .false. - -!======================================================================= -contains -!======================================================================= - -subroutine phys_ctl_readnl(nlfile) - - use namelist_utils, only: find_group_name - use units, only: getunit, freeunit - use spmd_utils, only: mpi_character, mpi_integer, mpi_logical, masterprocid, mpicom - use cam_control_mod, only: cam_ctrl_set_physics_type - - character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input - - ! Local variables - integer :: unitn, ierr - character(len=*), parameter :: subname = 'phys_ctl_readnl' - - namelist /phys_ctl_nl/ cam_physpkg, use_simple_phys, cam_chempkg, waccmx_opt, & - deep_scheme, shallow_scheme, & - eddy_scheme, microp_scheme, macrop_scheme, radiation_scheme, srf_flux_avg, & - use_subcol_microp, atm_dep_flux, history_amwg, history_vdiag, history_aerosol, history_aero_optics, & - history_eddy, history_budget, history_budget_histfile_num, history_waccm, & - history_waccmx, history_chemistry, history_carma, history_clubb, history_dust, & - history_cesm_forcing, history_scwaccm_forcing, history_chemspecies_srf, & - do_clubb_sgs, state_debug_checks, use_hetfrz_classnuc, use_gw_oro, use_gw_front, & - use_gw_front_igw, use_gw_convect_dp, use_gw_convect_sh, cld_macmic_num_steps, & - offline_driver, convproc_do_aer - !----------------------------------------------------------------------------- - - if (masterproc) then - unitn = getunit() - open( unitn, file=trim(nlfile), status='old' ) - call find_group_name(unitn, 'phys_ctl_nl', status=ierr) - if (ierr == 0) then - read(unitn, phys_ctl_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(deep_scheme, len(deep_scheme), mpi_character, masterprocid, mpicom, ierr) - call mpi_bcast(cam_physpkg, len(cam_physpkg), mpi_character, masterprocid, mpicom, ierr) - call mpi_bcast(use_simple_phys, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(cam_chempkg, len(cam_chempkg), mpi_character, masterprocid, mpicom, ierr) - call mpi_bcast(waccmx_opt, len(waccmx_opt), mpi_character, masterprocid, mpicom, ierr) - call mpi_bcast(shallow_scheme, len(shallow_scheme), mpi_character, masterprocid, mpicom, ierr) - call mpi_bcast(eddy_scheme, len(eddy_scheme), mpi_character, masterprocid, mpicom, ierr) - call mpi_bcast(microp_scheme, len(microp_scheme), mpi_character, masterprocid, mpicom, ierr) - call mpi_bcast(radiation_scheme, len(radiation_scheme), mpi_character, masterprocid, mpicom, ierr) - call mpi_bcast(macrop_scheme, len(macrop_scheme), mpi_character, masterprocid, mpicom, ierr) - call mpi_bcast(srf_flux_avg, 1, mpi_integer, masterprocid, mpicom, ierr) - call mpi_bcast(use_subcol_microp, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(atm_dep_flux, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(history_amwg, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(history_vdiag, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(history_eddy, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(history_aerosol, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(history_aero_optics, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(history_budget, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(history_budget_histfile_num, 1, mpi_integer, masterprocid, mpicom, ierr) - call mpi_bcast(history_waccm, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(history_waccmx, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(history_chemistry, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(history_carma, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(history_clubb, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(history_cesm_forcing, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(history_chemspecies_srf, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(history_dust, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(history_scwaccm_forcing, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(do_clubb_sgs, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(state_debug_checks, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(use_hetfrz_classnuc, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(use_gw_oro, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(use_gw_front, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(use_gw_front_igw, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(use_gw_convect_dp, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(use_gw_convect_sh, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(cld_macmic_num_steps, 1, mpi_integer, masterprocid, mpicom, ierr) - call mpi_bcast(offline_driver, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(convproc_do_aer, 1, mpi_logical, masterprocid, mpicom, ierr) - - use_spcam = ( cam_physpkg_is('spcam_sam1mom') & - .or. cam_physpkg_is('spcam_m2005')) - - call cam_ctrl_set_physics_type(cam_physpkg) - - ! Error checking: - - ! Check compatibility of eddy & shallow schemes - if (( shallow_scheme .eq. 'UW' ) .and. ( eddy_scheme .ne. 'diag_TKE' )) then - write(iulog,*)'Do you really want to run UW shallow scheme without diagnostic TKE eddy scheme? Quiting' - call endrun('shallow convection and eddy scheme may be incompatible') - endif - - if (( shallow_scheme .eq. 'Hack' ) .and. ( ( eddy_scheme .ne. 'HB' ) .and. ( eddy_scheme .ne. 'HBR' ))) then - write(iulog,*)'Do you really want to run Hack shallow scheme with a non-standard eddy scheme? Quiting.' - call endrun('shallow convection and eddy scheme may be incompatible') - endif - - ! Check compatibility of PBL and Microphysics schemes - if (( eddy_scheme .eq. 'diag_TKE' ) .and. ( microp_scheme .eq. 'RK' )) then - write(iulog,*)'UW PBL is not compatible with RK microphysics. Quiting' - call endrun('PBL and Microphysics schemes incompatible') - endif - - ! Add a check to make sure CLUBB and MG are used together - if ( do_clubb_sgs .and. ( microp_scheme .ne. 'MG') .and. .not. use_spcam) then - write(iulog,*)'CLUBB is only compatible with MG microphysics. Quiting' - call endrun('CLUBB and microphysics schemes incompatible') - endif - - ! Check that eddy_scheme, macrop_scheme, shallow_scheme are all set to CLUBB_SGS if do_clubb_sgs is true - if (do_clubb_sgs .and. .not. use_spcam) then - if (eddy_scheme .ne. 'CLUBB_SGS' .or. macrop_scheme .ne. 'CLUBB_SGS' .or. shallow_scheme .ne. 'CLUBB_SGS') then - write(iulog,*)'eddy_scheme, macrop_scheme and shallow_scheme must all be CLUBB_SGS. Quiting' - call endrun('CLUBB and eddy, macrop or shallow schemes incompatible') - endif - endif - - ! Macro/micro co-substepping support. - if (cld_macmic_num_steps > 1) then - if (microp_scheme /= "MG" .or. (macrop_scheme /= "park" .and. macrop_scheme /= "CLUBB_SGS")) then - call endrun ("Setting cld_macmic_num_steps > 1 is only & - &supported with Park or CLUBB macrophysics and MG microphysics.") - end if - end if - - ! prog_modal_aero determines whether prognostic modal aerosols are present in the run. - prog_modal_aero = index(cam_chempkg,'_mam')>0 - -end subroutine phys_ctl_readnl - -!=============================================================================== - -logical function cam_physpkg_is(name) - - ! query for the name of the physics package - - character(len=*) :: name - - cam_physpkg_is = (trim(name) == trim(cam_physpkg)) -end function cam_physpkg_is - -!=============================================================================== - -logical function cam_chempkg_is(name) - - ! query for the name of the chemics package - - character(len=*) :: name - - cam_chempkg_is = (trim(name) == trim(cam_chempkg)) -end function cam_chempkg_is - -!=============================================================================== - -logical function waccmx_is(name) - - ! query for the name of the waccmx run option - - character(len=*) :: name - - waccmx_is = (trim(name) == trim(waccmx_opt)) -end function waccmx_is - -!=============================================================================== - -subroutine phys_getopts(deep_scheme_out, shallow_scheme_out, eddy_scheme_out, microp_scheme_out, & - radiation_scheme_out, use_subcol_microp_out, atm_dep_flux_out, & - history_amwg_out, history_vdiag_out, history_aerosol_out, history_aero_optics_out, history_eddy_out, & - history_budget_out, history_budget_histfile_num_out, & - history_waccm_out, history_waccmx_out, history_chemistry_out, & - history_carma_out, history_clubb_out, history_dust_out, & - history_cesm_forcing_out, history_scwaccm_forcing_out, history_chemspecies_srf_out, & - cam_chempkg_out, prog_modal_aero_out, macrop_scheme_out, & - do_clubb_sgs_out, use_spcam_out, state_debug_checks_out, cld_macmic_num_steps_out, & - offline_driver_out, convproc_do_aer_out) -!----------------------------------------------------------------------- -! Purpose: Return runtime settings -! deep_scheme_out : deep convection scheme -! shallow_scheme_out: shallow convection scheme -! eddy_scheme_out : vertical diffusion scheme -! microp_scheme_out : microphysics scheme -! radiation_scheme_out : radiation_scheme -! SPCAM_microp_scheme_out : SPCAM microphysics scheme -!----------------------------------------------------------------------- - - character(len=16), intent(out), optional :: deep_scheme_out - character(len=16), intent(out), optional :: shallow_scheme_out - character(len=16), intent(out), optional :: eddy_scheme_out - character(len=16), intent(out), optional :: microp_scheme_out - character(len=16), intent(out), optional :: radiation_scheme_out - character(len=16), intent(out), optional :: macrop_scheme_out - logical, intent(out), optional :: use_subcol_microp_out - logical, intent(out), optional :: use_spcam_out - logical, intent(out), optional :: atm_dep_flux_out - logical, intent(out), optional :: history_amwg_out - logical, intent(out), optional :: history_vdiag_out - logical, intent(out), optional :: history_eddy_out - logical, intent(out), optional :: history_aerosol_out - logical, intent(out), optional :: history_aero_optics_out - logical, intent(out), optional :: history_budget_out - integer, intent(out), optional :: history_budget_histfile_num_out - logical, intent(out), optional :: history_waccm_out - logical, intent(out), optional :: history_waccmx_out - logical, intent(out), optional :: history_chemistry_out - logical, intent(out), optional :: history_carma_out - logical, intent(out), optional :: history_clubb_out - logical, intent(out), optional :: history_cesm_forcing_out - logical, intent(out), optional :: history_chemspecies_srf_out - logical, intent(out), optional :: history_dust_out - logical, intent(out), optional :: history_scwaccm_forcing_out - logical, intent(out), optional :: do_clubb_sgs_out - character(len=32), intent(out), optional :: cam_chempkg_out - logical, intent(out), optional :: prog_modal_aero_out - logical, intent(out), optional :: state_debug_checks_out - integer, intent(out), optional :: cld_macmic_num_steps_out - logical, intent(out), optional :: offline_driver_out - logical, intent(out), optional :: convproc_do_aer_out - - if ( present(deep_scheme_out ) ) deep_scheme_out = deep_scheme - if ( present(shallow_scheme_out ) ) shallow_scheme_out = shallow_scheme - if ( present(eddy_scheme_out ) ) eddy_scheme_out = eddy_scheme - if ( present(microp_scheme_out ) ) microp_scheme_out = microp_scheme - if ( present(radiation_scheme_out ) ) radiation_scheme_out = radiation_scheme - if ( present(use_subcol_microp_out ) ) use_subcol_microp_out = use_subcol_microp - if ( present(use_spcam_out ) ) use_spcam_out = use_spcam - - if ( present(macrop_scheme_out ) ) macrop_scheme_out = macrop_scheme - if ( present(atm_dep_flux_out ) ) atm_dep_flux_out = atm_dep_flux - if ( present(history_aerosol_out ) ) history_aerosol_out = history_aerosol - if ( present(history_aero_optics_out ) ) history_aero_optics_out = history_aero_optics - if ( present(history_budget_out ) ) history_budget_out = history_budget - if ( present(history_amwg_out ) ) history_amwg_out = history_amwg - if ( present(history_vdiag_out ) ) history_vdiag_out = history_vdiag - if ( present(history_eddy_out ) ) history_eddy_out = history_eddy - if ( present(history_budget_histfile_num_out ) ) history_budget_histfile_num_out = history_budget_histfile_num - if ( present(history_waccm_out ) ) history_waccm_out = history_waccm - if ( present(history_waccmx_out ) ) history_waccmx_out = history_waccmx - if ( present(history_chemistry_out ) ) history_chemistry_out = history_chemistry - if ( present(history_cesm_forcing_out) ) history_cesm_forcing_out = history_cesm_forcing - if ( present(history_chemspecies_srf_out) ) history_chemspecies_srf_out = history_chemspecies_srf - if ( present(history_scwaccm_forcing_out) ) history_scwaccm_forcing_out = history_scwaccm_forcing - if ( present(history_carma_out ) ) history_carma_out = history_carma - if ( present(history_clubb_out ) ) history_clubb_out = history_clubb - if ( present(history_dust_out ) ) history_dust_out = history_dust - if ( present(do_clubb_sgs_out ) ) do_clubb_sgs_out = do_clubb_sgs - if ( present(cam_chempkg_out ) ) cam_chempkg_out = cam_chempkg - if ( present(prog_modal_aero_out ) ) prog_modal_aero_out = prog_modal_aero - if ( present(state_debug_checks_out ) ) state_debug_checks_out = state_debug_checks - if ( present(cld_macmic_num_steps_out) ) cld_macmic_num_steps_out = cld_macmic_num_steps - if ( present(offline_driver_out ) ) offline_driver_out = offline_driver - if ( present(convproc_do_aer_out ) ) convproc_do_aer_out = convproc_do_aer - -end subroutine phys_getopts - -!=============================================================================== - -subroutine phys_setopts(fv_am_correction_in) - - logical, intent(in), optional :: fv_am_correction_in - - if ( present(fv_am_correction_in) ) fv_am_correction = fv_am_correction_in - -end subroutine phys_setopts - -!=============================================================================== - -function phys_deepconv_pbl() - - logical phys_deepconv_pbl - - ! Don't allow deep convection in PBL if running UW PBL scheme - if ( (eddy_scheme .eq. 'diag_TKE' ) .or. (shallow_scheme .eq. 'UW' ) ) then - phys_deepconv_pbl = .true. - else - phys_deepconv_pbl = .false. - endif - - return - -end function phys_deepconv_pbl - -!=============================================================================== - -function phys_do_flux_avg() - - logical :: phys_do_flux_avg - !---------------------------------------------------------------------- - - phys_do_flux_avg = .false. - if (srf_flux_avg == 1) phys_do_flux_avg = .true. - -end function phys_do_flux_avg - -!=============================================================================== -end module phys_control diff --git a/src/physics/cam/physics_types.F90.orig b/src/physics/cam/physics_types.F90.orig deleted file mode 100644 index f08911ad50..0000000000 --- a/src/physics/cam/physics_types.F90.orig +++ /dev/null @@ -1,1943 +0,0 @@ -!------------------------------------------------------------------------------- -!physics data types module -!------------------------------------------------------------------------------- -module physics_types - - use shr_kind_mod, only: r8 => shr_kind_r8 - use ppgrid, only: pcols, pver, psubcols - use constituents, only: pcnst, qmin, cnst_name - use geopotential, only: geopotential_dse, geopotential_t - use physconst, only: zvir, gravit, cpair, rair, cpairv, rairv - use phys_grid, only: get_ncols_p, get_rlon_all_p, get_rlat_all_p, get_gcol_all_p - use cam_logfile, only: iulog - use cam_abortutils, only: endrun - use phys_control, only: waccmx_is - use shr_const_mod, only: shr_const_rwv - - implicit none - private ! Make default type private to the module - - logical, parameter :: adjust_te = .FALSE. - -! Public types: - - public physics_state - public physics_tend - public physics_ptend - -! Public interfaces - - public physics_update - public physics_state_check ! Check state object for invalid data. - public physics_ptend_reset - public physics_ptend_init - public physics_state_set_grid - public physics_dme_adjust ! adjust dry mass and energy for change in water - ! cannot be applied to eul or sld dycores - public physics_state_copy ! copy a physics_state object - public physics_ptend_copy ! copy a physics_ptend object - public physics_ptend_sum ! accumulate physics_ptend objects - public physics_ptend_scale ! Multiply physics_ptend objects by a constant factor. - public physics_tend_init ! initialize a physics_tend object - - public set_state_pdry ! calculate dry air masses in state variable - public set_wet_to_dry - public set_dry_to_wet - public physics_type_alloc - - public physics_state_alloc ! allocate individual components within state - public physics_state_dealloc ! deallocate individual components within state - public physics_tend_alloc ! allocate individual components within tend - public physics_tend_dealloc ! deallocate individual components within tend - public physics_ptend_alloc ! allocate individual components within tend - public physics_ptend_dealloc ! deallocate individual components within tend - -!------------------------------------------------------------------------------- - type physics_state - integer :: & - lchnk, &! chunk index - ngrdcol, &! -- Grid -- number of active columns (on the grid) - psetcols=0, &! -- -- max number of columns set - if subcols = pcols*psubcols, else = pcols - ncol=0 ! -- -- sum of nsubcol for all ngrdcols - number of active columns - real(r8), dimension(:), allocatable :: & - lat, &! latitude (radians) - lon, &! longitude (radians) - ps, &! surface pressure - psdry, &! dry surface pressure - phis, &! surface geopotential - ulat, &! unique latitudes (radians) - ulon ! unique longitudes (radians) - real(r8), dimension(:,:),allocatable :: & - t, &! temperature (K) - u, &! zonal wind (m/s) - v, &! meridional wind (m/s) - s, &! dry static energy - omega, &! vertical pressure velocity (Pa/s) - pmid, &! midpoint pressure (Pa) - pmiddry, &! midpoint pressure dry (Pa) - pdel, &! layer thickness (Pa) - pdeldry, &! layer thickness dry (Pa) - rpdel, &! reciprocal of layer thickness (Pa) - rpdeldry,&! recipricol layer thickness dry (Pa) - lnpmid, &! ln(pmid) - lnpmiddry,&! log midpoint pressure dry (Pa) - exner, &! inverse exner function w.r.t. surface pressure (ps/p)^(R/cp) - zm ! geopotential height above surface at midpoints (m) - - real(r8), dimension(:,:,:),allocatable :: & - q ! constituent mixing ratio (kg/kg moist or dry air depending on type) - - real(r8), dimension(:,:),allocatable :: & - pint, &! interface pressure (Pa) - pintdry, &! interface pressure dry (Pa) - lnpint, &! ln(pint) - lnpintdry,&! log interface pressure dry (Pa) - zi ! geopotential height above surface at interfaces (m) - - real(r8), dimension(:),allocatable :: & - te_ini, &! vertically integrated total (kinetic + static) energy of initial state - te_cur, &! vertically integrated total (kinetic + static) energy of current state - tw_ini, &! vertically integrated total water of initial state - tw_cur ! vertically integrated total water of new state - integer :: count ! count of values with significant energy or water imbalances - integer, dimension(:),allocatable :: & - latmapback, &! map from column to unique lat for that column - lonmapback, &! map from column to unique lon for that column - cid ! unique column id - integer :: ulatcnt, &! number of unique lats in chunk - uloncnt ! number of unique lons in chunk - - end type physics_state - -!------------------------------------------------------------------------------- - type physics_tend - - integer :: psetcols=0 ! max number of columns set- if subcols = pcols*psubcols, else = pcols - - real(r8), dimension(:,:),allocatable :: dtdt, dudt, dvdt - real(r8), dimension(:), allocatable :: flx_net - real(r8), dimension(:), allocatable :: & - te_tnd, &! cumulative boundary flux of total energy - tw_tnd ! cumulative boundary flux of total water - end type physics_tend - -!------------------------------------------------------------------------------- -! This is for tendencies returned from individual parameterizations - type physics_ptend - - integer :: psetcols=0 ! max number of columns set- if subcols = pcols*psubcols, else = pcols - - character*24 :: name ! name of parameterization which produced tendencies. - - logical :: & - ls = .false., &! true if dsdt is returned - lu = .false., &! true if dudt is returned - lv = .false. ! true if dvdt is returned - - logical,dimension(pcnst) :: lq = .false. ! true if dqdt() is returned - - integer :: & - top_level, &! top level index for which nonzero tendencies have been set - bot_level ! bottom level index for which nonzero tendencies have been set - - real(r8), dimension(:,:),allocatable :: & - s, &! heating rate (J/kg/s) - u, &! u momentum tendency (m/s/s) - v ! v momentum tendency (m/s/s) - real(r8), dimension(:,:,:),allocatable :: & - q ! consituent tendencies (kg/kg/s) - -! boundary fluxes - real(r8), dimension(:),allocatable ::& - hflux_srf, &! net heat flux at surface (W/m2) - hflux_top, &! net heat flux at top of model (W/m2) - taux_srf, &! net zonal stress at surface (Pa) - taux_top, &! net zonal stress at top of model (Pa) - tauy_srf, &! net meridional stress at surface (Pa) - tauy_top ! net meridional stress at top of model (Pa) - real(r8), dimension(:,:),allocatable ::& - cflx_srf, &! constituent flux at surface (kg/m2/s) - cflx_top ! constituent flux top of model (kg/m2/s) - - end type physics_ptend - - -!=============================================================================== -contains -!=============================================================================== - subroutine physics_type_alloc(phys_state, phys_tend, begchunk, endchunk, psetcols) - implicit none - type(physics_state), pointer :: phys_state(:) - type(physics_tend), pointer :: phys_tend(:) - integer, intent(in) :: begchunk, endchunk - integer, intent(in) :: psetcols - - integer :: ierr=0, lchnk - type(physics_state), pointer :: state - type(physics_tend), pointer :: tend - - allocate(phys_state(begchunk:endchunk), stat=ierr) - if( ierr /= 0 ) then - write(iulog,*) 'physics_types: phys_state allocation error = ',ierr - call endrun('physics_types: failed to allocate physics_state array') - end if - - do lchnk=begchunk,endchunk - call physics_state_alloc(phys_state(lchnk),lchnk,pcols) - end do - - allocate(phys_tend(begchunk:endchunk), stat=ierr) - if( ierr /= 0 ) then - write(iulog,*) 'physics_types: phys_tend allocation error = ',ierr - call endrun('physics_types: failed to allocate physics_tend array') - end if - - do lchnk=begchunk,endchunk - call physics_tend_alloc(phys_tend(lchnk),phys_state(lchnk)%psetcols) - end do - - end subroutine physics_type_alloc -!=============================================================================== - subroutine physics_update(state, ptend, dt, tend) -!----------------------------------------------------------------------- -! Update the state and or tendency structure with the parameterization tendencies -!----------------------------------------------------------------------- - use shr_sys_mod, only: shr_sys_flush - use constituents, only: cnst_get_ind, cnst_mw - use scamMod, only: scm_crm_mode, single_column - use phys_control, only: phys_getopts - use physconst, only: physconst_update ! Routine which updates physconst variables (WACCM-X) - use ppgrid, only: begchunk, endchunk - use qneg_module, only: qneg3 - -!------------------------------Arguments-------------------------------- - type(physics_ptend), intent(inout) :: ptend ! Parameterization tendencies - - type(physics_state), intent(inout) :: state ! Physics state variables - - real(r8), intent(in) :: dt ! time step - - type(physics_tend ), intent(inout), optional :: tend ! Physics tendencies over timestep - ! This is usually only needed by calls from physpkg. -! -!---------------------------Local storage------------------------------- - integer :: i,k,m ! column,level,constituent indices - integer :: ixcldice, ixcldliq ! indices for CLDICE and CLDLIQ - integer :: ixnumice, ixnumliq - integer :: ixnumsnow, ixnumrain - integer :: ncol ! number of columns - integer :: ixh, ixh2 ! constituent indices for H, H2 - - real(r8) :: zvirv(state%psetcols,pver) ! Local zvir array pointer - - real(r8),allocatable :: cpairv_loc(:,:,:) - real(r8),allocatable :: rairv_loc(:,:,:) - - ! PERGRO limits cldliq/ice for macro/microphysics: - character(len=24), parameter :: pergro_cldlim_names(4) = & - (/ "stratiform", "cldwat ", "micro_mg ", "macro_park" /) - - ! cldliq/ice limits that are always on. - character(len=24), parameter :: cldlim_names(2) = & - (/ "convect_deep", "zm_conv_tend" /) - - ! Whether to do validation of state on each call. - logical :: state_debug_checks - - !----------------------------------------------------------------------- - - ! The column radiation model does not update the state - if(single_column.and.scm_crm_mode) return - - - !----------------------------------------------------------------------- - ! If no fields are set, then return - if (.not. (any(ptend%lq(:)) .or. ptend%ls .or. ptend%lu .or. ptend%lv)) then - ptend%name = "none" - ptend%psetcols = 0 - return - end if - - !----------------------------------------------------------------------- - ! Check that the state/tend/ptend are all dimensioned with the same number of columns - if (state%psetcols /= ptend%psetcols) then - call endrun('ERROR in physics_update with ptend%name='//trim(ptend%name) & - //': state and ptend must have the same number of psetcols.') - end if - - if (present(tend)) then - if (state%psetcols /= tend%psetcols) then - call endrun('ERROR in physics_update with ptend%name='//trim(ptend%name) & - //': state and tend must have the same number of psetcols.') - end if - end if - - !----------------------------------------------------------------------- - ! cpairv_loc and rairv_loc need to be allocated to a size which matches state and ptend - ! If psetcols == pcols, the cpairv is the correct size and just copy - ! If psetcols > pcols and all cpairv match cpair, then assign the constant cpair - if (state%psetcols == pcols) then - allocate (cpairv_loc(state%psetcols,pver,begchunk:endchunk)) - cpairv_loc(:,:,:) = cpairv(:,:,:) - else if (state%psetcols > pcols .and. all(cpairv(:,:,:) == cpair)) then - allocate(cpairv_loc(state%psetcols,pver,begchunk:endchunk)) - cpairv_loc(:,:,:) = cpair - else - call endrun('physics_update: cpairv is not allowed to vary when subcolumns are turned on') - end if - if (state%psetcols == pcols) then - allocate (rairv_loc(state%psetcols,pver,begchunk:endchunk)) - rairv_loc(:,:,:) = rairv(:,:,:) - else if (state%psetcols > pcols .and. all(rairv(:,:,:) == rair)) then - allocate(rairv_loc(state%psetcols,pver,begchunk:endchunk)) - rairv_loc(:,:,:) = rair - else - call endrun('physics_update: rairv_loc is not allowed to vary when subcolumns are turned on') - end if - - !----------------------------------------------------------------------- - call phys_getopts(state_debug_checks_out=state_debug_checks) - - ncol = state%ncol - - ! Update u,v fields - if(ptend%lu) then - do k = ptend%top_level, ptend%bot_level - state%u (:ncol,k) = state%u (:ncol,k) + ptend%u(:ncol,k) * dt - if (present(tend)) & - tend%dudt(:ncol,k) = tend%dudt(:ncol,k) + ptend%u(:ncol,k) - end do - end if - - if(ptend%lv) then - do k = ptend%top_level, ptend%bot_level - state%v (:ncol,k) = state%v (:ncol,k) + ptend%v(:ncol,k) * dt - if (present(tend)) & - tend%dvdt(:ncol,k) = tend%dvdt(:ncol,k) + ptend%v(:ncol,k) - end do - end if - - ! Update constituents, all schemes use time split q: no tendency kept - call cnst_get_ind('CLDICE', ixcldice, abort=.false.) - call cnst_get_ind('CLDLIQ', ixcldliq, abort=.false.) - ! Check for number concentration of cloud liquid and cloud ice (if not present - ! the indices will be set to -1) - call cnst_get_ind('NUMICE', ixnumice, abort=.false.) - call cnst_get_ind('NUMLIQ', ixnumliq, abort=.false.) - call cnst_get_ind('NUMRAI', ixnumrain, abort=.false.) - call cnst_get_ind('NUMSNO', ixnumsnow, abort=.false.) - - do m = 1, pcnst - if(ptend%lq(m)) then - do k = ptend%top_level, ptend%bot_level - state%q(:ncol,k,m) = state%q(:ncol,k,m) + ptend%q(:ncol,k,m) * dt - end do - - ! now test for mixing ratios which are too small - ! don't call qneg3 for number concentration variables - if (m /= ixnumice .and. m /= ixnumliq .and. & - m /= ixnumrain .and. m /= ixnumsnow ) then - call qneg3(trim(ptend%name), state%lchnk, ncol, state%psetcols, pver, m, m, qmin(m:m), state%q(:,1:pver,m:m)) - else - do k = ptend%top_level, ptend%bot_level - ! checks for number concentration - state%q(:ncol,k,m) = max(1.e-12_r8,state%q(:ncol,k,m)) - state%q(:ncol,k,m) = min(1.e10_r8,state%q(:ncol,k,m)) - end do - end if - - end if - - end do - - !------------------------------------------------------------------------ - ! This is a temporary fix for the large H, H2 in WACCM-X - ! Well, it was supposed to be temporary, but it has been here - ! for a while now. - !------------------------------------------------------------------------ - if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then - call cnst_get_ind('H', ixh) - do k = ptend%top_level, ptend%bot_level - state%q(:ncol,k,ixh) = min(state%q(:ncol,k,ixh), 0.01_r8) - end do - - call cnst_get_ind('H2', ixh2) - do k = ptend%top_level, ptend%bot_level - state%q(:ncol,k,ixh2) = min(state%q(:ncol,k,ixh2), 6.e-5_r8) - end do - endif - - ! Special tests for cloud liquid and ice: - ! Enforce a minimum non-zero value. - if (ixcldliq > 1) then - if(ptend%lq(ixcldliq)) then -#ifdef PERGRO - if ( any(ptend%name == pergro_cldlim_names) ) & - call state_cnst_min_nz(1.e-12_r8, ixcldliq, ixnumliq) -#endif - if ( any(ptend%name == cldlim_names) ) & - call state_cnst_min_nz(1.e-36_r8, ixcldliq, ixnumliq) - end if - end if - - if (ixcldice > 1) then - if(ptend%lq(ixcldice)) then -#ifdef PERGRO - if ( any(ptend%name == pergro_cldlim_names) ) & - call state_cnst_min_nz(1.e-12_r8, ixcldice, ixnumice) -#endif - if ( any(ptend%name == cldlim_names) ) & - call state_cnst_min_nz(1.e-36_r8, ixcldice, ixnumice) - end if - end if - - !------------------------------------------------------------------------ - ! Get indices for molecular weights and call WACCM-X physconst_update - !------------------------------------------------------------------------ - if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then - call physconst_update(state%q, state%t, state%lchnk, ncol) - endif - - if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then - zvirv(:,:) = shr_const_rwv / rairv_loc(:,:,state%lchnk) - 1._r8 - else - zvirv(:,:) = zvir - endif - - !------------------------------------------------------------------------------------------------------------- - ! Update temperature from dry static energy (moved from above for WACCM-X so updating after cpairv_loc update) - !------------------------------------------------------------------------------------------------------------- - - if(ptend%ls) then - do k = ptend%top_level, ptend%bot_level - state%t(:ncol,k) = state%t(:ncol,k) + ptend%s(:ncol,k)*dt/cpairv_loc(:ncol,k,state%lchnk) - if (present(tend)) & - tend%dtdt(:ncol,k) = tend%dtdt(:ncol,k) + ptend%s(:ncol,k)/cpairv_loc(:ncol,k,state%lchnk) - end do - end if - - ! Derive new geopotential fields if heating or water tendency not 0. - - if (ptend%ls .or. ptend%lq(1)) then - call geopotential_t ( & - state%lnpint, state%lnpmid, state%pint , state%pmid , state%pdel , state%rpdel , & - state%t , state%q(:,:,1), rairv_loc(:,:,state%lchnk), gravit , zvirv , & - state%zi , state%zm , ncol ) - ! update dry static energy for use in next process - do k = ptend%top_level, ptend%bot_level - state%s(:ncol,k) = state%t(:ncol,k )*cpairv_loc(:ncol,k,state%lchnk) & - + gravit*state%zm(:ncol,k) + state%phis(:ncol) - end do - end if - - ! Good idea to do this regularly. - call shr_sys_flush(iulog) - - if (state_debug_checks) call physics_state_check(state, ptend%name) - - deallocate(cpairv_loc, rairv_loc) - - ! Deallocate ptend - call physics_ptend_dealloc(ptend) - - ptend%name = "none" - ptend%lq(:) = .false. - ptend%ls = .false. - ptend%lu = .false. - ptend%lv = .false. - ptend%psetcols = 0 - - contains - - subroutine state_cnst_min_nz(lim, qix, numix) - ! Small utility function for setting minimum nonzero - ! constituent concentrations. - - ! Lower limit and constituent index - real(r8), intent(in) :: lim - integer, intent(in) :: qix - ! Number concentration that goes with qix. - ! Ignored if <= 0 (and therefore constituent is not present). - integer, intent(in) :: numix - - if (numix > 0) then - ! Where q is too small, zero mass and number - ! concentration. - where (state%q(:ncol,:,qix) < lim) - state%q(:ncol,:,qix) = 0._r8 - state%q(:ncol,:,numix) = 0._r8 - end where - else - ! If no number index, just do mass. - where (state%q(:ncol,:,qix) < lim) - state%q(:ncol,:,qix) = 0._r8 - end where - end if - - end subroutine state_cnst_min_nz - - - end subroutine physics_update - -!=============================================================================== - - subroutine physics_state_check(state, name) -!----------------------------------------------------------------------- -! Check a physics_state object for invalid data (e.g NaNs, negative -! temperatures). -!----------------------------------------------------------------------- - use shr_infnan_mod, only: shr_infnan_inf_type, assignment(=), & - shr_infnan_posinf, shr_infnan_neginf - use shr_assert_mod, only: shr_assert, shr_assert_in_domain - use physconst, only: pi - use constituents, only: pcnst, qmin - -!------------------------------Arguments-------------------------------- - ! State to check. - type(physics_state), intent(in) :: state - ! Name of the package responsible for this state. - character(len=*), intent(in), optional :: name - -!---------------------------Local storage------------------------------- - ! Shortened name for ncol. - integer :: ncol - ! Double precision positive/negative infinity. - real(r8) :: posinf_r8, neginf_r8 - ! Canned message. - character(len=64) :: msg - ! Constituent index - integer :: m - -!----------------------------------------------------------------------- - - ncol = state%ncol - - posinf_r8 = shr_infnan_posinf - neginf_r8 = shr_infnan_neginf - - ! It may be reasonable to check some of the integer components of the - ! state as well, but this is not yet implemented. - - ! Check for NaN first to avoid any IEEE exceptions. - - if (present(name)) then - msg = "NaN produced in physics_state by package "// & - trim(name)//"." - else - msg = "NaN found in physics_state." - end if - - ! 1-D variables - call shr_assert_in_domain(state%ps(:ncol), is_nan=.false., & - varname="state%ps", msg=msg) - call shr_assert_in_domain(state%psdry(:ncol), is_nan=.false., & - varname="state%psdry", msg=msg) - call shr_assert_in_domain(state%phis(:ncol), is_nan=.false., & - varname="state%phis", msg=msg) - call shr_assert_in_domain(state%te_ini(:ncol), is_nan=.false., & - varname="state%te_ini", msg=msg) - call shr_assert_in_domain(state%te_cur(:ncol), is_nan=.false., & - varname="state%te_cur", msg=msg) - call shr_assert_in_domain(state%tw_ini(:ncol), is_nan=.false., & - varname="state%tw_ini", msg=msg) - call shr_assert_in_domain(state%tw_cur(:ncol), is_nan=.false., & - varname="state%tw_cur", msg=msg) - - ! 2-D variables (at midpoints) - call shr_assert_in_domain(state%t(:ncol,:), is_nan=.false., & - varname="state%t", msg=msg) - call shr_assert_in_domain(state%u(:ncol,:), is_nan=.false., & - varname="state%u", msg=msg) - call shr_assert_in_domain(state%v(:ncol,:), is_nan=.false., & - varname="state%v", msg=msg) - call shr_assert_in_domain(state%s(:ncol,:), is_nan=.false., & - varname="state%s", msg=msg) - call shr_assert_in_domain(state%omega(:ncol,:), is_nan=.false., & - varname="state%omega", msg=msg) - call shr_assert_in_domain(state%pmid(:ncol,:), is_nan=.false., & - varname="state%pmid", msg=msg) - call shr_assert_in_domain(state%pmiddry(:ncol,:), is_nan=.false., & - varname="state%pmiddry", msg=msg) - call shr_assert_in_domain(state%pdel(:ncol,:), is_nan=.false., & - varname="state%pdel", msg=msg) - call shr_assert_in_domain(state%pdeldry(:ncol,:), is_nan=.false., & - varname="state%pdeldry", msg=msg) - call shr_assert_in_domain(state%rpdel(:ncol,:), is_nan=.false., & - varname="state%rpdel", msg=msg) - call shr_assert_in_domain(state%rpdeldry(:ncol,:), is_nan=.false., & - varname="state%rpdeldry", msg=msg) - call shr_assert_in_domain(state%lnpmid(:ncol,:), is_nan=.false., & - varname="state%lnpmid", msg=msg) - call shr_assert_in_domain(state%lnpmiddry(:ncol,:), is_nan=.false., & - varname="state%lnpmiddry", msg=msg) - call shr_assert_in_domain(state%exner(:ncol,:), is_nan=.false., & - varname="state%exner", msg=msg) - call shr_assert_in_domain(state%zm(:ncol,:), is_nan=.false., & - varname="state%zm", msg=msg) - - ! 2-D variables (at interfaces) - call shr_assert_in_domain(state%pint(:ncol,:), is_nan=.false., & - varname="state%pint", msg=msg) - call shr_assert_in_domain(state%pintdry(:ncol,:), is_nan=.false., & - varname="state%pintdry", msg=msg) - call shr_assert_in_domain(state%lnpint(:ncol,:), is_nan=.false., & - varname="state%lnpint", msg=msg) - call shr_assert_in_domain(state%lnpintdry(:ncol,:), is_nan=.false., & - varname="state%lnpintdry", msg=msg) - call shr_assert_in_domain(state%zi(:ncol,:), is_nan=.false., & - varname="state%zi", msg=msg) - - ! 3-D variables - call shr_assert_in_domain(state%q(:ncol,:,:), is_nan=.false., & - varname="state%q", msg=msg) - - ! Now run other checks (i.e. values are finite and within a range that - ! is physically meaningful). - - if (present(name)) then - msg = "Invalid value produced in physics_state by package "// & - trim(name)//"." - else - msg = "Invalid value found in physics_state." - end if - - ! 1-D variables - call shr_assert_in_domain(state%ps(:ncol), lt=posinf_r8, gt=0._r8, & - varname="state%ps", msg=msg) - call shr_assert_in_domain(state%psdry(:ncol), lt=posinf_r8, gt=0._r8, & - varname="state%psdry", msg=msg) - call shr_assert_in_domain(state%phis(:ncol), lt=posinf_r8, gt=neginf_r8, & - varname="state%phis", msg=msg) - call shr_assert_in_domain(state%te_ini(:ncol), lt=posinf_r8, gt=neginf_r8, & - varname="state%te_ini", msg=msg) - call shr_assert_in_domain(state%te_cur(:ncol), lt=posinf_r8, gt=neginf_r8, & - varname="state%te_cur", msg=msg) - call shr_assert_in_domain(state%tw_ini(:ncol), lt=posinf_r8, gt=neginf_r8, & - varname="state%tw_ini", msg=msg) - call shr_assert_in_domain(state%tw_cur(:ncol), lt=posinf_r8, gt=neginf_r8, & - varname="state%tw_cur", msg=msg) - - ! 2-D variables (at midpoints) - call shr_assert_in_domain(state%t(:ncol,:), lt=posinf_r8, gt=0._r8, & - varname="state%t", msg=msg) - call shr_assert_in_domain(state%u(:ncol,:), lt=posinf_r8, gt=neginf_r8, & - varname="state%u", msg=msg) - call shr_assert_in_domain(state%v(:ncol,:), lt=posinf_r8, gt=neginf_r8, & - varname="state%v", msg=msg) - call shr_assert_in_domain(state%s(:ncol,:), lt=posinf_r8, gt=neginf_r8, & - varname="state%s", msg=msg) - call shr_assert_in_domain(state%omega(:ncol,:), lt=posinf_r8, gt=neginf_r8, & - varname="state%omega", msg=msg) - call shr_assert_in_domain(state%pmid(:ncol,:), lt=posinf_r8, gt=0._r8, & - varname="state%pmid", msg=msg) - call shr_assert_in_domain(state%pmiddry(:ncol,:), lt=posinf_r8, gt=0._r8, & - varname="state%pmiddry", msg=msg) - call shr_assert_in_domain(state%pdel(:ncol,:), lt=posinf_r8, gt=neginf_r8, & - varname="state%pdel", msg=msg) - call shr_assert_in_domain(state%pdeldry(:ncol,:), lt=posinf_r8, gt=neginf_r8, & - varname="state%pdeldry", msg=msg) - call shr_assert_in_domain(state%rpdel(:ncol,:), lt=posinf_r8, gt=neginf_r8, & - varname="state%rpdel", msg=msg) - call shr_assert_in_domain(state%rpdeldry(:ncol,:), lt=posinf_r8, gt=neginf_r8, & - varname="state%rpdeldry", msg=msg) - call shr_assert_in_domain(state%lnpmid(:ncol,:), lt=posinf_r8, gt=neginf_r8, & - varname="state%lnpmid", msg=msg) - call shr_assert_in_domain(state%lnpmiddry(:ncol,:), lt=posinf_r8, gt=neginf_r8, & - varname="state%lnpmiddry", msg=msg) - call shr_assert_in_domain(state%exner(:ncol,:), lt=posinf_r8, gt=0._r8, & - varname="state%exner", msg=msg) - call shr_assert_in_domain(state%zm(:ncol,:), lt=posinf_r8, gt=neginf_r8, & - varname="state%zm", msg=msg) - - ! 2-D variables (at interfaces) - call shr_assert_in_domain(state%pint(:ncol,:), lt=posinf_r8, gt=0._r8, & - varname="state%pint", msg=msg) - call shr_assert_in_domain(state%pintdry(:ncol,:), lt=posinf_r8, gt=0._r8, & - varname="state%pintdry", msg=msg) - call shr_assert_in_domain(state%lnpint(:ncol,:), lt=posinf_r8, gt=neginf_r8, & - varname="state%lnpint", msg=msg) - call shr_assert_in_domain(state%lnpintdry(:ncol,:), lt=posinf_r8, gt=neginf_r8, & - varname="state%lnpintdry", msg=msg) - call shr_assert_in_domain(state%zi(:ncol,:), lt=posinf_r8, gt=neginf_r8, & - varname="state%zi", msg=msg) - - ! 3-D variables - do m = 1,pcnst - call shr_assert_in_domain(state%q(:ncol,:,m), lt=posinf_r8, ge=qmin(m), & - varname="state%q ("//trim(cnst_name(m))//")", msg=msg) - end do - - end subroutine physics_state_check - -!=============================================================================== - - subroutine physics_ptend_sum(ptend, ptend_sum, ncol) -!----------------------------------------------------------------------- -! Add ptend fields to ptend_sum for ptend logical flags = .true. -! Where ptend logical flags = .false, don't change ptend_sum -!----------------------------------------------------------------------- - -!------------------------------Arguments-------------------------------- - type(physics_ptend), intent(in) :: ptend ! New parameterization tendencies - type(physics_ptend), intent(inout) :: ptend_sum ! Sum of incoming ptend_sum and ptend - integer, intent(in) :: ncol ! number of columns - -!---------------------------Local storage------------------------------- - integer :: i,k,m ! column,level,constituent indices - integer :: psetcols ! maximum number of columns - integer :: ierr = 0 - -!----------------------------------------------------------------------- - if (ptend%psetcols /= ptend_sum%psetcols) then - call endrun('physics_ptend_sum error: ptend and ptend_sum must have the same value for psetcols') - end if - - if (ncol > ptend_sum%psetcols) then - call endrun('physics_ptend_sum error: ncol must be less than or equal to psetcols') - end if - - psetcols = ptend_sum%psetcols - - ptend_sum%top_level = ptend%top_level - ptend_sum%bot_level = ptend%bot_level - -! Update u,v fields - if(ptend%lu) then - if (.not. allocated(ptend_sum%u)) then - allocate(ptend_sum%u(psetcols,pver), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_ptend_sum error: allocation error for ptend_sum%u') - ptend_sum%u=0.0_r8 - - allocate(ptend_sum%taux_srf(psetcols), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_ptend_sum error: allocation error for ptend_sum%taux_srf') - ptend_sum%taux_srf=0.0_r8 - - allocate(ptend_sum%taux_top(psetcols), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_ptend_sum error: allocation error for ptend_sum%taux_top') - ptend_sum%taux_top=0.0_r8 - end if - ptend_sum%lu = .true. - - do k = ptend%top_level, ptend%bot_level - do i = 1, ncol - ptend_sum%u(i,k) = ptend_sum%u(i,k) + ptend%u(i,k) - end do - end do - do i = 1, ncol - ptend_sum%taux_srf(i) = ptend_sum%taux_srf(i) + ptend%taux_srf(i) - ptend_sum%taux_top(i) = ptend_sum%taux_top(i) + ptend%taux_top(i) - end do - end if - - if(ptend%lv) then - if (.not. allocated(ptend_sum%v)) then - allocate(ptend_sum%v(psetcols,pver), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_ptend_sum error: allocation error for ptend_sum%v') - ptend_sum%v=0.0_r8 - - allocate(ptend_sum%tauy_srf(psetcols), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_ptend_sum error: allocation error for ptend_sum%tauy_srf') - ptend_sum%tauy_srf=0.0_r8 - - allocate(ptend_sum%tauy_top(psetcols), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_ptend_sum error: allocation error for ptend_sum%tauy_top') - ptend_sum%tauy_top=0.0_r8 - end if - ptend_sum%lv = .true. - - do k = ptend%top_level, ptend%bot_level - do i = 1, ncol - ptend_sum%v(i,k) = ptend_sum%v(i,k) + ptend%v(i,k) - end do - end do - do i = 1, ncol - ptend_sum%tauy_srf(i) = ptend_sum%tauy_srf(i) + ptend%tauy_srf(i) - ptend_sum%tauy_top(i) = ptend_sum%tauy_top(i) + ptend%tauy_top(i) - end do - end if - - - if(ptend%ls) then - if (.not. allocated(ptend_sum%s)) then - allocate(ptend_sum%s(psetcols,pver), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_ptend_sum error: allocation error for ptend_sum%s') - ptend_sum%s=0.0_r8 - - allocate(ptend_sum%hflux_srf(psetcols), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_ptend_sum error: allocation error for ptend_sum%hflux_srf') - ptend_sum%hflux_srf=0.0_r8 - - allocate(ptend_sum%hflux_top(psetcols), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_ptend_sum error: allocation error for ptend_sum%hflux_top') - ptend_sum%hflux_top=0.0_r8 - end if - ptend_sum%ls = .true. - - do k = ptend%top_level, ptend%bot_level - do i = 1, ncol - ptend_sum%s(i,k) = ptend_sum%s(i,k) + ptend%s(i,k) - end do - end do - do i = 1, ncol - ptend_sum%hflux_srf(i) = ptend_sum%hflux_srf(i) + ptend%hflux_srf(i) - ptend_sum%hflux_top(i) = ptend_sum%hflux_top(i) + ptend%hflux_top(i) - end do - end if - - if (any(ptend%lq(:))) then - - if (.not. allocated(ptend_sum%q)) then - allocate(ptend_sum%q(psetcols,pver,pcnst), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_ptend_sum error: allocation error for ptend_sum%q') - ptend_sum%q=0.0_r8 - - allocate(ptend_sum%cflx_srf(psetcols,pcnst), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_ptend_sum error: allocation error for ptend_sum%cflx_srf') - ptend_sum%cflx_srf=0.0_r8 - - allocate(ptend_sum%cflx_top(psetcols,pcnst), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_ptend_sum error: allocation error for ptend_sum%cflx_top') - ptend_sum%cflx_top=0.0_r8 - end if - - do m = 1, pcnst - if(ptend%lq(m)) then - ptend_sum%lq(m) = .true. - do k = ptend%top_level, ptend%bot_level - do i = 1,ncol - ptend_sum%q(i,k,m) = ptend_sum%q(i,k,m) + ptend%q(i,k,m) - end do - end do - do i = 1,ncol - ptend_sum%cflx_srf(i,m) = ptend_sum%cflx_srf(i,m) + ptend%cflx_srf(i,m) - ptend_sum%cflx_top(i,m) = ptend_sum%cflx_top(i,m) + ptend%cflx_top(i,m) - end do - end if - end do - - end if - - end subroutine physics_ptend_sum - -!=============================================================================== - - subroutine physics_ptend_scale(ptend, fac, ncol) -!----------------------------------------------------------------------- -! Scale ptend fields for ptend logical flags = .true. -! Where ptend logical flags = .false, don't change ptend. -! -! Assumes that input ptend is valid (e.g. that -! ptend%lu .eqv. allocated(ptend%u)), and therefore -! does not check allocation status of individual arrays. -!----------------------------------------------------------------------- - -!------------------------------Arguments-------------------------------- - type(physics_ptend), intent(inout) :: ptend ! Incoming ptend - real(r8), intent(in) :: fac ! Factor to multiply ptend by. - integer, intent(in) :: ncol ! number of columns - -!---------------------------Local storage------------------------------- - integer :: m ! constituent index - -!----------------------------------------------------------------------- - -! Update u,v fields - if (ptend%lu) & - call multiply_tendency(ptend%u, & - ptend%taux_srf, ptend%taux_top) - - if (ptend%lv) & - call multiply_tendency(ptend%v, & - ptend%tauy_srf, ptend%tauy_top) - -! Heat - if (ptend%ls) & - call multiply_tendency(ptend%s, & - ptend%hflux_srf, ptend%hflux_top) - -! Update constituents - do m = 1, pcnst - if (ptend%lq(m)) & - call multiply_tendency(ptend%q(:,:,m), & - ptend%cflx_srf(:,m), ptend%cflx_top(:,m)) - end do - - - contains - - subroutine multiply_tendency(tend_arr, flx_srf, flx_top) - real(r8), intent(inout) :: tend_arr(:,:) ! Tendency array (pcols, plev) - real(r8), intent(inout) :: flx_srf(:) ! Surface flux (or stress) - real(r8), intent(inout) :: flx_top(:) ! Top-of-model flux (or stress) - - integer :: k - - do k = ptend%top_level, ptend%bot_level - tend_arr(:ncol,k) = tend_arr(:ncol,k) * fac - end do - flx_srf(:ncol) = flx_srf(:ncol) * fac - flx_top(:ncol) = flx_top(:ncol) * fac - - end subroutine multiply_tendency - - end subroutine physics_ptend_scale - -!=============================================================================== - -subroutine physics_ptend_copy(ptend, ptend_cp) - - !----------------------------------------------------------------------- - ! Copy a physics_ptend object. Allocate ptend_cp internally before copy. - !----------------------------------------------------------------------- - - type(physics_ptend), intent(in) :: ptend ! ptend source - type(physics_ptend), intent(out) :: ptend_cp ! copy of ptend - - !----------------------------------------------------------------------- - - ptend_cp%name = ptend%name - - ptend_cp%ls = ptend%ls - ptend_cp%lu = ptend%lu - ptend_cp%lv = ptend%lv - ptend_cp%lq = ptend%lq - - call physics_ptend_alloc(ptend_cp, ptend%psetcols) - - ptend_cp%top_level = ptend%top_level - ptend_cp%bot_level = ptend%bot_level - - if (ptend_cp%ls) then - ptend_cp%s = ptend%s - ptend_cp%hflux_srf = ptend%hflux_srf - ptend_cp%hflux_top = ptend%hflux_top - end if - - if (ptend_cp%lu) then - ptend_cp%u = ptend%u - ptend_cp%taux_srf = ptend%taux_srf - ptend_cp%taux_top = ptend%taux_top - end if - - if (ptend_cp%lv) then - ptend_cp%v = ptend%v - ptend_cp%tauy_srf = ptend%tauy_srf - ptend_cp%tauy_top = ptend%tauy_top - end if - - if (any(ptend_cp%lq(:))) then - ptend_cp%q = ptend%q - ptend_cp%cflx_srf = ptend%cflx_srf - ptend_cp%cflx_top = ptend%cflx_top - end if - -end subroutine physics_ptend_copy - -!=============================================================================== - - subroutine physics_ptend_reset(ptend) -!----------------------------------------------------------------------- -! Reset the parameterization tendency structure to "empty" -!----------------------------------------------------------------------- - -!------------------------------Arguments-------------------------------- - type(physics_ptend), intent(inout) :: ptend ! Parameterization tendencies -!----------------------------------------------------------------------- - integer :: m ! Index for constiuent -!----------------------------------------------------------------------- - - if(ptend%ls) then - ptend%s = 0._r8 - ptend%hflux_srf = 0._r8 - ptend%hflux_top = 0._r8 - endif - if(ptend%lu) then - ptend%u = 0._r8 - ptend%taux_srf = 0._r8 - ptend%taux_top = 0._r8 - endif - if(ptend%lv) then - ptend%v = 0._r8 - ptend%tauy_srf = 0._r8 - ptend%tauy_top = 0._r8 - endif - if(any (ptend%lq(:))) then - ptend%q = 0._r8 - ptend%cflx_srf = 0._r8 - ptend%cflx_top = 0._r8 - end if - - ptend%top_level = 1 - ptend%bot_level = pver - - return - end subroutine physics_ptend_reset - -!=============================================================================== - subroutine physics_ptend_init(ptend, psetcols, name, ls, lu, lv, lq) -!----------------------------------------------------------------------- -! Allocate the fields in the structure which are specified. -! Initialize the parameterization tendency structure to "empty" -!----------------------------------------------------------------------- - -!------------------------------Arguments-------------------------------- - type(physics_ptend), intent(out) :: ptend ! Parameterization tendencies - integer, intent(in) :: psetcols ! maximum number of columns - character(len=*) :: name ! optional name of parameterization which produced tendencies. - logical, optional :: ls ! if true, then fields to support dsdt are allocated - logical, optional :: lu ! if true, then fields to support dudt are allocated - logical, optional :: lv ! if true, then fields to support dvdt are allocated - logical, dimension(pcnst),optional :: lq ! if true, then fields to support dqdt are allocated - -!----------------------------------------------------------------------- - - if (allocated(ptend%s)) then - call endrun(' physics_ptend_init: ptend should not be allocated before calling this routine') - end if - - ptend%name = name - ptend%psetcols = psetcols - - ! If no fields being stored, initialize all values to appropriate nulls and return - if (.not. present(ls) .and. .not. present(lu) .and. .not. present(lv) .and. .not. present(lq) ) then - ptend%ls = .false. - ptend%lu = .false. - ptend%lv = .false. - ptend%lq(:) = .false. - ptend%top_level = 1 - ptend%bot_level = pver - return - end if - - if (present(ls)) then - ptend%ls = ls - else - ptend%ls = .false. - end if - - if (present(lu)) then - ptend%lu = lu - else - ptend%lu = .false. - end if - - if (present(lv)) then - ptend%lv = lv - else - ptend%lv = .false. - end if - - if (present(lq)) then - ptend%lq(:) = lq(:) - else - ptend%lq(:) = .false. - end if - - call physics_ptend_alloc(ptend, psetcols) - - call physics_ptend_reset(ptend) - - return - end subroutine physics_ptend_init - -!=============================================================================== - - subroutine physics_state_set_grid(lchnk, phys_state) -!----------------------------------------------------------------------- -! Set the grid components of the physics_state object -!----------------------------------------------------------------------- - - integer, intent(in) :: lchnk - type(physics_state), intent(inout) :: phys_state - - ! local variables - integer :: i, ncol - real(r8) :: rlon(pcols) - real(r8) :: rlat(pcols) - - !----------------------------------------------------------------------- - ! get_ncols_p requires a state which does not have sub-columns - if (phys_state%psetcols .ne. pcols) then - call endrun('physics_state_set_grid: cannot pass in a state which has sub-columns') - end if - - ncol = get_ncols_p(lchnk) - - if(ncol<=0) then - write(iulog,*) lchnk, ncol - call endrun('physics_state_set_grid') - end if - - call get_rlon_all_p(lchnk, ncol, rlon) - call get_rlat_all_p(lchnk, ncol, rlat) - phys_state%ncol = ncol - phys_state%lchnk = lchnk - do i=1,ncol - phys_state%lat(i) = rlat(i) - phys_state%lon(i) = rlon(i) - end do - call init_geo_unique(phys_state,ncol) - - end subroutine physics_state_set_grid - - - subroutine init_geo_unique(phys_state,ncol) - integer, intent(in) :: ncol - type(physics_state), intent(inout) :: phys_state - logical :: match - integer :: i, j, ulatcnt, uloncnt - - phys_state%ulat=-999._r8 - phys_state%ulon=-999._r8 - phys_state%latmapback=0 - phys_state%lonmapback=0 - match=.false. - ulatcnt=0 - uloncnt=0 - match=.false. - do i=1,ncol - do j=1,ulatcnt - if(phys_state%lat(i) .eq. phys_state%ulat(j)) then - match=.true. - phys_state%latmapback(i)=j - end if - end do - if(.not. match) then - ulatcnt=ulatcnt+1 - phys_state%ulat(ulatcnt)=phys_state%lat(i) - phys_state%latmapback(i)=ulatcnt - end if - - match=.false. - do j=1,uloncnt - if(phys_state%lon(i) .eq. phys_state%ulon(j)) then - match=.true. - phys_state%lonmapback(i)=j - end if - end do - if(.not. match) then - uloncnt=uloncnt+1 - phys_state%ulon(uloncnt)=phys_state%lon(i) - phys_state%lonmapback(i)=uloncnt - end if - match=.false. - - end do - phys_state%uloncnt=uloncnt - phys_state%ulatcnt=ulatcnt - - call get_gcol_all_p(phys_state%lchnk,pcols,phys_state%cid) - - - end subroutine init_geo_unique - -!=============================================================================== - subroutine physics_dme_adjust(state, tend, qini, dt) - !----------------------------------------------------------------------- - ! - ! Purpose: Adjust the dry mass in each layer back to the value of physics input state - ! - ! Method: Conserve the integrated mass, momentum and total energy in each layer - ! by scaling the specific mass of consituents, specific momentum (velocity) - ! and specific total energy by the relative change in layer mass. Solve for - ! the new temperature by subtracting the new kinetic energy from total energy - ! and inverting the hydrostatic equation - ! - ! The mass in each layer is modified, changing the relationship of the layer - ! interfaces and midpoints to the surface pressure. The result is no longer in - ! the original hybrid coordinate. - ! - ! This procedure cannot be applied to the "eul" or "sld" dycores because they - ! require the hybrid coordinate. - ! - ! Author: Byron Boville - - ! !REVISION HISTORY: - ! 03.03.28 Boville Created, partly from code by Lin in p_d_adjust - ! - !----------------------------------------------------------------------- - - use constituents, only : cnst_get_type_byind - use ppgrid, only : begchunk, endchunk - - implicit none - ! - ! Arguments - ! - type(physics_state), intent(inout) :: state - type(physics_tend ), intent(inout) :: tend - real(r8), intent(in ) :: qini(pcols,pver) ! initial specific humidity - real(r8), intent(in ) :: dt ! model physics timestep - ! - !---------------------------Local workspace----------------------------- - ! - integer :: lchnk ! chunk identifier - integer :: ncol ! number of atmospheric columns - integer :: i,k,m ! Longitude, level indices - real(r8) :: fdq(pcols) ! mass adjustment factor - real(r8) :: te(pcols) ! total energy in a layer - real(r8) :: utmp(pcols) ! temp variable for recalculating the initial u values - real(r8) :: vtmp(pcols) ! temp variable for recalculating the initial v values - - real(r8) :: zvirv(pcols,pver) ! Local zvir array pointer - - real(r8),allocatable :: cpairv_loc(:,:,:) - ! - !----------------------------------------------------------------------- - - if (state%psetcols .ne. pcols) then - call endrun('physics_dme_adjust: cannot pass in a state which has sub-columns') - end if - if (adjust_te) then - call endrun('physics_dme_adjust: must update code based on the "correct" energy before turning on "adjust_te"') - end if - - lchnk = state%lchnk - ncol = state%ncol - - ! adjust dry mass in each layer back to input value, while conserving - ! constituents, momentum, and total energy - state%ps(:ncol) = state%pint(:ncol,1) - do k = 1, pver - - ! adjusment factor is just change in water vapor - fdq(:ncol) = 1._r8 + state%q(:ncol,k,1) - qini(:ncol,k) - - ! adjust constituents to conserve mass in each layer - do m = 1, pcnst - state%q(:ncol,k,m) = state%q(:ncol,k,m) / fdq(:ncol) - end do - - if (adjust_te) then - ! compute specific total energy of unadjusted state (J/kg) - te(:ncol) = state%s(:ncol,k) + 0.5_r8*(state%u(:ncol,k)**2 + state%v(:ncol,k)**2) - - ! recompute initial u,v from the new values and the tendencies - utmp(:ncol) = state%u(:ncol,k) - dt * tend%dudt(:ncol,k) - vtmp(:ncol) = state%v(:ncol,k) - dt * tend%dvdt(:ncol,k) - ! adjust specific total energy and specific momentum (velocity) to conserve each - te (:ncol) = te (:ncol) / fdq(:ncol) - state%u(:ncol,k) = state%u(:ncol,k ) / fdq(:ncol) - state%v(:ncol,k) = state%v(:ncol,k ) / fdq(:ncol) - ! compute adjusted u,v tendencies - tend%dudt(:ncol,k) = (state%u(:ncol,k) - utmp(:ncol)) / dt - tend%dvdt(:ncol,k) = (state%v(:ncol,k) - vtmp(:ncol)) / dt - - ! compute adjusted static energy - state%s(:ncol,k) = te(:ncol) - 0.5_r8*(state%u(:ncol,k)**2 + state%v(:ncol,k)**2) - end if - -! compute new total pressure variables - state%pdel (:ncol,k ) = state%pdel(:ncol,k ) * fdq(:ncol) - state%ps(:ncol) = state%ps(:ncol) + state%pdel(:ncol,k) - state%pint (:ncol,k+1) = state%pint(:ncol,k ) + state%pdel(:ncol,k) - state%lnpint(:ncol,k+1) = log(state%pint(:ncol,k+1)) - state%rpdel (:ncol,k ) = 1._r8/ state%pdel(:ncol,k ) - end do - - if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then - zvirv(:,:) = shr_const_rwv / rairv(:,:,state%lchnk) - 1._r8 - else - zvirv(:,:) = zvir - endif - -! compute new T,z from new s,q,dp - if (adjust_te) then - -! cpairv_loc needs to be allocated to a size which matches state and ptend -! If psetcols == pcols, cpairv is the correct size and just copy into cpairv_loc -! If psetcols > pcols and all cpairv match cpair, then assign the constant cpair - - if (state%psetcols == pcols) then - allocate (cpairv_loc(state%psetcols,pver,begchunk:endchunk)) - cpairv_loc(:,:,:) = cpairv(:,:,:) - else if (state%psetcols > pcols .and. all(cpairv(:,:,:) == cpair)) then - allocate(cpairv_loc(state%psetcols,pver,begchunk:endchunk)) - cpairv_loc(:,:,:) = cpair - else - call endrun('physics_dme_adjust: cpairv is not allowed to vary when subcolumns are turned on') - end if - - call geopotential_dse(state%lnpint, state%lnpmid, state%pint, & - state%pmid , state%pdel , state%rpdel, & - state%s , state%q(:,:,1), state%phis , rairv(:,:,state%lchnk), & - gravit, cpairv_loc(:,:,state%lchnk), zvirv, & - state%t , state%zi , state%zm , ncol) - - deallocate(cpairv_loc) - - end if - - end subroutine physics_dme_adjust -!----------------------------------------------------------------------- - -!=============================================================================== - subroutine physics_state_copy(state_in, state_out) - - use ppgrid, only: pver, pverp - use constituents, only: pcnst - - implicit none - - ! - ! Arguments - ! - type(physics_state), intent(in) :: state_in - type(physics_state), intent(out) :: state_out - - ! - ! Local variables - ! - integer i, k, m, ncol - - ! Allocate state_out with same subcol dimension as state_in - call physics_state_alloc ( state_out, state_in%lchnk, state_in%psetcols) - - ncol = state_in%ncol - - state_out%psetcols = state_in%psetcols - state_out%ngrdcol = state_in%ngrdcol - state_out%lchnk = state_in%lchnk - state_out%ncol = state_in%ncol - state_out%count = state_in%count - - do i = 1, ncol - state_out%lat(i) = state_in%lat(i) - state_out%lon(i) = state_in%lon(i) - state_out%ps(i) = state_in%ps(i) - state_out%phis(i) = state_in%phis(i) - state_out%te_ini(i) = state_in%te_ini(i) - state_out%te_cur(i) = state_in%te_cur(i) - state_out%tw_ini(i) = state_in%tw_ini(i) - state_out%tw_cur(i) = state_in%tw_cur(i) - end do - - do k = 1, pver - do i = 1, ncol - state_out%t(i,k) = state_in%t(i,k) - state_out%u(i,k) = state_in%u(i,k) - state_out%v(i,k) = state_in%v(i,k) - state_out%s(i,k) = state_in%s(i,k) - state_out%omega(i,k) = state_in%omega(i,k) - state_out%pmid(i,k) = state_in%pmid(i,k) - state_out%pdel(i,k) = state_in%pdel(i,k) - state_out%rpdel(i,k) = state_in%rpdel(i,k) - state_out%lnpmid(i,k) = state_in%lnpmid(i,k) - state_out%exner(i,k) = state_in%exner(i,k) - state_out%zm(i,k) = state_in%zm(i,k) - end do - end do - - do k = 1, pverp - do i = 1, ncol - state_out%pint(i,k) = state_in%pint(i,k) - state_out%lnpint(i,k) = state_in%lnpint(i,k) - state_out%zi(i,k) = state_in% zi(i,k) - end do - end do - - - do i = 1, ncol - state_out%psdry(i) = state_in%psdry(i) - end do - do k = 1, pver - do i = 1, ncol - state_out%lnpmiddry(i,k) = state_in%lnpmiddry(i,k) - state_out%pmiddry(i,k) = state_in%pmiddry(i,k) - state_out%pdeldry(i,k) = state_in%pdeldry(i,k) - state_out%rpdeldry(i,k) = state_in%rpdeldry(i,k) - end do - end do - do k = 1, pverp - do i = 1, ncol - state_out%pintdry(i,k) = state_in%pintdry(i,k) - state_out%lnpintdry(i,k) = state_in%lnpintdry(i,k) - end do - end do - - do m = 1, pcnst - do k = 1, pver - do i = 1, ncol - state_out%q(i,k,m) = state_in%q(i,k,m) - end do - end do - end do - - end subroutine physics_state_copy -!=============================================================================== - - subroutine physics_tend_init(tend) - - implicit none - - ! - ! Arguments - ! - type(physics_tend), intent(inout) :: tend - - ! - ! Local variables - ! - - if (.not. allocated(tend%dtdt)) then - call endrun('physics_tend_init: tend must be allocated before it can be initialized') - end if - - tend%dtdt = 0._r8 - tend%dudt = 0._r8 - tend%dvdt = 0._r8 - tend%flx_net = 0._r8 - tend%te_tnd = 0._r8 - tend%tw_tnd = 0._r8 - -end subroutine physics_tend_init - -!=============================================================================== - -subroutine set_state_pdry (state,pdeld_calc) - - use ppgrid, only: pver - use pmgrid, only: plev, plevp - implicit none - - type(physics_state), intent(inout) :: state - logical, optional, intent(in) :: pdeld_calc ! .true. do calculate pdeld [default] - ! .false. don't calculate pdeld - integer ncol - integer i, k - logical do_pdeld_calc - - if ( present(pdeld_calc) ) then - do_pdeld_calc = pdeld_calc - else - do_pdeld_calc = .true. - endif - - ncol = state%ncol - - - state%psdry(:ncol) = state%pint(:ncol,1) - state%pintdry(:ncol,1) = state%pint(:ncol,1) - - if (do_pdeld_calc) then - do k = 1, pver - state%pdeldry(:ncol,k) = state%pdel(:ncol,k)*(1._r8-state%q(:ncol,k,1)) - end do - endif - do k = 1, pver - state%pintdry(:ncol,k+1) = state%pintdry(:ncol,k)+state%pdeldry(:ncol,k) - state%pmiddry(:ncol,k) = (state%pintdry(:ncol,k+1)+state%pintdry(:ncol,k))/2._r8 - state%psdry(:ncol) = state%psdry(:ncol) + state%pdeldry(:ncol,k) - end do - - state%rpdeldry(:ncol,:) = 1._r8/state%pdeldry(:ncol,:) - state%lnpmiddry(:ncol,:) = log(state%pmiddry(:ncol,:)) - state%lnpintdry(:ncol,:) = log(state%pintdry(:ncol,:)) - -end subroutine set_state_pdry - -!=============================================================================== - -subroutine set_wet_to_dry (state) - - use constituents, only: pcnst, cnst_type - - type(physics_state), intent(inout) :: state - - integer m, ncol - - ncol = state%ncol - - do m = 1,pcnst - if (cnst_type(m).eq.'dry') then - state%q(:ncol,:,m) = state%q(:ncol,:,m)*state%pdel(:ncol,:)/state%pdeldry(:ncol,:) - endif - end do - -end subroutine set_wet_to_dry - -!=============================================================================== - -subroutine set_dry_to_wet (state) - - use constituents, only: pcnst, cnst_type - - type(physics_state), intent(inout) :: state - - integer m, ncol - - ncol = state%ncol - - do m = 1,pcnst - if (cnst_type(m).eq.'dry') then - state%q(:ncol,:,m) = state%q(:ncol,:,m)*state%pdeldry(:ncol,:)/state%pdel(:ncol,:) - endif - end do - -end subroutine set_dry_to_wet - -!=============================================================================== - -subroutine physics_state_alloc(state,lchnk,psetcols) - - use infnan, only : inf, assignment(=) - -! allocate the individual state components - - type(physics_state), intent(inout) :: state - integer,intent(in) :: lchnk - - integer, intent(in) :: psetcols - - integer :: ierr=0, i - - state%lchnk = lchnk - state%psetcols = psetcols - state%ngrdcol = get_ncols_p(lchnk) ! Number of grid columns - - !---------------------------------- - ! Following variables will be overwritten by sub-column generator, if sub-columns are being used - - ! state%ncol - is initialized in physics_state_set_grid, if not using sub-columns - - !---------------------------------- - - allocate(state%lat(psetcols), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%lat') - - allocate(state%lon(psetcols), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%lon') - - allocate(state%ps(psetcols), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%ps') - - allocate(state%psdry(psetcols), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%psdry') - - allocate(state%phis(psetcols), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%phis') - - allocate(state%ulat(psetcols), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%ulat') - - allocate(state%ulon(psetcols), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%ulon') - - allocate(state%t(psetcols,pver), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%t') - - allocate(state%u(psetcols,pver), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%u') - - allocate(state%v(psetcols,pver), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%v') - - allocate(state%s(psetcols,pver), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%s') - - allocate(state%omega(psetcols,pver), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%omega') - - allocate(state%pmid(psetcols,pver), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%pmid') - - allocate(state%pmiddry(psetcols,pver), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%pmiddry') - - allocate(state%pdel(psetcols,pver), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%pdel') - - allocate(state%pdeldry(psetcols,pver), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%pdeldry') - - allocate(state%rpdel(psetcols,pver), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%rpdel') - - allocate(state%rpdeldry(psetcols,pver), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%rpdeldry') - - allocate(state%lnpmid(psetcols,pver), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%lnpmid') - - allocate(state%lnpmiddry(psetcols,pver), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%lnpmiddry') - - allocate(state%exner(psetcols,pver), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%exner') - - allocate(state%zm(psetcols,pver), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%zm') - - allocate(state%q(psetcols,pver,pcnst), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%q') - - allocate(state%pint(psetcols,pver+1), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%pint') - - allocate(state%pintdry(psetcols,pver+1), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%pintdry') - - allocate(state%lnpint(psetcols,pver+1), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%lnpint') - - allocate(state%lnpintdry(psetcols,pver+1), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%lnpintdry') - - allocate(state%zi(psetcols,pver+1), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%zi') - - allocate(state%te_ini(psetcols), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%te_ini') - - allocate(state%te_cur(psetcols), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%te_cur') - - allocate(state%tw_ini(psetcols), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%tw_ini') - - allocate(state%tw_cur(psetcols), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%tw_cur') - - allocate(state%latmapback(psetcols), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%latmapback') - - allocate(state%lonmapback(psetcols), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%lonmapback') - - allocate(state%cid(psetcols), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%cid') - - state%lat(:) = inf - state%lon(:) = inf - state%ulat(:) = inf - state%ulon(:) = inf - state%ps(:) = inf - state%psdry(:) = inf - state%phis(:) = inf - state%t(:,:) = inf - state%u(:,:) = inf - state%v(:,:) = inf - state%s(:,:) = inf - state%omega(:,:) = inf - state%pmid(:,:) = inf - state%pmiddry(:,:) = inf - state%pdel(:,:) = inf - state%pdeldry(:,:) = inf - state%rpdel(:,:) = inf - state%rpdeldry(:,:) = inf - state%lnpmid(:,:) = inf - state%lnpmiddry(:,:) = inf - state%exner(:,:) = inf - state%zm(:,:) = inf - state%q(:,:,:) = inf - - state%pint(:,:) = inf - state%pintdry(:,:) = inf - state%lnpint(:,:) = inf - state%lnpintdry(:,:) = inf - state%zi(:,:) = inf - - state%te_ini(:) = inf - state%te_cur(:) = inf - state%tw_ini(:) = inf - state%tw_cur(:) = inf - -end subroutine physics_state_alloc - -!=============================================================================== - -subroutine physics_state_dealloc(state) - -! deallocate the individual state components - - type(physics_state), intent(inout) :: state - integer :: ierr = 0 - - deallocate(state%lat, stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%lat') - - deallocate(state%lon, stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%lon') - - deallocate(state%ps, stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%ps') - - deallocate(state%psdry, stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%psdry') - - deallocate(state%phis, stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%phis') - - deallocate(state%ulat, stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%ulat') - - deallocate(state%ulon, stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%ulon') - - deallocate(state%t, stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%t') - - deallocate(state%u, stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%u') - - deallocate(state%v, stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%v') - - deallocate(state%s, stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%s') - - deallocate(state%omega, stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%omega') - - deallocate(state%pmid, stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%pmid') - - deallocate(state%pmiddry, stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%pmiddry') - - deallocate(state%pdel, stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%pdel') - - deallocate(state%pdeldry, stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%pdeldry') - - deallocate(state%rpdel, stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%rpdel') - - deallocate(state%rpdeldry, stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%rpdeldry') - - deallocate(state%lnpmid, stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%lnpmid') - - deallocate(state%lnpmiddry, stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%lnpmiddry') - - deallocate(state%exner, stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%exner') - - deallocate(state%zm, stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%zm') - - deallocate(state%q, stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%q') - - deallocate(state%pint, stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%pint') - - deallocate(state%pintdry, stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%pintdry') - - deallocate(state%lnpint, stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%lnpint') - - deallocate(state%lnpintdry, stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%lnpintdry') - - deallocate(state%zi, stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%zi') - - deallocate(state%te_ini, stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%te_ini') - - deallocate(state%te_cur, stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%te_cur') - - deallocate(state%tw_ini, stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%tw_ini') - - deallocate(state%tw_cur, stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%tw_cur') - - deallocate(state%latmapback, stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%latmapback') - - deallocate(state%lonmapback, stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%lonmapback') - - deallocate(state%cid, stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%cid') - -end subroutine physics_state_dealloc - -!=============================================================================== - -subroutine physics_tend_alloc(tend,psetcols) - - use infnan, only : inf, assignment(=) -! allocate the individual tend components - - type(physics_tend), intent(inout) :: tend - - integer, intent(in) :: psetcols - - integer :: ierr = 0 - - tend%psetcols = psetcols - - allocate(tend%dtdt(psetcols,pver), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_tend_alloc error: allocation error for tend%dtdt') - - allocate(tend%dudt(psetcols,pver), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_tend_alloc error: allocation error for tend%dudt') - - allocate(tend%dvdt(psetcols,pver), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_tend_alloc error: allocation error for tend%dvdt') - - allocate(tend%flx_net(psetcols), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_tend_alloc error: allocation error for tend%flx_net') - - allocate(tend%te_tnd(psetcols), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_tend_alloc error: allocation error for tend%te_tnd') - - allocate(tend%tw_tnd(psetcols), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_tend_alloc error: allocation error for tend%tw_tnd') - - tend%dtdt(:,:) = inf - tend%dudt(:,:) = inf - tend%dvdt(:,:) = inf - tend%flx_net(:) = inf - tend%te_tnd(:) = inf - tend%tw_tnd(:) = inf - -end subroutine physics_tend_alloc - -!=============================================================================== - -subroutine physics_tend_dealloc(tend) - -! deallocate the individual tend components - - type(physics_tend), intent(inout) :: tend - integer :: psetcols - integer :: ierr = 0 - - deallocate(tend%dtdt, stat=ierr) - if ( ierr /= 0 ) call endrun('physics_tend_dealloc error: deallocation error for tend%dtdt') - - deallocate(tend%dudt, stat=ierr) - if ( ierr /= 0 ) call endrun('physics_tend_dealloc error: deallocation error for tend%dudt') - - deallocate(tend%dvdt, stat=ierr) - if ( ierr /= 0 ) call endrun('physics_tend_dealloc error: deallocation error for tend%dvdt') - - deallocate(tend%flx_net, stat=ierr) - if ( ierr /= 0 ) call endrun('physics_tend_dealloc error: deallocation error for tend%flx_net') - - deallocate(tend%te_tnd, stat=ierr) - if ( ierr /= 0 ) call endrun('physics_tend_dealloc error: deallocation error for tend%te_tnd') - - deallocate(tend%tw_tnd, stat=ierr) - if ( ierr /= 0 ) call endrun('physics_tend_dealloc error: deallocation error for tend%tw_tnd') -end subroutine physics_tend_dealloc - -!=============================================================================== - -subroutine physics_ptend_alloc(ptend,psetcols) - -! allocate the individual ptend components - - type(physics_ptend), intent(inout) :: ptend - - integer, intent(in) :: psetcols - - integer :: ierr = 0 - - ptend%psetcols = psetcols - - if (ptend%ls) then - allocate(ptend%s(psetcols,pver), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_ptend_alloc error: allocation error for ptend%s') - - allocate(ptend%hflux_srf(psetcols), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_ptend_alloc error: allocation error for ptend%hflux_srf') - - allocate(ptend%hflux_top(psetcols), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_ptend_alloc error: allocation error for ptend%hflux_top') - end if - - if (ptend%lu) then - allocate(ptend%u(psetcols,pver), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_ptend_alloc error: allocation error for ptend%u') - - allocate(ptend%taux_srf(psetcols), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_ptend_alloc error: allocation error for ptend%taux_srf') - - allocate(ptend%taux_top(psetcols), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_ptend_alloc error: allocation error for ptend%taux_top') - end if - - if (ptend%lv) then - allocate(ptend%v(psetcols,pver), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_ptend_alloc error: allocation error for ptend%v') - - allocate(ptend%tauy_srf(psetcols), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_ptend_alloc error: allocation error for ptend%tauy_srf') - - allocate(ptend%tauy_top(psetcols), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_ptend_alloc error: allocation error for ptend%tauy_top') - end if - - if (any(ptend%lq)) then - allocate(ptend%q(psetcols,pver,pcnst), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_ptend_alloc error: allocation error for ptend%q') - - allocate(ptend%cflx_srf(psetcols,pcnst), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_ptend_alloc error: allocation error for ptend%cflx_srf') - - allocate(ptend%cflx_top(psetcols,pcnst), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_ptend_alloc error: allocation error for ptend%cflx_top') - end if - -end subroutine physics_ptend_alloc - -!=============================================================================== - -subroutine physics_ptend_dealloc(ptend) - -! deallocate the individual ptend components - - type(physics_ptend), intent(inout) :: ptend - integer :: ierr = 0 - - ptend%psetcols = 0 - - if (allocated(ptend%s)) deallocate(ptend%s, stat=ierr) - if ( ierr /= 0 ) call endrun('physics_ptend_dealloc error: deallocation error for ptend%s') - - if (allocated(ptend%hflux_srf)) deallocate(ptend%hflux_srf, stat=ierr) - if ( ierr /= 0 ) call endrun('physics_ptend_dealloc error: deallocation error for ptend%hflux_srf') - - if (allocated(ptend%hflux_top)) deallocate(ptend%hflux_top, stat=ierr) - if ( ierr /= 0 ) call endrun('physics_ptend_dealloc error: deallocation error for ptend%hflux_top') - - if (allocated(ptend%u)) deallocate(ptend%u, stat=ierr) - if ( ierr /= 0 ) call endrun('physics_ptend_dealloc error: deallocation error for ptend%u') - - if (allocated(ptend%taux_srf)) deallocate(ptend%taux_srf, stat=ierr) - if ( ierr /= 0 ) call endrun('physics_ptend_dealloc error: deallocation error for ptend%taux_srf') - - if (allocated(ptend%taux_top)) deallocate(ptend%taux_top, stat=ierr) - if ( ierr /= 0 ) call endrun('physics_ptend_dealloc error: deallocation error for ptend%taux_top') - - if (allocated(ptend%v)) deallocate(ptend%v, stat=ierr) - if ( ierr /= 0 ) call endrun('physics_ptend_dealloc error: deallocation error for ptend%v') - - if (allocated(ptend%tauy_srf)) deallocate(ptend%tauy_srf, stat=ierr) - if ( ierr /= 0 ) call endrun('physics_ptend_dealloc error: deallocation error for ptend%tauy_srf') - - if (allocated(ptend%tauy_top)) deallocate(ptend%tauy_top, stat=ierr) - if ( ierr /= 0 ) call endrun('physics_ptend_dealloc error: deallocation error for ptend%tauy_top') - - if (allocated(ptend%q)) deallocate(ptend%q, stat=ierr) - if ( ierr /= 0 ) call endrun('physics_ptend_dealloc error: deallocation error for ptend%q') - - if (allocated(ptend%cflx_srf)) deallocate(ptend%cflx_srf, stat=ierr) - if ( ierr /= 0 ) call endrun('physics_ptend_dealloc error: deallocation error for ptend%cflx_srf') - - if(allocated(ptend%cflx_top)) deallocate(ptend%cflx_top, stat=ierr) - if ( ierr /= 0 ) call endrun('physics_ptend_dealloc error: deallocation error for ptend%cflx_top') - -end subroutine physics_ptend_dealloc - -end module physics_types diff --git a/src/physics/cam/physpkg.F90.orig b/src/physics/cam/physpkg.F90.orig deleted file mode 100644 index 7982432814..0000000000 --- a/src/physics/cam/physpkg.F90.orig +++ /dev/null @@ -1,2397 +0,0 @@ -module physpkg - !----------------------------------------------------------------------- - ! Purpose: - ! - ! Provides the interface to CAM physics package - ! - ! Revision history: - ! Aug 2005, E. B. Kluzek, Creation of module from physpkg subroutine - ! 2005-10-17 B. Eaton Add contents of inti.F90 to phys_init(). Add - ! initialization of grid info in phys_state. - ! Nov 2010 A. Gettelman Put micro/macro physics into separate routines - !----------------------------------------------------------------------- - - use shr_kind_mod, only: r8 => shr_kind_r8 - use spmd_utils, only: masterproc - use physconst, only: latvap, latice, rh2o - use physics_types, only: physics_state, physics_tend, physics_state_set_grid, & - physics_ptend, physics_tend_init, physics_update, & - physics_type_alloc, physics_ptend_dealloc,& - physics_state_alloc, physics_state_dealloc, physics_tend_alloc, physics_tend_dealloc - use phys_grid, only: get_ncols_p - use phys_gmean, only: gmean_mass - use ppgrid, only: begchunk, endchunk, pcols, pver, pverp, psubcols - use constituents, only: pcnst, cnst_name, cnst_get_ind - use camsrfexch, only: cam_out_t, cam_in_t - - use cam_control_mod, only: ideal_phys, adiabatic - use phys_control, only: phys_do_flux_avg, phys_getopts, waccmx_is - use scamMod, only: single_column, scm_crm_mode - use flux_avg, only: flux_avg_init - use perf_mod - use cam_logfile, only: iulog - use camsrfexch, only: cam_export - - use modal_aero_calcsize, only: modal_aero_calcsize_init, modal_aero_calcsize_diag, modal_aero_calcsize_reg - use modal_aero_wateruptake, only: modal_aero_wateruptake_init, modal_aero_wateruptake_dr, modal_aero_wateruptake_reg - - implicit none - private - save - - ! Public methods - public phys_register ! was initindx - register physics methods - public phys_init ! Public initialization method - public phys_run1 ! First phase of the public run method - public phys_run2 ! Second phase of the public run method - public phys_final ! Public finalization method - - ! Private module data - - ! Physics package options - character(len=16) :: shallow_scheme - character(len=16) :: macrop_scheme - character(len=16) :: microp_scheme - integer :: cld_macmic_num_steps ! Number of macro/micro substeps - logical :: do_clubb_sgs - logical :: use_subcol_microp ! if true, use subcolumns in microphysics - logical :: state_debug_checks ! Debug physics_state. - logical :: clim_modal_aero ! climate controled by prognostic or prescribed modal aerosols - logical :: prog_modal_aero ! Prognostic modal aerosols present - - ! Physics buffer index - integer :: teout_idx = 0 - - integer :: landm_idx = 0 - integer :: sgh_idx = 0 - integer :: sgh30_idx = 0 - - integer :: qini_idx = 0 - integer :: cldliqini_idx = 0 - integer :: cldiceini_idx = 0 - - integer :: prec_str_idx = 0 - integer :: snow_str_idx = 0 - integer :: prec_sed_idx = 0 - integer :: snow_sed_idx = 0 - integer :: prec_pcw_idx = 0 - integer :: snow_pcw_idx = 0 - integer :: prec_dp_idx = 0 - integer :: snow_dp_idx = 0 - integer :: prec_sh_idx = 0 - integer :: snow_sh_idx = 0 - integer :: dlfzm_idx = 0 ! detrained convective cloud water mixing ratio. - -!======================================================================= -contains -!======================================================================= - - subroutine phys_register - !----------------------------------------------------------------------- - ! - ! Purpose: Register constituents and physics buffer fields. - ! - ! Author: CSM Contact: M. Vertenstein, Aug. 1997 - ! B.A. Boville, Oct 2001 - ! A. Gettelman, Nov 2010 - put micro/macro physics into separate routines - ! - !----------------------------------------------------------------------- - use cam_abortutils, only: endrun - use physics_buffer, only: pbuf_init_time - use physics_buffer, only: pbuf_add_field, dtype_r8, pbuf_register_subcol - use shr_kind_mod, only: r8 => shr_kind_r8 - use spmd_utils, only: masterproc - use constituents, only: pcnst, cnst_add, cnst_chk_dim, cnst_name - - use cam_control_mod, only: moist_physics - use chemistry, only: chem_register - use cloud_fraction, only: cldfrc_register - use rk_stratiform, only: rk_stratiform_register - use microp_driver, only: microp_driver_register - use microp_aero, only: microp_aero_register - use macrop_driver, only: macrop_driver_register - use clubb_intr, only: clubb_register_cam - use conv_water, only: conv_water_register - use physconst, only: mwdry, cpair, mwh2o, cpwv - use tracers, only: tracers_register - use check_energy, only: check_energy_register - use carma_intr, only: carma_register - use cam3_aero_data, only: cam3_aero_data_on, cam3_aero_data_register - use cam3_ozone_data, only: cam3_ozone_data_on, cam3_ozone_data_register - use ghg_data, only: ghg_data_register - use vertical_diffusion, only: vd_register - use convect_deep, only: convect_deep_register - use convect_shallow, only: convect_shallow_register - use radiation, only: radiation_register - use co2_cycle, only: co2_register - use flux_avg, only: flux_avg_register - use iondrag, only: iondrag_register - use waccmx_phys_intr, only: waccmx_phys_ion_elec_temp_reg - use string_utils, only: to_lower - use prescribed_ozone, only: prescribed_ozone_register - use prescribed_volcaero,only: prescribed_volcaero_register - use prescribed_strataero,only: prescribed_strataero_register - use prescribed_aero, only: prescribed_aero_register - use prescribed_ghg, only: prescribed_ghg_register - use sslt_rebin, only: sslt_rebin_register - use aoa_tracers, only: aoa_tracers_register - use aircraft_emit, only: aircraft_emit_register - use cam_diagnostics, only: diag_register - use cloud_diagnostics, only: cloud_diagnostics_register - use cospsimulator_intr, only: cospsimulator_intr_register - use rad_constituents, only: rad_cnst_get_info ! Added to query if it is a modal aero sim or not - use subcol, only: subcol_register - use subcol_utils, only: is_subcol_on - use dyn_comp, only: dyn_register - use spcam_drivers, only: spcam_register - use offline_driver, only: offline_driver_reg - - !---------------------------Local variables----------------------------- - ! - integer :: m ! loop index - integer :: mm ! constituent index - integer :: nmodes - !----------------------------------------------------------------------- - - ! Get physics options - call phys_getopts(shallow_scheme_out = shallow_scheme, & - macrop_scheme_out = macrop_scheme, & - microp_scheme_out = microp_scheme, & - cld_macmic_num_steps_out = cld_macmic_num_steps, & - do_clubb_sgs_out = do_clubb_sgs, & - use_subcol_microp_out = use_subcol_microp, & - state_debug_checks_out = state_debug_checks) - - ! Initialize dyn_time_lvls - call pbuf_init_time() - - ! Register the subcol scheme - call subcol_register() - - ! Register water vapor. - ! ***** N.B. ***** This must be the first call to cnst_add so that - ! water vapor is constituent 1. - if (moist_physics) then - call cnst_add('Q', mwh2o, cpwv, 1.E-12_r8, mm, & - longname='Specific humidity', readiv=.true., is_convtran1=.true.) - else - call cnst_add('Q', mwh2o, cpwv, 0.0_r8, mm, & - longname='Specific humidity', readiv=.false., is_convtran1=.true.) - end if - - ! Topography file fields. - call pbuf_add_field('LANDM', 'global', dtype_r8, (/pcols/), landm_idx) - call pbuf_add_field('SGH', 'global', dtype_r8, (/pcols/), sgh_idx) - call pbuf_add_field('SGH30', 'global', dtype_r8, (/pcols/), sgh30_idx) - - ! Fields for physics package diagnostics - call pbuf_add_field('QINI', 'physpkg', dtype_r8, (/pcols,pver/), qini_idx) - call pbuf_add_field('CLDLIQINI', 'physpkg', dtype_r8, (/pcols,pver/), cldliqini_idx) - call pbuf_add_field('CLDICEINI', 'physpkg', dtype_r8, (/pcols,pver/), cldiceini_idx) - - ! check energy package - call check_energy_register - - ! If using a simple physics option (e.g., held_suarez, adiabatic), - ! the normal CAM physics parameterizations are not called. - if (moist_physics) then - - ! register fluxes for saving across time - if (phys_do_flux_avg()) call flux_avg_register() - - call cldfrc_register() - - ! cloud water - if( microp_scheme == 'RK' ) then - call rk_stratiform_register() - elseif( microp_scheme == 'MG' ) then - if (.not. do_clubb_sgs) call macrop_driver_register() - call microp_aero_register() - call microp_driver_register() - end if - - ! Register CLUBB_SGS here - if (do_clubb_sgs) call clubb_register_cam() - - - call pbuf_add_field('PREC_STR', 'physpkg',dtype_r8,(/pcols/),prec_str_idx) - call pbuf_add_field('SNOW_STR', 'physpkg',dtype_r8,(/pcols/),snow_str_idx) - call pbuf_add_field('PREC_PCW', 'physpkg',dtype_r8,(/pcols/),prec_pcw_idx) - call pbuf_add_field('SNOW_PCW', 'physpkg',dtype_r8,(/pcols/),snow_pcw_idx) - call pbuf_add_field('PREC_SED', 'physpkg',dtype_r8,(/pcols/),prec_sed_idx) - call pbuf_add_field('SNOW_SED', 'physpkg',dtype_r8,(/pcols/),snow_sed_idx) - if (is_subcol_on()) then - call pbuf_register_subcol('PREC_STR', 'phys_register', prec_str_idx) - call pbuf_register_subcol('SNOW_STR', 'phys_register', snow_str_idx) - call pbuf_register_subcol('PREC_PCW', 'phys_register', prec_pcw_idx) - call pbuf_register_subcol('SNOW_PCW', 'phys_register', snow_pcw_idx) - call pbuf_register_subcol('PREC_SED', 'phys_register', prec_sed_idx) - call pbuf_register_subcol('SNOW_SED', 'phys_register', snow_sed_idx) - end if - - ! Who should add FRACIS? - ! -- It does not seem that aero_intr should add it since FRACIS is used in convection - ! even if there are no prognostic aerosols ... so do it here for now - call pbuf_add_field('FRACIS','physpkg',dtype_r8,(/pcols,pver,pcnst/),m) - - call conv_water_register() - - ! Determine whether its a 'modal' aerosol simulation or not - call rad_cnst_get_info(0, nmodes=nmodes) - clim_modal_aero = (nmodes > 0) - - if (clim_modal_aero) then - call modal_aero_calcsize_reg() - call modal_aero_wateruptake_reg() - endif - - ! register chemical constituents including aerosols ... - call chem_register() - - ! co2 constituents - call co2_register() - - ! register data model ozone with pbuf - if (cam3_ozone_data_on) then - call cam3_ozone_data_register() - end if - call prescribed_volcaero_register() - call prescribed_strataero_register() - call prescribed_ozone_register() - call prescribed_aero_register() - call prescribed_ghg_register() - call sslt_rebin_register - - ! CAM3 prescribed aerosols - if (cam3_aero_data_on) then - call cam3_aero_data_register() - end if - - ! register various data model gasses with pbuf - call ghg_data_register() - - ! carma microphysics - ! - call carma_register() - - ! Register iondrag variables with pbuf - call iondrag_register() - - ! Register ionosphere variables with pbuf if mode set to ionosphere - if( waccmx_is('ionosphere') ) then - call waccmx_phys_ion_elec_temp_reg() - endif - - call aircraft_emit_register() - - ! deep convection - call convect_deep_register - - ! shallow convection - call convect_shallow_register - - - call spcam_register - - ! radiation - call radiation_register - call cloud_diagnostics_register - - ! COSP - call cospsimulator_intr_register - - ! vertical diffusion - call vd_register() - else - ! held_suarez/adiabatic physics option should be in simple_physics - call endrun('phys_register: moist_physics configuration error') - end if - - ! Register diagnostics PBUF - call diag_register() - - ! Register age of air tracers - call aoa_tracers_register() - - ! Register test tracers - call tracers_register() - - call dyn_register() - - ! All tracers registered, check that the dimensions are correct - call cnst_chk_dim() - - ! ***NOTE*** No registering constituents after the call to cnst_chk_dim. - - call offline_driver_reg() - - end subroutine phys_register - - - - !======================================================================= - - subroutine phys_inidat( cam_out, pbuf2d ) - use cam_abortutils, only: endrun - - use physics_buffer, only: pbuf_get_index, pbuf_get_field, physics_buffer_desc, pbuf_set_field, dyn_time_lvls - - - use cam_initfiles, only: initial_file_get_id, topo_file_get_id - use cam_grid_support, only: cam_grid_check, cam_grid_id - use cam_grid_support, only: cam_grid_get_dim_names - use pio, only: file_desc_t - use ncdio_atm, only: infld - use dycore, only: dycore_is - use polar_avg, only: polar_average - use short_lived_species, only: initialize_short_lived_species - use cam_control_mod, only: aqua_planet - use waccmx_phys_intr, only: waccmx_phys_ion_elec_temp_inidat - - type(cam_out_t), intent(inout) :: cam_out(begchunk:endchunk) - type(physics_buffer_desc), pointer :: pbuf2d(:,:) - integer :: lchnk, m, n, i, k, ncol - type(file_desc_t), pointer :: fh_ini, fh_topo - character(len=8) :: fieldname - real(r8), pointer :: tptr(:,:), tptr_2(:,:), tptr3d(:,:,:), tptr3d_2(:,:,:) - real(r8), pointer :: qpert(:,:) - - character(len=11) :: subname='phys_inidat' ! subroutine name - integer :: tpert_idx, qpert_idx, pblh_idx - - logical :: found=.false., found2=.false. - integer :: ierr - character(len=8) :: dim1name, dim2name - integer :: ixcldice, ixcldliq - integer :: grid_id ! grid ID for data mapping - - nullify(tptr,tptr_2,tptr3d,tptr3d_2) - - fh_ini => initial_file_get_id() - fh_topo => topo_file_get_id() - - ! dynamics variables are handled in dyn_init - here we read variables needed for physics - ! but not dynamics - - 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) - - allocate(tptr(1:pcols,begchunk:endchunk)) - - if (associated(fh_topo) .and. .not. aqua_planet) then - call infld('SGH', fh_topo, dim1name, dim2name, 1, pcols, begchunk, endchunk, & - tptr, found, gridname='physgrid') - if(.not. found) call endrun('ERROR: SGH not found on topo file') - - call pbuf_set_field(pbuf2d, sgh_idx, tptr) - - allocate(tptr_2(1:pcols,begchunk:endchunk)) - call infld('SGH30', fh_topo, dim1name, dim2name, 1, pcols, begchunk, endchunk, & - tptr_2, found, gridname='physgrid') - if(found) then - call pbuf_set_field(pbuf2d, sgh30_idx, tptr_2) - else - if (masterproc) write(iulog,*) 'Warning: Error reading SGH30 from topo file.' - if (masterproc) write(iulog,*) 'The field SGH30 will be filled using data from SGH.' - call pbuf_set_field(pbuf2d, sgh30_idx, tptr) - end if - - deallocate(tptr_2) - - call infld('LANDM_COSLAT', fh_topo, dim1name, dim2name, 1, pcols, begchunk, endchunk, & - tptr, found, gridname='physgrid') - - if(.not.found) call endrun(' ERROR: LANDM_COSLAT not found on topo dataset.') - - call pbuf_set_field(pbuf2d, landm_idx, tptr) - - else - call pbuf_set_field(pbuf2d, sgh_idx, 0._r8) - call pbuf_set_field(pbuf2d, sgh30_idx, 0._r8) - call pbuf_set_field(pbuf2d, landm_idx, 0._r8) - end if - - call infld('PBLH', fh_ini, dim1name, dim2name, 1, pcols, begchunk, endchunk, & - tptr(:,:), found, gridname='physgrid') - if(.not. found) then - tptr(:,:) = 0._r8 - if (masterproc) write(iulog,*) 'PBLH initialized to 0.' - end if - pblh_idx = pbuf_get_index('pblh') - - call pbuf_set_field(pbuf2d, pblh_idx, tptr) - - call infld('TPERT', fh_ini, dim1name, dim2name, 1, pcols, begchunk, endchunk, & - tptr(:,:), found, gridname='physgrid') - if(.not. found) then - tptr(:,:) = 0._r8 - if (masterproc) write(iulog,*) 'TPERT initialized to 0.' - end if - tpert_idx = pbuf_get_index( 'tpert') - call pbuf_set_field(pbuf2d, tpert_idx, tptr) - - fieldname='QPERT' - qpert_idx = pbuf_get_index( 'qpert',ierr) - if (qpert_idx > 0) then - call infld(fieldname, fh_ini, dim1name, dim2name, 1, pcols, begchunk, endchunk, & - tptr, found, gridname='physgrid') - if(.not. found) then - tptr=0_r8 - if (masterproc) write(iulog,*) trim(fieldname), ' initialized to 0.' - end if - - allocate(tptr3d_2(pcols,pcnst,begchunk:endchunk)) - tptr3d_2 = 0_r8 - tptr3d_2(:,1,:) = tptr(:,:) - - call pbuf_set_field(pbuf2d, qpert_idx, tptr3d_2) - deallocate(tptr3d_2) - end if - - fieldname='CUSH' - m = pbuf_get_index('cush', ierr) - if (m > 0) then - call infld(fieldname, fh_ini, dim1name, dim2name, 1, pcols, begchunk, endchunk, & - tptr, found, gridname='physgrid') - if(.not.found) then - if(masterproc) write(iulog,*) trim(fieldname), ' initialized to 1000.' - tptr=1000._r8 - end if - do n=1,dyn_time_lvls - call pbuf_set_field(pbuf2d, m, tptr, start=(/1,n/), kount=(/pcols,1/)) - end do - deallocate(tptr) - end if - - ! - ! 3-D fields - ! - - allocate(tptr3d(pcols,pver,begchunk:endchunk)) - - fieldname='CLOUD' - m = pbuf_get_index('CLD') - call infld(fieldname, fh_ini, dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, & - tptr3d, found, gridname='physgrid') - if(found) then - do n = 1, dyn_time_lvls - call pbuf_set_field(pbuf2d, m, tptr3d, (/1,1,n/),(/pcols,pver,1/)) - end do - else - call pbuf_set_field(pbuf2d, m, 0._r8) - if (masterproc) write(iulog,*) trim(fieldname), ' initialized to 0.' - end if - - fieldname='QCWAT' - m = pbuf_get_index(fieldname,ierr) - if (m > 0) then - call infld(fieldname, fh_ini, dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, & - tptr3d, found, gridname='physgrid') - if(.not. found) then - call infld('Q',fh_ini,dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, & - tptr3d, found, gridname='physgrid') - if (found) then - if (masterproc) write(iulog,*) trim(fieldname), ' initialized with Q' - if(dycore_is('LR')) call polar_average(pver, tptr3d) - else - if (masterproc) write(iulog,*) trim(fieldname), ' initialized to huge()' - tptr3d = huge(1.0_r8) - end if - end if - do n = 1, dyn_time_lvls - call pbuf_set_field(pbuf2d, m, tptr3d, (/1,1,n/),(/pcols,pver,1/)) - end do - end if - - fieldname = 'ICCWAT' - m = pbuf_get_index(fieldname, ierr) - if (m > 0) then - call infld(fieldname, fh_ini, dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, & - tptr3d, found, gridname='physgrid') - if(found) then - do n = 1, dyn_time_lvls - call pbuf_set_field(pbuf2d, m, tptr3d, (/1,1,n/),(/pcols,pver,1/)) - end do - else - call cnst_get_ind('CLDICE', ixcldice) - call infld('CLDICE',fh_ini,dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, & - tptr3d, found, gridname='physgrid') - if(found) then - do n = 1, dyn_time_lvls - call pbuf_set_field(pbuf2d, m, tptr3d, (/1,1,n/),(/pcols,pver,1/)) - end do - else - call pbuf_set_field(pbuf2d, m, 0._r8) - end if - if (masterproc) then - if (found) then - write(iulog,*) trim(fieldname), ' initialized with CLDICE' - else - write(iulog,*) trim(fieldname), ' initialized to 0.0' - end if - end if - end if - end if - - fieldname = 'LCWAT' - m = pbuf_get_index(fieldname,ierr) - if (m > 0) then - call infld(fieldname, fh_ini, dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, & - tptr3d, found, gridname='physgrid') - if(found) then - do n = 1, dyn_time_lvls - call pbuf_set_field(pbuf2d, m, tptr3d, (/1,1,n/),(/pcols,pver,1/)) - end do - else - allocate(tptr3d_2(pcols,pver,begchunk:endchunk)) - call cnst_get_ind('CLDICE', ixcldice) - call cnst_get_ind('CLDLIQ', ixcldliq) - call infld('CLDICE',fh_ini,dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, & - tptr3d, found, gridname='physgrid') - call infld('CLDLIQ',fh_ini,dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, & - tptr3d_2, found2, gridname='physgrid') - if(found .and. found2) then - do lchnk = begchunk, endchunk - ncol = get_ncols_p(lchnk) - tptr3d(:ncol,:,lchnk)=tptr3d(:ncol,:,lchnk)+tptr3d_2(:ncol,:,lchnk) - end do - if (masterproc) write(iulog,*) trim(fieldname), ' initialized with CLDICE + CLDLIQ' - else if (found) then ! Data already loaded in tptr3d - if (masterproc) write(iulog,*) trim(fieldname), ' initialized with CLDICE only' - else if (found2) then - tptr3d(:,:,:)=tptr3d_2(:,:,:) - if (masterproc) write(iulog,*) trim(fieldname), ' initialized with CLDLIQ only' - end if - - if (found .or. found2) then - do n = 1, dyn_time_lvls - call pbuf_set_field(pbuf2d, m, tptr3d, (/1,1,n/),(/pcols,pver,1/)) - end do - if(dycore_is('LR')) call polar_average(pver, tptr3d) - else - call pbuf_set_field(pbuf2d, m, 0._r8) - if (masterproc) write(iulog,*) trim(fieldname), ' initialized to 0.0' - end if - deallocate(tptr3d_2) - end if - end if - - deallocate(tptr3d) - allocate(tptr3d(pcols,pver,begchunk:endchunk)) - - fieldname = 'TCWAT' - m = pbuf_get_index(fieldname,ierr) - if (m > 0) then - call infld(fieldname, fh_ini, dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, & - tptr3d, found, gridname='physgrid') - if(.not.found) then - call infld('T', fh_ini, dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, & - tptr3d, found, gridname='physgrid') - if (found) then - if(dycore_is('LR')) call polar_average(pver, tptr3d) - if (masterproc) write(iulog,*) trim(fieldname), ' initialized with T' - else - if (masterproc) write(iulog,*) trim(fieldname), ' initialized to huge()' - tptr3d = huge(1._r8) - end if - end if - do n = 1, dyn_time_lvls - call pbuf_set_field(pbuf2d, m, tptr3d, (/1,1,n/),(/pcols,pver,1/)) - end do - end if - - deallocate(tptr3d) - allocate(tptr3d(pcols,pverp,begchunk:endchunk)) - - fieldname = 'TKE' - m = pbuf_get_index( 'tke') - call infld(fieldname, fh_ini, dim1name, 'ilev', dim2name, 1, pcols, 1, pverp, begchunk, endchunk, & - tptr3d, found, gridname='physgrid') - if (found) then - call pbuf_set_field(pbuf2d, m, tptr3d) - else - call pbuf_set_field(pbuf2d, m, 0.01_r8) - if (masterproc) write(iulog,*) trim(fieldname), ' initialized to 0.01' - end if - - - fieldname = 'KVM' - m = pbuf_get_index('kvm') - call infld(fieldname, fh_ini, dim1name, 'ilev', dim2name, 1, pcols, 1, pverp, begchunk, endchunk, & - tptr3d, found, gridname='physgrid') - if (found) then - call pbuf_set_field(pbuf2d, m, tptr3d) - else - call pbuf_set_field(pbuf2d, m, 0._r8) - if (masterproc) write(iulog,*) trim(fieldname), ' initialized to 0.' - end if - - - fieldname = 'KVH' - m = pbuf_get_index('kvh') - call infld(fieldname, fh_ini, dim1name, 'ilev', dim2name, 1, pcols, 1, pverp, begchunk, endchunk, & - tptr3d, found, gridname='physgrid') - if (found) then - call pbuf_set_field(pbuf2d, m, tptr3d) - else - call pbuf_set_field(pbuf2d, m, 0._r8) - if (masterproc) write(iulog,*) trim(fieldname), ' initialized to 0.' - end if - - deallocate(tptr3d) - allocate(tptr3d(pcols,pver,begchunk:endchunk)) - - fieldname = 'CONCLD' - m = pbuf_get_index('CONCLD',ierr) - if (m > 0) then - call infld(fieldname, fh_ini, dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, & - tptr3d, found, gridname='physgrid') - if(found) then - do n = 1, dyn_time_lvls - call pbuf_set_field(pbuf2d, m, tptr3d, (/1,1,n/),(/pcols,pver,1/)) - end do - else - call pbuf_set_field(pbuf2d, m, 0._r8) - if (masterproc) write(iulog,*) trim(fieldname), ' initialized to 0.' - end if - - deallocate (tptr3d) - end if - - call initialize_short_lived_species(fh_ini, pbuf2d) - - !--------------------------------------------------------------------------------- - ! If needed, get ion and electron temperature fields from initial condition file - !--------------------------------------------------------------------------------- - - call waccmx_phys_ion_elec_temp_inidat(fh_ini,pbuf2d) - - end subroutine phys_inidat - - - subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_out ) - - !----------------------------------------------------------------------- - ! - ! Initialization of physics package. - ! - !----------------------------------------------------------------------- - - use physics_buffer, only: physics_buffer_desc, pbuf_initialize, pbuf_get_index - use physconst, only: rair, cpair, gravit, stebol, tmelt, & - latvap, latice, rh2o, rhoh2o, pstd, zvir, & - karman, rhodair, physconst_init - use ref_pres, only: pref_edge, pref_mid - - use carma_intr, only: carma_init - use cam_control_mod, only: initial_run - use check_energy, only: check_energy_init - use chemistry, only: chem_init - use prescribed_ozone, only: prescribed_ozone_init - use prescribed_ghg, only: prescribed_ghg_init - use prescribed_aero, only: prescribed_aero_init - use aerodep_flx, only: aerodep_flx_init - use aircraft_emit, only: aircraft_emit_init - use prescribed_volcaero,only: prescribed_volcaero_init - use prescribed_strataero,only: prescribed_strataero_init - use cloud_fraction, only: cldfrc_init - use cldfrc2m, only: cldfrc2m_init - use co2_cycle, only: co2_init, co2_transport - use convect_deep, only: convect_deep_init - use convect_shallow, only: convect_shallow_init - use cam_diagnostics, only: diag_init - use gw_drag, only: gw_init - use cam3_aero_data, only: cam3_aero_data_on, cam3_aero_data_init - use cam3_ozone_data, only: cam3_ozone_data_on, cam3_ozone_data_init - use radheat, only: radheat_init - use radiation, only: radiation_init - use cloud_diagnostics, only: cloud_diagnostics_init - use rk_stratiform, only: rk_stratiform_init - use wv_saturation, only: wv_sat_init - use microp_driver, only: microp_driver_init - use microp_aero, only: microp_aero_init - use macrop_driver, only: macrop_driver_init - use conv_water, only: conv_water_init - use spcam_drivers, only: spcam_init - use tracers, only: tracers_init - use aoa_tracers, only: aoa_tracers_init - use rayleigh_friction, only: rayleigh_friction_init - use pbl_utils, only: pbl_utils_init - use vertical_diffusion, only: vertical_diffusion_init - use phys_debug_util, only: phys_debug_init - use phys_debug, only: phys_debug_state_init - use rad_constituents, only: rad_cnst_init - use aer_rad_props, only: aer_rad_props_init - use subcol, only: subcol_init - use qbo, only: qbo_init - use qneg_module, only: qneg_init - use iondrag, only: iondrag_init, do_waccm_ions -#if ( defined OFFLINE_DYN ) - use metdata, only: metdata_phys_init -#endif - use epp_ionization, only: epp_ionization_init, epp_ionization_active - use waccmx_phys_intr, only: waccmx_phys_ion_elec_temp_init ! Initialization of ionosphere module (WACCM-X) - use waccmx_phys_intr, only: waccmx_phys_mspd_init ! Initialization of major species diffusion module (WACCM-X) - use clubb_intr, only: clubb_ini_cam - use sslt_rebin, only: sslt_rebin_init - use tropopause, only: tropopause_init - use solar_data, only: solar_data_init - use dadadj_cam, only: dadadj_init - use cam_abortutils, only: endrun - use nudging, only: Nudge_Model, nudging_init - - ! Input/output arguments - type(physics_state), pointer :: phys_state(:) - type(physics_tend ), pointer :: phys_tend(:) - type(physics_buffer_desc), pointer :: pbuf2d(:,:) - - type(cam_out_t),intent(inout) :: cam_out(begchunk:endchunk) - - ! local variables - integer :: lchnk - integer :: ierr - - !----------------------------------------------------------------------- - - call physics_type_alloc(phys_state, phys_tend, begchunk, endchunk, pcols) - - do lchnk = begchunk, endchunk - call physics_state_set_grid(lchnk, phys_state(lchnk)) - end do - - !------------------------------------------------------------------------------------------- - ! Initialize any variables in physconst which are not temporally and/or spatially constant - !------------------------------------------------------------------------------------------- - call physconst_init() - - ! Initialize debugging a physics column - call phys_debug_init() - - call pbuf_initialize(pbuf2d) - - ! Initialize subcol scheme - call subcol_init(pbuf2d) - - ! diag_init makes addfld calls for dynamics fields that are output from - ! the physics decomposition - call diag_init(pbuf2d) - - call check_energy_init() - - call tracers_init() - - ! age of air tracers - call aoa_tracers_init() - - teout_idx = pbuf_get_index( 'TEOUT') - - ! adiabatic or ideal physics should be only used if in simple_physics - if (adiabatic .or. ideal_phys) then - if (adiabatic) then - call endrun('phys_init: adiabatic configuration error') - else - call endrun('phys_init: ideal_phys configuration error') - end if - end if - - if (initial_run) then - call phys_inidat(cam_out, pbuf2d) - end if - - ! wv_saturation is relatively independent of everything else and - ! low level, so init it early. Must at least do this before radiation. - call wv_sat_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 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) - - ! Prescribed tracers - call prescribed_ozone_init() - call prescribed_ghg_init() - call prescribed_aero_init() - call aerodep_flx_init() - call aircraft_emit_init() - call prescribed_volcaero_init() - call prescribed_strataero_init() - - ! co2 cycle - if (co2_transport()) then - call co2_init() - end if - - ! CAM3 prescribed ozone - if (cam3_ozone_data_on) call cam3_ozone_data_init(phys_state) - - call gw_init() - - call rayleigh_friction_init() - - call pbl_utils_init(gravit, karman, cpair, rair, zvir) - call vertical_diffusion_init(pbuf2d) - - if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then - call waccmx_phys_mspd_init () - ! Initialization of ionosphere module if mode set to ionosphere - if( waccmx_is('ionosphere') ) then - call waccmx_phys_ion_elec_temp_init(pbuf2d) - endif - endif - - call radiation_init(pbuf2d) - - call cloud_diagnostics_init() - - call radheat_init(pref_mid) - - call convect_shallow_init(pref_edge, pbuf2d) - - call cldfrc_init() - call cldfrc2m_init() - - call convect_deep_init(pref_edge) - - if( microp_scheme == 'RK' ) then - call rk_stratiform_init() - elseif( microp_scheme == 'MG' ) then - if (.not. do_clubb_sgs) call macrop_driver_init(pbuf2d) - call microp_aero_init() - call microp_driver_init(pbuf2d) - call conv_water_init - elseif( microp_scheme == 'SPCAM_m2005') then - call conv_water_init - end if - - - ! initiate CLUBB within CAM - if (do_clubb_sgs) call clubb_ini_cam(pbuf2d) - - call spcam_init(pbuf2d) - - call qbo_init - - call iondrag_init(pref_mid) - ! Geomagnetic module -- after iondrag_init - if (epp_ionization_active) then - call epp_ionization_init() - endif - -#if ( defined OFFLINE_DYN ) - call metdata_phys_init() -#endif - call sslt_rebin_init() - call tropopause_init() - call dadadj_init() - - prec_dp_idx = pbuf_get_index('PREC_DP') - snow_dp_idx = pbuf_get_index('SNOW_DP') - prec_sh_idx = pbuf_get_index('PREC_SH') - snow_sh_idx = pbuf_get_index('SNOW_SH') - - dlfzm_idx = pbuf_get_index('DLFZM', ierr) - - call phys_getopts(prog_modal_aero_out=prog_modal_aero) - - ! Initialize Nudging Parameters - !-------------------------------- - if(Nudge_Model) call nudging_init - - if (clim_modal_aero) then - - ! If climate calculations are affected by prescribed modal aerosols, the - ! the initialization routine for the dry mode radius calculation is called - ! here. For prognostic MAM the initialization is called from - ! modal_aero_initialize - if (.not. prog_modal_aero) then - call modal_aero_calcsize_init(pbuf2d) - endif - - call modal_aero_wateruptake_init(pbuf2d) - - end if - - ! Initialize qneg3 and qneg4 - call qneg_init() - - end subroutine phys_init - - ! - !----------------------------------------------------------------------- - ! - - subroutine phys_run1(phys_state, ztodt, phys_tend, pbuf2d, cam_in, cam_out) - !----------------------------------------------------------------------- - ! - ! Purpose: - ! First part of atmospheric physics package before updating of surface models - ! - !----------------------------------------------------------------------- - use time_manager, only: get_nstep - use cam_diagnostics,only: diag_allocate, diag_physvar_ic - use check_energy, only: check_energy_gmean - use phys_control, only: phys_getopts - use spcam_drivers, only: tphysbc_spcam - use spmd_utils, only: mpicom - use physics_buffer, only: physics_buffer_desc, pbuf_get_chunk, pbuf_allocate -#if (defined BFB_CAM_SCAM_IOP ) - use cam_history, only: outfld -#endif - use cam_abortutils, only: endrun -#if ( defined OFFLINE_DYN ) - use metdata, only: get_met_srf1 -#endif - ! - ! Input arguments - ! - real(r8), intent(in) :: ztodt ! physics time step unless nstep=0 - ! - ! Input/Output arguments - ! - type(physics_state), intent(inout), dimension(begchunk:endchunk) :: phys_state - type(physics_tend ), intent(inout), dimension(begchunk:endchunk) :: phys_tend - - type(physics_buffer_desc), pointer, dimension(:,:) :: pbuf2d - type(cam_in_t), dimension(begchunk:endchunk) :: cam_in - type(cam_out_t), dimension(begchunk:endchunk) :: cam_out - !----------------------------------------------------------------------- - ! - !---------------------------Local workspace----------------------------- - ! - integer :: c ! indices - integer :: ncol ! number of columns - integer :: nstep ! current timestep number - logical :: use_spcam - type(physics_buffer_desc), pointer :: phys_buffer_chunk(:) - - call t_startf ('physpkg_st1') - nstep = get_nstep() - -#if ( defined OFFLINE_DYN ) - ! - ! if offline mode set SNOWH and TS for micro-phys - ! - call get_met_srf1( cam_in ) -#endif - - ! The following initialization depends on the import state (cam_in) - ! being initialized. This isn't true when cam_init is called, so need - ! to postpone this initialization to here. - if (nstep == 0 .and. phys_do_flux_avg()) call flux_avg_init(cam_in, pbuf2d) - - ! Compute total energy of input state and previous output state - call t_startf ('chk_en_gmean') - call check_energy_gmean(phys_state, pbuf2d, ztodt, nstep) - call t_stopf ('chk_en_gmean') - - call t_stopf ('physpkg_st1') - - call t_startf ('physpkg_st1') - - call pbuf_allocate(pbuf2d, 'physpkg') - call diag_allocate() - - !----------------------------------------------------------------------- - ! Advance time information - !----------------------------------------------------------------------- - - call phys_timestep_init(phys_state, cam_in, cam_out, pbuf2d) - - call t_stopf ('physpkg_st1') - -#ifdef TRACER_CHECK - call gmean_mass ('before tphysbc DRY', phys_state) -#endif - - - !----------------------------------------------------------------------- - ! Tendency physics before flux coupler invocation - !----------------------------------------------------------------------- - ! - -#if (defined BFB_CAM_SCAM_IOP ) - do c=begchunk, endchunk - call outfld('Tg',cam_in(c)%ts,pcols ,c ) - end do -#endif - - call t_barrierf('sync_bc_physics', mpicom) - call t_startf ('bc_physics') - call t_adj_detailf(+1) - - call phys_getopts( use_spcam_out = use_spcam) - -!$OMP PARALLEL DO PRIVATE (C, phys_buffer_chunk) - do c=begchunk, endchunk - ! - ! Output physics terms to IC file - ! - phys_buffer_chunk => pbuf_get_chunk(pbuf2d, c) - - call t_startf ('diag_physvar_ic') - call diag_physvar_ic ( c, phys_buffer_chunk, cam_out(c), cam_in(c) ) - call t_stopf ('diag_physvar_ic') - - if (use_spcam) then - call tphysbc_spcam (ztodt, phys_state(c), & - phys_tend(c), phys_buffer_chunk, & - cam_out(c), cam_in(c) ) - else - call tphysbc (ztodt, phys_state(c), & - phys_tend(c), phys_buffer_chunk, & - cam_out(c), cam_in(c) ) - end if - - end do - - call t_adj_detailf(-1) - call t_stopf ('bc_physics') - - ! Don't call the rest in CRM mode - if(single_column.and.scm_crm_mode) return - -#ifdef TRACER_CHECK - call gmean_mass ('between DRY', phys_state) -#endif - - end subroutine phys_run1 - - ! - !----------------------------------------------------------------------- - ! - - subroutine phys_run2(phys_state, ztodt, phys_tend, pbuf2d, cam_out, & - cam_in ) - !----------------------------------------------------------------------- - ! - ! Purpose: - ! Second part of atmospheric physics package after updating of surface models - ! - !----------------------------------------------------------------------- - use physics_buffer, only: physics_buffer_desc, pbuf_get_chunk, pbuf_deallocate, pbuf_update_tim_idx - use mo_lightning, only: lightning_no_prod - use cam_diagnostics, only: diag_deallocate, diag_surf - use physconst, only: stebol, latvap - use carma_intr, only: carma_accumulate_stats - use spmd_utils, only: mpicom -#if ( defined OFFLINE_DYN ) - use metdata, only: get_met_srf2 -#endif - ! - ! Input arguments - ! - real(r8), intent(in) :: ztodt ! physics time step unless nstep=0 - ! - ! Input/Output arguments - ! - type(physics_state), intent(inout), dimension(begchunk:endchunk) :: phys_state - type(physics_tend ), intent(inout), dimension(begchunk:endchunk) :: phys_tend - type(physics_buffer_desc),pointer, dimension(:,:) :: pbuf2d - - type(cam_out_t), intent(inout), dimension(begchunk:endchunk) :: cam_out - type(cam_in_t), intent(inout), dimension(begchunk:endchunk) :: cam_in - ! - !----------------------------------------------------------------------- - !---------------------------Local workspace----------------------------- - ! - integer :: c ! chunk index - integer :: ncol ! number of columns - type(physics_buffer_desc),pointer, dimension(:) :: phys_buffer_chunk - ! - ! If exit condition just return - ! - - if(single_column.and.scm_crm_mode) return - - !----------------------------------------------------------------------- - ! Tendency physics after coupler - ! Not necessary at terminal timestep. - !----------------------------------------------------------------------- - ! -#if ( defined OFFLINE_DYN ) - ! - ! if offline mode set SHFLX QFLX TAUX TAUY for vert diffusion - ! - call get_met_srf2( cam_in ) -#endif - ! Set lightning production of NO - call t_startf ('lightning_no_prod') - call lightning_no_prod( phys_state, pbuf2d, cam_in ) - call t_stopf ('lightning_no_prod') - - call t_barrierf('sync_ac_physics', mpicom) - call t_startf ('ac_physics') - call t_adj_detailf(+1) - -!$OMP PARALLEL DO PRIVATE (C, NCOL, phys_buffer_chunk) - - do c=begchunk,endchunk - ncol = get_ncols_p(c) - phys_buffer_chunk => pbuf_get_chunk(pbuf2d, c) - ! - ! surface diagnostics for history files - ! - call t_startf('diag_surf') - call diag_surf(cam_in(c), cam_out(c), phys_state(c), phys_buffer_chunk) - call t_stopf('diag_surf') - - call tphysac(ztodt, cam_in(c), & - cam_out(c), & - phys_state(c), phys_tend(c), phys_buffer_chunk) - end do ! Chunk loop - - call t_adj_detailf(-1) - call t_stopf('ac_physics') - -#ifdef TRACER_CHECK - call gmean_mass ('after tphysac FV:WET)', phys_state) -#endif - - call t_startf ('carma_accumulate_stats') - call carma_accumulate_stats() - call t_stopf ('carma_accumulate_stats') - - call t_startf ('physpkg_st2') - call pbuf_deallocate(pbuf2d, 'physpkg') - - call pbuf_update_tim_idx() - call diag_deallocate() - call t_stopf ('physpkg_st2') - - end subroutine phys_run2 - - ! - !----------------------------------------------------------------------- - ! - - subroutine phys_final( phys_state, phys_tend, pbuf2d ) - use physics_buffer, only : physics_buffer_desc, pbuf_deallocate - use chemistry, only : chem_final - use carma_intr, only : carma_final - use wv_saturation, only : wv_sat_final - !----------------------------------------------------------------------- - ! - ! Purpose: - ! Finalization of physics package - ! - !----------------------------------------------------------------------- - ! Input/output arguments - type(physics_state), pointer :: phys_state(:) - type(physics_tend ), pointer :: phys_tend(:) - type(physics_buffer_desc), pointer :: pbuf2d(:,:) - - if(associated(pbuf2d)) then - call pbuf_deallocate(pbuf2d,'global') - deallocate(pbuf2d) - end if - deallocate(phys_state) - deallocate(phys_tend) - call chem_final - call carma_final - call wv_sat_final - - end subroutine phys_final - - - subroutine tphysac (ztodt, cam_in, & - cam_out, state, tend, pbuf) - !----------------------------------------------------------------------- - ! - ! Tendency physics after coupling to land, sea, and ice models. - ! - ! Computes the following: - ! - ! o Aerosol Emission at Surface - ! o Source-Sink for Advected Tracers - ! o Symmetric Turbulence Scheme - Vertical Diffusion - ! o Rayleigh Friction - ! o Dry Deposition of Aerosol - ! o Enforce Charge Neutrality ( Only for WACCM ) - ! o Gravity Wave Drag - ! o QBO Relaxation ( Only for WACCM ) - ! o Ion Drag ( Only for WACCM ) - ! o Scale Dry Mass Energy - !----------------------------------------------------------------------- - use physics_buffer, only: physics_buffer_desc, pbuf_set_field, pbuf_get_index, pbuf_get_field, pbuf_old_tim_idx - use shr_kind_mod, only: r8 => shr_kind_r8 - use chemistry, only: chem_is_active, chem_timestep_tend, chem_emissions - use cam_diagnostics, only: diag_phys_tend_writeout - use gw_drag, only: gw_tend - use vertical_diffusion, only: vertical_diffusion_tend - use rayleigh_friction, only: rayleigh_friction_tend - use constituents, only: cnst_get_ind - use physics_types, only: physics_state, physics_tend, physics_ptend, physics_update, & - physics_dme_adjust, set_dry_to_wet, physics_state_check - use waccmx_phys_intr, only: waccmx_phys_mspd_tend ! WACCM-X major diffusion - use waccmx_phys_intr, only: waccmx_phys_ion_elec_temp_tend ! WACCM-X - use aoa_tracers, only: aoa_tracers_timestep_tend - use physconst, only: rhoh2o, latvap,latice - use aero_model, only: aero_model_drydep - use carma_intr, only: carma_emission_tend, carma_timestep_tend - use carma_flags_mod, only: carma_do_aerosol, carma_do_emission - use check_energy, only: check_energy_chng, calc_te_and_aam_budgets - use check_energy, only: check_tracers_data, check_tracers_init, check_tracers_chng - use time_manager, only: get_nstep - use cam_abortutils, only: endrun - use dycore, only: dycore_is - use cam_control_mod, only: aqua_planet - use mo_gas_phase_chemdr,only: map2chm - use clybry_fam, only: clybry_fam_set - use charge_neutrality, only: charge_balance - use qbo, only: qbo_relax - use iondrag, only: iondrag_calc, do_waccm_ions - use perf_mod - use flux_avg, only: flux_avg_run - use unicon_cam, only: unicon_cam_org_diags - use cam_history, only: hist_fld_active - use qneg_module, only: qneg4 - use co2_cycle, only: co2_cycle_set_ptend - use nudging, only: Nudge_Model,Nudge_ON,nudging_timestep_tend - - ! - ! Arguments - ! - real(r8), intent(in) :: ztodt ! Two times model timestep (2 delta-t) - - type(cam_in_t), intent(inout) :: cam_in - type(cam_out_t), intent(inout) :: cam_out - type(physics_state), intent(inout) :: state - type(physics_tend ), intent(inout) :: tend - type(physics_buffer_desc), pointer :: pbuf(:) - - - type(check_tracers_data):: tracerint ! tracer mass integrals and cummulative boundary fluxes - - ! - !---------------------------Local workspace----------------------------- - ! - type(physics_ptend) :: ptend ! indivdual parameterization tendencies - - integer :: nstep ! current timestep number - real(r8) :: zero(pcols) ! array of zeros - - integer :: lchnk ! chunk identifier - integer :: ncol ! number of atmospheric columns - integer i,k,m ! Longitude, level indices - integer :: yr, mon, day, tod ! components of a date - integer :: ixcldice, ixcldliq ! constituent indices for cloud liquid and ice water. - - logical :: labort ! abort flag - - real(r8) tvm(pcols,pver) ! virtual temperature - real(r8) prect(pcols) ! total precipitation - real(r8) surfric(pcols) ! surface friction velocity - real(r8) obklen(pcols) ! Obukhov length - real(r8) :: fh2o(pcols) ! h2o flux to balance source from methane chemistry - real(r8) :: flx_heat(pcols) ! Heat flux for check_energy_chng. - real(r8) :: tmp_q (pcols,pver) ! tmp space - real(r8) :: tmp_cldliq(pcols,pver) ! tmp space - real(r8) :: tmp_cldice(pcols,pver) ! tmp space - real(r8) :: tmp_trac (pcols,pver,pcnst) ! tmp space - real(r8) :: tmp_pdel (pcols,pver) ! tmp space - real(r8) :: tmp_ps (pcols) ! tmp space - - ! physics buffer fields for total energy and mass adjustment - integer itim_old, ifld - - real(r8), pointer, dimension(:,:) :: cld - real(r8), pointer, dimension(:,:) :: qini - real(r8), pointer, dimension(:,:) :: cldliqini - real(r8), pointer, dimension(:,:) :: cldiceini - real(r8), pointer, dimension(:,:) :: dtcore - real(r8), pointer, dimension(:,:) :: ast ! relative humidity cloud fraction - - !----------------------------------------------------------------------- - lchnk = state%lchnk - ncol = state%ncol - - nstep = get_nstep() - - ! 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) - endif - - ! Validate the physics state. - if (state_debug_checks) & - call physics_state_check(state, name="before tphysac") - - call t_startf('tphysac_init') - ! Associate pointers with physics buffer fields - itim_old = pbuf_old_tim_idx() - - - ifld = pbuf_get_index('DTCORE') - call pbuf_get_field(pbuf, ifld, dtcore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) - - call pbuf_get_field(pbuf, qini_idx, qini) - call pbuf_get_field(pbuf, cldliqini_idx, cldliqini) - call pbuf_get_field(pbuf, cldiceini_idx, cldiceini) - - ifld = pbuf_get_index('CLD') - call pbuf_get_field(pbuf, ifld, cld, start=(/1,1,itim_old/),kount=(/pcols,pver,1/)) - - ifld = pbuf_get_index('AST') - call pbuf_get_field(pbuf, ifld, ast, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) - - ! - ! accumulate fluxes into net flux array for spectral dycores - ! jrm Include latent heat of fusion for snow - ! - do i=1,ncol - tend%flx_net(i) = tend%flx_net(i) + cam_in%shf(i) + (cam_out%precc(i) & - + cam_out%precl(i))*latvap*rhoh2o & - + (cam_out%precsc(i) + cam_out%precsl(i))*latice*rhoh2o - end do - - ! emissions of aerosols and gas-phase chemistry constituents at surface - call chem_emissions( state, cam_in ) - - if (carma_do_emission) then - ! carma emissions - call carma_emission_tend (state, ptend, cam_in, ztodt) - call physics_update(state, ptend, ztodt, tend) - end if - - ! get nstep and zero array for energy checker - zero = 0._r8 - nstep = get_nstep() - call check_tracers_init(state, tracerint) - - ! Check if latent heat flux exceeds the total moisture content of the - ! lowest model layer, thereby creating negative moisture. - - call qneg4('TPHYSAC', lchnk, ncol, ztodt , & - state%q(1,pver,1), state%rpdel(1,pver), & - cam_in%shf, cam_in%lhf, cam_in%cflx) - - call t_stopf('tphysac_init') - !=================================================== - ! Source/sink terms for advected tracers. - !=================================================== - call t_startf('adv_tracer_src_snk') - ! Test tracers - - call aoa_tracers_timestep_tend(state, ptend, cam_in%cflx, cam_in%landfrac, ztodt) - call physics_update(state, ptend, ztodt, tend) - call check_tracers_chng(state, tracerint, "aoa_tracers_timestep_tend", nstep, ztodt, & - cam_in%cflx) - - call co2_cycle_set_ptend(state, pbuf, ptend) - call physics_update(state, ptend, ztodt, tend) - - !=================================================== - ! Chemistry and MAM calculation - ! MAM core aerosol conversion process is performed in the below 'chem_timestep_tend'. - ! In addition, surface flux of aerosol species other than 'dust' and 'sea salt', and - ! elevated emission of aerosol species are treated in 'chem_timestep_tend' before - ! Gas chemistry and MAM core aerosol conversion. - ! Note that surface flux is not added into the atmosphere, but elevated emission is - ! added into the atmosphere as tendency. - !=================================================== - if (chem_is_active()) then - call chem_timestep_tend(state, ptend, cam_in, cam_out, ztodt, & - pbuf, fh2o=fh2o) - - call physics_update(state, ptend, ztodt, tend) - call check_energy_chng(state, tend, "chem", nstep, ztodt, fh2o, zero, zero, zero) - call check_tracers_chng(state, tracerint, "chem_timestep_tend", nstep, ztodt, & - cam_in%cflx) - end if - call t_stopf('adv_tracer_src_snk') - - !=================================================== - ! Vertical diffusion/pbl calculation - ! Call vertical diffusion code (pbl, free atmosphere and molecular) - !=================================================== - - call t_startf('vertical_diffusion_tend') - call vertical_diffusion_tend (ztodt ,state , cam_in, & - surfric ,obklen ,ptend ,ast ,pbuf ) - - !------------------------------------------ - ! Call major diffusion for extended model - !------------------------------------------ - if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then - call waccmx_phys_mspd_tend (ztodt ,state ,ptend) - endif - - call physics_update(state, ptend, ztodt, tend) - - call t_stopf ('vertical_diffusion_tend') - - !=================================================== - ! Rayleigh friction calculation - !=================================================== - call t_startf('rayleigh_friction') - call rayleigh_friction_tend( ztodt, state, ptend) - call physics_update(state, ptend, ztodt, tend) - call t_stopf('rayleigh_friction') - - if (do_clubb_sgs) then - call check_energy_chng(state, tend, "vdiff", nstep, ztodt, zero, zero, zero, zero) - else - call check_energy_chng(state, tend, "vdiff", nstep, ztodt, cam_in%cflx(:,1), zero, & - zero, cam_in%shf) - endif - - call check_tracers_chng(state, tracerint, "vdiff", nstep, ztodt, cam_in%cflx) - - ! aerosol dry deposition processes - call t_startf('aero_drydep') - call aero_model_drydep( state, pbuf, obklen, surfric, cam_in, ztodt, cam_out, ptend ) - call physics_update(state, ptend, ztodt, tend) - call t_stopf('aero_drydep') - - ! CARMA microphysics - ! - ! NOTE: This does both the timestep_tend for CARMA aerosols as well as doing the dry - ! deposition for CARMA aerosols. It needs to follow vertical_diffusion_tend, so that - ! obklen and surfric have been calculated. It needs to follow aero_model_drydep, so - ! 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) - - call check_energy_chng(state, tend, "carma_tend", nstep, ztodt, zero, zero, zero, zero) - call t_stopf('carma_timestep_tend') - end if - - - !--------------------------------------------------------------------------------- - ! ... enforce charge neutrality - !--------------------------------------------------------------------------------- - call charge_balance(state, pbuf) - - !=================================================== - ! Gravity wave drag - !=================================================== - call t_startf('gw_tend') - - call gw_tend(state, pbuf, ztodt, ptend, cam_in, flx_heat) - - call physics_update(state, ptend, ztodt, tend) - ! Check energy integrals - call check_energy_chng(state, tend, "gwdrag", nstep, ztodt, zero, & - zero, zero, flx_heat) - call t_stopf('gw_tend') - - ! QBO relaxation - call qbo_relax(state, pbuf, ptend) - call physics_update(state, ptend, ztodt, tend) - ! Check energy integrals - call check_energy_chng(state, tend, "qborelax", nstep, ztodt, zero, zero, zero, zero) - - ! Ion drag calculation - call t_startf ( 'iondrag' ) - - if ( do_waccm_ions ) then - call iondrag_calc( lchnk, ncol, state, ptend, pbuf, ztodt ) - else - call iondrag_calc( lchnk, ncol, state, ptend) - endif - !---------------------------------------------------------------------------- - ! 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 - - call physics_update(state, ptend, ztodt, tend) - call calc_te_and_aam_budgets(state, 'pAP') - - !--------------------------------------------------------------------------------- - ! Enforce charge neutrality after O+ change from ionos_tend - !--------------------------------------------------------------------------------- - if( waccmx_is('ionosphere') ) then - call charge_balance(state, pbuf) - endif - - ! Check energy integrals - call check_energy_chng(state, tend, "iondrag", nstep, ztodt, zero, zero, zero, zero) - - call t_stopf ( 'iondrag' ) - - ! Update Nudging values, if needed - !---------------------------------- - if((Nudge_Model).and.(Nudge_ON)) then - call nudging_timestep_tend(state,ptend) - call physics_update(state,ptend,ztodt,tend) - call check_energy_chng(state, tend, "nudging", nstep, ztodt, zero, zero, zero, zero) - endif - - !-------------- Energy budget checks vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv - - ! Save total energy for global fixer in next timestep (FV and SE dycores) - call pbuf_set_field(pbuf, teout_idx, state%te_cur, (/1,itim_old/),(/pcols,1/)) - - if (shallow_scheme .eq. 'UNICON') then - - ! ------------------------------------------------------------------------ - ! Insert the organization-related heterogeneities computed inside the - ! UNICON into the tracer arrays here before performing advection. - ! This is necessary to prevent any modifications of organization-related - ! heterogeneities by non convection-advection process, such as - ! dry and wet deposition of aerosols, MAM, etc. - ! Again, note that only UNICON and advection schemes are allowed to - ! changes to organization at this stage, although we can include the - ! effects of other physical processes in future. - ! ------------------------------------------------------------------------ - - call unicon_cam_org_diags(state, pbuf) - - end if - ! - ! FV: convert dry-type mixing ratios to moist here because physics_dme_adjust - ! assumes moist. This is done in p_d_coupling for other dynamics. Bundy, Feb 2004. - if ( dycore_is('LR')) call set_dry_to_wet(state) ! Physics had dry, dynamics wants moist - - ! Scale dry mass and energy (does nothing if dycore is EUL or SLD) - call cnst_get_ind('CLDLIQ', ixcldliq) - call cnst_get_ind('CLDICE', ixcldice) - tmp_q (:ncol,:pver) = state%q(:ncol,:pver,1) - tmp_cldliq(:ncol,:pver) = state%q(:ncol,:pver,ixcldliq) - tmp_cldice(:ncol,:pver) = state%q(:ncol,:pver,ixcldice) - ! For not 'FV', physics_dme_adjust is called for energy diagnostic purposes only. So, save off tracers - if (.not.dycore_is('FV').and.& - (hist_fld_active('SE_pAM').or.hist_fld_active('KE_pAM').or.hist_fld_active('WV_pAM').or.& - hist_fld_active('WL_pAM').or.hist_fld_active('WI_pAM'))) then - tmp_trac(:ncol,:pver,:pcnst) = state%q(:ncol,:pver,:pcnst) - tmp_pdel(:ncol,:pver) = state%pdel(:ncol,:pver) - tmp_ps(:ncol) = state%ps(:ncol) - ! - ! pint, lnpint,rpdel are altered by dme_adjust but not used for tendencies in dynamics of SE - ! we do not reset them to pre-dme_adjust values - ! - if (dycore_is('SE')) call set_dry_to_wet(state) - call physics_dme_adjust(state, tend, qini, ztodt) - call calc_te_and_aam_budgets(state, 'pAM') - ! Restore pre-"physics_dme_adjust" tracers - state%q(:ncol,:pver,:pcnst) = tmp_trac(:ncol,:pver,:pcnst) - state%pdel(:ncol,:pver) = tmp_pdel(:ncol,:pver) - state%ps(:ncol) = tmp_ps(:ncol) - end if - - if (dycore_is('LR')) then - call physics_dme_adjust(state, tend, qini, ztodt) - call calc_te_and_aam_budgets(state, 'pAM') - endif - -!!! REMOVE THIS CALL, SINCE ONLY Q IS BEING ADJUSTED. WON'T BALANCE ENERGY. TE IS SAVED BEFORE THIS -!!! call check_energy_chng(state, tend, "drymass", nstep, ztodt, zero, zero, zero, zero) - - ! store T in buffer for use in computing dynamics T-tendency in next timestep - do k = 1,pver - dtcore(:ncol,k) = state%t(:ncol,k) - end do - - !-------------- Energy budget checks ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ - - if (aqua_planet) then - labort = .false. - do i=1,ncol - if (cam_in%ocnfrac(i) /= 1._r8) labort = .true. - end do - if (labort) then - call endrun ('TPHYSAC error: grid contains non-ocean point') - endif - endif - - call diag_phys_tend_writeout (state, pbuf, tend, ztodt, tmp_q, tmp_cldliq, tmp_cldice, & - qini, cldliqini, cldiceini) - - call clybry_fam_set( ncol, lchnk, map2chm, state%q, pbuf ) - - end subroutine tphysac - - subroutine tphysbc (ztodt, state, & - tend, pbuf, & - cam_out, cam_in ) - !----------------------------------------------------------------------- - ! - ! Purpose: - ! Evaluate and apply physical processes that are calculated BEFORE - ! coupling to land, sea, and ice models. - ! - ! Processes currently included are: - ! - ! o Resetting Negative Tracers to Positive - ! o Global Mean Total Energy Fixer - ! o Dry Adjustment - ! o Asymmetric Turbulence Scheme : Deep Convection & Shallow Convection - ! o Stratiform Macro-Microphysics - ! o Wet Scavenging of Aerosol - ! o Radiation - ! - ! Method: - ! - ! Each parameterization should be implemented with this sequence of calls: - ! 1) Call physics interface - ! 2) Check energy - ! 3) Call physics_update - ! See Interface to Column Physics and Chemistry Packages - ! http://www.ccsm.ucar.edu/models/atm-cam/docs/phys-interface/index.html - ! - !----------------------------------------------------------------------- - - use physics_buffer, only: physics_buffer_desc, pbuf_get_field - use physics_buffer, only: pbuf_get_index, pbuf_old_tim_idx - use physics_buffer, only: col_type_subcol, dyn_time_lvls - use shr_kind_mod, only: r8 => shr_kind_r8 - - use dadadj_cam, only: dadadj_tend - use rk_stratiform, only: rk_stratiform_tend - use microp_driver, only: microp_driver_tend - use microp_aero, only: microp_aero_run - use macrop_driver, only: macrop_driver_tend - use physics_types, only: physics_state, physics_tend, physics_ptend, & - physics_update, physics_ptend_init, physics_ptend_sum, & - physics_state_check, physics_ptend_scale - use cam_diagnostics, only: diag_conv_tend_ini, diag_phys_writeout, diag_conv, diag_export, diag_state_b4_phys_write - use cam_history, only: outfld - use physconst, only: cpair, latvap - use constituents, only: pcnst, qmin, cnst_get_ind - use convect_deep, only: convect_deep_tend, convect_deep_tend_2, deep_scheme_does_scav_trans - use time_manager, only: is_first_step, get_nstep - use convect_shallow, only: convect_shallow_tend - use check_energy, only: check_energy_chng, check_energy_fix, check_energy_timestep_init - use check_energy, only: check_tracers_data, check_tracers_init, check_tracers_chng - use check_energy, only: calc_te_and_aam_budgets - use dycore, only: dycore_is - use aero_model, only: aero_model_wetdep - use carma_intr, only: carma_wetdep_tend, carma_timestep_tend - use carma_flags_mod, only: carma_do_detrain, carma_do_cldice, carma_do_cldliq, carma_do_wetdep - use radiation, only: radiation_tend - use cloud_diagnostics, only: cloud_diagnostics_calc - use perf_mod - use mo_gas_phase_chemdr,only: map2chm - use clybry_fam, only: clybry_fam_adj - use clubb_intr, only: clubb_tend_cam - use sslt_rebin, only: sslt_rebin_adv - use tropopause, only: tropopause_output - use cam_abortutils, only: endrun - use subcol, only: subcol_gen, subcol_ptend_avg - use subcol_utils, only: subcol_ptend_copy, is_subcol_on - use qneg_module, only: qneg3 - - ! Arguments - - real(r8), intent(in) :: ztodt ! 2 delta t (model time increment) - - type(physics_state), intent(inout) :: state - type(physics_tend ), intent(inout) :: tend - type(physics_buffer_desc), pointer :: pbuf(:) - - type(cam_out_t), intent(inout) :: cam_out - type(cam_in_t), intent(in) :: cam_in - - - ! - !---------------------------Local workspace----------------------------- - ! - - type(physics_ptend) :: ptend ! indivdual parameterization tendencies - type(physics_state) :: state_sc ! state for sub-columns - type(physics_ptend) :: ptend_sc ! ptend for sub-columns - type(physics_ptend) :: ptend_aero ! ptend for microp_aero - type(physics_ptend) :: ptend_aero_sc ! ptend for microp_aero on sub-columns - type(physics_tend) :: tend_sc ! tend for sub-columns - - integer :: nstep ! current timestep number - - real(r8) :: net_flx(pcols) - - real(r8) :: zdu(pcols,pver) ! detraining mass flux from deep convection - real(r8) :: cmfmc(pcols,pverp) ! Convective mass flux--m sub c - - real(r8) cmfcme(pcols,pver) ! cmf condensation - evaporation - - real(r8) dlf(pcols,pver) ! Detraining cld H20 from shallow + deep convections - real(r8) dlf2(pcols,pver) ! Detraining cld H20 from shallow convections - real(r8) pflx(pcols,pverp) ! Conv rain flux thru out btm of lev - - integer lchnk ! chunk identifier - integer ncol ! number of atmospheric columns - - integer :: i ! column indicex - integer :: ixcldice, ixcldliq ! constituent indices for cloud liquid and ice water. - ! for macro/micro co-substepping - integer :: macmic_it ! iteration variables - real(r8) :: cld_macmic_ztodt ! modified timestep - ! physics buffer fields to compute tendencies for stratiform package - integer itim_old, ifld - real(r8), pointer, dimension(:,:) :: cld ! cloud fraction - - - ! physics buffer fields for total energy and mass adjustment - real(r8), pointer, dimension(: ) :: teout - real(r8), pointer, dimension(:,:) :: qini - real(r8), pointer, dimension(:,:) :: cldliqini - real(r8), pointer, dimension(:,:) :: cldiceini - real(r8), pointer, dimension(:,:) :: dtcore - - real(r8), pointer, dimension(:,:,:) :: fracis ! fraction of transported species that are insoluble - - real(r8), pointer :: dlfzm(:,:) ! ZM detrained convective cloud water mixing ratio. - - ! convective precipitation variables - real(r8),pointer :: prec_dp(:) ! total precipitation from ZM convection - real(r8),pointer :: snow_dp(:) ! snow from ZM convection - real(r8),pointer :: prec_sh(:) ! total precipitation from Hack convection - real(r8),pointer :: snow_sh(:) ! snow from Hack convection - - ! carma precipitation variables - real(r8) :: prec_sed_carma(pcols) ! total precip from cloud sedimentation (CARMA) - real(r8) :: snow_sed_carma(pcols) ! snow from cloud ice sedimentation (CARMA) - - ! stratiform precipitation variables - real(r8),pointer :: prec_str(:) ! sfc flux of precip from stratiform (m/s) - real(r8),pointer :: snow_str(:) ! sfc flux of snow from stratiform (m/s) - real(r8),pointer :: prec_str_sc(:) ! sfc flux of precip from stratiform (m/s) -- for subcolumns - real(r8),pointer :: snow_str_sc(:) ! sfc flux of snow from stratiform (m/s) -- for subcolumns - real(r8),pointer :: prec_pcw(:) ! total precip from prognostic cloud scheme - real(r8),pointer :: snow_pcw(:) ! snow from prognostic cloud scheme - real(r8),pointer :: prec_sed(:) ! total precip from cloud sedimentation - real(r8),pointer :: snow_sed(:) ! snow from cloud ice sedimentation - - ! Local copies for substepping - real(r8) :: prec_pcw_macmic(pcols) - real(r8) :: snow_pcw_macmic(pcols) - real(r8) :: prec_sed_macmic(pcols) - real(r8) :: snow_sed_macmic(pcols) - - ! energy checking variables - real(r8) :: zero(pcols) ! array of zeros - real(r8) :: zero_sc(pcols*psubcols) ! array of zeros - real(r8) :: rliq(pcols) ! vertical integral of liquid not yet in q(ixcldliq) - real(r8) :: rice(pcols) ! vertical integral of ice not yet in q(ixcldice) - real(r8) :: rliq2(pcols) ! vertical integral of liquid from shallow scheme - real(r8) :: det_s (pcols) ! vertical integral of detrained static energy from ice - real(r8) :: det_ice(pcols) ! vertical integral of detrained ice - real(r8) :: flx_cnd(pcols) - real(r8) :: flx_heat(pcols) - type(check_tracers_data):: tracerint ! energy integrals and cummulative boundary fluxes - real(r8) :: zero_tracers(pcols,pcnst) - - logical :: lq(pcnst) - !----------------------------------------------------------------------- - - call t_startf('bc_init') - - zero = 0._r8 - zero_tracers(:,:) = 0._r8 - zero_sc(:) = 0._r8 - - lchnk = state%lchnk - ncol = state%ncol - - nstep = get_nstep() - - ! Associate pointers with physics buffer fields - itim_old = pbuf_old_tim_idx() - ifld = pbuf_get_index('CLD') - call pbuf_get_field(pbuf, ifld, cld, (/1,1,itim_old/),(/pcols,pver,1/)) - - call pbuf_get_field(pbuf, teout_idx, teout, (/1,itim_old/), (/pcols,1/)) - - call pbuf_get_field(pbuf, qini_idx, qini) - call pbuf_get_field(pbuf, cldliqini_idx, cldliqini) - call pbuf_get_field(pbuf, cldiceini_idx, cldiceini) - - ifld = pbuf_get_index('DTCORE') - call pbuf_get_field(pbuf, ifld, dtcore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) - - ifld = pbuf_get_index('FRACIS') - call pbuf_get_field(pbuf, ifld, fracis, start=(/1,1,1/), kount=(/pcols, pver, pcnst/) ) - fracis (:ncol,:,1:pcnst) = 1._r8 - - ! Set physics tendencies to 0 - tend %dTdt(:ncol,:pver) = 0._r8 - tend %dudt(:ncol,:pver) = 0._r8 - tend %dvdt(:ncol,:pver) = 0._r8 - - ! Verify state coming from the dynamics - if (state_debug_checks) & - call physics_state_check(state, name="before tphysbc (dycore?)") - - call clybry_fam_adj( ncol, lchnk, map2chm, state%q, pbuf ) - - ! Since clybry_fam_adj operates directly on the tracers, and has no - ! physics_update call, re-run qneg3. - - call qneg3('TPHYSBCc',lchnk ,ncol ,pcols ,pver , & - 1, pcnst, qmin ,state%q ) - - ! Validate output of clybry_fam_adj. - if (state_debug_checks) & - call physics_state_check(state, name="clybry_fam_adj") - - ! - ! Dump out "before physics" state - ! - call diag_state_b4_phys_write (state) - - ! compute mass integrals of input tracers state - call check_tracers_init(state, tracerint) - - call t_stopf('bc_init') - - !=================================================== - ! Global mean total energy fixer - !=================================================== - call t_startf('energy_fixer') - - call calc_te_and_aam_budgets(state, 'pBF') - if (dycore_is('LR') .or. dycore_is('SE')) then - call check_energy_fix(state, ptend, nstep, flx_heat) - call physics_update(state, ptend, ztodt, tend) - call check_energy_chng(state, tend, "chkengyfix", nstep, ztodt, zero, zero, zero, flx_heat) - call outfld( 'EFIX', flx_heat , pcols, lchnk ) - end if - call calc_te_and_aam_budgets(state, 'pBP') - ! Save state for convective tendency calculations. - call diag_conv_tend_ini(state, pbuf) - - call cnst_get_ind('CLDLIQ', ixcldliq) - call cnst_get_ind('CLDICE', ixcldice) - qini (:ncol,:pver) = state%q(:ncol,:pver, 1) - cldliqini(:ncol,:pver) = state%q(:ncol,:pver,ixcldliq) - cldiceini(:ncol,:pver) = state%q(:ncol,:pver,ixcldice) - - call outfld('TEOUT', teout , pcols, lchnk ) - call outfld('TEINP', state%te_ini, pcols, lchnk ) - call outfld('TEFIX', state%te_cur, pcols, lchnk ) - - ! T tendency due to dynamics - if( nstep > dyn_time_lvls-1 ) then - dtcore(:ncol,:pver) = (state%t(:ncol,:pver) - dtcore(:ncol,:pver))/ztodt - call outfld( 'DTCORE', dtcore, pcols, lchnk ) - end if - - call t_stopf('energy_fixer') - ! - !=================================================== - ! Dry adjustment - !=================================================== - call t_startf('dry_adjustment') - - call dadadj_tend(ztodt, state, ptend) - - call physics_update(state, ptend, ztodt, tend) - - call t_stopf('dry_adjustment') - - !=================================================== - ! Moist convection - !=================================================== - call t_startf('moist_convection') - - call t_startf ('convect_deep_tend') - - call convect_deep_tend( & - cmfmc, cmfcme, & - pflx, zdu, & - rliq, rice, & - ztodt, & - state, ptend, cam_in%landfrac, pbuf) - - call physics_update(state, ptend, ztodt, tend) - - call t_stopf('convect_deep_tend') - - call pbuf_get_field(pbuf, prec_dp_idx, prec_dp ) - call pbuf_get_field(pbuf, snow_dp_idx, snow_dp ) - call pbuf_get_field(pbuf, prec_sh_idx, prec_sh ) - call pbuf_get_field(pbuf, snow_sh_idx, snow_sh ) - call pbuf_get_field(pbuf, prec_str_idx, prec_str ) - call pbuf_get_field(pbuf, snow_str_idx, snow_str ) - call pbuf_get_field(pbuf, prec_sed_idx, prec_sed ) - call pbuf_get_field(pbuf, snow_sed_idx, snow_sed ) - call pbuf_get_field(pbuf, prec_pcw_idx, prec_pcw ) - call pbuf_get_field(pbuf, snow_pcw_idx, snow_pcw ) - - if (use_subcol_microp) then - call pbuf_get_field(pbuf, prec_str_idx, prec_str_sc, col_type=col_type_subcol) - call pbuf_get_field(pbuf, snow_str_idx, snow_str_sc, col_type=col_type_subcol) - end if - - ! Check energy integrals, including "reserved liquid" - flx_cnd(:ncol) = prec_dp(:ncol) + rliq(:ncol) - snow_dp(:ncol) = snow_dp(:ncol) + rice(:ncol) - call check_energy_chng(state, tend, "convect_deep", nstep, ztodt, zero, flx_cnd, snow_dp, zero) - snow_dp(:ncol) = snow_dp(:ncol) - rice(:ncol) - - ! - ! Call Hack (1994) convection scheme to deal with shallow/mid-level convection - ! - call t_startf ('convect_shallow_tend') - - if (dlfzm_idx > 0) then - call pbuf_get_field(pbuf, dlfzm_idx, dlfzm) - dlf(:ncol,:) = dlfzm(:ncol,:) - else - dlf(:,:) = 0._r8 - end if - - call convect_shallow_tend (ztodt , cmfmc, & - dlf , dlf2 , rliq , rliq2, & - state , ptend , pbuf, cam_in) - call t_stopf ('convect_shallow_tend') - - call physics_update(state, ptend, ztodt, tend) - - flx_cnd(:ncol) = prec_sh(:ncol) + rliq2(:ncol) - call check_energy_chng(state, tend, "convect_shallow", nstep, ztodt, zero, flx_cnd, snow_sh, zero) - - call check_tracers_chng(state, tracerint, "convect_shallow", nstep, ztodt, zero_tracers) - - call t_stopf('moist_convection') - - ! Rebin the 4-bin version of sea salt into bins for coarse and accumulation - ! modes that correspond to the available optics data. This is only necessary - ! for CAM-RT. But it's done here so that the microphysics code which is called - ! from the stratiform interface has access to the same aerosols as the radiation - ! code. - call sslt_rebin_adv(pbuf, state) - - !=================================================== - ! Calculate tendencies from CARMA bin microphysics. - !=================================================== - ! - ! If CARMA is doing detrainment, then on output, rliq no longer represents water reserved - ! for detrainment, but instead represents potential snow fall. The mass and number of the - ! snow are stored in the physics buffer and will be incorporated by the MG microphysics. - ! - ! Currently CARMA cloud microphysics is only supported with the MG microphysics. - call t_startf('carma_timestep_tend') - - if (carma_do_cldice .or. carma_do_cldliq) then - call carma_timestep_tend(state, cam_in, cam_out, ptend, ztodt, pbuf, dlf=dlf, rliq=rliq, & - prec_str=prec_str, snow_str=snow_str, prec_sed=prec_sed_carma, snow_sed=snow_sed_carma) - call physics_update(state, ptend, ztodt, tend) - - ! Before the detrainment, the reserved condensate is all liquid, but if CARMA is doing - ! detrainment, then the reserved condensate is snow. - if (carma_do_detrain) then - call check_energy_chng(state, tend, "carma_tend", nstep, ztodt, zero, prec_str+rliq, snow_str+rliq, zero) - else - call check_energy_chng(state, tend, "carma_tend", nstep, ztodt, zero, prec_str, snow_str, zero) - end if - end if - - call t_stopf('carma_timestep_tend') - - if( microp_scheme == 'RK' ) then - - !=================================================== - ! Calculate stratiform tendency (sedimentation, detrain, cloud fraction and microphysics ) - !=================================================== - call t_startf('rk_stratiform_tend') - - call rk_stratiform_tend(state, ptend, pbuf, ztodt, & - cam_in%icefrac, cam_in%landfrac, cam_in%ocnfrac, & - cam_in%snowhland, & ! sediment - dlf, dlf2, & ! detrain - rliq , & ! check energy after detrain - cmfmc, & - cam_in%ts, cam_in%sst, zdu) - - call physics_update(state, ptend, ztodt, tend) - call check_energy_chng(state, tend, "cldwat_tend", nstep, ztodt, zero, prec_str, snow_str, zero) - - call t_stopf('rk_stratiform_tend') - - elseif( microp_scheme == 'MG' ) then - ! Start co-substepping of macrophysics and microphysics - cld_macmic_ztodt = ztodt/cld_macmic_num_steps - - ! Clear precip fields that should accumulate. - prec_sed_macmic = 0._r8 - snow_sed_macmic = 0._r8 - prec_pcw_macmic = 0._r8 - snow_pcw_macmic = 0._r8 - - do macmic_it = 1, cld_macmic_num_steps - - !=================================================== - ! Calculate macrophysical tendency (sedimentation, detrain, cloud fraction) - !=================================================== - - call t_startf('macrop_tend') - - ! don't call Park macrophysics if CLUBB is called - if (macrop_scheme .ne. 'CLUBB_SGS') then - - call macrop_driver_tend( & - state, ptend, cld_macmic_ztodt, & - cam_in%landfrac, cam_in%ocnfrac, cam_in%snowhland, & ! sediment - dlf, dlf2, & ! detrain - cmfmc, & - cam_in%ts, cam_in%sst, zdu, & - pbuf, det_s, det_ice) - - ! Since we "added" the reserved liquid back in this routine, we need - ! to account for it in the energy checker - flx_cnd(:ncol) = -1._r8*rliq(:ncol) - flx_heat(:ncol) = det_s(:ncol) - - ! Unfortunately, physics_update does not know what time period - ! "tend" is supposed to cover, and therefore can't update it - ! with substeps correctly. For now, work around this by scaling - ! ptend down by the number of substeps, then applying it for - ! the full time (ztodt). - call physics_ptend_scale(ptend, 1._r8/cld_macmic_num_steps, ncol) - call physics_update(state, ptend, ztodt, tend) - call check_energy_chng(state, tend, "macrop_tend", nstep, ztodt, & - zero, flx_cnd(:ncol)/cld_macmic_num_steps, & - det_ice(:ncol)/cld_macmic_num_steps, & - flx_heat(:ncol)/cld_macmic_num_steps) - - else ! Calculate CLUBB macrophysics - - ! ===================================================== - ! CLUBB call (PBL, shallow convection, macrophysics) - ! ===================================================== - - call clubb_tend_cam(state, ptend, pbuf, cld_macmic_ztodt,& - cmfmc, cam_in, macmic_it, cld_macmic_num_steps, & - dlf, det_s, det_ice) - - ! Since we "added" the reserved liquid back in this routine, we need - ! to account for it in the energy checker - flx_cnd(:ncol) = -1._r8*rliq(:ncol) - flx_heat(:ncol) = cam_in%shf(:ncol) + det_s(:ncol) - - ! Unfortunately, physics_update does not know what time period - ! "tend" is supposed to cover, and therefore can't update it - ! with substeps correctly. For now, work around this by scaling - ! ptend down by the number of substeps, then applying it for - ! the full time (ztodt). - call physics_ptend_scale(ptend, 1._r8/cld_macmic_num_steps, ncol) - - ! Update physics tendencies and copy state to state_eq, because that is - ! input for microphysics - call physics_update(state, ptend, ztodt, tend) - - ! Use actual qflux (not lhf/latvap) for consistency with surface fluxes and revised code - call check_energy_chng(state, tend, "clubb_tend", nstep, ztodt, & - cam_in%cflx(:ncol,1)/cld_macmic_num_steps, & - flx_cnd(:ncol)/cld_macmic_num_steps, & - det_ice(:ncol)/cld_macmic_num_steps, & - flx_heat(:ncol)/cld_macmic_num_steps) - - endif - - call t_stopf('macrop_tend') - - !=================================================== - ! Calculate cloud microphysics - !=================================================== - - if (is_subcol_on()) then - ! Allocate sub-column structures. - call physics_state_alloc(state_sc, lchnk, psubcols*pcols) - call physics_tend_alloc(tend_sc, psubcols*pcols) - - ! Generate sub-columns using the requested scheme - call subcol_gen(state, tend, state_sc, tend_sc, pbuf) - - !Initialize check energy for subcolumns - call check_energy_timestep_init(state_sc, tend_sc, pbuf, col_type_subcol) - end if - - call t_startf('microp_aero_run') - call microp_aero_run(state, ptend_aero, cld_macmic_ztodt, pbuf) - call t_stopf('microp_aero_run') - - call t_startf('microp_tend') - - if (use_subcol_microp) then - call microp_driver_tend(state_sc, ptend_sc, cld_macmic_ztodt, pbuf) - - ! Average the sub-column ptend for use in gridded update - will not contain ptend_aero - call subcol_ptend_avg(ptend_sc, state_sc%ngrdcol, lchnk, ptend) - - ! Copy ptend_aero field to one dimensioned by sub-columns before summing with ptend - call subcol_ptend_copy(ptend_aero, state_sc, ptend_aero_sc) - call physics_ptend_sum(ptend_aero_sc, ptend_sc, state_sc%ncol) - call physics_ptend_dealloc(ptend_aero_sc) - - ! Have to scale and apply for full timestep to get tend right - ! (see above note for macrophysics). - call physics_ptend_scale(ptend_sc, 1._r8/cld_macmic_num_steps, ncol) - - call physics_update (state_sc, ptend_sc, ztodt, tend_sc) - call check_energy_chng(state_sc, tend_sc, "microp_tend_subcol", & - nstep, ztodt, zero_sc, & - prec_str_sc(:state_sc%ncol)/cld_macmic_num_steps, & - snow_str_sc(:state_sc%ncol)/cld_macmic_num_steps, zero_sc) - - call physics_state_dealloc(state_sc) - call physics_tend_dealloc(tend_sc) - call physics_ptend_dealloc(ptend_sc) - else - call microp_driver_tend(state, ptend, cld_macmic_ztodt, pbuf) - end if - ! combine aero and micro tendencies for the grid - call physics_ptend_sum(ptend_aero, ptend, ncol) - call physics_ptend_dealloc(ptend_aero) - - ! Have to scale and apply for full timestep to get tend right - ! (see above note for macrophysics). - call physics_ptend_scale(ptend, 1._r8/cld_macmic_num_steps, ncol) - - call physics_update (state, ptend, ztodt, tend) - call check_energy_chng(state, tend, "microp_tend", nstep, ztodt, & - zero, prec_str(:ncol)/cld_macmic_num_steps, & - snow_str(:ncol)/cld_macmic_num_steps, zero) - - call t_stopf('microp_tend') - prec_sed_macmic(:ncol) = prec_sed_macmic(:ncol) + prec_sed(:ncol) - snow_sed_macmic(:ncol) = snow_sed_macmic(:ncol) + snow_sed(:ncol) - prec_pcw_macmic(:ncol) = prec_pcw_macmic(:ncol) + prec_pcw(:ncol) - snow_pcw_macmic(:ncol) = snow_pcw_macmic(:ncol) + snow_pcw(:ncol) - - end do ! end substepping over macrophysics/microphysics - - prec_sed(:ncol) = prec_sed_macmic(:ncol)/cld_macmic_num_steps - snow_sed(:ncol) = snow_sed_macmic(:ncol)/cld_macmic_num_steps - prec_pcw(:ncol) = prec_pcw_macmic(:ncol)/cld_macmic_num_steps - snow_pcw(:ncol) = snow_pcw_macmic(:ncol)/cld_macmic_num_steps - prec_str(:ncol) = prec_pcw(:ncol) + prec_sed(:ncol) - snow_str(:ncol) = snow_pcw(:ncol) + snow_sed(:ncol) - - endif - - ! Add the precipitation from CARMA to the precipitation from stratiform. - if (carma_do_cldice .or. carma_do_cldliq) then - prec_sed(:ncol) = prec_sed(:ncol) + prec_sed_carma(:ncol) - snow_sed(:ncol) = snow_sed(:ncol) + snow_sed_carma(:ncol) - end if - - if ( .not. deep_scheme_does_scav_trans() ) then - - ! ------------------------------------------------------------------------------- - ! 1. Wet Scavenging of Aerosols by Convective and Stratiform Precipitation. - ! 2. Convective Transport of Non-Water Aerosol Species. - ! - ! . Aerosol wet chemistry determines scavenging fractions, and transformations - ! . Then do convective transport of all trace species except qv,ql,qi. - ! . We needed to do the scavenging first to determine the interstitial fraction. - ! . When UNICON is used as unified convection, we should still perform - ! wet scavenging but not 'convect_deep_tend2'. - ! ------------------------------------------------------------------------------- - - call t_startf('bc_aerosols') - if (clim_modal_aero .and. .not. prog_modal_aero) then - call modal_aero_calcsize_diag(state, pbuf) - call modal_aero_wateruptake_dr(state, pbuf) - endif - call aero_model_wetdep( state, ztodt, dlf, cam_out, ptend, pbuf) - call physics_update(state, ptend, ztodt, tend) - - - if (carma_do_wetdep) then - ! CARMA wet deposition - ! - ! NOTE: It needs to follow aero_model_wetdep, so that cam_out%xxxwetxxx - ! fields have already been set for CAM aerosols and cam_out can be added - ! to for CARMA aerosols. - call t_startf ('carma_wetdep_tend') - call carma_wetdep_tend(state, ptend, ztodt, pbuf, dlf, cam_out) - call physics_update(state, ptend, ztodt, tend) - call t_stopf ('carma_wetdep_tend') - end if - - call t_startf ('convect_deep_tend2') - call convect_deep_tend_2( state, ptend, ztodt, pbuf ) - call physics_update(state, ptend, ztodt, tend) - call t_stopf ('convect_deep_tend2') - - ! check tracer integrals - call check_tracers_chng(state, tracerint, "cmfmca", nstep, ztodt, zero_tracers) - - call t_stopf('bc_aerosols') - - endif - - !=================================================== - ! Moist physical parameteriztions complete: - ! send dynamical variables, and derived variables to history file - !=================================================== - - call t_startf('bc_history_write') - call diag_phys_writeout(state, pbuf) - call diag_conv(state, ztodt, pbuf) - - call t_stopf('bc_history_write') - - !=================================================== - ! Write cloud diagnostics on history file - !=================================================== - - call t_startf('bc_cld_diag_history_write') - - call cloud_diagnostics_calc(state, pbuf) - - call t_stopf('bc_cld_diag_history_write') - - !=================================================== - ! Radiation computations - !=================================================== - call t_startf('radiation') - - - call radiation_tend( & - state, ptend, pbuf, cam_out, cam_in, net_flx) - - ! Set net flux used by spectral dycores - do i=1,ncol - tend%flx_net(i) = net_flx(i) - end do - call physics_update(state, ptend, ztodt, tend) - call check_energy_chng(state, tend, "radheat", nstep, ztodt, zero, zero, zero, net_flx) - - call t_stopf('radiation') - - ! Diagnose the location of the tropopause and its location to the history file(s). - call t_startf('tropopause') - call tropopause_output(state) - call t_stopf('tropopause') - - ! Save atmospheric fields to force surface models - call t_startf('cam_export') - call cam_export (state,cam_out,pbuf) - call t_stopf('cam_export') - - ! Write export state to history file - call t_startf('diag_export') - call diag_export(cam_out) - call t_stopf('diag_export') - - end subroutine tphysbc - -subroutine phys_timestep_init(phys_state, cam_in, cam_out, pbuf2d) -!----------------------------------------------------------------------------------- -! -! Purpose: The place for parameterizations to call per timestep initializations. -! Generally this is used to update time interpolated fields from boundary -! datasets. -! -!----------------------------------------------------------------------------------- - use shr_kind_mod, only: r8 => shr_kind_r8 - use chemistry, only: chem_timestep_init - use chem_surfvals, only: chem_surfvals_set - use physics_types, only: physics_state - use physics_buffer, only: physics_buffer_desc - use carma_intr, only: carma_timestep_init - use ghg_data, only: ghg_data_timestep_init - use cam3_aero_data, only: cam3_aero_data_on, cam3_aero_data_timestep_init - use cam3_ozone_data, only: cam3_ozone_data_on, cam3_ozone_data_timestep_init - use aoa_tracers, only: aoa_tracers_timestep_init - use vertical_diffusion, only: vertical_diffusion_ts_init - use radheat, only: radheat_timestep_init - use solar_data, only: solar_data_advance - use qbo, only: qbo_timestep_init - use iondrag, only: do_waccm_ions, iondrag_timestep_init - use perf_mod - - use prescribed_ozone, only: prescribed_ozone_adv - use prescribed_ghg, only: prescribed_ghg_adv - use prescribed_aero, only: prescribed_aero_adv - use aerodep_flx, only: aerodep_flx_adv - use aircraft_emit, only: aircraft_emit_adv - use prescribed_volcaero, only: prescribed_volcaero_adv - use prescribed_strataero,only: prescribed_strataero_adv - use mo_apex, only: mo_apex_init - use epp_ionization, only: epp_ionization_active - use iop_forcing, only: scam_use_iop_srf - use nudging, only: Nudge_Model, nudging_timestep_init - - implicit none - - type(physics_state), intent(inout), dimension(begchunk:endchunk) :: phys_state - type(cam_in_t), intent(inout), dimension(begchunk:endchunk) :: cam_in - type(cam_out_t), intent(inout), dimension(begchunk:endchunk) :: cam_out - - type(physics_buffer_desc), pointer :: pbuf2d(:,:) - - !----------------------------------------------------------------------------- - - if (single_column) call scam_use_iop_srf(cam_in) - - ! update geomagnetic coordinates - if (epp_ionization_active .or. do_waccm_ions) then - call mo_apex_init(phys_state) - endif - - ! Chemistry surface values - call chem_surfvals_set() - - ! Solar irradiance - call solar_data_advance() - - ! Time interpolate for chemistry. - call chem_timestep_init(phys_state, pbuf2d) - - ! Prescribed tracers - call prescribed_ozone_adv(phys_state, pbuf2d) - call prescribed_ghg_adv(phys_state, pbuf2d) - call prescribed_aero_adv(phys_state, pbuf2d) - call aircraft_emit_adv(phys_state, pbuf2d) - call prescribed_volcaero_adv(phys_state, pbuf2d) - call prescribed_strataero_adv(phys_state, pbuf2d) - - ! prescribed aerosol deposition fluxes - call aerodep_flx_adv(phys_state, pbuf2d, cam_out) - - ! CAM3 prescribed aerosol masses - if (cam3_aero_data_on) call cam3_aero_data_timestep_init(pbuf2d, phys_state) - - ! CAM3 prescribed ozone data - if (cam3_ozone_data_on) call cam3_ozone_data_timestep_init(pbuf2d, phys_state) - - ! Time interpolate data models of gasses in pbuf2d - call ghg_data_timestep_init(pbuf2d, phys_state) - - ! Upper atmosphere radiative processes - call radheat_timestep_init(phys_state, pbuf2d) - - ! Time interpolate for vertical diffusion upper boundary condition - call vertical_diffusion_ts_init(pbuf2d, phys_state) - - !---------------------------------------------------------------------- - ! update QBO data for this time step - !---------------------------------------------------------------------- - call qbo_timestep_init - - call iondrag_timestep_init() - - call carma_timestep_init() - - ! age of air tracers - call aoa_tracers_timestep_init(phys_state) - - ! Update Nudging values, if needed - !---------------------------------- - if(Nudge_Model) call nudging_timestep_init(phys_state) - -end subroutine phys_timestep_init - -end module physpkg diff --git a/src/physics/camrt/radiation.F90.orig b/src/physics/camrt/radiation.F90.orig deleted file mode 100644 index 1ca1e074de..0000000000 --- a/src/physics/camrt/radiation.F90.orig +++ /dev/null @@ -1,1339 +0,0 @@ -module radiation - -!--------------------------------------------------------------------------------- -! -! CAM interface to the legacy 'camrt' radiation code -! -!--------------------------------------------------------------------------------- - -use shr_kind_mod, only: r8=>shr_kind_r8, cl=>shr_kind_cl -use spmd_utils, only: masterproc -use ppgrid, only: pcols, pver, pverp, begchunk, endchunk -use physics_types, only: physics_state, physics_ptend -use phys_grid, only: get_ncols_p -use camsrfexch, only: cam_out_t, cam_in_t -use physconst, only: cpair, cappa -use time_manager, only: get_nstep, is_first_restart_step, & - get_curr_calday, get_step_size -use cam_control_mod, only: lambm0, obliqr, mvelpp, eccen - -use radae, only: abstot_3d, absnxt_3d, emstot_3d, initialize_radbuffer, ntoplw - -use scamMod, only: scm_crm_mode, single_column,have_cld,cldobs,& - have_clwp,clwpobs,have_tg,tground - -use cam_grid_support, only: cam_grid_write_attr, cam_grid_id, & - cam_grid_header_info_t, cam_grid_dimensions, & - cam_grid_write_dist_array, cam_grid_read_dist_array - -use cam_history, only: outfld, hist_fld_active -use cam_history_support, only: fillvalue - -use cam_pio_utils, only: cam_pio_def_dim - -use pio, only: file_desc_t, var_desc_t, & - pio_double, pio_int, pio_noerr, & - pio_seterrorhandling, pio_bcast_error, & - pio_inq_varid, & - pio_def_var, pio_def_dim, & - pio_put_var, pio_get_var - -use cam_abortutils, only: endrun -use error_messages, only: handle_err -use perf_mod, only: t_startf, t_stopf -use cam_logfile, only: iulog - -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, &! - radiation_write_restart, &! - radiation_read_restart, &! - radiation_tend, &! compute heating rates and fluxes - rad_out_t ! type for diagnostic outputs - -type rad_out_t - real(r8) :: solin(pcols) ! Solar incident flux - real(r8) :: fsntoa(pcols) ! Net solar flux at TOA - real(r8) :: fsutoa(pcols) ! upwelling solar flux at TOA - real(r8) :: fsntoac(pcols) ! Clear sky net 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) :: fsntc(pcols) ! Clear sky total column abs solar flux - real(r8) :: fsnsc(pcols) ! Clear sky surface abs solar flux - real(r8) :: fsdsc(pcols) ! Clear sky surface downwelling solar flux - real(r8) :: flut(pcols) ! Upward flux at top of model - real(r8) :: flutc(pcols) ! Upward Clear Sky flux at top of model - real(r8) :: flntc(pcols) ! Clear sky lw flux at model top - 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) :: flwds(pcols) ! Down longwave flux at surface - real(r8) :: fsnr(pcols) - real(r8) :: flnr(pcols) - real(r8) :: fsds(pcols) ! Surface solar down flux - 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) :: fsn200(pcols) ! fns interpolated to 200 mb - real(r8) :: fsn200c(pcols) ! fcns interpolated to 200 mb - real(r8) :: sols(pcols) ! Solar downward visible direct to surface - real(r8) :: soll(pcols) ! Solar downward near infrared direct to surface - real(r8) :: solsd(pcols) ! Solar downward visible diffuse to surface - real(r8) :: solld(pcols) ! Solar downward near infrared diffuse to surface - real(r8) :: qrsc(pcols,pver) ! clearsky shortwave radiative heating rate - real(r8) :: qrlc(pcols,pver) ! clearsky longwave radiative heating rate - real(r8) :: fsdtoa(pcols) ! Solar input = Flux Solar Downward Top of Atmosphere - real(r8) :: swcf(pcols) ! shortwave cloud forcing - real(r8) :: lwcf(pcols) ! longwave cloud forcing - - real(r8) :: tot_cld_vistau(pcols,pver) - real(r8) :: tot_icld_vistau(pcols,pver) - 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) -end type rad_out_t - -! Namelist variables - -character(len=cl) :: absems_data -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 :: iradae = -12 ! frequency of absorp/emis 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 zenith angle averaged over - ! interval between radiation calculations - -! Physics buffer indices -integer :: qrs_idx = 0 -integer :: qrl_idx = 0 -integer :: fsds_idx = 0 -integer :: fsns_idx = 0 -integer :: fsnt_idx = 0 -integer :: flns_idx = 0 -integer :: flnt_idx = 0 -integer :: cld_idx = 0 -integer :: rel_idx = 0 -integer :: rei_idx = 0 -integer :: cicewp_idx = -1 -integer :: cliqwp_idx = -1 -integer :: cldemis_idx = -1 -integer :: cldtau_idx = -1 -integer :: nmxrgn_idx = -1 -integer :: pmxrgn_idx = -1 - -! averaging time interval for zenith angle -real(r8) :: dt_avg = 0._r8 - -real(r8), parameter :: cgs2mks = 1.e-3_r8 - -! PIO descriptors (for restarts) - -type(var_desc_t), allocatable :: abstot_desc(:) -type(var_desc_t) :: emstot_desc, absnxt_desc(4) - -!=============================================================================== -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 :: sub = 'radiation_readnl' - - namelist /radiation_nl/ absems_data, iradsw, iradlw, iradae, irad_always, & - use_rad_dt_cosz - !----------------------------------------------------------------------------- - - 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(sub // ':: ERROR reading namelist') - end if - end if - close(unitn) - call freeunit(unitn) - end if - - ! Broadcast namelist variables - call mpi_bcast(absems_data, len(absems_data), mpi_character, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: absems_data") - call mpi_bcast(iradsw, 1, mpi_integer, mstrid, mpicom, ierr) - 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(sub//": FATAL: mpi_bcast: iradlw") - call mpi_bcast(iradae, 1, mpi_integer, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: iradae") - call mpi_bcast(irad_always, 1, mpi_integer, mstrid, mpicom, ierr) - 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(sub//": FATAL: mpi_bcast: use_rad_dt_cosz") - - ! 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) - - ! Convert iradae from hours to timesteps if necessary and check that - ! iradae must be an even multiple of iradlw - if (iradae < 0) iradae = nint((-iradae*3600._r8)/dtime) - if (mod(iradae,iradlw)/=0) then - write(iulog,*) sub//': iradae must be an even multiple of iradlw.' - write(iulog,*)' iradae = ',iradae,', iradlw = ',iradlw - call endrun(sub//': iradae must be an even multiple of iradlw.') - end if - - !----------------------------------------------------------------------- - ! Print runtime options to log. - !----------------------------------------------------------------------- - - if (masterproc) then - write(iulog,*) 'CAMRT radiation scheme parameters:' - write(iulog,10) iradsw, iradlw, iradae, irad_always, use_rad_dt_cosz - write(iulog,*) ' Abs/Emis dataset: ', trim(absems_data) - end if - -10 format(' Frequency (timesteps) of Shortwave Radiation calc: ',i5/, & - ' Frequency (timesteps) of Longwave Radiation calc: ',i5/, & - ' Frequency (timesteps) of Absorptivity/Emissivity calc:',i5/, & - ' SW/LW calc done every timestep for first N steps. N= ',i5/, & - ' Use average zenith angle: ',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 - - call rad_data_register() - -end subroutine radiation_register - -!================================================================================================ - -function radiation_do(op, timestep) - - ! Returns 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 ('absems') ! do an absorptivity/emissivity calculation this timestep? - radiation_do = nstep == 0 .or. iradae == 1 & - .or. (mod(nstep-1,iradae) == 0 .and. nstep /= 1) - - case ('aeres') ! write absorptivity/emissivity to restart file this timestep? - radiation_do = mod(nstep,iradae) /= 0 - - case default - call endrun('radiation_do: unknown operation:'//op) - - end select -end function radiation_do - -!================================================================================================ - -real(r8) function radiation_nextsw_cday() - - ! Returns 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 - !----------------------------------------------------------------------- - - 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 - -end function radiation_nextsw_cday - -!================================================================================================ - -subroutine radiation_init(pbuf2d) - - ! Initialize the radiation parameterization, add fields to the history buffer - - use cam_history, only: addfld, add_default, horiz_only - use physconst, only: gravit, cpair, epsilo, stebol, & - pstd, mwdry, mwco2, mwo3 - - use physics_buffer, only: physics_buffer_desc, pbuf_get_index - use radsw, only: radsw_init - use radlw, only: radlw_init - use radae, only: radae_init - use radconstants, only: radconstants_init - use rad_solar_var, only: rad_solar_var_init - use radiation_data, only: rad_data_init - use phys_control, only: phys_getopts - use time_manager, only: get_step_size - - ! args - type(physics_buffer_desc), pointer :: pbuf2d(:,:) - - - ! Local variables - 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 :: dtime - !----------------------------------------------------------------------- - - call radconstants_init() - call rad_solar_var_init() - - call radsw_init(gravit) - call radlw_init(gravit, stebol) - call radae_init( & - gravit, epsilo, stebol, pstd, mwdry, & - mwco2, mwo3, absems_data) - - call rad_data_init(pbuf2d) - - ! 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 = real(iradsw*dtime, r8) - end if - - ! Get physics buffer indices - cld_idx = pbuf_get_index('CLD') - rel_idx = pbuf_get_index('REL') - rei_idx = pbuf_get_index('REI') - - ! "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() - irad_always = irad_always + nstep - end if - - ! Shortwave radiation - call addfld ('SOLIN', horiz_only, 'A','W/m2','Solar insolation', sampling_seq='rad_lwsw') - call addfld ('SOLL', horiz_only, 'A','W/m2','Solar downward near infrared direct to surface', & - sampling_seq='rad_lwsw') - call addfld ('SOLS', horiz_only, 'A','W/m2','Solar downward visible direct to surface', sampling_seq='rad_lwsw') - call addfld ('SOLLD', horiz_only, 'A','W/m2','Solar downward near infrared diffuse to surface', & - sampling_seq='rad_lwsw') - call addfld ('SOLSD', horiz_only, 'A','W/m2','Solar downward visible diffuse to surface', sampling_seq='rad_lwsw') - call addfld ('QRS', (/ 'lev' /), 'A','K/s', 'Solar heating rate', sampling_seq='rad_lwsw') - call addfld ('QRSC', (/ 'lev' /), 'A','K/s', 'Clearsky solar heating rate', sampling_seq='rad_lwsw') - call addfld ('FSNS', horiz_only, 'A','W/m2','Net solar flux at surface', sampling_seq='rad_lwsw') - call addfld ('FSNT', horiz_only, 'A','W/m2','Net solar flux at top of model', sampling_seq='rad_lwsw') - call addfld ('FSNTOA', horiz_only, 'A','W/m2','Net solar flux at top of atmosphere', sampling_seq='rad_lwsw') - call addfld ('FSUTOA', horiz_only, 'A','W/m2','Upwelling solar flux at top of atmosphere', sampling_seq='rad_lwsw') - call addfld ('FSNTOAC', horiz_only, 'A','W/m2','Clearsky net solar flux at top of atmosphere', & - sampling_seq='rad_lwsw') - call addfld ('FSDTOA', horiz_only, 'A','W/m2','Downwelling solar flux at top of atmosphere', sampling_seq='rad_lwsw') - call addfld ('FSN200', horiz_only, 'A','W/m2','Net shortwave flux at 200 mb', sampling_seq='rad_lwsw') - call addfld ('FSN200C', horiz_only, 'A','W/m2','Clearsky net shortwave flux at 200 mb', sampling_seq='rad_lwsw') - call addfld ('FSNTC', horiz_only, 'A','W/m2','Clearsky net solar flux at top of model', sampling_seq='rad_lwsw') - call addfld ('FSNSC', horiz_only, 'A','W/m2','Clearsky net solar flux at surface', sampling_seq='rad_lwsw') - call addfld ('FSDSC', horiz_only, 'A','W/m2','Clearsky downwelling solar flux at surface', & - sampling_seq='rad_lwsw') - call addfld ('FSDS', horiz_only, 'A','W/m2','Downwelling solar flux at surface', sampling_seq='rad_lwsw') - call addfld ('FUS', (/ 'ilev' /), 'I','W/m2','Shortwave upward flux') - call addfld ('FDS', (/ 'ilev' /), 'I','W/m2','Shortwave downward flux') - call addfld ('FUSC', (/ 'ilev' /), 'I','W/m2','Shortwave clear-sky upward flux') - call addfld ('FDSC', (/ 'ilev' /), 'I','W/m2','Shortwave clear-sky downward flux') - call addfld ('FSNIRTOA', horiz_only, 'A','W/m2','Net near-infrared flux (Nimbus-7 WFOV) at top of atmosphere', & - sampling_seq='rad_lwsw') - call addfld ('FSNRTOAC', horiz_only, 'A','W/m2', & - 'Clearsky net near-infrared flux (Nimbus-7 WFOV) at top of atmosphere', sampling_seq='rad_lwsw') - call addfld ('FSNRTOAS', horiz_only, 'A','W/m2','Net near-infrared flux (>= 0.7 microns) at top of atmosphere', & - sampling_seq='rad_lwsw') - call addfld ('FSNR', horiz_only, 'A','W/m2','Net solar flux at tropopause', sampling_seq='rad_lwsw') - call addfld ('SWCF', horiz_only, 'A','W/m2','Shortwave cloud forcing', sampling_seq='rad_lwsw') - - call addfld ('TOT_CLD_VISTAU', (/ 'lev' /), 'A','1', 'Total gbx cloud visible sw optical depth', & - sampling_seq='rad_lwsw',flag_xyfill=.true.) - call addfld ('TOT_ICLD_VISTAU', (/ 'lev' /), 'A','1', 'Total in-cloud visible sw optical depth', & - sampling_seq='rad_lwsw',flag_xyfill=.true.) - call addfld ('LIQ_ICLD_VISTAU', (/ 'lev' /), 'A','1', 'Liquid in-cloud visible sw optical depth', & - sampling_seq='rad_lwsw',flag_xyfill=.true.) - call addfld ('ICE_ICLD_VISTAU', (/ 'lev' /), 'A','1', 'Ice in-cloud visible sw optical depth', & - sampling_seq='rad_lwsw',flag_xyfill=.true.) - - ! Longwave radiation - call addfld ('QRL', (/ 'lev' /), 'A','K/s', 'Longwave heating rate', sampling_seq='rad_lwsw') - call addfld ('QRLC', (/ 'lev' /), 'A','K/s', 'Clearsky longwave heating rate', sampling_seq='rad_lwsw') - call addfld ('FLNS', horiz_only, 'A','W/m2','Net longwave flux at surface', sampling_seq='rad_lwsw') - call addfld ('FLDS', horiz_only, 'A','W/m2','Downwelling longwave flux at surface', sampling_seq='rad_lwsw') - call addfld ('FLNT', horiz_only, 'A','W/m2','Net longwave flux at top of model', sampling_seq='rad_lwsw') - call addfld ('FLUT', horiz_only, 'A','W/m2','Upwelling longwave flux at top of model', sampling_seq='rad_lwsw') - call addfld ('FLUTC', horiz_only, 'A','W/m2','Clearsky upwelling longwave flux at top of model', & - sampling_seq='rad_lwsw') - call addfld ('FLNTC', horiz_only, 'A','W/m2','Clearsky net longwave flux at top of model', sampling_seq='rad_lwsw') - call addfld ('FLN200', horiz_only, 'A','W/m2','Net longwave flux at 200 mb', sampling_seq='rad_lwsw') - call addfld ('FLN200C', horiz_only, 'A','W/m2','Clearsky net longwave flux at 200 mb', sampling_seq='rad_lwsw') - call addfld ('FLNR', horiz_only, 'A','W/m2','Net longwave flux at tropopause', sampling_seq='rad_lwsw') - call addfld ('FLNSC', horiz_only, 'A','W/m2','Clearsky net longwave flux at surface', sampling_seq='rad_lwsw') - call addfld ('FLDSC', horiz_only, 'A','W/m2','Clearsky downwelling longwave flux at surface', & - sampling_seq='rad_lwsw') - call addfld ('LWCF', horiz_only, 'A','W/m2','Longwave cloud forcing', sampling_seq='rad_lwsw') - call addfld ('FUL', (/ 'ilev' /), 'I','W/m2','Longwave upward flux') - call addfld ('FDL', (/ 'ilev' /), 'I','W/m2','Longwave downward flux') - call addfld ('FULC', (/ 'ilev' /), 'I','W/m2','Longwave clear-sky upward flux') - call addfld ('FDLC', (/ 'ilev' /), 'I','W/m2','Longwave clear-sky downward flux') - - ! Heating rate needed for d(theta)/dt computation - call addfld ('HR', (/ 'lev' /), 'A','K/s', 'Heating rate needed for d(theta)/dt computation') - - ! determine default variables - 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) - - if (history_amwg) then - ! Shortwave variables - call add_default ('SOLIN ', 1, ' ') - call add_default ('QRS ', 1, ' ') - call add_default ('FSNS ', 1, ' ') - call add_default ('FSNT ', 1, ' ') - call add_default ('FSDTOA ', 1, ' ') - call add_default ('FSNTOA ', 1, ' ') - call add_default ('FSUTOA ', 1, ' ') - call add_default ('FSNTOAC ', 1, ' ') - call add_default ('FSNTC ', 1, ' ') - call add_default ('FSNSC ', 1, ' ') - call add_default ('FSDSC ', 1, ' ') - call add_default ('FSDS ', 1, ' ') - call add_default ('SWCF ', 1, ' ') - ! Longwave variables - call add_default ('QRL ', 1, ' ') - call add_default ('FLNS ', 1, ' ') - call add_default ('FLDS ', 1, ' ') - call add_default ('FLNT ', 1, ' ') - call add_default ('FLUT ', 1, ' ') - call add_default ('FLUTC ', 1, ' ') - call add_default ('FLNTC ', 1, ' ') - call add_default ('FLNSC ', 1, ' ') - call add_default ('FLDSC ', 1, ' ') - call add_default ('LWCF ', 1, ' ') - endif - if (single_column.and.scm_crm_mode) then - ! Shortwave variables - call add_default ('FUS ', 1, ' ') - call add_default ('FUSC ', 1, ' ') - call add_default ('FDS ', 1, ' ') - call add_default ('FDSC ', 1, ' ') - ! Longwave variables - call add_default ('FUL ', 1, ' ') - call add_default ('FULC ', 1, ' ') - call add_default ('FDL ', 1, ' ') - call add_default ('FDLC ', 1, ' ') - endif - - 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 - - cicewp_idx = pbuf_get_index('CICEWP') - cliqwp_idx = pbuf_get_index('CLIQWP') - cldemis_idx= pbuf_get_index('CLDEMIS') - cldtau_idx = pbuf_get_index('CLDTAU') - nmxrgn_idx = pbuf_get_index('NMXRGN') - pmxrgn_idx = pbuf_get_index('PMXRGN') - -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 :: i, ierr - integer :: grid_id - integer :: hdimcnt - integer :: pver_id, pverp_id - integer :: vsize - integer :: dimids(4) - - type(cam_grid_header_info_t) :: info - - character(len=16) :: pname - !---------------------------------------------------------------------------- - - call pio_seterrorhandling(File, PIO_BCAST_ERROR) - - if (radiation_do('aeres')) then - - grid_id = cam_grid_id('physgrid') - call cam_grid_write_attr(File, grid_id, info) - hdimcnt = info%num_hdims() - do i = 1, hdimcnt - dimids(i) = info%get_hdimid(i) - end do - - call cam_pio_def_dim(File, 'lev', pver, pver_id, existOK=.true.) - call cam_pio_def_dim(File, 'ilev', pverp, pverp_id, existOK=.true.) - - vsize = pverp - ntoplw + 1 - if (vsize /= pverp) then - ierr = pio_def_dim(File, 'lwcols', vsize, dimids(hdimcnt+1)) - else - dimids(hdimcnt+1) = pverp_id - end if - - ! split into vsize variables to avoid excessive memory usage in IO - - allocate(abstot_desc(ntoplw:pverp)) - - do i = ntoplw, pverp - write(pname,'(a,i3.3)') 'NAL_absorp', i - ierr = pio_def_var(File, trim(pname), pio_double, dimids(1:hdimcnt+1), abstot_desc(i)) - end do - - dimids(hdimcnt+1) = pverp_id - ierr = pio_def_var(File, 'Emissivity', pio_double, dimids(1:hdimcnt+1), emstot_desc) - - dimids(hdimcnt+1) = pver_id - do i=1,4 - write(pname,'(a,i3.3)') 'NN_absorp',i - ierr = pio_def_var(File, pname, pio_double, dimids(1:hdimcnt+1), absnxt_desc(i)) - end do - - 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 :: i, ierr - integer :: physgrid - integer :: dims(3), gdims(3) - integer :: nhdims - integer :: ncol - !---------------------------------------------------------------------------- - - if ( radiation_do('aeres') ) then - - physgrid = cam_grid_id('physgrid') - call cam_grid_dimensions(physgrid, gdims(1:2), nhdims) - - do i = begchunk, endchunk - ncol = get_ncols_p(i) - if (ncol < pcols) then - abstot_3d(ncol+1:pcols,:,:,i) = fillvalue - absnxt_3d(ncol+1:pcols,:,:,i) = fillvalue - emstot_3d(ncol+1:pcols,:,i) = fillvalue - end if - end do - - ! abstot_3d is written as a series of 3D variables - - dims(1) = size(abstot_3d, 1) ! Should be pcols - dims(2) = size(abstot_3d, 2) ! Should be (pverp-ntoplw+1) - dims(3) = size(abstot_3d, 4) ! Should be endchunk - begchunk + 1 - gdims(nhdims+1) = dims(2) - do i = ntoplw, pverp - call cam_grid_write_dist_array(File, physgrid, dims(1:3), & - gdims(1:nhdims+1), abstot_3d(:,:,i,:), abstot_desc(i)) - end do - - dims(1) = size(emstot_3d, 1) ! Should be pcols - dims(2) = size(emstot_3d, 2) ! Should be pverp - dims(3) = size(emstot_3d, 3) ! Should be endchunk - begchunk + 1 - gdims(nhdims+1) = dims(2) - call cam_grid_write_dist_array(File, physgrid, dims(1:3), & - gdims(1:nhdims+1), emstot_3d, emstot_desc) - - dims(1) = size(absnxt_3d, 1) ! Should be pcols - dims(2) = size(absnxt_3d, 2) ! Should be pver - dims(3) = size(absnxt_3d, 4) ! Should be endchunk - begchunk + 1 - gdims(nhdims+1) = dims(2) - do i = 1, 4 - call cam_grid_write_dist_array(File, physgrid, dims(1:3), & - gdims(1:nhdims+1), absnxt_3d(:,:,i,:), absnxt_desc(i)) - end do - - ! module data was allocated in radiation_define_restart - deallocate(abstot_desc) - 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 :: err_handling - integer :: ierr - integer :: physgrid - integer :: dims(3), gdims(3), nhdims - integer :: vsize - integer :: i - - type(var_desc_t) :: vardesc - character(len=16) :: pname - !---------------------------------------------------------------------------- - - ! Put this call here for now. It should move to an init method when the - ! initialization and restart sequencing is unified. - call initialize_radbuffer() - - if ( radiation_do('aeres') ) then - - call pio_seterrorhandling(File, PIO_BCAST_ERROR, err_handling) - ierr = pio_inq_varid(File, 'Emissivity', vardesc) - call pio_seterrorhandling(File, err_handling) - if (ierr /= PIO_NOERR) then - if (masterproc) write(iulog,*) 'Warning: Emissivity variable not found on restart file.' - return - end if - - physgrid = cam_grid_id('physgrid') - call cam_grid_dimensions(physgrid, gdims(1:2), nhdims) - - dims(1) = pcols - dims(2) = pverp - dims(3) = endchunk - begchunk + 1 - gdims(nhdims+1) = dims(2) - - call cam_grid_read_dist_array(File, physgrid, dims(1:3), & - gdims(1:nhdims+1), emstot_3d, vardesc) - - vsize = pverp - ntoplw + 1 - dims(2) = vsize - gdims(nhdims+1) = dims(2) - - do i = ntoplw, pverp - write(pname,'(a,i3.3)') 'NAL_absorp', i - ierr = pio_inq_varid(File, trim(pname), vardesc) - call cam_grid_read_dist_array(File, physgrid, dims(1:3), & - gdims(1:nhdims+1), abstot_3d(:,:,i,:), vardesc) - end do - - dims(2) = pver - gdims(nhdims+1) = dims(2) - do i = 1, 4 - write(pname,'(a,i3.3)') 'NN_absorp', i - ierr = pio_inq_varid(File, trim(pname), vardesc) - call cam_grid_read_dist_array(File, physgrid, dims(1:3), & - gdims(1:nhdims+1), absnxt_3d(:,:,i,:), vardesc) - end do - end if - -end subroutine radiation_read_restart - -!=============================================================================== - -subroutine radiation_tend( & - state, ptend, pbuf, cam_out, cam_in, net_flx, rd_out) - - !----------------------------------------------------------------------- - ! Driver for radiation computation. - ! - ! NOTE: Radiation uses cgs units, so conversions must be done from - ! model fields to radiation fields. - !----------------------------------------------------------------------- - - use physics_buffer, only: physics_buffer_desc, pbuf_get_field, pbuf_old_tim_idx - use phys_grid, only: get_rlat_all_p, get_rlon_all_p - use physics_types, only: physics_state, physics_ptend - use time_manager, only: get_curr_calday - use radheat, only: radheat_tend - use physconst, only: cpair, stebol - use radconstants, only: nlwbands, nswbands - use radsw, only: radcswmx - use radlw, only: radclwmx - use rad_constituents, only: rad_cnst_get_gas, rad_cnst_out - use aer_rad_props, only: aer_rad_props_sw, aer_rad_props_lw - use interpolate_data, only: vertinterp - use radiation_data, only: rad_data_write - use cloud_cover_diags, only: cloud_cover_diags_out - use tropopause, only: tropopause_find, TROP_ALG_HYBSTOB, TROP_ALG_CLIMATE - use orbit, only: zenith - - ! Arguments - type(physics_state), target, intent(in) :: 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 - - integer :: i, k - integer :: lchnk, ncol - - logical :: dosw, dolw, doabsems - integer, pointer :: nmxrgn(:) ! pbuf pointer to Number of maximally overlapped regions - real(r8),pointer :: pmxrgn(:,:) ! Maximum values of pressure for each - ! maximally overlapped region. - ! 0->pmxrgn(i,1) is range of pressure for - ! 1st region,pmxrgn(i,1)->pmxrgn(i,2) for - ! 2nd region, etc - - real(r8),pointer :: emis(:,:) ! Cloud longwave emissivity - real(r8),pointer :: cldtau(:,:) ! Cloud longwave optical depth - real(r8),pointer :: cicewp(:,:) ! in-cloud cloud ice water path - real(r8),pointer :: cliqwp(:,:) ! in-cloud cloud liquid water path - - real(r8) :: cltot(pcols) ! Diagnostic total cloud cover - real(r8) :: cllow(pcols) ! " low cloud cover - real(r8) :: clmed(pcols) ! " mid cloud cover - real(r8) :: clhgh(pcols) ! " hgh cloud cover - - real(r8) :: ftem(pcols,pver) ! Temporary workspace for outfld variables - - integer :: itim_old - real(r8), pointer, dimension(:,:) :: rel ! liquid effective drop radius (microns) - real(r8), pointer, dimension(:,:) :: rei ! ice effective drop size (microns) - real(r8), pointer, dimension(:,:) :: cld ! cloud fraction - real(r8), pointer, dimension(:,:) :: qrs ! shortwave radiative heating rate - real(r8), pointer, dimension(:,:) :: qrl ! longwave radiative heating rate - - real(r8) :: calday ! current calendar day - real(r8) :: clat(pcols) ! current latitudes(radians) - real(r8) :: clon(pcols) ! current longitudes(radians) - real(r8) :: coszrs(pcols) ! Cosine solar zenith angle - - 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 - - ! This is used by the chemistry. - real(r8), pointer :: fsds(:) ! Surface solar down flux - - ! This is used for the energy checker and the Eulerian dycore. - 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) :: pbr(pcols,pver) ! Model mid-level pressures (dynes/cm2) - real(r8) :: pnm(pcols,pverp) ! Model interface pressures (dynes/cm2) - real(r8) :: eccf ! Earth/sun distance factor - real(r8) :: lwupcgs(pcols) ! Upward longwave flux in cgs units - - real(r8), pointer, dimension(:,:) :: n2o ! nitrous oxide mass mixing ratio - real(r8), pointer, dimension(:,:) :: ch4 ! methane mass mixing ratio - real(r8), pointer, dimension(:,:) :: cfc11 ! cfc11 mass mixing ratio - real(r8), pointer, dimension(:,:) :: cfc12 ! cfc12 mass mixing ratio - real(r8), pointer, dimension(:,:) :: o3 ! Ozone mass mixing ratio - real(r8), pointer, dimension(:,:) :: o2 ! Oxygen mass mixing ratio - real(r8), dimension(pcols) :: o2_col ! column oxygen mmr - real(r8), pointer, dimension(:,:) :: co2 ! co2 mass mixing ratio - real(r8), dimension(pcols) :: co2_col_mean ! co2 column mean mmr - real(r8), pointer, dimension(:,:) :: sp_hum ! specific humidity - - ! 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_f(pcols,0:pver,nswbands) ! aerosol forward scattered fraction * w * tau - - ! Aerosol longwave absorption optical depth - real(r8) :: odap_aer(pcols,pver,nlwbands) - - ! Gathered indicies 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, dimension(pcols) :: IdxDay ! Indicies of daylight coumns - integer, dimension(pcols) :: IdxNite ! Indicies of night coumns - - character(*), parameter :: name = 'radiation_tend' - - ! tropopause diagnostic - integer :: troplev(pcols) - real(r8):: p_trop(pcols) - - logical :: write_output ! switch for outfld calls - !---------------------------------------------------------------------- - - lchnk = state%lchnk - ncol = state%ncol - - calday = get_curr_calday() - - if (present(rd_out)) then - rd => rd_out - write_output = .false. - else - allocate(rd) - write_output=.true. - end if - - itim_old = pbuf_old_tim_idx() - 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, fsds_idx, fsds) - - call pbuf_get_field(pbuf, fsns_idx, fsns) - call pbuf_get_field(pbuf, fsnt_idx, fsnt) - call pbuf_get_field(pbuf, flns_idx, flns) - call pbuf_get_field(pbuf, flnt_idx, flnt) - - call pbuf_get_field(pbuf, rel_idx, rel) - call pbuf_get_field(pbuf, rei_idx, rei) - - ! For CRM, make cloud equal to input observations: - if (single_column.and.scm_crm_mode.and.have_cld) then - do k = 1,pver - cld(:ncol,k)= cldobs(k) - enddo - endif - - ! Cosine solar zenith angle for current time step - call get_rlat_all_p(lchnk, ncol, clat) - call get_rlon_all_p(lchnk, ncol, clon) - call zenith (calday, clat, clon, coszrs, ncol, dt_avg) - - ! 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 - - dosw = radiation_do('sw') ! do shortwave heating calc this timestep? - dolw = radiation_do('lw') ! do longwave heating calc this timestep? - - doabsems = radiation_do('absems') ! do absorptivity/emissivity calc this timestep? - - if (dosw .or. dolw) then - - ! pbuf cloud properties set in cloud_diagnostics - call pbuf_get_field(pbuf, cicewp_idx, cicewp) - call pbuf_get_field(pbuf, cliqwp_idx, cliqwp) - call pbuf_get_field(pbuf, cldemis_idx, emis) - - call pbuf_get_field(pbuf, cldtau_idx, cldtau) - - call pbuf_get_field(pbuf, pmxrgn_idx, pmxrgn) - call pbuf_get_field(pbuf, nmxrgn_idx, nmxrgn) - - ! For CRM, make cloud liquid water path equal to input observations - if(single_column.and.scm_crm_mode.and.have_clwp)then - do k=1,pver - cliqwp(:ncol,k) = clwpobs(k) - end do - endif - - ! Get specific humidity - call rad_cnst_get_gas(0,'H2O', state, pbuf, sp_hum) - - ! Get ozone mass mixing ratio. - call rad_cnst_get_gas(0,'O3', state, pbuf, o3) - - ! Get CO2 mass mixing ratio and compute column mean values - call rad_cnst_get_gas(0,'CO2', state, pbuf, co2) - call calc_col_mean(state, co2, co2_col_mean) - - ! construct cgs unit reps of pmid and pint and get "eccf" - earthsundistancefactor - call radinp(ncol, state%pmid, state%pint, pbr, pnm, eccf) - - ! Solar radiation computation - - 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) - endif - - if (dosw) then - - call t_startf('rad_sw') - - ! Get Oxygen mass mixing ratio. - call rad_cnst_get_gas(0,'O2', state, pbuf, o2) - call calc_col_mean(state, o2, o2_col) - - ! Get aerosol radiative properties. - call t_startf('aero_optics_sw') - call aer_rad_props_sw(0, state, pbuf, nnite, idxnite, & - aer_tau, aer_tau_w, aer_tau_w_g, aer_tau_w_f) - call t_stopf('aero_optics_sw') - - call radcswmx(lchnk, & - ncol, pnm, pbr, sp_hum, o3, & - o2_col, cld, cicewp, cliqwp, rel, & - rei, eccf, coszrs, rd%solin, & - cam_in%asdir, cam_in%asdif, cam_in%aldir, cam_in%aldif, nmxrgn, & - pmxrgn, qrs, rd%qrsc, fsnt, rd%fsntc, rd%fsdtoa, & - rd%fsntoa, rd%fsutoa, rd%fsntoac, rd%fsnirt, rd%fsnrtc, rd%fsnirtsq, & - fsns, rd%fsnsc, rd%fsdsc, fsds, cam_out%sols, & - cam_out%soll, cam_out%solsd, cam_out%solld, fns, fcns, & - Nday, Nnite, IdxDay, IdxNite, co2_col_mean, & - aer_tau, aer_tau_w, aer_tau_w_g, aer_tau_w_f , rd%liq_icld_vistau, rd%ice_icld_vistau ) - - call t_stopf('rad_sw') - - ! Output net fluxes at 200 mb - call vertinterp(ncol, pcols, pverp, state%pint, 20000._r8, fcns, rd%fsn200c) - call vertinterp(ncol, pcols, pverp, state%pint, 20000._r8, fns, rd%fsn200) - 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)) - rd%fsnr(i) = rd%fsnr(i)*cgs2mks - enddo - else - rd%fsnr(:) = 0._r8 - endif - - ! Convert units of shortwave fields needed by rest of model from CGS to MKS - - do i=1,ncol - rd%solin(i) = rd%solin(i) *cgs2mks - fsds(i) = fsds(i) *cgs2mks - rd%fsnirt(i) = rd%fsnirt(i) *cgs2mks - rd%fsnrtc(i) = rd%fsnrtc(i) *cgs2mks - rd%fsnirtsq(i)= rd%fsnirtsq(i)*cgs2mks - fsnt(i) = fsnt(i) *cgs2mks - rd%fsdtoa(i) = rd%fsdtoa(i) *cgs2mks - fsns(i) = fsns(i) *cgs2mks - rd%fsntc(i) = rd%fsntc(i) *cgs2mks - rd%fsnsc(i) = rd%fsnsc(i) *cgs2mks - rd%fsdsc(i) = rd%fsdsc(i) *cgs2mks - rd%fsntoa(i) = rd%fsntoa(i) *cgs2mks - rd%fsutoa(i) = rd%fsutoa(i) *cgs2mks - rd%fsntoac(i) = rd%fsntoac(i) *cgs2mks - rd%fsn200(i) = rd%fsn200(i) *cgs2mks - rd%fsn200c(i) = rd%fsn200c(i) *cgs2mks - rd%swcf(i) = rd%fsntoa(i) - rd%fsntoac(i) - end do - - ! initialize tau_cld_vistau and tau_icld_vistau as fillvalue, they will stay fillvalue for night columns - rd%tot_icld_vistau(1:pcols,1:pver) = fillvalue - rd%tot_cld_vistau(1:pcols,1:pver) = fillvalue - - ! only do calcs for tot_cld_vistau and tot_icld_vistau on daytime columns - do i=1,Nday - ! sum the water and ice optical depths to get total in-cloud cloud optical depth - rd%tot_icld_vistau(IdxDay(i),1:pver) = rd%liq_icld_vistau(IdxDay(i),1:pver) + & - rd%ice_icld_vistau(IdxDay(i),1:pver) - - ! sum wat and ice, multiply by cloud fraction to get grid-box value - rd%tot_cld_vistau(IdxDay(i),1:pver) = (rd%liq_icld_vistau(IdxDay(i),1:pver) + & - rd%ice_icld_vistau(IdxDay(i),1:pver))*cld(IdxDay(i),1:pver) - end do - - ! add fillvalue for night columns - do i = 1, Nnite - rd%liq_icld_vistau(IdxNite(i),:) = fillvalue - rd%ice_icld_vistau(IdxNite(i),:) = fillvalue - end do - - if (write_output) call radiation_output_sw(state, rd, cam_out, fsns, fsnt, fsds, qrs) - - end if ! dosw - - ! Longwave radiation computation - - if (dolw) then - - call t_startf("rad_lw") - - ! Convert upward longwave flux units to CGS - - do i=1,ncol - lwupcgs(i) = cam_in%lwup(i)*1000._r8 - if (single_column .and. scm_crm_mode .and. have_tg) & - lwupcgs(i) = 1000*stebol*tground(1)**4 - end do - - ! Get gas phase constituents. - call rad_cnst_get_gas(0,'N2O', state, pbuf, n2o) - call rad_cnst_get_gas(0,'CH4', state, pbuf, ch4) - call rad_cnst_get_gas(0,'CFC11', state, pbuf, cfc11) - call rad_cnst_get_gas(0,'CFC12', state, pbuf, cfc12) - - ! absems requires lw absorption optical depth and transmission through aerosols - call t_startf('aero_optics_lw') - if (doabsems) call aer_rad_props_lw(0, state, pbuf, odap_aer) - call t_stopf('aero_optics_lw') - - call radclwmx(lchnk, ncol, doabsems, & - lwupcgs, state%t, sp_hum, o3, pbr, & - pnm, state%lnpmid, state%lnpint, n2o, ch4, & - cfc11, cfc12, cld, emis, pmxrgn, & - nmxrgn, qrl, rd%qrlc, flns, flnt, rd%flnsc, & - rd%flntc, cam_out%flwds, rd%fldsc, rd%flut, rd%flutc, & - fnl, fcnl, co2_col_mean, odap_aer) - - call t_stopf("rad_lw") - - ! 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)) - enddo - else - rd%flnr(:) = 0._r8 - endif - - ! Convert units of longwave fields needed by rest of model from CGS to MKS - - do i = 1, ncol - flnt(i) = flnt(i) *cgs2mks - rd%flut(i) = rd%flut(i) *cgs2mks - rd%flutc(i) = rd%flutc(i) *cgs2mks - rd%lwcf(i) = rd%flutc(i) - rd%flut(i) - flns(i) = flns(i) *cgs2mks - rd%fldsc(i) = rd%fldsc(i) *cgs2mks - rd%flntc(i) = rd%flntc(i) *cgs2mks - rd%fln200(i) = rd%fln200(i) *cgs2mks - rd%fln200c(i) = rd%fln200c(i) *cgs2mks - rd%flnsc(i) = rd%flnsc(i) *cgs2mks - cam_out%flwds(i) = cam_out%flwds(i) *cgs2mks - rd%flnr(i) = rd%flnr(i) *cgs2mks - end do - - if (write_output) call radiation_output_lw(state, rd, cam_out, flns, flnt, qrl) - - end if ! dolw - - ! Output aerosol mmr - if (write_output) call rad_cnst_out(0, state, pbuf) - - ! Cloud cover diagnostics - ! radsw can change pmxrgn and nmxrgn so cldsav needs to follow radsw - if (write_output) call cloud_cover_diags_out(lchnk, ncol, cld, state%pmid, nmxrgn, pmxrgn ) - - else ! if (dosw .or. dolw) then - - ! convert radiative heating rates from Q*dp to Q for energy conservation - do k =1 , pver - do i = 1, ncol - qrs(i,k) = qrs(i,k)/state%pdel(i,k) - qrl(i,k) = qrl(i,k)/state%pdel(i,k) - end do - end do - - end if ! if (dosw .or. dolw) then - - ! output rad inputs and resulting heating rates - call rad_data_write( pbuf, state, cam_in, coszrs ) - - ! Compute net radiative heating tendency - 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 - do k =1 , pver - do i = 1, ncol - qrs(i,k) = qrs(i,k)*state%pdel(i,k) - qrl(i,k) = qrl(i,k)*state%pdel(i,k) - end do - end do - - cam_out%netsw(:ncol) = fsns(:ncol) - - if (.not. present(rd_out)) then - deallocate(rd) - end if -end subroutine radiation_tend - -!=============================================================================== - -subroutine radiation_output_sw(state, rd, cam_out, fsns, fsnt, fsds, qrs) - - ! Dump shortwave radiation information to history buffer (diagnostics) - - type(physics_state), intent(in) :: state - type(rad_out_t), intent(in) :: rd - type(cam_out_t), intent(in) :: cam_out - real(r8), intent(in) :: fsns(pcols) ! Surface solar absorbed flux - real(r8), intent(in) :: fsnt(pcols) ! Net column abs solar flux at model top - real(r8), intent(in) :: fsds(pcols) ! Surface solar down flux - real(r8), pointer :: qrs(:,:) ! shortwave radiative heating rate - - ! Local variables - integer :: lchnk, ncol - real(r8) :: ftem(pcols,pver) ! Temporary workspace for outfld variables - !---------------------------------------------------------------------- - - lchnk = state%lchnk - ncol = state%ncol - - ftem(:ncol,:pver) = qrs(:ncol,:pver)/cpair - call outfld('QRS ',ftem ,pcols,lchnk) - - ftem(:ncol,:pver) = rd%qrsc(:ncol,:pver)/cpair - call outfld('QRSC ',ftem ,pcols,lchnk) - - call outfld('SOLIN ',rd%solin ,pcols,lchnk) - call outfld('FSDS ',fsds ,pcols,lchnk) - call outfld('FSNIRTOA',rd%fsnirt ,pcols,lchnk) - call outfld('FSNRTOAC',rd%fsnrtc ,pcols,lchnk) - call outfld('FSNRTOAS',rd%fsnirtsq ,pcols,lchnk) - call outfld('FSNT ',fsnt ,pcols,lchnk) - call outfld('FSDTOA ',rd%fsdtoa ,pcols,lchnk) - call outfld('FSNS ',fsns ,pcols,lchnk) - call outfld('FSNTC ',rd%fsntc ,pcols,lchnk) - call outfld('FSNSC ',rd%fsnsc ,pcols,lchnk) - call outfld('FSDSC ',rd%fsdsc ,pcols,lchnk) - call outfld('FSNTOA ',rd%fsntoa ,pcols,lchnk) - call outfld('FSUTOA ',rd%fsutoa ,pcols,lchnk) - call outfld('FSNTOAC ',rd%fsntoac ,pcols,lchnk) - call outfld('SOLS ',cam_out%sols ,pcols,lchnk) - call outfld('SOLL ',cam_out%soll ,pcols,lchnk) - call outfld('SOLSD ',cam_out%solsd ,pcols,lchnk) - call outfld('SOLLD ',cam_out%solld ,pcols,lchnk) - call outfld('FSN200 ',rd%fsn200 ,pcols,lchnk) - call outfld('FSN200C ',rd%fsn200c ,pcols,lchnk) - call outfld('FSNR' ,rd%fsnr ,pcols,lchnk) - call outfld('SWCF ',rd%swcf ,pcols,lchnk) - - 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) - -end subroutine radiation_output_sw - -!=============================================================================== - -subroutine radiation_output_lw(state, rd, cam_out, flns, flnt, qrl) - - ! Dump longwave radiation information to history tape buffer (diagnostics) - - type(physics_state), intent(in) :: state - type(rad_out_t), intent(in) :: rd - type(cam_out_t), intent(in) :: cam_out - real(r8), intent(in) :: flns(pcols) ! Srf longwave cooling (up-down) flux - real(r8), intent(in) :: flnt(pcols) ! Net outgoing lw flux at model top - real(r8), pointer :: qrl(:,:) ! longwave radiative heating rate - - ! Local variables - integer :: lchnk, ncol - real(r8) :: ftem(pcols,pver) - !---------------------------------------------------------------------- - - lchnk = state%lchnk - ncol = state%ncol - - call outfld('QRL ',qrl(:ncol,:)/cpair,ncol,lchnk) - call outfld('QRLC ',rd%qrlc(:ncol,:)/cpair,ncol,lchnk) - call outfld('FLNT ',flnt ,pcols,lchnk) - call outfld('FLUT ',rd%flut ,pcols,lchnk) - call outfld('FLUTC ',rd%flutc ,pcols,lchnk) - call outfld('FLNTC ',rd%flntc ,pcols,lchnk) - call outfld('FLNS ',flns ,pcols,lchnk) - call outfld('FLDS ',cam_out%flwds ,pcols,lchnk) - call outfld('FLNSC ',rd%flnsc ,pcols,lchnk) - call outfld('FLDSC ',rd%fldsc ,pcols,lchnk) - call outfld('LWCF ',rd%lwcf ,pcols,lchnk) - call outfld('FLN200 ',rd%fln200,pcols,lchnk) - call outfld('FLN200C ',rd%fln200c,pcols,lchnk) - call outfld('FLNR ' ,rd%flnr,pcols,lchnk) - -end subroutine radiation_output_lw - -!=============================================================================== - -subroutine radinp(ncol, pmid, pint, pmidrd, pintrd, eccf) - - use shr_orb_mod - use time_manager, only: get_curr_calday - - !------------------------------Arguments-------------------------------- - integer, intent(in) :: ncol ! number of atmospheric columns - - real(r8), intent(in) :: pmid(pcols,pver) ! Pressure at model mid-levels (pascals) - real(r8), intent(in) :: pint(pcols,pverp) ! Pressure at model interfaces (pascals) - - real(r8), intent(out) :: pmidrd(pcols,pver) ! Pressure at mid-levels (dynes/cm*2) - real(r8), intent(out) :: pintrd(pcols,pverp) ! Pressure at interfaces (dynes/cm*2) - real(r8), intent(out) :: eccf ! Earth-sun distance factor - - !---------------------------Local variables----------------------------- - integer :: i, k - real(r8) :: calday ! current calendar day - real(r8) :: delta ! Solar declination angle - !----------------------------------------------------------------------- - - calday = get_curr_calday() - call shr_orb_decl (calday ,eccen ,mvelpp ,lambm0 ,obliqr , & - delta ,eccf) - - ! Convert pressure from pascals to dynes/cm2 - do k=1,pver - do i=1,ncol - pmidrd(i,k) = pmid(i,k)*10.0_r8 - pintrd(i,k) = pint(i,k)*10.0_r8 - end do - end do - do i=1,ncol - pintrd(i,pverp) = pint(i,pverp)*10.0_r8 - end do - -end subroutine radinp - -!=============================================================================== - -subroutine calc_col_mean(state, mmr_pointer, mean_value) - - ! Compute the column mean. - - use cam_logfile, only: iulog - - 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 - -!=============================================================================== - -end module radiation - diff --git a/src/physics/rrtmg/radiation.F90.orig b/src/physics/rrtmg/radiation.F90.orig deleted file mode 100644 index 83f457bc6e..0000000000 --- a/src/physics/rrtmg/radiation.F90.orig +++ /dev/null @@ -1,1426 +0,0 @@ -module radiation - -!--------------------------------------------------------------------------------- -! -! CAM interface to RRTMG radiation parameterization -! -!--------------------------------------------------------------------------------- - -use shr_kind_mod, only: r8=>shr_kind_r8 -use spmd_utils, only: masterproc -use ppgrid, only: pcols, pver, pverp, begchunk, endchunk -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 - -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, rrtmg_sw_cloudsim_band, rrtmg_lw_cloudsim_band, & - idx_sw_diag - -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 - -use pio, only: file_desc_t, var_desc_t, & - pio_int, pio_noerr, & - pio_seterrorhandling, pio_bcast_error, & - pio_inq_varid, pio_def_var, & - pio_put_var, pio_get_var - -use cam_abortutils, only: endrun -use error_messages, only: handle_err -use perf_mod, only: t_startf, t_stopf -use cam_logfile, only: iulog - -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 - -type rad_out_t - real(r8) :: solin(pcols) ! Solar incident flux - - real(r8) :: qrsc(pcols,pver) - - real(r8) :: fsntc(pcols) ! Clear sky total column abs 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) :: fsnsc(pcols) ! Clear sky surface abs solar flux - real(r8) :: fsdsc(pcols) ! Clear sky surface downwelling solar 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) :: cld_tau_cloudsim(pcols,pver) - real(r8) :: aer_tau400(pcols,0:pver) - real(r8) :: aer_tau550(pcols,0:pver) - real(r8) :: aer_tau700(pcols,0:pver) - -end type rad_out_t - -! Namelist variables - -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. - -! 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 - -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 - -! PIO descriptors (for restarts) -type(var_desc_t) :: cospcnt_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 - - character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input - - ! Local variables - integer :: unitn, ierr - integer :: dtime ! timestep size - character(len=*), parameter :: sub = 'radiation_readnl' - - namelist /radiation_nl/ iradsw, iradlw, irad_always, & - use_rad_dt_cosz, spectralflux - !----------------------------------------------------------------------------- - - 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(sub // ':: ERROR reading namelist') - end if - end if - close(unitn) - call freeunit(unitn) - end if - - ! Broadcast namelist variables - call mpi_bcast(iradsw, 1, mpi_integer, mstrid, mpicom, ierr) - 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(sub//": FATAL: mpi_bcast: iradlw") - call mpi_bcast(irad_always, 1, mpi_integer, mstrid, mpicom, ierr) - 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(sub//": FATAL: mpi_bcast: use_rad_dt_cosz") - call mpi_bcast(spectralflux, 1, mpi_logical, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: spectralflux") - - ! 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,*) 'RRTMG radiation scheme parameters:' - write(iulog,10) iradsw, iradlw, irad_always, use_rad_dt_cosz, spectralflux - end if - -10 format(' 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/) - -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() - -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 - !----------------------------------------------------------------------- - - 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 - -end function radiation_nextsw_cday - -!================================================================================================ - -subroutine radiation_init(pbuf2d) - - ! Initialize the radiation parameterization, add fields to the history buffer - - use physics_buffer, only: pbuf_get_index, pbuf_set_field - use phys_control, only: phys_getopts - use radsw, only: radsw_init - use radlw, only: radlw_init - use rad_solar_var, only: rad_solar_var_init - 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 rrtmg_state, only: rrtmg_state_init - use time_manager, only: is_first_step - - - ! arguments - type(physics_buffer_desc), pointer :: pbuf2d(:,:) - - ! local variables - 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 :: err - - integer :: dtime - !----------------------------------------------------------------------- - - call rad_solar_var_init() - call rrtmg_state_init() - call rad_data_init(pbuf2d) ! initialize output fields for offline driver - call radsw_init() - call radlw_init() - call cloud_rad_props_init() - - cld_idx = pbuf_get_index('CLD') - cldfsnow_idx = pbuf_get_index('CLDFSNOW',errcode=err) - - 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 - - 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) call modal_aer_opt_init() - - ! "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() - 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 - - call addfld('O3colAbove', horiz_only, 'A', 'DU', 'Column O3 above model top', sampling_seq='rad_lwsw') - - 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.) - - 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.) - endif - - ! 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 - - 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 - - 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('FLNTCLR'//diag(icall), horiz_only, 'A', 'W/m2', 'Clearsky ONLY points net longwave flux at top of model',& - sampling_seq='rad_lwsw') - call addfld('FREQCLR'//diag(icall), horiz_only, 'A', 'Frac', 'Frequency of Occurrence of Clearsky', & - 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('FLNTCLR'//diag(icall), 1, ' ') - call add_default('FREQCLR'//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, ' ') - endif - - end if - end do - - call addfld('EMIS', (/ 'lev' /), 'A', '1', 'Cloud longwave emissivity') - - 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') - - 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 - -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) - - 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 - !---------------------------------------------------------------------------- - - 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 :: err_handling - integer :: ierr - - type(var_desc_t) :: vardesc - !---------------------------------------------------------------------------- - - 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 - -end subroutine radiation_read_restart - -!=============================================================================== - -subroutine radiation_tend( & - state, ptend, pbuf, cam_out, cam_in, net_flx, rd_out) - - !----------------------------------------------------------------------- - ! - ! Driver for radiation computation. - ! - ! Revision history: - ! 2007-11-05 M. Iacono Install rrtmg_lw and sw as radiation model. - ! 2007-12-27 M. Iacono Modify to use CAM cloud optical properties with rrtmg. - !----------------------------------------------------------------------- - - 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 aer_rad_props, only: aer_rad_props_sw, aer_rad_props_lw - - use cloud_rad_props, only: get_ice_optics_sw, get_liquid_optics_sw, liquid_cloud_get_rad_props_lw, & - ice_cloud_get_rad_props_lw, cloud_rad_props_get_lw, & - 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 rad_solar_var, only: get_variability - use radsw, only: rad_rrtmg_sw - use radlw, only: rad_rrtmg_lw - use radheat, only: radheat_tend - - use radiation_data, only: rad_data_write - use rrtmg_state, only: rrtmg_state_create, rrtmg_state_update, rrtmg_state_destroy, rrtmg_state_t, & - num_rrtmg_levs - - 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 - 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 :: 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 - 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) - - type(rrtmg_state_t), pointer :: r_state ! contains the atm concentrations in layers needed for RRTMG - - ! 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) - - ! 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) - - ! 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) - - real(r8) :: sfac(1:nswbands) ! time varying scaling factors due to Solar Spectral Irrad at 1 A.U. per band - - integer :: icall ! index through climate/diagnostic radiation calls - logical :: active_calls(0:N_DIAG) - - ! 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_f(pcols,0:pver,nswbands) ! aerosol forward scattered fraction * w * tau - real(r8) :: aer_lw_abs (pcols,pver,nlwbands) ! aerosol absorption optics depth (LW) - - 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 - - ! 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 - - real(r8) :: freqclr(pcols) ! Frequency of occurrence of clear sky columns - real(r8) :: flntclr(pcols) ! Clearsky only columns (zero if cloudy) - - character(*), parameter :: name = 'radiation_tend' - !-------------------------------------------------------------------------------------- - - lchnk = state%lchnk - ncol = state%ncol - - if (present(rd_out)) then - rd => rd_out - write_output = .false. - else - allocate(rd) - write_output=.true. - end if - - dosw = radiation_do('sw') ! do shortwave heating calc this timestep? - dolw = radiation_do('lw') ! 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) - do i = 1, ncol - coszrs(i) = shr_orb_cosz(calday, clat(i), clon(i), delta, dt_avg) - end do - - ! 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/) ) - 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, fsnt_idx, fsnt) - call pbuf_get_field(pbuf, fsds_idx, fsds) - call pbuf_get_field(pbuf, fsns_idx, fsns) - 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 - - ! 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) - endif - - if (dosw .or. dolw) then - - ! construct an RRTMG state object - r_state => rrtmg_state_create( state, cam_in ) - - call t_startf('cldoptics') - - if (cldfsnow_idx > 0) then - do k = 1, pver - 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 (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.) - 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._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) & - + 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 - - ! 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 - - ! 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 - end do - - if (write_output) call radiation_output_cld(lchnk, ncol, rd) - - end if ! if (dosw) - - 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('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('liqcldoptics must be either slingo or gammadist') - end select - - cld_lw_abs(:,:ncol,:) = liq_lw_abs(:,:ncol,:) + ice_lw_abs(:,:ncol,:) - - end if - - 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 - - end if ! if (dolw) - - call t_stopf('cldoptics') - - ! Solar radiation computation - - if (dosw) then - - call get_variability(sfac) - - ! 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 - - ! update the concentrations in the RRTMG state object - call rrtmg_state_update(state, pbuf, icall, r_state) - - call aer_rad_props_sw(icall, state, pbuf, nnite, idxnite, & - aer_tau, aer_tau_w, aer_tau_w_g, aer_tau_w_f) - - rd%cld_tau_cloudsim(:ncol,:) = cld_tau(rrtmg_sw_cloudsim_band,:ncol,:) - rd%aer_tau550(:ncol,:) = aer_tau(:ncol,:,idx_sw_diag) - rd%aer_tau400(:ncol,:) = aer_tau(:ncol,:,idx_sw_diag+1) - rd%aer_tau700(:ncol,:) = aer_tau(:ncol,:,idx_sw_diag-1) - - 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, & - eccf, coszrs, rd%solin, sfac, cam_in%asdir, & - cam_in%asdif, cam_in%aldir, cam_in%aldif, qrs, rd%qrsc, & - fsnt, rd%fsntc, rd%fsntoa, rd%fsutoa, rd%fsntoac, & - rd%fsnirt, rd%fsnrtc, rd%fsnirtsq, fsns, rd%fsnsc, & - rd%fsdsc, fsds, cam_out%sols, cam_out%soll, cam_out%solsd, & - cam_out%solld, fns, fcns, Nday, Nnite, & - IdxDay, IdxNite, su, sd, E_cld_tau=c_cld_tau, & - E_cld_tau_w=c_cld_tau_w, E_cld_tau_w_g=c_cld_tau_w_g, & - E_cld_tau_w_f=c_cld_tau_w_f, old_convert=.false.) - - ! Output net fluxes at 200 mb - call vertinterp(ncol, pcols, pverp, state%pint, 20000._r8, fcns, rd%fsn200c) - call vertinterp(ncol, pcols, pverp, state%pint, 20000._r8, fns, rd%fsn200) - 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 (write_output) call radiation_output_sw(lchnk, ncol, icall, rd, pbuf, cam_out) - - end if - end do - - end if - - ! Output aerosol mmr - call rad_cnst_out(0, state, pbuf) - - ! Longwave radiation computation - - if (dolw) then - - 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 - - ! update the conctrations in the RRTMG state object - call rrtmg_state_update( state, pbuf, icall, r_state) - - call aer_rad_props_lw(icall, state, pbuf, aer_lw_abs) - - call rad_rrtmg_lw( & - lchnk, ncol, num_rrtmg_levs, r_state, state%pmid, & - aer_lw_abs, cldfprime, c_cld_lw_abs, qrl, rd%qrlc, & - flns, flnt, rd%flnsc, rd%flntc, cam_out%flwds, & - rd%flut, rd%flutc, fnl, fcnl, rd%fldsc, & - lu, ld) - - ! 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 - - flntclr(:) = 0._r8 - freqclr(:) = 0._r8 - do i = 1, ncol - if (maxval(cldfprime(i,:)) <= 0.1_r8) then - freqclr(i) = 1._r8 - flntclr(i) = rd%flntc(i) - end if - end do - - if (write_output) call radiation_output_lw(lchnk, ncol, icall, rd, pbuf, cam_out, freqclr, flntclr) - - end if - end do - - end if - - ! deconstruct the RRTMG state object - call rrtmg_state_destroy(r_state) - - if (docosp) then - - ! initialize and calculate emis - emis(:,:) = 0._r8 - emis(:ncol,:) = 1._r8 - exp(-cld_lw_abs(rrtmg_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 - gb_snow_tau(i,k) = snow_tau(rrtmg_sw_cloudsim_band,i,k)*cldfsnow(i,k) - gb_snow_lw(i,k) = snow_lw_abs(rrtmg_lw_cloudsim_band,i,k)*cldfsnow(i,k) - 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(rrtmg_sw_cloudsim_band,:,:),& - snow_tau_in=gb_snow_tau, snow_emis_in=gb_snow_lw) - cosp_cnt(lchnk) = 0 - end if - end if - - else ! if (dosw .or. dolw) then - - ! convert radiative heating rates from Q*dp to Q for energy conservation - do k =1 , pver - do i = 1, ncol - qrs(i,k) = qrs(i,k)/state%pdel(i,k) - qrl(i,k) = qrl(i,k)/state%pdel(i,k) - end do - end do - - end if ! if (dosw .or. dolw) then - - ! output rad inputs and resulting heating rates - call rad_data_write( pbuf, state, cam_in, coszrs ) - - ! Compute net radiative heating tendency - 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 - do k = 1, pver - do i = 1, ncol - qrs(i,k) = qrs(i,k)*state%pdel(i,k) - qrl(i,k) = qrl(i,k)*state%pdel(i,k) - end do - end do - - cam_out%netsw(:ncol) = fsns(:ncol) - - if (.not. present(rd_out)) then - deallocate(rd) - end if - -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) :: 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) - call outfld('QRSC'//diag(icall), rd%qrsc(:ncol,:)/cpair, ncol, 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) - - 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) - -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 - -end subroutine radiation_output_cld - -!=============================================================================== - -subroutine radiation_output_lw(lchnk, ncol, icall, rd, pbuf, cam_out, freqclr, flntclr) - - ! 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 - real(r8), intent(in) :: freqclr(pcols) - real(r8), intent(in) :: flntclr(pcols) - - ! 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('FREQCLR'//diag(icall), freqclr, pcols, lchnk) - call outfld('FLNTCLR'//diag(icall), flntclr, 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) - -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 - -!=============================================================================== - -end module radiation - diff --git a/src/utils/orbit.F90.orig b/src/utils/orbit.F90.orig deleted file mode 100644 index bb110f578e..0000000000 --- a/src/utils/orbit.F90.orig +++ /dev/null @@ -1,56 +0,0 @@ -module orbit - -contains - -subroutine zenith(calday ,clat , clon ,coszrs ,ncol, dt_avg ) -!----------------------------------------------------------------------- -! -! Purpose: -! Compute cosine of solar zenith angle for albedo and radiation -! computations. -! -! Method: -! -! -! -! Author: J. Kiehl -! -!----------------------------------------------------------------------- - use shr_kind_mod, only: r8 => shr_kind_r8 - use shr_orb_mod - use cam_control_mod, only: lambm0, obliqr, eccen, mvelpp - implicit none - -!------------------------------Arguments-------------------------------- -! -! Input arguments -! - integer, intent(in) :: ncol ! number of positions - real(r8), intent(in) :: calday ! Calendar day, including fraction - real(r8), intent(in) :: clat(ncol) ! Current centered latitude (radians) - real(r8), intent(in) :: clon(ncol) ! Centered longitude (radians) - real(r8), intent(in), optional :: dt_avg ! if present, time step to use for the shr_orb_cosz calculation -! -! Output arguments -! - real(r8), intent(out) :: coszrs(ncol) ! Cosine solar zenith angle -! -!---------------------------Local variables----------------------------- -! - integer i ! Position loop index - real(r8) delta ! Solar declination angle in radians - real(r8) eccf ! Earth orbit eccentricity factor -! -!----------------------------------------------------------------------- -! - call shr_orb_decl (calday ,eccen ,mvelpp ,lambm0 ,obliqr , & - delta ,eccf ) -! -! Compute local cosine solar zenith angle, -! - do i=1,ncol - coszrs(i) = shr_orb_cosz( calday, clat(i), clon(i), delta, dt_avg ) - end do - -end subroutine zenith -end module orbit