diff --git a/.github/workflows/python_unit_tests.yml b/.github/workflows/python_unit_tests.yml index 48a79a6a..9ca8a8db 100644 --- a/.github/workflows/python_unit_tests.yml +++ b/.github/workflows/python_unit_tests.yml @@ -21,7 +21,7 @@ jobs: strategy: matrix: #All of these python versions will be used to run tests: - python-version: ["3.7", "3.8", "3.9", "3.10"] + python-version: ["3.7", "3.8", "3.9", "3.10", "3.11"] fail-fast: false steps: # Acquire github action routines: diff --git a/Externals.cfg b/Externals.cfg index f352e7f7..2d8ae276 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -1,5 +1,5 @@ [ccs_config] -tag = ccs_config_cesm0.0.28 +tag = ccs_config_cesm0.0.59 protocol = git repo_url = https://github.com/ESMCI/ccs_config_cesm local_path = ccs_config @@ -13,7 +13,7 @@ local_path = components/cice5 required = True [cice6] -tag = cesm_cice6_2_0_21 +tag = cesm_cice6_4_1_3 protocol = git repo_url = https://github.com/ESCOMP/CESM_CICE local_path = components/cice @@ -21,14 +21,14 @@ externals = Externals.cfg required = True [cmeps] -tag = cmeps0.13.62 +tag = cmeps0.14.24 protocol = git repo_url = https://github.com/ESCOMP/CMEPS.git local_path = components/cmeps required = True [cdeps] -tag = cdeps0.12.46 +tag = cdeps1.0.8 protocol = git repo_url = https://github.com/ESCOMP/CDEPS.git local_path = components/cdeps @@ -36,14 +36,14 @@ externals = Externals_CDEPS.cfg required = True [cpl7] -tag = cpl7.0.12 +tag = cpl7.0.15 protocol = git repo_url = https://github.com/ESCOMP/CESM_CPL7andDataComps local_path = components/cpl7 required = True [share] -tag = share1.0.11 +tag = share1.0.16 protocol = git repo_url = https://github.com/ESCOMP/CESM_share local_path = share @@ -57,14 +57,14 @@ local_path = libraries/mct required = True [parallelio] -tag = pio2_5_6 +tag = pio2_5_10 protocol = git repo_url = https://github.com/NCAR/ParallelIO local_path = libraries/parallelio required = True [cime] -tag = cime6.0.38 +tag = cime6.0.94 protocol = git repo_url = https://github.com/ESMCI/cime local_path = cime @@ -79,7 +79,7 @@ externals = Externals_CISM.cfg required = True [clm] -tag = ctsm5.1.dev082 +tag = ctsm5.1.dev120 protocol = git repo_url = https://github.com/ESCOMP/CTSM local_path = components/clm @@ -95,7 +95,7 @@ externals = Externals_FMS.cfg required = True [mosart] -tag = mosart1_0_45 +tag = mosart1_0_48 protocol = git repo_url = https://github.com/ESCOMP/MOSART local_path = components/mosart diff --git a/Externals_CAM.cfg b/Externals_CAM.cfg index 1baada2f..1a7b01d5 100644 --- a/Externals_CAM.cfg +++ b/Externals_CAM.cfg @@ -1,8 +1,8 @@ [ccpp-framework] local_path = ccpp_framework protocol = git -repo_url = https://github.com/gold2718/ccpp-framework -tag = CPF_0.2.032 +repo_url = https://github.com/peverwhee/ccpp-framework +tag = CPF_0.2.042 required = True [cosp2] diff --git a/cime_config/cam_build_cache.py b/cime_config/cam_build_cache.py index 6577d6d8..7d4f886f 100644 --- a/cime_config/cam_build_cache.py +++ b/cime_config/cam_build_cache.py @@ -100,6 +100,34 @@ def new_entry_from_xml(item): # end if return new_entry +############################################################################### +def clean_xml_text(item): +############################################################################### + """Return a 'clean' (stripped) version of .text or an empty + string if .text is None or not a string-type variable + + doctests + + 1. Test that the function works as expected when passed a string. + >>> test_xml = ET.Element("text") + >>> test_xml.text = " THIS IS A test " + >>> clean_xml_text(test_xml) + 'THIS IS A test' + + 2. Verify that the function returns an empty string when not passed a string. + >>> test_xml = ET.Element("text") + >>> test_xml.text = 2 + >>> clean_xml_text(test_xml) + '' + + """ + itext = item.text + iret = "" + if isinstance(itext, str): + iret = itext.strip() + # end if + return iret + class FileStatus: """Class to hold full path and SHA hash of a file""" @@ -219,13 +247,14 @@ def __init__(self, build_cache): elif item.tag == 'config': self.__config = item.text elif item.tag == 'reg_gen_file': - self.__reg_gen_files.append(item.text.strip()) + self.__reg_gen_files.append(clean_xml_text(item)) elif item.tag == 'ic_name_entry': stdname = item.get('standard_name') if stdname not in self.__ic_names: self.__ic_names[stdname] = [] # end if - self.__ic_names[stdname].append(item.text.strip()) + itext = clean_xml_text(item) + self.__ic_names[stdname].append(itext) else: emsg = "ERROR: Unknown registry tag, '{}'" raise ValueError(emsg.format(item.tag)) @@ -248,16 +277,29 @@ def __init__(self, build_cache): new_entry = new_entry_from_xml(item) self.__xml_files[new_entry.key] = new_entry elif item.tag == 'scheme_namelist_meta_file': - self.__scheme_nl_metadata.append(item.text.strip()) + if isinstance(item.text, str): + if item.text: + self.__scheme_nl_metadata.append(item.text.strip()) + # end if + # end if elif item.tag == 'scheme_namelist_groups': - group_list = [x for x in - item.text.strip().split(' ') if x] + group_list = [] + if isinstance(item.text, str): + if item.text: + group_list = [x for x in + item.text.strip().split(' ') if x] + # end if + # end if self.__scheme_nl_groups = group_list elif item.tag == 'preproc_defs': - self.__preproc_defs = item.text.strip() + self.__preproc_defs = clean_xml_text(item) elif item.tag == 'kind_type': - kname, ktype = item.text.strip().split('=') - self.__kind_types[kname.strip()] = ktype.strip() + if isinstance(item.text, str): + if item.text: + kname, ktype = item.text.strip().split('=') + self.__kind_types[kname.strip()] = ktype.strip() + # end if + # end if else: emsg = "ERROR: Unknown CCPP tag, '{}'" raise ValueError(emsg.format(item.tag)) diff --git a/cime_config/cam_config.py b/cime_config/cam_config.py index 3bc81fee..b5b1afd7 100644 --- a/cime_config/cam_config.py +++ b/cime_config/cam_config.py @@ -250,7 +250,6 @@ def __init__(self, case, case_log): #Add the default host model namelists: self._add_xml_nml_file(cime_conf_path, "namelist_definition_cam.xml") self._add_xml_nml_file(data_nml_path, "namelist_definition_physconst.xml") - self._add_xml_nml_file(data_nml_path, "namelist_definition_air_comp.xml") self._add_xml_nml_file(data_nml_path, "namelist_definition_ref_pres.xml") #---------------------------------------------------- diff --git a/src/control/cam_comp.F90 b/src/control/cam_comp.F90 index a718930f..c9c7b642 100644 --- a/src/control/cam_comp.F90 +++ b/src/control/cam_comp.F90 @@ -10,25 +10,28 @@ module cam_comp ! !----------------------------------------------------------------------- - use shr_kind_mod, only: r8 => SHR_KIND_R8 - use shr_kind_mod, only: cl=>SHR_KIND_CL, cs=>SHR_KIND_CS - use shr_sys_mod, only: shr_sys_flush - - use spmd_utils, only: masterproc, mpicom - use cam_control_mod, only: cam_ctrl_init, cam_ctrl_set_orbit, cam_ctrl_set_physics_type - use cam_control_mod, only: caseid, ctitle - use runtime_opts, only: read_namelist - use runtime_obj, only: cam_runtime_opts - use time_manager, only: timemgr_init, get_step_size - use time_manager, only: get_nstep, is_first_step, is_first_restart_step - - use camsrfexch, only: cam_out_t, cam_in_t - use physics_types, only: phys_state, phys_tend - use dyn_comp, only: dyn_import_t, dyn_export_t - - use perf_mod, only: t_barrierf, t_startf, t_stopf - use cam_logfile, only: iulog - use cam_abortutils, only: endrun + use shr_kind_mod, only: r8 => SHR_KIND_R8 + use shr_kind_mod, only: cl=>SHR_KIND_CL, cs=>SHR_KIND_CS, cx=>SHR_KIND_CX + use shr_sys_mod, only: shr_sys_flush + + use spmd_utils, only: masterproc, mpicom + use cam_control_mod, only: cam_ctrl_init, cam_ctrl_set_orbit + use cam_control_mod, only: cam_ctrl_set_physics_type + use cam_control_mod, only: caseid, ctitle + use runtime_opts, only: read_namelist + use runtime_obj, only: cam_runtime_opts + use time_manager, only: timemgr_init, get_step_size + use time_manager, only: get_nstep + use time_manager, only: is_first_step, is_first_restart_step + + use camsrfexch, only: cam_out_t, cam_in_t + use physics_types, only: phys_state, phys_tend + use dyn_comp, only: dyn_import_t, dyn_export_t + + use perf_mod, only: t_barrierf, t_startf, t_stopf + use cam_logfile, only: iulog + use cam_abortutils, only: endrun + use ccpp_constituent_prop_mod, only: ccpp_constituent_properties_t implicit none private @@ -47,6 +50,16 @@ module cam_comp logical :: BFB_CAM_SCAM_IOP = .false. + ! Currently, the host (CAM) only adds water vapor (specific_humidity) + ! as a constituent. + ! Does this need to be a configurable variable? + integer, parameter :: num_host_advected = 1 + type(ccpp_constituent_properties_t), target :: host_constituents(num_host_advected) + + ! Private interface (here to avoid circular dependency) + private :: cam_register_constituents + + !----------------------------------------------------------------------- CONTAINS !----------------------------------------------------------------------- @@ -80,6 +93,9 @@ subroutine cam_init(caseid, ctitle, model_doi_url, & ! use history_defaults, only: initialize_iop_history use stepon, only: stepon_init use air_composition, only: air_composition_init + use cam_ccpp_cap, only: cam_ccpp_initialize_constituents + use physics_grid, only: columns_on_task + use vert_coord, only: pver ! Arguments character(len=cl), intent(in) :: caseid ! case ID @@ -122,6 +138,8 @@ subroutine cam_init(caseid, ctitle, model_doi_url, & ! Local variables character(len=cs) :: filein ! Input namelist filename + integer :: errflg + character(len=cx) :: errmsg !----------------------------------------------------------------------- call init_pio_subsystem() @@ -153,12 +171,20 @@ subroutine cam_init(caseid, ctitle, model_doi_url, & ! Open initial or restart file, and topo file if specified. call cam_initfiles_open() - ! Initialize model grids and decompositions - call model_grid_init() + ! Initialize constituent information + ! This will set the total number of constituents and the + ! number of advected constituents. + call cam_register_constituents(cam_runtime_opts) ! Initialize composition-dependent constants: call air_composition_init() + ! Initialize model grids and decompositions + call model_grid_init() + + ! Initialize constituent data + call cam_ccpp_initialize_constituents(columns_on_task, pver, errflg, errmsg) + ! Initialize ghg surface values before default initial distributions ! are set in dyn_init !!XXgoldyXX: This needs to be converted to CCPP and the issue of @@ -461,6 +487,60 @@ subroutine cam_final(cam_out, cam_in) end subroutine cam_final +!----------------------------------------------------------------------- + + subroutine cam_register_constituents(cam_runtime_opts) + ! Call the CCPP interface to register all constituents for the + ! physics suite being invoked during this run. + use cam_abortutils, only: endrun + use runtime_obj, only: runtime_options + use cam_constituents, only: cam_constituents_init + use ccpp_constituent_prop_mod, only: ccpp_constituent_prop_ptr_t + use cam_ccpp_cap, only: cam_ccpp_register_constituents + use cam_ccpp_cap, only: cam_ccpp_number_constituents + use cam_ccpp_cap, only: cam_model_const_properties + use cam_ccpp_cap, only: cam_const_get_index + + ! Dummy arguments + type(runtime_options), intent(in) :: cam_runtime_opts + ! Local variables + integer :: index + integer :: num_advect + integer, allocatable :: ind_water_spec(:) + integer :: errflg + character(len=cx) :: errmsg + type(ccpp_constituent_prop_ptr_t), pointer :: const_props(:) + character(len=*), parameter :: subname = 'cam_register_constituents: ' + + ! Register the constituents to find out what needs advecting + call host_constituents(1)%instantiate(std_name="specific_humidity", & + long_name="Specific humidity", units="kg kg-1", & + vertical_dim="vertical_layer_dimension", advected=.true., & + errcode=errflg, errmsg=errmsg) + if (errflg /= 0) then + call endrun(subname//trim(errmsg), file=__FILE__, line=__LINE__) + end if + call cam_ccpp_register_constituents(cam_runtime_opts%suite_as_list(), & + host_constituents, errcode=errflg, errmsg=errmsg) + + if (errflg /= 0) then + call endrun(subname//trim(errmsg), file=__FILE__, line=__LINE__) + end if + call cam_ccpp_number_constituents(num_advect, advected=.true., & + errcode=errflg, errmsg=errmsg) + + if (errflg /= 0) then + call endrun(subname//trim(errmsg), file=__FILE__, line=__LINE__) + end if + + ! Grab a pointer to the constituent array + const_props => cam_model_const_properties() + + ! Finally, initialize the constituents module + call cam_constituents_init(const_props, num_advect) + + end subroutine cam_register_constituents + !----------------------------------------------------------------------- end module cam_comp diff --git a/src/control/cam_logfile.F90 b/src/control/cam_logfile.F90 index 8b63506e..8c25d10c 100644 --- a/src/control/cam_logfile.F90 +++ b/src/control/cam_logfile.F90 @@ -28,12 +28,15 @@ module cam_logfile !----------------------------------------------------------------------- ! Public data ---------------------------------------------------------- !----------------------------------------------------------------------- - integer, public, protected :: iulog = 6 integer, public, parameter :: DEBUGOUT_NONE = 0 integer, public, parameter :: DEBUGOUT_INFO = 1 integer, public, parameter :: DEBUGOUT_VERBOSE = 2 integer, public, parameter :: DEBUGOUT_DEBUG = 3 integer, public, protected :: debug_output = DEBUGOUT_NONE + !> \section arg_table_cam_logfile Argument Table + !! \htmlinclude cam_logfile.html + integer, public, protected :: iulog = 6 + logical, public, protected :: log_output = .false. !----------------------------------------------------------------------- ! Private data --------------------------------------------------------- @@ -68,9 +71,9 @@ subroutine cam_set_log_unit(unit_num) end subroutine cam_set_log_unit subroutine cam_logfile_readnl(nlfile) - use shr_nl_mod, only: find_group_name => shr_nl_find_group_name - use spmd_utils, only: mpicom, masterprocid, masterproc - use mpi, only: mpi_integer + use mpi, only: mpi_integer + use shr_nl_mod, only: find_group_name => shr_nl_find_group_name + use spmd_utils, only: mpicom, masterprocid, masterproc ! nlfile: filepath for file containing namelist input character(len=*), intent(in) :: nlfile @@ -84,6 +87,10 @@ subroutine cam_logfile_readnl(nlfile) namelist /cam_logfile_nl/ debug_output !------------------------------------------------------------------------ + ! Since cam_set_log_unit is called before spmd_init is called, + ! set log_output flag here + log_output = masterproc + if (masterproc) then open(newunit=unitn, file=trim(nlfile), status='old') call find_group_name(unitn, 'cam_logfile_nl', status=ierr) diff --git a/src/control/cam_logfile.meta b/src/control/cam_logfile.meta new file mode 100644 index 00000000..829ed975 --- /dev/null +++ b/src/control/cam_logfile.meta @@ -0,0 +1,19 @@ +[ccpp-table-properties] + name = cam_logfile + type = module + +[ccpp-arg-table] + name = cam_logfile + type = module +[ iulog ] + standard_name = log_output_unit + units = 1 + type = integer + dimensions = () + protected = True +[ log_output ] + standard_name = do_log_output + units = flag + type = logical + dimensions = () + protected = True diff --git a/src/control/camsrfexch.F90 b/src/control/camsrfexch.F90 index dfbcd75a..912ba87f 100644 --- a/src/control/camsrfexch.F90 +++ b/src/control/camsrfexch.F90 @@ -6,7 +6,6 @@ module camsrfexch !----------------------------------------------------------------------- use shr_kind_mod, only: r8 => shr_kind_r8, r4 => shr_kind_r4 - use constituents, only: pcnst use shr_infnan_mod, only: posinf => shr_infnan_posinf, assignment(=) use cam_abortutils, only: endrun use string_utils, only: to_str @@ -155,7 +154,6 @@ subroutine cam_export(state, cam_out) use physics_types, only: physics_state use vert_coord, only: pver use physconst, only: rair, mwdry, mwco2, gravit - use constituents, only: pcnst ! Input arguments type(physics_state), intent(in) :: state diff --git a/src/control/runtime_obj.F90 b/src/control/runtime_obj.F90 index a344af5c..0c84c3f5 100644 --- a/src/control/runtime_obj.F90 +++ b/src/control/runtime_obj.F90 @@ -24,7 +24,10 @@ module runtime_obj ! update_thermo_variables: update thermo "constants" to composition-dependent thermo variables logical, private :: update_thermo_variables = .false. contains + ! General runtime access procedure, public :: physics_suite + procedure, public :: suite_as_list + ! Runtime parameters of interest to dycore procedure, public :: waccmx_on procedure, public :: waccmx_option procedure, public :: gw_front @@ -41,41 +44,48 @@ module runtime_obj CONTAINS - character(len=CS) function physics_suite(self) + pure character(len=CS) function physics_suite(self) class(runtime_options), intent(in) :: self physics_suite = trim(self%phys_suite) end function physics_suite - logical function waccmx_on(self) + pure function suite_as_list(self) result(slist) + class(runtime_options), intent(in) :: self + character(len=CS) :: slist(1) + + slist = (/ trim(self%phys_suite) /) + end function suite_as_list + + pure logical function waccmx_on(self) class(runtime_options), intent(in) :: self waccmx_on = trim(self%waccmx_opt) /= unset_str end function waccmx_on - character(len=16) function waccmx_option(self) + pure character(len=16) function waccmx_option(self) class(runtime_options), intent(in) :: self waccmx_option = trim(self%waccmx_opt) end function waccmx_option - logical function gw_front(self) + pure logical function gw_front(self) class(runtime_options), intent(in) :: self gw_front = self%use_gw_front end function gw_front - logical function gw_front_igw(self) + pure logical function gw_front_igw(self) class(runtime_options), intent(in) :: self gw_front_igw = self%use_gw_front_igw end function gw_front_igw - logical function update_thermodynamic_variables(self) + pure logical function update_thermodynamic_variables(self) class(runtime_options), intent(in) :: self update_thermodynamic_variables = self%update_thermo_variables diff --git a/src/control/runtime_opts.F90 b/src/control/runtime_opts.F90 index aa2dfb10..12081a81 100644 --- a/src/control/runtime_opts.F90 +++ b/src/control/runtime_opts.F90 @@ -25,7 +25,7 @@ subroutine read_namelist(nlfilename, single_column, scmlat, scmlon) use cam_abortutils, only: endrun use cam_logfile, only: cam_logfile_readnl, iulog use cam_initfiles, only: cam_initfiles_readnl - use constituents, only: cnst_readnl + use cam_constituents, only: cam_constituents_readnl use cam_ccpp_scheme_namelists, only: cam_read_ccpp_scheme_namelists use runtime_obj, only: cam_set_runtime_opts, unset_str use cam_ccpp_cap, only: ccpp_physics_suite_schemes @@ -36,7 +36,6 @@ subroutine read_namelist(nlfilename, single_column, scmlat, scmlon) ! use scamMod, only: scam_readnl use physconst, only: physconst_readnl - use air_composition, only: air_composition_readnl use phys_comp, only: phys_readnl, phys_suite_name use vert_coord, only: vert_coord_readnl use ref_pres, only: ref_pres_readnl @@ -90,9 +89,8 @@ subroutine read_namelist(nlfilename, single_column, scmlat, scmlon) call cam_logfile_readnl(nlfilename) ! call physics_grid_readnl(nlfilename) call physconst_readnl(nlfilename) - call air_composition_readnl(nlfilename) call cam_initfiles_readnl(nlfilename) - call cnst_readnl(nlfilename) + call cam_constituents_readnl(nlfilename) ! call history_readnl(nlfilename) call phys_readnl(nlfilename) ! Should set phys_suite_name call vert_coord_readnl(nlfilename) diff --git a/src/data/air_composition.F90 b/src/data/air_composition.F90 index 3d87c950..fb51066b 100644 --- a/src/data/air_composition.F90 +++ b/src/data/air_composition.F90 @@ -1,16 +1,16 @@ ! air_composition module defines major species of the atmosphere and manages the physical properties that are dependent on the composition of air module air_composition - use ccpp_kinds, only: kind_phys - use cam_abortutils, only: endrun, check_allocate - use runtime_obj, only: unset_real, unset_int + use ccpp_kinds, only: kind_phys + use cam_abortutils, only: endrun, check_allocate + use runtime_obj, only: unset_real, unset_int use phys_vars_init_check, only: std_name_len + use physics_types, only: cpairv, rairv, cappav, mbarv, zvirv implicit none private save - public :: air_composition_readnl public :: air_composition_init public :: air_composition_update ! get_cp_dry: (generalized) heat capacity for dry air @@ -30,10 +30,7 @@ module air_composition ! composition of air ! - integer, parameter :: num_names_max = 30 - character(len=std_name_len) :: dry_air_species(num_names_max) - character(len=std_name_len) :: water_species_in_air(num_names_max) - + logical, protected, public, allocatable :: const_is_water_species(:) integer, protected, public :: dry_air_species_num integer, protected, public :: water_species_in_air_num @@ -97,17 +94,6 @@ module air_composition real(kind_phys), public, protected :: n2_mwi = unset_real ! Inverse mol. weight of N2 real(kind_phys), public, protected :: mbar = unset_real ! Mean mass at mid level - ! cpairv: composition dependent specific heat at constant pressure - real(kind_phys), public, protected, allocatable :: cpairv(:,:) - ! rairv: composition dependent gas "constant" - real(kind_phys), public, protected, allocatable :: rairv(:,:) - ! cappav: rairv / cpairv - real(kind_phys), public, protected, allocatable :: cappav(:,:) - ! mbarv: composition dependent atmosphere mean mass - real(kind_phys), public, protected, allocatable :: mbarv(:,:) - ! zvirv: rh2o / rair - 1 - real(kind_phys), public, protected, allocatable :: zvirv(:,:) - ! ! Interfaces for public routines interface get_cp_dry @@ -136,113 +122,25 @@ module air_composition CONTAINS - ! Read namelist variables. - subroutine air_composition_readnl(nlfile) - use shr_nl_mod, only: find_group_name => shr_nl_find_group_name - use spmd_utils, only: masterproc, mpicom, masterprocid - use mpi, only: mpi_character - use cam_logfile, only: iulog - - ! Dummy argument: filepath for file containing namelist input - character(len=*), intent(in) :: nlfile - - ! Local variables - integer :: unitn, ierr, indx - integer, parameter :: lsize = 76 - character(len=*), parameter :: subname = 'air_composition_readnl :: ' - character(len=lsize) :: banner - character(len=lsize) :: bline - - ! Variable components of dry air and water species in air - namelist /air_composition_nl/ dry_air_species, water_species_in_air - !----------------------------------------------------------------------- - - banner = repeat('*', lsize) - bline = "***"//repeat(' ', lsize - 6)//"***" - - ! Read variable components of dry air and water species in air - dry_air_species = (/ (' ', indx = 1, num_names_max) /) - water_species_in_air = (/ (' ', indx = 1, num_names_max) /) - - if (masterproc) then - open(newunit=unitn, file=trim(nlfile), status='old') - call find_group_name(unitn, 'air_composition_nl', status=ierr) - if (ierr == 0) then - read(unitn, air_composition_nl, iostat=ierr) - if (ierr /= 0) then - call endrun(subname//'ERROR reading namelist, air_composition_nl') - end if - end if - close(unitn) - end if - - call mpi_bcast(dry_air_species, len(dry_air_species)*num_names_max, & - mpi_character, masterprocid, mpicom, ierr) - if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: dry_air_species") - call mpi_bcast(water_species_in_air, & - len(water_species_in_air)*num_names_max, mpi_character, & - masterprocid, mpicom, ierr) - if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: water_species_in_air") - - dry_air_species_num = 0 - water_species_in_air_num = 0 - do indx = 1, num_names_max - if ( (LEN_TRIM(dry_air_species(indx)) > 0) .and. & - (TRIM(dry_air_species(indx)) /= 'N2')) then - dry_air_species_num = dry_air_species_num + 1 - end if - if (LEN_TRIM(water_species_in_air(indx)) > 0) then - water_species_in_air_num = water_species_in_air_num + 1 - end if - end do - - ! Initialize number of thermodynamically active species - thermodynamic_active_species_num = & - dry_air_species_num + water_species_in_air_num - - if (masterproc) then - write(iulog, *) banner - write(iulog, *) bline - - if (dry_air_species_num == 0) then - write(iulog, *) " Thermodynamic properties of dry air are ", & - "fixed at troposphere values" - else - write(iulog, *) " Thermodynamic properties of dry air are ", & - "based on variable composition of the following species:" - do indx = 1, dry_air_species_num - write(iulog, *) ' ', trim(dry_air_species(indx)) - end do - write(iulog,*) ' ' - end if - write(iulog,*) " Thermodynamic properties of moist air are ", & - "based on variable composition of the following water species:" - do indx = 1, water_species_in_air_num - write(iulog, *) ' ', trim(water_species_in_air(indx)) - end do - write(iulog, *) bline - write(iulog, *) banner - end if - - end subroutine air_composition_readnl - !=========================================================================== subroutine air_composition_init() - use string_utils, only: to_str - use spmd_utils, only: masterproc - use cam_logfile, only: iulog - use physconst, only: r_universal, cpair, rair, cpwv, rh2o, cpliq, cpice, mwdry, zvir, mwh2o - use physics_types,only: ix_qv, ix_cld_liq, ix_rain !!XXgoldyXXRemove once constituents are enabled - use physics_grid, only: pcols => columns_on_task - use vert_coord, only: pver - - integer :: icnst, ix, isize, ierr, idx - integer :: liq_num, ice_num - integer :: liq_idx(water_species_in_air_num) - integer :: ice_idx(water_species_in_air_num) + use string_utils, only: to_str + use spmd_utils, only: masterproc + use cam_logfile, only: iulog + use physconst, only: r_universal, cpwv + use physconst, only: rh2o, cpliq, cpice + use physics_grid, only: pcols => columns_on_task + use vert_coord, only: pver + use cam_constituents, only: const_name, num_advected + + integer :: icnst, ix, ierr, idx + integer :: liq_num, ice_num, water_species_num, dry_species_num + integer :: liq_idx(num_advected) + integer :: ice_idx(num_advected) logical :: has_liq, has_ice real(kind_phys) :: mw + character(len=std_name_len) :: cnst_stdname character(len=*), parameter :: subname = 'air_composition_init' @@ -282,51 +180,33 @@ subroutine air_composition_init() ! init for variable composition dry air - isize = dry_air_species_num + water_species_in_air_num - allocate(thermodynamic_active_species_idx(isize), stat=ierr) - call check_allocate(ierr, subname,'thermodynamic_active_species_idx(isize)', & + allocate(thermodynamic_active_species_idx(0:num_advected), stat=ierr) + call check_allocate(ierr, subname,'thermodynamic_active_species_idx(num_advected)', & file=__FILE__, line=__LINE__) - allocate(thermodynamic_active_species_idx_dycore(isize), stat=ierr) - call check_allocate(ierr, subname,'thermodynamic_active_species_idx_dycore(isize)', & + allocate(thermodynamic_active_species_idx_dycore(num_advected), stat=ierr) + call check_allocate(ierr, subname,'thermodynamic_active_species_idx_dycore(num_advected)', & file=__FILE__, line=__LINE__) - allocate(thermodynamic_active_species_cp(0:isize), stat=ierr) - call check_allocate(ierr, subname,'thermodynamic_active_species_cp(0:isize)', & + allocate(thermodynamic_active_species_cp(0:num_advected), stat=ierr) + call check_allocate(ierr, subname,'thermodynamic_active_species_cp(0:num_advected)', & file=__FILE__, line=__LINE__) - allocate(thermodynamic_active_species_cv(0:isize), stat=ierr) - call check_allocate(ierr, subname,'thermodynamic_active_species_cv(0:isize)', & + allocate(thermodynamic_active_species_cv(0:num_advected), stat=ierr) + call check_allocate(ierr, subname,'thermodynamic_active_species_cv(0:num_advected)', & file=__FILE__, line=__LINE__) - allocate(thermodynamic_active_species_R(0:isize), stat=ierr) - call check_allocate(ierr, subname,'thermodynamic_active_species_R(0:isize)', & + allocate(thermodynamic_active_species_R(0:num_advected), stat=ierr) + call check_allocate(ierr, subname,'thermodynamic_active_species_R(0:num_advected)', & file=__FILE__, line=__LINE__) - isize = dry_air_species_num - allocate(thermodynamic_active_species_mwi(0:isize), stat=ierr) - call check_allocate(ierr, subname,'thermodynamic_active_species_mwi(0:isize)', & - file=__FILE__, line=__LINE__) - allocate(thermodynamic_active_species_kv(0:isize), stat=ierr) - call check_allocate(ierr, subname,'thermodynamic_active_species_kv(0:isize)', & - file=__FILE__, line=__LINE__) - allocate(thermodynamic_active_species_kc(0:isize), stat=ierr) - call check_allocate(ierr, subname,'thermodynamic_active_species_kc(0:isize)', & - file=__FILE__, line=__LINE__) - !------------------------------------------------------------------------ - ! Allocate constituent dependent properties - !------------------------------------------------------------------------ - allocate(cpairv(pcols,pver), stat=ierr) - call check_allocate(ierr, subname,'cpairv(pcols,pver)', & - file=__FILE__, line=__LINE__) - allocate(rairv(pcols,pver), stat=ierr) - call check_allocate(ierr, subname,'rairv(pcols,pver)', & + allocate(thermodynamic_active_species_mwi(0:num_advected), stat=ierr) + call check_allocate(ierr, subname,'thermodynamic_active_species_mwi(0:num_advected)', & file=__FILE__, line=__LINE__) - allocate(cappav(pcols,pver), stat=ierr) - call check_allocate(ierr, subname,'cappav(pcols,pver)', & + allocate(thermodynamic_active_species_kv(0:num_advected), stat=ierr) + call check_allocate(ierr, subname,'thermodynamic_active_species_kv(0:num_advected)', & file=__FILE__, line=__LINE__) - allocate(mbarv(pcols,pver), stat=ierr) - call check_allocate(ierr, subname,'mbarv(pcols,pver)', & - file=__FILE__, line=__LINE__) - allocate(zvirv(pcols,pver), stat=ierr) - call check_allocate(ierr, subname, 'zvirv(pcols,pver)', & + allocate(thermodynamic_active_species_kc(0:num_advected), stat=ierr) + call check_allocate(ierr, subname,'thermodynamic_active_species_kc(0:num_advected)', & file=__FILE__, line=__LINE__) + allocate(const_is_water_species(num_advected), stat=ierr) + call check_allocate(ierr, subname, 'const_is_water_species', file=__FILE__, line=__LINE__) thermodynamic_active_species_idx = -HUGE(1) thermodynamic_active_species_idx_dycore = -HUGE(1) @@ -336,51 +216,8 @@ subroutine air_composition_init() thermodynamic_active_species_mwi = 0.0_kind_phys thermodynamic_active_species_kv = 0.0_kind_phys thermodynamic_active_species_kc = 0.0_kind_phys - !------------------------------------------------------------------------ - ! Initialize constituent dependent properties - !------------------------------------------------------------------------ - cpairv(:pcols, :pver) = cpair - rairv(:pcols, :pver) = rair - cappav(:pcols, :pver) = rair / cpair - mbarv(:pcols, :pver) = mwdry - zvirv(:pcols, :pver) = zvir - ! - if (dry_air_species_num > 0) then - ! - ! The last major species in dry_air_species is derived from the - ! others and constants associated with it are initialized here - ! - if (TRIM(dry_air_species(dry_air_species_num + 1)) == 'N2') then -!!XXgoldyXX: Un-comment once constituents are enabled -#if 0 - call air_species_info('N', ix, mw) - mw = 2.0_kind_phys * mw - icnst = 0 ! index for the derived tracer N2 - thermodynamic_active_species_cp(icnst) = cp2 / mw - thermodynamic_active_species_cv(icnst) = cv2 / mw !N2 - thermodynamic_active_species_R (icnst) = r_universal / mw - thermodynamic_active_species_mwi(icnst) = 1.0_kind_phys / mw - thermodynamic_active_species_kv(icnst) = kv2 - thermodynamic_active_species_kc(icnst) = kc2 -#endif -!!XXgoldyXX: Un-comment once constituents are enabled - ! - ! if last major species is not N2 then add code here - ! - else - write(iulog, *) subname, ' derived major species not found: ', & - dry_air_species(dry_air_species_num) - call endrun(subname//': derived major species not found') - end if - else - ! - ! dry air is not species dependent - ! - icnst = 0 - thermodynamic_active_species_cp (icnst) = cpair - thermodynamic_active_species_cv (icnst) = cpair - rair - thermodynamic_active_species_R (icnst) = rair - end if + const_is_water_species = .false. + ! !************************************************************************ ! @@ -389,15 +226,17 @@ subroutine air_composition_init() !************************************************************************ ! icnst = 1 - do idx = 1, dry_air_species_num - select case (TRIM(dry_air_species(idx))) + water_species_num = 0 + dry_species_num = 0 + has_ice = .false. + do idx = 1, num_advected + cnst_stdname = const_name(idx) + select case (TRIM((cnst_stdname))) ! ! O ! case('O_mixing_ratio_wrt_dry_air') -!!XXgoldyXX: Un-comment once constituents are enabled -#if 0 - call air_species_info('O', ix, mw) + call air_species_info('O_mixing_ratio_wrt_dry_air', ix, mw) thermodynamic_active_species_idx(icnst) = ix thermodynamic_active_species_cp (icnst) = cp1 / mw thermodynamic_active_species_cv (icnst) = cv1 / mw @@ -406,15 +245,12 @@ subroutine air_composition_init() thermodynamic_active_species_kv(icnst) = kv3 thermodynamic_active_species_kc(icnst) = kc3 icnst = icnst + 1 -#endif -!!XXgoldyXX: Un-comment once constituents are enabled + dry_species_num = dry_species_num + 1 ! ! O2 ! case('O2_mixing_ratio_wrt_dry_air') -!!XXgoldyXX: Un-comment once constituents are enabled -#if 0 - call air_species_info('O2', ix, mw) + call air_species_info('O2_mixing_ratio_wrt_dry_air', ix, mw) thermodynamic_active_species_idx(icnst) = ix thermodynamic_active_species_cp (icnst) = cp2 / mw thermodynamic_active_species_cv (icnst) = cv2 / mw @@ -423,15 +259,12 @@ subroutine air_composition_init() thermodynamic_active_species_kv(icnst) = kv1 thermodynamic_active_species_kc(icnst) = kc1 icnst = icnst + 1 -#endif -!!XXgoldyXX: Un-comment once constituents are enabled + dry_species_num = dry_species_num + 1 ! ! H ! case('H_mixing_ratio_wrt_dry_air') -!!XXgoldyXX: Un-comment once constituents are enabled -#if 0 - call air_species_info('H', ix, mw) + call air_species_info('H_mixing_ratio_wrt_dry_air', ix, mw) thermodynamic_active_species_idx(icnst) = ix thermodynamic_active_species_cp (icnst) = cp1 / mw thermodynamic_active_species_cv (icnst) = cv1 / mw @@ -441,138 +274,111 @@ subroutine air_composition_init() thermodynamic_active_species_kv(icnst) = 0.0_kind_phys thermodynamic_active_species_kc(icnst) = 0.0_kind_phys icnst = icnst + 1 -#endif -!!XXgoldyXX: Un-comment once constituents are enabled + dry_species_num = dry_species_num + 1 ! - ! If support for more major species is to be included add code here + ! N2 ! - case default - write(iulog, *) subname, ' dry air component not found: ', & - dry_air_species(idx) - call endrun(subname//': dry air component not found') - end select - - if (masterproc) then - write(iulog, *) "Dry air composition ", & - TRIM(dry_air_species(idx)), & - icnst-1,thermodynamic_active_species_idx(icnst-1), & - thermodynamic_active_species_mwi(icnst-1), & - thermodynamic_active_species_cp(icnst-1), & - thermodynamic_active_species_cv(icnst-1) - end if - end do - isize = dry_air_species_num+1 - icnst = 0 ! N2 - if(isize > 0) then - if(masterproc) then - write(iulog, *) "Dry air composition ", & - TRIM(dry_air_species(idx)), & - icnst, -1, thermodynamic_active_species_mwi(icnst), & - thermodynamic_active_species_cp(icnst), & - thermodynamic_active_species_cv(icnst) - end if - end if - ! - !************************************************************************ - ! - ! Add non-dry components of moist air (water vapor and condensates) - ! - !************************************************************************ - ! - icnst = dry_air_species_num + 1 - do idx = 1, water_species_in_air_num - select case (TRIM(water_species_in_air(idx))) + case('N2_mixing_ratio_wrt_dry_air') + call air_species_info('N2_mixing_ratio_wrt_dry_air', ix, mw) + mw = 2.0_kind_phys * mw + icnst = 0 ! index for the derived tracer N2 + thermodynamic_active_species_cp(icnst) = cp2 / mw + thermodynamic_active_species_cv(icnst) = cv2 / mw !N2 + thermodynamic_active_species_R (icnst) = r_universal / mw + thermodynamic_active_species_mwi(icnst) = 1.0_kind_phys / mw + thermodynamic_active_species_kv(icnst) = kv2 + thermodynamic_active_species_kc(icnst) = kc2 ! ! Q ! case('specific_humidity') -! call air_species_info('Q', ix, mw) !!XXgoldyXX: this should be uncommented once constituents are enabled - ix = ix_qv ! this should be removed once constituents are enabled - mw = mwh2o !this should be removed once constituents are enabled + call air_species_info('specific_humidity', ix, mw) thermodynamic_active_species_idx(icnst) = ix thermodynamic_active_species_cp (icnst) = cpwv thermodynamic_active_species_cv (icnst) = cv3 / mw thermodynamic_active_species_R (icnst) = rh2o icnst = icnst + 1 + water_species_num = water_species_num + 1 + const_is_water_species(ix) = .true. ! ! CLDLIQ ! case('cloud_liquid_water_mixing_ratio_wrt_moist_air') -! call air_species_info('CLDLIQ', ix, mw) !!XXgoldyXX: this should be uncommented once constituents are enabled - ix = ix_cld_liq ! this should be removed once constituents are enabled + call air_species_info('cloud_liquid_water_mixing_ratio_wrt_moist_air', & + ix, mw) thermodynamic_active_species_idx(icnst) = ix thermodynamic_active_species_cp (icnst) = cpliq thermodynamic_active_species_cv (icnst) = cpliq liq_num = liq_num+1 liq_idx (liq_num) = ix icnst = icnst + 1 + water_species_num = water_species_num + 1 has_liq = .true. + const_is_water_species(ix) = .true. ! ! CLDICE ! - case('cloud_ice_mixing_ratio_wrt_moist_air') -! call air_species_info('CLDICE', ix, mw) !!XXgoldyXX: this should be uncommented once constituents are enabled - ix = -1 !!XXgoldyXX: Model should die if it gets here, until constituents are enabled + case('cloud_ice_water_mixing_ratio_wrt_moist_air') + call air_species_info('cloud_ice_water_mixing_ratio_wrt_moist_air', ix, mw) thermodynamic_active_species_idx(icnst) = ix thermodynamic_active_species_cp (icnst) = cpice thermodynamic_active_species_cv (icnst) = cpice ice_num = ice_num+1 ice_idx(ice_num) = ix icnst = icnst + 1 + water_species_num = water_species_num + 1 has_ice = .true. + const_is_water_species(ix) = .true. ! ! RAINQM ! case('rain_water_mixing_ratio_wrt_moist_air') -! call air_species_info('RAINQM', ix, mw) !!XXgoldyXX: this should be uncommented once constituents are enabled - ix = ix_rain !!XXgoldyXX: this should be removed once constituents are enabled + call air_species_info('rain_water_mixing_ratio_wrt_moist_air', ix, mw) thermodynamic_active_species_idx(icnst) = ix thermodynamic_active_species_cp (icnst) = cpliq thermodynamic_active_species_cv (icnst) = cpliq liq_num = liq_num+1 liq_idx(liq_num) = ix icnst = icnst + 1 + water_species_num = water_species_num + 1 has_liq = .true. + const_is_water_species(ix) = .true. ! ! SNOWQM ! case('snow_water_mixing_ratio_wrt_moist_air') -! call air_species_info('SNOWQM', ix, mw) !!XXgoldyXX: this should be uncommented once constituents are enabled - ix = -1 !!XXgoldyXX: Model should die if it gets here, until constituents are enabled + call air_species_info('snow_water_mixing_ratio_wrt_moist_air', ix, mw) thermodynamic_active_species_idx(icnst) = ix thermodynamic_active_species_cp (icnst) = cpice thermodynamic_active_species_cv (icnst) = cpice ice_num = ice_num+1 ice_idx(ice_num) = ix icnst = icnst + 1 + water_species_num = water_species_num + 1 has_ice = .true. + const_is_water_species(ix) = .true. ! ! GRAUQM ! - case('graupel_mixing_ratio_wrt_moist_air') -! call air_species_info('GRAUQM', ix, mw) !!XXgoldyXX: this should be uncommented once constituents are enabled - ix = -1 !!XXgoldyXX: Model should die if it gets here, until constituents are enabled + case('graupel_water_mixing_ratio_wrt_moist_air') + call air_species_info('graupel_water_mixing_ratio_wrt_moist_air', ix, mw) thermodynamic_active_species_idx(icnst) = ix thermodynamic_active_species_cp (icnst) = cpice thermodynamic_active_species_cv (icnst) = cpice ice_num = ice_num+1 ice_idx(ice_num) = ix icnst = icnst + 1 + water_species_num = water_species_num + 1 has_ice = .true. + const_is_water_species(ix) = .true. ! ! If support for more major species is to be included add code here ! - case default - write(iulog, *) subname, ' moist air component not found: ', & - water_species_in_air(idx) - call endrun(subname//': moist air component not found') end select - ! - ! - ! + if (masterproc) then write(iulog, *) "Thermodynamic active species ", & - TRIM(water_species_in_air(idx)) + TRIM(cnst_stdname) write(iulog, *) " global index : ", & icnst-1 write(iulog, *) " thermodynamic_active_species_idx : ", & @@ -595,6 +401,10 @@ subroutine air_composition_init() has_ice = .false. end do + water_species_in_air_num = water_species_num + dry_air_species_num = dry_species_num + thermodynamic_active_species_num = water_species_num + dry_species_num + allocate(thermodynamic_active_species_liq_idx(liq_num), stat=ierr) call check_allocate(ierr, subname,'thermodynamic_active_species_liq_idx(liq_num)', & file=__FILE__, line=__LINE__) @@ -1116,32 +926,19 @@ end subroutine update_zvirv !=========================================================================== subroutine air_species_info(name, index, molec_weight, caller) - use cam_abortutils, only: endrun - use cam_logfile, only: iulog - !!XXgoldyXX: v until we get constituents figured out in CCPP -#if 0 - !!XXgoldyXX: ^ until we get constituents figured out in CCPP - use constituents, only: cnst_get_ind, cnst_mw - !!XXgoldyXX: v until we get constituents figured - !out in CCPP -#endif - !!XXgoldyXX: ^ until we get constituents - !figured out in CCPP - ! Find the constituent index of and return it in - ! . Return the constituent molecular weight in - ! + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + use cam_constituents, only: const_get_index, const_molec_weight ! Dummy arguments character(len=*), intent(in) :: name - integer, intent(inout) :: index + integer, intent(out) :: index real(kind_phys), intent(out) :: molec_weight character(len=*), optional, intent(in) :: caller ! Local parameter character(len=*), parameter :: subname = 'air_species_info: ' - !!XXgoldyXX: vv commented out until we get constituents figured out - !call cnst_get_ind(trim(name), index, abort=.false.) - !!XXgoldyXX^^ commented out until we get constituents figured out + call const_get_index(name, index, abort=.false.) if (index < 1) then if (present(caller)) then write(iulog, *) trim(caller), ": air component not found, '", & @@ -1155,9 +952,7 @@ subroutine air_species_info(name, index, molec_weight, caller) trim(name)//"'") end if else - !!XXgoldyXX vv commented out until we get constituents figured out - ! molec_weight = cnst_mw(index) - !!XXgoldyXX ^^ commented out until we get constituents figured out + molec_weight = const_molec_weight(index) end if end subroutine air_species_info diff --git a/src/data/air_composition.meta b/src/data/air_composition.meta index cb335637..c5018d4e 100644 --- a/src/data/air_composition.meta +++ b/src/data/air_composition.meta @@ -29,33 +29,3 @@ units = g mol-1 type = real | kind = kind_phys dimensions = () -[ cpairv ] - standard_name = composition_dependent_specific_heat_of_dry_air_at_constant_pressure - units = J kg-1 K-1 - type = real | kind = kind_phys - dimensions = (horizontal_dimension, vertical_layer_dimension) - protected = True -[ rairv ] - standard_name = composition_dependent_gas_constant_of_dry_air - units = J kg-1 K-1 - type = real | kind = kind_phys - dimensions = (horizontal_dimension, vertical_layer_dimension) - protected = True -[ cappav ] - standard_name = composition_dependent_ratio_of_dry_air_gas_constant_to_specific_heat_at_constant_pressure - units = 1 - type = real | kind = kind_phys - dimensions = (horizontal_dimension, vertical_layer_dimension) - protected = True -[ mbarv ] - standard_name = composition_dependent_mean_molecular_dry_air_weight_at_mid_level - units = g mol-1 - type = real | kind = kind_phys - dimensions = (horizontal_dimension, vertical_layer_dimension) - protected = True -[ zvirv ] - standard_name = composition_dependent_ratio_of_water_vapor_to_dry_air_gas_constants_minus_one - units = 1 - type = real | kind = kind_phys - dimensions = (horizontal_dimension, vertical_layer_dimension) - protected = True diff --git a/src/data/cam_var_init_marks.inc b/src/data/cam_var_init_marks.inc index a9a207e9..b9b44c03 100644 --- a/src/data/cam_var_init_marks.inc +++ b/src/data/cam_var_init_marks.inc @@ -102,15 +102,16 @@ end function is_initialized - logical function is_read_from_file(varname, stdnam_idx_out) + subroutine is_read_from_file(varname, is_read, stdnam_idx_out) - ! This function checks if the variable, , is read from + ! This subroutine checks if the variable, , is read from ! file according to the 'initialized_vars' array. use cam_abortutils, only: endrun ! Dummy arguments character(len=*), intent(in) :: varname ! Variable name being checked + logical, intent(out) :: is_read ! Set to .true. if from file integer, optional, intent(out) :: stdnam_idx_out ! Local variables @@ -119,19 +120,29 @@ logical :: found ! Check that was found character(len=*), parameter :: subname = 'is_read_from_file: ' - is_read_from_file = .false. + is_read = .false. found = .false. ! Return .true. if the variable's status is READ_FROM_FILE: do stdnam_idx = 1, phys_var_num if (trim(phys_var_stdnames(stdnam_idx)) == trim(varname)) then - is_read_from_file = (initialized_vars(stdnam_idx) == READ_FROM_FILE) + is_read = (initialized_vars(stdnam_idx) == READ_FROM_FILE) ! Mark as found: found = .true. exit ! Exit loop once variable has been found and checked end if end do + if (.not. found) then + ! Check to see if this is an internally-protected variable + do stdnam_idx = 1, phys_const_num + if (trim(phys_const_stdnames(stdnam_idx)) == trim(varname)) then + found = .true. + exit ! Exit loop once variable has been found + end if + end do + end if + if (.not. found) then ! This condition is an internal error, it should not happen call endrun(subname//": Variable '"//trim(varname)// & @@ -141,4 +152,4 @@ stdnam_idx_out = stdnam_idx end if - end function is_read_from_file + end subroutine is_read_from_file diff --git a/src/data/generate_registry_data.py b/src/data/generate_registry_data.py index 37415301..7541c56a 100755 --- a/src/data/generate_registry_data.py +++ b/src/data/generate_registry_data.py @@ -25,6 +25,7 @@ if __SPINSCRIPTS not in sys.path: sys.path.append(__SPINSCRIPTS) # end if +_ALL_STRINGS_REGEX = re.compile(r'[A-Za-z][A-Za-z_0-9]+') # CCPP framework imports # pylint: disable=wrong-import-position @@ -152,6 +153,7 @@ def __init__(self, elem_node, local_name, dimensions, known_types, self.__standard_name = elem_node.get('standard_name') self.__long_name = '' self.__initial_value = '' + self.__initial_val_vars = set() self.__ic_names = None self.__elements = [] self.__protected = protected @@ -159,6 +161,7 @@ def __init__(self, elem_node, local_name, dimensions, known_types, self.__local_index_name = local_index_name self.__local_index_name_str = local_index_name_str self.__allocatable = elem_node.get('allocatable', default=alloc_default) + self.__advected = elem_node.get("advected", default=False) self.__tstep_init = elem_node.get("phys_timestep_init_zero", default=tstep_init_default) if self.__allocatable == "none": @@ -206,8 +209,11 @@ def write_metadata(self, outfile): outfile.write(f' type = {self.var_type}\n') # end if outfile.write(f' dimensions = {self.dimension_string}\n') + if self.is_advected: + outfile.write(' advected = true\n') + # end if - def write_initial_value(self, outfile, indent, init_var, ddt_str, + def write_initial_value(self, outfile, indent, init_var, ddt_str, physconst_vars, tstep_init=False): """Write the code for the initial value of this variable and/or one of its array elements.""" @@ -276,9 +282,16 @@ def write_initial_value(self, outfile, indent, init_var, ddt_str, elif init_val: outfile.write(f"if ({init_var}) then", indent) outfile.write(f"{var_name} = {init_val}", indent+1) + if self.initial_val_vars and self.initial_val_vars.issubset(physconst_vars): + outfile.write(f"call mark_as_initialized('{self.standard_name}')", indent+1) + # end if outfile.write("end if", indent) # end if + def set_initial_val_vars(self, init_vars): + """Set the initial value variable set""" + self.__initial_val_vars = init_vars + @property def local_name(self): """Return the local (variable) name for this variable""" @@ -324,6 +337,11 @@ def initial_value(self): """Return the initial_value for this variable""" return self.__initial_value + @property + def initial_val_vars(self): + """Return the initial_val_var_array for this variable""" + return self.__initial_val_vars + @property def ic_names(self): """Return list of possible Initial Condition (IC) file input names""" @@ -372,6 +390,11 @@ def is_ddt(self): """Return True iff this variable is a derived type""" return self.__type.ddt + @property + def is_advected(self): + """Return True if this variable is advected""" + return self.__advected + @property def tstep_init(self): """Return True if variable will be set to zero every physics timestep.""" @@ -475,9 +498,10 @@ class Variable(VarBase): # Constant dimensions __CONSTANT_DIMENSIONS = {'ccpp_constant_one' : 1, 'ccpp_constant_zero' : 0} - __VAR_ATTRIBUTES = ["access", "allocatable", "dycore", "extends", - "kind", "local_name", "name", "standard_name", - "type", "units", "version", "phys_timestep_init_zero"] + __VAR_ATTRIBUTES = ["access", "advected", "allocatable", "dycore", + "extends", "kind", "local_name", "name", + "phys_timestep_init_zero", "standard_name", + "type", "units", "version"] def __init__(self, var_node, known_types, vdict, logger): # pylint: disable=too-many-locals @@ -653,14 +677,13 @@ def write_definition(self, outfile, access, indent, # end if type_str = self.type_string + tpad # Initial value + init_str = "" if self.initial_value: if self.allocatable == "pointer": init_str = f" => {self.initial_value}" elif not (self.allocatable[0:11] == 'allocatable'): init_str = f" = {self.initial_value}" # end if (no else, do not initialize allocatable fields) - else: - init_str = "" # end if if self.long_name: comment = ' ! ' + self.local_name + ": " + self.long_name @@ -674,7 +697,7 @@ def write_definition(self, outfile, access, indent, outfile.write(var_dec_str, indent) def write_allocate_routine(self, outfile, indent, - init_var, reall_var, ddt_str): + init_var, reall_var, ddt_str, physconst_vars): """Write the code to allocate and initialize this Variable is a string to use to write initialization test code. is a string to use to write reallocate test code. @@ -697,7 +720,7 @@ def write_allocate_routine(self, outfile, indent, # end if for var in my_ddt.variable_list(): var.write_allocate_routine(outfile, subi, - init_var, reall_var, sub_ddt_str) + init_var, reall_var, sub_ddt_str, physconst_vars) else: # Do we need to allocate this variable? lname = f'{ddt_str}{self.local_name}' @@ -725,17 +748,17 @@ def write_allocate_routine(self, outfile, indent, # end if if self.allocatable != "parameter": # Initialize the variable - self.write_initial_value(outfile, indent, init_var, ddt_str) + self.write_initial_value(outfile, indent, init_var, ddt_str, physconst_vars) for elem in self.elements: if elem.initial_value: elem.write_initial_value(outfile, indent, - init_var, ddt_str) + init_var, ddt_str, physconst_vars) # end if # end for # end if def write_tstep_init_routine(self, outfile, indent, - ddt_str, init_val=False): + ddt_str, physconst_vars, init_val=False): """ Write the code to iniitialize this variable to zero at the start of each physics timestep. @@ -762,7 +785,7 @@ def write_tstep_init_routine(self, outfile, indent, raise ParseInternalError(emsg) # end if for var in my_ddt.variable_list(): - var.write_tstep_init_routine(outfile, subi, sub_ddt_str, + var.write_tstep_init_routine(outfile, subi, sub_ddt_str, physconst_vars, init_val=self.tstep_init) else: @@ -784,7 +807,7 @@ def write_tstep_init_routine(self, outfile, indent, outfile.write(comment, indent) # Initialize the variable: - self.write_initial_value(outfile, indent, "", ddt_str, + self.write_initial_value(outfile, indent, "", ddt_str, physconst_vars, tstep_init=True) # end if @@ -822,6 +845,7 @@ def __init__(self, name, ttype, logger): self.__logger = logger self.__standard_names = [] self.__dimensions = set() # All known dimensions for this dictionary + self.__initial_value_vars = set() # All known initial value variables for this dict @property def name(self): @@ -838,6 +862,11 @@ def known_dimensions(self): """Return the set of known dimensions for this dictionary""" return self.__dimensions + @property + def known_initial_value_vars(self): + """Return the set of known initial value variables for this dictionary""" + return self.__initial_value_vars + def add_variable(self, newvar): """Add a variable if it does not conflict with existing entries""" local_name = newvar.local_name @@ -879,6 +908,18 @@ def add_variable(self, newvar): # end if # end for # end for + # Parse out all strings from initial value + all_strings = _ALL_STRINGS_REGEX.findall(newvar.initial_value) + init_val_vars = set() + excluded_initializations = {'null', 'nan', 'false', 'true'} + # Exclude NULL and nan variables + for var in all_strings: + if var.lower() not in excluded_initializations: + init_val_vars.add(var) + # end if + # end if + self.__initial_value_vars.update(init_val_vars) + newvar.set_initial_val_vars(init_val_vars) def find_variable_by_local_name(self, local_name): """Return this dictionary's variable matching local name, . @@ -969,6 +1010,18 @@ def write_definition(self, outfile, access, indent): has_protect=has_prot) # end for + + def check_initial_values(self, physconst_vars): + """Raise an error if there are any initial values that are set to + non-"used" and/or non-"physconst" variables""" + for var in self.known_initial_value_vars: + if var not in physconst_vars: + emsg = f"Initial value '{var}' is not a physconst variable" + emsg += " or does not have necessary use statement" + raise CCPPError(emsg) + # end if + # end for + ############################################################################### class DDT: ############################################################################### @@ -1216,7 +1269,7 @@ def dim_sort_key(cls, dim_name): # end if return File.__dim_order[dim_name] - def write_source(self, outdir, indent, logger): + def write_source(self, outdir, indent, logger, physconst_vars): """Write out source code for the variables in this file""" ofilename = os.path.join(outdir, f"{self.name}.F90") logger.info(f"Writing registry source file, {ofilename}") @@ -1273,8 +1326,8 @@ def write_source(self, outdir, indent, logger): outfile.end_module_header() outfile.write("", 0) # Write data management subroutines - self.write_allocate_routine(outfile) - self.write_tstep_init_routine(outfile) + self.write_allocate_routine(outfile, physconst_vars) + self.write_tstep_init_routine(outfile, physconst_vars) # end with @@ -1286,7 +1339,7 @@ def tstep_init_routine_name(self): """Return the name of the physics timestep init routine for this module""" return f"{self.name}_tstep_init" - def write_allocate_routine(self, outfile): + def write_allocate_routine(self, outfile, physconst_vars): """Write a subroutine to allocate all the data in this module""" subname = self.allocate_routine_name() args = list(self.__var_dict.known_dimensions) @@ -1332,11 +1385,11 @@ def write_allocate_routine(self, outfile): outfile.write('end if', 2) outfile.write('', 0) for var in self.__var_dict.variable_list(): - var.write_allocate_routine(outfile, 2, init_var, reall_var, '') + var.write_allocate_routine(outfile, 2, init_var, reall_var, '', physconst_vars) # end for outfile.write(f'end subroutine {subname}', 1) - def write_tstep_init_routine(self, outfile): + def write_tstep_init_routine(self, outfile, physconst_vars): """ Write a subroutine to initialize registered variables to zero at the beginning of each physics timestep. @@ -1349,7 +1402,7 @@ def write_tstep_init_routine(self, outfile): subn_str = f'character(len=*), parameter :: subname = "{subname}"' outfile.write(subn_str, 2) for var in self.__var_dict.variable_list(): - var.write_tstep_init_routine(outfile, 2, '') + var.write_tstep_init_routine(outfile, 2, '', physconst_vars) # end for outfile.write('', 0) outfile.write(f'end subroutine {subname}', 1) @@ -1379,6 +1432,11 @@ def generate_code(self): """Return True if code and metadata should be generated for this File""" return self.__generate_code + @property + def use_statements(self): + """Return list of use statements""" + return self.__use_statements + @property def file_path(self): """Return file path if provided, otherwise return None""" @@ -1575,11 +1633,22 @@ def write_registry_files(registry, dycore, config, outdir, src_mod, src_root, if not os.path.exists(outdir): os.makedirs(outdir) # end if - # Write metadata for file_ in files: + # Check to see if any initial values for variables aren't "used" physconst vars + # First pull out the physconst variables used for this file + physconst_vars = set() + for ref in file_.use_statements: + if ref[0] == 'physconst': + physconst_vars.add(ref[1]) + # end if + # end for + # Then check against the initial values in the variable dictionary + # Check will raise an exception if there is a rogue variable + file_.var_dict.check_initial_values(physconst_vars) + # Generate metadata and source if file_.generate_code: file_.write_metadata(outdir, logger) - file_.write_source(outdir, indent, logger) + file_.write_source(outdir, indent, logger, physconst_vars) # end if # end for diff --git a/src/data/inputnames_to_stdnames.py b/src/data/inputnames_to_stdnames.py new file mode 100644 index 00000000..bb7a061d --- /dev/null +++ b/src/data/inputnames_to_stdnames.py @@ -0,0 +1,105 @@ +#!/usr/bin/env python3 +""" +Change variable names in NetCDF file to match those in a standard names dictionary +NOTE: Use of this script requires the user to have NCO operators (e.g. ncrename) in their path +""" +# Python library imports +import sys +import os +import argparse +import xml.etree.ElementTree as ET + +def write_new_ncdata_file(input_filename, output_filename, inputname_dict): + """Create and run ncrename command""" + base_cmd = f'ncrename -h -o {output_filename} -O' + for input_name in inputname_dict: + base_cmd += f' -v .{input_name},{inputname_dict[input_name]}' + #end for input_name in inputname_dict + base_cmd += f' {input_filename}' + os.system(base_cmd) + +def parse_stdname_file(file_to_parse): + """Parse XML standard name dictionary""" + with open(file_to_parse, encoding='utf-8') as fh1: + try: + tree = ET.parse(fh1) + root = tree.getroot() + except ET.ParseError as perr: + print(f"Cannot parse XML file {file_to_parse}") + return {} + # end try + # end with open(file_to_parse) + inputname_dict = {} + for entry in root: + stdname = entry.attrib["stdname"] + for sub_element in entry: + if sub_element.tag == "ic_file_input_names": + for input_name in sub_element: + inputname_dict[input_name.text.strip()] = stdname + # end for input_name + # end if sub_element.tag + # end if for sub_element in entry + # end if for entry in root + return inputname_dict + + +def main(input_file, output_filename, stdname_file): + """Parse standard name dictionary and then replace input name variables with stdnames""" + if not os.path.isfile(input_file): + print(f"Input file {input_file} does not exist") + return 1 + #end if not os.path.isfile(input_file) + if not os.access(input_file, os.R_OK): + print(f"Cannot open file {input_file}") + return 2 + #end if not os.access(input_file) + if not os.path.isfile(stdname_file): + print(f"Standard name dictionary {stdname_file} does not exist") + return 3 + #end if not os.path.isfile(stdname_file) + if not os.access(stdname_file, os.R_OK): + print(f"Cannot open standard name dictionary {stdname_file}") + return 4 + #end if not os.access(stdname_file) + output_dir = os.path.split(output_filename)[0] + if not output_dir.strip(): + inputfile_dir = os.path.dirname(input_file) + output_file = os.path.join(inputfile_dir, output_filename) + else: + if os.path.isdir(output_dir): + output_file = output_filename + else: + print(f"Directory {output_dir} does not exist") + return 5 + #end if os.path.isdir(output_dir) + #end if len(output_dir.strip())) == 0 + # Parse the standard name dictionary + inputname_dict = parse_stdname_file(stdname_file) + if not inputname_dict: + print(f"Standard name dictionary {stdname_file} empty or not parse-able") + return 6 + #end if inputname_dict + # use the parsed dictionary to create new NetCDF file + write_new_ncdata_file(input_file, output_file, inputname_dict) + return 0 + +def parse_command_line(arguments, description): + """Parse command-line arguments""" + parser = argparse.ArgumentParser(description=description, + formatter_class=argparse.RawTextHelpFormatter) + parser.add_argument("--input", type=str, required=True, + metavar='input file - REQUIRED', + help="Full path of NetCDF file that contains non-standard variable names (to be converted)") + parser.add_argument("--output", type=str, required=True, + metavar='output filename - REQUIRED', + help="Name of the output NetCDF file that will have standard variable names\n"\ + "Written to the same directory --input file is in;\nif full path is supplied, file is written there") + parser.add_argument("--stdnames", type=str, required=True, + metavar='stdname file', + help="Full path to the standard names dictionary (e.g. stdnames_to_inputnames_dictionary.xml)") + pargs = parser.parse_args(arguments) + return pargs + +if __name__ == "__main__": + ARGS = parse_command_line(sys.argv[1:], __doc__) + sys.exit(main(ARGS.input, ARGS.output, ARGS.stdnames)) diff --git a/src/data/namelist_definition_air_comp.xml b/src/data/namelist_definition_air_comp.xml deleted file mode 100644 index 8b93b22f..00000000 --- a/src/data/namelist_definition_air_comp.xml +++ /dev/null @@ -1,87 +0,0 @@ - - - - - - - - char*80(20) - air_composition - air_composition_nl - - List of major species of dry air. If not set then the composition of dry - air is considered fixed at tropospheric conditions and the properties of - dry air are constant. If set then the list of major species is assumed to - have 'N2' listed last. This information is currently used only for - computing the variable properties of air in WACCM-X configurations. - Default if WACCM-X: - - ['O_mixing_ratio_wrt_dry_air', 'O2_mixing_ratio_wrt_dry_air', - 'H_mixing_ratio_wrt_dry_air', 'N2_mixing_ratio_wrt_dry_air'] - - Otherwise default is None. - - - "" - - O_mixing_ratio_wrt_dry_air, - O2_mixing_ratio_wrt_dry_air, - H_mixing_ratio_wrt_dry_air, - N2_mixing_ratio_wrt_dry_air - - - - - char*80(20) - air_composition - air_composition_nl - - List of water species that are included in "moist" air. This is currently - used only by the SE dycore to generalize the computation of the moist air - mass and thermodynamic properties. - Default if CAM4, CAM5, or Kessler physics is used: - - ['specific_humidity', - 'cloud_liquid_water_mixing_ratio_wrt_moist_air', - 'rain_water_mixing_ratio_wrt_moist_air'] - - Default if CAM6 physics is used: - - ['specific_humidity', - 'cloud_liquid_water_mixing_ratio_wrt_moist_air', - 'cloud_ice_water_mixing_ratio_wrt_moist_air', - 'rain_water_mixing_ratio_wrt_moist_air', - 'snow_water_mixing_ratio_wrt_moist_air'] - - Otherwise default is: ['specific_humidity'] - - - - specific_humidity - - - specific_humidity, - cloud_liquid_water_mixing_ratio_wrt_moist_air, - rain_water_mixing_ratio_wrt_moist_air - - - specific_humidity, - cloud_liquid_water_mixing_ratio_wrt_moist_air, - rain_water_mixing_ratio_wrt_moist_air - - - specific_humidity, - cloud_liquid_water_mixing_ratio_wrt_moist_air, - rain_water_mixing_ratio_wrt_moist_air - - - specific_humidity, - cloud_liquid_water_mixing_ratio_wrt_moist_air, - cloud_ice_water_mixing_ratio_wrt_moist_air, - rain_water_mixing_ratio_wrt_moist_air, - snow_water_mixing_ratio_wrt_moist_air - - - - - diff --git a/src/data/physconst.F90 b/src/data/physconst.F90 index 21724e76..91b312b8 100644 --- a/src/data/physconst.F90 +++ b/src/data/physconst.F90 @@ -114,6 +114,7 @@ subroutine physconst_readnl(nlfile) use spmd_utils, only: masterproc, mpicom, masterprocid use mpi, only: mpi_real8 use cam_logfile, only: iulog + use runtime_obj, only: unset_real ! Dummy argument: filepath for file containing namelist input character(len=*), intent(in) :: nlfile @@ -149,7 +150,16 @@ subroutine physconst_readnl(nlfile) ! (e.g., for aqua planet experiments) namelist /physconst_nl/ user_defined_gravit, user_defined_sday, user_defined_mwh2o, user_defined_cpwv, user_defined_mwdry, & user_defined_cpair, user_defined_rearth, user_defined_tmelt, user_defined_omega - !----------------------------------------------------------------------- + !---------------------------------------------------------------------- + user_defined_gravit = UNSET_REAL + user_defined_sday = UNSET_REAL + user_defined_mwh2o = UNSET_REAL + user_defined_cpwv = UNSET_REAL + user_defined_mwdry = UNSET_REAL + user_defined_cpair = UNSET_REAL + user_defined_rearth = UNSET_REAL + user_defined_tmelt = UNSET_REAL + user_defined_omega = UNSET_REAL banner = repeat('*', lsize) bline = "***"//repeat(' ', lsize - 6)//"***" diff --git a/src/data/ref_pres.F90 b/src/data/ref_pres.F90 index 7d94fa2e..31e3c677 100644 --- a/src/data/ref_pres.F90 +++ b/src/data/ref_pres.F90 @@ -169,10 +169,30 @@ subroutine ref_pres_init(pref_edge_in, pref_mid_in, num_pr_lev_in) end if ! Tell rest of model that variables have been initialized: - call mark_as_initialized("reference_pressure_at_interface") ! pref_edge_in - call mark_as_initialized("reference_pressure") ! pref_mid_in - call mark_as_initialized("air_pressure_at_top_of_atmosphere_model") ! ptop_ref - call mark_as_initialized("reference_pressure_normalized_by_surface_pressure") ! pref_mid_norm + ! pref_edge_in + call mark_as_initialized("reference_pressure_at_interface") + ! pref_mid_in + call mark_as_initialized("reference_pressure") + ! pref_mid_norm + call mark_as_initialized("reference_pressure_normalized_by_surface_pressure") + ! ptop_ref + call mark_as_initialized("air_pressure_at_top_of_atmosphere_model") + ! psurf_ref + call mark_as_initialized("reference_pressure_at_surface") + ! num_pr_lev + call mark_as_initialized("number_of_pure_pressure_levels_at_top") + ! trop_cloud_top_lev + call mark_as_initialized("index_of_pressure_at_troposhere_cloud_top") + ! clim_modal_aero_top_lev + call mark_as_initialized("index_of_air_pressure_at_top_of_aerosol_model") + ! do_molec_press + call mark_as_initialized("largest_model_top_pressure_that_allows_molecular_diffusion") + ! molec_diff_bot_press + call mark_as_initialized("pressure_at_bottom_of_molecular_diffusion") + ! do_molec_diff + call mark_as_initialized("flag_for_molecular_diffusion") + ! nbot_molec + call mark_as_initialized("index_of_pressure_at_bottom_of_molecular_diffusion") end subroutine ref_pres_init diff --git a/src/data/ref_pres.meta b/src/data/ref_pres.meta index 83f054e9..84a70a8c 100644 --- a/src/data/ref_pres.meta +++ b/src/data/ref_pres.meta @@ -59,7 +59,7 @@ dimensions = () protected = True [ molec_diff_bot_press ] - standard_name = pressure_at_bottom_of_molcular_diffusion + standard_name = pressure_at_bottom_of_molecular_diffusion units = Pa type = real | kind = kind_phys dimensions = () @@ -71,7 +71,7 @@ dimensions = () protected = True [ nbot_molec ] - standard_name = index_of_pressure_at_bottom_of_molcular_diffusion + standard_name = index_of_pressure_at_bottom_of_molecular_diffusion units = index type = integer dimensions = () diff --git a/src/data/registry.xml b/src/data/registry.xml index 853d6e15..b7749ba1 100644 --- a/src/data/registry.xml +++ b/src/data/registry.xml @@ -4,12 +4,13 @@ $SRCROOT/src/utils/spmd_utils.meta + $SRCROOT/src/control/cam_logfile.meta $SRCROOT/src/control/camsrfexch.meta $SRCROOT/src/control/runtime_obj.meta + $SRCROOT/src/data/physconst.meta $SRCROOT/src/physics/utils/phys_comp.meta $SRCROOT/src/physics/utils/physics_grid.meta - $SRCROOT/src/physics/utils/constituents.meta - $SRCROOT/src/data/physconst.meta + $SRCROOT/src/physics/utils/cam_constituents.meta $SRCROOT/src/data/air_composition.meta $SRCROOT/src/data/cam_thermo.meta $SRCROOT/src/data/ref_pres.meta @@ -19,22 +20,11 @@ - - - 1 - - - 2 - - - 3 - + + + + + horizontal_dimension vertical_layer_dimension zm state_zm - - horizontal_dimension vertical_layer_dimension - number_of_constituents - - Q cnst_Q - - - CLDLIQ cnst_CLDLIQ - - - RAINQM cnst_RAINQM - - + horizontal_dimension vertical_layer_dimension + Q cnst_Q + x_wind y_wind lagrangian_tendency_of_air_pressure - constituent_mixing_ratio pressure_thickness pressure_thickness_of_dry_air reciprocal_of_pressure_thickness @@ -347,5 +321,46 @@ phys_timestep_init_zero="true"> Total tendency from physics suite + + + Composition-dependent specific heat of dry air at constant pressure + horizontal_dimension vertical_layer_dimension + cpair + + + Composition-dependent gas constant of dry air + horizontal_dimension vertical_layer_dimension + rair + + + Composition-dependent ratio of dry air gas constant to specific heat at constant pressure + horizontal_dimension vertical_layer_dimension + rair/cpair + + + Composition-dependent mean molecular dry air weight at mid-level + horizontal_dimension vertical_layer_dimension + mwdry + + + Composition-dependent ratio of water vapor to dry air gas constants minus one + horizontal_dimension vertical_layer_dimension + zvir + diff --git a/src/data/registry_v1_0.xsd b/src/data/registry_v1_0.xsd index 283ac61c..bc0c776f 100644 --- a/src/data/registry_v1_0.xsd +++ b/src/data/registry_v1_0.xsd @@ -139,6 +139,8 @@ + @@ -157,6 +159,8 @@ + diff --git a/src/data/stdnames_to_inputnames_dictionary.xml b/src/data/stdnames_to_inputnames_dictionary.xml new file mode 100644 index 00000000..39b0aa56 --- /dev/null +++ b/src/data/stdnames_to_inputnames_dictionary.xml @@ -0,0 +1,292 @@ + + + + + + + lat + + + + + lon + + + + + area + + + + + mdt + + + + + ps + state_ps + + + + + psdry + state_psdry + + + + + phis + state_phis + + + + + T + state_t + + + + + u + state_u + + + + + v + state_v + + + + + s + state_s + + + + + omega + state_omega + + + + + pmid + state_pmid + + + + + pmiddry + state_pmiddry + + + + + pdel + state_pdel + + + + + pdeldry + state_pdeldry + + + + + rpdel + state_rpdel + + + + + rpdeldry + state_rpdeldry + + + + + lnpmid + state_lnpmid + + + + + lnpmiddry + state_lnpmiddry + + + + + exner + state_exner + + + + + zm + state_zm + + + + + pint + state_pint + + + + + pintdry + state_pintdry + + + + + lnpint + state_lnpint + + + + + lnpintdry + state_lnpintdry + + + + + zi + state_zi + + + + + te_ini + state_te_ini + + + + + te_cur + state_te_cur + + + + + tw_ini + state_tw_ini + + + + + tw_cur + state_tw_cur + + + + + RHO + cnst_RHO + + + + + dTdt + tend_dtdt + + + + + dudt + tend_dudt + + + + + dvdt + tend_dvdt + + + + + Q + cnst_Q + + + + + CLDLIQ + cnst_CLDLIQ + + + + + CLDICE + cnst_CLDICE + + + + + RAINQM + cnst_RAINQM + + + + + SNOWQM + cnst_SNOWQM + + + + + ch4vmr + + + + + covmr + + + + + co2vmr + + + + + ccl4vmr + + + + + f11vmr + + + + + f12vmr + + + + + f113vmr + + + + + f22vmr + + + + + o2vmr + + + + + n2ovmr + + + + diff --git a/src/data/write_init_files.py b/src/data/write_init_files.py index 110841af..41f18b60 100644 --- a/src/data/write_init_files.py +++ b/src/data/write_init_files.py @@ -16,7 +16,18 @@ from var_props import is_horizontal_dimension, is_vertical_dimension # Exclude these standard names from init processing -_EXCLUDED_STDNAMES = set(['suite_name', 'suite_part']) +# Some are internal names (e.g., suite_name) +# Some are from the CCPP framework (e.g., ccpp_num_constituents) +# Some are for efficiency and to avoid dependency loops (e.g., log_output_unit) +_EXCLUDED_STDNAMES = {'suite_name', 'suite_part', + 'ccpp_num_constituents', + 'ccpp_num_advected_constituents', + 'ccpp_constituent_array', + 'ccpp_constituent_properties_array', + 'ccpp_constituent_array_minimum_values', + 'log_output_unit', 'do_log_output', + 'mpi_communicator', 'mpi_root', 'mpi_rank', + 'number_of_mpi_tasks'} # Variable input types _INPUT_TYPES = set(['in', 'inout']) @@ -40,13 +51,17 @@ def write_init_files(cap_database, ic_names, outdir, 1. phys_vars_init_check.F90 - This file contains four + This file contains five variable arrays: phys_var_stdnames - All registered variable standard names + phys_const_stdnames - + The "excluded" standard names + (from _EXCLUDED_STDNAMES) + input_var_names - All registered names for each variable that could @@ -241,22 +256,45 @@ def __init__(self, message): ################# ############################################################################## -def _find_and_add_host_variable(stdname, host_dict, var_dict, missing_vars): +def _find_and_add_host_variable(stdname, host_dict, const_dicts, var_dict): """Find in and add it to if found and not of type, 'host'. + If is not in but is in one of the , + it is considered found but not added to . If not found, add to . - Return the variable if found, otherwise None - Note: This function has side effects. + If found and added to , also process the standard names of + any intrinsic sub-elements of . + Return the list of (if any). + Note: This function has a side effect (adding to ). """ + missing_vars = [] hvar = host_dict.find_variable(stdname) - if hvar: - if hvar.source.type != 'host': - var_dict[stdname] = hvar - # end if (other variables not readable) - else: - missing_vars.add(stdname) + if hvar and (hvar.source.ptype != 'host'): + var_dict[stdname] = hvar + # Process elements (if any) + ielem = hvar.intrinsic_elements() + # List elements are the only ones we care about + if isinstance(ielem, list): + for sname in ielem: + smissing = _find_and_add_host_variable(sname, host_dict, + const_dicts, var_dict) + missing_vars.extend(smissing) + # end for + # end if + # end if + if not hvar: + cvar = None + for cdict in const_dicts: + cvar = cdict.find_variable(stdname) + if cvar: + break + # end if + # end for + if not cvar: + missing_vars.append(stdname) + # end if # end if - return hvar + return missing_vars ############################################################################## def gather_ccpp_req_vars(cap_database): @@ -268,18 +306,19 @@ def gather_ccpp_req_vars(cap_database): the host model. Return several values: - A list of host model variables - - The local name of the vertical layer dimension - - The local name of the vertical interface dimension - An error message (blank for no error) """ # Dictionary of all 'in' and 'inout' suite variables. - # Key is standard name, value is host-model variable + # Key is standard name, value is host-model or constituent variable req_vars = {} missing_vars = set() retmsg = "" - # Host model - host = cap_database.host_model_dict() + # Host model dictionary + host_dict = cap_database.host_model_dict() + # Constituent dictionaries + const_dicts = [cap_database.constituent_dictionary(s) + for s in cap_database.suite_list()] # Create CCPP datatable required variables-listing object: # XXgoldyXX: Choose only some phases here? @@ -291,19 +330,9 @@ def gather_ccpp_req_vars(cap_database): (stdname not in req_vars) and (stdname not in _EXCLUDED_STDNAMES)): # We need to work with the host model version of this variable - hvar = _find_and_add_host_variable(stdname, host, - req_vars, missing_vars) - # Expand any combo objects - if hvar: - ielem = hvar.intrinsic_elements() - else: - ielem = None - # end if - if isinstance(ielem, list): - for sname in ielem: - _find_and_add_host_variable(sname, host, - req_vars, missing_vars) - # end for + missing = _find_and_add_host_variable(stdname, host_dict, + const_dicts, req_vars) + missing_vars.update(missing) # end if # end if (do not include output variables) # end for (loop over call list) @@ -334,6 +363,9 @@ def write_ic_params(outfile, host_vars, ic_names): num_pvars = len(host_vars) outfile.write(f"integer, public, parameter :: phys_var_num = {num_pvars}", 1) + num_cvars = len(_EXCLUDED_STDNAMES) + outfile.write(f"integer, public, parameter :: phys_const_num = {num_cvars}", + 1) outfile.blank_line() @@ -447,6 +479,21 @@ def write_ic_arrays(outfile, ic_name_dict, ic_max_len, outfile.blank_line() + # Write excluded standard names + cname_max_len = max([len(x) for x in _EXCLUDED_STDNAMES]) + num_cvars = len(_EXCLUDED_STDNAMES) + vartype = f"character(len={cname_max_len}), public, protected" + varname = "phys_const_stdnames(phys_const_num)" + outfile.write(f"{vartype} :: {varname} = (/ &", 1) + suffix = ", &" + for index, stdname_str in enumerate(sorted(_EXCLUDED_STDNAMES)): + spc = ' '*(cname_max_len - len(stdname_str)) + if index == num_cvars - 1: + suffix = " /)" + # end if + outfile.write(f'"{stdname_str}{spc}"{suffix}', 2) + # end for + #Write starting declaration of IC field input names array: outfile.write("!Array storing all registered IC file input names for each variable:", 1) vartype = f"character(len={ic_max_len}), public, protected" @@ -580,7 +627,7 @@ def collect_host_var_imports(host_vars, host_dict): # We do not import variables from the 'host' table as they are # passed to physics via the argument list. # As such, they are also always considered initialized. - if hvar.source.type == 'host': + if hvar.source.ptype == 'host': continue # end if _get_host_model_import(hvar, use_vars_write_dict, host_dict) @@ -719,7 +766,7 @@ def write_phys_read_subroutine(outfile, host_dict, host_vars, host_imports, # We do not attempt to read values from variables from the 'host' # table as they are passed to physics via the argument list. # As such, they are always considered initialized. - if hvar.source.type == 'host': + if hvar.source.ptype == 'host': continue # end if var_stdname = hvar.get_prop_value('standard_name') @@ -771,8 +818,9 @@ def write_phys_read_subroutine(outfile, host_dict, host_vars, host_imports, ["shr_kind_mod", ["SHR_KIND_CS, SHR_KIND_CL, SHR_KIND_CX"]], ["physics_data", ["read_field", "find_input_name_idx", "no_exist_idx", "init_mark_idx", - "prot_no_init_idx"]], - ["cam_ccpp_cap", ["ccpp_physics_suite_variables"]], + "prot_no_init_idx", "const_idx"]], + ["cam_ccpp_cap", ["ccpp_physics_suite_variables", "cam_constituents_array"]], + ["ccpp_kinds", ["kind_phys"]], [phys_check_fname_str, ["phys_var_stdnames", "input_var_names", "std_name_len"]]] @@ -802,14 +850,16 @@ def write_phys_read_subroutine(outfile, host_dict, host_vars, host_imports, outfile.write("character(len=SHR_KIND_CL) :: missing_required_vars", 2) outfile.write("character(len=SHR_KIND_CL) :: protected_non_init_vars", 2) outfile.blank_line() - outfile.write("character(len=SHR_KIND_CX) :: errmsg !CCPP framework error message", 2) - outfile.write("integer :: errflg !CCPP framework error flag", 2) - outfile.write("integer :: name_idx !Input variable array index", 2) - outfile.write("integer :: req_idx !Required variable array index", 2) - outfile.write("integer :: suite_idx !Suite array index", 2) - outfile.write("character(len=2) :: sep = '' !String separator used to print error messages", 2) - outfile.write("character(len=2) :: sep2 = '' !String separator used to print error messages", 2) - outfile.write("character(len=2) :: sep3 = '' !String separator used to print error messages", 2) + outfile.write("character(len=SHR_KIND_CX) :: errmsg !CCPP framework error message", 2) + outfile.write("integer :: errflg !CCPP framework error flag", 2) + outfile.write("integer :: name_idx !Input variable array index", 2) + outfile.write("integer :: constituent_idx !Constituent table index", 2) + outfile.write("integer :: req_idx !Required variable array index", 2) + outfile.write("integer :: suite_idx !Suite array index", 2) + outfile.write("character(len=2) :: sep !String separator used to print err messages", 2) + outfile.write("character(len=2) :: sep2 !String separator used to print err messages", 2) + outfile.write("character(len=2) :: sep3 !String separator used to print err messages", 2) + outfile.write("real(kind=kind_phys), pointer :: field_data_ptr(:,:,:)", 2) outfile.blank_line() outfile.comment("Logical to default optional argument to False:", 2) outfile.write("logical :: use_init_variables", 2) @@ -820,6 +870,9 @@ def write_phys_read_subroutine(outfile, host_dict, host_vars, host_imports, 2) outfile.write("missing_required_vars = ' '", 2) outfile.write("protected_non_init_vars = ' '", 2) + outfile.write("sep = ''", 2) + outfile.write("sep2 = ''", 2) + outfile.write("sep3 = ''", 2) outfile.blank_line() outfile.comment("Initialize use_init_variables based on whether it " + \ "was input to function:", 2) @@ -850,7 +903,7 @@ def write_phys_read_subroutine(outfile, host_dict, host_vars, host_imports, # Call input name search function: outfile.comment("Find IC file input name array index for required variable:", 4) - outfile.write("name_idx = find_input_name_idx(ccpp_required_data(req_idx), use_init_variables)", 4) + outfile.write("name_idx = find_input_name_idx(ccpp_required_data(req_idx), use_init_variables, constituent_idx)", 4) # Start select-case statement: outfile.blank_line() @@ -891,6 +944,14 @@ def write_phys_read_subroutine(outfile, host_dict, host_vars, host_imports, outfile.write("sep2 = ', '", 6) outfile.blank_line() + # Handle the case where the required variable is a constituent + outfile.write("case (const_idx)", 5) + outfile.blank_line() + outfile.comment("If an index was found in the constituent hash table, then read in the data to that index of the constituent array", 6) + outfile.blank_line() + outfile.write("field_data_ptr => cam_constituents_array()", 6) + outfile.write("call read_field(file, ccpp_required_data(req_idx), [ccpp_required_data(req_idx)], 'lev', timestep, field_data_ptr(:,:,constituent_idx), mark_as_read=.false.)", 6) + # start default case steps: outfile.write("case default", 5) outfile.blank_line() @@ -967,7 +1028,7 @@ def write_phys_check_subroutine(outfile, host_dict, host_vars, host_imports, # We do not 'check' variables from the 'host' table as they are # passed to physics via the argument list. # As such, they are always considered initialized. - if hvar.source.type == 'host': + if hvar.source.ptype == 'host': continue # end if var_stdname = hvar.get_prop_value('standard_name') @@ -1008,8 +1069,9 @@ def write_phys_check_subroutine(outfile, host_dict, host_vars, host_imports, ["shr_kind_mod", ["SHR_KIND_CS, SHR_KIND_CL, SHR_KIND_CX"]], ["physics_data", ["check_field", "find_input_name_idx", "no_exist_idx", "init_mark_idx", - "prot_no_init_idx"]], - ["cam_ccpp_cap", ["ccpp_physics_suite_variables"]], + "prot_no_init_idx", "const_idx"]], + ["cam_ccpp_cap", ["ccpp_physics_suite_variables", "cam_advected_constituents_array"]], + ["cam_constituents", ["const_get_index"]], ["ccpp_kinds", ["kind_phys"]], ["cam_logfile", ["iulog"]], ["spmd_utils", ["masterproc"]], @@ -1052,12 +1114,15 @@ def write_phys_check_subroutine(outfile, host_dict, host_vars, host_imports, outfile.write("character(len=SHR_KIND_CX) :: errmsg !CCPP framework error message", 2) outfile.write("integer :: errflg !CCPP framework error flag", 2) outfile.write("integer :: name_idx !Input variable array index", 2) + outfile.write("integer :: constituent_idx !Index of variable in constituent array", 2) outfile.write("integer :: req_idx !Required variable array index", 2) outfile.write("integer :: suite_idx !Suite array index", 2) outfile.write("character(len=SHR_KIND_CL) :: ncdata_check_loc", 2) outfile.write("type(file_desc_t), pointer :: file", 2) outfile.write("logical :: file_found", 2) outfile.write("logical :: is_first", 2) + outfile.write("logical :: is_read", 2) + outfile.write("real(kind=kind_phys), pointer :: field_data_ptr(:,:,:)", 2) outfile.blank_line() # Initialize variables: @@ -1117,21 +1182,34 @@ def write_phys_check_subroutine(outfile, host_dict, host_vars, host_imports, outfile.write("do req_idx = 1, size(ccpp_required_data, 1)", 3) outfile.blank_line() + # First check if the required variable is a constituent + outfile.comment("First check if the required variable is a constituent:", 4) + outfile.write("call const_get_index(ccpp_required_data(req_idx), constituent_idx, abort=.false., warning=.false.)", 4) + outfile.write("if (constituent_idx > -1) then", 4) + outfile.comment("The required variable is a constituent. Call check variable routine on the relevant index of the constituent array", 5) + outfile.write("field_data_ptr => cam_advected_constituents_array()", 5) + outfile.write("call check_field(file, [ccpp_required_data(req_idx)], 'lev', timestep, field_data_ptr(:,:,constituent_idx), ccpp_required_data(req_idx), min_difference, min_relative_value, is_first)", 5) + outfile.write("else", 4) + outfile.comment("The required variable is not a constituent. Check if the variable was read from a file", 5) + # Call input name search function: - outfile.comment("Find IC file input name array index for required variable:", 4) - outfile.write("if (.not. is_read_from_file(ccpp_required_data(req_idx), name_idx)) then", 4) - outfile.write("continue", 5) - outfile.write("end if", 4) + outfile.comment("Find IC file input name array index for required variable:", 5) + outfile.write("call is_read_from_file(ccpp_required_data(req_idx), " + \ + "is_read, stdnam_idx_out=name_idx)", 5) + outfile.write("if (.not. is_read) then", 5) + outfile.write("cycle", 6) + outfile.write("end if", 5) # Generate "check_field" calls: - outfile.comment("Check variable vs input check file:", 4) + outfile.comment("Check variable vs input check file:", 5) outfile.blank_line() - outfile.write("select case (trim(phys_var_stdnames(name_idx)))", 4) + outfile.write("select case (trim(phys_var_stdnames(name_idx)))", 5) for case_call, read_call in call_string_dict.items(): outfile.write(case_call, 5) outfile.write(read_call, 6) outfile.blank_line() - outfile.write("end select !check variables", 4) + outfile.write("end select !check variables", 5) + outfile.write("end if !check if constituent", 4) # End select case and required variables loop: outfile.write("end do !Suite-required variables", 3) @@ -1155,15 +1233,19 @@ def write_phys_check_subroutine(outfile, host_dict, host_vars, host_imports, # Check if no differences were found outfile.write("if (is_first) then", 2) - outfile.write("write(iulog,*) ''", 3) - outfile.write("write(iulog,*) 'No differences found!'", 3) + outfile.write("if (masterproc) then", 3) + outfile.write("write(iulog,*) ''", 4) + outfile.write("write(iulog,*) 'No differences found!'", 4) + outfile.write("end if", 3) outfile.write("end if", 2) # End check data log: - outfile.write("write(iulog,*) ''", 2) + outfile.write("if (masterproc) then", 2) + outfile.write("write(iulog,*) ''", 3) outfile.write("write(iulog,*) '********** End Physics Check Data " + \ - "Results **********'", 2) - outfile.write("write(iulog,*) ''", 2) + "Results **********'", 3) + outfile.write("write(iulog,*) ''", 3) + outfile.write("end if", 2) # End subroutine: outfile.write("end subroutine physics_check_data", 1) diff --git a/src/dynamics/none/dyn_grid.F90 b/src/dynamics/none/dyn_grid.F90 index c018efb7..cbeb6d09 100644 --- a/src/dynamics/none/dyn_grid.F90 +++ b/src/dynamics/none/dyn_grid.F90 @@ -127,7 +127,7 @@ subroutine model_grid_init() ! We will handle errors for this routine call pio_seterrorhandling(fh_ini, PIO_BCAST_ERROR, oldmethod=err_handling) ! Find the latitude variable and dimension(s) - call cam_pio_find_var(fh_ini, (/ 'lat ', 'lat_d' /), lat_name, & + call cam_pio_find_var(fh_ini, (/ 'lat ', 'lat_d ', 'latitude' /), lat_name, & lat_vardesc, var_found) if (var_found) then ! Find the variable latitude dimension info @@ -160,7 +160,7 @@ subroutine model_grid_init() end if end if ! Find the longitude variable and dimension(s) - call cam_pio_find_var(fh_ini, (/ 'lon ', 'lon_d' /), lon_name, & + call cam_pio_find_var(fh_ini, (/ 'lon ', 'lon_d ', 'longitude' /), lon_name, & lon_vardesc, var_found) if (var_found) then ! Find the longitude variable dimension info @@ -213,7 +213,7 @@ subroutine model_grid_init() '(a,i4,i9,2i7)', (/ num_local_columns, col_start, col_end/)) end if ! Find a 3D variable and get its dimensions - call cam_pio_find_var(fh_ini, (/ 'U ', 'state_u' /), & + call cam_pio_find_var(fh_ini, (/ 'U ', 'state_u', 'x_wind ' /), & fieldname, vardesc, var_found) if (var_found) then ! Find the variable dimension info @@ -353,7 +353,7 @@ subroutine model_grid_init() end if end if ! Find the grid area and / or weight terms - call cam_pio_find_var(fh_ini, (/ 'gw ', 'area' /), var_name, & + call cam_pio_find_var(fh_ini, (/ 'gw ', 'area ', 'cell_area' /), var_name, & vardesc, var_found) if (var_found) then ! Find the variable dimension info diff --git a/src/dynamics/se/advect_tend.F90 b/src/dynamics/se/advect_tend.F90 index bec262a8..62d5b65c 100644 --- a/src/dynamics/se/advect_tend.F90 +++ b/src/dynamics/se/advect_tend.F90 @@ -22,10 +22,10 @@ module advect_tend ! - second call computes and outputs the tendencies !---------------------------------------------------------------------- subroutine compute_adv_tends_xyz(elem,fvm,nets,nete,qn0,n0) -! use cam_history, only: outfld, hist_fld_active +! use cam_history, only: outfld, hist_fld_active use time_manager, only: get_step_size -! use constituents, only: tottnam,pcnst - use constituents, only: pcnst +! use cam_constituents, only: tottnam,num_advected + use cam_constituents, only: num_advected use cam_abortutils, only: check_allocate ! SE dycore: @@ -58,8 +58,8 @@ subroutine compute_adv_tends_xyz(elem,fvm,nets,nete,qn0,n0) init = .false. if ( .not. allocated( adv_tendxyz ) ) then init = .true. - allocate( adv_tendxyz(nx,nx,nlev,pcnst,nets:nete), stat=iret ) - call check_allocate(iret, subname, 'adv_tendxyz(nx,nx,nlev,pcnst,nets:nete)', & + allocate( adv_tendxyz(nx,nx,nlev,num_advected,nets:nete), stat=iret ) + call check_allocate(iret, subname, 'adv_tendxyz(nx,nx,nlev,num_advected,nets:nete)', & file=__FILE__, line=__LINE__) adv_tendxyz(:,:,:,:,:) = 0._r8 @@ -67,13 +67,13 @@ subroutine compute_adv_tends_xyz(elem,fvm,nets,nete,qn0,n0) if (ntrac>0) then do ie=nets,nete - do ic=1,pcnst + do ic = 1, num_advected adv_tendxyz(:,:,:,ic,ie) = fvm(ie)%c(1:nc,1:nc,:,ic) - adv_tendxyz(:,:,:,ic,ie) end do end do else do ie=nets,nete - do ic=1,pcnst + do ic = 1, num_advected adv_tendxyz(:,:,:,ic,ie) = elem(ie)%state%Qdp(:,:,:,ic,qn0)/elem(ie)%state%dp3d(:,:,:,n0) - adv_tendxyz(:,:,:,ic,ie) enddo end do @@ -86,7 +86,7 @@ subroutine compute_adv_tends_xyz(elem,fvm,nets,nete,qn0,n0) idt = 1._r8/dt do ie=nets,nete - do ic = 1,pcnst + do ic = 1, num_advected do j=1,nx do i=1,nx ftmp(i+(j-1)*nx,:) = adv_tendxyz(i,j,:,ic,ie) diff --git a/src/dynamics/se/dp_coupling.F90 b/src/dynamics/se/dp_coupling.F90 index 4b2b8da3..e020d2a2 100644 --- a/src/dynamics/se/dp_coupling.F90 +++ b/src/dynamics/se/dp_coupling.F90 @@ -4,35 +4,33 @@ module dp_coupling ! dynamics - physics coupling module !------------------------------------------------------------------------------- -use shr_kind_mod, only: r8=>shr_kind_r8 -use ccpp_kinds, only: kind_phys -!use constituents, only: pcnst, cnst_type -use constituents, only: pcnst +use shr_kind_mod, only: r8=>shr_kind_r8 +use ccpp_kinds, only: kind_phys +use cam_constituents, only: const_is_wet, num_advected -use spmd_dyn, only: local_dp_map -use spmd_utils, only: iam -use dyn_grid, only: TimeLevel, edgebuf -use dyn_comp, only: dyn_export_t, dyn_import_t +use spmd_dyn, only: local_dp_map +use spmd_utils, only: iam +use dyn_grid, only: TimeLevel, edgebuf +use dyn_comp, only: dyn_export_t, dyn_import_t -use runtime_obj, only: runtime_options -use physics_types, only: physics_state, physics_tend -use physics_types, only: ix_qv, ix_cld_liq, ix_rain !Remove once constituents are enabled -use physics_grid, only: pcols => columns_on_task, get_dyn_col_p -use vert_coord, only: pver, pverp +use runtime_obj, only: runtime_options +use physics_types, only: physics_state, physics_tend +use physics_grid, only: pcols => columns_on_task, get_dyn_col_p +use vert_coord, only: pver, pverp -use dp_mapping, only: nphys_pts +use dp_mapping, only: nphys_pts -use perf_mod, only: t_startf, t_stopf, t_barrierf -use cam_abortutils, only: endrun, check_allocate +use perf_mod, only: t_startf, t_stopf, t_barrierf +use cam_abortutils, only: endrun, check_allocate !SE dycore: -use parallel_mod, only: par -use thread_mod, only: horz_num_threads, max_num_threads -use hybrid_mod, only: config_thread_region, get_loop_ranges, hybrid_t -use dimensions_mod, only: np, npsq, nelemd, nlev, nc, qsize, ntrac, fv_nphys +use parallel_mod, only: par +use thread_mod, only: horz_num_threads, max_num_threads +use hybrid_mod, only: config_thread_region, get_loop_ranges, hybrid_t +use dimensions_mod, only: np, npsq, nelemd, nlev, nc, qsize, ntrac, fv_nphys -use dof_mod, only: UniquePoints, PutUniquePoints -use element_mod, only: element_t +use dof_mod, only: UniquePoints, PutUniquePoints +use element_mod, only: element_t implicit none private @@ -55,6 +53,8 @@ subroutine d_p_coupling(cam_runtime_opts, phys_state, phys_tend, dyn_out) use gravity_waves_sources, only: gws_src_fnct use hycoef, only: hyai, ps0 use test_fvm_mapping, only: test_mapping_overwrite_dyn_state, test_mapping_output_phys_state + use cam_ccpp_cap, only: cam_constituents_array + use cam_constituents, only: const_name !SE dycore: use fvm_mapping, only: dyn2phys_vector, dyn2phys_all_vars @@ -81,6 +81,7 @@ subroutine d_p_coupling(cam_runtime_opts, phys_state, phys_tend, dyn_out) real(r8), allocatable :: uv_tmp(:,:,:,:) ! temp array to hold u and v real(r8), allocatable :: q_tmp(:,:,:,:) ! temp to hold advected constituents real(r8), allocatable :: omega_tmp(:,:,:) ! temp array to hold omega + real(kind=kind_phys), pointer :: const_data_ptr(:,:,:) ! pointer to constituent array ! Frontogenesis real (kind=r8), allocatable :: frontgf(:,:,:) ! temp arrays to hold frontogenesis @@ -95,6 +96,7 @@ subroutine d_p_coupling(cam_runtime_opts, phys_state, phys_tend, dyn_out) integer :: tl_f, tl_qdp_np0, tl_qdp_np1 character(len=*), parameter :: subname = 'd_p_coupling' + character(len=200) :: stdname_test !---------------------------------------------------------------------------- @@ -109,13 +111,15 @@ subroutine d_p_coupling(cam_runtime_opts, phys_state, phys_tend, dyn_out) if (fv_nphys > 0) then nphys = fv_nphys else - allocate(qgll(np,np,nlev,pcnst), stat=ierr) - call check_allocate(ierr, subname, 'qgll(np,np,nlev,pcnst)', & + allocate(qgll(np,np,nlev,num_advected), stat=ierr) + call check_allocate(ierr, subname, 'qgll(np,np,nlev,num_advected)', & file=__FILE__, line=__LINE__) nphys = np end if + const_data_ptr => cam_constituents_array() + ! Allocate temporary arrays to hold data for physics decomposition allocate(ps_tmp(nphys_pts,nelemd), stat=ierr) call check_allocate(ierr, subname, 'ps_tmp(nphys_pts,nelemd)', & @@ -141,8 +145,8 @@ subroutine d_p_coupling(cam_runtime_opts, phys_state, phys_tend, dyn_out) call check_allocate(ierr, subname, 'uv_tmp(nphys_pts,2,pver,nelemd)', & file=__FILE__, line=__LINE__) - allocate(q_tmp(nphys_pts,pver,pcnst,nelemd), stat=ierr) - call check_allocate(ierr, subname, 'q_tmp(nphys_pts,pver,pcnst,nelemd)', & + allocate(q_tmp(nphys_pts,pver,num_advected,nelemd), stat=ierr) + call check_allocate(ierr, subname, 'q_tmp(nphys_pts,pver,num_advected,nelemd)', & file=__FILE__, line=__LINE__) allocate(omega_tmp(nphys_pts,pver,nelemd), stat=ierr) @@ -181,7 +185,7 @@ subroutine d_p_coupling(cam_runtime_opts, phys_state, phys_tend, dyn_out) ! note that the fvm halo has been filled in prim_run_subcycle ! if physics grid resolution is not equal to fvm resolution call dyn2phys_all_vars(1,nelemd,elem, dyn_out%fvm,& - pcnst,hyai(1)*ps0,tl_f, & + num_advected,hyai(1)*ps0,tl_f, & ! output dp3d_tmp, ps_tmp, q_tmp, T_tmp, & omega_tmp, phis_tmp & @@ -198,14 +202,14 @@ subroutine d_p_coupling(cam_runtime_opts, phys_state, phys_tend, dyn_out) ! physics decomposition !****************************************************************** - if (qsize < pcnst) then + if (qsize < num_advected) then call endrun('d_p_coupling: Fewer GLL tracers advected than required') end if call t_startf('UniquePoints') do ie = 1, nelemd inv_dp3d(:,:,:) = 1.0_r8/elem(ie)%state%dp3d(:,:,:,tl_f) - do m=1,pcnst + do m = 1, num_advected qgll(:,:,:,m) = elem(ie)%state%Qdp(:,:,:,m,tl_qdp_np0)*inv_dp3d(:,:,:) end do ncols = elem(ie)%idxP%NumUniquePts @@ -216,7 +220,7 @@ subroutine d_p_coupling(cam_runtime_opts, phys_state, phys_tend, dyn_out) call UniquePoints(elem(ie)%idxV, nlev, elem(ie)%derived%omega, omega_tmp(1:ncols,:,ie)) call UniquePoints(elem(ie)%idxP, elem(ie)%state%phis, phis_tmp(1:ncols,ie)) - call UniquePoints(elem(ie)%idxP, nlev, pcnst, qgll,q_tmp(1:ncols,:,:,ie)) + call UniquePoints(elem(ie)%idxP, nlev, num_advected, qgll,q_tmp(1:ncols,:,:,ie)) end do call t_stopf('UniquePoints') @@ -248,8 +252,8 @@ subroutine d_p_coupling(cam_runtime_opts, phys_state, phys_tend, dyn_out) ! q_prev is for saving the tracer fields for calculating tendencies if (.not. allocated(q_prev)) then - allocate(q_prev(pcols,pver,pcnst), stat=ierr) - call check_allocate(ierr, subname, 'q_prev(pcols,pver,pcnst)', & + allocate(q_prev(pcols,pver,num_advected), stat=ierr) + call check_allocate(ierr, subname, 'q_prev(pcols,pver,num_advected)', & file=__FILE__, line=__LINE__) end if q_prev = 0.0_r8 @@ -273,9 +277,9 @@ subroutine d_p_coupling(cam_runtime_opts, phys_state, phys_tend, dyn_out) end if end do - do m = 1, pcnst + do m = 1, num_advected do ilyr = 1, pver - phys_state%q(icol, ilyr,m) = real(q_tmp(blk_ind(1), ilyr,m, ie), kind_phys) + const_data_ptr(icol, ilyr,m) = real(q_tmp(blk_ind(1), ilyr,m, ie), kind_phys) end do end do end do @@ -284,7 +288,7 @@ subroutine d_p_coupling(cam_runtime_opts, phys_state, phys_tend, dyn_out) ! Save the tracer fields input to physics package for calculating tendencies ! The mixing ratios are all dry at this point. - q_prev(1:pcols,1:pver,:) = real(phys_state%q(1:pcols,1:pver,1:3), r8) + q_prev(1:pcols,1:pver,:) = real(const_data_ptr(1:pcols,1:pver,1:num_advected), r8) call test_mapping_output_phys_state(phys_state,dyn_out%fvm) @@ -312,6 +316,7 @@ subroutine p_d_coupling(cam_runtime_opts, phys_state, phys_tend, dyn_in, tl_f, t ! Convert the physics output state into the dynamics input state. use test_fvm_mapping, only: test_mapping_overwrite_tendencies use test_fvm_mapping, only: test_mapping_output_mapped_tendencies + use cam_ccpp_cap, only: cam_constituents_array ! SE dycore: use bndry_mod, only: bndry_exchange @@ -332,6 +337,7 @@ subroutine p_d_coupling(cam_runtime_opts, phys_state, phys_tend, dyn_in, tl_f, t integer :: ie ! index for elements integer :: blk_ind(1) ! element offset integer :: icol, ilyr ! indices for column, layer + real(kind=kind_phys), pointer :: const_data_ptr(:,:,:) ! constituent data pointer real(r8), allocatable :: dp_phys(:,:,:) ! temp array to hold dp on physics grid real(r8), allocatable :: T_tmp(:,:,:) ! temp array to hold T @@ -366,8 +372,8 @@ subroutine p_d_coupling(cam_runtime_opts, phys_state, phys_tend, dyn_in, tl_f, t call check_allocate(ierr, subname, 'uv_tmp(nphys_pts,2,pver,nelemd)', & file=__FILE__, line=__LINE__) - allocate(dq_tmp(nphys_pts,pver,pcnst,nelemd), stat=ierr) - call check_allocate(ierr, subname, 'dq_tmp(nphys_pts,pver,pcnst,nelemd)', & + allocate(dq_tmp(nphys_pts,pver,num_advected,nelemd), stat=ierr) + call check_allocate(ierr, subname, 'dq_tmp(nphys_pts,pver,num_advected,nelemd)', & file=__FILE__, line=__LINE__) allocate(dp_phys(nphys_pts,pver,nelemd), stat=ierr) @@ -378,44 +384,12 @@ subroutine p_d_coupling(cam_runtime_opts, phys_state, phys_tend, dyn_in, tl_f, t uv_tmp = 0.0_r8 dq_tmp = 0.0_r8 + ! Grab pointer to constituent array + const_data_ptr => cam_constituents_array() + if (.not. allocated(q_prev)) then call endrun('p_d_coupling: q_prev not allocated') end if - -!Remove once constituents are implemented in the CCPP framework -JN: -#if 0 - ! Convert wet to dry mixing ratios and modify the physics temperature - ! tendency to be thermodynamically consistent with the dycore. - !$omp parallel do num_threads(max_num_threads) private (lchnk, ncols, icol, ilyr, m, factor) - do lchnk = begchunk, endchunk - ncols = get_ncols_p(lchnk) - do icol = 1, ncols - do ilyr = 1, pver - ! convert wet mixing ratios to dry - factor = phys_state(lchnk)%pdel(icol,ilyr)/phys_state(lchnk)%pdeldry(icol,ilyr) - do m = 1, pcnst - if (cnst_type(m) == 'wet') then - phys_state(lchnk)%q(icol,ilyr,m) = factor*phys_state(lchnk)%q(icol,ilyr,m) - end if - end do - end do - end do - call thermodynamic_consistency( & - phys_state(lchnk), phys_tend(lchnk), ncols, pver) - end do -#else - do ilyr = 1, pver - do icol=1, pcols - !Apply adjustment only to water vapor: - factor = phys_state%pdel(icol,ilyr)/phys_state%pdeldry(icol,ilyr) - phys_state%q(icol,ilyr,ix_qv) = factor*phys_state%q(icol,ilyr,ix_qv) - phys_state%q(icol,ilyr,ix_cld_liq) = factor*phys_state%q(icol,ilyr,ix_cld_liq) - phys_state%q(icol,ilyr,ix_rain) = factor*phys_state%q(icol,ilyr,ix_rain) - end do - end do - call thermodynamic_consistency(phys_state, phys_tend, pcols, pver) -#endif - call t_startf('pd_copy') !$omp parallel do num_threads(max_num_threads) private (icol, ie, blk_ind, ilyr, m) do icol = 1, pcols @@ -431,9 +405,9 @@ subroutine p_d_coupling(cam_runtime_opts, phys_state, phys_tend, dyn_in, tl_f, t T_tmp(blk_ind(1),ilyr,ie) = real(phys_tend%dTdt_total(icol,ilyr), r8) uv_tmp(blk_ind(1),1,ilyr,ie) = real(phys_tend%dudt_total(icol,ilyr), r8) uv_tmp(blk_ind(1),2,ilyr,ie) = real(phys_tend%dvdt_total(icol,ilyr), r8) - do m = 1, pcnst + do m = 1, num_advected dq_tmp(blk_ind(1),ilyr,m,ie) = & - (real(phys_state%q(icol,ilyr,m), r8) - q_prev(icol,ilyr,m)) + (real(const_data_ptr(icol,ilyr,m), r8) - q_prev(icol,ilyr,m)) end do end do end do @@ -478,7 +452,7 @@ subroutine p_d_coupling(cam_runtime_opts, phys_state, phys_tend, dyn_in, tl_f, t elem(ie)%derived%fT(:,:,:)) call putUniquePoints(elem(ie)%idxV, 2, nlev, uv_tmp(1:ncols,:,:,ie), & elem(ie)%derived%fM(:,:,:,:)) - call putUniquePoints(elem(ie)%idxV, nlev, pcnst, dq_tmp(1:ncols,:,:,ie), & + call putUniquePoints(elem(ie)%idxV, nlev, num_advected, dq_tmp(1:ncols,:,:,ie), & elem(ie)%derived%fQ(:,:,:,:)) end do call t_stopf('putUniquePoints') @@ -573,10 +547,12 @@ subroutine derived_phys_dry(cam_runtime_opts, phys_state, phys_tend) ! Finally compute energy and water column integrals of the physics input state. ! use constituents, only: qmin + use cam_ccpp_cap, only: cam_constituents_array + use cam_constituents, only: const_get_index use physics_types, only: lagrangian_vertical use physconst, only: cpair, gravit, zvir, cappa use cam_thermo, only: cam_thermo_update - use air_composition,only: rairv, zvirv + use physics_types, only: rairv, zvirv use shr_const_mod, only: shr_const_rwv use geopotential_t, only: geopotential_t_run ! use check_energy, only: check_energy_timestep_init @@ -593,8 +569,10 @@ subroutine derived_phys_dry(cam_runtime_opts, phys_state, phys_tend) ! local variables real(kind_phys) :: factor_array(pcols,nlev) + real(kind_phys), pointer :: const_data_ptr(:,:,:) integer :: m, i, k + integer :: ix_q, ix_cld_liq, ix_rain !Needed for "geopotential_t" CCPP scheme: integer :: errflg @@ -608,6 +586,14 @@ subroutine derived_phys_dry(cam_runtime_opts, phys_state, phys_tend) real(r8), parameter :: N2mmrMin=1.e-6_r8 ! lower limit of o2, o, and h mixing ratios !---------------------------------------------------------------------------- + ! Set constituent indices + call const_get_index('specific_humidity', ix_q) + call const_get_index('cloud_liquid_water_mixing_ratio_wrt_moist_air', ix_cld_liq) + call const_get_index('rain_water_mixing_ratio_wrt_moist_air', ix_rain) + + ! Grab pointer to constituent array + const_data_ptr => cam_constituents_array() + ! Evaluate derived quantities ! dry pressure variables @@ -648,7 +634,7 @@ subroutine derived_phys_dry(cam_runtime_opts, phys_state, phys_tend) do i=1, pcols ! to be consistent with total energy formula in physic's check_energy module only ! include water vapor in in moist dp - factor_array(i,k) = 1._kind_phys+phys_state%q(i,k,ix_qv) + factor_array(i,k) = 1._kind_phys+const_data_ptr(i,k,ix_q) phys_state%pdel(i,k) = phys_state%pdeldry(i,k)*factor_array(i,k) end do end do @@ -688,27 +674,14 @@ subroutine derived_phys_dry(cam_runtime_opts, phys_state, phys_tend) ! physics expect water variables moist factor_array(:,1:nlev) = 1._kind_phys/factor_array(:,1:nlev) -!Remove once constituents are enabled in the CCPP framework: -#if 0 - do m = 1,pcnst - if (cnst_type(m) == 'wet') then - do k = 1, nlev - do i = 1, ncol - phys_state(lchnk)%q(i,k,m) = factor_array(i,k)*phys_state(lchnk)%q(i,k,m) - end do - end do - end if - end do -#else !$omp parallel do num_threads(horz_num_threads) private (k, i) do k = 1, nlev do i=1, pcols - phys_state%q(i,k,ix_qv) = factor_array(i,k)*phys_state%q(i,k,ix_qv) - phys_state%q(i,k,ix_cld_liq) = factor_array(i,k)*phys_state%q(i,k,ix_cld_liq) - phys_state%q(i,k,ix_rain) = factor_array(i,k)*phys_state%q(i,k,ix_rain) + const_data_ptr(i,k,ix_q) = factor_array(i,k)*const_data_ptr(i,k,ix_q) + const_data_ptr(i,k,ix_cld_liq) = factor_array(i,k)*const_data_ptr(i,k,ix_cld_liq) + const_data_ptr(i,k,ix_rain) = factor_array(i,k)*const_data_ptr(i,k,ix_rain) end do end do -#endif !------------------------------------------------------------ ! Ensure O2 + O + H (N2) mmr greater than one. @@ -720,23 +693,23 @@ subroutine derived_phys_dry(cam_runtime_opts, phys_state, phys_tend) do i=1,pcols do k=1,pver - if (phys_state%q(i,k,ixo) < mmrMin) phys_state%q(i,k,ixo) = mmrMin - if (phys_state%q(i,k,ixo2) < mmrMin) phys_state%q(i,k,ixo2) = mmrMin + if (const_data_ptr(i,k,ixo) < mmrMin) const_data_ptr(i,k,ixo) = mmrMin + if (const_data_ptr(i,k,ixo2) < mmrMin) const_data_ptr(i,k,ixo2) = mmrMin - mmrSum_O_O2_H = phys_state%q(i,k,ixo)+phys_state%q(i,k,ixo2)+phys_state%q(i,k,ixh) + mmrSum_O_O2_H = const_data_ptr(i,k,ixo)+const_data_ptr(i,k,ixo2)+const_data_ptr(i,k,ixh) if ((1._r8-mmrMin-mmrSum_O_O2_H) < 0._r8) then - phys_state%q(i,k,ixo) = phys_state%q(i,k,ixo) * (1._r8 - N2mmrMin) / mmrSum_O_O2_H + const_data_ptr(i,k,ixo) = const_data_ptr(i,k,ixo) * (1._r8 - N2mmrMin) / mmrSum_O_O2_H - phys_state%q(i,k,ixo2) = phys_state%q(i,k,ixo2) * (1._r8 - N2mmrMin) / mmrSum_O_O2_H + const_data_ptr(i,k,ixo2) = const_data_ptr(i,k,ixo2) * (1._r8 - N2mmrMin) / mmrSum_O_O2_H - phys_state%q(i,k,ixh) = phys_state%q(i,k,ixh) * (1._r8 - N2mmrMin) / mmrSum_O_O2_H + const_data_ptr(i,k,ixh) = const_data_ptr(i,k,ixh) * (1._r8 - N2mmrMin) / mmrSum_O_O2_H endif - if(phys_state%q(i,k,ixh2) .gt. 6.e-5_r8) then - phys_state%q(i,k,ixh2) = 6.e-5_r8 + if(const_data_ptr(i,k,ixh2) .gt. 6.e-5_r8) then + const_data_ptr(i,k,ixh2) = 6.e-5_r8 endif end do @@ -748,16 +721,16 @@ subroutine derived_phys_dry(cam_runtime_opts, phys_state, phys_tend) ! returns .true., cam_thermo_update will compute cpairv, rairv, mbarv, and cappav as ! constituent dependent variables. It will also: ! Compute molecular viscosity(kmvis) and conductivity(kmcnd). - ! Update air_composition zvirv variable; calculated for WACCM-X. + ! Update zvirv registry variable; calculated for WACCM-X. !----------------------------------------------------------------------------- - call cam_thermo_update(phys_state%q, phys_state%t, pcols, & + call cam_thermo_update(const_data_ptr, phys_state%t, pcols, & cam_runtime_opts%update_thermodynamic_variables()) !Call geopotential_t CCPP scheme: call geopotential_t_run(pver, lagrangian_vertical, pver, 1, & pverp, 1, phys_state%lnpint, phys_state%pint, & phys_state%pmid, phys_state%pdel, & - phys_state%rpdel, phys_state%t, phys_state%q(:,:,ix_qv), & + phys_state%rpdel, phys_state%t, const_data_ptr(:,:,ix_q), & rairv, gravit, zvirv, phys_state%zi, phys_state%zm, pcols, & errflg, errmsg) @@ -775,7 +748,7 @@ subroutine derived_phys_dry(cam_runtime_opts, phys_state, phys_tend) #if 0 ! Ensure tracers are all positive call qneg3('D_P_COUPLING',lchnk ,ncol ,pcols ,pver , & - 1, pcnst, qmin ,phys_state%q) + 1, num_advected, qmin ,const_data_ptr) #endif !Remove once check_energy scheme exists in CAMDEN: @@ -788,7 +761,7 @@ end subroutine derived_phys_dry !========================================================================================= -subroutine thermodynamic_consistency(phys_state, phys_tend, ncols, pver) +subroutine thermodynamic_consistency(phys_state, const_data_ptr, phys_tend, ncols, pver) ! ! Adjust the physics temperature tendency for thermal energy consistency with the ! dynamics. @@ -802,6 +775,7 @@ subroutine thermodynamic_consistency(phys_state, phys_tend, ncols, pver) use control_mod, only: phys_dyn_cp type(physics_state), intent(in) :: phys_state + real(kind_phys), pointer :: const_data_ptr(:,:,:) type(physics_tend ), intent(inout) :: phys_tend integer, intent(in) :: ncols, pver @@ -816,7 +790,7 @@ subroutine thermodynamic_consistency(phys_state, phys_tend, ncols, pver) ! note that if lcp_moist=.false. then there is thermal energy increment ! consistency (not taking into account dme adjust) ! - call get_cp(phys_state%q(1:ncols,1:pver,:),.true.,inv_cp) + call get_cp(const_data_ptr(1:ncols,1:pver,1:num_advected),.true.,inv_cp) phys_tend%dTdt_total(1:ncols,1:pver) = phys_tend%dTdt_total(1:ncols,1:pver)*cpair*inv_cp end if diff --git a/src/dynamics/se/dycore/dimensions_mod.F90 b/src/dynamics/se/dycore/dimensions_mod.F90 index 120cf38a..14856a4b 100644 --- a/src/dynamics/se/dycore/dimensions_mod.F90 +++ b/src/dynamics/se/dycore/dimensions_mod.F90 @@ -117,9 +117,9 @@ subroutine dimensions_mod_init() ! Allocate and initalize the relevant SE dycore dimension variables. - use vert_coord, only: pver, pverp - use constituents, only: pcnst - use cam_abortutils, only: check_allocate + use vert_coord, only: pver, pverp + use cam_constituents, only: num_advected + use cam_abortutils, only: check_allocate ! Local variables: @@ -131,10 +131,10 @@ subroutine dimensions_mod_init() if (fv_nphys > 0) then ! Use CSLAM for tracer advection qsize_d = 10 ! SE tracers (currently SE supports 10 condensate loading tracers) - ntrac = pcnst + ntrac = num_advected else ! Use GLL for tracer advection - qsize_d = pcnst + qsize_d = num_advected ntrac = 0 ! No fvm tracers if CSLAM is off end if @@ -213,4 +213,3 @@ end subroutine set_mesh_dimensions !============================================================================== end module dimensions_mod - diff --git a/src/dynamics/se/dycore/prim_driver_mod.F90 b/src/dynamics/se/dycore/prim_driver_mod.F90 index e5431ac2..fdee231f 100644 --- a/src/dynamics/se/dycore/prim_driver_mod.F90 +++ b/src/dynamics/se/dycore/prim_driver_mod.F90 @@ -201,7 +201,7 @@ subroutine prim_run_subcycle(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,nsubst real(kind=r8), intent(in) :: dt ! "timestep dependent" timestep type (TimeLevel_t), intent(inout):: tl integer, intent(in) :: nsubstep ! nsubstep = 1 .. nsplit - real (kind=r8) , intent(inout):: omega_cn(2,nets:nete) !min and max of vertical Courant number + real (kind=r8) , intent(inout):: omega_cn(2,nets:nete) !min and max of vertical Courant number real(kind=r8) :: dt_q, dt_remap, dt_phys integer :: ie, q,k,n0_qdp,np1_qdp,r, nstep_end,region_num_threads,i,j @@ -229,7 +229,7 @@ subroutine prim_run_subcycle(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,nsubst ! ! initialize variables for computing vertical Courant number ! - if (variable_nsplit.or.compute_diagnostics) then + if (variable_nsplit.or.compute_diagnostics) then if (nsubstep==1) then do ie=nets,nete omega_cn(1,ie) = 0.0_r8 @@ -247,13 +247,13 @@ subroutine prim_run_subcycle(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,nsubst call calc_tot_energy_dynamics(elem,fvm,nets,nete,tl%n0,n0_qdp,'dAF') call ApplyCAMForcing(elem,fvm,tl%n0,n0_qdp,dt_remap,dt_phys,nets,nete,nsubstep) - call calc_tot_energy_dynamics(elem,fvm,nets,nete,tl%n0,n0_qdp,'dBD') + call calc_tot_energy_dynamics(elem,fvm,nets,nete,tl%n0,n0_qdp,'dBD') do r=1,rsplit if (r.ne.1) call TimeLevel_update(tl,"leapfrog") call prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,r) enddo - + ! defer final timelevel update until after remap and diagnostics call TimeLevel_Qdp( tl, qsplit, n0_qdp, np1_qdp) @@ -263,12 +263,12 @@ subroutine prim_run_subcycle(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,nsubst ! always for tracers !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - call calc_tot_energy_dynamics(elem,fvm,nets,nete,tl%np1,np1_qdp,'dAD') + call calc_tot_energy_dynamics(elem,fvm,nets,nete,tl%np1,np1_qdp,'dAD') if (variable_nsplit.or.compute_diagnostics) then ! ! initialize variables for computing vertical Courant number - ! + ! do ie=nets,nete dp_end(:,:,:,ie) = elem(ie)%state%dp3d(:,:,:,tl%np1) end do @@ -283,7 +283,7 @@ subroutine prim_run_subcycle(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,nsubst call calc_tot_energy_dynamics(elem,fvm,nets,nete,tl%np1,np1_qdp,'dAR') if (nsubstep==nsplit) then - call compute_omega(hybrid,tl%np1,np1_qdp,elem,deriv,nets,nete,dt_remap,hvcoord) + call compute_omega(hybrid,tl%np1,np1_qdp,elem,deriv,nets,nete,dt_remap,hvcoord) end if ! now we have: @@ -384,8 +384,8 @@ subroutine prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord, rstep) #ifdef waccm_debug use cam_history, only: outfld -#endif - +#endif + type (element_t) , intent(inout) :: elem(:) type(fvm_struct), intent(inout) :: fvm(:) @@ -503,20 +503,20 @@ subroutine prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord, rstep) if (qsize > 0) then call t_startf('prim_advec_tracers_remap') - if(ntrac>0) then + if(ntrac>0) then ! Deactivate threading in the tracer dimension if this is a CSLAM run region_num_threads = 1 else region_num_threads=tracer_num_threads - endif + endif call omp_set_nested(.true.) !$OMP PARALLEL NUM_THREADS(region_num_threads), DEFAULT(SHARED), PRIVATE(hybridnew) - if(ntrac>0) then + if(ntrac>0) then ! Deactivate threading in the tracer dimension if this is a CSLAM run hybridnew = config_thread_region(hybrid,'serial') else hybridnew = config_thread_region(hybrid,'tracer') - endif + endif call Prim_Advec_Tracers_remap(elem, deriv,hvcoord,hybridnew,dt_q,tl,nets,nete) !$OMP END PARALLEL call omp_set_nested(.false.) @@ -529,7 +529,7 @@ subroutine prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord, rstep) ! ! FVM transport ! - if ((mod(rstep,fvm_supercycling) == 0).and.(mod(rstep,fvm_supercycling_jet) == 0)) then + if ((mod(rstep,fvm_supercycling) == 0).and.(mod(rstep,fvm_supercycling_jet) == 0)) then ! call omp_set_nested(.true.) ! !$OMP PARALLEL NUM_THREADS(vert_num_threads), DEFAULT(SHARED), PRIVATE(hybridnew2,kbeg,kend) @@ -595,15 +595,15 @@ subroutine prim_set_dry_mass(elem, hvcoord,initial_global_ave_dry_ps,q) use hybvcoord_mod , only: hvcoord_t use dimensions_mod, only: nelemd, nlev, np !Un-comment once constitutents are enabled -JN: -! use constituents, only: cnst_type, qmin, pcnst - use constituents, only: pcnst +! use constituents, only: cnst_type, qmin, num_advected + use cam_constituents, only: num_advected use cam_logfile, only: iulog use spmd_utils, only: masterproc type (element_t) , intent(inout):: elem(:) type (hvcoord_t) , intent(in) :: hvcoord real (kind=r8), intent(in) :: initial_global_ave_dry_ps - real (kind=r8), intent(inout):: q(np,np,nlev,nelemd,pcnst) + real (kind=r8), intent(inout):: q(np,np,nlev,nelemd,num_advected) ! local real (kind=r8) :: global_ave_ps_inic,dp_tmp, factor(np,np,nlev) @@ -629,7 +629,7 @@ subroutine prim_set_dry_mass(elem, hvcoord,initial_global_ave_dry_ps,q) ! conserve initial condition mass of 'wet' tracers (following dryairm.F90 for FV dycore) ! and conserve mixing ratio (not mass) of 'dry' tracers ! - do m_cnst=1,pcnst + do m_cnst = 1, num_advected !Un-comment once constitutents are enabled -JN: ! if (cnst_type(m_cnst).ne.'dry') then do k=1,nlev diff --git a/src/dynamics/se/dyn_comp.F90 b/src/dynamics/se/dyn_comp.F90 index 5d89b69f..8c0d3049 100644 --- a/src/dynamics/se/dyn_comp.F90 +++ b/src/dynamics/se/dyn_comp.F90 @@ -5,10 +5,10 @@ module dyn_comp use shr_kind_mod, only: r8=>shr_kind_r8, shr_kind_cl use dynconst, only: pi use spmd_utils, only: iam, masterproc -!use constituents, only: pcnst, cnst_get_ind, cnst_name, cnst_longname, & -! cnst_read_iv, qmin, cnst_type, tottnam, & -! cnst_is_a_water_species -use constituents, only: pcnst +use cam_constituents, only: const_name, const_longname, num_advected +use cam_constituents, only: const_get_index, const_is_wet, const_qmin +use cam_constituents, only: readtrace +use air_composition, only: const_is_water_species use cam_control_mod, only: initial_run, simple_phys use cam_initfiles, only: initial_file_get_id, topo_file_get_id, pertlim use dyn_grid, only: ini_grid_name, timelevel, hvcoord, edgebuf @@ -332,7 +332,7 @@ subroutine dyn_readnl(NLFileName) ! Finally, set the HOMME variables which have different names fine_ne = se_fine_ne ftype = se_ftype - statediag_numtrac = MIN(se_statediag_numtrac,pcnst) + statediag_numtrac = MIN(se_statediag_numtrac,num_advected) hypervis_power = se_hypervis_power hypervis_scaling = se_hypervis_scaling hypervis_subcycle = se_hypervis_subcycle @@ -373,14 +373,6 @@ subroutine dyn_readnl(NLFileName) rayk0 = se_rayk0 molecular_diff = se_molecular_diff - if (fv_nphys > 0) then - ! Use CSLAM for tracer advection - qsize = thermodynamic_active_species_num ! number tracers advected by GLL - else - ! Use GLL for tracer advection - qsize = pcnst - end if - if (rsplit < 1) then call endrun('dyn_readnl: rsplit must be > 0') end if @@ -574,8 +566,6 @@ subroutine dyn_init(cam_runtime_opts, dyn_in, dyn_out) !use cam_history, only: addfld, add_default, horiz_only, register_vector_field use gravity_waves_sources, only: gws_init - use physics_types, only: ix_qv, ix_cld_liq !Use until constituents are fully-enabled -JN - !SE dycore: use prim_advance_mod, only: prim_advance_init use thread_mod, only: horz_num_threads @@ -603,7 +593,7 @@ subroutine dyn_init(cam_runtime_opts, dyn_in, dyn_out) type(hybrid_t) :: hybrid - integer :: ixcldice, ixcldliq, ixrain, ixsnow, ixgraupel + integer :: ixq, ixcldice, ixcldliq, ixrain, ixsnow, ixgraupel integer :: m_cnst, m integer :: iret @@ -674,9 +664,6 @@ subroutine dyn_init(cam_runtime_opts, dyn_in, dyn_out) kord_tr_cslam(:) = vert_remap_tracer_alg end if -!Remove/replace after constituents are enabled in CCPP -JN: -#if 0 - do m=1,qsize ! ! The "_gll" index variables below are used to keep track of condensate-loading tracers @@ -696,8 +683,8 @@ subroutine dyn_init(cam_runtime_opts, dyn_in, dyn_out) thermodynamic_active_species_idx_dycore(m) = m kord_tr_cslam(thermodynamic_active_species_idx(m)) = vert_remap_uvTq_alg kord_tr(m) = vert_remap_uvTq_alg - cnst_name_gll (m) = cnst_name (thermodynamic_active_species_idx(m)) - cnst_longname_gll(m) = cnst_longname(thermodynamic_active_species_idx(m)) + cnst_name_gll (m) = const_name (thermodynamic_active_species_idx(m)) + cnst_longname_gll(m) = const_longname(thermodynamic_active_species_idx(m)) else ! ! if not running with CSLAM then the condensate-loading water tracers are not necessarily @@ -707,37 +694,11 @@ subroutine dyn_init(cam_runtime_opts, dyn_in, dyn_out) thermodynamic_active_species_idx_dycore(m) = thermodynamic_active_species_idx(m) kord_tr(thermodynamic_active_species_idx_dycore(m)) = vert_remap_uvTq_alg end if - cnst_name_gll (m) = cnst_name (m) - cnst_longname_gll(m) = cnst_longname(m) + cnst_name_gll (m) = const_name (m) + cnst_longname_gll(m) = const_longname(m) end if end do -#else - !Remove/replace after constituents are enabled in CCPP -JN: - do m=1, qsize - if (ntrac>0) then - thermodynamic_active_species_idx_dycore(m) = m - kord_tr_cslam(thermodynamic_active_species_idx(m)) = vert_remap_uvTq_alg - kord_tr(m) = vert_remap_uvTq_alg - else - if (m.le.thermodynamic_active_species_num) then - thermodynamic_active_species_idx_dycore(m) = thermodynamic_active_species_idx(m) - kord_tr(thermodynamic_active_species_idx_dycore(m)) = vert_remap_uvTq_alg - end if - endif - - if (m == ix_qv) then - cnst_name_gll(m) = 'Q' - cnst_longname_gll(m) = 'specific_humidity' - else if (m == ix_cld_liq) then - cnst_name_gll(m) = 'CLDLIQ' - cnst_longname_gll(m) = 'cloud_liquid_water_mixing_ratio_wrt_moist_air' - else - cnst_name_gll(m) = 'RAINQM' - cnst_longname_gll(m) = 'rain_water_mixing_ratio_wrt_moist_air' - end if - end do -#endif ! ! Initialize the import/export objects @@ -885,11 +846,11 @@ subroutine dyn_init(cam_runtime_opts, dyn_in, dyn_out) ! Tracer forcing on fvm (CSLAM) grid and internal CSLAM pressure fields if (ntrac>0) then do m = 1, ntrac - call addfld (trim(cnst_name(m))//'_fvm', (/ 'lev' /), 'I', 'kg/kg', & - trim(cnst_longname(m)), gridname='FVM') + call addfld (trim(const_name(m))//'_fvm', (/ 'lev' /), 'I', 'kg/kg', & + trim(const_longname(m)), gridname='FVM') - call addfld ('F'//trim(cnst_name(m))//'_fvm', (/ 'lev' /), 'I', 'kg/kg/s', & - trim(cnst_longname(m))//' mixing ratio forcing term (q_new-q_old) on fvm grid', & + call addfld ('F'//trim(const_name(m))//'_fvm', (/ 'lev' /), 'I', 'kg/kg/s', & + trim(const_longname(m))//' mixing ratio forcing term (q_new-q_old) on fvm grid', & gridname='FVM') end do @@ -899,7 +860,7 @@ subroutine dyn_init(cam_runtime_opts, dyn_in, dyn_out) do m_cnst = 1, qsize call addfld ('F'//trim(cnst_name_gll(m_cnst))//'_gll', (/ 'lev' /), 'I', 'kg/kg/s', & - trim(cnst_longname_gll(m_cnst))//' mixing ratio forcing term (q_new-q_old) on GLL grid', gridname='GLL') + trim(const_longname_gll(m_cnst))//' mixing ratio forcing term (q_new-q_old) on GLL grid', gridname='GLL') end do ! Energy diagnostics and axial angular momentum diagnostics @@ -938,32 +899,34 @@ subroutine dyn_init(cam_runtime_opts, dyn_in, dyn_out) ! add dynamical core tracer tendency output ! if (ntrac>0) then - do m = 1, pcnst - call addfld(tottnam(m),(/ 'lev' /),'A','kg/kg/s',trim(cnst_name(m))//' horz + vert', & + do m = 1, num_advected + call addfld(tottnam(m),(/ 'lev' /),'A','kg/kg/s',trim(const_name(m))//' horz + vert', & gridname='FVM') end do else - do m = 1, pcnst - call addfld(tottnam(m),(/ 'lev' /),'A','kg/kg/s',trim(cnst_name(m))//' horz + vert', & + do m = 1, num_advected + call addfld(tottnam(m),(/ 'lev' /),'A','kg/kg/s',trim(const_name(m))//' horz + vert', & gridname='GLL') end do end if call phys_getopts(history_budget_out=history_budget, history_budget_histfile_num_out=budget_hfile_num) if ( history_budget ) then - call cnst_get_ind('CLDLIQ', ixcldliq) - call cnst_get_ind('CLDICE', ixcldice) - call add_default(tottnam( 1), budget_hfile_num, ' ') + call const_get_index('specific_humidity', ixq) + call const_get_index('cloud_liquid_water_mixing_ratio_wrt_total_mass', & + ixcldliq) + call const_get_index('cloud_ice_water_mixing_ratio_wrt_total_mass', ixcldice) + call add_default(tottnam( ixq), budget_hfile_num, ' ') call add_default(tottnam(ixcldliq), budget_hfile_num, ' ') call add_default(tottnam(ixcldice), budget_hfile_num, ' ') end if - ! constituent indices for waccm-x + ! constituent indices for waccm-x if ( cam_runtime_opts%waccmx_option() == 'ionosphere' .or. & cam_runtime_opts%waccmx_option() == 'neutral' ) then - call cnst_get_ind('O', ixo) - call cnst_get_ind('O2', ixo2) - call cnst_get_ind('H', ixh) - call cnst_get_ind('H2', ixh2) + call const_get_index('atomic_oxygen_mixing_ratio_wrt_total_mass', ixo) + call const_get_index('oxygen_mixing_ratio_wrt_total_mass', ixo2) + call const_get_index('atomic_hydrogen_mixing_ratio_wrt_total_mass', ixh) + call const_get_index('hydrogen_mixing_ratio_wrt_total_mass', ixh2) end if call test_mapping_addfld @@ -1190,7 +1153,6 @@ subroutine read_inidat(dyn_in) use shr_sys_mod, only: shr_sys_flush use hycoef, only: hyai, hybi, ps0 use phys_vars_init_check, only: mark_as_initialized - !use const_init, only: cnst_init_default !SE-dycore: use element_mod, only: timelevels @@ -1257,15 +1219,14 @@ subroutine read_inidat(dyn_in) fh_ini => initial_file_get_id() fh_topo => topo_file_get_id() - if (iam < par%nprocs) then elem => dyn_in%elem else nullify(elem) end if - allocate(qtmp(np,np,nlev,nelemd,pcnst), stat=ierr) - call check_allocate(ierr, subname, 'qtmp(np,np,nlev,nelemd,pcnst)', & + allocate(qtmp(np,np,nlev,nelemd,num_advected), stat=ierr) + call check_allocate(ierr, subname, 'qtmp(np,np,nlev,nelemd,num_advected)', & file=__FILE__, line=__LINE__) qtmp = 0._r8 @@ -1538,25 +1499,22 @@ subroutine read_inidat(dyn_in) ! except for the water species. if (ntrac > qsize) then - if (ntrac < pcnst) then + if (ntrac < num_advected) then write(errmsg, '(a,3(i0,a))') ': ntrac (',ntrac,') > qsize (',qsize, & - ') but < pcnst (',pcnst,')' + ') but < num_advected (',num_advected,')' call endrun(trim(subname)//errmsg) end if - else if (qsize < pcnst) then - write(errmsg, '(a,2(i0,a))') ': qsize (',qsize,') < pcnst (',pcnst,')' + else if (qsize < num_advected) then + write(errmsg, '(a,2(i0,a))') ': qsize (',qsize,') < num_advected (',num_advected,')' call endrun(trim(subname)//errmsg) end if -!Un-comment once non-water constituents are enabled in CAMDEN -JN: -#if 0 - ! If using analytic ICs the initial file only needs the horizonal grid ! dimension checked in the case that the file contains constituent mixing ! ratios. - do m_cnst = 1, pcnst - if (cnst_read_iv(m_cnst) .and. .not. cnst_is_a_water_species(cnst_name(m_cnst))) then - if (dyn_field_exists(fh_ini, trim(cnst_name(m_cnst)), required=.false.)) then + do m_cnst = 1, num_advected + if (readtrace .and. .not. const_is_water_species(m_cnst)) then + if (dyn_field_exists(fh_ini, trim(const_name(m_cnst)), required=.false.)) then call check_file_layout(fh_ini, elem, dyn_cols, 'ncdata', .true., dimname) exit end if @@ -1567,19 +1525,19 @@ subroutine read_inidat(dyn_in) call check_allocate(ierr, subname, 'dbuf3(npsq,nlev,nelemd)', & file=__FILE__, line=__LINE__) - do m_cnst = 1, pcnst + do m_cnst = 1, num_advected - if (analytic_ic_active() .and. cnst_is_a_water_species(cnst_name(m_cnst))) cycle + if (analytic_ic_active() .and. const_is_water_species(m_cnst)) cycle found = .false. - if (cnst_read_iv(m_cnst)) then - found = dyn_field_exists(fh_ini, trim(cnst_name(m_cnst)), required=.false.) + if (readtrace) then + found = dyn_field_exists(fh_ini, trim(const_name(m_cnst)), required=.false.) end if if (found) then - call read_dyn_var(trim(cnst_name(m_cnst)), fh_ini, dimname, dbuf3) + call read_dyn_var(trim(const_name(m_cnst)), fh_ini, dimname, dbuf3) else - call cnst_init_default(m_cnst, latvals, lonvals, dbuf3, pmask) + !call cnst_init_default(m_cnst, latvals, lonvals, dbuf3, pmask) end if do ie = 1, nelemd @@ -1591,7 +1549,7 @@ subroutine read_inidat(dyn_in) do i = 1, np ! Set qtmp at the unique columns only: zero non-unique columns if (pmask(((ie - 1) * npsq) + indx)) then - qtmp(i,j, k, ie, m_cnst) = max(qmin(m_cnst),dbuf3(indx,k,ie)) + qtmp(i,j, k, ie, m_cnst) = max(const_qmin(m_cnst),dbuf3(indx,k,ie)) else qtmp(i,j, k, ie, m_cnst) = 0.0_r8 end if @@ -1601,14 +1559,11 @@ subroutine read_inidat(dyn_in) end do end do - end do ! pcnst + end do ! num_advected ! Cleanup deallocate(dbuf3) -!Un-comment once constituents are enabled in CAMDEN -JN: -#endif - ! Put the error handling back the way it was call pio_seterrorhandling(fh_ini, pio_errtype) @@ -1625,7 +1580,7 @@ subroutine read_inidat(dyn_in) ! once we've read or initialized all the fields we do a boundary exchange to ! update the redundent columns in the dynamics if(iam < par%nprocs) then - call initEdgeBuffer(par, edge, elem, (3+pcnst)*nlev + 2 ) + call initEdgeBuffer(par, edge, elem, (3+num_advected)*nlev + 2 ) end if do ie = 1, nelemd kptr = 0 @@ -1635,7 +1590,7 @@ subroutine read_inidat(dyn_in) kptr = kptr + (2 * nlev) call edgeVpack(edge, elem(ie)%state%T(:,:,:,1),nlev,kptr,ie) kptr = kptr + nlev - call edgeVpack(edge, qtmp(:,:,:,ie,:),nlev*pcnst,kptr,ie) + call edgeVpack(edge, qtmp(:,:,:,ie,:),nlev*num_advected,kptr,ie) end do if(iam < par%nprocs) then call bndry_exchange(par,edge,location='read_inidat') @@ -1648,7 +1603,7 @@ subroutine read_inidat(dyn_in) kptr = kptr + (2 * nlev) call edgeVunpack(edge, elem(ie)%state%T(:,:,:,1),nlev,kptr,ie) kptr = kptr + nlev - call edgeVunpack(edge, qtmp(:,:,:,ie,:),nlev*pcnst,kptr,ie) + call edgeVunpack(edge, qtmp(:,:,:,ie,:),nlev*num_advected,kptr,ie) end do if (inic_wet) then @@ -1678,27 +1633,24 @@ subroutine read_inidat(dyn_in) end do factor_array(:,:,:,:) = 1.0_r8/factor_array(:,:,:,:) - do m_cnst = 1, pcnst -!Un-comment once constituents are enabled -JN: -! if (cnst_type(m_cnst) == 'wet') then + do m_cnst = 1, num_advected + if (const_is_wet(m_cnst)) then do ie = 1, nelemd do k = 1, nlev do j = 1, np do i = 1, np - ! convert wet mixing ratio to dry qtmp(i,j,k,ie,m_cnst) = qtmp(i,j,k,ie,m_cnst) * factor_array(i,j,k,ie) ! truncate negative values if they were not analytically specified if (.not. analytic_ic_active()) then -! qtmp(i,j,k,ie,m_cnst) = max(qmin(m_cnst), qtmp(i,j,k,ie,m_cnst)) - qtmp(i,j,k,ie,m_cnst) = max(0._r8, qtmp(i,j,k,ie,m_cnst)) !Remove once constituents are enabled -JN + qtmp(i,j,k,ie,m_cnst) = max(const_qmin(m_cnst), qtmp(i,j,k,ie,m_cnst)) end if end do end do end do end do -! end if + end if end do ! initialize dp3d and qdp @@ -1865,10 +1817,10 @@ subroutine read_inidat(dyn_in) call mark_as_initialized("y_wind") !northward wind call mark_as_initialized("air_temperature") - !These calls will need to be modified once constituents are enabled: - call mark_as_initialized("specific_humidity") - call mark_as_initialized("cloud_liquid_water_mixing_ratio_wrt_moist_air") - call mark_as_initialized("rain_water_mixing_ratio_wrt_moist_air") + !Mark all constituents as initialized + do m_cnst = 1, num_advected + call mark_as_initialized(const_name(m_cnst)) + end do !These calls may be removed if geopotential_t is only allowed to run !in a CCPP physics suite: @@ -2463,7 +2415,6 @@ end subroutine map_phis_from_physgrid_to_gll !Un-comment once "outfld has been enabled in CAMDEN -JN: #if 0 - subroutine write_dyn_vars(dyn_out) type (dyn_export_t), intent(inout) :: dyn_out ! Dynamics export container @@ -2474,17 +2425,17 @@ subroutine write_dyn_vars(dyn_out) if (ntrac > 0) then do ie = 1, nelemd - call outfld('dp_fvm', RESHAPE(dyn_out%fvm(ie)%dp_fvm(1:nc,1:nc,:), & + call outfld('dp_fvm', RESHAPE(dyn_out%fvm(ie)%dp_fvm(1:nc,1:nc,:), & (/nc*nc,nlev/)), nc*nc, ie) - call outfld('PSDRY_fvm', RESHAPE(dyn_out%fvm(ie)%psc(1:nc,1:nc), & + call outfld('PSDRY_fvm', RESHAPE(dyn_out%fvm(ie)%psc(1:nc,1:nc), & (/nc*nc/)), nc*nc, ie) do m = 1, ntrac - tfname = trim(cnst_name(m))//'_fvm' - call outfld(tfname, RESHAPE(dyn_out%fvm(ie)%c(1:nc,1:nc,:,m), & + tfname = trim(const_name(m))//'_fvm' + call outfld(tfname, RESHAPE(dyn_out%fvm(ie)%c(1:nc,1:nc,:,m), & (/nc*nc,nlev/)), nc*nc, ie) - tfname = 'F'//trim(cnst_name(m))//'_fvm' - call outfld(tfname, RESHAPE(dyn_out%fvm(ie)%fc(1:nc,1:nc,:,m),& + tfname = 'F'//trim(const_name(m))//'_fvm' + call outfld(tfname, RESHAPE(dyn_out%fvm(ie)%fc(1:nc,1:nc,:,m), & (/nc*nc,nlev/)), nc*nc, ie) end do end do diff --git a/src/dynamics/se/dyn_grid.F90 b/src/dynamics/se/dyn_grid.F90 index e7733646..a8bd51e3 100644 --- a/src/dynamics/se/dyn_grid.F90 +++ b/src/dynamics/se/dyn_grid.F90 @@ -31,7 +31,7 @@ module dyn_grid use shr_kind_mod, only: r8 => shr_kind_r8, shr_kind_cl use spmd_utils, only: masterproc, iam, mpicom, mstrid=>masterprocid, & npes -use constituents, only: pcnst +use cam_constituents, only: num_advected use dynconst, only: pi use cam_initfiles, only: initial_file_get_id use physics_column_type, only: physics_column_t, kind_pcol @@ -138,7 +138,7 @@ subroutine model_grid_init() use control_mod, only: qsplit, rsplit use time_mod, only: tstep, nsplit use fvm_mod, only: fvm_init2, fvm_init3, fvm_pg_init - use dimensions_mod, only: irecons_tracer, dimensions_mod_init + use dimensions_mod, only: irecons_tracer, dimensions_mod_init, qsize use comp_gll_ctr_vol, only: gll_grid_write ! Local variables @@ -165,6 +165,13 @@ subroutine model_grid_init() character(len=*), parameter :: subname = 'model_grid_init' !---------------------------------------------------------------------------- + if (fv_nphys > 0) then + ! Use CSLAM for tracer advection + qsize = thermodynamic_active_species_num ! number tracers advected by GLL + else + ! Use GLL for tracer advection + qsize = num_advected + end if ! Get file handle for initial file and first consistency check fh_ini => initial_file_get_id() @@ -249,13 +256,12 @@ subroutine model_grid_init() if (fv_nphys > 0) then qsize_local = thermodynamic_active_species_num + 3 else - qsize_local = pcnst + 3 + qsize_local = num_advected + 3 end if call initEdgeBuffer(par, edgebuf, elem, qsize_local*nlev, nthreads=1) else ! auxiliary processes - globaluniquecols = 0 nelem = 0 nelemd = 0 diff --git a/src/dynamics/se/test_fvm_mapping.F90 b/src/dynamics/se/test_fvm_mapping.F90 index c59153a4..1fada43a 100644 --- a/src/dynamics/se/test_fvm_mapping.F90 +++ b/src/dynamics/se/test_fvm_mapping.F90 @@ -27,7 +27,7 @@ subroutine test_mapping_addfld #ifdef debug_coupling use cam_history, only: addfld, add_default, horiz_only, register_vector_field - use constituents, only: cnst_get_ind,cnst_name + use cam_constituents, only: const_name character(LEN=128) :: name integer :: nq,m_cnst @@ -69,37 +69,37 @@ subroutine test_mapping_addfld do nq=ntrac,ntrac m_cnst = nq - name = 'f2p_'//trim(cnst_name(m_cnst))//'_fvm' + name = 'f2p_'//trim(const_name(m_cnst))//'_fvm' call addfld(trim(name), (/ 'lev' /), 'I','','Exact water tracer on fvm grid',gridname='FVM') call add_default (trim(name), 1, ' ') - name = 'f2p_'//trim(cnst_name(m_cnst))//'_err' + name = 'f2p_'//trim(const_name(m_cnst))//'_err' call addfld(trim(name), (/ 'lev' /), 'I','','Error in water tracer on physics grid (mapped from fvm grid)') call add_default (trim(name), 1, ' ') - name = 'f2p_'//trim(cnst_name(m_cnst))//'' + name = 'f2p_'//trim(const_name(m_cnst))//'' call addfld(trim(name), (/ 'lev' /), 'I','','Water tracer on physics grid (mapped from fvm grid') call add_default (trim(name), 1, ' ') ! ! physgrid to gll (condensate loading tracers) ! - name = 'p2d_'//trim(cnst_name(m_cnst))//'' + name = 'p2d_'//trim(const_name(m_cnst))//'' call addfld(trim(name), (/ 'lev' /), 'I','','Water tracer on physics grid') !call add_default (trim(name), 1, ' ') - name = 'p2d_'//trim(cnst_name(m_cnst))//'_gll' + name = 'p2d_'//trim(const_name(m_cnst))//'_gll' call addfld(trim(name), (/ 'lev' /), 'I','','Water tracer on GLL grid',gridname='GLL') !call add_default (trim(name), 1, ' ') - name = 'p2d_'//trim(cnst_name(m_cnst))//'_err_gll' + name = 'p2d_'//trim(const_name(m_cnst))//'_err_gll' call addfld(trim(name), (/ 'lev' /), 'I','','Error in water tracer mapped to GLL grid',gridname='GLL') !call add_default (trim(name), 1, ' ') ! ! physgrid to fvm (condensate loading tracers) ! - name = 'p2f_'//trim(cnst_name(m_cnst))//'' + name = 'p2f_'//trim(const_name(m_cnst))//'' call addfld(trim(name), (/ 'lev' /), 'I','','Water tracer on physics grid') call add_default (trim(name), 1, ' ') - name = 'p2f_'//trim(cnst_name(m_cnst))//'_fvm' + name = 'p2f_'//trim(const_name(m_cnst))//'_fvm' call addfld(trim(name), (/ 'lev' /), 'I','','Water tracer on FVM grid',gridname='FVM') call add_default (trim(name), 1, ' ') - name = 'p2f_'//trim(cnst_name(m_cnst))//'_err_fvm' + name = 'p2f_'//trim(const_name(m_cnst))//'_err_fvm' call addfld(trim(name), (/ 'lev' /), 'I','','Error in water tracer mapped to FVM grid',gridname='FVM') call add_default (trim(name), 1, ' ') end do @@ -130,14 +130,14 @@ subroutine test_mapping_addfld gridname='GLL') !call add_default ('p2d_v_gll_err', 1, ' ') -! name = 'phys2dyn_'//trim(cnst_name(m_cnst))//'_physgrid' +! name = 'phys2dyn_'//trim(const_name(m_cnst))//'_physgrid' ! call outfld(trim(name),phys_state%q(:ncols,:,m_cnst),ncols,lchnk) #endif end subroutine test_mapping_addfld subroutine test_mapping_overwrite_tendencies(phys_state,phys_tend,ncols,q_prev,fvm) -! use constituents, only: cnst_get_ind,pcnst,cnst_name - use physics_types, only: physics_state, physics_tend + use cam_constituents, only: const_name + use physics_types, only: physics_state, physics_tend !SE dycore: use dimensions_mod, only: fv_nphys @@ -165,9 +165,9 @@ subroutine test_mapping_overwrite_tendencies(phys_state,phys_tend,ncols,q_prev,f phys_state%q(icol,k,m_cnst) = test_func(phys_state%lat(icol), phys_state%lon(icol), k, k) end do enddo - name = 'p2f_'//trim(cnst_name(m_cnst))//'' + name = 'p2f_'//trim(const_name(m_cnst))//'' call outfld(trim(name),phys_state%q(:ncols,:,m_cnst),ncols,lchnk) - name = 'p2d_'//trim(cnst_name(m_cnst))//'' + name = 'p2d_'//trim(const_name(m_cnst))//'' call outfld(trim(name),phys_state%q(:ncols,:,m_cnst),ncols,lchnk) end do @@ -197,7 +197,7 @@ subroutine test_mapping_overwrite_tendencies(phys_state,phys_tend,ncols,q_prev,f end subroutine test_mapping_overwrite_tendencies subroutine test_mapping_output_mapped_tendencies(fvm,elem,nets,nete,tl_f,tl_qdp) -! use constituents, only: cnst_get_ind,cnst_name + use cam_constituents, only: const_name !SE dycore: use dimensions_mod, only: fv_nphys,nlev,nc @@ -236,7 +236,7 @@ subroutine test_mapping_output_mapped_tendencies(fvm,elem,nets,nete,tl_f,tl_qdp) do ie = nets,nete do nq=ntrac,ntrac m_cnst = nq - name = 'p2d_'//trim(cnst_name(m_cnst))//'_gll' + name = 'p2d_'//trim(const_name(m_cnst))//'_gll' call outfld(TRIM(name), RESHAPE(elem(ie)%derived%fq(:,:,:,nq),(/npsq,nlev/)), npsq, ie) ! call outfld(trim(name),& ! RESHAPE(fvm(ie)%fc(1:nc,1:nc,:,m_cnst),& @@ -249,13 +249,13 @@ subroutine test_mapping_output_mapped_tendencies(fvm,elem,nets,nete,tl_f,tl_qdp) end do end do end do - name = 'p2d_'//trim(cnst_name(m_cnst))//'_err_gll' + name = 'p2d_'//trim(const_name(m_cnst))//'_err_gll' call outfld(TRIM(name), RESHAPE(elem(ie)%derived%fq(:,:,:,nq),(/npsq,nlev/)), npsq, ie) end do if (ntrac>0) then do nq=ntrac,ntrac m_cnst = nq - name = 'p2f_'//trim(cnst_name(m_cnst))//'_fvm' + name = 'p2f_'//trim(const_name(m_cnst))//'_fvm' ! ! cly ! @@ -273,7 +273,7 @@ subroutine test_mapping_output_mapped_tendencies(fvm,elem,nets,nete,tl_f,tl_qdp) end do end do end do - name = 'p2f_'//trim(cnst_name(m_cnst))//'_err_fvm' + name = 'p2f_'//trim(const_name(m_cnst))//'_err_fvm' call outfld(TRIM(name), RESHAPE(diff(:,:,:,m_cnst),(/nc*nc,nlev/)), nc*nc, ie) end do @@ -283,7 +283,7 @@ subroutine test_mapping_output_mapped_tendencies(fvm,elem,nets,nete,tl_f,tl_qdp) end subroutine test_mapping_output_mapped_tendencies subroutine test_mapping_overwrite_dyn_state(elem,fvm) -! use constituents, only: cnst_name + use cam_constituents, only: const_name !SE dycore: use fvm_control_volume_mod, only: fvm_struct @@ -306,7 +306,7 @@ subroutine test_mapping_overwrite_dyn_state(elem,fvm) do ie=nets,nete do nq=ntrac,ntrac m_cnst = nq - name = 'f2p_'//trim(cnst_name(m_cnst))//'_fvm' + name = 'f2p_'//trim(const_name(m_cnst))//'_fvm' do k=1,num_fnc do j=1,nc do i=1,nc @@ -372,9 +372,9 @@ subroutine test_mapping_overwrite_dyn_state(elem,fvm) end subroutine test_mapping_overwrite_dyn_state subroutine test_mapping_output_phys_state(phys_state,fvm) - use physics_types, only: physics_state -! use ppgrid, only: begchunk, endchunk, pver, pcols -! use constituents, only: cnst_get_ind,cnst_name + use physics_types, only: physics_state +! use ppgrid, only: begchunk, endchunk, pver, pcols + use cam_constituents, only: const_name type(physics_state), intent(inout) :: phys_state type(fvm_struct), pointer:: fvm(:) @@ -393,7 +393,7 @@ subroutine test_mapping_output_phys_state(phys_state,fvm) if (ntrac>0) then do nq=ntrac,ntrac m_cnst = nq - name = 'f2p_'//trim(cnst_name(m_cnst)) + name = 'f2p_'//trim(const_name(m_cnst)) ! ! cly ! @@ -412,7 +412,7 @@ subroutine test_mapping_output_phys_state(phys_state,fvm) -test_func(phys_state(lchnk)%lat(icol), phys_state(lchnk)%lon(icol), k,k) end do enddo - name = 'f2p_'//trim(cnst_name(m_cnst))//'_err' + name = 'f2p_'//trim(const_name(m_cnst))//'_err' call outfld(TRIM(name), phys_state(lchnk)%q(1:pcols,1:pver,m_cnst), pcols, lchnk) phys_state(lchnk)%q(1:pcols,1:pver,m_cnst) = 0.0_r8 end do diff --git a/src/dynamics/tests/initial_conditions/ic_baro_dry_jw06.F90 b/src/dynamics/tests/initial_conditions/ic_baro_dry_jw06.F90 index 5a5fd4cc..6dbb6b54 100644 --- a/src/dynamics/tests/initial_conditions/ic_baro_dry_jw06.F90 +++ b/src/dynamics/tests/initial_conditions/ic_baro_dry_jw06.F90 @@ -50,13 +50,11 @@ module ic_baro_dry_jw06 subroutine bc_dry_jw06_set_ic(vcoord, latvals, lonvals, U, V, T, PS, PHIS, & Q, m_cnst, mask, verbose) - use dyn_tests_utils, only: vc_moist_pressure, vc_dry_pressure, vc_height + use dyn_tests_utils, only: vc_moist_pressure, vc_dry_pressure, vc_height + use cam_constituents, only: const_get_index !use constituents, only: cnst_name !use const_init, only: cnst_init_default - !Remove once constituents are enabled -JN - use physics_types, only: ix_cld_liq, ix_rain - !----------------------------------------------------------------------- ! ! Purpose: Set baroclinic wave initial values for dynamics state variables @@ -86,6 +84,7 @@ subroutine bc_dry_jw06_set_ic(vcoord, latvals, lonvals, U, V, T, PS, PHIS, & integer :: nlev integer :: ncnst integer :: iret + integer :: ix_rain, ix_cld_liq character(len=*), parameter :: subname = 'BC_DRY_JW06_SET_IC' real(r8) :: tmp real(r8) :: r(size(latvals)) @@ -117,6 +116,10 @@ subroutine bc_dry_jw06_set_ic(vcoord, latvals, lonvals, U, V, T, PS, PHIS, & verbose_use = .true. end if + !set constituent indices + call const_get_index('cloud_liquid_water_mixing_ratio_wrt_moist_air', ix_cld_liq) + call const_get_index('rain_water_mixing_ratio_wrt_moist_air', ix_rain) + ncol = size(latvals, 1) nlev = -1 diff --git a/src/dynamics/tests/initial_conditions/ic_baroclinic.F90 b/src/dynamics/tests/initial_conditions/ic_baroclinic.F90 index 8ddc5684..029bc9b5 100644 --- a/src/dynamics/tests/initial_conditions/ic_baroclinic.F90 +++ b/src/dynamics/tests/initial_conditions/ic_baroclinic.F90 @@ -11,11 +11,9 @@ module ic_baroclinic use cam_abortutils, only: endrun use spmd_utils, only: masterproc - use physconst, only : rair, gravit, rearth, pi, omega, epsilo - use hycoef, only : hyai, hybi, hyam, hybm, ps0 - - !Remove once constituents are enabled -JN - use physics_types, only : ix_cld_liq, ix_rain + use physconst, only : rair, gravit, rearth, pi, omega, epsilo + use hycoef, only : hyai, hybi, hyam, hybm, ps0 + use cam_constituents, only: const_get_index implicit none private @@ -109,6 +107,7 @@ subroutine bc_wav_set_ic(vcoord,latvals, lonvals, zint, U, V, T, PS, PHIS, & ! Local variables logical, allocatable :: mask_use(:) logical :: verbose_use + integer :: ix_cld_liq, ix_rain integer :: i, k, m integer :: ncol integer :: nlev @@ -160,6 +159,9 @@ subroutine bc_wav_set_ic(vcoord,latvals, lonvals, zint, U, V, T, PS, PHIS, & mask_use = .true. end if + call const_get_index('cloud_liquid_water_mixing_ratio_wrt_moist_air', ix_cld_liq) + call const_get_index('rain_water_mixing_ratio_wrt_moist_air', ix_rain) + if (present(verbose)) then verbose_use = verbose else diff --git a/src/dynamics/tests/initial_conditions/ic_held_suarez.F90 b/src/dynamics/tests/initial_conditions/ic_held_suarez.F90 index e18920c9..00ec98dd 100644 --- a/src/dynamics/tests/initial_conditions/ic_held_suarez.F90 +++ b/src/dynamics/tests/initial_conditions/ic_held_suarez.F90 @@ -25,8 +25,7 @@ module ic_held_suarez subroutine hs94_set_ic(latvals, lonvals, U, V, T, PS, PHIS, & Q, m_cnst, mask, verbose) !use const_init, only: cnst_init_default - !use constituents, only: cnst_name - use physics_types, only: ix_cld_liq, ix_rain !Remove once constituents are enabled -JN + use cam_constituents, only: const_get_index !----------------------------------------------------------------------- ! @@ -51,6 +50,7 @@ subroutine hs94_set_ic(latvals, lonvals, U, V, T, PS, PHIS, & logical, allocatable :: mask_use(:) logical :: verbose_use integer :: i, k, m + integer :: ix_cld_liq, ix_rain integer :: ncol integer :: nlev integer :: ncnst @@ -76,6 +76,10 @@ subroutine hs94_set_ic(latvals, lonvals, U, V, T, PS, PHIS, & verbose_use = .true. end if + !set constituent indices + call const_get_index('cloud_liquid_water_mixing_ratio_wrt_moist_air', ix_cld_liq) + call const_get_index('rain_water_mixing_ratio_wrt_moist_air', ix_rain) + ncol = size(latvals, 1) nlev = -1 if (present(U)) then diff --git a/src/physics/utils/cam_constituents.F90 b/src/physics/utils/cam_constituents.F90 new file mode 100644 index 00000000..e0814cd9 --- /dev/null +++ b/src/physics/utils/cam_constituents.F90 @@ -0,0 +1,526 @@ +module cam_constituents + + use ccpp_kinds, only: kind_phys + use ccpp_constituent_prop_mod, only: ccpp_constituent_prop_ptr_t + + implicit none + private + + ! Public system functions + public :: cam_constituents_readnl + public :: cam_constituents_init + ! Public accessor functions + public :: const_name ! Constituent standard name + public :: const_longname + public :: const_molec_weight + public :: const_get_index + public :: const_is_dry + public :: const_is_moist + public :: const_is_wet + public :: const_qmin + public :: const_is_initialized_in_physics + + ! Private array of constituent properties (for property interface functions) + type(ccpp_constituent_prop_ptr_t), pointer :: const_props(:) => NULL() + + ! Namelist variable + ! readtrace: Obtain initial tracer data from IC file if .true. + logical, public :: readtrace = .true. + ! Only allow initialization once + logical, private :: initialized = .false. + + !> \section arg_table_cam_constituents Argument Table + !! \htmlinclude cam_constituents.html + integer, public, protected :: num_advected = 0 + + !! Note: There are no _name interfaces in function interfaces below + !! because use of this sort of interface is often for optional + !! constituents and there is no way to indicate a missing + !! constituent in these functions (e.g., a logical). + + interface const_is_dry + module procedure const_is_dry_obj + module procedure const_is_dry_index + end interface const_is_dry + + interface const_is_moist + module procedure const_is_moist_obj + module procedure const_is_moist_index + end interface const_is_moist + + interface const_is_wet + module procedure const_is_wet_obj + module procedure const_is_wet_index + end interface const_is_wet + + interface const_qmin + module procedure const_qmin_obj + module procedure const_qmin_index + end interface const_qmin + + interface const_is_initialized_in_physics + module procedure const_is_initialized_in_physics_obj + module procedure const_is_initialized_in_physics_index + end interface const_is_initialized_in_physics + + ! Private interfaces + private :: check_index_bounds + +CONTAINS + + subroutine cam_constituents_readnl(nlfile) + + use mpi, only: mpi_logical + use shr_nl_mod, only: find_group_name => shr_nl_find_group_name + use spmd_utils, only: masterproc, mpicom, mstrid=>masterprocid + use cam_logfile, only: iulog + use cam_abortutils, only: endrun + + ! nlfile: filepath for file containing namelist input + character(len=*), intent(in) :: nlfile + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: sub = 'cam_constituents_readnl' + + namelist /constituents_nl/ readtrace + !------------------------------------------------------------------------ + + !!XXgoldyXX: v Need to figure out how to figure out pcnst + !! Update physconst so that we can use 'dry_air_species' and + !! 'water_species_in_air' from air_composition_nl. + !! Register CCPP constituents (see call below) + !! Count up species from air_composition_nl plus CCPP advected + !! constituents not in that namelist. + !! Make sure there are indices for all thermodynamically-active species + !! in runtime DDT object. Pack them at front of state Q array. + !!XXgoldyXX: ^ Need to figure out how to figure out pcnst + + if (masterproc) then + open(newunit=unitn, file=trim(nlfile), status='old') + call find_group_name(unitn, 'constituents_nl', status=ierr) + if (ierr == 0) then + read(unitn, constituents_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(sub//': FATAL: reading namelist', & + file=__FILE__, line=__LINE__) + end if + end if + close(unitn) + end if + + call mpi_bcast(readtrace, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) then + call endrun(sub//": FATAL: mpi_bcast: readtrace", & + file=__FILE__, line=__LINE__) + end if + + if (masterproc) then + write(iulog,*)'Summary of constituent module options:' + if (readtrace) then + write(iulog,*)' Attempt to read constituent initial values ', & + 'from the initial file by default' + else + write(iulog,*)' Do not read constituent initial values ', & + 'from the initial file' + end if + end if + + end subroutine cam_constituents_readnl + + !####################################################################### + + subroutine cam_constituents_init(cnst_prop_ptr, num_advect) + use cam_abortutils, only: endrun + + ! Initialize module constituent variables + type(ccpp_constituent_prop_ptr_t), pointer :: cnst_prop_ptr(:) + integer, intent(in) :: num_advect + + if (initialized) then + call endrun("cam_constituents_init: already initialized", & + file=__FILE__, line=__LINE__) + end if + const_props => cnst_prop_ptr + num_advected = num_advect + + initialized = .true. + + end subroutine cam_constituents_init + + !####################################################################### + + logical function check_index_bounds(const_ind, subname) + use cam_abortutils, only: endrun + use string_utils, only: to_str + + ! Return the standard name of the constituent at . + ! Dummy arguments + integer, intent(in) :: const_ind + character(len=*), intent(in) :: subname + ! Local variables + integer :: err_code + character(len=256) :: err_msg + + if (const_ind < LBOUND(const_props, 1)) then + call endrun(subname//"index ("//to_str(const_ind)//") out of "// & + "bounds, lower bound is "//to_str(LBOUND(const_props, 1)), & + file=__FILE__, line=__LINE__) + check_index_bounds = .false. ! safety in case abort becomes optionsl + else if (const_ind > UBOUND(const_props, 1)) then + call endrun(subname//"index ("//to_str(const_ind)//") out of "// & + "bounds, upper bound is "//to_str(UBOUND(const_props, 1)), & + file=__FILE__, line=__LINE__) + check_index_bounds = .false. ! safety in case abort becomes optionsl + else + check_index_bounds = .true. + end if + + end function check_index_bounds + + !####################################################################### + + function const_name(const_ind) + use cam_abortutils, only: endrun + use string_utils, only: to_str + use phys_vars_init_check, only: std_name_len + + ! Return the standard name of the constituent at . + ! Dummy arguments + integer, intent(in) :: const_ind + character(len=std_name_len) :: const_name + ! Local variables + integer :: err_code + character(len=256) :: err_msg + character(len=*), parameter :: subname = 'const_name: ' + + if (check_index_bounds(const_ind, subname)) then + call const_props(const_ind)%standard_name(const_name, & + err_code, err_msg) + if (err_code /= 0) then + call endrun(subname//"Error "//to_str(err_code)//": "// & + trim(err_msg), file=__FILE__, line=__LINE__) + end if + end if + + end function const_name + + !####################################################################### + + function const_longname(const_ind) + use cam_abortutils, only: endrun + use string_utils, only: to_str + use shr_kind_mod, only: CL => shr_kind_cl + + ! Return the long name of the constituent at . + ! Dummy arguments + integer, intent(in) :: const_ind + character(len=CL) :: const_longname + ! Local variables + integer :: err_code + character(len=256) :: err_msg + character(len=*), parameter :: subname = 'const_longname: ' + + if (check_index_bounds(const_ind, subname)) then + call const_props(const_ind)%long_name(const_longname, & + err_code, err_msg) + if (err_code /= 0) then + call endrun(subname//"Error "//to_str(err_code)//": "// & + trim(err_msg), file=__FILE__, line=__LINE__) + end if + end if + + end function const_longname + + !####################################################################### + + function const_molec_weight(const_ind) + use cam_abortutils, only: endrun + use string_utils, only: to_str + + ! Return the long name of the constituent at . + ! Dummy arguments + integer, intent(in) :: const_ind + real(kind_phys) :: const_molec_weight + ! Local variables + integer :: err_code + character(len=256) :: err_msg + character(len=*), parameter :: subname = 'const_molec_weight: ' + + if (check_index_bounds(const_ind, subname)) then + call const_props(const_ind)%molec_weight(const_molec_weight, & + err_code, err_msg) + if (err_code /= 0) then + call endrun(subname//"Error "//to_str(err_code)//": "// & + trim(err_msg), file=__FILE__, line=__LINE__) + end if + end if + + end function const_molec_weight + + !####################################################################### + + subroutine const_get_index(name, cindex, abort, warning, caller) + use shr_kind_mod, only: CX => SHR_KIND_CX + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + use cam_ccpp_cap, only: cam_const_get_index + + ! Get the index of a constituent with standard name, . + ! Setting optional argument to .false. returns control to + ! the caller if the constituent name is not found. + ! Default behavior is to call endrun when name is not found. + ! If the optional argument, , is passed, it is used + ! instead of in messages. + + !-----------------------------Arguments--------------------------------- + character(len=*), intent(in) :: name ! constituent name + integer, intent(out) :: cindex ! global constituent ind + logical, optional, intent(in) :: abort ! flag controlling abort + logical, optional, intent(in) :: warning ! flag controlling warning + character(len=*), optional, intent(in) :: caller ! calling routine + + !---------------------------Local workspace----------------------------- + logical :: warning_on_error + logical :: abort_on_error + integer :: errcode + character(len=CX) :: errmsg + character(len=*), parameter :: subname = 'const_get_index: ' + !----------------------------------------------------------------------- + + ! Find tracer name in the master table + call cam_const_get_index(name, cindex, errcode=errcode, errmsg=errmsg) + + if (errcode /= 0) then + ! Unrecognized name, set an error return and possibly abort + cindex = -1 + if (present(abort)) then + abort_on_error = abort + else + abort_on_error = .true. + end if + if (present(warning)) then + warning_on_error = warning + else + warning_on_error = .true. + end if + + if (abort_on_error) then + if (present(caller)) then + write(iulog, *) caller, 'FATAL: name:', trim(name), & + ' not found in constituent table' + call endrun(caller//'FATAL: name ('//trim(name)//') not found') + else + write(iulog, *) subname, 'FATAL: name:', trim(name), & + ' not found in constituent table' + call endrun(subname//'FATAL: name ('//trim(name)//') not found') + end if + else + if (warning_on_error) then + if (present(caller)) then + write(iulog, *) caller, 'WARNING: name:', trim(name), & + ' not found in constituent table' + else + write(iulog, *) subname, 'WARNING: name:', trim(name), & + ' not found in constituent table' + end if + end if + end if + end if + + end subroutine const_get_index + + !####################################################################### + + logical function const_is_dry_obj(const_obj) + use cam_abortutils, only: endrun + use string_utils, only: to_str + + ! Return .true. if the constituent object, , is dry + ! Dummy argument + type(ccpp_constituent_prop_ptr_t), intent(in) :: const_obj + ! Local variables + integer :: err_code + character(len=256) :: err_msg + character(len=*), parameter :: subname = 'const_is_dry_obj: ' + + call const_obj%is_dry(const_is_dry_obj, err_code, err_msg) + if (err_code /= 0) then + call endrun(subname//"Error "//to_str(err_code)//": "// & + trim(err_msg), file=__FILE__, line=__LINE__) + end if + + end function const_is_dry_obj + + !####################################################################### + + logical function const_is_dry_index(const_ind) + + ! Return .true. if the constituent at is dry + ! Dummy argument + integer, intent(in) :: const_ind + ! Local variable + character(len=*), parameter :: subname = 'const_is_dry_index: ' + + if (check_index_bounds(const_ind, subname)) then + const_is_dry_index = const_is_dry(const_props(const_ind)) + end if + + end function const_is_dry_index + + !####################################################################### + + logical function const_is_moist_obj(const_obj) + use cam_abortutils, only: endrun + use string_utils, only: to_str + + ! Return .true. if the constituent object, , is moist + ! Dummy argument + type(ccpp_constituent_prop_ptr_t), intent(in) :: const_obj + ! Local variables + integer :: err_code + character(len=256) :: err_msg + character(len=*), parameter :: subname = 'const_is_moist_obj: ' + + call const_obj%is_moist(const_is_moist_obj, err_code, err_msg) + if (err_code /= 0) then + call endrun(subname//"Error "//to_str(err_code)//": "// & + trim(err_msg), file=__FILE__, line=__LINE__) + end if + + end function const_is_moist_obj + + !####################################################################### + + logical function const_is_moist_index(const_ind) + + ! Return .true. if the constituent at is moist + ! Dummy argument + integer, intent(in) :: const_ind + ! Local variable + character(len=*), parameter :: subname = 'const_is_moist_index: ' + + if (check_index_bounds(const_ind, subname)) then + const_is_moist_index = const_is_moist(const_props(const_ind)) + end if + + end function const_is_moist_index + + !####################################################################### + + logical function const_is_wet_obj(const_obj) + use cam_abortutils, only: endrun + use string_utils, only: to_str + + ! Return .true. if the constituent object, , is wet + ! Dummy argument + type(ccpp_constituent_prop_ptr_t), intent(in) :: const_obj + ! Local variables + integer :: err_code + character(len=256) :: err_msg + character(len=*), parameter :: subname = 'const_is_wet_obj: ' + + call const_obj%is_wet(const_is_wet_obj, err_code, err_msg) + if (err_code /= 0) then + call endrun(subname//"Error "//to_str(err_code)//": "// & + trim(err_msg), file=__FILE__, line=__LINE__) + end if + + end function const_is_wet_obj + + !####################################################################### + + logical function const_is_wet_index(const_ind) + + ! Return .true. if the constituent at is wet + ! Dummy argument + integer, intent(in) :: const_ind + ! Local variable + character(len=*), parameter :: subname = 'const_is_wet_index: ' + + if (check_index_bounds(const_ind, subname)) then + const_is_wet_index = const_is_wet(const_props(const_ind)) + end if + + end function const_is_wet_index + + !####################################################################### + + real(kind_phys) function const_qmin_obj(const_obj) + use cam_abortutils, only: endrun + use string_utils, only: to_str + + ! Return the minimum allowed mixing ratio for, + ! Dummy argument + type(ccpp_constituent_prop_ptr_t), intent(in) :: const_obj + ! Local variables + integer :: err_code + character(len=256) :: err_msg + character(len=*), parameter :: subname = 'const_qmin_obj: ' + + call const_obj%minimum(const_qmin_obj, err_code, err_msg) + if (err_code /= 0) then + call endrun(subname//"Error "//to_str(err_code)//": "// & + trim(err_msg), file=__FILE__, line=__LINE__) + end if + + end function const_qmin_obj + + !####################################################################### + + real(kind_phys) function const_qmin_index(const_ind) + + ! Return the minimum allowed mxing ratio for the constituent at + ! Dummy argument + integer, intent(in) :: const_ind + ! Local variable + character(len=*), parameter :: subname = 'const_qmin_index: ' + + if (check_index_bounds(const_ind, subname)) then + const_qmin_index = const_qmin(const_props(const_ind)) + end if + + end function const_qmin_index + + !####################################################################### + + logical function const_is_initialized_in_physics_obj(const_obj) result(is_initialized) + use cam_abortutils, only: endrun + use string_utils, only: to_str + + ! Return true iff is initialized in physics + ! Dummy argument + type(ccpp_constituent_prop_ptr_t), intent(in) :: const_obj + ! Local variables + integer :: err_code + character(len=256) :: err_msg + character(len=*), parameter :: subname = 'const_is_initialized_in_physics_obj: ' + + call const_obj%is_initialized_in_physics(is_initialized, errcode=err_code, errmsg=err_msg) + if (err_code /= 0) then + call endrun(subname//"Error "//to_str(err_code)//": "// & + trim(err_msg), file=__FILE__, line=__LINE__) + end if + + end function const_is_initialized_in_physics_obj + + !####################################################################### + + logical function const_is_initialized_in_physics_index(const_ind) result(is_initialized) + use cam_ccpp_cap, only: cam_model_const_properties + ! Return true iff the constituent at is initialized in physics + ! Dummy argument + integer, intent(in) :: const_ind + ! Local variable + type(ccpp_constituent_prop_ptr_t), pointer :: const_properties(:) + character(len=*), parameter :: subname = 'const_is_initialized_in_physics_index: ' + + const_properties => NULL() + if (check_index_bounds(const_ind, subname)) then + const_properties => cam_model_const_properties() + is_initialized = const_is_initialized_in_physics(const_properties(const_ind)) + end if + + end function const_is_initialized_in_physics_index + +end module cam_constituents diff --git a/src/physics/utils/cam_constituents.meta b/src/physics/utils/cam_constituents.meta new file mode 100644 index 00000000..37de9894 --- /dev/null +++ b/src/physics/utils/cam_constituents.meta @@ -0,0 +1,14 @@ +################################### +[ccpp-table-properties] + name = cam_constituents + type = module + +[ccpp-arg-table] + name = cam_constituents + type = module +[ num_advected ] + standard_name = number_of_advected_constituents + units = count + type = integer + dimensions = () + protected = True diff --git a/src/physics/utils/constituents.F90 b/src/physics/utils/constituents.F90 deleted file mode 100644 index 8c598ef5..00000000 --- a/src/physics/utils/constituents.F90 +++ /dev/null @@ -1,76 +0,0 @@ -module constituents - - implicit none - private - - public :: cnst_readnl - - ! Namelist variable - ! readtrace: Obtain initial tracer data from IC file if .true. - logical, public, protected :: readtrace = .true. - - !> \section arg_table_constituents Argument Table - !! \htmlinclude constituents.html - integer, public, protected :: pcnst = 0 - -CONTAINS - - subroutine cnst_readnl(nlfile) - - use mpi, only: mpi_logical - use shr_nl_mod, only: find_group_name => shr_nl_find_group_name - use spmd_utils, only: masterproc, mpicom, mstrid=>masterprocid - use cam_logfile, only: iulog - use cam_abortutils, only: endrun - !!XXgoldyXX: v see comment about pcnst - use physics_types, only: ix_qv, ix_cld_liq, ix_rain - !!XXgoldyXX: ^ see comment about pcnst - - ! nlfile: filepath for file containing namelist input - character(len=*), intent(in) :: nlfile - - ! Local variables - integer :: unitn, ierr - character(len=*), parameter :: sub = 'cnst_readnl' - - namelist /constituents_nl/ readtrace - !------------------------------------------------------------------------ - - !!XXgoldyXX: v Need to figure out how to figure out pcnst - pcnst = 3 - ix_qv = 1 - ix_cld_liq = 2 - ix_rain = 3 - !!XXgoldyXX: ^ Need to figure out how to figure out pcnst - - if (masterproc) then - open(newunit=unitn, file=trim(nlfile), status='old') - call find_group_name(unitn, 'constituents_nl', status=ierr) - if (ierr == 0) then - read(unitn, constituents_nl, iostat=ierr) - if (ierr /= 0) then - call endrun(sub//': FATAL: reading namelist') - end if - end if - close(unitn) - end if - - call mpi_bcast(readtrace, 1, mpi_logical, mstrid, mpicom, ierr) - if (ierr /= 0) then - call endrun(sub//": FATAL: mpi_bcast: readtrace") - end if - - if (masterproc) then - write(iulog,*)'Summary of constituent module options:' - if (readtrace) then - write(iulog,*)' Attempt to read constituent initial values ', & - 'from the initial file by default' - else - write(iulog,*)' Do not read constituent initial values ', & - 'from the initial file' - end if - end if - - end subroutine cnst_readnl - -end module constituents diff --git a/src/physics/utils/constituents.meta b/src/physics/utils/constituents.meta deleted file mode 100644 index 9bf36c54..00000000 --- a/src/physics/utils/constituents.meta +++ /dev/null @@ -1,13 +0,0 @@ -[ccpp-table-properties] - name = constituents - type = module - -[ccpp-arg-table] - name = constituents - type = module -[ pcnst ] - standard_name = number_of_constituents - units = count - type = integer - dimensions = () - protected = True diff --git a/src/physics/utils/phys_comp.F90 b/src/physics/utils/phys_comp.F90 index d9a97ccd..663a8b06 100644 --- a/src/physics/utils/phys_comp.F90 +++ b/src/physics/utils/phys_comp.F90 @@ -127,18 +127,17 @@ subroutine phys_readnl(nlfilename) end subroutine phys_readnl subroutine phys_init(cam_runtime_opts, phys_state, phys_tend, cam_out) - use pio, only: file_desc_t - use cam_abortutils, only: endrun - use runtime_obj, only: runtime_options - use physics_types, only: physics_state, physics_tend - use camsrfexch, only: cam_out_t - use physics_grid, only: columns_on_task - use vert_coord, only: pver, pverp - use cam_thermo, only: cam_thermo_init - use physics_types, only: allocate_physics_types_fields - use constituents, only: pcnst - use cam_ccpp_cap, only: cam_ccpp_physics_initialize - use cam_ccpp_cap, only: ccpp_physics_suite_part_list + use pio, only: file_desc_t + use cam_abortutils, only: endrun + use runtime_obj, only: runtime_options + use physics_types, only: physics_state, physics_tend + use camsrfexch, only: cam_out_t + use physics_grid, only: columns_on_task + use vert_coord, only: pver, pverp + use cam_thermo, only: cam_thermo_init + use physics_types, only: allocate_physics_types_fields + use cam_ccpp_cap, only: cam_ccpp_physics_initialize + use cam_ccpp_cap, only: ccpp_physics_suite_part_list ! Dummy arguments type(runtime_options), intent(in) :: cam_runtime_opts @@ -155,7 +154,7 @@ subroutine phys_init(cam_runtime_opts, phys_state, phys_tend, cam_out) call cam_thermo_init(columns_on_task, pver, pverp) call allocate_physics_types_fields(columns_on_task, pver, pverp, & - pcnst, set_init_val_in=.true., reallocate_in=.false.) + set_init_val_in=.true., reallocate_in=.false.) call cam_ccpp_physics_initialize(phys_suite_name, dtime_phys, & errmsg, errcode) if (errcode /= 0) then diff --git a/src/physics/utils/physics_data.F90 b/src/physics/utils/physics_data.F90 index bf2a421b..3950b6d0 100644 --- a/src/physics/utils/physics_data.F90 +++ b/src/physics/utils/physics_data.F90 @@ -13,6 +13,7 @@ module physics_data integer, public, parameter :: no_exist_idx = -1 integer, public, parameter :: init_mark_idx = -2 integer, public, parameter :: prot_no_init_idx = -3 + integer, public, parameter :: const_idx = -4 interface read_field module procedure read_field_2d @@ -28,28 +29,37 @@ module physics_data CONTAINS !============================================================================== - integer function find_input_name_idx(stdname, use_init_variables) + integer function find_input_name_idx(stdname, use_init_variables, constituent_index) !Finds the 'input_var_names' array index for a given !variable standard name. use phys_vars_init_check, only: protected_vars use phys_vars_init_check, only: phys_var_stdnames - use phys_vars_init_check, only: phys_var_num + use phys_vars_init_check, only: phys_const_stdnames + use phys_vars_init_check, only: phys_var_num, phys_const_num use phys_vars_init_check, only: is_initialized use phys_vars_init_check, only: is_read_from_file + use cam_constituents, only: const_get_index + use cam_constituents, only: const_is_initialized_in_physics - !Variable standard name being checked: - character(len=*), intent(in) :: stdname - - !Logical for whether or not to read initialized variables - logical, intent(in) :: use_init_variables + ! Dummy arguments + ! Variable standard name being checked: + character(len=*), intent(in) :: stdname + ! Logical for whether or not to read initialized variables + logical, intent(in) :: use_init_variables + ! Variable to store constituent index if necessary: + integer, intent(out) :: constituent_index - !standard names array index: + ! Local variables + ! standard names array index: integer :: idx + ! to test read_from_file status + logical :: is_read !Initialize function: find_input_name_idx = no_exist_idx + constituent_index = no_exist_idx !Loop through physics variable standard names: do idx = 1, phys_var_num @@ -58,7 +68,12 @@ integer function find_input_name_idx(stdname, use_init_variables) !Check if this variable has already been initialized. !If so, then set the index to a quantity that will be skipped: if (is_initialized(stdname)) then - if (use_init_variables.and.is_read_from_file(stdname)) then + if (use_init_variables) then + call is_read_from_file(stdname, is_read) + else + is_read = .false. + end if + if (is_read) then !If reading initialized variables, set to idx: find_input_name_idx = idx else @@ -75,6 +90,32 @@ integer function find_input_name_idx(stdname, use_init_variables) exit end if end do + ! If not found, loop through the excluded variable standard names + if (find_input_name_idx == no_exist_idx) then + do idx = 1, phys_const_num + if (trim(phys_const_stdnames(idx)) == trim(stdname)) then + ! Set to initialized because we can't check here. + ! The relevant modules (e.g., cam_constituents) will check. + find_input_name_idx = init_mark_idx + end if + end do + end if + ! If still not found, look in the constituent hash table + if (find_input_name_idx == no_exist_idx) then + call const_get_index(trim(stdname), find_input_name_idx, abort=.false., warning=.false.) + if (find_input_name_idx < 0) then + find_input_name_idx = no_exist_idx + else + ! Check if constituent is initialized in a physics init routine + if (const_is_initialized_in_physics(find_input_name_idx)) then + find_input_name_idx = init_mark_idx + else + constituent_index = find_input_name_idx + find_input_name_idx = const_idx + end if + end if + end if + end function find_input_name_idx @@ -100,7 +141,7 @@ function arr2str(name_array) end function arr2str - subroutine read_field_2d(file, std_name, var_names, timestep, buffer) + subroutine read_field_2d(file, std_name, var_names, timestep, buffer, mark_as_read) use shr_assert_mod, only: shr_assert_in_domain use shr_sys_mod, only: shr_sys_flush use pio, only: file_desc_t, var_desc_t @@ -112,7 +153,7 @@ subroutine read_field_2d(file, std_name, var_names, timestep, buffer) use phys_vars_init_check, only: mark_as_read_from_file !Max possible length of variable name in input (IC) file: - use phys_vars_init_check, only: ic_name_len + use phys_vars_init_check, only: std_name_len ! Dummy arguments type(file_desc_t), intent(inout) :: file @@ -120,13 +161,24 @@ subroutine read_field_2d(file, std_name, var_names, timestep, buffer) character(len=*), intent(in) :: var_names(:) ! var name on file integer, intent(in) :: timestep real(kind_phys), intent(inout) :: buffer(:) + logical, optional, intent(in) :: mark_as_read ! Local variables + logical :: mark_as_read_local logical :: var_found - character(len=ic_name_len) :: found_name + character(len=std_name_len) :: found_name type(var_desc_t) :: vardesc character(len=*), parameter :: subname = 'read_field_2d: ' + if (present(mark_as_read)) then + mark_as_read_local = mark_as_read + else + mark_as_read_local = .true. + end if + call cam_pio_find_var(file, var_names, found_name, vardesc, var_found) + if (.not. var_found) then + call cam_pio_find_var(file, [std_name], found_name, vardesc, var_found) + end if if (var_found) then if (masterproc) then @@ -135,7 +187,9 @@ subroutine read_field_2d(file, std_name, var_names, timestep, buffer) end if call cam_read_field(found_name, file, buffer, var_found, & timelevel=timestep) - call mark_as_read_from_file(std_name) + if (mark_as_read_local) then + call mark_as_read_from_file(std_name) + end if else call endrun(subname//'No variable found in '//arr2str(var_names)) end if @@ -149,7 +203,7 @@ subroutine read_field_2d(file, std_name, var_names, timestep, buffer) end subroutine read_field_2d subroutine read_field_3d(file, std_name, var_names, vcoord_name, & - timestep, buffer) + timestep, buffer, mark_as_read) use shr_assert_mod, only: shr_assert_in_domain use shr_sys_mod, only: shr_sys_flush use pio, only: file_desc_t, var_desc_t @@ -162,7 +216,7 @@ subroutine read_field_3d(file, std_name, var_names, vcoord_name, & use phys_vars_init_check, only: mark_as_read_from_file !Max possible length of variable name in input (IC) file: - use phys_vars_init_check, only: ic_name_len + use phys_vars_init_check, only: std_name_len ! Dummy arguments type(file_desc_t), intent(inout) :: file @@ -171,15 +225,26 @@ subroutine read_field_3d(file, std_name, var_names, vcoord_name, & character(len=*), intent(in) :: vcoord_name integer, intent(in) :: timestep real(kind_phys), intent(inout) :: buffer(:,:) + logical, optional, intent(in) :: mark_as_read ! Local variables + logical :: mark_as_read_local logical :: var_found integer :: num_levs - character(len=ic_name_len) :: found_name + character(len=std_name_len) :: found_name type(var_desc_t) :: vardesc character(len=*), parameter :: subname = 'read_field_3d: ' + if (present(mark_as_read)) then + mark_as_read_local = mark_as_read + else + mark_as_read_local = .true. + end if + call cam_pio_find_var(file, var_names, found_name, vardesc, var_found) + if (.not. var_found) then + call cam_pio_find_var(file, [std_name], found_name, vardesc, var_found) + end if if (var_found) then if (trim(vcoord_name) == 'lev') then num_levs = pver @@ -195,7 +260,9 @@ subroutine read_field_3d(file, std_name, var_names, vcoord_name, & call cam_read_field(found_name, file, buffer, var_found, & timelevel=timestep, dim3name=trim(vcoord_name), & dim3_bnds=(/1, num_levs/)) - call mark_as_read_from_file(std_name) + if (mark_as_read_local) then + call mark_as_read_from_file(std_name) + end if else call endrun(subname//'No variable found in '//arr2str(var_names)) end if @@ -204,7 +271,7 @@ subroutine read_field_3d(file, std_name, var_names, vcoord_name, & varname=trim(found_name), & msg=subname//'NaN found in '//trim(found_name)) else - call endrun(subname//'Mismatch variable found in '//arr2str(var_names)) + call endrun(subname//'Mismatch variable found in '//found_name) end if end subroutine read_field_3d @@ -219,7 +286,7 @@ subroutine check_field_2d(file, var_names, timestep, current_value, & use spmd_utils, only: mpicom !Max possible length of variable name in file: - use phys_vars_init_check, only: ic_name_len + use phys_vars_init_check, only: std_name_len !Dummy arguments: real(kind_phys), intent(in) :: current_value(:) @@ -233,7 +300,7 @@ subroutine check_field_2d(file, var_names, timestep, current_value, & !Local variables: logical :: var_found - character(len=ic_name_len) :: found_name + character(len=std_name_len) :: found_name type(var_desc_t) :: vardesc character(len=*), parameter :: subname = 'check_field_2d' real(kind_phys) :: diff @@ -304,7 +371,7 @@ subroutine check_field_3d(file, var_names, vcoord_name, timestep, & use vert_coord, only: pver, pverp !Max possible length of variable name in file: - use phys_vars_init_check, only: ic_name_len + use phys_vars_init_check, only: std_name_len !Dummy arguments: real(kind_phys), intent(in) :: current_value(:,:) @@ -319,7 +386,7 @@ subroutine check_field_3d(file, var_names, vcoord_name, timestep, & !Local variables: logical :: var_found = .true. - character(len=ic_name_len) :: found_name + character(len=std_name_len) :: found_name type(var_desc_t) :: vardesc character(len=*), parameter :: subname = 'check_field_3d' real(kind_phys) :: diff @@ -405,7 +472,6 @@ subroutine write_check_field_entry(stdname, diff_count, max_diff, is_first) !Local variables: character(len=24) :: fmt_str integer :: slen - integer :: row integer, parameter :: indent_level = 50 slen = len_trim(stdname) diff --git a/src/utils/spmd_utils.meta b/src/utils/spmd_utils.meta index 6fa78afe..eb82abc5 100644 --- a/src/utils/spmd_utils.meta +++ b/src/utils/spmd_utils.meta @@ -7,19 +7,31 @@ type = module [ mpicom ] standard_name = mpi_communicator - units = None + units = index type = integer dimensions = () protected = True [ masterprocid ] standard_name = mpi_root - units = None + units = index type = integer dimensions = () protected = True [ masterproc ] - standard_name = flag_for_mpi_root + standard_name = is_mpi_root units = flag type = logical dimensions = () protected = True +[ iam ] + standard_name = mpi_rank + units = index + type = integer + dimensions = () + protected = True +[ npes ] + standard_name = number_of_mpi_tasks + units = count + type = integer + dimensions = () + protected = True diff --git a/src/utils/std_atm_profile.F90 b/src/utils/std_atm_profile.F90 index 04378085..f0821d1f 100644 --- a/src/utils/std_atm_profile.F90 +++ b/src/utils/std_atm_profile.F90 @@ -90,13 +90,13 @@ end subroutine std_atm_pres !========================================================================================= subroutine std_atm_height(pstd, height) + use string_utils, only: to_str ! arguments real(r8), intent(in) :: pstd(:) ! std pressure in Pa real(r8), intent(out) :: height(:) ! height above sea level in meters integer :: i, ii, k, nlev - logical :: found_region character(len=*), parameter :: routine = 'std_atm_height' !---------------------------------------------------------------------------- @@ -109,6 +109,7 @@ subroutine std_atm_height(pstd, height) ii = 1 else ! find region containing pressure + ii = -1 find_region: do i = 2, nreg if (pstd(k) > pb(i)) then ii = i - 1 @@ -117,6 +118,11 @@ subroutine std_atm_height(pstd, height) end do find_region end if + if (ii < 1) then + ! We did not find a region + call endrun(routine//": Did not find presure region for level = "//to_str(k)) + end if + if (lb(ii) /= 0._r8) then height(k) = hb(ii) + (tb(ii)/lb(ii)) * ( (pb(ii)/pstd(k))**(lb(ii)/c1) - 1._r8 ) else @@ -129,6 +135,7 @@ end subroutine std_atm_height !========================================================================================= subroutine std_atm_temp(height, temp) + use string_utils, only: to_str ! arguments real(r8), intent(in) :: height(:) ! std pressure in Pa @@ -144,6 +151,7 @@ subroutine std_atm_temp(height, temp) if (height(k) < 0.0_r8) then ii = 1 else + ii = -1 ! find region containing height find_region: do i = nreg, 1, -1 if (height(k) >= hb(i)) then @@ -153,6 +161,11 @@ subroutine std_atm_temp(height, temp) end do find_region end if + if (ii < 1) then + ! We did not find a region + call endrun(routine//": Did not find presure region for level = "//to_str(k)) + end if + if (lb(ii) /= 0._r8) then temp(k) = tb(ii) + lb(ii)*(height(k) - hb(ii)) else diff --git a/src/utils/time_manager.F90 b/src/utils/time_manager.F90 index ed9159fb..ff15e614 100644 --- a/src/utils/time_manager.F90 +++ b/src/utils/time_manager.F90 @@ -19,6 +19,7 @@ module time_manager use string_utils, only: to_upper use cam_abortutils, only: endrun use cam_logfile, only: iulog + use runtime_obj, only: unset_int implicit none private @@ -58,7 +59,7 @@ module time_manager ! Private module data -integer, parameter :: uninit_int = -999999999 +integer, parameter :: uninit_int = unset_int integer :: dtime = uninit_int ! timestep in seconds @@ -416,41 +417,60 @@ end subroutine init_calendar subroutine timemgr_print() ! Local variables + integer :: rc + integer :: yr, mon, day + integer :: nstep ! current step number + integer :: step_sec ! timestep size in seconds + integer :: start_yr ! start year + integer :: start_mon ! start month + integer :: start_day ! start day of month + integer :: start_tod ! start time of day + integer :: stop_yr ! stop year + integer :: stop_mon ! stop month + integer :: stop_day ! stop day of month + integer :: stop_tod ! stop time of day + integer :: ref_yr ! reference year + integer :: ref_mon ! reference month + integer :: ref_day ! reference day of month + integer :: ref_tod ! reference time of day + integer :: curr_yr ! current year + integer :: curr_mon ! current month + integer :: curr_day ! current day of month + integer :: curr_tod ! current time of day + integer(ESMF_KIND_I8) :: step_no ! current ESMF Clock step number + type(ESMF_Time) :: start_date ! start date for run + type(ESMF_Time) :: stop_date ! stop date for run + type(ESMF_Time) :: curr_date ! current date for run + type(ESMF_Time) :: ref_date ! reference date + type(ESMF_TimeInterval) :: step ! Time-step character(len=*), parameter :: sub = 'timemgr_print' - integer :: rc - integer :: yr, mon, day - integer ::& - nstep = uninit_int, &! current step number - step_sec = uninit_int, &! timestep size seconds - start_yr = uninit_int, &! start year - start_mon = uninit_int, &! start month - start_day = uninit_int, &! start day of month - start_tod = uninit_int, &! start time of day - stop_yr = uninit_int, &! stop year - stop_mon = uninit_int, &! stop month - stop_day = uninit_int, &! stop day of month - stop_tod = uninit_int, &! stop time of day - ref_yr = uninit_int, &! reference year - ref_mon = uninit_int, &! reference month - ref_day = uninit_int, &! reference day of month - ref_tod = uninit_int, &! reference time of day - curr_yr = uninit_int, &! current year - curr_mon = uninit_int, &! current month - curr_day = uninit_int, &! current day of month - curr_tod = uninit_int ! current time of day - integer(ESMF_KIND_I8) :: step_no - type(ESMF_Time) :: start_date! start date for run - type(ESMF_Time) :: stop_date ! stop date for run - type(ESMF_Time) :: curr_date ! current date for run - type(ESMF_Time) :: ref_date ! reference date - type(ESMF_TimeInterval) :: step ! Time-step -!----------------------------------------------------------------------------------------- +!------------------------------------------------------------------------------ + + !Initialize variables + nstep = uninit_int + step_sec = uninit_int + start_yr = uninit_int + start_mon = uninit_int + start_day = uninit_int + start_tod = uninit_int + stop_yr = uninit_int + stop_mon = uninit_int + stop_day = uninit_int + stop_tod = uninit_int + ref_yr = uninit_int + ref_mon = uninit_int + ref_day = uninit_int + ref_tod = uninit_int + curr_yr = uninit_int + curr_mon = uninit_int + curr_day = uninit_int + curr_tod = uninit_int call ESMF_ClockGet( tm_clock, startTime=start_date, currTime=curr_date, & refTime=ref_date, stopTime=stop_date, timeStep=step, & advanceCount=step_no, rc=rc ) call chkrc(rc, sub//': error return from ESMF_ClockGet') - nstep = step_no + nstep = int(step_no) write(iulog,*)' ********** Time Manager Configuration **********' @@ -543,7 +563,7 @@ integer function get_nstep() call ESMF_ClockGet(tm_clock, advanceCount=step_no, rc=rc) call chkrc(rc, sub//': error return from ESMF_ClockGet') - get_nstep = step_no + get_nstep = int(step_no) end function get_nstep !========================================================================================= @@ -985,7 +1005,7 @@ logical function is_first_step() call ESMF_ClockGet( tm_clock, advanceCount=step_no, rc=rc ) call chkrc(rc, sub//': error return from ESMF_ClockGet') - nstep = step_no + nstep = int(step_no) is_first_step = (nstep == 0) end function is_first_step diff --git a/test/unit/sample_files/physics_types_complete.F90 b/test/unit/sample_files/physics_types_complete.F90 index de6af294..c0a048c9 100644 --- a/test/unit/sample_files/physics_types_complete.F90 +++ b/test/unit/sample_files/physics_types_complete.F90 @@ -18,6 +18,8 @@ module physics_types_complete use ccpp_kinds, only: kind_phys + use physconst, only: rair + use physconst, only: cpair implicit none @@ -57,15 +59,18 @@ module physics_types_complete !> \section arg_table_physics_types_complete Argument Table !! \htmlinclude physics_types_complete.html ! ix_qv: Index of water vapor specific humidity - integer, public :: ix_qv = 1 + integer, public :: ix_qv = 1 ! ix_cld_liq: Index of cloud liquid water mixing ratio of moist air - integer, public :: ix_cld_liq = 2 + integer, public :: ix_cld_liq = 2 ! param_val_var: Made up param variable - integer, public, parameter :: param_val_var = 42 + integer, public, parameter :: param_val_var = 42 ! standard_var: Standard non ddt variable - real, public :: standard_var + real, public :: standard_var + ! cappav: Composition-dependent ratio of dry air gas constant to specific heat at constant + ! pressure + real(kind_phys), public, allocatable :: cappav(:, :) ! phys_state: Physics state variables updated by dynamical core - type(physics_state), public :: phys_state + type(physics_state), public :: phys_state !! public interfaces public :: allocate_physics_types_complete_fields @@ -110,6 +115,20 @@ subroutine allocate_physics_types_complete_fields(horizontal_dimension, if (set_init_val) then standard_var = nan end if + if (allocated(cappav)) then + if (reallocate) then + deallocate(cappav) + else + call endrun(subname//": cappav is already allocated, cannot allocate") + end if + end if + allocate(cappav(horizontal_dimension, vertical_layer_dimension)) + if (set_init_val) then + cappav = 1 + rair/cpair - rair * 2 + call & + mark_as_initialized('composition_dependent_ratio_of_dry_air_gas_constant_to_specific_heat_at_constant_pressure') + + end if if (associated(phys_state%latitude)) then if (reallocate) then deallocate(phys_state%latitude) diff --git a/test/unit/sample_files/physics_types_complete.meta b/test/unit/sample_files/physics_types_complete.meta index cecbc98f..c617a800 100644 --- a/test/unit/sample_files/physics_types_complete.meta +++ b/test/unit/sample_files/physics_types_complete.meta @@ -101,6 +101,12 @@ units = K type = real dimensions = () +[ cappav ] + standard_name = composition_dependent_ratio_of_dry_air_gas_constant_to_specific_heat_at_constant_pressure + long_name = Composition-dependent ratio of dry air gas constant to specific heat at constant pressure + units = 1 + type = real | kind = kind_phys + dimensions = (horizontal_dimension, vertical_layer_dimension) [ phys_state ] standard_name = physics_state_due_to_dynamics long_name = Physics state variables updated by dynamical core diff --git a/test/unit/sample_files/physics_types_ddt_eul.F90 b/test/unit/sample_files/physics_types_ddt_eul.F90 index e7ee7e71..0cd8e191 100644 --- a/test/unit/sample_files/physics_types_ddt_eul.F90 +++ b/test/unit/sample_files/physics_types_ddt_eul.F90 @@ -18,6 +18,8 @@ module physics_types_ddt use ccpp_kinds, only: kind_phys + use physconst, only: cpair + use physconst, only: rair implicit none @@ -33,11 +35,14 @@ module physics_types_ddt !> \section arg_table_physics_types_ddt Argument Table !! \htmlinclude physics_types_ddt.html ! latitude: Latitude - real(kind_phys), public, pointer, protected :: latitude(:) => NULL() + real(kind_phys), public, pointer, protected :: latitude(:) => NULL() ! longitude: Longitude - real(kind_phys), public, pointer, protected :: longitude(:) => NULL() + real(kind_phys), public, pointer, protected :: longitude(:) => NULL() + ! cappav: Composition-dependent ratio of dry air gas constant to specific heat at constant + ! pressure + real(kind_phys), public, allocatable :: cappav(:, :) ! phys_state: Physics state variables updated by dynamical core - type(physics_state), public :: phys_state + type(physics_state), public :: phys_state !! public interfaces public :: allocate_physics_types_ddt_fields @@ -45,12 +50,13 @@ module physics_types_ddt CONTAINS - subroutine allocate_physics_types_ddt_fields(horizontal_dimension, set_init_val_in, & - reallocate_in) + subroutine allocate_physics_types_ddt_fields(horizontal_dimension, vertical_layer_dimension, & + set_init_val_in, reallocate_in) use shr_infnan_mod, only: nan => shr_infnan_nan, assignment(=) use cam_abortutils, only: endrun !! Dummy arguments integer, intent(in) :: horizontal_dimension + integer, intent(in) :: vertical_layer_dimension logical, optional, intent(in) :: set_init_val_in logical, optional, intent(in) :: reallocate_in @@ -95,6 +101,20 @@ subroutine allocate_physics_types_ddt_fields(horizontal_dimension, set_init_val_ if (set_init_val) then longitude = nan end if + if (allocated(cappav)) then + if (reallocate) then + deallocate(cappav) + else + call endrun(subname//": cappav is already allocated, cannot allocate") + end if + end if + allocate(cappav(horizontal_dimension, vertical_layer_dimension)) + if (set_init_val) then + cappav = rair/cpair + call & + mark_as_initialized('composition_dependent_ratio_of_dry_air_gas_constant_to_specific_heat_at_constant_pressure') + + end if if (set_init_val) then phys_state%ncol = 0 end if diff --git a/test/unit/sample_files/physics_types_ddt_eul.meta b/test/unit/sample_files/physics_types_ddt_eul.meta index bd5a5a54..5b3b38dc 100644 --- a/test/unit/sample_files/physics_types_ddt_eul.meta +++ b/test/unit/sample_files/physics_types_ddt_eul.meta @@ -29,6 +29,12 @@ type = real | kind = kind_phys dimensions = (horizontal_dimension) protected = True +[ cappav ] + standard_name = composition_dependent_ratio_of_dry_air_gas_constant_to_specific_heat_at_constant_pressure + long_name = Composition-dependent ratio of dry air gas constant to specific heat at constant pressure + units = 1 + type = real | kind = kind_phys + dimensions = (horizontal_dimension, vertical_layer_dimension) [ phys_state ] standard_name = physics_state_due_to_dynamics long_name = Physics state variables updated by dynamical core diff --git a/test/unit/sample_files/physics_types_ddt_fv.F90 b/test/unit/sample_files/physics_types_ddt_fv.F90 index 2446d024..e3d4afe3 100644 --- a/test/unit/sample_files/physics_types_ddt_fv.F90 +++ b/test/unit/sample_files/physics_types_ddt_fv.F90 @@ -18,6 +18,8 @@ module physics_types_ddt use ccpp_kinds, only: kind_phys + use physconst, only: cpair + use physconst, only: rair implicit none @@ -35,9 +37,12 @@ module physics_types_ddt !> \section arg_table_physics_types_ddt Argument Table !! \htmlinclude physics_types_ddt.html ! latitude: Latitude - real(kind_phys), public, pointer, protected :: latitude(:) => NULL() + real(kind_phys), public, pointer, protected :: latitude(:) => NULL() + ! cappav: Composition-dependent ratio of dry air gas constant to specific heat at constant + ! pressure + real(kind_phys), public, allocatable :: cappav(:, :) ! phys_state: Physics state variables updated by dynamical core - type(physics_state), public :: phys_state + type(physics_state), public :: phys_state !! public interfaces public :: allocate_physics_types_ddt_fields @@ -45,12 +50,13 @@ module physics_types_ddt CONTAINS - subroutine allocate_physics_types_ddt_fields(horizontal_dimension, set_init_val_in, & - reallocate_in) + subroutine allocate_physics_types_ddt_fields(horizontal_dimension, vertical_layer_dimension, & + set_init_val_in, reallocate_in) use shr_infnan_mod, only: nan => shr_infnan_nan, assignment(=) use cam_abortutils, only: endrun !! Dummy arguments integer, intent(in) :: horizontal_dimension + integer, intent(in) :: vertical_layer_dimension logical, optional, intent(in) :: set_init_val_in logical, optional, intent(in) :: reallocate_in @@ -83,6 +89,20 @@ subroutine allocate_physics_types_ddt_fields(horizontal_dimension, set_init_val_ if (set_init_val) then latitude = nan end if + if (allocated(cappav)) then + if (reallocate) then + deallocate(cappav) + else + call endrun(subname//": cappav is already allocated, cannot allocate") + end if + end if + allocate(cappav(horizontal_dimension, vertical_layer_dimension)) + if (set_init_val) then + cappav = rair/cpair + call & + mark_as_initialized('composition_dependent_ratio_of_dry_air_gas_constant_to_specific_heat_at_constant_pressure') + + end if if (set_init_val) then phys_state%ncol = 0 end if diff --git a/test/unit/sample_files/physics_types_ddt_fv.meta b/test/unit/sample_files/physics_types_ddt_fv.meta index 39877b92..94705ce0 100644 --- a/test/unit/sample_files/physics_types_ddt_fv.meta +++ b/test/unit/sample_files/physics_types_ddt_fv.meta @@ -29,6 +29,12 @@ type = real | kind = kind_phys dimensions = (horizontal_dimension) protected = True +[ cappav ] + standard_name = composition_dependent_ratio_of_dry_air_gas_constant_to_specific_heat_at_constant_pressure + long_name = Composition-dependent ratio of dry air gas constant to specific heat at constant pressure + units = 1 + type = real | kind = kind_phys + dimensions = (horizontal_dimension, vertical_layer_dimension) [ phys_state ] standard_name = physics_state_due_to_dynamics long_name = Physics state variables updated by dynamical core diff --git a/test/unit/sample_files/physics_types_ddt_se.F90 b/test/unit/sample_files/physics_types_ddt_se.F90 index 894f280f..3019e2d7 100644 --- a/test/unit/sample_files/physics_types_ddt_se.F90 +++ b/test/unit/sample_files/physics_types_ddt_se.F90 @@ -18,6 +18,8 @@ module physics_types_ddt use ccpp_kinds, only: kind_phys + use physconst, only: cpair + use physconst, only: rair implicit none @@ -35,9 +37,12 @@ module physics_types_ddt !> \section arg_table_physics_types_ddt Argument Table !! \htmlinclude physics_types_ddt.html ! longitude: Longitude - real(kind_phys), public, pointer, protected :: longitude(:) => NULL() + real(kind_phys), public, pointer, protected :: longitude(:) => NULL() + ! cappav: Composition-dependent ratio of dry air gas constant to specific heat at constant + ! pressure + real(kind_phys), public, allocatable :: cappav(:, :) ! phys_state: Physics state variables updated by dynamical core - type(physics_state), public :: phys_state + type(physics_state), public :: phys_state !! public interfaces public :: allocate_physics_types_ddt_fields @@ -45,12 +50,13 @@ module physics_types_ddt CONTAINS - subroutine allocate_physics_types_ddt_fields(horizontal_dimension, set_init_val_in, & - reallocate_in) + subroutine allocate_physics_types_ddt_fields(horizontal_dimension, vertical_layer_dimension, & + set_init_val_in, reallocate_in) use shr_infnan_mod, only: nan => shr_infnan_nan, assignment(=) use cam_abortutils, only: endrun !! Dummy arguments integer, intent(in) :: horizontal_dimension + integer, intent(in) :: vertical_layer_dimension logical, optional, intent(in) :: set_init_val_in logical, optional, intent(in) :: reallocate_in @@ -83,6 +89,20 @@ subroutine allocate_physics_types_ddt_fields(horizontal_dimension, set_init_val_ if (set_init_val) then longitude = nan end if + if (allocated(cappav)) then + if (reallocate) then + deallocate(cappav) + else + call endrun(subname//": cappav is already allocated, cannot allocate") + end if + end if + allocate(cappav(horizontal_dimension, vertical_layer_dimension)) + if (set_init_val) then + cappav = rair/cpair + call & + mark_as_initialized('composition_dependent_ratio_of_dry_air_gas_constant_to_specific_heat_at_constant_pressure') + + end if if (set_init_val) then phys_state%ncol = 0 end if diff --git a/test/unit/sample_files/physics_types_ddt_se.meta b/test/unit/sample_files/physics_types_ddt_se.meta index 9ef46b17..01943381 100644 --- a/test/unit/sample_files/physics_types_ddt_se.meta +++ b/test/unit/sample_files/physics_types_ddt_se.meta @@ -29,6 +29,12 @@ type = real | kind = kind_phys dimensions = (horizontal_dimension) protected = True +[ cappav ] + standard_name = composition_dependent_ratio_of_dry_air_gas_constant_to_specific_heat_at_constant_pressure + long_name = Composition-dependent ratio of dry air gas constant to specific heat at constant pressure + units = 1 + type = real | kind = kind_phys + dimensions = (horizontal_dimension, vertical_layer_dimension) [ phys_state ] standard_name = physics_state_due_to_dynamics long_name = Physics state variables updated by dynamical core diff --git a/test/unit/sample_files/reg_good_complete.xml b/test/unit/sample_files/reg_good_complete.xml index b3a80a5d..a18660ba 100644 --- a/test/unit/sample_files/reg_good_complete.xml +++ b/test/unit/sample_files/reg_good_complete.xml @@ -3,6 +3,8 @@ + + Number of horizontal columns @@ -57,6 +59,14 @@ units="K" type="real" phys_timestep_init_zero="true"> stand_var + + Composition-dependent ratio of dry air gas constant to specific heat at constant pressure + horizontal_dimension vertical_layer_dimension + 1 + rair/cpair - rair * 2 + + + Number of horizontal columns @@ -20,6 +22,14 @@ horizontal_dimension lon + + Composition-dependent ratio of dry air gas constant to specific heat at constant pressure + horizontal_dimension vertical_layer_dimension + rair/cpair + horizontal_dimension latitude diff --git a/test/unit/sample_files/reg_good_mf.xml b/test/unit/sample_files/reg_good_mf.xml index 79a28a94..618cb8c2 100644 --- a/test/unit/sample_files/reg_good_mf.xml +++ b/test/unit/sample_files/reg_good_mf.xml @@ -3,6 +3,8 @@ + + Number of horizontal columns @@ -20,6 +22,14 @@ horizontal_dimension lon + + Composition-dependent ratio of dry air gas constant to specific heat at constant pressure + horizontal_dimension vertical_layer_dimension + rair/cpair + horizontal_dimension latitude diff --git a/test/unit/sample_files/write_init_files/phys_vars_init_check_4D.F90 b/test/unit/sample_files/write_init_files/phys_vars_init_check_4D.F90 index a231438e..ee00c231 100644 --- a/test/unit/sample_files/write_init_files/phys_vars_init_check_4D.F90 +++ b/test/unit/sample_files/write_init_files/phys_vars_init_check_4D.F90 @@ -34,6 +34,7 @@ module phys_vars_init_check_4D integer, public, parameter :: READ_FROM_FILE = 3 !Total number of physics-related variables: integer, public, parameter :: phys_var_num = 2 + integer, public, parameter :: phys_const_num = 13 !Max length of physics-related variable standard names: integer, public, parameter :: std_name_len = 25 @@ -46,6 +47,20 @@ module phys_vars_init_check_4D 'potential_temperature ', & 'air_pressure_at_sea_level' /) + character(len=37), public, protected :: phys_const_stdnames(phys_const_num) = (/ & + "ccpp_constituent_array ", & + "ccpp_constituent_array_minimum_values", & + "ccpp_constituent_properties_array ", & + "ccpp_num_advected_constituents ", & + "ccpp_num_constituents ", & + "do_log_output ", & + "log_output_unit ", & + "mpi_communicator ", & + "mpi_rank ", & + "mpi_root ", & + "number_of_mpi_tasks ", & + "suite_name ", & + "suite_part " /) !Array storing all registered IC file input names for each variable: character(len=5), public, protected :: input_var_names(1, phys_var_num) = reshape((/ & 'theta', & @@ -168,15 +183,16 @@ logical function is_initialized(varname) end function is_initialized - logical function is_read_from_file(varname, stdnam_idx_out) + subroutine is_read_from_file(varname, is_read, stdnam_idx_out) - ! This function checks if the variable, , is read from + ! This subroutine checks if the variable, , is read from ! file according to the 'initialized_vars' array. use cam_abortutils, only: endrun ! Dummy arguments character(len=*), intent(in) :: varname ! Variable name being checked + logical, intent(out) :: is_read ! Set to .true. if from file integer, optional, intent(out) :: stdnam_idx_out ! Local variables @@ -185,19 +201,29 @@ logical function is_read_from_file(varname, stdnam_idx_out) logical :: found ! Check that was found character(len=*), parameter :: subname = 'is_read_from_file: ' - is_read_from_file = .false. + is_read = .false. found = .false. ! Return .true. if the variable's status is READ_FROM_FILE: do stdnam_idx = 1, phys_var_num if (trim(phys_var_stdnames(stdnam_idx)) == trim(varname)) then - is_read_from_file = (initialized_vars(stdnam_idx) == READ_FROM_FILE) + is_read = (initialized_vars(stdnam_idx) == READ_FROM_FILE) ! Mark as found: found = .true. exit ! Exit loop once variable has been found and checked end if end do + if (.not. found) then + ! Check to see if this is an internally-protected variable + do stdnam_idx = 1, phys_const_num + if (trim(phys_const_stdnames(stdnam_idx)) == trim(varname)) then + found = .true. + exit ! Exit loop once variable has been found + end if + end do + end if + if (.not. found) then ! This condition is an internal error, it should not happen call endrun(subname//": Variable '"//trim(varname)// & @@ -207,6 +233,6 @@ logical function is_read_from_file(varname, stdnam_idx_out) stdnam_idx_out = stdnam_idx end if - end function is_read_from_file + end subroutine is_read_from_file end module phys_vars_init_check_4D diff --git a/test/unit/sample_files/write_init_files/phys_vars_init_check_bvd.F90 b/test/unit/sample_files/write_init_files/phys_vars_init_check_bvd.F90 index a5a2ae58..bbf7e335 100644 --- a/test/unit/sample_files/write_init_files/phys_vars_init_check_bvd.F90 +++ b/test/unit/sample_files/write_init_files/phys_vars_init_check_bvd.F90 @@ -34,6 +34,7 @@ module phys_vars_init_check_bvd integer, public, parameter :: READ_FROM_FILE = 3 !Total number of physics-related variables: integer, public, parameter :: phys_var_num = 2 + integer, public, parameter :: phys_const_num = 13 !Max length of physics-related variable standard names: integer, public, parameter :: std_name_len = 25 @@ -46,6 +47,20 @@ module phys_vars_init_check_bvd 'potential_temperature ', & 'air_pressure_at_sea_level' /) + character(len=37), public, protected :: phys_const_stdnames(phys_const_num) = (/ & + "ccpp_constituent_array ", & + "ccpp_constituent_array_minimum_values", & + "ccpp_constituent_properties_array ", & + "ccpp_num_advected_constituents ", & + "ccpp_num_constituents ", & + "do_log_output ", & + "log_output_unit ", & + "mpi_communicator ", & + "mpi_rank ", & + "mpi_root ", & + "number_of_mpi_tasks ", & + "suite_name ", & + "suite_part " /) !Array storing all registered IC file input names for each variable: character(len=5), public, protected :: input_var_names(1, phys_var_num) = reshape((/ & 'theta', & @@ -168,15 +183,16 @@ logical function is_initialized(varname) end function is_initialized - logical function is_read_from_file(varname, stdnam_idx_out) + subroutine is_read_from_file(varname, is_read, stdnam_idx_out) - ! This function checks if the variable, , is read from + ! This subroutine checks if the variable, , is read from ! file according to the 'initialized_vars' array. use cam_abortutils, only: endrun ! Dummy arguments character(len=*), intent(in) :: varname ! Variable name being checked + logical, intent(out) :: is_read ! Set to .true. if from file integer, optional, intent(out) :: stdnam_idx_out ! Local variables @@ -185,19 +201,29 @@ logical function is_read_from_file(varname, stdnam_idx_out) logical :: found ! Check that was found character(len=*), parameter :: subname = 'is_read_from_file: ' - is_read_from_file = .false. + is_read = .false. found = .false. ! Return .true. if the variable's status is READ_FROM_FILE: do stdnam_idx = 1, phys_var_num if (trim(phys_var_stdnames(stdnam_idx)) == trim(varname)) then - is_read_from_file = (initialized_vars(stdnam_idx) == READ_FROM_FILE) + is_read = (initialized_vars(stdnam_idx) == READ_FROM_FILE) ! Mark as found: found = .true. exit ! Exit loop once variable has been found and checked end if end do + if (.not. found) then + ! Check to see if this is an internally-protected variable + do stdnam_idx = 1, phys_const_num + if (trim(phys_const_stdnames(stdnam_idx)) == trim(varname)) then + found = .true. + exit ! Exit loop once variable has been found + end if + end do + end if + if (.not. found) then ! This condition is an internal error, it should not happen call endrun(subname//": Variable '"//trim(varname)// & @@ -207,6 +233,6 @@ logical function is_read_from_file(varname, stdnam_idx_out) stdnam_idx_out = stdnam_idx end if - end function is_read_from_file + end subroutine is_read_from_file end module phys_vars_init_check_bvd diff --git a/test/unit/sample_files/write_init_files/phys_vars_init_check_ddt.F90 b/test/unit/sample_files/write_init_files/phys_vars_init_check_ddt.F90 index 852b2ef9..3bb0b8d3 100644 --- a/test/unit/sample_files/write_init_files/phys_vars_init_check_ddt.F90 +++ b/test/unit/sample_files/write_init_files/phys_vars_init_check_ddt.F90 @@ -34,6 +34,7 @@ module phys_vars_init_check_ddt integer, public, parameter :: READ_FROM_FILE = 3 !Total number of physics-related variables: integer, public, parameter :: phys_var_num = 2 + integer, public, parameter :: phys_const_num = 13 !Max length of physics-related variable standard names: integer, public, parameter :: std_name_len = 25 @@ -46,6 +47,20 @@ module phys_vars_init_check_ddt 'potential_temperature ', & 'air_pressure_at_sea_level' /) + character(len=37), public, protected :: phys_const_stdnames(phys_const_num) = (/ & + "ccpp_constituent_array ", & + "ccpp_constituent_array_minimum_values", & + "ccpp_constituent_properties_array ", & + "ccpp_num_advected_constituents ", & + "ccpp_num_constituents ", & + "do_log_output ", & + "log_output_unit ", & + "mpi_communicator ", & + "mpi_rank ", & + "mpi_root ", & + "number_of_mpi_tasks ", & + "suite_name ", & + "suite_part " /) !Array storing all registered IC file input names for each variable: character(len=5), public, protected :: input_var_names(1, phys_var_num) = reshape((/ & 'theta', & @@ -168,15 +183,16 @@ logical function is_initialized(varname) end function is_initialized - logical function is_read_from_file(varname, stdnam_idx_out) + subroutine is_read_from_file(varname, is_read, stdnam_idx_out) - ! This function checks if the variable, , is read from + ! This subroutine checks if the variable, , is read from ! file according to the 'initialized_vars' array. use cam_abortutils, only: endrun ! Dummy arguments character(len=*), intent(in) :: varname ! Variable name being checked + logical, intent(out) :: is_read ! Set to .true. if from file integer, optional, intent(out) :: stdnam_idx_out ! Local variables @@ -185,19 +201,29 @@ logical function is_read_from_file(varname, stdnam_idx_out) logical :: found ! Check that was found character(len=*), parameter :: subname = 'is_read_from_file: ' - is_read_from_file = .false. + is_read = .false. found = .false. ! Return .true. if the variable's status is READ_FROM_FILE: do stdnam_idx = 1, phys_var_num if (trim(phys_var_stdnames(stdnam_idx)) == trim(varname)) then - is_read_from_file = (initialized_vars(stdnam_idx) == READ_FROM_FILE) + is_read = (initialized_vars(stdnam_idx) == READ_FROM_FILE) ! Mark as found: found = .true. exit ! Exit loop once variable has been found and checked end if end do + if (.not. found) then + ! Check to see if this is an internally-protected variable + do stdnam_idx = 1, phys_const_num + if (trim(phys_const_stdnames(stdnam_idx)) == trim(varname)) then + found = .true. + exit ! Exit loop once variable has been found + end if + end do + end if + if (.not. found) then ! This condition is an internal error, it should not happen call endrun(subname//": Variable '"//trim(varname)// & @@ -207,6 +233,6 @@ logical function is_read_from_file(varname, stdnam_idx_out) stdnam_idx_out = stdnam_idx end if - end function is_read_from_file + end subroutine is_read_from_file end module phys_vars_init_check_ddt diff --git a/test/unit/sample_files/write_init_files/phys_vars_init_check_ddt2.F90 b/test/unit/sample_files/write_init_files/phys_vars_init_check_ddt2.F90 index fc183e21..a2a2e536 100644 --- a/test/unit/sample_files/write_init_files/phys_vars_init_check_ddt2.F90 +++ b/test/unit/sample_files/write_init_files/phys_vars_init_check_ddt2.F90 @@ -34,6 +34,7 @@ module phys_vars_init_check_ddt2 integer, public, parameter :: READ_FROM_FILE = 3 !Total number of physics-related variables: integer, public, parameter :: phys_var_num = 2 + integer, public, parameter :: phys_const_num = 13 !Max length of physics-related variable standard names: integer, public, parameter :: std_name_len = 25 @@ -46,6 +47,20 @@ module phys_vars_init_check_ddt2 'potential_temperature ', & 'air_pressure_at_sea_level' /) + character(len=37), public, protected :: phys_const_stdnames(phys_const_num) = (/ & + "ccpp_constituent_array ", & + "ccpp_constituent_array_minimum_values", & + "ccpp_constituent_properties_array ", & + "ccpp_num_advected_constituents ", & + "ccpp_num_constituents ", & + "do_log_output ", & + "log_output_unit ", & + "mpi_communicator ", & + "mpi_rank ", & + "mpi_root ", & + "number_of_mpi_tasks ", & + "suite_name ", & + "suite_part " /) !Array storing all registered IC file input names for each variable: character(len=5), public, protected :: input_var_names(1, phys_var_num) = reshape((/ & 'theta', & @@ -168,15 +183,16 @@ logical function is_initialized(varname) end function is_initialized - logical function is_read_from_file(varname, stdnam_idx_out) + subroutine is_read_from_file(varname, is_read, stdnam_idx_out) - ! This function checks if the variable, , is read from + ! This subroutine checks if the variable, , is read from ! file according to the 'initialized_vars' array. use cam_abortutils, only: endrun ! Dummy arguments character(len=*), intent(in) :: varname ! Variable name being checked + logical, intent(out) :: is_read ! Set to .true. if from file integer, optional, intent(out) :: stdnam_idx_out ! Local variables @@ -185,19 +201,29 @@ logical function is_read_from_file(varname, stdnam_idx_out) logical :: found ! Check that was found character(len=*), parameter :: subname = 'is_read_from_file: ' - is_read_from_file = .false. + is_read = .false. found = .false. ! Return .true. if the variable's status is READ_FROM_FILE: do stdnam_idx = 1, phys_var_num if (trim(phys_var_stdnames(stdnam_idx)) == trim(varname)) then - is_read_from_file = (initialized_vars(stdnam_idx) == READ_FROM_FILE) + is_read = (initialized_vars(stdnam_idx) == READ_FROM_FILE) ! Mark as found: found = .true. exit ! Exit loop once variable has been found and checked end if end do + if (.not. found) then + ! Check to see if this is an internally-protected variable + do stdnam_idx = 1, phys_const_num + if (trim(phys_const_stdnames(stdnam_idx)) == trim(varname)) then + found = .true. + exit ! Exit loop once variable has been found + end if + end do + end if + if (.not. found) then ! This condition is an internal error, it should not happen call endrun(subname//": Variable '"//trim(varname)// & @@ -207,6 +233,6 @@ logical function is_read_from_file(varname, stdnam_idx_out) stdnam_idx_out = stdnam_idx end if - end function is_read_from_file + end subroutine is_read_from_file end module phys_vars_init_check_ddt2 diff --git a/test/unit/sample_files/write_init_files/phys_vars_init_check_ddt_array.F90 b/test/unit/sample_files/write_init_files/phys_vars_init_check_ddt_array.F90 index 3bb989b7..40e0755e 100644 --- a/test/unit/sample_files/write_init_files/phys_vars_init_check_ddt_array.F90 +++ b/test/unit/sample_files/write_init_files/phys_vars_init_check_ddt_array.F90 @@ -34,6 +34,7 @@ module phys_vars_init_check_ddt_array integer, public, parameter :: READ_FROM_FILE = 3 !Total number of physics-related variables: integer, public, parameter :: phys_var_num = 2 + integer, public, parameter :: phys_const_num = 13 !Max length of physics-related variable standard names: integer, public, parameter :: std_name_len = 25 @@ -46,6 +47,20 @@ module phys_vars_init_check_ddt_array 'potential_temperature ', & 'air_pressure_at_sea_level' /) + character(len=37), public, protected :: phys_const_stdnames(phys_const_num) = (/ & + "ccpp_constituent_array ", & + "ccpp_constituent_array_minimum_values", & + "ccpp_constituent_properties_array ", & + "ccpp_num_advected_constituents ", & + "ccpp_num_constituents ", & + "do_log_output ", & + "log_output_unit ", & + "mpi_communicator ", & + "mpi_rank ", & + "mpi_root ", & + "number_of_mpi_tasks ", & + "suite_name ", & + "suite_part " /) !Array storing all registered IC file input names for each variable: character(len=39), public, protected :: input_var_names(1, phys_var_num) = reshape((/ & 'T(:, :, index_of_potential_temperature)', & @@ -168,15 +183,16 @@ logical function is_initialized(varname) end function is_initialized - logical function is_read_from_file(varname, stdnam_idx_out) + subroutine is_read_from_file(varname, is_read, stdnam_idx_out) - ! This function checks if the variable, , is read from + ! This subroutine checks if the variable, , is read from ! file according to the 'initialized_vars' array. use cam_abortutils, only: endrun ! Dummy arguments character(len=*), intent(in) :: varname ! Variable name being checked + logical, intent(out) :: is_read ! Set to .true. if from file integer, optional, intent(out) :: stdnam_idx_out ! Local variables @@ -185,19 +201,29 @@ logical function is_read_from_file(varname, stdnam_idx_out) logical :: found ! Check that was found character(len=*), parameter :: subname = 'is_read_from_file: ' - is_read_from_file = .false. + is_read = .false. found = .false. ! Return .true. if the variable's status is READ_FROM_FILE: do stdnam_idx = 1, phys_var_num if (trim(phys_var_stdnames(stdnam_idx)) == trim(varname)) then - is_read_from_file = (initialized_vars(stdnam_idx) == READ_FROM_FILE) + is_read = (initialized_vars(stdnam_idx) == READ_FROM_FILE) ! Mark as found: found = .true. exit ! Exit loop once variable has been found and checked end if end do + if (.not. found) then + ! Check to see if this is an internally-protected variable + do stdnam_idx = 1, phys_const_num + if (trim(phys_const_stdnames(stdnam_idx)) == trim(varname)) then + found = .true. + exit ! Exit loop once variable has been found + end if + end do + end if + if (.not. found) then ! This condition is an internal error, it should not happen call endrun(subname//": Variable '"//trim(varname)// & @@ -207,6 +233,6 @@ logical function is_read_from_file(varname, stdnam_idx_out) stdnam_idx_out = stdnam_idx end if - end function is_read_from_file + end subroutine is_read_from_file end module phys_vars_init_check_ddt_array diff --git a/test/unit/sample_files/write_init_files/phys_vars_init_check_host_var.F90 b/test/unit/sample_files/write_init_files/phys_vars_init_check_host_var.F90 index 5060bf36..3261a537 100644 --- a/test/unit/sample_files/write_init_files/phys_vars_init_check_host_var.F90 +++ b/test/unit/sample_files/write_init_files/phys_vars_init_check_host_var.F90 @@ -34,6 +34,7 @@ module phys_vars_init_check_host_var integer, public, parameter :: READ_FROM_FILE = 3 !Total number of physics-related variables: integer, public, parameter :: phys_var_num = 1 + integer, public, parameter :: phys_const_num = 13 !Max length of physics-related variable standard names: integer, public, parameter :: std_name_len = 25 @@ -45,6 +46,20 @@ module phys_vars_init_check_host_var character(len=25), public, protected :: phys_var_stdnames(phys_var_num) = (/ & 'air_pressure_at_sea_level' /) + character(len=37), public, protected :: phys_const_stdnames(phys_const_num) = (/ & + "ccpp_constituent_array ", & + "ccpp_constituent_array_minimum_values", & + "ccpp_constituent_properties_array ", & + "ccpp_num_advected_constituents ", & + "ccpp_num_constituents ", & + "do_log_output ", & + "log_output_unit ", & + "mpi_communicator ", & + "mpi_rank ", & + "mpi_root ", & + "number_of_mpi_tasks ", & + "suite_name ", & + "suite_part " /) !Array storing all registered IC file input names for each variable: character(len=3), public, protected :: input_var_names(1, phys_var_num) = reshape((/ & 'slp' /), (/1, phys_var_num/)) @@ -164,15 +179,16 @@ logical function is_initialized(varname) end function is_initialized - logical function is_read_from_file(varname, stdnam_idx_out) + subroutine is_read_from_file(varname, is_read, stdnam_idx_out) - ! This function checks if the variable, , is read from + ! This subroutine checks if the variable, , is read from ! file according to the 'initialized_vars' array. use cam_abortutils, only: endrun ! Dummy arguments character(len=*), intent(in) :: varname ! Variable name being checked + logical, intent(out) :: is_read ! Set to .true. if from file integer, optional, intent(out) :: stdnam_idx_out ! Local variables @@ -181,19 +197,29 @@ logical function is_read_from_file(varname, stdnam_idx_out) logical :: found ! Check that was found character(len=*), parameter :: subname = 'is_read_from_file: ' - is_read_from_file = .false. + is_read = .false. found = .false. ! Return .true. if the variable's status is READ_FROM_FILE: do stdnam_idx = 1, phys_var_num if (trim(phys_var_stdnames(stdnam_idx)) == trim(varname)) then - is_read_from_file = (initialized_vars(stdnam_idx) == READ_FROM_FILE) + is_read = (initialized_vars(stdnam_idx) == READ_FROM_FILE) ! Mark as found: found = .true. exit ! Exit loop once variable has been found and checked end if end do + if (.not. found) then + ! Check to see if this is an internally-protected variable + do stdnam_idx = 1, phys_const_num + if (trim(phys_const_stdnames(stdnam_idx)) == trim(varname)) then + found = .true. + exit ! Exit loop once variable has been found + end if + end do + end if + if (.not. found) then ! This condition is an internal error, it should not happen call endrun(subname//": Variable '"//trim(varname)// & @@ -203,6 +229,6 @@ logical function is_read_from_file(varname, stdnam_idx_out) stdnam_idx_out = stdnam_idx end if - end function is_read_from_file + end subroutine is_read_from_file end module phys_vars_init_check_host_var diff --git a/test/unit/sample_files/write_init_files/phys_vars_init_check_mf.F90 b/test/unit/sample_files/write_init_files/phys_vars_init_check_mf.F90 index 529147c3..a6cdac6d 100644 --- a/test/unit/sample_files/write_init_files/phys_vars_init_check_mf.F90 +++ b/test/unit/sample_files/write_init_files/phys_vars_init_check_mf.F90 @@ -34,6 +34,7 @@ module phys_vars_init_check_mf integer, public, parameter :: READ_FROM_FILE = 3 !Total number of physics-related variables: integer, public, parameter :: phys_var_num = 2 + integer, public, parameter :: phys_const_num = 13 !Max length of physics-related variable standard names: integer, public, parameter :: std_name_len = 25 @@ -46,6 +47,20 @@ module phys_vars_init_check_mf 'potential_temperature ', & 'air_pressure_at_sea_level' /) + character(len=37), public, protected :: phys_const_stdnames(phys_const_num) = (/ & + "ccpp_constituent_array ", & + "ccpp_constituent_array_minimum_values", & + "ccpp_constituent_properties_array ", & + "ccpp_num_advected_constituents ", & + "ccpp_num_constituents ", & + "do_log_output ", & + "log_output_unit ", & + "mpi_communicator ", & + "mpi_rank ", & + "mpi_root ", & + "number_of_mpi_tasks ", & + "suite_name ", & + "suite_part " /) !Array storing all registered IC file input names for each variable: character(len=5), public, protected :: input_var_names(1, phys_var_num) = reshape((/ & 'theta', & @@ -168,15 +183,16 @@ logical function is_initialized(varname) end function is_initialized - logical function is_read_from_file(varname, stdnam_idx_out) + subroutine is_read_from_file(varname, is_read, stdnam_idx_out) - ! This function checks if the variable, , is read from + ! This subroutine checks if the variable, , is read from ! file according to the 'initialized_vars' array. use cam_abortutils, only: endrun ! Dummy arguments character(len=*), intent(in) :: varname ! Variable name being checked + logical, intent(out) :: is_read ! Set to .true. if from file integer, optional, intent(out) :: stdnam_idx_out ! Local variables @@ -185,19 +201,29 @@ logical function is_read_from_file(varname, stdnam_idx_out) logical :: found ! Check that was found character(len=*), parameter :: subname = 'is_read_from_file: ' - is_read_from_file = .false. + is_read = .false. found = .false. ! Return .true. if the variable's status is READ_FROM_FILE: do stdnam_idx = 1, phys_var_num if (trim(phys_var_stdnames(stdnam_idx)) == trim(varname)) then - is_read_from_file = (initialized_vars(stdnam_idx) == READ_FROM_FILE) + is_read = (initialized_vars(stdnam_idx) == READ_FROM_FILE) ! Mark as found: found = .true. exit ! Exit loop once variable has been found and checked end if end do + if (.not. found) then + ! Check to see if this is an internally-protected variable + do stdnam_idx = 1, phys_const_num + if (trim(phys_const_stdnames(stdnam_idx)) == trim(varname)) then + found = .true. + exit ! Exit loop once variable has been found + end if + end do + end if + if (.not. found) then ! This condition is an internal error, it should not happen call endrun(subname//": Variable '"//trim(varname)// & @@ -207,6 +233,6 @@ logical function is_read_from_file(varname, stdnam_idx_out) stdnam_idx_out = stdnam_idx end if - end function is_read_from_file + end subroutine is_read_from_file end module phys_vars_init_check_mf diff --git a/test/unit/sample_files/write_init_files/phys_vars_init_check_no_horiz.F90 b/test/unit/sample_files/write_init_files/phys_vars_init_check_no_horiz.F90 index 3adb9c88..9d26ec3e 100644 --- a/test/unit/sample_files/write_init_files/phys_vars_init_check_no_horiz.F90 +++ b/test/unit/sample_files/write_init_files/phys_vars_init_check_no_horiz.F90 @@ -34,6 +34,7 @@ module phys_vars_init_check_no_horiz integer, public, parameter :: READ_FROM_FILE = 3 !Total number of physics-related variables: integer, public, parameter :: phys_var_num = 2 + integer, public, parameter :: phys_const_num = 13 !Max length of physics-related variable standard names: integer, public, parameter :: std_name_len = 25 @@ -46,6 +47,20 @@ module phys_vars_init_check_no_horiz 'potential_temperature ', & 'air_pressure_at_sea_level' /) + character(len=37), public, protected :: phys_const_stdnames(phys_const_num) = (/ & + "ccpp_constituent_array ", & + "ccpp_constituent_array_minimum_values", & + "ccpp_constituent_properties_array ", & + "ccpp_num_advected_constituents ", & + "ccpp_num_constituents ", & + "do_log_output ", & + "log_output_unit ", & + "mpi_communicator ", & + "mpi_rank ", & + "mpi_root ", & + "number_of_mpi_tasks ", & + "suite_name ", & + "suite_part " /) !Array storing all registered IC file input names for each variable: character(len=5), public, protected :: input_var_names(1, phys_var_num) = reshape((/ & 'theta', & @@ -168,15 +183,16 @@ logical function is_initialized(varname) end function is_initialized - logical function is_read_from_file(varname, stdnam_idx_out) + subroutine is_read_from_file(varname, is_read, stdnam_idx_out) - ! This function checks if the variable, , is read from + ! This subroutine checks if the variable, , is read from ! file according to the 'initialized_vars' array. use cam_abortutils, only: endrun ! Dummy arguments character(len=*), intent(in) :: varname ! Variable name being checked + logical, intent(out) :: is_read ! Set to .true. if from file integer, optional, intent(out) :: stdnam_idx_out ! Local variables @@ -185,19 +201,29 @@ logical function is_read_from_file(varname, stdnam_idx_out) logical :: found ! Check that was found character(len=*), parameter :: subname = 'is_read_from_file: ' - is_read_from_file = .false. + is_read = .false. found = .false. ! Return .true. if the variable's status is READ_FROM_FILE: do stdnam_idx = 1, phys_var_num if (trim(phys_var_stdnames(stdnam_idx)) == trim(varname)) then - is_read_from_file = (initialized_vars(stdnam_idx) == READ_FROM_FILE) + is_read = (initialized_vars(stdnam_idx) == READ_FROM_FILE) ! Mark as found: found = .true. exit ! Exit loop once variable has been found and checked end if end do + if (.not. found) then + ! Check to see if this is an internally-protected variable + do stdnam_idx = 1, phys_const_num + if (trim(phys_const_stdnames(stdnam_idx)) == trim(varname)) then + found = .true. + exit ! Exit loop once variable has been found + end if + end do + end if + if (.not. found) then ! This condition is an internal error, it should not happen call endrun(subname//": Variable '"//trim(varname)// & @@ -207,6 +233,6 @@ logical function is_read_from_file(varname, stdnam_idx_out) stdnam_idx_out = stdnam_idx end if - end function is_read_from_file + end subroutine is_read_from_file end module phys_vars_init_check_no_horiz diff --git a/test/unit/sample_files/write_init_files/phys_vars_init_check_noreq.F90 b/test/unit/sample_files/write_init_files/phys_vars_init_check_noreq.F90 index 237bfabc..aaa174cd 100644 --- a/test/unit/sample_files/write_init_files/phys_vars_init_check_noreq.F90 +++ b/test/unit/sample_files/write_init_files/phys_vars_init_check_noreq.F90 @@ -34,6 +34,7 @@ module phys_vars_init_check_noreq integer, public, parameter :: READ_FROM_FILE = 3 !Total number of physics-related variables: integer, public, parameter :: phys_var_num = 0 + integer, public, parameter :: phys_const_num = 13 !Max length of physics-related variable standard names: integer, public, parameter :: std_name_len = 0 @@ -44,6 +45,20 @@ module phys_vars_init_check_noreq ! Physics-related input variable standard names: character(len=0), public, protected :: phys_var_stdnames(phys_var_num) + character(len=37), public, protected :: phys_const_stdnames(phys_const_num) = (/ & + "ccpp_constituent_array ", & + "ccpp_constituent_array_minimum_values", & + "ccpp_constituent_properties_array ", & + "ccpp_num_advected_constituents ", & + "ccpp_num_constituents ", & + "do_log_output ", & + "log_output_unit ", & + "mpi_communicator ", & + "mpi_rank ", & + "mpi_root ", & + "number_of_mpi_tasks ", & + "suite_name ", & + "suite_part " /) !Array storing all registered IC file input names for each variable: character(len=0), public, protected :: input_var_names(0, phys_var_num) @@ -160,15 +175,16 @@ logical function is_initialized(varname) end function is_initialized - logical function is_read_from_file(varname, stdnam_idx_out) + subroutine is_read_from_file(varname, is_read, stdnam_idx_out) - ! This function checks if the variable, , is read from + ! This subroutine checks if the variable, , is read from ! file according to the 'initialized_vars' array. use cam_abortutils, only: endrun ! Dummy arguments character(len=*), intent(in) :: varname ! Variable name being checked + logical, intent(out) :: is_read ! Set to .true. if from file integer, optional, intent(out) :: stdnam_idx_out ! Local variables @@ -177,19 +193,29 @@ logical function is_read_from_file(varname, stdnam_idx_out) logical :: found ! Check that was found character(len=*), parameter :: subname = 'is_read_from_file: ' - is_read_from_file = .false. + is_read = .false. found = .false. ! Return .true. if the variable's status is READ_FROM_FILE: do stdnam_idx = 1, phys_var_num if (trim(phys_var_stdnames(stdnam_idx)) == trim(varname)) then - is_read_from_file = (initialized_vars(stdnam_idx) == READ_FROM_FILE) + is_read = (initialized_vars(stdnam_idx) == READ_FROM_FILE) ! Mark as found: found = .true. exit ! Exit loop once variable has been found and checked end if end do + if (.not. found) then + ! Check to see if this is an internally-protected variable + do stdnam_idx = 1, phys_const_num + if (trim(phys_const_stdnames(stdnam_idx)) == trim(varname)) then + found = .true. + exit ! Exit loop once variable has been found + end if + end do + end if + if (.not. found) then ! This condition is an internal error, it should not happen call endrun(subname//": Variable '"//trim(varname)// & @@ -199,6 +225,6 @@ logical function is_read_from_file(varname, stdnam_idx_out) stdnam_idx_out = stdnam_idx end if - end function is_read_from_file + end subroutine is_read_from_file end module phys_vars_init_check_noreq diff --git a/test/unit/sample_files/write_init_files/phys_vars_init_check_param.F90 b/test/unit/sample_files/write_init_files/phys_vars_init_check_param.F90 index 3d06812e..e29234d0 100644 --- a/test/unit/sample_files/write_init_files/phys_vars_init_check_param.F90 +++ b/test/unit/sample_files/write_init_files/phys_vars_init_check_param.F90 @@ -34,6 +34,7 @@ module phys_vars_init_check_param integer, public, parameter :: READ_FROM_FILE = 3 !Total number of physics-related variables: integer, public, parameter :: phys_var_num = 3 + integer, public, parameter :: phys_const_num = 13 !Max length of physics-related variable standard names: integer, public, parameter :: std_name_len = 26 @@ -47,6 +48,20 @@ module phys_vars_init_check_param 'air_pressure_at_sea_level ', & 'gravitational_acceleration' /) + character(len=37), public, protected :: phys_const_stdnames(phys_const_num) = (/ & + "ccpp_constituent_array ", & + "ccpp_constituent_array_minimum_values", & + "ccpp_constituent_properties_array ", & + "ccpp_num_advected_constituents ", & + "ccpp_num_constituents ", & + "do_log_output ", & + "log_output_unit ", & + "mpi_communicator ", & + "mpi_rank ", & + "mpi_root ", & + "number_of_mpi_tasks ", & + "suite_name ", & + "suite_part " /) !Array storing all registered IC file input names for each variable: character(len=5), public, protected :: input_var_names(1, phys_var_num) = reshape((/ & 'theta', & @@ -172,15 +187,16 @@ logical function is_initialized(varname) end function is_initialized - logical function is_read_from_file(varname, stdnam_idx_out) + subroutine is_read_from_file(varname, is_read, stdnam_idx_out) - ! This function checks if the variable, , is read from + ! This subroutine checks if the variable, , is read from ! file according to the 'initialized_vars' array. use cam_abortutils, only: endrun ! Dummy arguments character(len=*), intent(in) :: varname ! Variable name being checked + logical, intent(out) :: is_read ! Set to .true. if from file integer, optional, intent(out) :: stdnam_idx_out ! Local variables @@ -189,19 +205,29 @@ logical function is_read_from_file(varname, stdnam_idx_out) logical :: found ! Check that was found character(len=*), parameter :: subname = 'is_read_from_file: ' - is_read_from_file = .false. + is_read = .false. found = .false. ! Return .true. if the variable's status is READ_FROM_FILE: do stdnam_idx = 1, phys_var_num if (trim(phys_var_stdnames(stdnam_idx)) == trim(varname)) then - is_read_from_file = (initialized_vars(stdnam_idx) == READ_FROM_FILE) + is_read = (initialized_vars(stdnam_idx) == READ_FROM_FILE) ! Mark as found: found = .true. exit ! Exit loop once variable has been found and checked end if end do + if (.not. found) then + ! Check to see if this is an internally-protected variable + do stdnam_idx = 1, phys_const_num + if (trim(phys_const_stdnames(stdnam_idx)) == trim(varname)) then + found = .true. + exit ! Exit loop once variable has been found + end if + end do + end if + if (.not. found) then ! This condition is an internal error, it should not happen call endrun(subname//": Variable '"//trim(varname)// & @@ -211,6 +237,6 @@ logical function is_read_from_file(varname, stdnam_idx_out) stdnam_idx_out = stdnam_idx end if - end function is_read_from_file + end subroutine is_read_from_file end module phys_vars_init_check_param diff --git a/test/unit/sample_files/write_init_files/phys_vars_init_check_protect.F90 b/test/unit/sample_files/write_init_files/phys_vars_init_check_protect.F90 index 704bce08..4154538b 100644 --- a/test/unit/sample_files/write_init_files/phys_vars_init_check_protect.F90 +++ b/test/unit/sample_files/write_init_files/phys_vars_init_check_protect.F90 @@ -34,6 +34,7 @@ module phys_vars_init_check_protect integer, public, parameter :: READ_FROM_FILE = 3 !Total number of physics-related variables: integer, public, parameter :: phys_var_num = 2 + integer, public, parameter :: phys_const_num = 13 !Max length of physics-related variable standard names: integer, public, parameter :: std_name_len = 25 @@ -46,6 +47,20 @@ module phys_vars_init_check_protect 'potential_temperature ', & 'air_pressure_at_sea_level' /) + character(len=37), public, protected :: phys_const_stdnames(phys_const_num) = (/ & + "ccpp_constituent_array ", & + "ccpp_constituent_array_minimum_values", & + "ccpp_constituent_properties_array ", & + "ccpp_num_advected_constituents ", & + "ccpp_num_constituents ", & + "do_log_output ", & + "log_output_unit ", & + "mpi_communicator ", & + "mpi_rank ", & + "mpi_root ", & + "number_of_mpi_tasks ", & + "suite_name ", & + "suite_part " /) !Array storing all registered IC file input names for each variable: character(len=5), public, protected :: input_var_names(1, phys_var_num) = reshape((/ & 'theta', & @@ -168,15 +183,16 @@ logical function is_initialized(varname) end function is_initialized - logical function is_read_from_file(varname, stdnam_idx_out) + subroutine is_read_from_file(varname, is_read, stdnam_idx_out) - ! This function checks if the variable, , is read from + ! This subroutine checks if the variable, , is read from ! file according to the 'initialized_vars' array. use cam_abortutils, only: endrun ! Dummy arguments character(len=*), intent(in) :: varname ! Variable name being checked + logical, intent(out) :: is_read ! Set to .true. if from file integer, optional, intent(out) :: stdnam_idx_out ! Local variables @@ -185,19 +201,29 @@ logical function is_read_from_file(varname, stdnam_idx_out) logical :: found ! Check that was found character(len=*), parameter :: subname = 'is_read_from_file: ' - is_read_from_file = .false. + is_read = .false. found = .false. ! Return .true. if the variable's status is READ_FROM_FILE: do stdnam_idx = 1, phys_var_num if (trim(phys_var_stdnames(stdnam_idx)) == trim(varname)) then - is_read_from_file = (initialized_vars(stdnam_idx) == READ_FROM_FILE) + is_read = (initialized_vars(stdnam_idx) == READ_FROM_FILE) ! Mark as found: found = .true. exit ! Exit loop once variable has been found and checked end if end do + if (.not. found) then + ! Check to see if this is an internally-protected variable + do stdnam_idx = 1, phys_const_num + if (trim(phys_const_stdnames(stdnam_idx)) == trim(varname)) then + found = .true. + exit ! Exit loop once variable has been found + end if + end do + end if + if (.not. found) then ! This condition is an internal error, it should not happen call endrun(subname//": Variable '"//trim(varname)// & @@ -207,6 +233,6 @@ logical function is_read_from_file(varname, stdnam_idx_out) stdnam_idx_out = stdnam_idx end if - end function is_read_from_file + end subroutine is_read_from_file end module phys_vars_init_check_protect diff --git a/test/unit/sample_files/write_init_files/phys_vars_init_check_scalar.F90 b/test/unit/sample_files/write_init_files/phys_vars_init_check_scalar.F90 index 45143048..78252797 100644 --- a/test/unit/sample_files/write_init_files/phys_vars_init_check_scalar.F90 +++ b/test/unit/sample_files/write_init_files/phys_vars_init_check_scalar.F90 @@ -34,6 +34,7 @@ module phys_vars_init_check_scalar integer, public, parameter :: READ_FROM_FILE = 3 !Total number of physics-related variables: integer, public, parameter :: phys_var_num = 2 + integer, public, parameter :: phys_const_num = 13 !Max length of physics-related variable standard names: integer, public, parameter :: std_name_len = 25 @@ -46,6 +47,20 @@ module phys_vars_init_check_scalar 'potential_temperature ', & 'air_pressure_at_sea_level' /) + character(len=37), public, protected :: phys_const_stdnames(phys_const_num) = (/ & + "ccpp_constituent_array ", & + "ccpp_constituent_array_minimum_values", & + "ccpp_constituent_properties_array ", & + "ccpp_num_advected_constituents ", & + "ccpp_num_constituents ", & + "do_log_output ", & + "log_output_unit ", & + "mpi_communicator ", & + "mpi_rank ", & + "mpi_root ", & + "number_of_mpi_tasks ", & + "suite_name ", & + "suite_part " /) !Array storing all registered IC file input names for each variable: character(len=5), public, protected :: input_var_names(1, phys_var_num) = reshape((/ & 'theta', & @@ -168,15 +183,16 @@ logical function is_initialized(varname) end function is_initialized - logical function is_read_from_file(varname, stdnam_idx_out) + subroutine is_read_from_file(varname, is_read, stdnam_idx_out) - ! This function checks if the variable, , is read from + ! This subroutine checks if the variable, , is read from ! file according to the 'initialized_vars' array. use cam_abortutils, only: endrun ! Dummy arguments character(len=*), intent(in) :: varname ! Variable name being checked + logical, intent(out) :: is_read ! Set to .true. if from file integer, optional, intent(out) :: stdnam_idx_out ! Local variables @@ -185,19 +201,29 @@ logical function is_read_from_file(varname, stdnam_idx_out) logical :: found ! Check that was found character(len=*), parameter :: subname = 'is_read_from_file: ' - is_read_from_file = .false. + is_read = .false. found = .false. ! Return .true. if the variable's status is READ_FROM_FILE: do stdnam_idx = 1, phys_var_num if (trim(phys_var_stdnames(stdnam_idx)) == trim(varname)) then - is_read_from_file = (initialized_vars(stdnam_idx) == READ_FROM_FILE) + is_read = (initialized_vars(stdnam_idx) == READ_FROM_FILE) ! Mark as found: found = .true. exit ! Exit loop once variable has been found and checked end if end do + if (.not. found) then + ! Check to see if this is an internally-protected variable + do stdnam_idx = 1, phys_const_num + if (trim(phys_const_stdnames(stdnam_idx)) == trim(varname)) then + found = .true. + exit ! Exit loop once variable has been found + end if + end do + end if + if (.not. found) then ! This condition is an internal error, it should not happen call endrun(subname//": Variable '"//trim(varname)// & @@ -207,6 +233,6 @@ logical function is_read_from_file(varname, stdnam_idx_out) stdnam_idx_out = stdnam_idx end if - end function is_read_from_file + end subroutine is_read_from_file end module phys_vars_init_check_scalar diff --git a/test/unit/sample_files/write_init_files/phys_vars_init_check_simple.F90 b/test/unit/sample_files/write_init_files/phys_vars_init_check_simple.F90 index b330c2c9..087d9cb7 100644 --- a/test/unit/sample_files/write_init_files/phys_vars_init_check_simple.F90 +++ b/test/unit/sample_files/write_init_files/phys_vars_init_check_simple.F90 @@ -34,6 +34,7 @@ module phys_vars_init_check_simple integer, public, parameter :: READ_FROM_FILE = 3 !Total number of physics-related variables: integer, public, parameter :: phys_var_num = 2 + integer, public, parameter :: phys_const_num = 13 !Max length of physics-related variable standard names: integer, public, parameter :: std_name_len = 25 @@ -46,6 +47,20 @@ module phys_vars_init_check_simple 'potential_temperature ', & 'air_pressure_at_sea_level' /) + character(len=37), public, protected :: phys_const_stdnames(phys_const_num) = (/ & + "ccpp_constituent_array ", & + "ccpp_constituent_array_minimum_values", & + "ccpp_constituent_properties_array ", & + "ccpp_num_advected_constituents ", & + "ccpp_num_constituents ", & + "do_log_output ", & + "log_output_unit ", & + "mpi_communicator ", & + "mpi_rank ", & + "mpi_root ", & + "number_of_mpi_tasks ", & + "suite_name ", & + "suite_part " /) !Array storing all registered IC file input names for each variable: character(len=5), public, protected :: input_var_names(1, phys_var_num) = reshape((/ & 'theta', & @@ -168,15 +183,16 @@ logical function is_initialized(varname) end function is_initialized - logical function is_read_from_file(varname, stdnam_idx_out) + subroutine is_read_from_file(varname, is_read, stdnam_idx_out) - ! This function checks if the variable, , is read from + ! This subroutine checks if the variable, , is read from ! file according to the 'initialized_vars' array. use cam_abortutils, only: endrun ! Dummy arguments character(len=*), intent(in) :: varname ! Variable name being checked + logical, intent(out) :: is_read ! Set to .true. if from file integer, optional, intent(out) :: stdnam_idx_out ! Local variables @@ -185,19 +201,29 @@ logical function is_read_from_file(varname, stdnam_idx_out) logical :: found ! Check that was found character(len=*), parameter :: subname = 'is_read_from_file: ' - is_read_from_file = .false. + is_read = .false. found = .false. ! Return .true. if the variable's status is READ_FROM_FILE: do stdnam_idx = 1, phys_var_num if (trim(phys_var_stdnames(stdnam_idx)) == trim(varname)) then - is_read_from_file = (initialized_vars(stdnam_idx) == READ_FROM_FILE) + is_read = (initialized_vars(stdnam_idx) == READ_FROM_FILE) ! Mark as found: found = .true. exit ! Exit loop once variable has been found and checked end if end do + if (.not. found) then + ! Check to see if this is an internally-protected variable + do stdnam_idx = 1, phys_const_num + if (trim(phys_const_stdnames(stdnam_idx)) == trim(varname)) then + found = .true. + exit ! Exit loop once variable has been found + end if + end do + end if + if (.not. found) then ! This condition is an internal error, it should not happen call endrun(subname//": Variable '"//trim(varname)// & @@ -207,6 +233,6 @@ logical function is_read_from_file(varname, stdnam_idx_out) stdnam_idx_out = stdnam_idx end if - end function is_read_from_file + end subroutine is_read_from_file end module phys_vars_init_check_simple diff --git a/test/unit/sample_files/write_init_files/physics_inputs_4D.F90 b/test/unit/sample_files/write_init_files/physics_inputs_4D.F90 index 44843583..9f658864 100644 --- a/test/unit/sample_files/write_init_files/physics_inputs_4D.F90 +++ b/test/unit/sample_files/write_init_files/physics_inputs_4D.F90 @@ -33,8 +33,9 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia use cam_abortutils, only: endrun use shr_kind_mod, only: SHR_KIND_CS, SHR_KIND_CL, SHR_KIND_CX use physics_data, only: read_field, find_input_name_idx, no_exist_idx - use physics_data, only: init_mark_idx, prot_no_init_idx - use cam_ccpp_cap, only: ccpp_physics_suite_variables + use physics_data, only: init_mark_idx, prot_no_init_idx, const_idx + use cam_ccpp_cap, only: ccpp_physics_suite_variables, cam_constituents_array + use ccpp_kinds, only: kind_phys use phys_vars_init_check_4D, only: phys_var_stdnames, input_var_names, std_name_len use physics_types_4D, only: slp, theta @@ -53,14 +54,16 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia character(len=SHR_KIND_CL) :: missing_required_vars character(len=SHR_KIND_CL) :: protected_non_init_vars - character(len=SHR_KIND_CX) :: errmsg !CCPP framework error message - integer :: errflg !CCPP framework error flag - integer :: name_idx !Input variable array index - integer :: req_idx !Required variable array index - integer :: suite_idx !Suite array index - character(len=2) :: sep = '' !String separator used to print error messages - character(len=2) :: sep2 = '' !String separator used to print error messages - character(len=2) :: sep3 = '' !String separator used to print error messages + character(len=SHR_KIND_CX) :: errmsg !CCPP framework error message + integer :: errflg !CCPP framework error flag + integer :: name_idx !Input variable array index + integer :: constituent_idx !Constituent table index + integer :: req_idx !Required variable array index + integer :: suite_idx !Suite array index + character(len=2) :: sep !String separator used to print err messages + character(len=2) :: sep2 !String separator used to print err messages + character(len=2) :: sep3 !String separator used to print err messages + real(kind=kind_phys), pointer :: field_data_ptr(:,:,:) ! Logical to default optional argument to False: logical :: use_init_variables @@ -68,6 +71,9 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia ! Initalize missing and non-initialized variables strings: missing_required_vars = ' ' protected_non_init_vars = ' ' + sep = '' + sep2 = '' + sep3 = '' ! Initialize use_init_variables based on whether it was input to function: if (present(read_initialized_variables)) then @@ -88,7 +94,8 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia do req_idx = 1, size(ccpp_required_data, 1) ! Find IC file input name array index for required variable: - name_idx = find_input_name_idx(ccpp_required_data(req_idx), use_init_variables) + name_idx = find_input_name_idx(ccpp_required_data(req_idx), use_init_variables, & + constituent_idx) ! Check for special index values: select case (name_idx) @@ -118,6 +125,15 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia ! Update character separator to now include comma: sep2 = ', ' + case (const_idx) + + ! If an index was found in the constituent hash table, then read in the data + ! to that index of the constituent array + + field_data_ptr => cam_constituents_array() + call read_field(file, ccpp_required_data(req_idx), & + [ccpp_required_data(req_idx)], 'lev', timestep, & + field_data_ptr(:,:,constituent_idx), mark_as_read=.false.) case default ! Read variable from IC file: @@ -162,8 +178,10 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, use cam_abortutils, only: endrun use shr_kind_mod, only: SHR_KIND_CS, SHR_KIND_CL, SHR_KIND_CX use physics_data, only: check_field, find_input_name_idx, no_exist_idx - use physics_data, only: init_mark_idx, prot_no_init_idx + use physics_data, only: init_mark_idx, prot_no_init_idx, const_idx use cam_ccpp_cap, only: ccpp_physics_suite_variables + use cam_ccpp_cap, only: cam_advected_constituents_array + use cam_constituents, only: const_get_index use ccpp_kinds, only: kind_phys use cam_logfile, only: iulog use spmd_utils, only: masterproc @@ -193,12 +211,15 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, character(len=SHR_KIND_CX) :: errmsg !CCPP framework error message integer :: errflg !CCPP framework error flag integer :: name_idx !Input variable array index + integer :: constituent_idx !Index of variable in constituent array integer :: req_idx !Required variable array index integer :: suite_idx !Suite array index character(len=SHR_KIND_CL) :: ncdata_check_loc type(file_desc_t), pointer :: file logical :: file_found logical :: is_first + logical :: is_read + real(kind=kind_phys), pointer :: field_data_ptr(:,:,:) ! Initalize missing and non-initialized variables strings: missing_required_vars = ' ' @@ -239,13 +260,28 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, ! Loop over all required variables as specified by CCPP suite: do req_idx = 1, size(ccpp_required_data, 1) - ! Find IC file input name array index for required variable: - if (.not. is_read_from_file(ccpp_required_data(req_idx), name_idx)) then - continue - end if - ! Check variable vs input check file: - - select case (trim(phys_var_stdnames(name_idx))) + ! First check if the required variable is a constituent: + call const_get_index(ccpp_required_data(req_idx), constituent_idx, abort=.false., & + warning=.false.) + if (constituent_idx > -1) then + ! The required variable is a constituent. Call check variable routine on the + ! relevant index of the constituent array + field_data_ptr => cam_advected_constituents_array() + call check_field(file, [ccpp_required_data(req_idx)], 'lev', timestep, & + field_data_ptr(:,:,constituent_idx), ccpp_required_data(req_idx), & + min_difference, min_relative_value, is_first) + else + ! The required variable is not a constituent. Check if the variable was read from + ! a file + ! Find IC file input name array index for required variable: + call is_read_from_file(ccpp_required_data(req_idx), is_read, & + stdnam_idx_out=name_idx) + if (.not. is_read) then + cycle + end if + ! Check variable vs input check file: + + select case (trim(phys_var_stdnames(name_idx))) case ('potential_temperature') call check_field(file, input_var_names(:,name_idx), 'lev', timestep, theta, & 'potential_temperature', min_difference, min_relative_value, is_first) @@ -255,7 +291,8 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, endrun('Cannot check status of slp'// & ', slp has unsupported dimension, timestep_for_physics.') - end select !check variables + end select !check variables + end if !check if constituent end do !Suite-required variables ! Deallocate required variables array for use in next suite: @@ -268,12 +305,16 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, deallocate(file) nullify(file) if (is_first) then + if (masterproc) then + write(iulog,*) '' + write(iulog,*) 'No differences found!' + end if + end if + if (masterproc) then + write(iulog,*) '' + write(iulog,*) '********** End Physics Check Data Results **********' write(iulog,*) '' - write(iulog,*) 'No differences found!' end if - write(iulog,*) '' - write(iulog,*) '********** End Physics Check Data Results **********' - write(iulog,*) '' end subroutine physics_check_data end module physics_inputs_4D diff --git a/test/unit/sample_files/write_init_files/physics_inputs_bvd.F90 b/test/unit/sample_files/write_init_files/physics_inputs_bvd.F90 index 1701f38b..f7b111bd 100644 --- a/test/unit/sample_files/write_init_files/physics_inputs_bvd.F90 +++ b/test/unit/sample_files/write_init_files/physics_inputs_bvd.F90 @@ -33,8 +33,9 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia use cam_abortutils, only: endrun use shr_kind_mod, only: SHR_KIND_CS, SHR_KIND_CL, SHR_KIND_CX use physics_data, only: read_field, find_input_name_idx, no_exist_idx - use physics_data, only: init_mark_idx, prot_no_init_idx - use cam_ccpp_cap, only: ccpp_physics_suite_variables + use physics_data, only: init_mark_idx, prot_no_init_idx, const_idx + use cam_ccpp_cap, only: ccpp_physics_suite_variables, cam_constituents_array + use ccpp_kinds, only: kind_phys use phys_vars_init_check_bvd, only: phys_var_stdnames, input_var_names, std_name_len use physics_types_bad_vertdim, only: slp, theta @@ -53,14 +54,16 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia character(len=SHR_KIND_CL) :: missing_required_vars character(len=SHR_KIND_CL) :: protected_non_init_vars - character(len=SHR_KIND_CX) :: errmsg !CCPP framework error message - integer :: errflg !CCPP framework error flag - integer :: name_idx !Input variable array index - integer :: req_idx !Required variable array index - integer :: suite_idx !Suite array index - character(len=2) :: sep = '' !String separator used to print error messages - character(len=2) :: sep2 = '' !String separator used to print error messages - character(len=2) :: sep3 = '' !String separator used to print error messages + character(len=SHR_KIND_CX) :: errmsg !CCPP framework error message + integer :: errflg !CCPP framework error flag + integer :: name_idx !Input variable array index + integer :: constituent_idx !Constituent table index + integer :: req_idx !Required variable array index + integer :: suite_idx !Suite array index + character(len=2) :: sep !String separator used to print err messages + character(len=2) :: sep2 !String separator used to print err messages + character(len=2) :: sep3 !String separator used to print err messages + real(kind=kind_phys), pointer :: field_data_ptr(:,:,:) ! Logical to default optional argument to False: logical :: use_init_variables @@ -68,6 +71,9 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia ! Initalize missing and non-initialized variables strings: missing_required_vars = ' ' protected_non_init_vars = ' ' + sep = '' + sep2 = '' + sep3 = '' ! Initialize use_init_variables based on whether it was input to function: if (present(read_initialized_variables)) then @@ -88,7 +94,8 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia do req_idx = 1, size(ccpp_required_data, 1) ! Find IC file input name array index for required variable: - name_idx = find_input_name_idx(ccpp_required_data(req_idx), use_init_variables) + name_idx = find_input_name_idx(ccpp_required_data(req_idx), use_init_variables, & + constituent_idx) ! Check for special index values: select case (name_idx) @@ -118,6 +125,15 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia ! Update character separator to now include comma: sep2 = ', ' + case (const_idx) + + ! If an index was found in the constituent hash table, then read in the data + ! to that index of the constituent array + + field_data_ptr => cam_constituents_array() + call read_field(file, ccpp_required_data(req_idx), & + [ccpp_required_data(req_idx)], 'lev', timestep, & + field_data_ptr(:,:,constituent_idx), mark_as_read=.false.) case default ! Read variable from IC file: @@ -162,8 +178,10 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, use cam_abortutils, only: endrun use shr_kind_mod, only: SHR_KIND_CS, SHR_KIND_CL, SHR_KIND_CX use physics_data, only: check_field, find_input_name_idx, no_exist_idx - use physics_data, only: init_mark_idx, prot_no_init_idx + use physics_data, only: init_mark_idx, prot_no_init_idx, const_idx use cam_ccpp_cap, only: ccpp_physics_suite_variables + use cam_ccpp_cap, only: cam_advected_constituents_array + use cam_constituents, only: const_get_index use ccpp_kinds, only: kind_phys use cam_logfile, only: iulog use spmd_utils, only: masterproc @@ -193,12 +211,15 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, character(len=SHR_KIND_CX) :: errmsg !CCPP framework error message integer :: errflg !CCPP framework error flag integer :: name_idx !Input variable array index + integer :: constituent_idx !Index of variable in constituent array integer :: req_idx !Required variable array index integer :: suite_idx !Suite array index character(len=SHR_KIND_CL) :: ncdata_check_loc type(file_desc_t), pointer :: file logical :: file_found logical :: is_first + logical :: is_read + real(kind=kind_phys), pointer :: field_data_ptr(:,:,:) ! Initalize missing and non-initialized variables strings: missing_required_vars = ' ' @@ -239,13 +260,28 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, ! Loop over all required variables as specified by CCPP suite: do req_idx = 1, size(ccpp_required_data, 1) - ! Find IC file input name array index for required variable: - if (.not. is_read_from_file(ccpp_required_data(req_idx), name_idx)) then - continue - end if - ! Check variable vs input check file: - - select case (trim(phys_var_stdnames(name_idx))) + ! First check if the required variable is a constituent: + call const_get_index(ccpp_required_data(req_idx), constituent_idx, abort=.false., & + warning=.false.) + if (constituent_idx > -1) then + ! The required variable is a constituent. Call check variable routine on the + ! relevant index of the constituent array + field_data_ptr => cam_advected_constituents_array() + call check_field(file, [ccpp_required_data(req_idx)], 'lev', timestep, & + field_data_ptr(:,:,constituent_idx), ccpp_required_data(req_idx), & + min_difference, min_relative_value, is_first) + else + ! The required variable is not a constituent. Check if the variable was read from + ! a file + ! Find IC file input name array index for required variable: + call is_read_from_file(ccpp_required_data(req_idx), is_read, & + stdnam_idx_out=name_idx) + if (.not. is_read) then + cycle + end if + ! Check variable vs input check file: + + select case (trim(phys_var_stdnames(name_idx))) case ('potential_temperature') call check_field(file, input_var_names(:,name_idx), 'lev', timestep, theta, & 'potential_temperature', min_difference, min_relative_value, is_first) @@ -255,7 +291,8 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, endrun('Cannot check status of slp'// & ', slp has unsupported dimension, band_number.') - end select !check variables + end select !check variables + end if !check if constituent end do !Suite-required variables ! Deallocate required variables array for use in next suite: @@ -268,12 +305,16 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, deallocate(file) nullify(file) if (is_first) then + if (masterproc) then + write(iulog,*) '' + write(iulog,*) 'No differences found!' + end if + end if + if (masterproc) then + write(iulog,*) '' + write(iulog,*) '********** End Physics Check Data Results **********' write(iulog,*) '' - write(iulog,*) 'No differences found!' end if - write(iulog,*) '' - write(iulog,*) '********** End Physics Check Data Results **********' - write(iulog,*) '' end subroutine physics_check_data end module physics_inputs_bvd diff --git a/test/unit/sample_files/write_init_files/physics_inputs_ddt.F90 b/test/unit/sample_files/write_init_files/physics_inputs_ddt.F90 index 0260638b..8e6b39fc 100644 --- a/test/unit/sample_files/write_init_files/physics_inputs_ddt.F90 +++ b/test/unit/sample_files/write_init_files/physics_inputs_ddt.F90 @@ -33,8 +33,9 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia use cam_abortutils, only: endrun use shr_kind_mod, only: SHR_KIND_CS, SHR_KIND_CL, SHR_KIND_CX use physics_data, only: read_field, find_input_name_idx, no_exist_idx - use physics_data, only: init_mark_idx, prot_no_init_idx - use cam_ccpp_cap, only: ccpp_physics_suite_variables + use physics_data, only: init_mark_idx, prot_no_init_idx, const_idx + use cam_ccpp_cap, only: ccpp_physics_suite_variables, cam_constituents_array + use ccpp_kinds, only: kind_phys use phys_vars_init_check_ddt, only: phys_var_stdnames, input_var_names, std_name_len use physics_types_ddt, only: phys_state, slp @@ -53,14 +54,16 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia character(len=SHR_KIND_CL) :: missing_required_vars character(len=SHR_KIND_CL) :: protected_non_init_vars - character(len=SHR_KIND_CX) :: errmsg !CCPP framework error message - integer :: errflg !CCPP framework error flag - integer :: name_idx !Input variable array index - integer :: req_idx !Required variable array index - integer :: suite_idx !Suite array index - character(len=2) :: sep = '' !String separator used to print error messages - character(len=2) :: sep2 = '' !String separator used to print error messages - character(len=2) :: sep3 = '' !String separator used to print error messages + character(len=SHR_KIND_CX) :: errmsg !CCPP framework error message + integer :: errflg !CCPP framework error flag + integer :: name_idx !Input variable array index + integer :: constituent_idx !Constituent table index + integer :: req_idx !Required variable array index + integer :: suite_idx !Suite array index + character(len=2) :: sep !String separator used to print err messages + character(len=2) :: sep2 !String separator used to print err messages + character(len=2) :: sep3 !String separator used to print err messages + real(kind=kind_phys), pointer :: field_data_ptr(:,:,:) ! Logical to default optional argument to False: logical :: use_init_variables @@ -68,6 +71,9 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia ! Initalize missing and non-initialized variables strings: missing_required_vars = ' ' protected_non_init_vars = ' ' + sep = '' + sep2 = '' + sep3 = '' ! Initialize use_init_variables based on whether it was input to function: if (present(read_initialized_variables)) then @@ -88,7 +94,8 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia do req_idx = 1, size(ccpp_required_data, 1) ! Find IC file input name array index for required variable: - name_idx = find_input_name_idx(ccpp_required_data(req_idx), use_init_variables) + name_idx = find_input_name_idx(ccpp_required_data(req_idx), use_init_variables, & + constituent_idx) ! Check for special index values: select case (name_idx) @@ -118,6 +125,15 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia ! Update character separator to now include comma: sep2 = ', ' + case (const_idx) + + ! If an index was found in the constituent hash table, then read in the data + ! to that index of the constituent array + + field_data_ptr => cam_constituents_array() + call read_field(file, ccpp_required_data(req_idx), & + [ccpp_required_data(req_idx)], 'lev', timestep, & + field_data_ptr(:,:,constituent_idx), mark_as_read=.false.) case default ! Read variable from IC file: @@ -161,8 +177,10 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, use cam_abortutils, only: endrun use shr_kind_mod, only: SHR_KIND_CS, SHR_KIND_CL, SHR_KIND_CX use physics_data, only: check_field, find_input_name_idx, no_exist_idx - use physics_data, only: init_mark_idx, prot_no_init_idx + use physics_data, only: init_mark_idx, prot_no_init_idx, const_idx use cam_ccpp_cap, only: ccpp_physics_suite_variables + use cam_ccpp_cap, only: cam_advected_constituents_array + use cam_constituents, only: const_get_index use ccpp_kinds, only: kind_phys use cam_logfile, only: iulog use spmd_utils, only: masterproc @@ -192,12 +210,15 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, character(len=SHR_KIND_CX) :: errmsg !CCPP framework error message integer :: errflg !CCPP framework error flag integer :: name_idx !Input variable array index + integer :: constituent_idx !Index of variable in constituent array integer :: req_idx !Required variable array index integer :: suite_idx !Suite array index character(len=SHR_KIND_CL) :: ncdata_check_loc type(file_desc_t), pointer :: file logical :: file_found logical :: is_first + logical :: is_read + real(kind=kind_phys), pointer :: field_data_ptr(:,:,:) ! Initalize missing and non-initialized variables strings: missing_required_vars = ' ' @@ -238,13 +259,28 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, ! Loop over all required variables as specified by CCPP suite: do req_idx = 1, size(ccpp_required_data, 1) - ! Find IC file input name array index for required variable: - if (.not. is_read_from_file(ccpp_required_data(req_idx), name_idx)) then - continue - end if - ! Check variable vs input check file: - - select case (trim(phys_var_stdnames(name_idx))) + ! First check if the required variable is a constituent: + call const_get_index(ccpp_required_data(req_idx), constituent_idx, abort=.false., & + warning=.false.) + if (constituent_idx > -1) then + ! The required variable is a constituent. Call check variable routine on the + ! relevant index of the constituent array + field_data_ptr => cam_advected_constituents_array() + call check_field(file, [ccpp_required_data(req_idx)], 'lev', timestep, & + field_data_ptr(:,:,constituent_idx), ccpp_required_data(req_idx), & + min_difference, min_relative_value, is_first) + else + ! The required variable is not a constituent. Check if the variable was read from + ! a file + ! Find IC file input name array index for required variable: + call is_read_from_file(ccpp_required_data(req_idx), is_read, & + stdnam_idx_out=name_idx) + if (.not. is_read) then + cycle + end if + ! Check variable vs input check file: + + select case (trim(phys_var_stdnames(name_idx))) case ('potential_temperature') call check_field(file, input_var_names(:,name_idx), 'lev', timestep, & phys_state%theta, 'potential_temperature', min_difference, & @@ -254,7 +290,8 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, call check_field(file, input_var_names(:,name_idx), timestep, slp, & 'air_pressure_at_sea_level', min_difference, min_relative_value, is_first) - end select !check variables + end select !check variables + end if !check if constituent end do !Suite-required variables ! Deallocate required variables array for use in next suite: @@ -267,12 +304,16 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, deallocate(file) nullify(file) if (is_first) then + if (masterproc) then + write(iulog,*) '' + write(iulog,*) 'No differences found!' + end if + end if + if (masterproc) then + write(iulog,*) '' + write(iulog,*) '********** End Physics Check Data Results **********' write(iulog,*) '' - write(iulog,*) 'No differences found!' end if - write(iulog,*) '' - write(iulog,*) '********** End Physics Check Data Results **********' - write(iulog,*) '' end subroutine physics_check_data end module physics_inputs_ddt diff --git a/test/unit/sample_files/write_init_files/physics_inputs_ddt2.F90 b/test/unit/sample_files/write_init_files/physics_inputs_ddt2.F90 index 1b31883f..0c5fcbb3 100644 --- a/test/unit/sample_files/write_init_files/physics_inputs_ddt2.F90 +++ b/test/unit/sample_files/write_init_files/physics_inputs_ddt2.F90 @@ -33,8 +33,9 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia use cam_abortutils, only: endrun use shr_kind_mod, only: SHR_KIND_CS, SHR_KIND_CL, SHR_KIND_CX use physics_data, only: read_field, find_input_name_idx, no_exist_idx - use physics_data, only: init_mark_idx, prot_no_init_idx - use cam_ccpp_cap, only: ccpp_physics_suite_variables + use physics_data, only: init_mark_idx, prot_no_init_idx, const_idx + use cam_ccpp_cap, only: ccpp_physics_suite_variables, cam_constituents_array + use ccpp_kinds, only: kind_phys use phys_vars_init_check_ddt2, only: phys_var_stdnames, input_var_names, std_name_len use physics_types_ddt2, only: phys_state @@ -53,14 +54,16 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia character(len=SHR_KIND_CL) :: missing_required_vars character(len=SHR_KIND_CL) :: protected_non_init_vars - character(len=SHR_KIND_CX) :: errmsg !CCPP framework error message - integer :: errflg !CCPP framework error flag - integer :: name_idx !Input variable array index - integer :: req_idx !Required variable array index - integer :: suite_idx !Suite array index - character(len=2) :: sep = '' !String separator used to print error messages - character(len=2) :: sep2 = '' !String separator used to print error messages - character(len=2) :: sep3 = '' !String separator used to print error messages + character(len=SHR_KIND_CX) :: errmsg !CCPP framework error message + integer :: errflg !CCPP framework error flag + integer :: name_idx !Input variable array index + integer :: constituent_idx !Constituent table index + integer :: req_idx !Required variable array index + integer :: suite_idx !Suite array index + character(len=2) :: sep !String separator used to print err messages + character(len=2) :: sep2 !String separator used to print err messages + character(len=2) :: sep3 !String separator used to print err messages + real(kind=kind_phys), pointer :: field_data_ptr(:,:,:) ! Logical to default optional argument to False: logical :: use_init_variables @@ -68,6 +71,9 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia ! Initalize missing and non-initialized variables strings: missing_required_vars = ' ' protected_non_init_vars = ' ' + sep = '' + sep2 = '' + sep3 = '' ! Initialize use_init_variables based on whether it was input to function: if (present(read_initialized_variables)) then @@ -88,7 +94,8 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia do req_idx = 1, size(ccpp_required_data, 1) ! Find IC file input name array index for required variable: - name_idx = find_input_name_idx(ccpp_required_data(req_idx), use_init_variables) + name_idx = find_input_name_idx(ccpp_required_data(req_idx), use_init_variables, & + constituent_idx) ! Check for special index values: select case (name_idx) @@ -118,6 +125,15 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia ! Update character separator to now include comma: sep2 = ', ' + case (const_idx) + + ! If an index was found in the constituent hash table, then read in the data + ! to that index of the constituent array + + field_data_ptr => cam_constituents_array() + call read_field(file, ccpp_required_data(req_idx), & + [ccpp_required_data(req_idx)], 'lev', timestep, & + field_data_ptr(:,:,constituent_idx), mark_as_read=.false.) case default ! Read variable from IC file: @@ -161,8 +177,10 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, use cam_abortutils, only: endrun use shr_kind_mod, only: SHR_KIND_CS, SHR_KIND_CL, SHR_KIND_CX use physics_data, only: check_field, find_input_name_idx, no_exist_idx - use physics_data, only: init_mark_idx, prot_no_init_idx + use physics_data, only: init_mark_idx, prot_no_init_idx, const_idx use cam_ccpp_cap, only: ccpp_physics_suite_variables + use cam_ccpp_cap, only: cam_advected_constituents_array + use cam_constituents, only: const_get_index use ccpp_kinds, only: kind_phys use cam_logfile, only: iulog use spmd_utils, only: masterproc @@ -192,12 +210,15 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, character(len=SHR_KIND_CX) :: errmsg !CCPP framework error message integer :: errflg !CCPP framework error flag integer :: name_idx !Input variable array index + integer :: constituent_idx !Index of variable in constituent array integer :: req_idx !Required variable array index integer :: suite_idx !Suite array index character(len=SHR_KIND_CL) :: ncdata_check_loc type(file_desc_t), pointer :: file logical :: file_found logical :: is_first + logical :: is_read + real(kind=kind_phys), pointer :: field_data_ptr(:,:,:) ! Initalize missing and non-initialized variables strings: missing_required_vars = ' ' @@ -238,13 +259,28 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, ! Loop over all required variables as specified by CCPP suite: do req_idx = 1, size(ccpp_required_data, 1) - ! Find IC file input name array index for required variable: - if (.not. is_read_from_file(ccpp_required_data(req_idx), name_idx)) then - continue - end if - ! Check variable vs input check file: - - select case (trim(phys_var_stdnames(name_idx))) + ! First check if the required variable is a constituent: + call const_get_index(ccpp_required_data(req_idx), constituent_idx, abort=.false., & + warning=.false.) + if (constituent_idx > -1) then + ! The required variable is a constituent. Call check variable routine on the + ! relevant index of the constituent array + field_data_ptr => cam_advected_constituents_array() + call check_field(file, [ccpp_required_data(req_idx)], 'lev', timestep, & + field_data_ptr(:,:,constituent_idx), ccpp_required_data(req_idx), & + min_difference, min_relative_value, is_first) + else + ! The required variable is not a constituent. Check if the variable was read from + ! a file + ! Find IC file input name array index for required variable: + call is_read_from_file(ccpp_required_data(req_idx), is_read, & + stdnam_idx_out=name_idx) + if (.not. is_read) then + cycle + end if + ! Check variable vs input check file: + + select case (trim(phys_var_stdnames(name_idx))) case ('potential_temperature') call check_field(file, input_var_names(:,name_idx), 'lev', timestep, & phys_state%theta, 'potential_temperature', min_difference, & @@ -254,7 +290,8 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, call check_field(file, input_var_names(:,name_idx), timestep, phys_state%slp, & 'air_pressure_at_sea_level', min_difference, min_relative_value, is_first) - end select !check variables + end select !check variables + end if !check if constituent end do !Suite-required variables ! Deallocate required variables array for use in next suite: @@ -267,12 +304,16 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, deallocate(file) nullify(file) if (is_first) then + if (masterproc) then + write(iulog,*) '' + write(iulog,*) 'No differences found!' + end if + end if + if (masterproc) then + write(iulog,*) '' + write(iulog,*) '********** End Physics Check Data Results **********' write(iulog,*) '' - write(iulog,*) 'No differences found!' end if - write(iulog,*) '' - write(iulog,*) '********** End Physics Check Data Results **********' - write(iulog,*) '' end subroutine physics_check_data end module physics_inputs_ddt2 diff --git a/test/unit/sample_files/write_init_files/physics_inputs_ddt_array.F90 b/test/unit/sample_files/write_init_files/physics_inputs_ddt_array.F90 index 1095ea0a..f563a44a 100644 --- a/test/unit/sample_files/write_init_files/physics_inputs_ddt_array.F90 +++ b/test/unit/sample_files/write_init_files/physics_inputs_ddt_array.F90 @@ -33,8 +33,10 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia use cam_abortutils, only: endrun use shr_kind_mod, only: SHR_KIND_CS, SHR_KIND_CL, SHR_KIND_CX use physics_data, only: read_field, find_input_name_idx, no_exist_idx - use physics_data, only: init_mark_idx, prot_no_init_idx + use physics_data, only: init_mark_idx, prot_no_init_idx, const_idx use cam_ccpp_cap, only: ccpp_physics_suite_variables + use cam_ccpp_cap, only: cam_constituents_array + use ccpp_kinds, only: kind_phys use phys_vars_init_check_ddt_array, only: phys_var_stdnames, input_var_names, std_name_len use physics_types_ddt_array, only: ix_theta, phys_state @@ -53,14 +55,16 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia character(len=SHR_KIND_CL) :: missing_required_vars character(len=SHR_KIND_CL) :: protected_non_init_vars - character(len=SHR_KIND_CX) :: errmsg !CCPP framework error message - integer :: errflg !CCPP framework error flag - integer :: name_idx !Input variable array index - integer :: req_idx !Required variable array index - integer :: suite_idx !Suite array index - character(len=2) :: sep = '' !String separator used to print error messages - character(len=2) :: sep2 = '' !String separator used to print error messages - character(len=2) :: sep3 = '' !String separator used to print error messages + character(len=SHR_KIND_CX) :: errmsg !CCPP framework error message + integer :: errflg !CCPP framework error flag + integer :: name_idx !Input variable array index + integer :: constituent_idx !Constituent table index + integer :: req_idx !Required variable array index + integer :: suite_idx !Suite array index + character(len=2) :: sep !String separator used to print err messages + character(len=2) :: sep2 !String separator used to print err messages + character(len=2) :: sep3 !String separator used to print err messages + real(kind=kind_phys), pointer :: field_data_ptr(:,:,:) ! Logical to default optional argument to False: logical :: use_init_variables @@ -68,6 +72,9 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia ! Initalize missing and non-initialized variables strings: missing_required_vars = ' ' protected_non_init_vars = ' ' + sep = '' + sep2 = '' + sep3 = '' ! Initialize use_init_variables based on whether it was input to function: if (present(read_initialized_variables)) then @@ -88,7 +95,8 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia do req_idx = 1, size(ccpp_required_data, 1) ! Find IC file input name array index for required variable: - name_idx = find_input_name_idx(ccpp_required_data(req_idx), use_init_variables) + name_idx = find_input_name_idx(ccpp_required_data(req_idx), use_init_variables, & + constituent_idx) ! Check for special index values: select case (name_idx) @@ -118,6 +126,15 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia ! Update character separator to now include comma: sep2 = ', ' + case (const_idx) + + ! If an index was found in the constituent hash table, then read in the data + ! to that index of the constituent array + + field_data_ptr => cam_constituents_array() + call read_field(file, ccpp_required_data(req_idx), & + [ccpp_required_data(req_idx)], 'lev', timestep, & + field_data_ptr(:,:,constituent_idx), mark_as_read=.false.) case default ! Read variable from IC file: @@ -162,8 +179,10 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, use cam_abortutils, only: endrun use shr_kind_mod, only: SHR_KIND_CS, SHR_KIND_CL, SHR_KIND_CX use physics_data, only: check_field, find_input_name_idx, no_exist_idx - use physics_data, only: init_mark_idx, prot_no_init_idx + use physics_data, only: init_mark_idx, prot_no_init_idx, const_idx use cam_ccpp_cap, only: ccpp_physics_suite_variables + use cam_ccpp_cap, only: cam_advected_constituents_array + use cam_constituents, only: const_get_index use ccpp_kinds, only: kind_phys use cam_logfile, only: iulog use spmd_utils, only: masterproc @@ -193,12 +212,15 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, character(len=SHR_KIND_CX) :: errmsg !CCPP framework error message integer :: errflg !CCPP framework error flag integer :: name_idx !Input variable array index + integer :: constituent_idx !Index of variable in constituent array integer :: req_idx !Required variable array index integer :: suite_idx !Suite array index character(len=SHR_KIND_CL) :: ncdata_check_loc type(file_desc_t), pointer :: file logical :: file_found logical :: is_first + logical :: is_read + real(kind=kind_phys), pointer :: field_data_ptr(:,:,:) ! Initalize missing and non-initialized variables strings: missing_required_vars = ' ' @@ -239,13 +261,28 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, ! Loop over all required variables as specified by CCPP suite: do req_idx = 1, size(ccpp_required_data, 1) - ! Find IC file input name array index for required variable: - if (.not. is_read_from_file(ccpp_required_data(req_idx), name_idx)) then - continue - end if - ! Check variable vs input check file: - - select case (trim(phys_var_stdnames(name_idx))) + ! First check if the required variable is a constituent: + call const_get_index(ccpp_required_data(req_idx), constituent_idx, abort=.false., & + warning=.false.) + if (constituent_idx > -1) then + ! The required variable is a constituent. Call check variable routine on the + ! relevant index of the constituent array + field_data_ptr => cam_advected_constituents_array() + call check_field(file, [ccpp_required_data(req_idx)], 'lev', timestep, & + field_data_ptr(:,:,constituent_idx), ccpp_required_data(req_idx), & + min_difference, min_relative_value, is_first) + else + ! The required variable is not a constituent. Check if the variable was read from + ! a file + ! Find IC file input name array index for required variable: + call is_read_from_file(ccpp_required_data(req_idx), is_read, & + stdnam_idx_out=name_idx) + if (.not. is_read) then + cycle + end if + ! Check variable vs input check file: + + select case (trim(phys_var_stdnames(name_idx))) case ('potential_temperature') call check_field(file, input_var_names(:,name_idx), 'lev', timestep, & phys_state%T(:, :, ix_theta), 'potential_temperature', min_difference, & @@ -255,7 +292,8 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, call check_field(file, input_var_names(:,name_idx), timestep, phys_state%slp, & 'air_pressure_at_sea_level', min_difference, min_relative_value, is_first) - end select !check variables + end select !check variables + end if !check if constituent end do !Suite-required variables ! Deallocate required variables array for use in next suite: @@ -268,12 +306,16 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, deallocate(file) nullify(file) if (is_first) then + if (masterproc) then + write(iulog,*) '' + write(iulog,*) 'No differences found!' + end if + end if + if (masterproc) then + write(iulog,*) '' + write(iulog,*) '********** End Physics Check Data Results **********' write(iulog,*) '' - write(iulog,*) 'No differences found!' end if - write(iulog,*) '' - write(iulog,*) '********** End Physics Check Data Results **********' - write(iulog,*) '' end subroutine physics_check_data end module physics_inputs_ddt_array diff --git a/test/unit/sample_files/write_init_files/physics_inputs_host_var.F90 b/test/unit/sample_files/write_init_files/physics_inputs_host_var.F90 index f0a1f351..84969562 100644 --- a/test/unit/sample_files/write_init_files/physics_inputs_host_var.F90 +++ b/test/unit/sample_files/write_init_files/physics_inputs_host_var.F90 @@ -33,8 +33,10 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia use cam_abortutils, only: endrun use shr_kind_mod, only: SHR_KIND_CS, SHR_KIND_CL, SHR_KIND_CX use physics_data, only: read_field, find_input_name_idx, no_exist_idx - use physics_data, only: init_mark_idx, prot_no_init_idx + use physics_data, only: init_mark_idx, prot_no_init_idx, const_idx use cam_ccpp_cap, only: ccpp_physics_suite_variables + use cam_ccpp_cap, only: cam_constituents_array + use ccpp_kinds, only: kind_phys use phys_vars_init_check_host_var, only: phys_var_stdnames, input_var_names, std_name_len use physics_types_host_var, only: slp @@ -53,14 +55,16 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia character(len=SHR_KIND_CL) :: missing_required_vars character(len=SHR_KIND_CL) :: protected_non_init_vars - character(len=SHR_KIND_CX) :: errmsg !CCPP framework error message - integer :: errflg !CCPP framework error flag - integer :: name_idx !Input variable array index - integer :: req_idx !Required variable array index - integer :: suite_idx !Suite array index - character(len=2) :: sep = '' !String separator used to print error messages - character(len=2) :: sep2 = '' !String separator used to print error messages - character(len=2) :: sep3 = '' !String separator used to print error messages + character(len=SHR_KIND_CX) :: errmsg !CCPP framework error message + integer :: errflg !CCPP framework error flag + integer :: name_idx !Input variable array index + integer :: constituent_idx !Constituent table index + integer :: req_idx !Required variable array index + integer :: suite_idx !Suite array index + character(len=2) :: sep !String separator used to print err messages + character(len=2) :: sep2 !String separator used to print err messages + character(len=2) :: sep3 !String separator used to print err messages + real(kind=kind_phys), pointer :: field_data_ptr(:,:,:) ! Logical to default optional argument to False: logical :: use_init_variables @@ -68,6 +72,9 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia ! Initalize missing and non-initialized variables strings: missing_required_vars = ' ' protected_non_init_vars = ' ' + sep = '' + sep2 = '' + sep3 = '' ! Initialize use_init_variables based on whether it was input to function: if (present(read_initialized_variables)) then @@ -88,7 +95,8 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia do req_idx = 1, size(ccpp_required_data, 1) ! Find IC file input name array index for required variable: - name_idx = find_input_name_idx(ccpp_required_data(req_idx), use_init_variables) + name_idx = find_input_name_idx(ccpp_required_data(req_idx), use_init_variables, & + constituent_idx) ! Check for special index values: select case (name_idx) @@ -118,6 +126,15 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia ! Update character separator to now include comma: sep2 = ', ' + case (const_idx) + + ! If an index was found in the constituent hash table, then read in the data + ! to that index of the constituent array + + field_data_ptr => cam_constituents_array() + call read_field(file, ccpp_required_data(req_idx), & + [ccpp_required_data(req_idx)], 'lev', timestep, & + field_data_ptr(:,:,constituent_idx), mark_as_read=.false.) case default ! Read variable from IC file: @@ -157,8 +174,10 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, use cam_abortutils, only: endrun use shr_kind_mod, only: SHR_KIND_CS, SHR_KIND_CL, SHR_KIND_CX use physics_data, only: check_field, find_input_name_idx, no_exist_idx - use physics_data, only: init_mark_idx, prot_no_init_idx + use physics_data, only: init_mark_idx, prot_no_init_idx, const_idx use cam_ccpp_cap, only: ccpp_physics_suite_variables + use cam_ccpp_cap, only: cam_advected_constituents_array + use cam_constituents, only: const_get_index use ccpp_kinds, only: kind_phys use cam_logfile, only: iulog use spmd_utils, only: masterproc @@ -188,12 +207,15 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, character(len=SHR_KIND_CX) :: errmsg !CCPP framework error message integer :: errflg !CCPP framework error flag integer :: name_idx !Input variable array index + integer :: constituent_idx !Index of variable in constituent array integer :: req_idx !Required variable array index integer :: suite_idx !Suite array index character(len=SHR_KIND_CL) :: ncdata_check_loc type(file_desc_t), pointer :: file logical :: file_found logical :: is_first + logical :: is_read + real(kind=kind_phys), pointer :: field_data_ptr(:,:,:) ! Initalize missing and non-initialized variables strings: missing_required_vars = ' ' @@ -234,18 +256,34 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, ! Loop over all required variables as specified by CCPP suite: do req_idx = 1, size(ccpp_required_data, 1) - ! Find IC file input name array index for required variable: - if (.not. is_read_from_file(ccpp_required_data(req_idx), name_idx)) then - continue - end if - ! Check variable vs input check file: - - select case (trim(phys_var_stdnames(name_idx))) + ! First check if the required variable is a constituent: + call const_get_index(ccpp_required_data(req_idx), constituent_idx, abort=.false., & + warning=.false.) + if (constituent_idx > -1) then + ! The required variable is a constituent. Call check variable routine on the + ! relevant index of the constituent array + field_data_ptr => cam_advected_constituents_array() + call check_field(file, [ccpp_required_data(req_idx)], 'lev', timestep, & + field_data_ptr(:,:,constituent_idx), ccpp_required_data(req_idx), & + min_difference, min_relative_value, is_first) + else + ! The required variable is not a constituent. Check if the variable was read from + ! a file + ! Find IC file input name array index for required variable: + call is_read_from_file(ccpp_required_data(req_idx), is_read, & + stdnam_idx_out=name_idx) + if (.not. is_read) then + cycle + end if + ! Check variable vs input check file: + + select case (trim(phys_var_stdnames(name_idx))) case ('air_pressure_at_sea_level') call check_field(file, input_var_names(:,name_idx), timestep, slp, & 'air_pressure_at_sea_level', min_difference, min_relative_value, is_first) - end select !check variables + end select !check variables + end if !check if constituent end do !Suite-required variables ! Deallocate required variables array for use in next suite: @@ -258,12 +296,16 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, deallocate(file) nullify(file) if (is_first) then + if (masterproc) then + write(iulog,*) '' + write(iulog,*) 'No differences found!' + end if + end if + if (masterproc) then + write(iulog,*) '' + write(iulog,*) '********** End Physics Check Data Results **********' write(iulog,*) '' - write(iulog,*) 'No differences found!' end if - write(iulog,*) '' - write(iulog,*) '********** End Physics Check Data Results **********' - write(iulog,*) '' end subroutine physics_check_data end module physics_inputs_host_var diff --git a/test/unit/sample_files/write_init_files/physics_inputs_mf.F90 b/test/unit/sample_files/write_init_files/physics_inputs_mf.F90 index 5ef348e0..47458e33 100644 --- a/test/unit/sample_files/write_init_files/physics_inputs_mf.F90 +++ b/test/unit/sample_files/write_init_files/physics_inputs_mf.F90 @@ -33,8 +33,9 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia use cam_abortutils, only: endrun use shr_kind_mod, only: SHR_KIND_CS, SHR_KIND_CL, SHR_KIND_CX use physics_data, only: read_field, find_input_name_idx, no_exist_idx - use physics_data, only: init_mark_idx, prot_no_init_idx - use cam_ccpp_cap, only: ccpp_physics_suite_variables + use physics_data, only: init_mark_idx, prot_no_init_idx, const_idx + use cam_ccpp_cap, only: ccpp_physics_suite_variables, cam_constituents_array + use ccpp_kinds, only: kind_phys use phys_vars_init_check_mf, only: phys_var_stdnames, input_var_names, std_name_len use ref_theta, only: theta use physics_types_mf, only: slp @@ -54,14 +55,16 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia character(len=SHR_KIND_CL) :: missing_required_vars character(len=SHR_KIND_CL) :: protected_non_init_vars - character(len=SHR_KIND_CX) :: errmsg !CCPP framework error message - integer :: errflg !CCPP framework error flag - integer :: name_idx !Input variable array index - integer :: req_idx !Required variable array index - integer :: suite_idx !Suite array index - character(len=2) :: sep = '' !String separator used to print error messages - character(len=2) :: sep2 = '' !String separator used to print error messages - character(len=2) :: sep3 = '' !String separator used to print error messages + character(len=SHR_KIND_CX) :: errmsg !CCPP framework error message + integer :: errflg !CCPP framework error flag + integer :: name_idx !Input variable array index + integer :: constituent_idx !Constituent table index + integer :: req_idx !Required variable array index + integer :: suite_idx !Suite array index + character(len=2) :: sep !String separator used to print err messages + character(len=2) :: sep2 !String separator used to print err messages + character(len=2) :: sep3 !String separator used to print err messages + real(kind=kind_phys), pointer :: field_data_ptr(:,:,:) ! Logical to default optional argument to False: logical :: use_init_variables @@ -69,6 +72,9 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia ! Initalize missing and non-initialized variables strings: missing_required_vars = ' ' protected_non_init_vars = ' ' + sep = '' + sep2 = '' + sep3 = '' ! Initialize use_init_variables based on whether it was input to function: if (present(read_initialized_variables)) then @@ -89,7 +95,8 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia do req_idx = 1, size(ccpp_required_data, 1) ! Find IC file input name array index for required variable: - name_idx = find_input_name_idx(ccpp_required_data(req_idx), use_init_variables) + name_idx = find_input_name_idx(ccpp_required_data(req_idx), use_init_variables, & + constituent_idx) ! Check for special index values: select case (name_idx) @@ -119,6 +126,15 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia ! Update character separator to now include comma: sep2 = ', ' + case (const_idx) + + ! If an index was found in the constituent hash table, then read in the data + ! to that index of the constituent array + + field_data_ptr => cam_constituents_array() + call read_field(file, ccpp_required_data(req_idx), & + [ccpp_required_data(req_idx)], 'lev', timestep, & + field_data_ptr(:,:,constituent_idx), mark_as_read=.false.) case default ! Read variable from IC file: @@ -162,8 +178,10 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, use cam_abortutils, only: endrun use shr_kind_mod, only: SHR_KIND_CS, SHR_KIND_CL, SHR_KIND_CX use physics_data, only: check_field, find_input_name_idx, no_exist_idx - use physics_data, only: init_mark_idx, prot_no_init_idx + use physics_data, only: init_mark_idx, prot_no_init_idx, const_idx use cam_ccpp_cap, only: ccpp_physics_suite_variables + use cam_ccpp_cap, only: cam_advected_constituents_array + use cam_constituents, only: const_get_index use ccpp_kinds, only: kind_phys use cam_logfile, only: iulog use spmd_utils, only: masterproc @@ -194,12 +212,15 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, character(len=SHR_KIND_CX) :: errmsg !CCPP framework error message integer :: errflg !CCPP framework error flag integer :: name_idx !Input variable array index + integer :: constituent_idx !Index of variable in constituent array integer :: req_idx !Required variable array index integer :: suite_idx !Suite array index character(len=SHR_KIND_CL) :: ncdata_check_loc type(file_desc_t), pointer :: file logical :: file_found logical :: is_first + logical :: is_read + real(kind=kind_phys), pointer :: field_data_ptr(:,:,:) ! Initalize missing and non-initialized variables strings: missing_required_vars = ' ' @@ -240,13 +261,28 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, ! Loop over all required variables as specified by CCPP suite: do req_idx = 1, size(ccpp_required_data, 1) - ! Find IC file input name array index for required variable: - if (.not. is_read_from_file(ccpp_required_data(req_idx), name_idx)) then - continue - end if - ! Check variable vs input check file: - - select case (trim(phys_var_stdnames(name_idx))) + ! First check if the required variable is a constituent: + call const_get_index(ccpp_required_data(req_idx), constituent_idx, abort=.false., & + warning=.false.) + if (constituent_idx > -1) then + ! The required variable is a constituent. Call check variable routine on the + ! relevant index of the constituent array + field_data_ptr => cam_advected_constituents_array() + call check_field(file, [ccpp_required_data(req_idx)], 'lev', timestep, & + field_data_ptr(:,:,constituent_idx), ccpp_required_data(req_idx), & + min_difference, min_relative_value, is_first) + else + ! The required variable is not a constituent. Check if the variable was read from + ! a file + ! Find IC file input name array index for required variable: + call is_read_from_file(ccpp_required_data(req_idx), is_read, & + stdnam_idx_out=name_idx) + if (.not. is_read) then + cycle + end if + ! Check variable vs input check file: + + select case (trim(phys_var_stdnames(name_idx))) case ('potential_temperature') call check_field(file, input_var_names(:,name_idx), 'lev', timestep, theta, & 'potential_temperature', min_difference, min_relative_value, is_first) @@ -255,7 +291,8 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, call check_field(file, input_var_names(:,name_idx), timestep, slp, & 'air_pressure_at_sea_level', min_difference, min_relative_value, is_first) - end select !check variables + end select !check variables + end if !check if constituent end do !Suite-required variables ! Deallocate required variables array for use in next suite: @@ -268,12 +305,16 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, deallocate(file) nullify(file) if (is_first) then + if (masterproc) then + write(iulog,*) '' + write(iulog,*) 'No differences found!' + end if + end if + if (masterproc) then + write(iulog,*) '' + write(iulog,*) '********** End Physics Check Data Results **********' write(iulog,*) '' - write(iulog,*) 'No differences found!' end if - write(iulog,*) '' - write(iulog,*) '********** End Physics Check Data Results **********' - write(iulog,*) '' end subroutine physics_check_data end module physics_inputs_mf diff --git a/test/unit/sample_files/write_init_files/physics_inputs_no_horiz.F90 b/test/unit/sample_files/write_init_files/physics_inputs_no_horiz.F90 index ded3ccbe..49f3453c 100644 --- a/test/unit/sample_files/write_init_files/physics_inputs_no_horiz.F90 +++ b/test/unit/sample_files/write_init_files/physics_inputs_no_horiz.F90 @@ -33,8 +33,10 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia use cam_abortutils, only: endrun use shr_kind_mod, only: SHR_KIND_CS, SHR_KIND_CL, SHR_KIND_CX use physics_data, only: read_field, find_input_name_idx, no_exist_idx - use physics_data, only: init_mark_idx, prot_no_init_idx + use physics_data, only: init_mark_idx, prot_no_init_idx, const_idx use cam_ccpp_cap, only: ccpp_physics_suite_variables + use cam_ccpp_cap, only: cam_constituents_array + use ccpp_kinds, only: kind_phys use phys_vars_init_check_no_horiz, only: phys_var_stdnames, input_var_names, std_name_len use physics_types_no_horiz, only: slp, theta @@ -53,14 +55,16 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia character(len=SHR_KIND_CL) :: missing_required_vars character(len=SHR_KIND_CL) :: protected_non_init_vars - character(len=SHR_KIND_CX) :: errmsg !CCPP framework error message - integer :: errflg !CCPP framework error flag - integer :: name_idx !Input variable array index - integer :: req_idx !Required variable array index - integer :: suite_idx !Suite array index - character(len=2) :: sep = '' !String separator used to print error messages - character(len=2) :: sep2 = '' !String separator used to print error messages - character(len=2) :: sep3 = '' !String separator used to print error messages + character(len=SHR_KIND_CX) :: errmsg !CCPP framework error message + integer :: errflg !CCPP framework error flag + integer :: name_idx !Input variable array index + integer :: constituent_idx !Constituent table index + integer :: req_idx !Required variable array index + integer :: suite_idx !Suite array index + character(len=2) :: sep !String separator used to print err messages + character(len=2) :: sep2 !String separator used to print err messages + character(len=2) :: sep3 !String separator used to print err messages + real(kind=kind_phys), pointer :: field_data_ptr(:,:,:) ! Logical to default optional argument to False: logical :: use_init_variables @@ -68,6 +72,9 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia ! Initalize missing and non-initialized variables strings: missing_required_vars = ' ' protected_non_init_vars = ' ' + sep = '' + sep2 = '' + sep3 = '' ! Initialize use_init_variables based on whether it was input to function: if (present(read_initialized_variables)) then @@ -88,7 +95,8 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia do req_idx = 1, size(ccpp_required_data, 1) ! Find IC file input name array index for required variable: - name_idx = find_input_name_idx(ccpp_required_data(req_idx), use_init_variables) + name_idx = find_input_name_idx(ccpp_required_data(req_idx), use_init_variables, & + constituent_idx) ! Check for special index values: select case (name_idx) @@ -118,6 +126,15 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia ! Update character separator to now include comma: sep2 = ', ' + case (const_idx) + + ! If an index was found in the constituent hash table, then read in the data + ! to that index of the constituent array + + field_data_ptr => cam_constituents_array() + call read_field(file, ccpp_required_data(req_idx), & + [ccpp_required_data(req_idx)], 'lev', timestep, & + field_data_ptr(:,:,constituent_idx), mark_as_read=.false.) case default ! Read variable from IC file: @@ -162,8 +179,10 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, use cam_abortutils, only: endrun use shr_kind_mod, only: SHR_KIND_CS, SHR_KIND_CL, SHR_KIND_CX use physics_data, only: check_field, find_input_name_idx, no_exist_idx - use physics_data, only: init_mark_idx, prot_no_init_idx + use physics_data, only: init_mark_idx, prot_no_init_idx, const_idx use cam_ccpp_cap, only: ccpp_physics_suite_variables + use cam_ccpp_cap, only: cam_advected_constituents_array + use cam_constituents, only: const_get_index use ccpp_kinds, only: kind_phys use cam_logfile, only: iulog use spmd_utils, only: masterproc @@ -193,12 +212,15 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, character(len=SHR_KIND_CX) :: errmsg !CCPP framework error message integer :: errflg !CCPP framework error flag integer :: name_idx !Input variable array index + integer :: constituent_idx !Index of variable in constituent array integer :: req_idx !Required variable array index integer :: suite_idx !Suite array index character(len=SHR_KIND_CL) :: ncdata_check_loc type(file_desc_t), pointer :: file logical :: file_found logical :: is_first + logical :: is_read + real(kind=kind_phys), pointer :: field_data_ptr(:,:,:) ! Initalize missing and non-initialized variables strings: missing_required_vars = ' ' @@ -239,13 +261,28 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, ! Loop over all required variables as specified by CCPP suite: do req_idx = 1, size(ccpp_required_data, 1) - ! Find IC file input name array index for required variable: - if (.not. is_read_from_file(ccpp_required_data(req_idx), name_idx)) then - continue - end if - ! Check variable vs input check file: - - select case (trim(phys_var_stdnames(name_idx))) + ! First check if the required variable is a constituent: + call const_get_index(ccpp_required_data(req_idx), constituent_idx, abort=.false., & + warning=.false.) + if (constituent_idx > -1) then + ! The required variable is a constituent. Call check variable routine on the + ! relevant index of the constituent array + field_data_ptr => cam_advected_constituents_array() + call check_field(file, [ccpp_required_data(req_idx)], 'lev', timestep, & + field_data_ptr(:,:,constituent_idx), ccpp_required_data(req_idx), & + min_difference, min_relative_value, is_first) + else + ! The required variable is not a constituent. Check if the variable was read from + ! a file + ! Find IC file input name array index for required variable: + call is_read_from_file(ccpp_required_data(req_idx), is_read, & + stdnam_idx_out=name_idx) + if (.not. is_read) then + cycle + end if + ! Check variable vs input check file: + + select case (trim(phys_var_stdnames(name_idx))) case ('potential_temperature') call check_field(file, input_var_names(:,name_idx), 'lev', timestep, theta, & 'potential_temperature', min_difference, min_relative_value, is_first) @@ -253,7 +290,8 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, case ('air_pressure_at_sea_level') call endrun('Cannot check status of slp'//', slp has no horizontal dimension') - end select !check variables + end select !check variables + end if !check if constituent end do !Suite-required variables ! Deallocate required variables array for use in next suite: @@ -266,12 +304,16 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, deallocate(file) nullify(file) if (is_first) then + if (masterproc) then + write(iulog,*) '' + write(iulog,*) 'No differences found!' + end if + end if + if (masterproc) then + write(iulog,*) '' + write(iulog,*) '********** End Physics Check Data Results **********' write(iulog,*) '' - write(iulog,*) 'No differences found!' end if - write(iulog,*) '' - write(iulog,*) '********** End Physics Check Data Results **********' - write(iulog,*) '' end subroutine physics_check_data end module physics_inputs_no_horiz diff --git a/test/unit/sample_files/write_init_files/physics_inputs_noreq.F90 b/test/unit/sample_files/write_init_files/physics_inputs_noreq.F90 index 71610475..f398a22b 100644 --- a/test/unit/sample_files/write_init_files/physics_inputs_noreq.F90 +++ b/test/unit/sample_files/write_init_files/physics_inputs_noreq.F90 @@ -33,8 +33,9 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia use cam_abortutils, only: endrun use shr_kind_mod, only: SHR_KIND_CS, SHR_KIND_CL, SHR_KIND_CX use physics_data, only: read_field, find_input_name_idx, no_exist_idx - use physics_data, only: init_mark_idx, prot_no_init_idx - use cam_ccpp_cap, only: ccpp_physics_suite_variables + use physics_data, only: init_mark_idx, prot_no_init_idx, const_idx + use cam_ccpp_cap, only: ccpp_physics_suite_variables, cam_constituents_array + use ccpp_kinds, only: kind_phys use phys_vars_init_check_noreq, only: phys_var_stdnames, input_var_names, std_name_len ! Dummy arguments @@ -52,14 +53,16 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia character(len=SHR_KIND_CL) :: missing_required_vars character(len=SHR_KIND_CL) :: protected_non_init_vars - character(len=SHR_KIND_CX) :: errmsg !CCPP framework error message - integer :: errflg !CCPP framework error flag - integer :: name_idx !Input variable array index - integer :: req_idx !Required variable array index - integer :: suite_idx !Suite array index - character(len=2) :: sep = '' !String separator used to print error messages - character(len=2) :: sep2 = '' !String separator used to print error messages - character(len=2) :: sep3 = '' !String separator used to print error messages + character(len=SHR_KIND_CX) :: errmsg !CCPP framework error message + integer :: errflg !CCPP framework error flag + integer :: name_idx !Input variable array index + integer :: constituent_idx !Constituent table index + integer :: req_idx !Required variable array index + integer :: suite_idx !Suite array index + character(len=2) :: sep !String separator used to print err messages + character(len=2) :: sep2 !String separator used to print err messages + character(len=2) :: sep3 !String separator used to print err messages + real(kind=kind_phys), pointer :: field_data_ptr(:,:,:) ! Logical to default optional argument to False: logical :: use_init_variables @@ -67,6 +70,9 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia ! Initalize missing and non-initialized variables strings: missing_required_vars = ' ' protected_non_init_vars = ' ' + sep = '' + sep2 = '' + sep3 = '' ! Initialize use_init_variables based on whether it was input to function: if (present(read_initialized_variables)) then @@ -87,7 +93,8 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia do req_idx = 1, size(ccpp_required_data, 1) ! Find IC file input name array index for required variable: - name_idx = find_input_name_idx(ccpp_required_data(req_idx), use_init_variables) + name_idx = find_input_name_idx(ccpp_required_data(req_idx), use_init_variables, & + constituent_idx) ! Check for special index values: select case (name_idx) @@ -117,6 +124,15 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia ! Update character separator to now include comma: sep2 = ', ' + case (const_idx) + + ! If an index was found in the constituent hash table, then read in the data + ! to that index of the constituent array + + field_data_ptr => cam_constituents_array() + call read_field(file, ccpp_required_data(req_idx), & + [ccpp_required_data(req_idx)], 'lev', timestep, & + field_data_ptr(:,:,constituent_idx), mark_as_read=.false.) case default ! Read variable from IC file: @@ -152,8 +168,10 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, use cam_abortutils, only: endrun use shr_kind_mod, only: SHR_KIND_CS, SHR_KIND_CL, SHR_KIND_CX use physics_data, only: check_field, find_input_name_idx, no_exist_idx - use physics_data, only: init_mark_idx, prot_no_init_idx + use physics_data, only: init_mark_idx, prot_no_init_idx, const_idx use cam_ccpp_cap, only: ccpp_physics_suite_variables + use cam_ccpp_cap, only: cam_advected_constituents_array + use cam_constituents, only: const_get_index use ccpp_kinds, only: kind_phys use cam_logfile, only: iulog use spmd_utils, only: masterproc @@ -182,12 +200,15 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, character(len=SHR_KIND_CX) :: errmsg !CCPP framework error message integer :: errflg !CCPP framework error flag integer :: name_idx !Input variable array index + integer :: constituent_idx !Index of variable in constituent array integer :: req_idx !Required variable array index integer :: suite_idx !Suite array index character(len=SHR_KIND_CL) :: ncdata_check_loc type(file_desc_t), pointer :: file logical :: file_found logical :: is_first + logical :: is_read + real(kind=kind_phys), pointer :: field_data_ptr(:,:,:) ! Initalize missing and non-initialized variables strings: missing_required_vars = ' ' @@ -228,14 +249,30 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, ! Loop over all required variables as specified by CCPP suite: do req_idx = 1, size(ccpp_required_data, 1) - ! Find IC file input name array index for required variable: - if (.not. is_read_from_file(ccpp_required_data(req_idx), name_idx)) then - continue - end if - ! Check variable vs input check file: - - select case (trim(phys_var_stdnames(name_idx))) - end select !check variables + ! First check if the required variable is a constituent: + call const_get_index(ccpp_required_data(req_idx), constituent_idx, abort=.false., & + warning=.false.) + if (constituent_idx > -1) then + ! The required variable is a constituent. Call check variable routine on the + ! relevant index of the constituent array + field_data_ptr => cam_advected_constituents_array() + call check_field(file, [ccpp_required_data(req_idx)], 'lev', timestep, & + field_data_ptr(:,:,constituent_idx), ccpp_required_data(req_idx), & + min_difference, min_relative_value, is_first) + else + ! The required variable is not a constituent. Check if the variable was read from + ! a file + ! Find IC file input name array index for required variable: + call is_read_from_file(ccpp_required_data(req_idx), is_read, & + stdnam_idx_out=name_idx) + if (.not. is_read) then + cycle + end if + ! Check variable vs input check file: + + select case (trim(phys_var_stdnames(name_idx))) + end select !check variables + end if !check if constituent end do !Suite-required variables ! Deallocate required variables array for use in next suite: @@ -248,12 +285,16 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, deallocate(file) nullify(file) if (is_first) then + if (masterproc) then + write(iulog,*) '' + write(iulog,*) 'No differences found!' + end if + end if + if (masterproc) then + write(iulog,*) '' + write(iulog,*) '********** End Physics Check Data Results **********' write(iulog,*) '' - write(iulog,*) 'No differences found!' end if - write(iulog,*) '' - write(iulog,*) '********** End Physics Check Data Results **********' - write(iulog,*) '' end subroutine physics_check_data end module physics_inputs_noreq diff --git a/test/unit/sample_files/write_init_files/physics_inputs_param.F90 b/test/unit/sample_files/write_init_files/physics_inputs_param.F90 index f6cd8592..83f6ef05 100644 --- a/test/unit/sample_files/write_init_files/physics_inputs_param.F90 +++ b/test/unit/sample_files/write_init_files/physics_inputs_param.F90 @@ -33,8 +33,9 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia use cam_abortutils, only: endrun use shr_kind_mod, only: SHR_KIND_CS, SHR_KIND_CL, SHR_KIND_CX use physics_data, only: read_field, find_input_name_idx, no_exist_idx - use physics_data, only: init_mark_idx, prot_no_init_idx - use cam_ccpp_cap, only: ccpp_physics_suite_variables + use physics_data, only: init_mark_idx, prot_no_init_idx, const_idx + use cam_ccpp_cap, only: ccpp_physics_suite_variables, cam_constituents_array + use ccpp_kinds, only: kind_phys use phys_vars_init_check_param, only: phys_var_stdnames, input_var_names, std_name_len use physics_types_param, only: g, slp, theta @@ -53,14 +54,16 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia character(len=SHR_KIND_CL) :: missing_required_vars character(len=SHR_KIND_CL) :: protected_non_init_vars - character(len=SHR_KIND_CX) :: errmsg !CCPP framework error message - integer :: errflg !CCPP framework error flag - integer :: name_idx !Input variable array index - integer :: req_idx !Required variable array index - integer :: suite_idx !Suite array index - character(len=2) :: sep = '' !String separator used to print error messages - character(len=2) :: sep2 = '' !String separator used to print error messages - character(len=2) :: sep3 = '' !String separator used to print error messages + character(len=SHR_KIND_CX) :: errmsg !CCPP framework error message + integer :: errflg !CCPP framework error flag + integer :: name_idx !Input variable array index + integer :: constituent_idx !Constituent table index + integer :: req_idx !Required variable array index + integer :: suite_idx !Suite array index + character(len=2) :: sep !String separator used to print err messages + character(len=2) :: sep2 !String separator used to print err messages + character(len=2) :: sep3 !String separator used to print err messages + real(kind=kind_phys), pointer :: field_data_ptr(:,:,:) ! Logical to default optional argument to False: logical :: use_init_variables @@ -68,6 +71,9 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia ! Initalize missing and non-initialized variables strings: missing_required_vars = ' ' protected_non_init_vars = ' ' + sep = '' + sep2 = '' + sep3 = '' ! Initialize use_init_variables based on whether it was input to function: if (present(read_initialized_variables)) then @@ -88,7 +94,8 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia do req_idx = 1, size(ccpp_required_data, 1) ! Find IC file input name array index for required variable: - name_idx = find_input_name_idx(ccpp_required_data(req_idx), use_init_variables) + name_idx = find_input_name_idx(ccpp_required_data(req_idx), use_init_variables, & + constituent_idx) ! Check for special index values: select case (name_idx) @@ -118,6 +125,15 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia ! Update character separator to now include comma: sep2 = ', ' + case (const_idx) + + ! If an index was found in the constituent hash table, then read in the data + ! to that index of the constituent array + + field_data_ptr => cam_constituents_array() + call read_field(file, ccpp_required_data(req_idx), & + [ccpp_required_data(req_idx)], 'lev', timestep, & + field_data_ptr(:,:,constituent_idx), mark_as_read=.false.) case default ! Read variable from IC file: @@ -166,8 +182,10 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, use cam_abortutils, only: endrun use shr_kind_mod, only: SHR_KIND_CS, SHR_KIND_CL, SHR_KIND_CX use physics_data, only: check_field, find_input_name_idx, no_exist_idx - use physics_data, only: init_mark_idx, prot_no_init_idx + use physics_data, only: init_mark_idx, prot_no_init_idx, const_idx use cam_ccpp_cap, only: ccpp_physics_suite_variables + use cam_ccpp_cap, only: cam_advected_constituents_array + use cam_constituents, only: const_get_index use ccpp_kinds, only: kind_phys use cam_logfile, only: iulog use spmd_utils, only: masterproc @@ -197,12 +215,15 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, character(len=SHR_KIND_CX) :: errmsg !CCPP framework error message integer :: errflg !CCPP framework error flag integer :: name_idx !Input variable array index + integer :: constituent_idx !Index of variable in constituent array integer :: req_idx !Required variable array index integer :: suite_idx !Suite array index character(len=SHR_KIND_CL) :: ncdata_check_loc type(file_desc_t), pointer :: file logical :: file_found logical :: is_first + logical :: is_read + real(kind=kind_phys), pointer :: field_data_ptr(:,:,:) ! Initalize missing and non-initialized variables strings: missing_required_vars = ' ' @@ -243,13 +264,28 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, ! Loop over all required variables as specified by CCPP suite: do req_idx = 1, size(ccpp_required_data, 1) - ! Find IC file input name array index for required variable: - if (.not. is_read_from_file(ccpp_required_data(req_idx), name_idx)) then - continue - end if - ! Check variable vs input check file: - - select case (trim(phys_var_stdnames(name_idx))) + ! First check if the required variable is a constituent: + call const_get_index(ccpp_required_data(req_idx), constituent_idx, abort=.false., & + warning=.false.) + if (constituent_idx > -1) then + ! The required variable is a constituent. Call check variable routine on the + ! relevant index of the constituent array + field_data_ptr => cam_advected_constituents_array() + call check_field(file, [ccpp_required_data(req_idx)], 'lev', timestep, & + field_data_ptr(:,:,constituent_idx), ccpp_required_data(req_idx), & + min_difference, min_relative_value, is_first) + else + ! The required variable is not a constituent. Check if the variable was read from + ! a file + ! Find IC file input name array index for required variable: + call is_read_from_file(ccpp_required_data(req_idx), is_read, & + stdnam_idx_out=name_idx) + if (.not. is_read) then + cycle + end if + ! Check variable vs input check file: + + select case (trim(phys_var_stdnames(name_idx))) case ('potential_temperature') call check_field(file, input_var_names(:,name_idx), 'lev', timestep, theta, & 'potential_temperature', min_difference, min_relative_value, is_first) @@ -261,7 +297,8 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, case ('gravitational_acceleration') call endrun('Cannot check status of g'//', g has no horizontal dimension') - end select !check variables + end select !check variables + end if !check if constituent end do !Suite-required variables ! Deallocate required variables array for use in next suite: @@ -274,12 +311,16 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, deallocate(file) nullify(file) if (is_first) then + if (masterproc) then + write(iulog,*) '' + write(iulog,*) 'No differences found!' + end if + end if + if (masterproc) then + write(iulog,*) '' + write(iulog,*) '********** End Physics Check Data Results **********' write(iulog,*) '' - write(iulog,*) 'No differences found!' end if - write(iulog,*) '' - write(iulog,*) '********** End Physics Check Data Results **********' - write(iulog,*) '' end subroutine physics_check_data end module physics_inputs_param diff --git a/test/unit/sample_files/write_init_files/physics_inputs_protect.F90 b/test/unit/sample_files/write_init_files/physics_inputs_protect.F90 index 0083b8ba..cfc9417e 100644 --- a/test/unit/sample_files/write_init_files/physics_inputs_protect.F90 +++ b/test/unit/sample_files/write_init_files/physics_inputs_protect.F90 @@ -33,8 +33,10 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia use cam_abortutils, only: endrun use shr_kind_mod, only: SHR_KIND_CS, SHR_KIND_CL, SHR_KIND_CX use physics_data, only: read_field, find_input_name_idx, no_exist_idx - use physics_data, only: init_mark_idx, prot_no_init_idx + use physics_data, only: init_mark_idx, prot_no_init_idx, const_idx use cam_ccpp_cap, only: ccpp_physics_suite_variables + use cam_ccpp_cap, only: cam_constituents_array + use ccpp_kinds, only: kind_phys use phys_vars_init_check_protect, only: phys_var_stdnames, input_var_names, std_name_len use physics_types_protected, only: slp, theta @@ -53,14 +55,16 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia character(len=SHR_KIND_CL) :: missing_required_vars character(len=SHR_KIND_CL) :: protected_non_init_vars - character(len=SHR_KIND_CX) :: errmsg !CCPP framework error message - integer :: errflg !CCPP framework error flag - integer :: name_idx !Input variable array index - integer :: req_idx !Required variable array index - integer :: suite_idx !Suite array index - character(len=2) :: sep = '' !String separator used to print error messages - character(len=2) :: sep2 = '' !String separator used to print error messages - character(len=2) :: sep3 = '' !String separator used to print error messages + character(len=SHR_KIND_CX) :: errmsg !CCPP framework error message + integer :: errflg !CCPP framework error flag + integer :: name_idx !Input variable array index + integer :: constituent_idx !Constituent table index + integer :: req_idx !Required variable array index + integer :: suite_idx !Suite array index + character(len=2) :: sep !String separator used to print err messages + character(len=2) :: sep2 !String separator used to print err messages + character(len=2) :: sep3 !String separator used to print err messages + real(kind=kind_phys), pointer :: field_data_ptr(:,:,:) ! Logical to default optional argument to False: logical :: use_init_variables @@ -68,6 +72,9 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia ! Initalize missing and non-initialized variables strings: missing_required_vars = ' ' protected_non_init_vars = ' ' + sep = '' + sep2 = '' + sep3 = '' ! Initialize use_init_variables based on whether it was input to function: if (present(read_initialized_variables)) then @@ -88,7 +95,8 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia do req_idx = 1, size(ccpp_required_data, 1) ! Find IC file input name array index for required variable: - name_idx = find_input_name_idx(ccpp_required_data(req_idx), use_init_variables) + name_idx = find_input_name_idx(ccpp_required_data(req_idx), use_init_variables, & + constituent_idx) ! Check for special index values: select case (name_idx) @@ -118,6 +126,15 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia ! Update character separator to now include comma: sep2 = ', ' + case (const_idx) + + ! If an index was found in the constituent hash table, then read in the data + ! to that index of the constituent array + + field_data_ptr => cam_constituents_array() + call read_field(file, ccpp_required_data(req_idx), & + [ccpp_required_data(req_idx)], 'lev', timestep, & + field_data_ptr(:,:,constituent_idx), mark_as_read=.false.) case default ! Read variable from IC file: @@ -162,8 +179,10 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, use cam_abortutils, only: endrun use shr_kind_mod, only: SHR_KIND_CS, SHR_KIND_CL, SHR_KIND_CX use physics_data, only: check_field, find_input_name_idx, no_exist_idx - use physics_data, only: init_mark_idx, prot_no_init_idx + use physics_data, only: init_mark_idx, prot_no_init_idx, const_idx use cam_ccpp_cap, only: ccpp_physics_suite_variables + use cam_ccpp_cap, only: cam_advected_constituents_array + use cam_constituents, only: const_get_index use ccpp_kinds, only: kind_phys use cam_logfile, only: iulog use spmd_utils, only: masterproc @@ -193,12 +212,15 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, character(len=SHR_KIND_CX) :: errmsg !CCPP framework error message integer :: errflg !CCPP framework error flag integer :: name_idx !Input variable array index + integer :: constituent_idx !Index of variable in constituent array integer :: req_idx !Required variable array index integer :: suite_idx !Suite array index character(len=SHR_KIND_CL) :: ncdata_check_loc type(file_desc_t), pointer :: file logical :: file_found logical :: is_first + logical :: is_read + real(kind=kind_phys), pointer :: field_data_ptr(:,:,:) ! Initalize missing and non-initialized variables strings: missing_required_vars = ' ' @@ -239,13 +261,28 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, ! Loop over all required variables as specified by CCPP suite: do req_idx = 1, size(ccpp_required_data, 1) - ! Find IC file input name array index for required variable: - if (.not. is_read_from_file(ccpp_required_data(req_idx), name_idx)) then - continue - end if - ! Check variable vs input check file: - - select case (trim(phys_var_stdnames(name_idx))) + ! First check if the required variable is a constituent: + call const_get_index(ccpp_required_data(req_idx), constituent_idx, abort=.false., & + warning=.false.) + if (constituent_idx > -1) then + ! The required variable is a constituent. Call check variable routine on the + ! relevant index of the constituent array + field_data_ptr => cam_advected_constituents_array() + call check_field(file, [ccpp_required_data(req_idx)], 'lev', timestep, & + field_data_ptr(:,:,constituent_idx), ccpp_required_data(req_idx), & + min_difference, min_relative_value, is_first) + else + ! The required variable is not a constituent. Check if the variable was read from + ! a file + ! Find IC file input name array index for required variable: + call is_read_from_file(ccpp_required_data(req_idx), is_read, & + stdnam_idx_out=name_idx) + if (.not. is_read) then + cycle + end if + ! Check variable vs input check file: + + select case (trim(phys_var_stdnames(name_idx))) case ('potential_temperature') call check_field(file, input_var_names(:,name_idx), 'lev', timestep, theta, & 'potential_temperature', min_difference, min_relative_value, is_first) @@ -254,7 +291,8 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, call check_field(file, input_var_names(:,name_idx), timestep, slp, & 'air_pressure_at_sea_level', min_difference, min_relative_value, is_first) - end select !check variables + end select !check variables + end if !check if constituent end do !Suite-required variables ! Deallocate required variables array for use in next suite: @@ -267,12 +305,16 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, deallocate(file) nullify(file) if (is_first) then + if (masterproc) then + write(iulog,*) '' + write(iulog,*) 'No differences found!' + end if + end if + if (masterproc) then + write(iulog,*) '' + write(iulog,*) '********** End Physics Check Data Results **********' write(iulog,*) '' - write(iulog,*) 'No differences found!' end if - write(iulog,*) '' - write(iulog,*) '********** End Physics Check Data Results **********' - write(iulog,*) '' end subroutine physics_check_data end module physics_inputs_protect diff --git a/test/unit/sample_files/write_init_files/physics_inputs_scalar.F90 b/test/unit/sample_files/write_init_files/physics_inputs_scalar.F90 index 02cc4894..b210038c 100644 --- a/test/unit/sample_files/write_init_files/physics_inputs_scalar.F90 +++ b/test/unit/sample_files/write_init_files/physics_inputs_scalar.F90 @@ -33,8 +33,9 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia use cam_abortutils, only: endrun use shr_kind_mod, only: SHR_KIND_CS, SHR_KIND_CL, SHR_KIND_CX use physics_data, only: read_field, find_input_name_idx, no_exist_idx - use physics_data, only: init_mark_idx, prot_no_init_idx - use cam_ccpp_cap, only: ccpp_physics_suite_variables + use physics_data, only: init_mark_idx, prot_no_init_idx, const_idx + use cam_ccpp_cap, only: ccpp_physics_suite_variables, cam_constituents_array + use ccpp_kinds, only: kind_phys use phys_vars_init_check_scalar, only: phys_var_stdnames, input_var_names, std_name_len use physics_types_scalar_var, only: slp, theta @@ -53,14 +54,16 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia character(len=SHR_KIND_CL) :: missing_required_vars character(len=SHR_KIND_CL) :: protected_non_init_vars - character(len=SHR_KIND_CX) :: errmsg !CCPP framework error message - integer :: errflg !CCPP framework error flag - integer :: name_idx !Input variable array index - integer :: req_idx !Required variable array index - integer :: suite_idx !Suite array index - character(len=2) :: sep = '' !String separator used to print error messages - character(len=2) :: sep2 = '' !String separator used to print error messages - character(len=2) :: sep3 = '' !String separator used to print error messages + character(len=SHR_KIND_CX) :: errmsg !CCPP framework error message + integer :: errflg !CCPP framework error flag + integer :: name_idx !Input variable array index + integer :: constituent_idx !Constituent table index + integer :: req_idx !Required variable array index + integer :: suite_idx !Suite array index + character(len=2) :: sep !String separator used to print err messages + character(len=2) :: sep2 !String separator used to print err messages + character(len=2) :: sep3 !String separator used to print err messages + real(kind=kind_phys), pointer :: field_data_ptr(:,:,:) ! Logical to default optional argument to False: logical :: use_init_variables @@ -68,6 +71,9 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia ! Initalize missing and non-initialized variables strings: missing_required_vars = ' ' protected_non_init_vars = ' ' + sep = '' + sep2 = '' + sep3 = '' ! Initialize use_init_variables based on whether it was input to function: if (present(read_initialized_variables)) then @@ -88,7 +94,8 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia do req_idx = 1, size(ccpp_required_data, 1) ! Find IC file input name array index for required variable: - name_idx = find_input_name_idx(ccpp_required_data(req_idx), use_init_variables) + name_idx = find_input_name_idx(ccpp_required_data(req_idx), use_init_variables, & + constituent_idx) ! Check for special index values: select case (name_idx) @@ -118,6 +125,15 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia ! Update character separator to now include comma: sep2 = ', ' + case (const_idx) + + ! If an index was found in the constituent hash table, then read in the data + ! to that index of the constituent array + + field_data_ptr => cam_constituents_array() + call read_field(file, ccpp_required_data(req_idx), & + [ccpp_required_data(req_idx)], 'lev', timestep, & + field_data_ptr(:,:,constituent_idx), mark_as_read=.false.) case default ! Read variable from IC file: @@ -162,8 +178,10 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, use cam_abortutils, only: endrun use shr_kind_mod, only: SHR_KIND_CS, SHR_KIND_CL, SHR_KIND_CX use physics_data, only: check_field, find_input_name_idx, no_exist_idx - use physics_data, only: init_mark_idx, prot_no_init_idx + use physics_data, only: init_mark_idx, prot_no_init_idx, const_idx use cam_ccpp_cap, only: ccpp_physics_suite_variables + use cam_ccpp_cap, only: cam_advected_constituents_array + use cam_constituents, only: const_get_index use ccpp_kinds, only: kind_phys use cam_logfile, only: iulog use spmd_utils, only: masterproc @@ -193,12 +211,15 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, character(len=SHR_KIND_CX) :: errmsg !CCPP framework error message integer :: errflg !CCPP framework error flag integer :: name_idx !Input variable array index + integer :: constituent_idx !Index of variable in constituent array integer :: req_idx !Required variable array index integer :: suite_idx !Suite array index character(len=SHR_KIND_CL) :: ncdata_check_loc type(file_desc_t), pointer :: file logical :: file_found logical :: is_first + logical :: is_read + real(kind=kind_phys), pointer :: field_data_ptr(:,:,:) ! Initalize missing and non-initialized variables strings: missing_required_vars = ' ' @@ -239,13 +260,28 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, ! Loop over all required variables as specified by CCPP suite: do req_idx = 1, size(ccpp_required_data, 1) - ! Find IC file input name array index for required variable: - if (.not. is_read_from_file(ccpp_required_data(req_idx), name_idx)) then - continue - end if - ! Check variable vs input check file: - - select case (trim(phys_var_stdnames(name_idx))) + ! First check if the required variable is a constituent: + call const_get_index(ccpp_required_data(req_idx), constituent_idx, abort=.false., & + warning=.false.) + if (constituent_idx > -1) then + ! The required variable is a constituent. Call check variable routine on the + ! relevant index of the constituent array + field_data_ptr => cam_advected_constituents_array() + call check_field(file, [ccpp_required_data(req_idx)], 'lev', timestep, & + field_data_ptr(:,:,constituent_idx), ccpp_required_data(req_idx), & + min_difference, min_relative_value, is_first) + else + ! The required variable is not a constituent. Check if the variable was read from + ! a file + ! Find IC file input name array index for required variable: + call is_read_from_file(ccpp_required_data(req_idx), is_read, & + stdnam_idx_out=name_idx) + if (.not. is_read) then + cycle + end if + ! Check variable vs input check file: + + select case (trim(phys_var_stdnames(name_idx))) case ('potential_temperature') call check_field(file, input_var_names(:,name_idx), 'lev', timestep, theta, & 'potential_temperature', min_difference, min_relative_value, is_first) @@ -253,7 +289,8 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, case ('air_pressure_at_sea_level') call endrun('Cannot check status of slp'//', slp has no horizontal dimension') - end select !check variables + end select !check variables + end if !check if constituent end do !Suite-required variables ! Deallocate required variables array for use in next suite: @@ -266,12 +303,16 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, deallocate(file) nullify(file) if (is_first) then + if (masterproc) then + write(iulog,*) '' + write(iulog,*) 'No differences found!' + end if + end if + if (masterproc) then + write(iulog,*) '' + write(iulog,*) '********** End Physics Check Data Results **********' write(iulog,*) '' - write(iulog,*) 'No differences found!' end if - write(iulog,*) '' - write(iulog,*) '********** End Physics Check Data Results **********' - write(iulog,*) '' end subroutine physics_check_data end module physics_inputs_scalar diff --git a/test/unit/sample_files/write_init_files/physics_inputs_simple.F90 b/test/unit/sample_files/write_init_files/physics_inputs_simple.F90 index e78441dd..2482391a 100644 --- a/test/unit/sample_files/write_init_files/physics_inputs_simple.F90 +++ b/test/unit/sample_files/write_init_files/physics_inputs_simple.F90 @@ -33,8 +33,9 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia use cam_abortutils, only: endrun use shr_kind_mod, only: SHR_KIND_CS, SHR_KIND_CL, SHR_KIND_CX use physics_data, only: read_field, find_input_name_idx, no_exist_idx - use physics_data, only: init_mark_idx, prot_no_init_idx - use cam_ccpp_cap, only: ccpp_physics_suite_variables + use physics_data, only: init_mark_idx, prot_no_init_idx, const_idx + use cam_ccpp_cap, only: ccpp_physics_suite_variables, cam_constituents_array + use ccpp_kinds, only: kind_phys use phys_vars_init_check_simple, only: phys_var_stdnames, input_var_names, std_name_len use physics_types_simple, only: slp, theta @@ -53,14 +54,16 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia character(len=SHR_KIND_CL) :: missing_required_vars character(len=SHR_KIND_CL) :: protected_non_init_vars - character(len=SHR_KIND_CX) :: errmsg !CCPP framework error message - integer :: errflg !CCPP framework error flag - integer :: name_idx !Input variable array index - integer :: req_idx !Required variable array index - integer :: suite_idx !Suite array index - character(len=2) :: sep = '' !String separator used to print error messages - character(len=2) :: sep2 = '' !String separator used to print error messages - character(len=2) :: sep3 = '' !String separator used to print error messages + character(len=SHR_KIND_CX) :: errmsg !CCPP framework error message + integer :: errflg !CCPP framework error flag + integer :: name_idx !Input variable array index + integer :: constituent_idx !Constituent table index + integer :: req_idx !Required variable array index + integer :: suite_idx !Suite array index + character(len=2) :: sep !String separator used to print err messages + character(len=2) :: sep2 !String separator used to print err messages + character(len=2) :: sep3 !String separator used to print err messages + real(kind=kind_phys), pointer :: field_data_ptr(:,:,:) ! Logical to default optional argument to False: logical :: use_init_variables @@ -68,6 +71,9 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia ! Initalize missing and non-initialized variables strings: missing_required_vars = ' ' protected_non_init_vars = ' ' + sep = '' + sep2 = '' + sep3 = '' ! Initialize use_init_variables based on whether it was input to function: if (present(read_initialized_variables)) then @@ -88,7 +94,8 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia do req_idx = 1, size(ccpp_required_data, 1) ! Find IC file input name array index for required variable: - name_idx = find_input_name_idx(ccpp_required_data(req_idx), use_init_variables) + name_idx = find_input_name_idx(ccpp_required_data(req_idx), use_init_variables, & + constituent_idx) ! Check for special index values: select case (name_idx) @@ -118,6 +125,15 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia ! Update character separator to now include comma: sep2 = ', ' + case (const_idx) + + ! If an index was found in the constituent hash table, then read in the data + ! to that index of the constituent array + + field_data_ptr => cam_constituents_array() + call read_field(file, ccpp_required_data(req_idx), & + [ccpp_required_data(req_idx)], 'lev', timestep, & + field_data_ptr(:,:,constituent_idx), mark_as_read=.false.) case default ! Read variable from IC file: @@ -161,8 +177,10 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, use cam_abortutils, only: endrun use shr_kind_mod, only: SHR_KIND_CS, SHR_KIND_CL, SHR_KIND_CX use physics_data, only: check_field, find_input_name_idx, no_exist_idx - use physics_data, only: init_mark_idx, prot_no_init_idx + use physics_data, only: init_mark_idx, prot_no_init_idx, const_idx use cam_ccpp_cap, only: ccpp_physics_suite_variables + use cam_ccpp_cap, only: cam_advected_constituents_array + use cam_constituents, only: const_get_index use ccpp_kinds, only: kind_phys use cam_logfile, only: iulog use spmd_utils, only: masterproc @@ -192,12 +210,15 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, character(len=SHR_KIND_CX) :: errmsg !CCPP framework error message integer :: errflg !CCPP framework error flag integer :: name_idx !Input variable array index + integer :: constituent_idx !Index of variable in constituent array integer :: req_idx !Required variable array index integer :: suite_idx !Suite array index character(len=SHR_KIND_CL) :: ncdata_check_loc type(file_desc_t), pointer :: file logical :: file_found logical :: is_first + logical :: is_read + real(kind=kind_phys), pointer :: field_data_ptr(:,:,:) ! Initalize missing and non-initialized variables strings: missing_required_vars = ' ' @@ -238,13 +259,28 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, ! Loop over all required variables as specified by CCPP suite: do req_idx = 1, size(ccpp_required_data, 1) - ! Find IC file input name array index for required variable: - if (.not. is_read_from_file(ccpp_required_data(req_idx), name_idx)) then - continue - end if - ! Check variable vs input check file: - - select case (trim(phys_var_stdnames(name_idx))) + ! First check if the required variable is a constituent: + call const_get_index(ccpp_required_data(req_idx), constituent_idx, abort=.false., & + warning=.false.) + if (constituent_idx > -1) then + ! The required variable is a constituent. Call check variable routine on the + ! relevant index of the constituent array + field_data_ptr => cam_advected_constituents_array() + call check_field(file, [ccpp_required_data(req_idx)], 'lev', timestep, & + field_data_ptr(:,:,constituent_idx), ccpp_required_data(req_idx), & + min_difference, min_relative_value, is_first) + else + ! The required variable is not a constituent. Check if the variable was read from + ! a file + ! Find IC file input name array index for required variable: + call is_read_from_file(ccpp_required_data(req_idx), is_read, & + stdnam_idx_out=name_idx) + if (.not. is_read) then + cycle + end if + ! Check variable vs input check file: + + select case (trim(phys_var_stdnames(name_idx))) case ('potential_temperature') call check_field(file, input_var_names(:,name_idx), 'lev', timestep, theta, & 'potential_temperature', min_difference, min_relative_value, is_first) @@ -253,7 +289,8 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, call check_field(file, input_var_names(:,name_idx), timestep, slp, & 'air_pressure_at_sea_level', min_difference, min_relative_value, is_first) - end select !check variables + end select !check variables + end if !check if constituent end do !Suite-required variables ! Deallocate required variables array for use in next suite: @@ -266,12 +303,16 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, deallocate(file) nullify(file) if (is_first) then + if (masterproc) then + write(iulog,*) '' + write(iulog,*) 'No differences found!' + end if + end if + if (masterproc) then + write(iulog,*) '' + write(iulog,*) '********** End Physics Check Data Results **********' write(iulog,*) '' - write(iulog,*) 'No differences found!' end if - write(iulog,*) '' - write(iulog,*) '********** End Physics Check Data Results **********' - write(iulog,*) '' end subroutine physics_check_data end module physics_inputs_simple diff --git a/test/unit/test_cam_config.py b/test/unit/test_cam_config.py index 91b95ae4..bad32f5f 100644 --- a/test/unit/test_cam_config.py +++ b/test/unit/test_cam_config.py @@ -773,8 +773,6 @@ def test_xml_nml_file(self): 'namelist_definition_cam.xml') xml_fil_list['namelist_definition_physconst.xml'] = os.path.join(data_path, 'namelist_definition_physconst.xml') - xml_fil_list['namelist_definition_air_comp.xml'] = os.path.join(data_path, - 'namelist_definition_air_comp.xml') xml_fil_list['namelist_definition_ref_pres.xml'] = os.path.join(data_path, 'namelist_definition_ref_pres.xml') diff --git a/test/unit/test_registry.py b/test/unit/test_registry.py index 16bfb902..00530bb1 100644 --- a/test/unit/test_registry.py +++ b/test/unit/test_registry.py @@ -165,7 +165,6 @@ def test_good_ddt_registry(self): self.assertTrue(filecmp.cmp(out_source, in_source, shallow=False), msg=amsg) # End for - def test_good_ddt_registry2(self): """Test code and metadata generation from a good registry with DDTs with extends and bindC attributes. @@ -405,7 +404,8 @@ def test_SourceMods_metadata_file_registry(self): def test_good_complete_registry(self): """ Test that a good registry with variables, meta-data files, - DDTs, Arrays, and parameters validates, i.e. try and test + DDTs, Arrays, variables set to a physconst variable, + and parameters validates, i.e. try and test everything at once. Check that generate_registry_data.py generates @@ -1133,6 +1133,52 @@ def test_duplicate_standard_name(self): self.assertFalse(os.path.exists(out_meta)) self.assertFalse(os.path.exists(out_source)) + def test_missing_use_statement(self): + """Test a registry with a missing use statement needed for initialization. + Check that it raises an exception and does not generate any + Fortran or metadata files""" + # Setup test + infilename = os.path.join(_SAMPLE_FILES_DIR, "reg_good_complete.xml") + filename = os.path.join(_TMP_DIR, "reg_missing_use.xml") + out_source_name = "physics_types_missing_use" + out_source = os.path.join(_TMP_DIR, out_source_name + '.F90') + out_meta = os.path.join(_TMP_DIR, out_source_name + '.meta') + remove_files([out_source, out_meta]) + tree, root = read_xml_file(infilename) + # Add a new variable that uses a non-"used" physconst variable + for obj in root: + oname = obj.get('name') + if (obj.tag == 'file') and (oname == 'physics_types_complete'): + obj.set('name', out_source_name) + new_var = ET.SubElement(obj, "variable") + new_var.set("local_name", "french_fries") + new_var.set("standard_name", "french_fried_potaters") + new_var.set("units", "radians") + new_var.set("type", "real") + new_var.set("kind", "kind_phys") + new_var.set("allocatable", "allocatable") + dims_elem = ET.SubElement(new_var, "dimensions") + dims_elem.text = 'horizontal_dimension' + initial_elem = ET.SubElement(new_var, "initial_value") + initial_elem.text = 'zvir' + break + # End if + # End for + tree.write(filename) + # Run test + with self.assertRaises(ValueError) as verr: + _ = gen_registry(filename, 'eul', {}, _TMP_DIR, 2, + _SRC_MOD_DIR, _CAM_ROOT, + loglevel=logging.ERROR, + error_on_no_validate=True) + # End with + # Check exception message + emsg = "Initial value 'zvir' is not a physconst variable or does not have necessary use statement" + self.assertEqual(emsg, str(verr.exception)) + # Make sure the output meta data file matches and no source data file has been generated + self.assertFalse(os.path.exists(out_meta)) + self.assertFalse(os.path.exists(out_source)) + def test_bad_metadata_file_dup_section(self): """Test response to bad metadata file with a duplicate section. Check that the correct error is raised."""