diff --git a/scripts/ccpp_suite.py b/scripts/ccpp_suite.py index b2d4c36e..d2634c89 100644 --- a/scripts/ccpp_suite.py +++ b/scripts/ccpp_suite.py @@ -647,9 +647,15 @@ def __init__(self, sdfs, host_model, scheme_headers, run_env): # Secondary level is by phase scheme_library = {} # First, process DDT headers + all_ddts = [d for d in scheme_headers if d.header_type == 'ddt'] + ddt_titles = [d.title for d in all_ddts] + for ddt_title in self.host_model.ddt_lib: + if ddt_title not in ddt_titles: + all_ddts.append(self.host_model.ddt_lib[ddt_title]) + # end if + # end for self.__ddt_lib = DDTLibrary('{}_api'.format(self.host_model.name), - run_env, ddts=[d for d in scheme_headers - if d.header_type == 'ddt']) + run_env, ddts=all_ddts) for header in [d for d in scheme_headers if d.header_type != 'ddt']: if header.header_type != 'scheme': errmsg = "{} is an unknown CCPP API metadata header type, {}" @@ -677,15 +683,14 @@ def __init__(self, sdfs, host_model, scheme_headers, run_env): # end for # We will need the correct names for errmsg and errcode evar = self.host_model.find_variable(standard_name='ccpp_error_message') - subst_dict = {'intent':'out'} if evar is not None: - self._errmsg_var = evar.clone(subst_dict) + self._errmsg_var = evar else: raise CCPPError('Required variable, ccpp_error_message, not found') # end if evar = self.host_model.find_variable(standard_name='ccpp_error_code') if evar is not None: - self._errcode_var = evar.clone(subst_dict) + self._errcode_var = evar else: raise CCPPError('Required variable, ccpp_error_code, not found') # end if @@ -737,15 +742,25 @@ def write(self, output_dir, run_env): @classmethod def declare_inspection_interfaces(cls, ofile): """Declare the API interfaces for the suite inquiry functions""" - ofile.write("public :: {}".format(API.__suite_fname), 1) - ofile.write("public :: {}".format(API.__part_fname), 1) - ofile.write("public :: {}".format(API.__vars_fname), 1) - ofile.write("public :: {}".format(API.__schemes_fname), 1) - - def get_errinfo_names(self): - """Return a tuple of error output local names""" - errmsg_name = self._errmsg_var.get_prop_value('local_name') - errcode_name = self._errcode_var.get_prop_value('local_name') + ofile.write(f"public :: {API.__suite_fname}", 1) + ofile.write(f"public :: {API.__part_fname}", 1) + ofile.write(f"public :: {API.__vars_fname}", 1) + ofile.write(f"public :: {API.__schemes_fname}", 1) + + def get_errinfo_names(self, base_only=False): + """Return a tuple of error output local names. + If base_only==True, return only the name string of the variable. + If base_only=False, return the local name as a full reference. + If the error variables are intrinsic variables, this makes no + difference, however, for a DDT variable, the full reference is + % while the local name is just .""" + if base_only: + errmsg_name = self._errmsg_var.get_prop_value('local_name') + errcode_name = self._errcode_var.get_prop_value('local_name') + else: + errmsg_name = self._errmsg_var.call_string(self) + errcode_name = self._errcode_var.call_string(self) + # end if return (errmsg_name, errcode_name) @staticmethod @@ -756,29 +771,29 @@ def write_var_set_loop(ofile, varlist_name, var_list, indent, beginning at . """ if add_allocate: - ofile.write("allocate({}({}))".format(varlist_name, len(var_list)), - indent) + ofile.write(f"allocate({varlist_name}({len(var_list)}))", indent) # end if for ind, var in enumerate(sorted(var_list)): if start_var: - ind_str = "{} + {}".format(start_var, ind + start_index) + ind_str = f"{start_var} + {ind + start_index}" else: - ind_str = "{}".format(ind + start_index) + ind_str = f"{ind + start_index}" # end if - ofile.write("{}({}) = '{}'".format(varlist_name, ind_str, var), - indent) + ofile.write(f"{varlist_name}({ind_str}) = '{var}'", indent) # end for def write_suite_part_list_sub(self, ofile, errmsg_name, errcode_name): """Write the suite-part list subroutine""" inargs = f"suite_name, part_list, {errmsg_name}, {errcode_name}" ofile.write(f"subroutine {API.__part_fname}({inargs})", 1) - oline = "character(len=*), intent(in) :: suite_name" + oline = "character(len=*), intent(in) :: suite_name" ofile.write(oline, 2) - oline = "character(len=*), allocatable, intent(out) :: part_list(:)" + oline = "character(len=*), allocatable, intent(out) :: part_list(:)" ofile.write(oline, 2) - self._errmsg_var.write_def(ofile, 2, self) - self._errcode_var.write_def(ofile, 2, self) + self._errmsg_var.write_def(ofile, 2, self, dummy=True, add_intent="out", + extra_space=11) + self._errcode_var.write_def(ofile, 2, self, dummy=True, add_intent="out", + extra_space=11) else_str = '' ename = self._errcode_var.get_prop_value('local_name') ofile.write(f"{ename} = 0", 2) @@ -805,17 +820,19 @@ def write_req_vars_sub(self, ofile, errmsg_name, errcode_name): inargs = oline.format(errmsg=errmsg_name, errcode=errcode_name) ofile.write("\nsubroutine {}({})".format(API.__vars_fname, inargs), 1) ofile.write("! Dummy arguments", 2) - oline = "character(len=*), intent(in) :: suite_name" + oline = "character(len=*), intent(in) :: suite_name" ofile.write(oline, 2) - oline = "character(len=*), allocatable, intent(out) :: variable_list(:)" + oline = "character(len=*), allocatable, intent(out) :: variable_list(:)" ofile.write(oline, 2) - self._errmsg_var.write_def(ofile, 2, self, extra_space=22) - self._errcode_var.write_def(ofile, 2, self, extra_space=22) - oline = "logical, optional, intent(in) :: input_vars" + self._errmsg_var.write_def(ofile, 2, self, dummy=True, + add_intent="out", extra_space=11) + self._errcode_var.write_def(ofile, 2, self, dummy=True, + add_intent="out", extra_space=11) + oline = "logical, optional, intent(in) :: input_vars" ofile.write(oline, 2) - oline = "logical, optional, intent(in) :: output_vars" + oline = "logical, optional, intent(in) :: output_vars" ofile.write(oline, 2) - oline = "logical, optional, intent(in) :: struct_elements" + oline = "logical, optional, intent(in) :: struct_elements" ofile.write(oline, 2) ofile.write("! Local variables", 2) ofile.write("logical {}:: input_vars_use".format(' '*34), 2) @@ -1120,12 +1137,14 @@ def write_suite_schemes_sub(self, ofile, errmsg_name, errcode_name): inargs = oline.format(errmsg=errmsg_name, errcode=errcode_name) ofile.write("\nsubroutine {}({})".format(API.__schemes_fname, inargs), 1) - oline = "character(len=*), intent(in) :: suite_name" + oline = "character(len=*), intent(in) :: suite_name" ofile.write(oline, 2) - oline = "character(len=*), allocatable, intent(out) :: scheme_list(:)" + oline = "character(len=*), allocatable, intent(out) :: scheme_list(:)" ofile.write(oline, 2) - self._errmsg_var.write_def(ofile, 2, self) - self._errcode_var.write_def(ofile, 2, self) + self._errmsg_var.write_def(ofile, 2, self, dummy=True, + add_intent="out", extra_space=11) + self._errcode_var.write_def(ofile, 2, self, dummy=True, + add_intent="out", extra_space=11) else_str = '' ename = self._errcode_var.get_prop_value('local_name') ofile.write("{} = 0".format(ename), 2) @@ -1153,16 +1172,17 @@ def write_suite_schemes_sub(self, ofile, errmsg_name, errcode_name): def write_inspection_routines(self, ofile): """Write the list_suites and list_suite_parts subroutines""" - errmsg_name, errcode_name = self.get_errinfo_names() + errmsg_name, errcode_name = self.get_errinfo_names(base_only=True) ofile.write("subroutine {}(suites)".format(API.__suite_fname), 1) nsuites = len(self.suites) - oline = "character(len=*), allocatable, intent(out) :: suites(:)" + oline = "character(len=*), allocatable, intent(out) :: suites(:)" ofile.write(oline, 2) ofile.write("\nallocate(suites({}))".format(nsuites), 2) for ind, suite in enumerate(self.suites): ofile.write("suites({}) = '{}'".format(ind+1, suite.name), 2) # end for ofile.write("end subroutine {}".format(API.__suite_fname), 1) + ofile.blank_line() # Write out the suite part list subroutine self.write_suite_part_list_sub(ofile, errmsg_name, errcode_name) # Write out the suite required variable subroutine diff --git a/scripts/constituents.py b/scripts/constituents.py index d4b08ab3..a8c11144 100644 --- a/scripts/constituents.py +++ b/scripts/constituents.py @@ -491,10 +491,11 @@ def write_host_routines(cap, host, reg_funcname, init_funcname, num_const_funcna ConstituentVarDict.write_constituent_use_statements(cap, suite_list, 2) cap.blank_line() cap.comment("Dummy arguments", 2) - cap.write(f"type({CONST_PROP_TYPE}), target, intent(in) :: " + \ + cap.write(f"type({CONST_PROP_TYPE}), target, intent(in) :: " + \ "host_constituents(:)", 2) for evar in err_vars: - evar.write_def(cap, 2, host, dummy=True, add_intent="out") + evar.write_def(cap, 2, host, dummy=True, + add_intent="out", extra_space=25) # end for cap.comment("Local variables", 2) spc = ' '*37 @@ -546,7 +547,7 @@ def write_host_routines(cap, host, reg_funcname, init_funcname, num_const_funcna cap.write("end if", 3) cap.write("end do", 2) # end for - + # Register suite constituents for suite in suite_list: errvar_str = ConstituentVarDict.__errcode_callstr(herrcode, @@ -745,7 +746,8 @@ def write_host_routines(cap, host, reg_funcname, init_funcname, num_const_funcna cap.write("character(len=*), intent(in) :: stdname", 2) cap.write("integer, intent(out) :: const_index", 2) for evar in err_vars: - evar.write_def(cap, 2, host, dummy=True, add_intent="out") + evar.write_def(cap, 2, host, dummy=True, + add_intent="out", extra_space=1) # end for cap.blank_line() cap.write(f"call {const_obj_name}%const_index(const_index, " + \ diff --git a/scripts/ddt_library.py b/scripts/ddt_library.py index 72fe48b8..35425599 100644 --- a/scripts/ddt_library.py +++ b/scripts/ddt_library.py @@ -112,16 +112,21 @@ def call_string(self, var_dict, loop_vars=None): # end if return call_str - def write_def(self, outfile, indent, ddict, allocatable=False, dummy=False): + def write_def(self, outfile, indent, ddict, allocatable=False, target=False, + dummy=False, add_intent=None, extra_space=0, public=False): """Write the definition line for this DDT. The type of this declaration is the type of the Var at the end of the chain of references.""" if self.field is None: super().write_def(outfile, indent, ddict, - allocatable=allocatable, dummy=dummy) + allocatable=allocatable, target=target, dummy=dummy, + add_intent=add_intent, extra_space=extra_space, + public=public) else: self.field.write_def(outfile, indent, ddict, - allocatable=allocatable, dummy=dummy) + allocatable=allocatable, target=target, + dummy=dummy, add_intent=add_intent, + extra_space=extra_space, public=public) # end if @staticmethod @@ -214,8 +219,8 @@ def __init__(self, name, run_env, ddts=None): # end if if ddt.title in self: errmsg = "Duplicate DDT, {}, found{}, original{}" - ctx = context_string(ddt.source.context) - octx = context_string(self[ddt.title].source.context) + ctx = context_string(ddt.context) + octx = context_string(self[ddt.title].context) raise CCPPError(errmsg.format(ddt.title, ctx, octx)) # end if if run_env.verbose: @@ -324,7 +329,7 @@ def write_ddt_use_statements(self, variable_list, outfile, indent, pad=0): @property def name(self): - "Return the name of this DDT library" + """Return the name of this DDT library""" return self.__name @property @@ -332,6 +337,11 @@ def run_env(self): """Return the CCPPFrameworkEnv object for this DDT library""" return self.__run_env + @property + def max_mod_name_len(self): + """Return the maximum module name length of this DDT library's modules""" + return self.__max_mod_name_len + ############################################################################### if __name__ == "__main__": # pylint: disable=ungrouped-imports diff --git a/scripts/host_cap.py b/scripts/host_cap.py index d050dcdf..f1d2880b 100644 --- a/scripts/host_cap.py +++ b/scripts/host_cap.py @@ -523,12 +523,12 @@ def suite_part_call_list(host_model, const_dict, suite_part, subst_loop_vars, # end if # end for if hvar is None: - errmsg = 'No host model variable for {} in {}' - raise CCPPError(errmsg.format(stdname, suite_part.name)) + errmsg = f"No host model variable for {stdname} in {suite_part.name}" + raise CCPPError(errmsg) # End if if stdname not in CCPP_CONSTANT_VARS: lname = var_dict.var_call_string(hvar, loop_vars=loop_vars) - hmvars.append("{}={}".format(sp_lname, lname)) + hmvars.append(f"{sp_lname}={lname}") # End if # End for return ', '.join(hmvars) @@ -563,7 +563,7 @@ def write_host_cap(host_model, api, module_name, output_dir, run_env): cap.write(f"use {CONST_DDT_MOD}, {mspc}only: {CONST_DDT_NAME}", 1) cap.write(f"use {CONST_DDT_MOD}, {mspc}only: {CONST_PROP_TYPE}", 1) cap.write_preamble() - max_suite_len = 0 + max_suite_len = host_model.ddt_lib.max_mod_name_len for suite in api.suites: max_suite_len = max(max_suite_len, len(suite.module)) # End for @@ -697,12 +697,12 @@ def write_host_cap(host_model, api, module_name, output_dir, run_env): pad=max_suite_len) cap.write("", 1) - # Write out dummy arguments + # Write out dummy argument definitions for var in apivars: - var.write_def(cap, 2, host_model) + var.write_def(cap, 2, host_model, dummy=True) # End for for var in hdvars: - var.write_def(cap, 2, host_model) + var.write_def(cap, 2, host_model, dummy=True) # End for for var in host_local_vars.variable_list(): var.write_def(cap, 2, host_model, diff --git a/scripts/host_model.py b/scripts/host_model.py index c655421b..c3beb447 100644 --- a/scripts/host_model.py +++ b/scripts/host_model.py @@ -79,6 +79,9 @@ def __init__(self, meta_tables, name_in, run_env): # End for loop_vars = header.variable_list(std_vars=False, loop_vars=True, consts=False) + loop_vars.extend(self.__ddt_dict.variable_list(std_vars=False, + loop_vars=True, + consts=False)) if loop_vars: # loop_vars are part of the host-model interface call # at run time. As such, they override the host-model diff --git a/scripts/metavar.py b/scripts/metavar.py index b686453e..35878bc4 100755 --- a/scripts/metavar.py +++ b/scripts/metavar.py @@ -695,7 +695,7 @@ def call_string(self, var_dict, loop_vars=None): call_str, dims = self.handle_array_ref() # end if if dims: - call_str = call_str + '(' + call_str += '(' dsep = '' for dim in dims: if loop_vars: @@ -736,7 +736,7 @@ def call_string(self, var_dict, loop_vars=None): # end for # end if if lname is not None: - call_str = call_str + dsep + lname + call_str += dsep + lname dsep = ', ' else: errmsg = 'Unable to convert {} to local variables in {}{}' @@ -744,7 +744,7 @@ def call_string(self, var_dict, loop_vars=None): raise CCPPError(errmsg.format(dim, var_dict.name, ctx)) # end if # end for - call_str = call_str + ')' + call_str += ')' # end if return call_str @@ -1001,7 +1001,7 @@ def conditional(self, vdicts): 1 """ - active = self.get_prop_value('active') + active = self.get_prop_value('active') conditional = '' vars_needed = [] @@ -1096,7 +1096,7 @@ def write_def(self, outfile, indent, wdict, allocatable=False, target=False, elif intent is not None: alloval = self.get_prop_value('allocatable') if (intent.lower()[-3:] == 'out') and alloval: - intent_str = f"allocatable, intent({intent})" + intent_str = f"allocatable, intent({intent}){' '*(5 - len(intent))}" elif optional: intent_str = f"intent({intent}),{' '*(5 - len(intent))}" intent_str += 'target, optional ' @@ -1228,28 +1228,28 @@ class VarSpec: def __init__(self, var): """Initialize the common properties of this VarSpec-based object""" - self._name = var.get_prop_value('standard_name') - self._dims = var.get_dimensions() - if not self._dims: - self._dims = None + self.__name = var.get_prop_value('standard_name') + self.__dims = var.get_dimensions() + if not self.__dims: + self.__dims = None # end if @property def name(self): """Return the name of this VarSpec-based object""" - return self._name + return self.__name def get_dimensions(self): """Return the dimensions of this VarSpec-based object.""" - rdims = self._dims + rdims = self.__dims return rdims def __repr__(self): """Return a representation of this object""" - if self._dims is not None: - repr_str = "{}({})".format(self._name, ', '.join(self._dims)) + if self.__dims is not None: + repr_str = f"{self.__name}({', '.join(self.__dims)})" else: - repr_str = self._name + repr_str = self.__name # end if return repr_str @@ -1931,7 +1931,7 @@ def loop_var_okay(standard_name, is_run_phase): def __str__(self): """Return a string that represents this dictionary object""" - return "VarDictionary({}, {})".format(self.name, list(self.keys())) + return f"VarDictionary({self.name}, {list(self.keys())})" def __repr__(self): """Return an unique representation for this object""" @@ -1942,7 +1942,7 @@ def __repr__(self): else: comma = "" # end if - return "VarDictionary({}{}{}".format(self.name, comma, srepr[vstart:]) + return f"VarDictionary({self.name}{comma}{srepr[vstart:]}" def __del__(self): """Attempt to delete all of the variables in this dictionary""" @@ -1982,7 +1982,7 @@ def find_loop_dim_match(self, dim_string): for ssubst in std_subst: svar = self.find_variable(standard_name=ssubst, any_scope=False) if svar is not None: - lnames.append(svar.get_prop_value('local_name')) + lnames.append(svar.call_string(self)) else: break # end if diff --git a/test/ddthost_test/CMakeLists.txt b/test/ddthost_test/CMakeLists.txt new file mode 100644 index 00000000..5bbe196d --- /dev/null +++ b/test/ddthost_test/CMakeLists.txt @@ -0,0 +1,191 @@ +CMAKE_MINIMUM_REQUIRED(VERSION 3.15) +PROJECT(test_host) +ENABLE_LANGUAGE(Fortran) + +include(CMakeForceCompiler) + +SET(CMAKE_MODULE_PATH ${CMAKE_MODULE_PATH} ${CMAKE_SOURCE_DIR}/cmake/modules) + +#------------------------------------------------------------------------------ +# +# Set where the CCPP Framework lives +# +#------------------------------------------------------------------------------ +get_filename_component(TEST_ROOT "${CMAKE_SOURCE_DIR}" DIRECTORY) +get_filename_component(CCPP_ROOT "${TEST_ROOT}" DIRECTORY) +#------------------------------------------------------------------------------ +# +# Create list of SCHEME_FILES, HOST_FILES, and SUITE_FILES +# Paths should be relative to CMAKE_SOURCE_DIR (this file's directory) +# +#------------------------------------------------------------------------------ +LIST(APPEND SCHEME_FILES "temp_scheme_files.txt" "ddt_suite_files.txt") +LIST(APPEND HOST_FILES "test_host_data" "test_host_mod" "host_ccpp_ddt") +LIST(APPEND SUITE_FILES "ddt_suite.xml" "temp_suite.xml") +# HOST is the name of the executable we will build. +# We assume there are files ${HOST}.meta and ${HOST}.F90 in CMAKE_SOURCE_DIR +SET(HOST "${CMAKE_PROJECT_NAME}") + +#------------------------------------------------------------------------------ +# +# End of project-specific input +# +#------------------------------------------------------------------------------ + +# By default, no verbose output +SET(VERBOSITY 0 CACHE STRING "Verbosity level of output (default: 0)") +# By default, generated caps go in ccpp subdir +SET(CCPP_CAP_FILES "${CMAKE_BINARY_DIR}/ccpp" CACHE + STRING "Location of CCPP-generated cap files") + +SET(CCPP_FRAMEWORK ${CCPP_ROOT}/scripts) + +# Use rpaths on MacOSX +set(CMAKE_MACOSX_RPATH 1) + +#------------------------------------------------------------------------------ +# Set a default build type if none was specified +if(NOT CMAKE_BUILD_TYPE AND NOT CMAKE_CONFIGURATION_TYPES) + #message(STATUS "Setting build type to 'Debug' as none was specified.") + #set(CMAKE_BUILD_TYPE Debug CACHE STRING "Choose the type of build." FORCE) + message(STATUS "Setting build type to 'Release' as none was specified.") + set(CMAKE_BUILD_TYPE Release CACHE STRING "Choose the type of build." FORCE) + + # Set the possible values of build type for cmake-gui + set_property(CACHE CMAKE_BUILD_TYPE PROPERTY STRINGS "Debug" "Release" + "MinSizeRel" "RelWithDebInfo") +endif() + +ADD_COMPILE_OPTIONS(-O0) + +if (${CMAKE_Fortran_COMPILER_ID} MATCHES "GNU") +# gfortran +# MESSAGE("gfortran being used.") + ADD_COMPILE_OPTIONS(-fcheck=all) + ADD_COMPILE_OPTIONS(-fbacktrace) + ADD_COMPILE_OPTIONS(-ffpe-trap=zero) + ADD_COMPILE_OPTIONS(-finit-real=nan) + ADD_COMPILE_OPTIONS(-ggdb) + ADD_COMPILE_OPTIONS(-ffree-line-length-none) + ADD_COMPILE_OPTIONS(-cpp) +elseif (${CMAKE_Fortran_COMPILER_ID} MATCHES "Intel") +# ifort +# MESSAGE("ifort being used.") + #ADD_COMPILE_OPTIONS(-check all) + ADD_COMPILE_OPTIONS(-fpe0) + ADD_COMPILE_OPTIONS(-warn) + ADD_COMPILE_OPTIONS(-traceback) + ADD_COMPILE_OPTIONS(-debug extended) + ADD_COMPILE_OPTIONS(-fpp) +elseif (${CMAKE_Fortran_COMPILER_ID} MATCHES "PGI") +# pgf90 +# MESSAGE("pgf90 being used.") + ADD_COMPILE_OPTIONS(-g) + ADD_COMPILE_OPTIONS(-Mipa=noconst) + ADD_COMPILE_OPTIONS(-traceback) + ADD_COMPILE_OPTIONS(-Mfree) + ADD_COMPILE_OPTIONS(-Mfptrap) + ADD_COMPILE_OPTIONS(-Mpreprocess) +else (${CMAKE_Fortran_COMPILER_ID} MATCHES "GNU") + message (WARNING "This program has only been compiled with gfortran, pgf90 and ifort. If another compiler is needed, the appropriate flags SHOULD be added in ${CMAKE_SOURCE_DIR}/CMakeLists.txt") +endif (${CMAKE_Fortran_COMPILER_ID} MATCHES "GNU") + +#------------------------------------------------------------------------------ +# CMake Modules +# Set the CMake module path +list(APPEND CMAKE_MODULE_PATH "${CCPP_FRAMEWORK}/cmake") +#------------------------------------------------------------------------------ +# Set OpenMP flags for C/C++/Fortran +if (OPENMP) + include(detect_openmp) + detect_openmp() + set (CMAKE_C_FLAGS "${CMAKE_C_FLAGS} ${OpenMP_C_FLAGS}") + set (CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} ${OpenMP_CXX_FLAGS}") + set (CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} ${OpenMP_Fortran_FLAGS}") + message(STATUS "Enable OpenMP support for C/C++/Fortran compiler") +else(OPENMP) + message (STATUS "Disable OpenMP support for C/C++/Fortran compiler") +endif() + +# Create metadata and source file lists +FOREACH(FILE ${SCHEME_FILES}) + FILE(STRINGS ${FILE} FILENAMES) + LIST(APPEND SCHEME_FILENAMES ${FILENAMES}) +ENDFOREACH(FILE) +string(REPLACE ";" "," SCHEME_METADATA "${SCHEME_FILES}") + +FOREACH(FILE ${SCHEME_FILENAMES}) + # target_sources prefers absolute pathnames + string(REPLACE ".meta" ".F90" TEMP "${FILE}") + get_filename_component(ABS_PATH "${TEMP}" ABSOLUTE) + list(APPEND LIBRARY_LIST ${ABS_PATH}) +ENDFOREACH(FILE) + +FOREACH(FILE ${HOST_FILES}) + LIST(APPEND HOST_METADATA "${FILE}.meta") + # target_sources prefers absolute pathnames + get_filename_component(ABS_PATH "${FILE}.F90" ABSOLUTE) + LIST(APPEND HOST_SOURCE "${ABS_PATH}") +ENDFOREACH(FILE) +list(APPEND LIBRARY_LIST ${HOST_SOURCE}) +string(REPLACE ";" ".meta," HOST_METADATA "${HOST_FILES}") +set(HOST_METADATA "${HOST_METADATA}.meta,${HOST}.meta") + +string(REPLACE ";" "," SUITE_XML "${SUITE_FILES}") + +# Run ccpp_capgen +set(CAPGEN_CMD "${CCPP_FRAMEWORK}/ccpp_capgen.py") +list(APPEND CAPGEN_CMD "--host-files") +list(APPEND CAPGEN_CMD "${HOST_METADATA}") +list(APPEND CAPGEN_CMD "--scheme-files") +list(APPEND CAPGEN_CMD "${SCHEME_METADATA}") +list(APPEND CAPGEN_CMD "--suites") +list(APPEND CAPGEN_CMD "${SUITE_XML}") +list(APPEND CAPGEN_CMD "--host-name") +list(APPEND CAPGEN_CMD "test_host") +list(APPEND CAPGEN_CMD "--output-root") +list(APPEND CAPGEN_CMD "${CCPP_CAP_FILES}") +string(REPEAT "--verbose;" ${VERBOSITY} VERBOSE_REPEATED) +list(APPEND CAPGEN_CMD ${VERBOSE_REPEATED}) +list(APPEND CAPGEN_CMD "--debug") +string(REPLACE ";" " " CAPGEN_STRING "${CAPGEN_CMD}") +MESSAGE(STATUS "Running: ${CAPGEN_STRING}") +EXECUTE_PROCESS(COMMAND ${CAPGEN_CMD} + WORKING_DIRECTORY ${CMAKE_SOURCE_DIR} + OUTPUT_VARIABLE CAPGEN_OUT + ERROR_VARIABLE CAPGEN_OUT + RESULT_VARIABLE RES) +MESSAGE(STATUS "${CAPGEN_OUT}") +if (RES EQUAL 0) + MESSAGE(STATUS "CCPP cap generation completed") +else(RES EQUAL 0) + MESSAGE(FATAL_ERROR "CCPP cap generation FAILED: result = ${RES}") +endif(RES EQUAL 0) + +# Retrieve the list of files from datatable.xml and set to CCPP_CAPS +set(DTABLE_CMD "${CCPP_FRAMEWORK}/ccpp_datafile.py") +list(APPEND DTABLE_CMD "${CCPP_CAP_FILES}/datatable.xml") +list(APPEND DTABLE_CMD "--ccpp-files") +list(APPEND DTABLE_CMD "--separator=\\;") +string(REPLACE ";" " " DTABLE_STRING "${DTABLE_CMD}") +MESSAGE(STATUS "Running: ${DTABLE_STRING}") +EXECUTE_PROCESS(COMMAND ${DTABLE_CMD} + OUTPUT_VARIABLE CCPP_CAPS + RESULT_VARIABLE RES + OUTPUT_STRIP_TRAILING_WHITESPACE + ERROR_STRIP_TRAILING_WHITESPACE) +message(STATUS "CCPP_CAPS = ${CCPP_CAPS}") +if (RES EQUAL 0) + MESSAGE(STATUS "CCPP cap files retrieved") +else(RES EQUAL 0) + MESSAGE(FATAL_ERROR "CCPP cap file retrieval FAILED: result = ${RES}") +endif(RES EQUAL 0) +list(APPEND LIBRARY_LIST ${CCPP_CAPS}) +add_library(TESTLIB OBJECT ${LIBRARY_LIST}) +ADD_EXECUTABLE(${HOST} ${HOST}.F90 $) + +INCLUDE_DIRECTORIES(${CCPP_CAP_FILES}) + +set_target_properties(${HOST} PROPERTIES + COMPILE_FLAGS "${CMAKE_Fortran_FLAGS}" + LINK_FLAGS "${CMAKE_Fortran_FLAGS}") diff --git a/test/ddthost_test/README.md b/test/ddthost_test/README.md new file mode 100644 index 00000000..127544e0 --- /dev/null +++ b/test/ddthost_test/README.md @@ -0,0 +1,6 @@ +ccpp_capgen test +=========== + +To build and run the ccpp_capgen test, run ./run_test +This script will build and run the test. +The exit code is zero (0) on PASS and non-zero on FAIL. diff --git a/test/ddthost_test/ddt_suite.xml b/test/ddthost_test/ddt_suite.xml new file mode 100644 index 00000000..749bb3bc --- /dev/null +++ b/test/ddthost_test/ddt_suite.xml @@ -0,0 +1,8 @@ + + + + + make_ddt + environ_conditions + + diff --git a/test/ddthost_test/ddt_suite_files.txt b/test/ddthost_test/ddt_suite_files.txt new file mode 100644 index 00000000..7f96a84c --- /dev/null +++ b/test/ddthost_test/ddt_suite_files.txt @@ -0,0 +1,2 @@ +make_ddt.meta +environ_conditions.meta diff --git a/test/ddthost_test/environ_conditions.F90 b/test/ddthost_test/environ_conditions.F90 new file mode 100644 index 00000000..b6816117 --- /dev/null +++ b/test/ddthost_test/environ_conditions.F90 @@ -0,0 +1,96 @@ +module environ_conditions + + use ccpp_kinds, only: kind_phys + + implicit none + private + + public :: environ_conditions_init + public :: environ_conditions_run + public :: environ_conditions_finalize + + integer, parameter :: input_model_times = 3 + integer, parameter :: input_model_values(input_model_times) = (/ 31, 37, 41 /) + +contains + +!> \section arg_table_environ_conditions_run Argument Table +!! \htmlinclude arg_table_environ_conditions_run.html +!! + subroutine environ_conditions_run(psurf, errmsg, errflg) + + ! This routine currently does nothing -- should update values + + real(kind_phys), intent(in) :: psurf(:) + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + + errmsg = '' + errflg = 0 + + end subroutine environ_conditions_run + +!> \section arg_table_environ_conditions_init Argument Table +!! \htmlinclude arg_table_environ_conditions_init.html +!! + subroutine environ_conditions_init (nbox, O3, HNO3, ntimes, model_times, & + errmsg, errflg) + + integer, intent(in) :: nbox + real(kind_phys), intent(out) :: O3(:) + real(kind_phys), intent(out) :: HNO3(:) + integer, intent(out) :: ntimes + integer, allocatable, intent(out) :: model_times(:) + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg +!---------------------------------------------------------------- + + integer :: i, j + + errmsg = '' + errflg = 0 + + ! This may be replaced with MusicBox json environmental conditions reader??? + + do i = 1, nbox + O3(i) = real(i, kind_phys) * 1.e-6_kind_phys + HNO3(i) = real(i, kind_phys) * 1.e-9_kind_phys + end do + + ntimes = input_model_times + allocate(model_times(ntimes)) + model_times = input_model_values + + end subroutine environ_conditions_init + +!> \section arg_table_environ_conditions_finalize Argument Table +!! \htmlinclude arg_table_environ_conditions_finalize.html +!! + subroutine environ_conditions_finalize (ntimes, model_times, errmsg, errflg) + + integer, intent(in) :: ntimes + integer, intent(in) :: model_times(:) + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! This routine checks the size and values of model_times + if (ntimes /= input_model_times) then + errflg = 1 + write(errmsg, '(2(a,i0))') 'ntimes mismatch, ', ntimes, ' should be ', & + input_model_times + else if (size(model_times) /= input_model_times) then + errflg = 1 + write(errmsg, '(2(a,i0))') 'model_times size mismatch, ', & + size(model_times), ' should be ', input_model_times + else if (any(model_times /= input_model_values)) then + errflg = 1 + write(errmsg, *) 'model_times mismatch, ', & + model_times, ' should be ', input_model_values + else + errmsg = '' + errflg = 0 + end if + + end subroutine environ_conditions_finalize + +end module environ_conditions diff --git a/test/ddthost_test/environ_conditions.meta b/test/ddthost_test/environ_conditions.meta new file mode 100644 index 00000000..894e0e92 --- /dev/null +++ b/test/ddthost_test/environ_conditions.meta @@ -0,0 +1,110 @@ +[ccpp-table-properties] + name = environ_conditions + type = scheme +[ccpp-arg-table] + name = environ_conditions_run + type = scheme +[ psurf ] + standard_name = surface_air_pressure + state_variable = true + type = real + kind = kind_phys + units = Pa + dimensions = (horizontal_loop_extent) + intent = in +[ errmsg ] + standard_name = ccpp_error_message + long_name = Error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=512 + intent = out +[ errflg ] + standard_name = ccpp_error_code + long_name = Error flag for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out +[ccpp-arg-table] + name = environ_conditions_init + type = scheme +[ nbox ] + standard_name = horizontal_dimension + type = integer + units = count + dimensions = () + intent = in +[ o3 ] + standard_name = ozone + units = ppmv + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out +[ hno3 ] + standard_name = nitric_acid + units = ppmv + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out +[ ntimes ] + standard_name = number_of_model_times + type = integer + units = count + dimensions = () + intent = out +[ model_times ] + standard_name = model_times + units = seconds + dimensions = (number_of_model_times) + type = integer + intent = out + allocatable = True +[ errmsg ] + standard_name = ccpp_error_message + long_name = Error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=512 + intent = out +[ errflg ] + standard_name = ccpp_error_code + long_name = Error flag for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out +[ccpp-arg-table] + name = environ_conditions_finalize + type = scheme +[ ntimes ] + standard_name = number_of_model_times + type = integer + units = count + dimensions = () + intent = in +[ model_times ] + standard_name = model_times + units = seconds + dimensions = (number_of_model_times) + type = integer + intent = in +[ errmsg ] + standard_name = ccpp_error_message + long_name = Error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=512 + intent = out +[ errflg ] + standard_name = ccpp_error_code + long_name = Error flag for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out diff --git a/test/ddthost_test/host_ccpp_ddt.F90 b/test/ddthost_test/host_ccpp_ddt.F90 new file mode 100644 index 00000000..157f795f --- /dev/null +++ b/test/ddthost_test/host_ccpp_ddt.F90 @@ -0,0 +1,16 @@ +module host_ccpp_ddt + + implicit none + private + + !> \section arg_table_ccpp_info_t Argument Table + !! \htmlinclude arg_table_ccpp_info_t.html + !! + type, public :: ccpp_info_t + integer :: col_start ! horizontal_loop_begin + integer :: col_end ! horizontal_loop_end + character(len=512) :: errmsg ! ccpp_error_message + integer :: errflg ! ccpp_error_code + end type ccpp_info_t + +end module host_ccpp_ddt diff --git a/test/ddthost_test/host_ccpp_ddt.meta b/test/ddthost_test/host_ccpp_ddt.meta new file mode 100644 index 00000000..56dca845 --- /dev/null +++ b/test/ddthost_test/host_ccpp_ddt.meta @@ -0,0 +1,31 @@ +[ccpp-table-properties] + name = ccpp_info_t + type = ddt +[ccpp-arg-table] + name = ccpp_info_t + type = ddt +[ col_start ] + standard_name = horizontal_loop_begin + type = integer + units = count + dimensions = () + protected = True +[ col_end ] + standard_name = horizontal_loop_end + type = integer + units = count + dimensions = () + protected = True +[ errmsg ] + standard_name = ccpp_error_message + long_name = Error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=512 +[ errflg ] + standard_name = ccpp_error_code + long_name = Error flag for error handling in CCPP + units = 1 + dimensions = () + type = integer diff --git a/test/ddthost_test/make_ddt.F90 b/test/ddthost_test/make_ddt.F90 new file mode 100644 index 00000000..e94aaff4 --- /dev/null +++ b/test/ddthost_test/make_ddt.F90 @@ -0,0 +1,132 @@ +!Hello demonstration parameterization +! + +module make_ddt + + use ccpp_kinds, only: kind_phys + + implicit none + private + + public :: make_ddt_init + public :: make_ddt_run + public :: make_ddt_timestep_final + public :: vmr_type + + !> \section arg_table_vmr_type Argument Table + !! \htmlinclude arg_table_vmr_type.html + !! + type vmr_type + integer :: nvmr + real(kind_phys), allocatable :: vmr_array(:,:) + end type vmr_type + + +contains + + !> \section arg_table_make_ddt_run Argument Table + !! \htmlinclude arg_table_make_ddt_run.html + !! + subroutine make_ddt_run(cols, cole, O3, HNO3, vmr, errmsg, errflg) + !---------------------------------------------------------------- + implicit none + !---------------------------------------------------------------- + + ! Dummy arguments + integer, intent(in) :: cols + integer, intent(in) :: cole + real(kind_phys), intent(in) :: O3(:) + real(kind_phys), intent(in) :: HNO3(:) + type(vmr_type), intent(inout) :: vmr + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + ! Local variable + integer :: nbox + !---------------------------------------------------------------- + + errmsg = '' + errflg = 0 + + ! Check for correct threading behavior + nbox = cole - cols + 1 + if (SIZE(O3) /= nbox) then + errflg = 1 + write(errmsg, '(2(a,i0))') 'SIZE(O3) = ', SIZE(O3), ', should be ', nbox + else if (SIZE(HNO3) /= nbox) then + errflg = 1 + write(errmsg, '(2(a,i0))') 'SIZE(HNO3) = ', SIZE(HNO3), & + ', should be ', nbox + else + ! NOTE -- This is prototyping one approach to passing a large number of + ! chemical VMR values and is the predecessor for adding in methods and + ! maybe nesting DDTs (especially for aerosols) + vmr%vmr_array(cols:cole, 1) = O3(:) + vmr%vmr_array(cols:cole, 2) = HNO3(:) + end if + + end subroutine make_ddt_run + + !> \section arg_table_make_ddt_init Argument Table + !! \htmlinclude arg_table_make_ddt_init.html + !! + subroutine make_ddt_init(nbox, vmr, errmsg, errflg) + + ! Dummy arguments + integer, intent(in) :: nbox + type(vmr_type), intent(out) :: vmr + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! This routine initializes the vmr array + vmr%nvmr = 2 + allocate(vmr%vmr_array(nbox, vmr%nvmr)) + + errmsg = '' + errflg = 0 + + end subroutine make_ddt_init + + !> \section arg_table_make_ddt_timestep_final Argument Table + !! \htmlinclude arg_table_make_ddt_timestep_final.html + !! + subroutine make_ddt_timestep_final (ncols, vmr, errmsg, errflg) + + ! Dummy arguments + integer, intent(in) :: ncols + type(vmr_type), intent(in) :: vmr + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + ! Local variables + integer :: index + real(kind_phys) :: rind + + errmsg = '' + errflg = 0 + + ! This routine checks the array values in vmr + if (SIZE(vmr%vmr_array, 1) /= ncols) then + errflg = 1 + write(errmsg, '(2(a,i0))') 'VMR%VMR_ARRAY first dimension size is, ', & + SIZE(vmr%vmr_array, 1), ', should be, ', ncols + else + do index = 1, ncols + rind = real(index, kind_phys) + if (vmr%vmr_array(index, 1) /= rind * 1.e-6_kind_phys) then + errflg = 1 + write(errmsg, '(a,i0,2(a,e12.4))') 'O3(', index, ') = ', & + vmr%vmr_array(index, 1), ', should be, ', & + rind * 1.e-6_kind_phys + exit + else if (vmr%vmr_array(index, 2) /= rind * 1.e-9_kind_phys) then + errflg = 1 + write(errmsg, '(a,i0,2(a,e12.4))') 'HNO3(', index, ') = ', & + vmr%vmr_array(index, 2), ', should be, ', & + rind * 1.e-9_kind_phys + exit + end if + end do + end if + + end subroutine make_ddt_timestep_final + +end module make_ddt diff --git a/test/ddthost_test/make_ddt.meta b/test/ddthost_test/make_ddt.meta new file mode 100644 index 00000000..b9dbd8a9 --- /dev/null +++ b/test/ddthost_test/make_ddt.meta @@ -0,0 +1,127 @@ +[ccpp-table-properties] + name = vmr_type + type = ddt +[ccpp-arg-table] + name = vmr_type + type = ddt +[ nvmr ] + standard_name = number_of_chemical_species + units = count + dimensions = () + type = integer +[ vmr_array ] + standard_name = array_of_volume_mixing_ratios + units = ppmv + dimensions = (horizontal_loop_extent, number_of_chemical_species) + type = real + kind = kind_phys +[ccpp-table-properties] + name = make_ddt + type = scheme +[ccpp-arg-table] + name = make_ddt_run + type = scheme +[ cols ] + standard_name = horizontal_loop_begin + type = integer + units = count + dimensions = () + intent = in +[ cole ] + standard_name = horizontal_loop_end + type = integer + units = count + dimensions = () + intent = in +[ O3 ] + standard_name = ozone + units = ppmv + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[ HNO3 ] + standard_name = nitric_acid + units = ppmv + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[ vmr ] + standard_name = volume_mixing_ratio_ddt + dimensions = () + type = vmr_type + intent = inout +[ errmsg ] + standard_name = ccpp_error_message + long_name = Error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=512 + intent = out +[ errflg ] + standard_name = ccpp_error_code + long_name = Error flag for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out +[ccpp-arg-table] + name = make_ddt_init + type = scheme +[ nbox ] + standard_name = horizontal_dimension + type = integer + units = count + dimensions = () + intent = in +[ vmr ] + standard_name = volume_mixing_ratio_ddt + dimensions = () + type = vmr_type + intent = out +[ errmsg ] + standard_name = ccpp_error_message + long_name = Error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=512 + intent = out +[ errflg ] + standard_name = ccpp_error_code + long_name = Error flag for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out +[ccpp-arg-table] + name = make_ddt_timestep_final + type = scheme +[ ncols ] + standard_name = horizontal_dimension + type = integer + units = count + dimensions = () + intent = in +[ vmr ] + standard_name = volume_mixing_ratio_ddt + dimensions = () + type = vmr_type + intent = in +[ errmsg ] + standard_name = ccpp_error_message + long_name = Error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=512 + intent = out +[ errflg ] + standard_name = ccpp_error_code + long_name = Error flag for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out diff --git a/test/ddthost_test/run_test b/test/ddthost_test/run_test new file mode 100755 index 00000000..e7b5d09d --- /dev/null +++ b/test/ddthost_test/run_test @@ -0,0 +1,282 @@ +#! /bin/bash + +currdir="`pwd -P`" +scriptdir="$( cd $( dirname $0 ); pwd -P )" + +## +## Option default values +## +defdir="ddt_build" +build_dir="${currdir}/${defdir}" +cleanup="PASS" # Other supported options are ALWAYS and NEVER +verbosity=2 + +## +## General syntax help function +## Usage: help +## +help () { + local hname="Usage: `basename ${0}`" + local hprefix="`echo ${hname} | tr '[!-~]' ' '`" + echo "${hname} [ --build-dir ] [ --cleanup ]" + echo "${hprefix} [ --verbosity <#> ]" + hprefix=" " + echo "" + echo "${hprefix} : Directory for building and running the test" + echo "${hprefix} default is /${defdir}" + echo "${hprefix} : Cleanup option is ALWAYS, NEVER, or PASS" + echo "${hprefix} default is PASS" + echo "${hprefix} verbosity: 0, 1, or 2 (default=${verbosity})" + echo "${hprefix} default is 0" + exit $1 +} + +## +## Error output function (should be handed a string) +## +perr() { + >&2 echo -e "\nERROR: ${@}\n" + exit 1 +} + +## +## Cleanup the build and test directory +## +docleanup() { + # We start off in the build directory + if [ "${build_dir}" == "${currdir}" ]; then + echo "WARNING: Cannot clean ${build_dir}" + else + cd ${currdir} + rm -rf ${build_dir} + fi +} + +## Process our input arguments +while [ $# -gt 0 ]; do + case $1 in + --h | -h | --help | -help) + help 0 + ;; + --build-dir) + if [ $# -lt 2 ]; then + perr "${1} requires a build directory" + fi + build_dir="${2}" + shift + ;; + --cleanup) + if [ $# -lt 2 ]; then + perr "${1} requies a cleanup option (ALWAYS, NEVER, PASS)" + fi + if [ "${2}" == "ALWAYS" -o "${2}" == "NEVER" -o "${2}" == "PASS" ]; then + cleanup="${2}" + else + perr "Allowed cleanup options: ALWAYS, NEVER, PASS" + fi + shift + ;; + --verbosity) + if [ $# -lt 2 ]; then + perr "${1} requires a verbosity value (0, 1, or 2)" + fi + if [ "${2}" == "0" -o "${2}" == "1" -o "${2}" == "2" ]; then + verbosity=$2 + else + perr "allowed verbosity levels are 0, 1, 2" + fi + shift + ;; + *) + perr "Unrecognized option, \"${1}\"" + ;; + esac + shift +done + +# Create the build directory, if necessary +if [ -d "${build_dir}" ]; then + # Always make sure build_dir is not in the test dir + if [ "$( cd ${build_dir}; pwd -P )" == "${currdir}" ]; then + build_dir="${build_dir}/${defdir}" + fi +else + mkdir -p ${build_dir} + res=$? + if [ $res -ne 0 ]; then + perr "Unable to create build directory, '${build_dir}'" + fi +fi +build_dir="$( cd ${build_dir}; pwd -P )" + +## framework is the CCPP Framework root dir +framework="$( cd $( dirname $( dirname ${scriptdir} ) ); pwd -P )" +frame_src="${framework}/src" + +## +## check strings for datafile command-list test +## NB: This has to be after build_dir is finalized +## +host_files="${build_dir}/ccpp/test_host_ccpp_cap.F90" +suite_files="${build_dir}/ccpp/ccpp_ddt_suite_cap.F90" +suite_files="${suite_files},${build_dir}/ccpp/ccpp_temp_suite_cap.F90" +utility_files="${build_dir}/ccpp/ccpp_kinds.F90" +utility_files="${utility_files},${frame_src}/ccpp_constituent_prop_mod.F90" +utility_files="${utility_files},${frame_src}/ccpp_hashable.F90" +utility_files="${utility_files},${frame_src}/ccpp_hash_table.F90" +ccpp_files="${utility_files}" +ccpp_files="${ccpp_files},${build_dir}/ccpp/test_host_ccpp_cap.F90" +ccpp_files="${ccpp_files},${build_dir}/ccpp/ccpp_ddt_suite_cap.F90" +ccpp_files="${ccpp_files},${build_dir}/ccpp/ccpp_temp_suite_cap.F90" +process_list="adjusting=temp_calc_adjust,setter=temp_set" +module_list="environ_conditions,make_ddt,setup_coeffs,temp_adjust,temp_calc_adjust,temp_set" +dependencies="${scriptdir}/adjust/qux.F90,${scriptdir}/bar.F90,${scriptdir}/foo.F90" +suite_list="ddt_suite;temp_suite" +required_vars_ddt="ccpp_error_code,ccpp_error_message,horizontal_dimension" +required_vars_ddt="${required_vars_ddt},horizontal_loop_begin" +required_vars_ddt="${required_vars_ddt},horizontal_loop_end" +required_vars_ddt="${required_vars_ddt},model_times" +required_vars_ddt="${required_vars_ddt},number_of_model_times" +required_vars_ddt="${required_vars_ddt},surface_air_pressure" +input_vars_ddt="horizontal_dimension" +input_vars_ddt="${input_vars_ddt},horizontal_loop_begin" +input_vars_ddt="${input_vars_ddt},horizontal_loop_end" +input_vars_ddt="${input_vars_ddt},model_times,number_of_model_times" +input_vars_ddt="${input_vars_ddt},surface_air_pressure" +output_vars_ddt="ccpp_error_code,ccpp_error_message" +output_vars_ddt="${output_vars_ddt},model_times,number_of_model_times" +required_vars_temp="ccpp_error_code,ccpp_error_message" +required_vars_temp="${required_vars_temp},coefficients_for_interpolation" +required_vars_temp="${required_vars_temp},horizontal_dimension" +required_vars_temp="${required_vars_temp},horizontal_loop_begin" +required_vars_temp="${required_vars_temp},horizontal_loop_end" +required_vars_temp="${required_vars_temp},index_of_water_vapor_specific_humidity" +required_vars_temp="${required_vars_temp},number_of_tracers" +required_vars_temp="${required_vars_temp},potential_temperature" +required_vars_temp="${required_vars_temp},potential_temperature_at_interface" +required_vars_temp="${required_vars_temp},potential_temperature_increment" +required_vars_temp="${required_vars_temp},surface_air_pressure" +required_vars_temp="${required_vars_temp},time_step_for_physics" +required_vars_temp="${required_vars_temp},vertical_interface_dimension" +required_vars_temp="${required_vars_temp},vertical_layer_dimension" +required_vars_temp="${required_vars_temp},water_vapor_specific_humidity" +input_vars_temp="coefficients_for_interpolation" +input_vars_temp="${input_vars_temp},horizontal_dimension" +input_vars_temp="${input_vars_temp},horizontal_loop_begin" +input_vars_temp="${input_vars_temp},horizontal_loop_end" +input_vars_temp="${input_vars_temp},index_of_water_vapor_specific_humidity" +input_vars_temp="${input_vars_temp},number_of_tracers" +input_vars_temp="${input_vars_temp},potential_temperature" +input_vars_temp="${input_vars_temp},potential_temperature_at_interface" +input_vars_temp="${input_vars_temp},potential_temperature_increment" +input_vars_temp="${input_vars_temp},surface_air_pressure,time_step_for_physics" +input_vars_temp="${input_vars_temp},vertical_interface_dimension" +input_vars_temp="${input_vars_temp},vertical_layer_dimension" +input_vars_temp="${input_vars_temp},water_vapor_specific_humidity" +output_vars_temp="ccpp_error_code,ccpp_error_message" +output_vars_temp="${output_vars_temp},coefficients_for_interpolation" +output_vars_temp="${output_vars_temp},potential_temperature" +output_vars_temp="${output_vars_temp},potential_temperature_at_interface" +output_vars_temp="${output_vars_temp},surface_air_pressure" +output_vars_temp="${output_vars_temp},water_vapor_specific_humidity" + +## +## Run a database report and check the return string +## $1 is the report program file +## $2 is the database file +## $3 is the report string +## $4 is the check string +## $5+ are any optional arguments +## +check_datatable() { + local checkstr=${4} + local teststr + local prog=${1} + local database=${2} + local report=${3} + shift 4 + echo "Checking ${report} report" + teststr="`${prog} ${database} ${report} $@`" + if [ "${teststr}" != "${checkstr}" ]; then + perr "datatable check:\nExpected: '${checkstr}'\nGot: '${teststr}'" + fi +} + +# cd to the build directory +cd ${build_dir} +res=$? +if [ $res -ne 0 ]; then + perr "Unable to cd to build directory, '${build_dir}'" +fi +# Clean build directory +rm -rf * +res=$? +if [ $res -ne 0 ]; then + perr "Unable to clean build directory, '${build_dir}'" +fi +# Run CMake +opts="" +if [ $verbosity -gt 0 ]; then + opts="${opts} -DVERBOSITY=${verbosity}" +fi +# Run cmake +cmake ${scriptdir} ${opts} +res=$? +if [ $res -ne 0 ]; then + perr "CMake failed with exit code, ${res}" +fi +# Test the datafile user interface +report_prog="${framework}/scripts/ccpp_datafile.py" +datafile="${build_dir}/ccpp/datatable.xml" +echo "Running python interface tests" +python3 ${scriptdir}/test_reports.py ${build_dir} ${datafile} +res=$? +if [ $res -ne 0 ]; then + perr "python interface tests failed" +fi +echo "Running command line tests" +echo "Checking required files from command line:" +check_datatable ${report_prog} ${datafile} "--host-files" ${host_files} +check_datatable ${report_prog} ${datafile} "--suite-files" ${suite_files} +check_datatable ${report_prog} ${datafile} "--utility-files" ${utility_files} +check_datatable ${report_prog} ${datafile} "--ccpp-files" ${ccpp_files} +echo -e "\nChecking lists from command line" +check_datatable ${report_prog} ${datafile} "--process-list" ${process_list} +check_datatable ${report_prog} ${datafile} "--module-list" ${module_list} +check_datatable ${report_prog} ${datafile} "--dependencies" ${dependencies} +check_datatable ${report_prog} ${datafile} "--suite-list" ${suite_list} \ + --sep ";" +echo -e "\nChecking variables for DDT suite from command line" +check_datatable ${report_prog} ${datafile} "--required-variables" \ + ${required_vars_ddt} "ddt_suite" +check_datatable ${report_prog} ${datafile} "--input-variables" \ + ${input_vars_ddt} "ddt_suite" +check_datatable ${report_prog} ${datafile} "--output-variables" \ + ${output_vars_ddt} "ddt_suite" +echo -e "\nChecking variables for temp suite from command line" +check_datatable ${report_prog} ${datafile} "--required-variables" \ + ${required_vars_temp} "temp_suite" +check_datatable ${report_prog} ${datafile} "--input-variables" \ + ${input_vars_temp} "temp_suite" +check_datatable ${report_prog} ${datafile} "--output-variables" \ + ${output_vars_temp} "temp_suite" +# Run make +make +res=$? +if [ $res -ne 0 ]; then + perr "make failed with exit code, ${res}" +fi +# Run test +./test_host +res=$? +if [ $res -ne 0 ]; then + perr "test_host failed with exit code, ${res}" +fi + +if [ "${cleanup}" == "ALWAYS" ]; then + docleanup +elif [ $res -eq 0 -a "${cleanup}" == "PASS" ]; then + docleanup +fi + +exit $res diff --git a/test/ddthost_test/setup_coeffs.F90 b/test/ddthost_test/setup_coeffs.F90 new file mode 100644 index 00000000..27918695 --- /dev/null +++ b/test/ddthost_test/setup_coeffs.F90 @@ -0,0 +1,24 @@ +module setup_coeffs + use ccpp_kinds, only: kind_phys + implicit none + + public :: setup_coeffs_timestep_init + +contains + !> \section arg_table_setup_coeffs_timestep_init Argument Table + !! \htmlinclude arg_table_setup_coeffs_timestep_init.html + !! + subroutine setup_coeffs_timestep_init(coeffs, errmsg, errflg) + + real(kind_phys), intent(inout) :: coeffs(:) + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + + errmsg = '' + errflg = 0 + + coeffs(:) = 1._kind_phys + + end subroutine setup_coeffs_timestep_init + +end module setup_coeffs diff --git a/test/ddthost_test/setup_coeffs.meta b/test/ddthost_test/setup_coeffs.meta new file mode 100644 index 00000000..8d0fc5f4 --- /dev/null +++ b/test/ddthost_test/setup_coeffs.meta @@ -0,0 +1,29 @@ +[ccpp-table-properties] + name = setup_coeffs + type = scheme +[ccpp-arg-table] + name = setup_coeffs_timestep_init + type = scheme +[ coeffs ] + standard_name = coefficients_for_interpolation + long_name = coefficients for interpolation + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout +[ errmsg ] + standard_name = ccpp_error_message + long_name = Error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=512 + intent = out +[ errflg ] + standard_name = ccpp_error_code + long_name = Error flag for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out diff --git a/test/ddthost_test/temp_adjust.F90 b/test/ddthost_test/temp_adjust.F90 new file mode 100644 index 00000000..0458292c --- /dev/null +++ b/test/ddthost_test/temp_adjust.F90 @@ -0,0 +1,84 @@ +! Test parameterization with no vertical level +! + +module temp_adjust + + use ccpp_kinds, only: kind_phys + + implicit none + private + + public :: temp_adjust_init + public :: temp_adjust_run + public :: temp_adjust_finalize + +contains + + !> \section arg_table_temp_adjust_run Argument Table + !! \htmlinclude arg_table_temp_adjust_run.html + !! + subroutine temp_adjust_run(foo, timestep, temp_prev, temp_layer, qv, ps, & + to_promote, promote_pcnst, errmsg, errflg, innie, outie, optsie) + + integer, intent(in) :: foo + real(kind_phys), intent(in) :: timestep + real(kind_phys), intent(inout),optional :: qv(:) + real(kind_phys), intent(inout) :: ps(:) + real(kind_phys), intent(in) :: temp_prev(:) + real(kind_phys), intent(inout) :: temp_layer(foo) + real(kind_phys), intent(in) :: to_promote(:) + real(kind_phys), intent(in) :: promote_pcnst(:) + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + real(kind_phys), optional, intent(in) :: innie + real(kind_phys), optional, intent(out) :: outie + real(kind_phys), optional, intent(inout) :: optsie + !---------------------------------------------------------------- + + integer :: col_index + + errmsg = '' + errflg = 0 + + do col_index = 1, foo + temp_layer(col_index) = temp_layer(col_index) + temp_prev(col_index) + if (present(qv)) qv(col_index) = qv(col_index) + 1.0_kind_phys + end do + if (present(innie) .and. present(outie) .and. present(optsie)) then + outie = innie * optsie + optsie = optsie + 1.0_kind_phys + end if + + end subroutine temp_adjust_run + + !> \section arg_table_temp_adjust_init Argument Table + !! \htmlinclude arg_table_temp_adjust_init.html + !! + subroutine temp_adjust_init (errmsg, errflg) + + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! This routine currently does nothing + + errmsg = '' + errflg = 0 + + end subroutine temp_adjust_init + + !> \section arg_table_temp_adjust_finalize Argument Table + !! \htmlinclude arg_table_temp_adjust_finalize.html + !! + subroutine temp_adjust_finalize (errmsg, errflg) + + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! This routine currently does nothing + + errmsg = '' + errflg = 0 + + end subroutine temp_adjust_finalize + +end module temp_adjust diff --git a/test/ddthost_test/temp_adjust.meta b/test/ddthost_test/temp_adjust.meta new file mode 100644 index 00000000..420e9112 --- /dev/null +++ b/test/ddthost_test/temp_adjust.meta @@ -0,0 +1,119 @@ +[ccpp-table-properties] + name = temp_adjust + type = scheme + dependencies = qux.F90 + relative_path = adjust +[ccpp-arg-table] + name = temp_adjust_run + type = scheme +[ foo ] + standard_name = horizontal_loop_extent + type = integer + units = count + dimensions = () + intent = in +[ timestep ] + standard_name = time_step_for_physics + long_name = time step + units = s + dimensions = () + type = real + kind = kind_phys + intent = in +[ temp_prev ] + standard_name = potential_temperature_at_previous_timestep + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[ temp_layer ] + standard_name = potential_temperature + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + diagnostic_name = temperature +[ qv ] + standard_name = water_vapor_specific_humidity + units = kg kg-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + diagnostic_name_fixed = Q + optional = True +[ ps ] + standard_name = surface_air_pressure + state_variable = true + type = real + kind = kind_phys + units = Pa + dimensions = (horizontal_loop_extent) + intent = inout +[ to_promote ] + standard_name = promote_this_variable_to_suite + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[ promote_pcnst ] + standard_name = promote_this_variable_with_no_horizontal_dimension + units = K + dimensions = (number_of_tracers) + type = real + kind = kind_phys + intent = in +[ errmsg ] + standard_name = ccpp_error_message + long_name = Error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=512 + intent = out +[ errflg ] + standard_name = ccpp_error_code + long_name = Error flag for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out +[ccpp-arg-table] + name = temp_adjust_init + type = scheme +[ errmsg ] + standard_name = ccpp_error_message + long_name = Error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=512 + intent = out +[ errflg ] + standard_name = ccpp_error_code + long_name = Error flag for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out +[ccpp-arg-table] + name = temp_adjust_finalize + type = scheme +[ errmsg ] + standard_name = ccpp_error_message + long_name = Error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=512 + intent = out +[ errflg ] + standard_name = ccpp_error_code + long_name = Error flag for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out diff --git a/test/ddthost_test/temp_calc_adjust.F90 b/test/ddthost_test/temp_calc_adjust.F90 new file mode 100644 index 00000000..941286e8 --- /dev/null +++ b/test/ddthost_test/temp_calc_adjust.F90 @@ -0,0 +1,95 @@ +!Test parameterization with no vertical level and hanging intent(out) variable +! + +module temp_calc_adjust + + use ccpp_kinds, only: kind_phys + + implicit none + private + + public :: temp_calc_adjust_init + public :: temp_calc_adjust_run + public :: temp_calc_adjust_finalize + +contains + + !> \section arg_table_temp_calc_adjust_run Argument Table + !! \htmlinclude arg_table_temp_calc_adjust_run.html + !! + subroutine temp_calc_adjust_run(nbox, timestep, temp_level, temp_calc, & + errmsg, errflg) + + integer, intent(in) :: nbox + real(kind_phys), intent(in) :: timestep + real(kind_phys), intent(in) :: temp_level(:,:) + real(kind_phys), intent(out) :: temp_calc(:) + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + !---------------------------------------------------------------- + + integer :: col_index + real(kind_phys) :: bar = 1.0_kind_phys + + errmsg = '' + errflg = 0 + + call temp_calc_adjust_nested_subroutine(temp_calc) + if (check_foo()) then + call foo(bar) + end if + + contains + + elemental subroutine temp_calc_adjust_nested_subroutine(temp) + + real(kind_phys), intent(out) :: temp + !------------------------------------------------------------- + + temp = 1.0_kind_phys + + end subroutine temp_calc_adjust_nested_subroutine + + subroutine foo(bar) + real(kind_phys), intent(inout) :: bar + bar = bar + 1.0_kind_phys + + end subroutine + + logical function check_foo() + check_foo = .true. + end function check_foo + + end subroutine + + !> \section arg_table_temp_calc_adjust_init Argument Table + !! \htmlinclude arg_table_temp_calc_adjust_init.html + !! + subroutine temp_calc_adjust_init (errmsg, errflg) + + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! This routine currently does nothing + + errmsg = '' + errflg = 0 + + end subroutine temp_calc_adjust_init + + !> \section arg_table_temp_calc_adjust_finalize Argument Table + !! \htmlinclude arg_table_temp_calc_adjust_finalize.html + !! + subroutine temp_calc_adjust_finalize (errmsg, errflg) + + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! This routine currently does nothing + + errmsg = '' + errflg = 0 + + end subroutine temp_calc_adjust_finalize + +end module temp_calc_adjust diff --git a/test/ddthost_test/temp_calc_adjust.meta b/test/ddthost_test/temp_calc_adjust.meta new file mode 100644 index 00000000..437de934 --- /dev/null +++ b/test/ddthost_test/temp_calc_adjust.meta @@ -0,0 +1,87 @@ +[ccpp-table-properties] + name = temp_calc_adjust + type = scheme + dependencies = foo.F90, bar.F90 +[ccpp-arg-table] + name = temp_calc_adjust_run + type = scheme + process = adjusting +[ nbox ] + standard_name = horizontal_loop_extent + type = integer + units = count + dimensions = () + intent = in +[ timestep ] + standard_name = time_step_for_physics + long_name = time step + units = s + dimensions = () + type = real + kind = kind_phys + intent = in +[ temp_level ] + standard_name = potential_temperature_at_interface + units = K + dimensions = (ccpp_constant_one:horizontal_loop_extent, vertical_interface_dimension) + type = real + kind = kind_phys + intent = in +[ temp_calc ] + standard_name = potential_temperature_at_previous_timestep + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out +[ errmsg ] + standard_name = ccpp_error_message + long_name = Error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=512 + intent = out +[ errflg ] + standard_name = ccpp_error_code + long_name = Error flag for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out +[ccpp-arg-table] + name = temp_calc_adjust_init + type = scheme +[ errmsg ] + standard_name = ccpp_error_message + long_name = Error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=512 + intent = out +[ errflg ] + standard_name = ccpp_error_code + long_name = Error flag for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out +[ccpp-arg-table] + name = temp_calc_adjust_finalize + type = scheme +[ errmsg ] + standard_name = ccpp_error_message + long_name = Error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=512 + intent = out +[ errflg ] + standard_name = ccpp_error_code + long_name = Error flag for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out diff --git a/test/ddthost_test/temp_scheme_files.txt b/test/ddthost_test/temp_scheme_files.txt new file mode 100644 index 00000000..6c831539 --- /dev/null +++ b/test/ddthost_test/temp_scheme_files.txt @@ -0,0 +1,4 @@ +setup_coeffs.meta +temp_set.meta +temp_adjust.meta +temp_calc_adjust.meta diff --git a/test/ddthost_test/temp_set.F90 b/test/ddthost_test/temp_set.F90 new file mode 100644 index 00000000..27233e92 --- /dev/null +++ b/test/ddthost_test/temp_set.F90 @@ -0,0 +1,113 @@ +!Test 3D parameterization +! + +module temp_set + + use ccpp_kinds, only: kind_phys + + implicit none + private + + public :: temp_set_init + public :: temp_set_timestep_initialize + public :: temp_set_run + public :: temp_set_finalize + +contains + +!> \section arg_table_temp_set_run Argument Table +!! \htmlinclude arg_table_temp_set_run.html +!! + subroutine temp_set_run(ncol, lev, timestep, temp_level, temp, ps, & + to_promote, promote_pcnst, errmsg, errflg) +!---------------------------------------------------------------- + implicit none +!---------------------------------------------------------------- + + integer, intent(in) :: ncol, lev + real(kind_phys), intent(out) :: temp(:,:) + real(kind_phys), intent(in) :: timestep + real(kind_phys), intent(in) :: ps(:) + real(kind_phys), intent(inout) :: temp_level(:, :) + real(kind_phys), intent(out) :: to_promote(:, :) + real(kind_phys), intent(out) :: promote_pcnst(:) + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg +!---------------------------------------------------------------- + integer :: ilev + + integer :: col_index + integer :: lev_index + + errmsg = '' + errflg = 0 + + ilev = size(temp_level, 2) + if (ilev /= (lev + 1)) then + errflg = 1 + errmsg = 'Invalid value for ilev, must be lev+1' + return + end if + + do col_index = 1, ncol + do lev_index = 1, lev + temp(col_index, lev_index) = (temp_level(col_index, lev_index) & + + temp_level(col_index, lev_index + 1)) / 2.0_kind_phys + end do + end do + + end subroutine temp_set_run + +!> \section arg_table_temp_set_init Argument Table +!! \htmlinclude arg_table_temp_set_init.html +!! + subroutine temp_set_init(temp_inc_in, fudge, temp_inc_set, errmsg, errflg) + + real(kind_phys), intent(in) :: temp_inc_in + real(kind_phys), intent(in) :: fudge + real(kind_phys), intent(out) :: temp_inc_set + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + + temp_inc_set = temp_inc_in + + errmsg = '' + errflg = 0 + + end subroutine temp_set_init + +!> \section arg_table_temp_set_timestep_initialize Argument Table +!! \htmlinclude arg_table_temp_set_timestep_initialize.html +!! + subroutine temp_set_timestep_initialize(ncol, temp_inc, temp_level, & + errmsg, errflg) + + integer, intent(in) :: ncol + real(kind_phys), intent(in) :: temp_inc + real(kind_phys), intent(inout) :: temp_level(:,:) + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + + errmsg = '' + errflg = 0 + + temp_level = temp_level + temp_inc + + end subroutine temp_set_timestep_initialize + +!> \section arg_table_temp_set_finalize Argument Table +!! \htmlinclude arg_table_temp_set_finalize.html +!! + subroutine temp_set_finalize(errmsg, errflg) + + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! This routine currently does nothing + + errmsg = '' + errflg = 0 + + end subroutine temp_set_finalize + +end module temp_set diff --git a/test/ddthost_test/temp_set.meta b/test/ddthost_test/temp_set.meta new file mode 100644 index 00000000..b6c403ce --- /dev/null +++ b/test/ddthost_test/temp_set.meta @@ -0,0 +1,181 @@ +[ccpp-table-properties] + name = temp_set + type = scheme +[ccpp-arg-table] + name = temp_set_run + type = scheme + process = setter +[ ncol ] + standard_name = horizontal_loop_extent + type = integer + units = count + dimensions = () + intent = in +[ lev ] + standard_name = vertical_layer_dimension + type = integer + units = count + dimensions = () + intent = in +[ timestep ] + standard_name = time_step_for_physics + long_name = time step + units = s + dimensions = () + type = real + kind = kind_phys + intent = in +[ temp_level ] + standard_name = potential_temperature_at_interface + units = K + dimensions = (ccpp_constant_one:horizontal_loop_extent, vertical_interface_dimension) + type = real + kind = kind_phys + intent = inout +[ temp ] + standard_name = potential_temperature + units = K + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ ps ] + standard_name = surface_air_pressure + state_variable = true + type = real + kind = kind_phys + units = Pa + dimensions = (horizontal_loop_extent) + intent = in +[ to_promote ] + standard_name = promote_this_variable_to_suite + units = K + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ promote_pcnst ] + standard_name = promote_this_variable_with_no_horizontal_dimension + units = K + dimensions = (number_of_tracers) + type = real + kind = kind_phys + intent = out +[ errmsg ] + standard_name = ccpp_error_message + long_name = Error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=512 + intent = out +[ errflg ] + standard_name = ccpp_error_code + long_name = Error flag for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out +# Init +[ccpp-arg-table] + name = temp_set_init + type = scheme +[ temp_inc_in ] + standard_name = potential_temperature_increment + long_name = Per time step potential temperature increment + units = K + dimensions = () + type = real + kind = kind_phys + intent = in +[ fudge ] + standard_name = random_fudge_factor + long_name = Ignore this + units = 1 + dimensions = () + type = real + kind = kind_phys + intent = in + default_value = 1.0_kind_phys +[ temp_inc_set ] + standard_name = test_potential_temperature_increment + long_name = Per time step potential temperature increment + units = K + dimensions = () + type = real + kind = kind_phys + intent = out +[ errmsg ] + standard_name = ccpp_error_message + long_name = Error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=512 + intent = out +[ errflg ] + standard_name = ccpp_error_code + long_name = Error flag for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out +# Timestep Initialization +[ccpp-arg-table] + name = temp_set_timestep_initialize + type = scheme +[ ncol ] + standard_name = horizontal_dimension + type = integer + units = count + dimensions = () + intent = in +[ temp_inc ] + standard_name = test_potential_temperature_increment + long_name = Per time step potential temperature increment + units = K + dimensions = () + type = real + kind = kind_phys + intent = in +[ temp_level ] + standard_name = potential_temperature_at_interface + units = K + dimensions = (horizontal_dimension, vertical_interface_dimension) + type = real + kind = kind_phys + intent = inout +[ errmsg ] + standard_name = ccpp_error_message + long_name = Error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=512 + intent = out +[ errflg ] + standard_name = ccpp_error_code + long_name = Error flag for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out +# Finalize +[ccpp-arg-table] + name = temp_set_finalize + type = scheme +[ errmsg ] + standard_name = ccpp_error_message + long_name = Error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=512 + intent = out +[ errflg ] + standard_name = ccpp_error_code + long_name = Error flag for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out diff --git a/test/ddthost_test/temp_suite.xml b/test/ddthost_test/temp_suite.xml new file mode 100644 index 00000000..7a4795c4 --- /dev/null +++ b/test/ddthost_test/temp_suite.xml @@ -0,0 +1,12 @@ + + + + + setup_coeffs + temp_set + + + temp_calc_adjust + temp_adjust + + diff --git a/test/ddthost_test/test_host.F90 b/test/ddthost_test/test_host.F90 new file mode 100644 index 00000000..02809e8d --- /dev/null +++ b/test/ddthost_test/test_host.F90 @@ -0,0 +1,429 @@ +module test_prog + + use ccpp_kinds, only: kind_phys + + implicit none + private + + public test_host + + ! Public data and interfaces + integer, public, parameter :: cs = 16 + integer, public, parameter :: cm = 36 + + !> \section arg_table_suite_info Argument Table + !! \htmlinclude arg_table_suite_info.html + !! + type, public :: suite_info + character(len=cs) :: suite_name = '' + character(len=cs), pointer :: suite_parts(:) => NULL() + character(len=cm), pointer :: suite_input_vars(:) => NULL() + character(len=cm), pointer :: suite_output_vars(:) => NULL() + character(len=cm), pointer :: suite_required_vars(:) => NULL() + end type suite_info + +contains + + logical function check_list(test_list, chk_list, list_desc, suite_name) + ! Check a list () against its expected value () + + ! Dummy arguments + character(len=*), intent(in) :: test_list(:) + character(len=*), intent(in) :: chk_list(:) + character(len=*), intent(in) :: list_desc + character(len=*), optional, intent(in) :: suite_name + + ! Local variables + logical :: found + integer :: num_items + integer :: lindex, tindex + integer, allocatable :: check_unique(:) + character(len=2) :: sep + character(len=256) :: errmsg + + check_list = .true. + errmsg = '' + + ! Check the list size + num_items = size(chk_list) + if (size(test_list) /= num_items) then + write(errmsg, '(a,i0,2a)') 'ERROR: Found ', size(test_list), & + ' ', trim(list_desc) + if (present(suite_name)) then + write(errmsg(len_trim(errmsg)+1:), '(2a)') ' for suite, ', & + trim(suite_name) + end if + write(errmsg(len_trim(errmsg)+1:), '(a,i0)') ', should be ', num_items + write(6, *) trim(errmsg) + errmsg = '' + check_list = .false. + end if + + ! Now, check the list contents for 1-1 correspondence + if (check_list) then + allocate(check_unique(num_items)) + check_unique = -1 + do lindex = 1, num_items + found = .false. + do tindex = 1, num_items + if (trim(test_list(lindex)) == trim(chk_list(tindex))) then + check_unique(tindex) = lindex + found = .true. + exit + end if + end do + if (.not. found) then + check_list = .false. + write(errmsg, '(5a)') 'ERROR: ', trim(list_desc), ' item, ', & + trim(test_list(lindex)), ', was not found' + if (present(suite_name)) then + write(errmsg(len_trim(errmsg)+1:), '(2a)') ' in suite, ', & + trim(suite_name) + end if + write(6, *) trim(errmsg) + errmsg = '' + end if + end do + if (check_list .and. any(check_unique < 0)) then + check_list = .false. + write(errmsg, '(3a)') 'ERROR: The following ', trim(list_desc), & + ' items were not found' + if (present(suite_name)) then + write(errmsg(len_trim(errmsg)+1:), '(2a)') ' in suite, ', & + trim(suite_name) + end if + sep = '; ' + do lindex = 1, num_items + if (check_unique(lindex) < 0) then + write(errmsg(len_trim(errmsg)+1:), '(2a)') sep, & + trim(chk_list(lindex)) + sep = ', ' + end if + end do + write(6, *) trim(errmsg) + errmsg = '' + end if + end if + + end function check_list + + logical function check_suite(test_suite) + use test_host_ccpp_cap, only: ccpp_physics_suite_part_list + use test_host_ccpp_cap, only: ccpp_physics_suite_variables + + ! Dummy argument + type(suite_info), intent(in) :: test_suite + ! Local variables + integer :: sind + logical :: check + integer :: errflg + character(len=512) :: errmsg + character(len=128), allocatable :: test_list(:) + + check_suite = .true. + write(6, *) "Checking suite ", trim(test_suite%suite_name) + ! First, check the suite parts + call ccpp_physics_suite_part_list(test_suite%suite_name, test_list, & + errmsg, errflg) + if (errflg == 0) then + check = check_list(test_list, test_suite%suite_parts, 'part names', & + suite_name=test_suite%suite_name) + else + check = .false. + write(6, '(a,i0,2a)') 'ERROR ', errflg, ': ', trim(errmsg) + end if + check_suite = check_suite .and. check + if (allocated(test_list)) then + deallocate(test_list) + end if + ! Check the input variables + call ccpp_physics_suite_variables(test_suite%suite_name, test_list, & + errmsg, errflg, input_vars=.true., output_vars=.false.) + if (errflg == 0) then + check = check_list(test_list, test_suite%suite_input_vars, & + 'input variable names', suite_name=test_suite%suite_name) + else + check = .false. + write(6, '(a,i0,2a)') 'ERROR ', errflg, ': ', trim(errmsg) + end if + check_suite = check_suite .and. check + if (allocated(test_list)) then + deallocate(test_list) + end if + ! Check the output variables + call ccpp_physics_suite_variables(test_suite%suite_name, test_list, & + errmsg, errflg, input_vars=.false., output_vars=.true.) + if (errflg == 0) then + check = check_list(test_list, test_suite%suite_output_vars, & + 'output variable names', suite_name=test_suite%suite_name) + else + check = .false. + write(6, '(a,i0,2a)') 'ERROR ', errflg, ': ', trim(errmsg) + end if + check_suite = check_suite .and. check + if (allocated(test_list)) then + deallocate(test_list) + end if + ! Check all required variables + call ccpp_physics_suite_variables(test_suite%suite_name, test_list, & + errmsg, errflg) + if (errflg == 0) then + check = check_list(test_list, test_suite%suite_required_vars, & + 'required variable names', suite_name=test_suite%suite_name) + else + check = .false. + write(6, '(a,i0,2a)') 'ERROR ', errflg, ': ', trim(errmsg) + end if + check_suite = check_suite .and. check + if (allocated(test_list)) then + deallocate(test_list) + end if + end function check_suite + + + !> \section arg_table_test_host Argument Table + !! \htmlinclude arg_table_test_host.html + !! + subroutine test_host(retval, test_suites) + + use host_ccpp_ddt, only: ccpp_info_t + use test_host_mod, only: ncols, num_time_steps + use test_host_ccpp_cap, only: test_host_ccpp_physics_initialize + use test_host_ccpp_cap, only: test_host_ccpp_physics_timestep_initial + use test_host_ccpp_cap, only: test_host_ccpp_physics_run + use test_host_ccpp_cap, only: test_host_ccpp_physics_timestep_final + use test_host_ccpp_cap, only: test_host_ccpp_physics_finalize + use test_host_ccpp_cap, only: ccpp_physics_suite_list + use test_host_mod, only: init_data, compare_data, check_model_times + + type(suite_info), intent(in) :: test_suites(:) + logical, intent(out) :: retval + + logical :: check + integer :: col_start + integer :: index, sind + integer :: time_step + integer :: num_suites + character(len=128), allocatable :: suite_names(:) + type(ccpp_info_t) :: ccpp_info + + ! Initialize our 'data' + call init_data() + + ! Gather and test the inspection routines + num_suites = size(test_suites) + call ccpp_physics_suite_list(suite_names) + retval = check_list(suite_names, test_suites(:)%suite_name, & + 'suite names') + write(6, *) 'Available suites are:' + do index = 1, size(suite_names) + do sind = 1, num_suites + if (trim(test_suites(sind)%suite_name) == & + trim(suite_names(index))) then + exit + end if + end do + write(6, '(i0,3a,i0,a)') index, ') ', trim(suite_names(index)), & + ' = test_suites(', sind, ')' + end do + if (retval) then + do sind = 1, num_suites + check = check_suite(test_suites(sind)) + retval = retval .and. check + end do + end if + !!! Return here if any check failed + if (.not. retval) then + return + end if + + ! Use the suite information to setup the run + do sind = 1, num_suites + call test_host_ccpp_physics_initialize(test_suites(sind)%suite_name, & + ccpp_info) + if (ccpp_info%errflg /= 0) then + write(6, '(4a)') 'ERROR in initialize of ', & + trim(test_suites(sind)%suite_name), ': ', trim(ccpp_info%errmsg) + end if + end do + ! Loop over time steps + do time_step = 1, num_time_steps + ! Initialize the timestep + do sind = 1, num_suites + if (ccpp_info%errflg /= 0) then + exit + end if + if (ccpp_info%errflg == 0) then + call test_host_ccpp_physics_timestep_initial( & + test_suites(sind)%suite_name, ccpp_info) + end if + if (ccpp_info%errflg /= 0) then + write(6, '(3a)') trim(test_suites(sind)%suite_name), ': ', & + trim(ccpp_info%errmsg) + exit + end if + if (ccpp_info%errflg /= 0) then + exit + end if + end do + + do col_start = 1, ncols, 5 + if (ccpp_info%errflg /= 0) then + exit + end if + ccpp_info%col_start = col_start + ccpp_info%col_end = MIN(col_start + 4, ncols) + + do sind = 1, num_suites + if (ccpp_info%errflg /= 0) then + exit + end if + do index = 1, size(test_suites(sind)%suite_parts) + if (ccpp_info%errflg /= 0) then + exit + end if + if (ccpp_info%errflg == 0) then + call test_host_ccpp_physics_run( & + test_suites(sind)%suite_name, & + test_suites(sind)%suite_parts(index), & + ccpp_info) + end if + if (ccpp_info%errflg /= 0) then + write(6, '(5a)') trim(test_suites(sind)%suite_name), & + '/', trim(test_suites(sind)%suite_parts(index)), & + ': ', trim(ccpp_info%errmsg) + exit + end if + end do + end do + end do + + do sind = 1, num_suites + if (ccpp_info%errflg /= 0) then + exit + end if + if (ccpp_info%errflg == 0) then + call test_host_ccpp_physics_timestep_final( & + test_suites(sind)%suite_name, ccpp_info) + end if + if (ccpp_info%errflg /= 0) then + write(6, '(3a)') trim(test_suites(sind)%suite_name), ': ', & + trim(ccpp_info%errmsg) + exit + end if + end do + end do ! End time step loop + + do sind = 1, num_suites + if (ccpp_info%errflg /= 0) then + exit + end if + if (ccpp_info%errflg == 0) then + call test_host_ccpp_physics_finalize( & + test_suites(sind)%suite_name,ccpp_info) + end if + if (ccpp_info%errflg /= 0) then + write(6, '(3a)') test_suites(sind)%suite_parts(index), ': ', & + trim(ccpp_info%errmsg) + write(6,'(2a)') 'An error occurred in ccpp_timestep_final, ', & + 'Exiting...' + exit + end if + end do + + if (ccpp_info%errflg == 0) then + ! Run finished without error, check answers + if (.not. check_model_times()) then + write(6, *) 'Model times error!' + ccpp_info%errflg = -1 + else if (compare_data()) then + write(6, *) 'Answers are correct!' + ccpp_info%errflg = 0 + else + write(6, *) 'Answers are not correct!' + ccpp_info%errflg = -1 + end if + end if + + retval = ccpp_info%errflg == 0 + + end subroutine test_host + + end module test_prog + + program test + use test_prog, only: test_host, suite_info, cm, cs + + implicit none + + character(len=cs), target :: test_parts1(2) = (/ 'physics1 ', & + 'physics2 ' /) + character(len=cs), target :: test_parts2(1) = (/ 'data_prep ' /) + character(len=cm), target :: test_invars1(7) = (/ & + 'potential_temperature ', & + 'potential_temperature_at_interface ', & + 'coefficients_for_interpolation ', & + 'surface_air_pressure ', & + 'water_vapor_specific_humidity ', & + 'potential_temperature_increment ', & + 'time_step_for_physics ' /) + character(len=cm), target :: test_outvars1(7) = (/ & + 'potential_temperature ', & + 'potential_temperature_at_interface ', & + 'coefficients_for_interpolation ', & + 'surface_air_pressure ', & + 'water_vapor_specific_humidity ', & + 'ccpp_error_code ', & + 'ccpp_error_message ' /) + character(len=cm), target :: test_reqvars1(9) = (/ & + 'potential_temperature ', & + 'potential_temperature_at_interface ', & + 'coefficients_for_interpolation ', & + 'surface_air_pressure ', & + 'water_vapor_specific_humidity ', & + 'potential_temperature_increment ', & + 'time_step_for_physics ', & + 'ccpp_error_code ', & + 'ccpp_error_message ' /) + + character(len=cm), target :: test_invars2(3) = (/ & + 'model_times ', & + 'number_of_model_times ', & + 'surface_air_pressure ' /) + + character(len=cm), target :: test_outvars2(4) = (/ & + 'ccpp_error_code ', & + 'ccpp_error_message ', & + 'model_times ', & + 'number_of_model_times ' /) + + character(len=cm), target :: test_reqvars2(5) = (/ & + 'model_times ', & + 'number_of_model_times ', & + 'surface_air_pressure ', & + 'ccpp_error_code ', & + 'ccpp_error_message ' /) + type(suite_info) :: test_suites(2) + logical :: run_okay + + ! Setup expected test suite info + test_suites(1)%suite_name = 'temp_suite' + test_suites(1)%suite_parts => test_parts1 + test_suites(1)%suite_input_vars => test_invars1 + test_suites(1)%suite_output_vars => test_outvars1 + test_suites(1)%suite_required_vars => test_reqvars1 + test_suites(2)%suite_name = 'ddt_suite' + test_suites(2)%suite_parts => test_parts2 + test_suites(2)%suite_input_vars => test_invars2 + test_suites(2)%suite_output_vars => test_outvars2 + test_suites(2)%suite_required_vars => test_reqvars2 + + call test_host(run_okay, test_suites) + + if (run_okay) then + STOP 0 + else + STOP -1 + end if + +end program test diff --git a/test/ddthost_test/test_host.meta b/test/ddthost_test/test_host.meta new file mode 100644 index 00000000..82fdc462 --- /dev/null +++ b/test/ddthost_test/test_host.meta @@ -0,0 +1,18 @@ +[ccpp-table-properties] + name = suite_info + type = ddt +[ccpp-arg-table] + name = suite_info + type = ddt + +[ccpp-table-properties] + name = test_host + type = host +[ccpp-arg-table] + name = test_host + type = host +[ ccpp ] + standard_name = host_standard_ccpp_type + type = ccpp_info_t + dimensions = () + protected = False diff --git a/test/ddthost_test/test_host_data.F90 b/test/ddthost_test/test_host_data.F90 new file mode 100644 index 00000000..7a651fca --- /dev/null +++ b/test/ddthost_test/test_host_data.F90 @@ -0,0 +1,51 @@ +module test_host_data + + use ccpp_kinds, only: kind_phys + + !> \section arg_table_physics_state Argument Table + !! \htmlinclude arg_table_physics_state.html + type physics_state + real(kind_phys), dimension(:), allocatable :: & + ps ! surface pressure + real(kind_phys), dimension(:,:), allocatable :: & + u, & ! zonal wind (m/s) + v, & ! meridional wind (m/s) + pmid ! midpoint pressure (Pa) + + real(kind_phys), dimension(:,:,:),allocatable :: & + q ! constituent mixing ratio (kg/kg moist or dry air depending on type) + end type physics_state + + public allocate_physics_state + +contains + + subroutine allocate_physics_state(cols, levels, constituents, state) + integer, intent(in) :: cols + integer, intent(in) :: levels + integer, intent(in) :: constituents + type(physics_state), intent(out) :: state + + if (allocated(state%ps)) then + deallocate(state%ps) + end if + allocate(state%ps(cols)) + if (allocated(state%u)) then + deallocate(state%u) + end if + allocate(state%u(cols, levels)) + if (allocated(state%v)) then + deallocate(state%v) + end if + allocate(state%v(cols, levels)) + if (allocated(state%pmid)) then + deallocate(state%pmid) + end if + allocate(state%pmid(cols, levels)) + if (allocated(state%q)) then + deallocate(state%q) + end if + allocate(state%q(cols, levels, constituents)) + + end subroutine allocate_physics_state +end module test_host_data diff --git a/test/ddthost_test/test_host_data.meta b/test/ddthost_test/test_host_data.meta new file mode 100644 index 00000000..df4b92b4 --- /dev/null +++ b/test/ddthost_test/test_host_data.meta @@ -0,0 +1,52 @@ +[ccpp-table-properties] + name = physics_state + type = ddt +[ccpp-arg-table] + name = physics_state + type = ddt +[ ps ] + standard_name = surface_air_pressure + state_variable = true + type = real + kind = kind_phys + units = Pa + dimensions = (horizontal_dimension) +[ u ] + standard_name = eastward_wind + long_name = Zonal wind + state_variable = true + type = real + kind = kind_phys + units = m s-1 + dimensions = (horizontal_dimension, vertical_layer_dimension) +[ v ] + standard_name = northward_wind + long_name = Meridional wind + state_variable = true + type = real + kind = kind_phys + units = m s-1 + dimensions = (horizontal_dimension, vertical_layer_dimension) +[ pmid ] + standard_name = air_pressure + long_name = Midpoint air pressure + state_variable = true + type = real + kind = kind_phys + units = Pa + dimensions = (horizontal_dimension, vertical_layer_dimension) +[ q ] + standard_name = constituent_mixing_ratio + state_variable = true + type = real + kind = kind_phys + units = kg kg-1 moist or dry air depending on type + dimensions = (horizontal_dimension, vertical_layer_dimension, number_of_tracers) +[ q(:,:,index_of_water_vapor_specific_humidity) ] + standard_name = water_vapor_specific_humidity + state_variable = true + type = real + kind = kind_phys + units = kg kg-1 + dimensions = (horizontal_dimension, vertical_layer_dimension) + active = (index_of_water_vapor_specific_humidity > 0) diff --git a/test/ddthost_test/test_host_mod.F90 b/test/ddthost_test/test_host_mod.F90 new file mode 100644 index 00000000..43be333a --- /dev/null +++ b/test/ddthost_test/test_host_mod.F90 @@ -0,0 +1,140 @@ +module test_host_mod + + use ccpp_kinds, only: kind_phys + use test_host_data, only: physics_state, allocate_physics_state + + implicit none + public + + !> \section arg_table_test_host_mod Argument Table + !! \htmlinclude arg_table_test_host_host.html + !! + integer, parameter :: ncols = 10 + integer, parameter :: pver = 5 + integer, parameter :: pverP = 6 + integer, parameter :: pcnst = 2 + integer, parameter :: DiagDimStart = 2 + integer, parameter :: index_qv = 1 + real(kind_phys), allocatable :: temp_midpoints(:,:) + real(kind_phys) :: temp_interfaces(ncols, pverP) + real(kind_phys) :: coeffs(ncols) + real(kind_phys), dimension(DiagDimStart:ncols, DiagDimStart:pver) :: & + diag1, & + diag2 + real(kind_phys) :: dt + real(kind_phys), parameter :: temp_inc = 0.05_kind_phys + type(physics_state) :: phys_state + integer :: num_model_times = -1 + integer, allocatable :: model_times(:) + + integer, parameter :: num_time_steps = 2 + real(kind_phys), parameter :: tolerance = 1.0e-13_kind_phys + real(kind_phys) :: tint_save(ncols, pverP) + + public :: init_data + public :: compare_data + public :: check_model_times + +contains + + subroutine init_data() + + integer :: col + integer :: lev + integer :: cind + integer :: offsize + + ! Allocate and initialize temperature + allocate(temp_midpoints(ncols, pver)) + temp_midpoints = 0.0_kind_phys + do lev = 1, pverP + offsize = ((cind - 1) * (ncols * pver)) + ((lev - 1) * ncols) + do col = 1, ncols + temp_interfaces(col, lev) = real(offsize + col, kind=kind_phys) + tint_save(col, lev) = temp_interfaces(col, lev) + end do + end do + ! Allocate and initialize state + call allocate_physics_state(ncols, pver, pcnst, phys_state) + do cind = 1, pcnst + do lev = 1, pver + offsize = ((cind - 1) * (ncols * pver)) + ((lev - 1) * ncols) + do col = 1, ncols + phys_state%q(col, lev, cind) = real(offsize + col, kind=kind_phys) + end do + end do + end do + + end subroutine init_data + + logical function check_model_times() + + check_model_times = (num_model_times > 0) + if (check_model_times) then + check_model_times = (size(model_times) == num_model_times) + if (.not. check_model_times) then + write(6, '(2(a,i0))') 'model_times size mismatch, ', & + size(model_times), ' should be ', num_model_times + end if + else + write(6, '(a,i0,a)') 'num_model_times mismatch, ',num_model_times, & + ' should be greater than zero' + end if + + end function check_model_times + + logical function compare_data() + + integer :: col + integer :: lev + integer :: cind + integer :: offsize + logical :: need_header + real(kind_phys) :: avg + integer, parameter :: cincrements(pcnst) = (/ 1, 0 /) + + compare_data = .true. + + need_header = .true. + do lev = 1, pver + do col = 1, ncols + avg = (tint_save(col,lev) + tint_save(col,lev+1)) + avg = 1.0_kind_phys + (avg / 2.0_kind_phys) + avg = avg + (temp_inc * num_time_steps) + if (abs((temp_midpoints(col, lev) - avg) / avg) > tolerance) then + if (need_header) then + write(6, '(" COL LEV T MIDPOINTS EXPECTED")') + need_header = .false. + end if + write(6, '(2i5,2(3x,es15.7))') col, lev, & + temp_midpoints(col, lev), avg + compare_data = .false. + end if + end do + end do + ! Check constituents + need_header = .true. + do cind = 1, pcnst + do lev = 1, pver + offsize = ((cind - 1) * (ncols * pver)) + ((lev - 1) * ncols) + do col = 1, ncols + avg = real(offsize + col + (cincrements(cind) * num_time_steps), & + kind=kind_phys) + if (abs((phys_state%q(col, lev, cind) - avg) / avg) > & + tolerance) then + if (need_header) then + write(6, '(2(2x,a),3x,a,10x,a,14x,a)') & + 'COL', 'LEV', 'C#', 'Q', 'EXPECTED' + need_header = .false. + end if + write(6, '(3i5,2(3x,es15.7))') col, lev, cind, & + phys_state%q(col, lev, cind), avg + compare_data = .false. + end if + end do + end do + end do + + end function compare_data + +end module test_host_mod diff --git a/test/ddthost_test/test_host_mod.meta b/test/ddthost_test/test_host_mod.meta new file mode 100644 index 00000000..a450ee67 --- /dev/null +++ b/test/ddthost_test/test_host_mod.meta @@ -0,0 +1,98 @@ +[ccpp-table-properties] + name = test_host_mod + type = module +[ccpp-arg-table] + name = test_host_mod + type = module +[ index_qv ] + standard_name = index_of_water_vapor_specific_humidity + units = index + type = integer + protected = True + dimensions = () +[ ncols] + standard_name = horizontal_dimension + units = count + type = integer + protected = True + dimensions = () +[ pver ] + standard_name = vertical_layer_dimension + units = count + type = integer + protected = True + dimensions = () +[ pverP ] + standard_name = vertical_interface_dimension + type = integer + units = count + protected = True + dimensions = () +[ pcnst ] + standard_name = number_of_tracers + type = integer + units = count + protected = True + dimensions = () +[ DiagDimStart ] + standard_name = first_index_of_diag_fields + type = integer + units = count + protected = True + dimensions = () +[ temp_midpoints ] + standard_name = potential_temperature + units = K + dimensions = (horizontal_dimension, vertical_layer_dimension) + type = real | kind = kind_phys +[ temp_interfaces ] + standard_name = potential_temperature_at_interface + units = K + dimensions = (horizontal_dimension, vertical_interface_dimension) + type = real | kind = kind_phys +[ diag1 ] + standard_name = diagnostic_stuff_type_1 + long_name = This is just a test field + units = K + dimensions = (first_index_of_diag_fields:horizontal_dimension, first_index_of_diag_fields:vertical_layer_dimension) + type = real | kind = kind_phys +[ diag2 ] + standard_name = diagnostic_stuff_type_2 + long_name = This is just a test field + units = K + dimensions = (first_index_of_diag_fields: horizontal_dimension, first_index_of_diag_fields :vertical_layer_dimension) + type = real | kind = kind_phys +[ dt ] + standard_name = time_step_for_physics + long_name = time step + units = s + dimensions = () + type = real | kind = kind_phys +[ temp_inc ] + standard_name = potential_temperature_increment + long_name = Per time step potential temperature increment + units = K + dimensions = () + type = real | kind = kind_phys +[ phys_state ] + standard_name = physics_state_derived_type + long_name = Physics State DDT + type = physics_state + dimensions = () +[ num_model_times ] + standard_name = number_of_model_times + type = integer + units = count + dimensions = () +[ model_times ] + standard_name = model_times + units = seconds + dimensions = (number_of_model_times) + type = integer + allocatable = True +[ coeffs ] + standard_name = coefficients_for_interpolation + long_name = coefficients for interpolation + units = none + dimensions = (horizontal_dimension) + type = real | kind = kind_phys \ No newline at end of file diff --git a/test/ddthost_test/test_reports.py b/test/ddthost_test/test_reports.py new file mode 100644 index 00000000..99046387 --- /dev/null +++ b/test/ddthost_test/test_reports.py @@ -0,0 +1,178 @@ +#! /usr/bin/env python3 +""" +----------------------------------------------------------------------- + Description: Test capgen database report python interface + + Assumptions: + + Command line arguments: build_dir database_filepath + + Usage: python test_reports +----------------------------------------------------------------------- +""" +import sys +import os + +_TEST_DIR = os.path.dirname(os.path.abspath(__file__)) +_FRAMEWORK_DIR = os.path.abspath(os.path.join(_TEST_DIR, os.pardir, os.pardir)) +_SCRIPTS_DIR = os.path.join(_FRAMEWORK_DIR, "scripts") +_SRC_DIR = os.path.join(_FRAMEWORK_DIR, "src") + +if not os.path.exists(_SCRIPTS_DIR): + raise ImportError("Cannot find scripts directory") +# end if + +sys.path.append(_SCRIPTS_DIR) +# pylint: disable=wrong-import-position +from ccpp_datafile import datatable_report, DatatableReport +# pylint: enable=wrong-import-position + +import argparse + +parser = argparse.ArgumentParser(description="Test capgen database report python interface") +parser.add_argument('build_dir') +parser.add_argument('database_filepath') +if len(sys.argv) > 3: + parser.error("Too many arguments") +# end if +args = parser.parse_args() +_BUILD_DIR = os.path.abspath(args.build_dir) +_DATABASE = os.path.abspath(args.database_filepath) +if not os.path.isdir(_BUILD_DIR): + parser.error(" must be an existing build directory") +# end if +if (not os.path.exists(_DATABASE)) or (not os.path.isfile(_DATABASE)): + parser.error(" must be an existing CCPP database file") +# end if + +# Check data +_HOST_FILES = [os.path.join(_BUILD_DIR, "ccpp", "test_host_ccpp_cap.F90")] +_SUITE_FILES = [os.path.join(_BUILD_DIR, "ccpp", "ccpp_ddt_suite_cap.F90"), + os.path.join(_BUILD_DIR, "ccpp", "ccpp_temp_suite_cap.F90")] +_UTILITY_FILES = [os.path.join(_BUILD_DIR, "ccpp", "ccpp_kinds.F90"), + os.path.join(_SRC_DIR, "ccpp_constituent_prop_mod.F90"), + os.path.join(_SRC_DIR, "ccpp_hashable.F90"), + os.path.join(_SRC_DIR, "ccpp_hash_table.F90")] +_CCPP_FILES = _UTILITY_FILES + \ + [os.path.join(_BUILD_DIR, "ccpp", "test_host_ccpp_cap.F90"), + os.path.join(_BUILD_DIR, "ccpp", "ccpp_ddt_suite_cap.F90"), + os.path.join(_BUILD_DIR, "ccpp", "ccpp_temp_suite_cap.F90")] +_PROCESS_LIST = ["setter=temp_set", "adjusting=temp_calc_adjust"] +_MODULE_LIST = ["environ_conditions", "make_ddt", "setup_coeffs", "temp_adjust", + "temp_calc_adjust", "temp_set"] +_SUITE_LIST = ["ddt_suite", "temp_suite"] +_INPUT_VARS_DDT = ["model_times", "number_of_model_times", + "horizontal_loop_begin", "horizontal_loop_end", + "surface_air_pressure", "horizontal_dimension"] +_OUTPUT_VARS_DDT = ["ccpp_error_code", "ccpp_error_message", "model_times", + "number_of_model_times"] +_REQUIRED_VARS_DDT = _INPUT_VARS_DDT + _OUTPUT_VARS_DDT +_PROT_VARS_TEMP = ["horizontal_loop_begin", "horizontal_loop_end", + "horizontal_dimension", "vertical_layer_dimension", + "number_of_tracers", + # Added for --debug + "index_of_water_vapor_specific_humidity", + "vertical_interface_dimension"] +_REQUIRED_VARS_TEMP = ["ccpp_error_code", "ccpp_error_message", + "potential_temperature", + "potential_temperature_at_interface", + "coefficients_for_interpolation", + "potential_temperature_increment", + "surface_air_pressure", "time_step_for_physics", + "water_vapor_specific_humidity"] +_INPUT_VARS_TEMP = ["potential_temperature", + "potential_temperature_at_interface", + "coefficients_for_interpolation", + "potential_temperature_increment", + "surface_air_pressure", "time_step_for_physics", + "water_vapor_specific_humidity"] +_OUTPUT_VARS_TEMP = ["ccpp_error_code", "ccpp_error_message", + "potential_temperature", + "potential_temperature_at_interface", + "coefficients_for_interpolation", + "surface_air_pressure", "water_vapor_specific_humidity"] + +def fields_string(field_type, field_list, sep): + """Create an error string for field(s), . + is used to separate items in """ + indent = ' '*11 + fmsg = "" + if field_list: + if len(field_list) > 1: + field_str = f"{field_type} Fields: " + else: + field_str = f"{field_type} Field: " + # end if + fmsg = f"\n{indent}{field_str}{sep.join(sorted(field_list))}" + # end if + return fmsg + +def check_datatable(database, report_type, check_list, + sep=',', exclude_protected=False): + """Run a database report and check the return string. + If an error is found, print an error message. + Return the number of errors""" + if sep is None: + sep = ',' + # end if + test_str = datatable_report(database, report_type, sep, exclude_protected=exclude_protected) + test_list = [x for x in test_str.split(sep) if x] + tests_run = set(test_list) + expected_tests = set(check_list) + missing = expected_tests - tests_run + unexpected = tests_run - expected_tests + if missing or unexpected: + vmsg = f"ERROR in {report_type.action} datafile check:" + vmsg += fields_string("Missing", missing, sep) + vmsg += fields_string("Unexpected", unexpected, sep) + print(vmsg) + else: + print(f"{report_type.action} report okay") + # end if + return len(missing) + len(unexpected) + +NUM_ERRORS = 0 +print("Checking required files from python:") +NUM_ERRORS += check_datatable(_DATABASE, DatatableReport("host_files"), + _HOST_FILES) +NUM_ERRORS += check_datatable(_DATABASE, DatatableReport("suite_files"), + _SUITE_FILES) +NUM_ERRORS += check_datatable(_DATABASE, DatatableReport("utility_files"), + _UTILITY_FILES) +NUM_ERRORS += check_datatable(_DATABASE, DatatableReport("ccpp_files"), + _CCPP_FILES) +print("\nChecking lists from python") +NUM_ERRORS += check_datatable(_DATABASE, DatatableReport("process_list"), + _PROCESS_LIST) +NUM_ERRORS += check_datatable(_DATABASE, DatatableReport("module_list"), + _MODULE_LIST) +NUM_ERRORS += check_datatable(_DATABASE, DatatableReport("suite_list"), + _SUITE_LIST) +print("\nChecking variables for DDT suite from python") +NUM_ERRORS += check_datatable(_DATABASE, DatatableReport("required_variables", + value="ddt_suite"), + _REQUIRED_VARS_DDT) +NUM_ERRORS += check_datatable(_DATABASE, DatatableReport("input_variables", + value="ddt_suite"), + _INPUT_VARS_DDT) +NUM_ERRORS += check_datatable(_DATABASE, DatatableReport("output_variables", + value="ddt_suite"), + _OUTPUT_VARS_DDT) +print("\nChecking variables for temp suite from python") +NUM_ERRORS += check_datatable(_DATABASE, DatatableReport("required_variables", + value="temp_suite"), + _REQUIRED_VARS_TEMP + _PROT_VARS_TEMP) +NUM_ERRORS += check_datatable(_DATABASE, DatatableReport("required_variables", + value="temp_suite"), + _REQUIRED_VARS_TEMP, exclude_protected=True) +NUM_ERRORS += check_datatable(_DATABASE, DatatableReport("input_variables", + value="temp_suite"), + _INPUT_VARS_TEMP + _PROT_VARS_TEMP) +NUM_ERRORS += check_datatable(_DATABASE, DatatableReport("input_variables", + value="temp_suite"), + _INPUT_VARS_TEMP, exclude_protected=True) +NUM_ERRORS += check_datatable(_DATABASE, DatatableReport("output_variables", + value="temp_suite"), + _OUTPUT_VARS_TEMP) + +sys.exit(NUM_ERRORS) diff --git a/test/run_fortran_tests.sh b/test/run_fortran_tests.sh index ccfc85f9..942c0336 100755 --- a/test/run_fortran_tests.sh +++ b/test/run_fortran_tests.sh @@ -37,6 +37,14 @@ if [ $res -ne 0 ]; then echo "Failure running advection test" fi +# Run DDT host variable test +./ddthost_test/run_test +res=$? +errcnt=$((errcnt + res)) +if [ $res -ne 0 ]; then + echo "Failure running ddthost test" +fi + # Run var_compatibility test ./var_compatibility_test/run_test res=$?