diff --git a/.travis.yml b/.travis.yml deleted file mode 100644 index 0fb84aa9..00000000 --- a/.travis.yml +++ /dev/null @@ -1,100 +0,0 @@ -#====================================================================== -# Project settings -#====================================================================== -# Only build master. -branches: - only: - - master - - develop - -language: fortran - -#====================================================================== -# Environment -#====================================================================== - -# Code is Fortran. While docs need doxygen and graphviz to build -addons: - apt: - sources: - - ubuntu-toolchain-r-test - packages: - - cmake - - gcc-6 - - gfortran-6 - - g++-6 - - doxygen - - graphviz - - lcov - -#====================================================================== -# Build Matrix -#====================================================================== -matrix: - include: - - os: linux - compiler: gcc - sudo: false - dist: trusty - - os: osx - compiler: gcc - osx_image: xcode9.4 - -#====================================================================== -# Building -#====================================================================== -before_install: - - | - if [[ "$TRAVIS_OS_NAME" == "osx" ]] ; then - brew install gcc@7 || true; - brew link --overwrite gcc@7; - fi - - | - if [[ "$TRAVIS_OS_NAME" == "linux" ]] ; then - pip install --user cpp-coveralls - fi - -before_script: - - | - if [[ "$TRAVIS_OS_NAME" == "osx" ]] ; then - export CC="clang" FC="gfortran-7" CXX="clang++" ; - fi - - | - if [[ "$TRAVIS_OS_NAME" == "linux" ]] ; then - export CC="gcc-6" FC="gfortran-6" CXX="g++-6" ; - fi -# - export CC="gcc-6" FC="gfortran-6" CXX="g++-6" ; - -script: - - mkdir build && cd build && cmake .. && make - - | - if [[ "$TRAVIS_OS_NAME" == "linux" ]] ; then - export LD_LIBRARY_PATH=${PWD}/schemes/check/src/check-build - make test - fi - - | - if [[ "$TRAVIS_OS_NAME" == "osx" ]] ; then - export DYLD_LIBRARY_PATH=${PWD}/schemes/check/src/check-build - ctest - fi - - | - if [[ "$TRAVIS_OS_NAME" == "linux" ]] ; then - make clean - alias gcov="/usr/bin/gcov-6" - cmake -DCMAKE_BUILD_TYPE=Coverage .. && make coverage - fi - -after_success: - - | - if [[ "$TRAVIS_OS_NAME" == "linux" ]] ; then - bash <(curl -s https://codecov.io/bash) - fi - -#====================================================================== -# Notifications -#====================================================================== -notifications: - email: - recipients: dom.heinzeller@noaa.gov - on_success: change - on_failure: always diff --git a/CMakeLists.txt b/CMakeLists.txt index 33a7d9b4..aa9252ef 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -5,34 +5,22 @@ if(NOT PROJECT) endif (NOT PROJECT) #------------------------------------------------------------------------------ -cmake_minimum_required(VERSION 2.8.11) +cmake_minimum_required(VERSION 3.0) + +project(ccpp + VERSION 4.0.0 + LANGUAGES C CXX Fortran) # Use rpaths on MacOSX set(CMAKE_MACOSX_RPATH 1) - -if(POLICY CMP0048) - cmake_policy(SET CMP0048 NEW) - project(ccpp VERSION 3.0.0) -else(POLICY CMP0048) - project(ccpp) - set(PROJECT_VERSION 3.0.0) - set(PROJECT_VERSION_MAJOR 3) - set(PROJECT_VERSION_MINOR 0) - set(PROJECT_VERSION_PATCH 0) -endif(POLICY CMP0048) - if(POLICY CMP0042) cmake_policy(SET CMP0042 NEW) endif(POLICY CMP0042) -#------------------------------------------------------------------------------ -# Enable Fortran -enable_language(Fortran) - #------------------------------------------------------------------------------ # Set package definitions set(PACKAGE "ccpp-framework") -set(AUTHORS "Dom Heinzeller" "Timothy Brown" "David Gill") +set(AUTHORS "Dom Heinzeller" "Grant Firl" "Laurie Carson") string(TIMESTAMP YEAR "%Y") #------------------------------------------------------------------------------ @@ -40,13 +28,6 @@ string(TIMESTAMP YEAR "%Y") # Set the CMake module path list(APPEND CMAKE_MODULE_PATH "${CMAKE_CURRENT_SOURCE_DIR}/cmake") -#------------------------------------------------------------------------------ -# Static or dynamic CCPP, default is dynamic; standalone build can only be dynamic -option(STATIC "Build a static CCPP" OFF) -if (PROJECT STREQUAL "Unknown" AND STATIC) - message(FATAL_ERROR "ccpp-framework standalone build can only be dynamic") -endif(PROJECT STREQUAL "Unknown" AND STATIC) - #------------------------------------------------------------------------------ # Set OpenMP flags for C/C++/Fortran if (OPENMP) @@ -93,12 +74,8 @@ if ("${CMAKE_Fortran_COMPILER_ID}" STREQUAL "PGI") endif() #------------------------------------------------------------------------------ -# By default we want a shared library (unless a static build is requested) -if(STATIC) - option(BUILD_SHARED_LIBS "Build a static library" OFF) -else(STATIC) - option(BUILD_SHARED_LIBS "Build a shared library" ON) -endif(STATIC) +# Request a static build +option(BUILD_SHARED_LIBS "Build a static library" OFF) #------------------------------------------------------------------------------ # Enable code coverage @@ -117,8 +94,6 @@ enable_testing() add_subdirectory(src) # Documentation add_subdirectory(doc) -# All schemes -add_subdirectory(schemes) #------------------------------------------------------------------------------ # Configure and enable packaging diff --git a/doc/DevelopersGuide/CCPP_VARIABLES_FV3.pdf b/doc/DevelopersGuide/CCPP_VARIABLES_FV3.pdf index dd6283b8..b5362516 100644 Binary files a/doc/DevelopersGuide/CCPP_VARIABLES_FV3.pdf and b/doc/DevelopersGuide/CCPP_VARIABLES_FV3.pdf differ diff --git a/doc/DevelopersGuide/CCPP_VARIABLES_SCM.pdf b/doc/DevelopersGuide/CCPP_VARIABLES_SCM.pdf index 543f1c9a..29ffd5d8 100644 Binary files a/doc/DevelopersGuide/CCPP_VARIABLES_SCM.pdf and b/doc/DevelopersGuide/CCPP_VARIABLES_SCM.pdf differ diff --git a/doc/DevelopersGuide/Makefile b/doc/DevelopersGuide/Makefile deleted file mode 100644 index 501e745a..00000000 --- a/doc/DevelopersGuide/Makefile +++ /dev/null @@ -1,15 +0,0 @@ -# -# Makefile for the CCPP (SCM) Users Guide -# - -.PHONY: main.pdf all clean - -all: main.pdf - -main.pdf: main.tex - latexmk -f -pdf -pdflatex="pdflatex" -use-make main.tex - open main.pdf - -clean: - latexmk -CA - diff --git a/doc/DevelopersGuide/README.md b/doc/DevelopersGuide/README.md new file mode 100644 index 00000000..25e51919 --- /dev/null +++ b/doc/DevelopersGuide/README.md @@ -0,0 +1,12 @@ +# CCPP Framework Developers Guide + +The PDF files in this directory are generated in the following manner: + +When the ``ccpp_prebuild.py`` script is run for a host model, such as a single +column model (SCM) or the UFS Weather Model, a file named ``CCPP_VARIABLES_SCM.tex`` or +``CCPP_VARIABLES_FV3.tex`` is created in this directory. + +To create the PDF files, the latex to pdf converter is necessary: + +``pdflatex CCPP_VARIABLES_SCM.tex`` +``pdflatex CCPP_VARIABLES_FV3.tex`` diff --git a/doc/DevelopersGuide/acknow.tex b/doc/DevelopersGuide/acknow.tex deleted file mode 100644 index a5437152..00000000 --- a/doc/DevelopersGuide/acknow.tex +++ /dev/null @@ -1,23 +0,0 @@ -\begin{titlepage} -%\BgThispage -%\newgeometry{left=1cm,right=4cm} -\vspace*{0.5cm} -\noindent - -\begin{flushleft} -\textcolor{darkgray}{\LARGE Acknowledgement} -\vspace*{1cm}\par - -If significant help was provided via the GMTB helpdesk for work resulting in a publication, please acknowledge the Developmental Testbed Center GMTB Team.\\ -\vspace*{1cm}\par -For referencing this document please use:\\ -\vspace*{1cm}\par -Heinzeller, D., L. Bernardet, L. Carson, and G. Firl, 2018. Common Community Physics Package (CCPP) v2.0 Developers' Guide. 19pp. Available at https://dtcenter.org/gmtb/users/ccpp/docs/CCPP-DevGuide-v2.pdf - -\end{flushleft} -\end{titlepage} -\pagebreak{} - - - - diff --git a/doc/DevelopersGuide/chap_appendix.tex b/doc/DevelopersGuide/chap_appendix.tex deleted file mode 100644 index 861284b6..00000000 --- a/doc/DevelopersGuide/chap_appendix.tex +++ /dev/null @@ -1,2 +0,0 @@ -\chapter{Appendix}\label{appendix} - diff --git a/doc/DevelopersGuide/chap_hostmodel.tex b/doc/DevelopersGuide/chap_hostmodel.tex deleted file mode 100644 index 8d3150b0..00000000 --- a/doc/DevelopersGuide/chap_hostmodel.tex +++ /dev/null @@ -1,328 +0,0 @@ -\chapter{Integrating CCPP with a host model} -\label{chap_hostmodel} -\setlength{\parskip}{12pt} -%\label{section: addhostmodel} -This chapter describes the process of connecting a host model with the pool of CCPP physics schemes through the CCPP framework. This work can be split into several distinct steps outlined in the following sections. - -\section{Checking variable requirements on host model side} -\begin{sidewaysfigure} -\begin{lstlisting}[language=Fortran, - basicstyle=\scriptsize\ttfamily, - label=lst_mandatory_variables_by_ccpp, - caption=Mandatory variables that are provided by the CCPP framework (and must not be defined by the host model)] - -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |------------|--------------------|--------------------------------------|-------|------|-----------|---------|--------|----------| -!! | errflg | ccpp_error_flag | error flag for error handling | flag | 0 | integer | | none | F | -!! | errmsg | ccpp_error_message | error message for error handling | none | 0 | character | len=512 | none | F | -!! | loop_cnt | ccpp_loop_counter | loop counter for subcycling loops | index | 0 | integer | | none | F | -!! -\end{lstlisting}\vskip2ex -\begin{lstlisting}[language=Fortran, - basicstyle=\scriptsize\ttfamily, - label=lst_mandatory_variables_by_hostmodel, - caption=Mandatory variables that must be provided by the host model (local name is not fixed)] - -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |------------|--------------------|--------------------------------------|-------|------|-----------|---------|--------|----------| -!! | mpirank | mpi_rank | current MPI rank | index | 0 | integer | | none | F | -!! | mpiroot | mpi_root | master MPI rank | index | 0 | integer | | none | F | -!! | mpicomm | mpi_comm | MPI communicator | index | 0 | integer | | none | F | -!! | mpisize | mpi_size | number of MPI tasks in communicator | count | 0 | integer | | none | F | -!! | nthreads | omp_threads | number of threads for use by physics | count | 0 | integer | | none | F | -\end{lstlisting} -\end{sidewaysfigure} -The first step consists of making sure that the necessary variables for running the CCPP physics schemes are provided by the host model. A list of all variables required for the current pool of physics can be found in \execout{ccpp\{-,/\}framework/doc/DevelopersGuide/CCPP\_VARIABLES\_XYZ.pdf (\execout{XYZ}: SCM, FV3)}. While most of the variable requirements come from the CCPP physics schemes, a small number of variables are required for correct operation of the CCPP and for compliance with its standards. These variables are described in Listings~\ref{lst_mandatory_variables_by_ccpp} and~\ref{lst_mandatory_variables_by_hostmodel}. In case a required variable (that is not mandatory for CCPP) is not provided by the host model, there are several options: -\begin{itemize} -\item If a particular variable is only required by schemes in the pool that will not get used, these schemes can be commented out in the ccpp prebuild config (see Sect.~\ref{sec_addscheme}). -\item If a variable can be calculated from existing variables in the model, an interstitial scheme (usually called \execsub{scheme\_name\_pre}) can be created that calculates the missing variable. However, the memory for this variable must be allocated on the host model side (i.\,e. the variable must be defined but not initialized in the host model). Another interstitial scheme (usually called \execsub{scheme\_name\_post}) might be required to update variables used by the host model with the results from the new scheme. At present, adding interstitial schemes should be done in cooperation with the GMTB Help Desk (\url{gmtb-help@ucar.edu}). -\item In some cases, the declaration and calculation of the missing variable can be placed entirely inside the host model. Please consult with the GMTB Help Desk. -\end{itemize} - -At present, only two types of variable definitions are supported by the CCPP framework: -\begin{itemize} -\item Standard Fortran variables (\execout{character}, \execout{integer}, \execout{logical}, \execout{real}) defined in a module or in the main program. For \execout{character} variables, a fixed length is required. All others can have a \execout{kind} attribute of a kind type defined by the host model. -\item Derived data types (DDTs) defined in a module or the main program. While the use of derived data types as arguments to physics schemes in general is discouraged (see Sect.~\ref{sec_writescheme}), it is perfectly acceptable for the host model to define the variables requested by physics schemes as components of DDTs and pass these components to CCPP by using the correct \execout{local\_name} (see Listing~\ref{lst_metadata_table_hostmodel} for an example). -\end{itemize} -With the CCPP, it is possible to not only refer to components of derived types, but also to slices of arrays in the metadata table as long as these are contiguous in memory (see Listing~\ref{lst_metadata_table_hostmodel} in the following section for an example). - -\section{Adding metadata variable tables for the host model} -To establish the link between host model variables and physics scheme variables, the host model must provide metadata tables similar to those presented in Sect.~\ref{sec_writescheme}. The host model can have multiple metadata tables or just one. For each variable required by the pool of CCPP physics schemes, one and only one entry must exist on the host model side. The connection between a variable in the host model and in the physics scheme is made through its \execout{standard\_name}. - -The following requirements must be met when defining variables in the host model metadata tables (see also listing~\ref{lst_metadata_table_hostmodel} for examples of host model metadata tables). -\begin{itemize} -\item The \execout{standard\_name} must match that of the target variable in the physics scheme. -\item The type, kind, shape and size of the variable (as defined in the host model Fortran code) must match that of the target variable. -\item The attributes \execout{units}, \execout{rank}, \execout{type} and \execout{kind} in the host model metadata table must match those in the physics scheme table. -\item The attributes \execout{optional} and \execout{intent} must be set to \execout{F} and \execout{none}, respectively. -\item The \execout{local\_name} of the variable must be set to the name the host model cap (see Sect.~\ref{sec_hostmodel_cap}) uses to refer to the variable. -\item The name of the metadata table must match the name of the module or program in which the variable is defined, or the name of the derived data type if the variable is a component of this type. -\item Metadata tables describing module variables must be placed inside the module. -\item Metadata tables describing components of derived data types must be placed immediately before the type definition. -\end{itemize} -\begin{sidewaysfigure} -\begin{lstlisting}[language=Fortran, - %basicstyle=\scriptsize\fontfamily{qcr}\fontshape{n}\fontseries{l}\selectfont - basicstyle=\scriptsize\ttfamily, - label=lst_metadata_table_hostmodel, - caption=Example metadata table for a host model] - module example_vardefs - - implicit none - -!> \section arg_table_example_vardefs -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |------------|---------------|-----------|-------|------|-----------|--------|--------|----------| -!! | ex_int | example_int | ex. int | none | 0 | integer | | none | F | -!! | ex_real1 | example_real1 | ex. real | m | 2 | real | kind=8 | none | F | -!! | errmsg | error_message | err. msg. | none | 0 | character | len=64 | none | F | -!! | errflg | error_flag | err. flg. | flag | 0 | logical | | none | F | -!! - - integer, parameter :: r15 = selected_real_kind(15) - integer :: ex_int - real(kind=8), dimension(:,:) :: ex_real1 - character(len=64) :: errmsg - logical :: errflg - -! Derived data types - -!> \section arg_table_example_ddt -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |------------|---------------|-----------|-------|------|-----------|--------|--------|----------| -!! | ext%l | example_flag | ex. flag | flag | 0 | logical | | none | F | -!! | ext%r | example_real3 | ex. real | kg | 2 | real | r15 | none | F | -!! | ext%r(:,1) | example_slice | ex. slice | kg | 1 | real | r15 | none | F | -!! - type example_ddt - logical :: l - real, dimension(:,:) :: r - end type example_ddt - - type(example_ddt) :: ext - - end module example_vardefs -\end{lstlisting} -\end{sidewaysfigure} - -\section{Writing a host model cap for the CCPP} -\label{sec_hostmodel_cap} -The purpose of the host model cap is to abstract away the communication between the host model and the CCPP physics schemes. While CCPP calls can be placed directly inside the host model code, it is recommended to separate the cap in its own module for clarity and simplicity. The host model cap is responsible for: -\begin{description} -\item[\textbf{Allocating memory for variables needed by physics.}] This is only required if the variables are not allocated by the host model, for example for interstitial variables used exclusively for communication between the physics schemes. -\item[\textbf{Allocating the \execout{cdata} structure.}] The \execout{cdata} structure handles the data exchange between the host model and the physics schemes and must be defined in the host model cap or another suitable location in the host model. The \execout{cdata} variable must be persistent in memory. Note that \execout{cdata} is not restricted to being a scalar but can be a multi-dimensional array, depending on the needs of the host model. For example, a model that uses a 1-dimensional array of blocks for better cache-reuse may require \execout{cdata} to be a 1-dimensional array of the same size. Another example of a multi-dimensional array of \execout{cdata} is in the GMTB SCM, which uses a 1-dimensional \execout{cdata} array for $N$ independent columns. -\item[\textbf{Calling the suite initialization subroutine.}] The suite initialization subroutine takes two arguments, the name of the runtime suite definition file (of type \execout{character}) and the name of the \execout{cdata} variable that must be allocated at this point. \emph{Note.} The suite initialization routine \execout{ccpp\_init} parses the suite definition file and initializes the state of the suite and its schemes. This process must be repeated for every element of a multi-dimensional \execout{cdata}. For performance reasons, it is possible to avoid repeated reads of the suite definition file and to have a single state of the suite shared between the elements of \execout{cdata}. This is a developmental feature and has implications on the physics initialization. Host model developers interested in this feature should contact the GMTB Help Desk (\url{gmtb-help@ucar.edu}). -\item[\textbf{Populating the \execout{cdata} structure.}] Each variable required by the physics schemes must be added to the \execout{cdata} structure -- or to each element of a multi-dimensional \execout{cdata} -- on the host model side. This is an automated task and accomplished by inserting a preprocessor directive -\begin{lstlisting}[language=Fortran] -#include ccpp_modules.inc -\end{lstlisting} -at the top of the cap (before \execout{implicit none}) to load the required modules (e.\,g. module \execout{example\_vardefs} in listing~\ref{lst_metadata_table_hostmodel}), and a second preprocessor directive -\begin{lstlisting}[language=Fortran] -#include ccpp_fields.inc -\end{lstlisting} -after the \execout{cdata} variable and the variables required by the physics schemes are allocated. - -\emph{Note.} The CCPP framework supports splitting physics schemes into different sets that are used in different parts of the host model. An example therefore is the separation between slow and fast physics processes for the GFDL microphysics implemented in FV3GFS: while the slow physics are called as part of the usual model physics, the fast physics are integrated in the dynamical core. The separation of physics into different sets is part of the CCPP prebuild configuration (see Sect.~\ref{sec_ccpp_prebuild_config}), which allows to create multiple include files (e.g. \execout{ccpp\_fields\_slow\_physics.inc} and \execout{ccpp\_fields\_fast\_physics.inc} that can be used by different \execout{cdata} structures in different parts of the model). Please contact the GMTB Help Desk (\url{gmtb-help@ucar.edu}) if you would like to use this feature. -\item[\textbf{Providing interfaces to call CCPP for the host model.}] The cap must provide functions or subroutines that can be called at the appropriate places in the host model time integration loop and that internally call \execout{ccpp\_init}, \execout{ccpp\_physics\_init}, \execout{ccpp\_physics\_run}, \execout{ccpp\_physics\_finalize} and \execout{ccpp\_finalize}, and handle any errors returned. -\end{description} -Listing~\ref{lst_host_cap_template} contains a simple template of a host model cap for CCPP, which can also be found in \execout{ccpp/framework/doc/DevelopersGuide/host\_cap\_template.F90}. -\begin{figure} -\lstinputlisting[language=Fortran, - %basicstyle=\scriptsize\fontfamily{qcr}\fontshape{n}\fontseries{l}\selectfont - basicstyle=\scriptsize\ttfamily, - label=lst_host_cap_template, - caption=Fortran template for a CCPP host model cap]{./host_cap_template.F90} -\end{figure}\clearpage -\section{Configuring and running the CCPP prebuild script} -\label{sec_ccpp_prebuild_config} -\begin{figure} -\centerline{\includegraphics[width=0.85\textwidth]{./images/ccpp_design_with_ccpp_prebuild.pdf}} -\caption{Role of the CCPP prebuild script and the \execout{cdata} structure in the software architecture of an atmospheric modeling system.}\label{fig_ccpp_design_with_ccpp_prebuild} -\end{figure} -The CCPP prebuild script \execout{ccpp/framework/scripts/ccpp\_prebuild.py} is the central piece of code that connects the host model with the CCPP physics schemes (see Figure~\ref{fig_ccpp_design_with_ccpp_prebuild}). This script must be run before compiling the CCPP physics library and the host model cap. The CCPP prebuild script automates several tasks based on the information collected from the metadata tables on the host model side and from the individual physics schemes: -\begin{itemize} -\item Compiles a list of variables required to run all schemes in the CCPP physics pool. -\item Compiles a list of variables provided by the host model. -\item Matches these variables by their \execout{standard\_name}, checks for missing variables and mismatches of their attributes (e.\,g., units, rank, type, kind) and processes information on optional variables (see also Sect.~\ref{sec_writescheme}). -\item Creates Fortran code (\execout{ccpp\_modules.inc}, \execout{ccpp\_fields.inc}) that stores pointers to the host model variables in the \execout{cdata} structure. -\item Auto-generates the caps for the physics schemes. -\item Populates makefiles with schemes and caps. -\end{itemize} - -In order to connect the CCPP with a host model \execsub{XYZ}, a Python-based configuration file for this model must be created in the host model's repository. The easiest way is to copy an the existing configuration file for the TEST model in sub-directory \execout{schemes/check} of the \execout{ccpp-framework} repository. -The configuration in \execout{ccpp\_prebuild\_config.py} depends largely on (a) the directory structure of the host model itself, (b) where the \execout{ccpp/framework} and the \execout{ccpp/physics} directories are located relative to the directory structure of the host model, and (c) from which directory the \execout{ccpp\_prebuild.py} script is executed before/during the build process (this is referred to as \execout{basedir} in \execout{ccpp\_prebuild\_config\_XYZ.py}). - -Listing~\ref{lst_ccpp_prebuild_config} contains an example for the SCM CCPP prebuild config. Here, it is assumed that both \execout{ccpp/framework} and \execout{ccpp/physics} are located in the top-level directory of the host model, and that \execout{ccpp\_prebuild.py} is executed from the same top-level directory. -\begin{lstlisting}[language=python, - basicstyle=\scriptsize\ttfamily, - label=lst_ccpp_prebuild_config, - float=p, - caption=CCPP prebuild config for SCM (shortened)] -# Host model identifier -HOST_MODEL_IDENTIFIER = "TEST" - -# Add all files with metadata tables on the host model side, -# relative to basedir = top-level directory of host model -VARIABLE_DEFINITION_FILES = [ - 'scm/src/gmtb_scm_type_defs.f90', - 'scm/src/gmtb_scm_physical_constants.f90' - ] - -# Add all physics scheme dependencies relative to basedir - note that the CCPP -# rules stipulate that dependencies are not shared between the schemes! -SCHEME_FILES_DEPENDENCIES = [] # can be empty - -# Add all physics scheme files relative to basedir -SCHEME_FILES = { - # Relative path : [ list of sets in which scheme may be called ] - 'ccpp/physics/physics/GFS_DCNV_generic.f90' : ['physics'], - 'ccpp/physics/physics/sfc_sice.f' : ['physics'], - } - -# Auto-generated makefile/cmakefile snippets that contains all schemes -SCHEMES_MAKEFILE = 'ccpp/physics/CCPP_SCHEMES.mk' -SCHEMES_CMAKEFILE = 'ccpp/physics/CCPP_SCHEMES.cmake' - -# CCPP host cap in which to insert the ccpp_field_add statements; -# determines the directory to place ccpp_{modules,fields}.inc -TARGET_FILES = [ - 'scm/src/gmtb_scm.f90', - ] - -# Auto-generated makefile/cmakefile snippets that contains all caps -CAPS_MAKEFILE = 'ccpp/physics/CCPP_CAPS.mk' -CAPS_CMAKEFILE = 'ccpp/physics/CCPP_CAPS.cmake' - -# Directory where to put all auto-generated physics caps -CAPS_DIR = 'ccpp/physics/physics' - -# Optional arguments - only required for schemes that use optional arguments. -# ccpp_prebuild.py will throw an exception if it encounters a scheme subroutine -# with optional arguments if no entry is made here. Possible values are: -OPTIONAL_ARGUMENTS = { - #'subroutine_name_1' : 'all', - #'subroutine_name_2' : 'none', - #'subroutine_name_3' : [ 'var1', 'var2'], - } - -# HTML document containing the model-defined CCPP variables -HTML_VARTABLE_FILE = 'ccpp/physics/CCPP_VARIABLES.html' - -# LaTeX document containing the provided vs requested CCPP variables -LATEX_VARTABLE_FILE = 'ccpp/framework/doc/DevelopersGuide/CCPP_VARIABLES.tex' - -######## Template code to generate include files ######## - -# Name of the CCPP data structure in the host model cap; -# in the case of SCM, this is a vector with loop index i -CCPP_DATA_STRUCTURE = 'cdata(i)' - -# Modules to load for auto-generated ccpp_field_add code -# in the host model cap (e.g. error handling) -MODULE_USE_TEMPLATE_HOST_CAP = \ -''' -use ccpp_errors, only: ccpp_error -''' - -# Modules to load for auto-generated ccpp_field_get code -# in the physics scheme cap (e.g. derived data types) -MODULE_USE_TEMPLATE_SCHEME_CAP = \ -''' - use machine, only: kind_phys - use GFS_typedefs, only: GFS_statein_type, ... -''' - -# EOF -\end{lstlisting} -\clearpage - -Once the configuration in \execout{ccpp\_prebuild\_config.py} is complete, run -\begin{lstlisting}[language=bash] -./ccpp/framework/scripts/ccpp_prebuild.py --config=full_path_of_config_file [--debug] -\end{lstlisting} -from the top-level directory. Without the debugging flag, the output should look like -\begin{lstlisting}[language=bash,basicstyle=\scriptsize\ttfamily] -INFO: Logging level set to INFO -INFO: Parsing metadata tables for variables provided by host model ... -INFO: Parsed variable definition tables in module gmtb_scm_type_defs -INFO: Parsed variable definition tables in module gmtb_scm_physical_constants -INFO: Parsed variable definition tables in module ccpp_types -INFO: Metadata table for model SCM written to ccpp/physics/CCPP_VARIABLES_SCM.html -INFO: Parsing metadata tables in physics scheme files ... -INFO: Parsed tables in scheme rrtmg_lw -... -INFO: Checking optional arguments in physics schemes ... -INFO: Metadata table for model SCM written to ccpp/framework/doc/DevelopersGuide/CCPP_VARIABLES_SCM.tex -INFO: Comparing metadata for requested and provided variables ... -INFO: Generating module use statements for set physics ... -INFO: Generated module use statements for 4 module(s) -INFO: Generating ccpp_field_add statements for set physics ... -INFO: Generated ccpp_field_add statements for 606 variable(s) -INFO: Generating include files for host model cap scm/src/gmtb_scm.f90 ... -INFO: Generated module-use include file scm/src/ccpp_modules.inc -INFO: Generated fields-add include file scm/src/ccpp_fields.inc -INFO: Generating schemes makefile/cmakefile snippet ... -INFO: Added 81 schemes to ccpp/physics/CCPP_SCHEMES.mk and ccpp/physics/CCPP_SCHEMES.cmake -INFO: Generating caps makefile/cmakefile snippet ... -INFO: Added 64 auto-generated caps to ccpp/physics/CCPP_CAPS.mk and ccpp/physics/CCPP_CAPS.cmake -INFO: CCPP prebuild step completed successfully. -\end{lstlisting} - -\section{Building the CCPP framework and physics library} -\label{sec_ccpp_build} -\subsection{Preface} -It is highly recommended to build the CCPP physics library and software framework as part of the host model. Both \execout{ccpp-framework} and \execout{ccpp-physics} use a cmake build system, which can be integrated in the host model's cmake build system, as it is the case for the SCM. For the example of FV3GFS, which employs a traditional make build system, the cmake build for the CCPP framework and physics are triggered by the host model's \execout{compile.sh} script. - -\emph{Note.} It is possible to build the CCPP framework standalone, for example for testing purposes. It is generally not possible to build the CCPP physics library without running the CCPP prebuild script, since the build system relies on the auto-generated cmake code snippets that define the physics schemes and caps to compile. Further, any thirdparty libraries required by the physics schemes must be compiled and installed separately and the appropriate compiler and linker flags must be set manually. For example, the CCPP physics used by GMTB's SCM require several of NCEP's libraries (bacio, sp, w3nco); FV3GFS in addition requires the ESMF libraries and, depending on the operating system, also the Intel Math Kernel Library MKL (currently MacOSX only). -\subsection{Standalone ccpp-framework build}\label{sec_ccpp_framework_standalone_build} -The instructions laid out below demonstrate how to build the CCPP framework independently of the host model. It is assumed that the Github repository is checked out into a local directory \execout{ccpp-framework}. -\begin{description} -\item[\textbf{Set environment variables.}] In general, CCPP requires the \execout{CC} and \execout{FC} variables to point to the correct compilers. If threading (OpenMP) will be used inside the CCPP physics or the host model calling the CCPP physics, OpenMP-capable compilers must be used. -\item[\textbf{Build the CCPP framework.}] Use the following steps to build the CCPP framework. -\begin{lstlisting}[language=bash] -cd ccpp-framework -mkdir build && cd build -cmake -DCMAKE_INSTALL_PREFIX=$PWD .. -# add -DOPENMP=ON before .. for OpenMP build -# add -DCMAKE_BUILD_TYPE=Debug before .. for 'Debug' build -make -# add VERBOSE=1 for verbose output -make install -# add VERBOSE=1 after install for verbose output -\end{lstlisting} -\item[\textbf{Update environment variables.}] The previous install step creates directories \execout{include} and \execout{lib} inside the build directory. These directories and the newly built library \execout{libccpp.so} need to be added to the environment variables \execout{FFLAGS} and \execout{LDFLAGS}, respectively (example for bash, assuming the current directory is still the above build directory): -\begin{lstlisting}[language=bash] -export FFLAGS="-I$PWD/include/ccpp $FFLAGS" -export LDFLAGS="-L$PWD/lib -lccpp $LDFLAGS" -\end{lstlisting} -\item[\textbf{Testing the CCPP framework.}] Several unit tests are provided by the CCPP framework. These cover basic functionality and will be expanded to increase the test coverage in future releases. The unit tests are run from the build directory using -\begin{lstlisting}[language=bash] -export LD_LIBRARY_PATH=$PWD/schemes/check/src/check-build:$LD_LIBRARY_PATH -make test -\end{lstlisting} -\end{description} -\subsection{Integration with host model build system} -To allow for a flexible configuration of the CCPP framework and physics with multiple models, the \execout{CMakeLists.txt} configuration files for both packages use a cmake variable \execout{PROJECT}. This variable can be set as part of the cmake call (\execout{cmake -DPROJECT=XYZ}) or by a \execout{CMakeLists.txt} that integrates \execout{ccpp-framework} and \execout{ccpp-physics}. If not specified, \execout{PROJECT} is set to 'Unknown'. - -The basic steps to build the CCPP framework and physics for a specific host model are outlined in the following. -\begin{description} -\item[\textbf{Recommended directory structure.}] As mentioned in Section~\ref{sec_ccpp_prebuild_config}, we recommend placing the two repositories \execout{ccpp-framework} and \execout{ccpp-physics} into directories \execout{ccpp/framework} and \execout{ccpp/physics} relative to the top-level directory of the host model, and to adapt the CCPP prebuild config such that it can be run from the top-level directory. -\item[\textbf{Set environment variables.}] In addition to the compiler variables \execout{CC} and \execout{FC}, the CCPP physics require further enviroment variables for thirdparty libraries used by the physics schemes. The setup scripts for SCM (in \execout{scm/etc}) or FV3GFS (in \execout{conf} or \execout{modulefiles}) provide useful examples for the correct environment settings. -\item[\textbf{Build the CCPP framework.}] See previous section on how to build the CCPP framework. The cmake variable \execout{PROJECT} can be set to customize the build using \execout{ccpp/framework/CMakeLists.txt}. This includes preprocessor flags such as \execout{-DMPI}. -\item[\textbf{Update environment variables.}] See previous section on how to update the compiler and linker flags. -\item[\textbf{Build CCPP physics library.}] Before building \execout{ccpp-physics}, its top-level cmake configuration \execout{ccpp/physics/CMakeLists.txt} must be customized for the host model. This includes compiler flags, preprocessor flags etc. The user is referred to the existing configurations. The CCPP physics library is built starting from the build directory \execout{ccpp/framework/build}: -\begin{lstlisting}[language=bash] -cd ../.. # back to top-level directory -cd ccpp/physics -mkdir build && cd build -cmake .. -# add -DOPENMP=ON before .. for OpenMP build -# note that OpenMP build requires finding -# detect_openmp.cmake from ccpp/framework/cmake -make -# add VERBOSE=1 after install for verbose output -\end{lstlisting} -\end{description} -Following these steps, the include files and the library \execout{libccpp.so} that the host model needs to be compiled and linked against are located in \execout{ccpp/framework/build/include} and \execout{ccpp/framework/build/lib}. Note that there is no need to link the host model to the CCPP physics library in \execout{ccpp/physics/build}, as long as it is in the search path of the dynamic loader of the OS (for example by adding the directory \execout{ccpp/physics/build} to the \execout{LD\_LIBRARY\_PATH} environment variable). This is because the CCPP physics library is loaded dynamically by the CCPP framework using the library name specified in the runtime suite definition file (see the GMTB Single Column Model Technical Guide v2.1, Chapter 6.1.3, (\url{https://dtcenter.org/gmtb/users/ccpp/docs/}) for further information). Setting the environment variables \execout{FFLAGS} and \execout{LDFLAGS} as described for the CCPP framework standalone build in Sect.~\ref{sec_ccpp_framework_standalone_build} should be sufficient to compile the host model with its newly created host model cap (Sect.~\ref{sec_hostmodel_cap}) and connect to the CCPP library and framework. - -For a complete integration of the CCPP infrastructure and physics library build systems in the host model build system, users are referred to the existing implementations in GMTB SCM and FV3GFS. \ No newline at end of file diff --git a/doc/DevelopersGuide/chap_intro.tex b/doc/DevelopersGuide/chap_intro.tex deleted file mode 100644 index 6b313991..00000000 --- a/doc/DevelopersGuide/chap_intro.tex +++ /dev/null @@ -1,12 +0,0 @@ -\chapter{Introduction}\label{chap_introduction} -\setlength{\parskip}{12pt} - -The Common Community Physics Package (CCPP) is designed to facilitate the implementation of physics innovations in state-of-the-art atmospheric models, the use of various models to develop physics, and the acceleration of transition of physics innovations to operational NOAA models. The CCPP consists of two separate software packages, the pool of CCPP-compliant physics schemes (\execout{ccpp-physics}) and the framework (driver) that connects the physics schemes with a host model (\execout{ccpp-framework}). - -The connection between the host model and the physics schemes through the CCPP framework is realized with caps on both sides as illustrated in Fig.~\ref{fig_ccpp_design_with_ccpp_prebuild} in Chapter~\ref{chap_hostmodel}. While the caps to the individual physics schemes are auto-generated, the cap that connects the framework (Physics Driver) to the host model must be created manually. The CCPP framework generates a large fraction of code that can be included in the host model cap to facilitate this process. For more information about the CCPP design and implementation, see the CCPP Design Overview at {\url{https://dtcenter.org/gmtb/users/ccpp/docs/}}. - -This document serves two purposes, namely to describe the technical work of writing a CCPP-compliant physics scheme and adding it to the pool of CCPP physics schemes (Chapter~\ref{chap_schemes}), and to explain in detail the process of connecting an atmospheric model (host model) with the CCPP (Chapter~\ref{chap_hostmodel}). For further information and an example for integrating CCPP with a host model, the reader is referred to the GMTB Single Column Model (SCM) User and Technical Guide v2.1 available at {\url{https://dtcenter.org/gmtb/users/ccpp/docs}}. - -At the time of writing, the CCPP is supported for use with the GMTB Single Column Model (SCM). Support for use of CCPP with the experimental version of NCEP's Global Forecast System (GFS) that employs the Finite-Volume Cubed-Sphere dynamical core (FV3GFS) is available as an internal release for the developers. A public release of FV3GFS with CCPP is planned for early 2019. - -The GMTB welcomes contributions to CCPP, whether those are bug fixes, improvements to existing parameterizations, or new parameterizations. There are two aspects of adding innovations to the CCPP: technical and programmatic. This Developer's Guide explains how to make parameterizations technically compliant with the CCPP. Acceptance in the master branch of the CCPP repositories, and elevation of a parameterization to supported status, depends on a set of scientific and technical criteria that are under development as part of the incipient CCPP Governance. Contributions can be made in form of git pull requests to the development repositories. Before initiating a major development for the CCPP please contact GMTB at \url{gmtb-help@ucar.edu} to create an integration and transition plan. For further information, see the Developer's Corner for CCPP at \url{https://dtcenter.org/gmtb/users/ccpp/developers/index.php}. Note that while the pool of CCPP physics and the CCPP framework are managed by the Global Model Test Bed (GMTB) and governed jointly with partners (e.g., NCAR), the code governance for the host models lies with their respective organizations. Therefore, inclusion of CCPP within those models should be brought up to their governing bodies. \ No newline at end of file diff --git a/doc/DevelopersGuide/chap_schemes.tex b/doc/DevelopersGuide/chap_schemes.tex deleted file mode 100644 index 22a9b76b..00000000 --- a/doc/DevelopersGuide/chap_schemes.tex +++ /dev/null @@ -1,158 +0,0 @@ -\chapter{CCPP-compliant physics schemes} -\label{chap_schemes} -\setlength{\parskip}{12pt} - -\section{Writing a CCPP-compliant physics scheme} -\label{sec_writescheme} -The rules for writing a CCPP-compliant scheme are summarized in the following. Listing~\ref{lst_scheme_template} contains a Fortran template for a CCPP-compliant scheme, which can also be found in \execout{ccpp/framework/doc/DevelopersGuide/scheme\_template.F90}. - -General rules: -\begin{itemize} -\item Scheme must be in its own module (module name $=$ scheme name) and must have three entry points (subroutines) starting with the name of the module: module \execout{scheme\_template} $\rightarrow$ subroutines \execout{scheme\_template\_\{init,finalize,run\}}. The \execout{\_init} and \execout{\_finalize} routines are run automatically when the CCPP physics are initialized. These routines may be called more than once, depending on the host model's parallelization strategy, and as such must be idempotent (that is, multiple calls must not change the answer). -\item Empty schemes (e.\,g. \execout{scheme\_template\_init} in listing~\ref{lst_scheme_template}) need no argument table. -\item Schemes in use require an argument table as below, the order of arguments in the table must be the same as in the argument list of the subroutine. -\item An argument table must precede the subroutine, and must start with -\begin{lstlisting}[language=Fortran] -!> \section arg_table_subroutine_name Argument Table -\end{lstlisting} -and end with a line containing only -\begin{lstlisting}[language=Fortran] -!! -\end{lstlisting} -\item All external information required by the scheme must be passed in via the argument list, i.e. no external modules (except if defined in the Fortran standards 95--2003). -\item If the width of an argument table exceeds 250 characters, wrap the argument table in CPP preprocessor directives: -\begin{lstlisting}[language=Fortran] -#if 0 -!> \section arg_table_scheme_template_run Argument Table -... -!! -#endif -\end{lstlisting} -\item Module names, scheme names and subroutine names are case sensitive. -\item For better readability, it is suggested to align the columns in the metadata table. -\end{itemize} - -Input/output variable (argument) rules: -\begin{itemize} -\item Variables available for CCPP physics schemes are identified by their unique \execout{standard\_name}. While an effort is made to comply with existing \execout{standard\_name} definitions of the CF conventions (\url{http://cfconventions.org}), additional names are introduced by CCPP (see below for further information). -\item A \execout{standard\_name} cannot be assigned to more than one local variable (\execout{local\_name}). The \execout{local\_name} of a variable can be chosen freely and does not have to match the \execout{local\_name} in the host model. -\item All information (units, rank) must match the specifications on the host model side. -\item The two mandatory variables that every scheme must accept as \execout{intent(out)} arguments are \execout{errmsg} and \execout{errflg} (see also coding rules). -\item At present, only two types of variable definitions are supported by the CCPP framework: -\begin{itemize} -\item Standard Fortran variables (\execout{character}, \execout{integer}, \execout{logical}, \execout{real}). For \execout{character} variables, the length should be specified as $\ast$. All others can have a \execout{kind} attribute of a kind type defined by the host model. -\item Derived data types (DDTs). While the use of DDTs is discouraged in general, some use cases may justify their application (e.g. DDTs for chemistry that contain tracer arrays, information on whether tracers are advected, \dots). -\end{itemize} -\item If a scheme is to make use of CCPP's subcycling capability in the runtime suite definition file (SDF; see also GMTB Single Column Model Technical Guide v2.1, chapter 6.1.3, \url{https://dtcenter.org/gmtb/users/ccpp/docs}), the loop counter can be obtained from CCPP as an \execout{intent(in)} variable (see Listings~\ref{lst_mandatory_variables_by_ccpp} and~\ref{lst_mandatory_variables_by_hostmodel} for a mandatory list of variables that are provided by the CCPP framework and/or the host model for this and other purposes). -\end{itemize} - -Coding rules: -\begin{itemize} -\item Code must comply to modern Fortran standards (Fortran 90/95/2003) -\item Use labeled \execout{end} statements for modules, subroutines and functions, example:\\ -\execout{module scheme\_template} $\rightarrow$ \execout{end module scheme\_template}. -\item Use \execout{implicit none}. -\item All \execout{intent(out)} variables must be initialized properly inside the subroutine. -\item No permanent state of decomposition-dependent host model data inside the module. -\item No \execout{goto} statements. -\item Errors are handled by the host model using the two mandatory arguments \execout{errmsg} and \execout{errflg}. In the event of an error, assign a meaningful error message to \execout{errmsg} and set \execout{errflg} to a value other than 0. -\item Schemes are not allowed to abort/stop the program. -\item Schemes are not allowed to perform I/O operations (except for reading lookup tables or other information needed to initialize the scheme) -\item Line lengths of 120 characters are suggested for better readibility (exception: CCPP metadata argument tables). -\end{itemize} - -Parallel programming rules: -\begin{itemize} -\item Shared-memory (OpenMP) parallelization inside a scheme is allowed with the restriction that the number of OpenMP threads to use is obtained from the host model through the subroutine's argument table (Listings~\ref{lst_mandatory_variables_by_ccpp} and~\ref{lst_mandatory_variables_by_hostmodel}). -\item MPI communication is allowed in the \execout{\_init} and \execout{\_finalize} phase for the purpose of computing, reading or writing scheme-specific data that is independent of the host model's data decomposition. An example is the initial read of a lookup table of aerosol properties by one or more MPI processes which is then broadcasted to all processes. Several restrictions apply: -\begin{itemize} - \item Reading and writing of data must be implemented in a scalable way to perform efficiently from a few to millions of tasks. - \item The MPI communicator to use must be received from the host model through the subroutine's argument table (Listings~\ref{lst_mandatory_variables_by_ccpp} and~\ref{lst_mandatory_variables_by_hostmodel}). - \item The use of MPI is restricted to global communications, for example \execout{barrier}, \execout{broadcast}, \execout{gather}, \execout{scatter}, \execout{reduce}. -\end{itemize} -\item Calls to MPI and OpenMP functions, and the import of the MPI and OpenMP libraries, must be guarded by CPP preprocessor directives as illustrated in the following listing. OpenMP pragmas can be inserted without CPP guards, since they are ignored by the compiler if the OpenMP compiler flag is omitted. -\begin{lstlisting}[language=Fortran] -... - -#ifdef MPI - use mpi -#endif -#ifdef OPENMP - use omp_lib -#endif - -... - -#ifdef MPI - call MPI_BARRIER(mpicomm, ierr) -#endif - -#ifdef OPENMP - me = OMP_GET_THREAD_NUM() -#else - me = 0 -#endif -\end{lstlisting} - - -\item For Fortran coarrays, consult with the GMTB helpdesk (\url{gmtb-help@ucar.edu}). -\end{itemize} -Scientific Documentation rules: -\begin{itemize} -\item Technically, scientific documentation is not needed for a parameterization to work with the CCPP. However, inclusion of inline scientific documentation is highly recommended and necessary before a parameterization is submitted for inclusion in the CCPP. -\item Scientific documentation for CCPP parameterizations should be inline within the Fortran code using markups according to the Doxygen software. Reviewing the documentation for CCPP v2.0 parameterizations is a good way of getting started in writing documentation for a new scheme. -\item The CCPP Scientific Documentation can be converted to html format (see \url{https://dtcenter.org/gmtb/users/ccpp/docs/sci_doc_v2/}. -\item For precise instructions on creating the scientific documentation, contact the GMTB helpdesk at \url{gmtb-help@ucar.edu}. -\end{itemize} -\begin{sidewaysfigure} -\lstinputlisting[language=Fortran, - %basicstyle=\scriptsize\fontfamily{qcr}\fontshape{n}\fontseries{l}\selectfont - basicstyle=\scriptsize\ttfamily, - label=lst_scheme_template, - caption=Fortran template for a CCPP-compliant scheme, - firstline=78]{./scheme_template.F90} -\end{sidewaysfigure} - -\section{Adding a new scheme to the CCPP pool} -\label{sec_addscheme} -This section describes briefly how to add a new scheme to the CCPP pool and use it with a host model that already supports the CCPP. -\begin{enumerate} -\item Identify the required variables for your target host model: for a list of variables available for host model \execsub{XYZ} (currently \execout{SCM} and \execout{FV3}), see \execout{ccpp/framework/doc/DevelopersGuide/CCPP\_VARIABLES\_XYZ.pdf}. Contact the GMTB helpdesk at \url{gmtb-help@ucar.edu} if you need additional variables that you believe should be provided by the host model or as part of a pre-/post-scheme (interstitial scheme) instead of being calculated from existing variables inside your scheme. -\item Identify if your new scheme requires additional interstitial code that must be run before/after the scheme and that cannot be part of the scheme itself, for example because of dependencies on other schemes and/or the order the scheme is run in the suite definition file. As of now, interstitial schemes should be created in cooperation with the GMTB helpdesk. -\item Follow the guidelines outlined in the previous section to make your scheme CCPP-compliant. Make sure to use an uppercase suffix \execout{.F90} to enable CPP preprocessing. -\item Locate the CCPP prebuild configuration files for the target host model, for GFDL FV3 and GMTB SCM: -\begin{lstlisting}[language=Python] -ccpp/config/ccpp_prebuild_config.py -\end{lstlisting} -in the host model's main repository (NEMSfv3gfs or gmtb-scm, respectively). -\item Add the new scheme to the list of schemes using the same path as the existing schemes: -\begin{samepage} -\begin{lstlisting}[language=Python] -SCHEME_FILES = [ - ... - '../some_relative_path/existing_scheme.F90', - '../some_relative_path/new_scheme.F90', - ... - ] -\end{lstlisting} -\end{samepage} -\item If the new scheme uses optional arguments, add information on which ones to use further down in the configuration file. See existing entries and documentation in the configuration file for the possible options: -\begin{lstlisting}[language=Python] -OPTIONAL_ARGUMENTS = { - 'SCHEME_NAME' : { - 'SCHEME_NAME_run' : [ - # list of all optional arguments in use for this model, by standard_name - ], - # instead of list [...], can also say 'all' or 'none' - }, - } -\end{lstlisting} -\item Place new scheme in the same location as existing schemes in the CCPP directory structure, e.\,g. \execout{../some\_relative\_path/new\_scheme.F90}. -\item Edit the runtime suite definition file and add the new scheme at the place it should be run. SDFs are located in -\begin{lstlisting}[language=Python] -ccpp/suites/suite_FV3_GFS_2017*.xml # FV3 -ccpp/suites/suite_SCM_GFS_2017_updated*.xml # SCM -\end{lstlisting} -\item Done. Note that no further modifications of the build system are required, since the CCPP framework will auto-generate the necessary makefiles that allow the host model to compile the scheme. -\end{enumerate} -\textbf{Note:} Making a scheme CCPP-compliant is a necessary step for acceptance of the scheme in the pool of supported CCPP physics schemes, but does not guarantee it. Acceptance is subject to approval by a Governance committee and depends on scientific innovation, demonstrated added value, and compliance with the above rules. The criteria for acceptance of innovations into the CCPP is under development. For further information, please contact the GMTB helpdesk at \url{gmtb-help@ucar.edu}. diff --git a/doc/DevelopersGuide/host_cap_template.F90 b/doc/DevelopersGuide/host_cap_template.F90 deleted file mode 100644 index 14f66af8..00000000 --- a/doc/DevelopersGuide/host_cap_template.F90 +++ /dev/null @@ -1,69 +0,0 @@ -module example_ccpp_host_cap - - use ccpp_api, only: ccpp_t, ccpp_init, ccpp_finalize - use ccpp_static_api, only: ccpp_physics_init, ccpp_physics_run, & - ccpp_physics_finalize - - implicit none - - ! CCPP data structure - type(ccpp_t), save, target :: cdata - - public :: physics_init, physics_run, physics_finalize - -contains - - subroutine physics_init(ccpp_suite_name) - character(len=*), intent(in) :: ccpp_suite_name - integer :: ierr - ierr = 0 - - ! Initialize the CCPP framework, parse SDF - call ccpp_init(trim(ccpp_suite_name), cdata, ierr=ierr) - if (ierr/=0) then - write(*,'(a)') "An error occurred in ccpp_init" - stop - end if - - ! Initialize CCPP physics (run all _init routines) - call ccpp_physics_init(cdata, suite_name=trim(ccpp_suite_name), & - ierr=ierr) - ! error handling as above - - end subroutine physics_init - - subroutine physics_run(ccpp_suite_name, group) - ! Optional argument group can be used to run a group of schemes & - ! defined in the SDF. Otherwise, run entire suite. - character(len=*), intent(in) :: ccpp_suite_name - character(len=*), optional, intent(in) :: group - - integer :: ierr - ierr = 0 - - if (present(group)) then - call ccpp_physics_run(cdata, suite_name=trim(ccpp_suite_name), & - group_name=group, ierr=ierr) - else - call ccpp_physics_run(cdata, suite_name=trim(ccpp_suite_name), & - ierr=ierr) - end if - ! error handling as above - - end subroutine physics_run - - subroutine physics_finalize(ccpp_suite_name) - character(len=*), intent(in) :: ccpp_suite_name - integer :: ierr - ierr = 0 - - ! Finalize CCPP physics (run all _finalize routines) - call ccpp_physics_finalize(cdata, suite_name=trim(ccpp_suite_name), & - ierr=ierr) - ! error handling as above - call ccpp_finalize(cdata, ierr=ierr) - ! error handling as above - - end subroutine physics_finalize - -end module example_ccpp_host_cap diff --git a/doc/DevelopersGuide/images/ccpp_design_with_ccpp_prebuild.pdf b/doc/DevelopersGuide/images/ccpp_design_with_ccpp_prebuild.pdf deleted file mode 100644 index a36d5e24..00000000 Binary files a/doc/DevelopersGuide/images/ccpp_design_with_ccpp_prebuild.pdf and /dev/null differ diff --git a/doc/DevelopersGuide/images/dtc_logo.png b/doc/DevelopersGuide/images/dtc_logo.png deleted file mode 100644 index 87b0cda6..00000000 Binary files a/doc/DevelopersGuide/images/dtc_logo.png and /dev/null differ diff --git a/doc/DevelopersGuide/main.tex b/doc/DevelopersGuide/main.tex deleted file mode 100644 index 8df6d911..00000000 --- a/doc/DevelopersGuide/main.tex +++ /dev/null @@ -1,39 +0,0 @@ -\documentclass[12pt,letterpaper,oneside]{scrbook} - -\usepackage{import} -\import{../common/}{gmtb.sty} - -\makeindex - -\hypersetup{ - pdfauthor={Dom Heinzeller / Ligia Bernardet / Laurie Carson / Grant Firl}, - pdftitle={Common Community Physics Package (CCPP)}, -} - -\begin{document} - -\frontmatter -\import{./}{title.tex} - -\clearpage -\thispagestyle{empty} -\import{./}{acknow.tex} - -\tableofcontents - -\import{./}{preface.tex} - -\mainmatter - -\import{./}{chap_intro.tex} -\import{./}{chap_schemes.tex} -\import{./}{chap_hostmodel.tex} - -\appendix - -\renewcommand{\thechapter}{\Alph{chapter}} -%\import{./}{chap_appendix.tex} - -\backmatter - -\end{document} diff --git a/doc/DevelopersGuide/preface.tex b/doc/DevelopersGuide/preface.tex deleted file mode 100644 index 8dddb80f..00000000 --- a/doc/DevelopersGuide/preface.tex +++ /dev/null @@ -1,28 +0,0 @@ -\chapter*{Preface} -\addcontentsline{toc}{chapter}{Preface} - -\section*{Meaning of typographic changes and symbols} - -Table \ref{tab:pre_typog} describes the type changes and symbols used in this book. - -\begin{table}[h] -\centering -\begin{tabular}{+l^l^l} -\hline -\rowstyle{\bfseries} -Typeface or Symbol & Meaning & Example \\ -\hline -\hlinesep\execout{AaBbCc123} & The names of commands, & Edit your \execout{.bashrc} \\ - & files, and directories; & Use \execout{ls -a} to list all files. \\ - & on-screen computer output & \execout{host\$ You have mail!}. \\ -\hlinesep\exec{AaBbCc123} & What you type, contrasted & \execout{host\$} \exec{su} \\ - & with on-screen computer & \\ - & output & \\ -\hlinesep\execsub{AaBbCc123} & Command line placeholder: & To delete a file, type \\ - & replace with a real name & \execout{rm} \execsub{filename} \\ - & or value & \\ - \hline -\end{tabular} -\caption{Typographic Conventions} -\label{tab:pre_typog} -\end{table} diff --git a/doc/DevelopersGuide/scheme_template.F90 b/doc/DevelopersGuide/scheme_template.F90 deleted file mode 100644 index a038a035..00000000 --- a/doc/DevelopersGuide/scheme_template.F90 +++ /dev/null @@ -1,129 +0,0 @@ -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! CCPP-compliant physics scheme template -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! -! General rules: -! -! - scheme must be in its own module (module name = scheme name) and must -! have three entry points (subroutines) starting with the name of the module: -! module scheme_template -> subroutines scheme_template_{init,finalize,run} -! -! - each .f or .F90 file with one or more CCPP entry point schemes must be accompanied by a -! .meta file containing metadata for the scheme(s) -! -! - non-empty schemes must be preceded by the three lines below. These are markup comments used by Doxygen, -! the software employed to create the scientific documentation, to insert an external file containing metadata -! information (in this case, ``schemename_run.html``) in the documentation. See more on this topic in -! the CCPP Technical Documentation available at https://dtcenter.org/community-code/common-community-physics-package-ccpp. -! -! !> \section arg_table_schemename_run Argument Table -! !! \htmlinclude schemename_run.html -! !! -! -! - empty schemes (e.g., scheme_template_init below) do not need metadata -! -! - all external information required by the scheme must be passed in via the -! argument list, i.e. NO 'use EXTERNAL_MODULE' statements -! -! Metadata rules: -! -! - refer to file scheme_template.meta for information about the metadata -! -! Input/output variable (argument) rules: -! -! - for a list of variables available for the specific host model, see files -! doc/DevelopersGuide/CCPP_VARIABLES_XYZ.pdf, where XYZ is the name of the model -! -! - a standard_name cannot be assigned to more than one local variable (local_name) -! -! - all information (units, rank, index ordering) must match the specifications -! on the host model side, but subslices can be used/added in the host model: -! HOST MODEL: real, dimension(:,:,:,:) :: hydrometeors -! -! -! Coding rules: -! -! - code must comply to modern Fortran standards (Fortran 90/95/2003) -! -! - use labeled 'end' statements for modules, subroutines and functions -! module scheme_template -> end module scheme_template -! -! - use implicit none -! -! - all intent(out) variables must be initialized properly inside the subroutine -! -! - NO permanent state inside the module, i.e. no variables carrying the 'save' attribute -! -! - NO 'goto' statements -! -! - errors are handled by the host model using the two mandatory arguments -! errmsg and errflg; in the event of an error, assign a meaningful error -! message to errmsg and set errflg to a value other than 0 -! -! - schemes are NOT allowed to abort/stop the program -! -! - schemes are NOT allowed to perform I/O operations (except for reading -! lookup tables / other information needed to initialize the scheme) -! -! - line lengths of no more than 120 characters are suggested for better readability -! -! Parallel programming rules: -! -! - if OpenMP is used, the number of allowed threads must be provided by the -! host model as an intent(in) argument in the argument list -! -! - if MPI is used, it is restricted to global communications: barrier, broadcast, -! gather, scatter, reduction; the MPI communicator must be provided by the -! host model as an intent(in) argument in the argument list -! - do NOT use MPI_COMM_WORLD -! - do NOT use any point-to-point communication -! -! - if Fortran coarrays are used, consult with the CCPP development team -! -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - module scheme_template - - contains - - subroutine scheme_template_init () - end subroutine scheme_template_init - - subroutine scheme_template_finalize() - end subroutine scheme_template_finalize - -!> \section arg_table_scheme_template_run Argument Table -!! \htmlinclude scheme_template_run.html -!! - subroutine scheme_template_run (errmsg, errflg) - - implicit none - - !--- arguments - ! add your arguments here - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - !--- local variables - ! add your local variables here - - continue - - !--- initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - !--- initialize intent(out) variables - ! initialize all intent(out) variables here - - !--- actual code - ! add your code here - - ! in case of errors, set errflg to a value != 0, - ! assign a meaningful message to errmsg and return - - return - - end subroutine scheme_template_run - - end module scheme_template diff --git a/doc/DevelopersGuide/scheme_template.meta b/doc/DevelopersGuide/scheme_template.meta deleted file mode 100644 index 7a27bb32..00000000 --- a/doc/DevelopersGuide/scheme_template.meta +++ /dev/null @@ -1,81 +0,0 @@ -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! CCPP-compliant physics scheme template metadata -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! -! Metadata rules: -! -! - metadata files (.meta) are in a relaxed config file format and contain metada for one or more CCPP entrypoint schemes. -! There should be one .meta file for each .f or .F90 file -! -! - For each CCPP compliant scheme, the .meta file should have this set of lines -! [ccpp-arg-table] -! name = -! type = -! -! - ccpp-arg-table indicates the start of a new metadata section for a given scheme -! -! - is the name of the corresponding subroutine/module -! -! - type can be scheme, module, DDT, or host -! -! - for empty schemes, the three lines above are sufficient. For non-empty schemes, the metadata should -! describe all input and output arguments to the scheme using the following format: -! [varname] -! standard_name = -! long_name = -! units = -! dimensions = -! type = -! kind = -! intent = -! optional = -! -! - the intent argument is only valid in scheme metadata tables, as it is not applicable to the other types. -! -! - the following attributes are optional: long_name, kind, optional -! -! - lines can be combined using | as a separator, e.g., -! type = real | kind = kind_phys -! -! - is the local name of the variable in the subroutine -! -! - the dimensions attribute should be empty parentheses for scalars or contain the standard_name for the start and end for -! each dimension of an array. ccpp_constant_one is the assumed start for any dimension which only has a single value. -! For example: -! dimensions = () -! dimensions = (ccpp_constant_one:horizontal_loop_extent, vertical_level_dimension) -! dimensions = (horizontal_dimension,vertical_dimension) -! dimensions = (horizontal_dimension,vertical_dimension_of_ozone_forcing_data,number_of_coefficients_in_ozone_forcing_data) -! -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -[ccpp-arg-table] - name = ozphys_init - type = scheme - -######################################################################## -[ccpp-arg-table] - name = ozphys_finalize - type = scheme - -######################################################################## -[ccpp-arg-table] - name = ozphys_run - type = scheme -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out - optional = F -[errflg] - standard_name = ccpp_error_flag - long_name = error flag for error handling in CCPP - units = flag - dimensions = () - type = integer - intent = out - optional = F diff --git a/doc/DevelopersGuide/title.tex b/doc/DevelopersGuide/title.tex deleted file mode 100644 index 52175e50..00000000 --- a/doc/DevelopersGuide/title.tex +++ /dev/null @@ -1,28 +0,0 @@ -\begin{titlepage} -\renewcommand{\thefootnote}{\fnsymbol{footnote}} - -\vspace*{1em} -\noindent - -\begin{center} -\textcolor{darkgray}{\bigsf Common Community Physics Package\\[0.5ex] (CCPP)} -\vspace*{1em} - -\textcolor{darkgray}{\bigst Developers' Guide\\[0.5ex] v2.0} -\vspace*{1em} - -\large{August 2018}\\[4em] - -Dom Heinzeller, Ligia Bernardet\\ -\textit{\small{CIRES/CU at NOAA/ESRL Global Systems Division and Developmental Testbed Center}}\\[4em] - -Laurie Carson, Grant Firl\\ -\textit{\small{National Center for Atmospheric Research and Developmental Testbed Center}}\\[4em] - -\vspace{4em} - -\includegraphics[width=0.4\textwidth]{images/dtc_logo.png}\\[2em] - -\end{center} -\end{titlepage} -\pagebreak{} diff --git a/schemes/CMakeLists.txt b/schemes/CMakeLists.txt deleted file mode 100644 index 6f8899b1..00000000 --- a/schemes/CMakeLists.txt +++ /dev/null @@ -1,30 +0,0 @@ -# Set default project to unknown -if(NOT PROJECT) - message(STATUS "Setting CCPP project to 'unknown' as none was specified.") - set(PROJECT "Unknown") -endif (NOT PROJECT) - -#------------------------------------------------------------------------------ -# Include the external test project only in standalone builds (project not set) -#------------------------------------------------------------------------------ -if (PROJECT STREQUAL "Unknown") - include(ExternalProject) - - #---------------------------------------------------------------------------- - # The checker scheme - ExternalProject_Add( - check - DEPENDS ccpp - SOURCE_DIR "${CMAKE_CURRENT_SOURCE_DIR}/check" - PREFIX "check" - DOWNLOAD_COMMAND "" - UPDATE_COMMAND "" - INSTALL_COMMAND "" - CMAKE_ARGS -DCCPP_INCLUDE_DIRS=${CCPP_INCLUDE_DIRS} - -DCCPP_LIB_DIRS=${CCPP_LIB_DIRS} - -DPROJECT=${PROJECT} - -DCMAKE_Fortran_FLAGS=${CMAKE_Fortran_FLAGS} - -DCMAKE_SHARED_LIBRARY_CREATE_Fortran_FLAGS=${CMAKE_SHARED_LIBRARY_CREATE_Fortran_FLAGS} - -DCMAKE_BUILD_TYPE=${CMAKE_BUILD_TYPE} - ) -endif (PROJECT STREQUAL "Unknown") \ No newline at end of file diff --git a/schemes/check/CMakeLists.txt b/schemes/check/CMakeLists.txt deleted file mode 100644 index abdbec42..00000000 --- a/schemes/check/CMakeLists.txt +++ /dev/null @@ -1,99 +0,0 @@ -# Set default project to unknown -if(NOT PROJECT) - message(STATUS "Setting CCPP project to 'unknown' as none was specified.") - set(PROJECT "Unknown") -endif (NOT PROJECT) - -# Use rpaths on MacOSX -set(CMAKE_MACOSX_RPATH 1) - -#------------------------------------------------------------------------------ -cmake_minimum_required(VERSION 2.8.11) - -if(POLICY CMP0048) - cmake_policy(SET CMP0048 NEW) - project(check VERSION 0.0.1) -else(POLICY CMP0048) - project(check) - set(PROJECT_VERSION 0.0.1) - set(PROJECT_VERSION_MAJOR 0) - set(PROJECT_VERSION_MINOR 0) - set(PROJECT_VERSION_PATCH 1) -endif(POLICY CMP0048) - -#------------------------------------------------------------------------------ -set(PACKAGE "check") -set(AUTHORS "Timothy Brown" "Dom Heinzeller") -string(TIMESTAMP YEAR "%Y") - -#------------------------------------------------------------------------------ -# Enable Fortran -enable_language(Fortran) - -#------------------------------------------------------------------------------ -# CMake Modules -# Set the CMake module path -list(APPEND CMAKE_MODULE_PATH "${CMAKE_CURRENT_SOURCE_DIR}/../../cmake") - -#------------------------------------------------------------------------------ -# By default we want a shared library -option(BUILD_SHARED_LIBS "Build a shared library" ON) - -#------------------------------------------------------------------------------ -# Add the CCPP include/module directory and libraries, currently depends on build -# see FV3_current_trunk/ccpp/CMakeLists.txt on how to set CCPP_INCLUDE_DIRS etc. -if (PROJECT STREQUAL "CCPP-FV3") - # Add the CCPP include/module directory - set(CCPP_INCLUDE_DIRS "" CACHE FILEPATH "Path to ccpp includes") - set_property(DIRECTORY PROPERTY INCLUDE_DIRECTORIES ${CCPP_INCLUDE_DIRS}) - # Add the CCPP library - set(CCPP_LIB_DIRS "" CACHE FILEPATH "Path to ccpp library") - link_directories(${CCPP_LIB_DIRS}) - list(APPEND LIBS "ccpp") -else (PROJECT STREQUAL "CCPP-SCM") - # Add the CCPP include/module directory - INCLUDE_DIRECTORIES("${CMAKE_CURRENT_BINARY_DIR}/../../../../src") - # Add the CCPP library - LINK_DIRECTORIES("${CMAKE_CURRENT_BINARY_DIR}/../../../../src") - list(APPEND LIBS "ccpp") -endif (PROJECT STREQUAL "CCPP-FV3") - -#------------------------------------------------------------------------------ -# Set the sources -set(SOURCES - check_test.f90 - check_noop.f90 -) - -#------------------------------------------------------------------------------ -# Add the auto-generated caps -set (CCPP_MKCAP "${CMAKE_CURRENT_SOURCE_DIR}/../../scripts/ccpp_prebuild.py") -add_custom_command( - OUTPUT ${CMAKE_CURRENT_BINARY_DIR}/test_cap.F90 - DEPENDS ${CCPP_MKCAP} - COMMAND ${CCPP_MKCAP} --config=${CMAKE_CURRENT_SOURCE_DIR}/ccpp_prebuild_config.py --debug -) -list(APPEND SOURCES ${CMAKE_CURRENT_BINARY_DIR}/test_cap.F90) - -#------------------------------------------------------------------------------ -# The Fortran compiler/linker flag inserted by cmake to create shared libraries -# with the Intel compiler is deprecated (-i_dynamic), correct here. -# CMAKE_Fortran_COMPILER_ID = {"Intel", "PGI", "GNU", "Clang", "MSVC", ...} -if ("${CMAKE_Fortran_COMPILER_ID}" STREQUAL "Intel") - string(REPLACE "-i_dynamic" "-shared-intel" - CMAKE_SHARED_LIBRARY_CREATE_Fortran_FLAGS - "${CMAKE_SHARED_LIBRARY_CREATE_Fortran_FLAGS}") - string(REPLACE "-i_dynamic" "-shared-intel" - CMAKE_SHARED_LIBRARY_LINK_Fortran_FLAGS - "${CMAKE_SHARED_LIBRARY_LINK_Fortran_FLAGS}") -endif() - -# Guard for undefined/empty CMAKE_Fortran_FLAGS -set(CMAKE_Fortran_FLAGS " ${CMAKE_Fortran_FLAGS}") - -add_library(check ${SOURCES}) -target_link_libraries(check LINK_PUBLIC ${LIBS}) -set_target_properties(check PROPERTIES VERSION ${PROJECT_VERSION} - SOVERSION ${PROJECT_VERSION_MAJOR} - COMPILE_FLAGS ${CMAKE_Fortran_FLAGS} - LINK_FLAGS ${CMAKE_Fortran_FLAGS}) diff --git a/schemes/check/ccpp_prebuild_config.py b/schemes/check/ccpp_prebuild_config.py deleted file mode 100755 index a994686a..00000000 --- a/schemes/check/ccpp_prebuild_config.py +++ /dev/null @@ -1,92 +0,0 @@ -#!/usr/bin/env python - -# CCPP prebuild config for unit tests - - -############################################################################### -# Definitions # -############################################################################### - -HOST_MODEL_IDENTIFIER = 'TEST' - -# Add all files with metadata tables on the host model side, -# relative to basedir = top-level directory of host model -VARIABLE_DEFINITION_FILES = [ - '../../../../../src/tests/test_check.f90', - ] - -# Add all physics scheme dependencies relative to basedir - note that these are all violations -# of the CCPP requirement to not use any external modules except Fortran standard modules! -SCHEME_FILES_DEPENDENCIES = [ - ] - -# Add all physics scheme files relative to basedir -SCHEME_FILES = { - # Relative path to source (from where ccpp_prebuild.py is called) : [ list of physics sets in which scheme may be called ]; - # current restrictions are that each scheme can only belong to one physics set, and all schemes within one group in the - # suite definition file have to belong to the same physics set - '../../../../../schemes/check/check_test.f90' : [ 'test' ], - } - -# Default build dir, relative to current working directory, -# if not specified as command-line argument -DEFAULT_BUILD_DIR = '.' - -# Auto-generated makefile/cmakefile snippets that contain all schemes -SCHEMES_MAKEFILE = '/dev/null' -SCHEMES_CMAKEFILE = '/dev/null' -SCHEMES_SOURCEFILE = '/dev/null' - -# CCPP host cap in which to insert the ccpp_field_add statements; -# determines the directory to place ccpp_{modules,fields}.inc -TARGET_FILES = [ - '../../../../../src/tests/test_check.f90', - ] - -# Auto-generated makefile/cmakefile snippets that contain all caps -CAPS_MAKEFILE = '/dev/null' -CAPS_CMAKEFILE = '/dev/null' -CAPS_SOURCEFILE = '/dev/null' - -# Directory where to put all auto-generated physics caps -CAPS_DIR = '.' - -# Directory where the suite definition files are stored -SUITES_DIR = '../../../../../src/tests' - -# Optional arguments - only required for schemes that use -# optional arguments. ccpp_prebuild.py will throw an exception -# if it encounters a scheme subroutine with optional arguments -# if no entry is made here. Possible values are: 'all', 'none', -# or a list of standard_names: [ 'var1', 'var3' ]. -OPTIONAL_ARGUMENTS = { - 'test' : { - 'test_run' : [ 'surface_skin_temperature' ], - }, - #'subroutine_name_1' : 'all', - #'subroutine_name_2' : 'none', - #'subroutine_name_2' : [ 'var1', 'var3'], - } - -# Names of Fortran include files in the host model cap (do not change); -# both files will be written to the directory of each target file -MODULE_INCLUDE_FILE = 'ccpp_modules_{set}.inc' -FIELDS_INCLUDE_FILE = 'ccpp_fields_{set}.inc' - -# Directory where to write static API to -STATIC_API_DIR = '.' -STATIC_API_SRCFILE = './CCPP_STATIC_API.sh' - -# HTML document containing the model-defined CCPP variables -HTML_VARTABLE_FILE = 'CCPP_VARIABLES_FV3.html' - -# LaTeX document containing the provided vs requested CCPP variables -LATEX_VARTABLE_FILE = 'CCPP_VARIABLES_FV3.tex' - - -############################################################################### -# Template code to generate include files # -############################################################################### - -# Name of the CCPP data structure in the host model cap -CCPP_DATA_STRUCTURE = 'cdata' diff --git a/schemes/check/check_noop.f90 b/schemes/check/check_noop.f90 deleted file mode 100644 index ab8d17d0..00000000 --- a/schemes/check/check_noop.f90 +++ /dev/null @@ -1,72 +0,0 @@ -! -! This work (Common Community Physics Package), identified by NOAA, NCAR, -! CU/CIRES, is free of known copyright restrictions and is placed in the -! public domain. -! -! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL -! THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER -! IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN -! CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -! - -!> -!! @brief A NO-OP physics modules. -!! -! -module check_noop - - use, intrinsic :: iso_c_binding, & - only: c_f_pointer, c_ptr - use :: ccpp_types, & - only: ccpp_t - use :: ccpp_fields, & - only: ccpp_field_get - implicit none - - private - public :: noop_init_cap, noop_run_cap, noop_finalize_cap - - contains - - subroutine noop_init_cap(ptr) bind(c) - implicit none - type(c_ptr), intent(inout) :: ptr - - type(ccpp_t), pointer :: cdata - - call c_f_pointer(ptr, cdata) - - print *, 'In noop_init_cap' - print *, cdata%suite%groups(1)%subcycles(1)%schemes(1)%name - - end subroutine noop_init_cap - - subroutine noop_run_cap(ptr) bind(c) - implicit none - type(c_ptr), intent(inout) :: ptr - - type(ccpp_t), pointer :: cdata - - call c_f_pointer(ptr, cdata) - - print *, 'In noop_run_cap' - print *, cdata%suite%groups(1)%subcycles(1)%schemes(1)%name - - end subroutine noop_run_cap - - subroutine noop_finalize_cap(ptr) bind(c) - implicit none - type(c_ptr), intent(inout) :: ptr - - type(ccpp_t), pointer :: cdata - - call c_f_pointer(ptr, cdata) - - print *, 'In noop_finalize_cap' - print *, cdata%suite%groups(1)%subcycles(1)%schemes(1)%name - - end subroutine noop_finalize_cap - -end module check_noop diff --git a/schemes/check/check_test.f90 b/schemes/check/check_test.f90 deleted file mode 100644 index ffa04f3f..00000000 --- a/schemes/check/check_test.f90 +++ /dev/null @@ -1,65 +0,0 @@ -! -! This work (Common Community Physics Package), identified by NOAA, NCAR, -! CU/CIRES, is free of known copyright restrictions and is placed in the -! public domain. -! -! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL -! THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER -! IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN -! CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -! - -!> -!! @brief A checking physics modules. -!! -! -module test - - implicit none - - private - public :: test_init, test_run, test_finalize - - contains - - subroutine test_init() - end subroutine test_init - - subroutine test_finalize() - end subroutine test_finalize - -!! \section arg_table_test_run -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |-------------------------------------------|------------------------------------------|---------|------|-----------|----------|--------|----------| -!! | gravity | gravitational_acceleration | gravitational acceleration | m s-2 | 0 | real | | in | F | -!! | u | x_wind | zonal wind | m s-1 | 2 | real | | inout | F | -!! | v | y_wind | meridional wind | m s-1 | 2 | real | | inout | F | -!! | tsfc | surface_skin_temperature | surface skin temperature | K | 1 | real | | in | T | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! - subroutine test_run(gravity, u, v, tsfc, errflg, errmsg) - implicit none - real, intent(inout) :: gravity - real, intent(inout) :: u(:,:) - real, intent(inout) :: v(:,:) - real, intent(in) :: tsfc(:) - integer, intent(out) :: errflg - character(len=*), intent(out) :: errmsg - - errflg = 0 - errmsg = '' - - print *, 'In physics test_run' - print *, 'gravity: ', gravity - print *, 'tsfc: ', tsfc - print *, 'updating u to be 10m/s' - u = 10.0 - print *, 'updating v to be -10m/s' - v = -10.0 - - end subroutine test_run - -end module test diff --git a/schemes/check/nan.f90 b/schemes/check/nan.f90 deleted file mode 100644 index 166239b8..00000000 --- a/schemes/check/nan.f90 +++ /dev/null @@ -1,61 +0,0 @@ -! -! This work (Common Community Physics Package), identified by NOAA, NCAR, -! CU/CIRES, is free of known copyright restrictions and is placed in the -! public domain. -! -! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL -! THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER -! IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN -! CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -! - -!> -!! @brief A physics module to check for NaNs. -!! -! -module check_nans - - use, intrinsic :: iso_c_binding, & - only: c_f_pointer, c_ptr - use :: ccpp_types, & - only: ccpp_t - use :: ccpp_fields, & - only: ccpp_field_get - implicit none - - private - public :: nans_cap - - contains - - subroutine nans_cap(ptr) bind(c) - implicit none - type(c_ptr), intent(inout) :: ptr - - type(ccpp_t), pointer :: cdata - real, pointer :: v(:,:,:) - integer :: i - integer :: ierr - - call c_f_pointer(ptr, cdata) - - call ccpp_field_get(cdata, 'northward_wind', v, ierr) - - call nans_run(gravity, u, v, surf_t) - - end subroutine nans_cap - - subroutine nans_run(gravity, u, v, surf_t) - implicit none - real, pointer, intent(inout) :: gravity - real, pointer, intent(inout) :: surf_t(:) - real, pointer, intent(inout) :: u(:,:,:) - real, pointer, intent(inout) :: v(:,:,:) - - print *, 'In physics check nans run' - - end subroutine nans_run - -end module check_test diff --git a/schemes/check/scheme.xml b/schemes/check/scheme.xml deleted file mode 100644 index 8ae52e7d..00000000 --- a/schemes/check/scheme.xml +++ /dev/null @@ -1,35 +0,0 @@ - - - - - - gravity - m s-2 - gravity - 0 - real - - - surface_temperature - K - surf_t - 1 - real - - - eastward_wind - m s-1 - u - 3 - real - - - northward_wind - m s-1 - v - 3 - real - - - - diff --git a/scripts/ccpp_prebuild.py b/scripts/ccpp_prebuild.py index fda3c7ba..1e3dc561 100755 --- a/scripts/ccpp_prebuild.py +++ b/scripts/ccpp_prebuild.py @@ -3,6 +3,7 @@ # Standard modules import argparse import collections +import filecmp import importlib import itertools import logging @@ -13,10 +14,13 @@ # CCPP framework imports from common import encode_container, decode_container, decode_container_as_dict, execute from common import CCPP_INTERNAL_VARIABLES, CCPP_STATIC_API_MODULE, CCPP_INTERNAL_VARIABLE_DEFINITON_FILE +from common import STANDARD_VARIABLE_TYPES, STANDARD_INTEGER_TYPE, CCPP_TYPE +from common import SUITE_DEFINITION_FILENAME_PATTERN from common import split_var_name_and_array_reference from metadata_parser import merge_dictionaries, parse_scheme_tables, parse_variable_tables -from mkcap import Cap, CapsMakefile, CapsCMakefile, CapsSourcefile, \ - SchemesMakefile, SchemesCMakefile, SchemesSourcefile +from mkcap import CapsMakefile, CapsCMakefile, CapsSourcefile, \ + SchemesMakefile, SchemesCMakefile, SchemesSourcefile, \ + TypedefsMakefile, TypedefsCMakefile, TypedefsSourcefile from mkdoc import metadata_to_html, metadata_to_latex from mkstatic import API, Suite, Group @@ -28,8 +32,7 @@ parser.add_argument('--config', action='store', help='path to CCPP prebuild configuration file', required=True) parser.add_argument('--clean', action='store_true', help='remove files created by this script, then exit', default=False) parser.add_argument('--debug', action='store_true', help='enable debugging output', default=False) -parser.add_argument('--static', action='store_true', help='enable a static build for a given suite definition file', default=False) -parser.add_argument('--suites', action='store', help='suite definition files to use (comma-separated, for static build only, without path)', default='') +parser.add_argument('--suites', action='store', help='suite definition files to use (comma-separated, without path)', default='') parser.add_argument('--builddir', action='store', help='relative path to CCPP build directory', required=False, default=None) # BASEDIR is the current directory where this script is executed @@ -46,13 +49,12 @@ def parse_arguments(): configfile = args.config clean = args.clean debug = args.debug - static = args.static - if static and not args.suites: - parser.print_help() - sys.exit(-1) - sdfs = [ 'suite_{0}.xml'.format(x) for x in args.suites.split(',')] + if args.suites: + sdfs = [ 'suite_{0}.xml'.format(x) for x in args.suites.split(',')] + else: + sdfs = None builddir = args.builddir - return (success, configfile, clean, debug, static, sdfs, builddir) + return (success, configfile, clean, debug, sdfs, builddir) def import_config(configfile, builddir): """Import the configuration from a given configuration file""" @@ -80,6 +82,9 @@ def import_config(configfile, builddir): # Definitions in host-model dependent CCPP prebuild config script config['variable_definition_files'] = ccpp_prebuild_config.VARIABLE_DEFINITION_FILES + config['typedefs_makefile'] = ccpp_prebuild_config.TYPEDEFS_MAKEFILE.format(build_dir=builddir) + config['typedefs_cmakefile'] = ccpp_prebuild_config.TYPEDEFS_CMAKEFILE.format(build_dir=builddir) + config['typedefs_sourcefile'] = ccpp_prebuild_config.TYPEDEFS_SOURCEFILE.format(build_dir=builddir) config['scheme_files'] = ccpp_prebuild_config.SCHEME_FILES config['scheme_files_dependencies'] = ccpp_prebuild_config.SCHEME_FILES_DEPENDENCIES config['schemes_makefile'] = ccpp_prebuild_config.SCHEMES_MAKEFILE.format(build_dir=builddir) @@ -97,7 +102,7 @@ def import_config(configfile, builddir): config['host_model'] = ccpp_prebuild_config.HOST_MODEL_IDENTIFIER config['html_vartable_file'] = ccpp_prebuild_config.HTML_VARTABLE_FILE.format(build_dir=builddir) config['latex_vartable_file'] = ccpp_prebuild_config.LATEX_VARTABLE_FILE.format(build_dir=builddir) - # For static build: location of static API file, and shell script to source + # Location of static API file, and shell script to source config['static_api_dir'] = ccpp_prebuild_config.STATIC_API_DIR.format(build_dir=builddir) config['static_api_srcfile'] = ccpp_prebuild_config.STATIC_API_SRCFILE.format(build_dir=builddir) # Template code in host-model dependent CCPP prebuild config script @@ -109,10 +114,10 @@ def import_config(configfile, builddir): # To handle new metadata: import DDT references (if exist) try: config['typedefs_new_metadata'] = ccpp_prebuild_config.TYPEDEFS_NEW_METADATA - logging.info("Found TYPEDEFS_NEW_METADATA dictionary in config, assume at least some data is in new metadata formet") + logging.info("Found TYPEDEFS_NEW_METADATA dictionary in config, assume at least some data is in new metadata format") except AttributeError: config['typedefs_new_metadata'] = None - logging.info("Could not find TYPEDEFS_NEW_METADATA dictionary in config, assume all data is in old metadata formet") + logging.info("Could not find TYPEDEFS_NEW_METADATA dictionary in config, assume all data is in old metadata format") return(success, config) @@ -130,12 +135,15 @@ def setup_logging(debug): logging.info('Logging level set to INFO') return success -def clean_files(config, static): +def clean_files(config): """Clean files created by ccpp_prebuild.py""" success = True logging.info('Performing clean ....') # Create list of files to remove, use wildcards where necessary files_to_remove = [ + config['typedefs_makefile'], + config['typedefs_cmakefile'], + config['typedefs_sourcefile'], config['schemes_makefile'], config['schemes_cmakefile'], config['schemes_sourcefile'], @@ -144,23 +152,30 @@ def clean_files(config, static): config['caps_sourcefile'], config['html_vartable_file'], config['latex_vartable_file'], + os.path.join(config['caps_dir'], 'ccpp_*_cap.F90'), + os.path.join(config['static_api_dir'], '{api}.F90'.format(api=CCPP_STATIC_API_MODULE)), + config['static_api_srcfile'], ] - if static: - files_to_remove.append(os.path.join(config['caps_dir'], 'ccpp_*_cap.F90')) - files_to_remove.append(os.path.join(config['static_api_dir'], '{api}.F90'.format(api=CCPP_STATIC_API_MODULE))) - else: - files_to_remove.append(os.path.join(config['caps_dir'], '*_cap.F90')) - for target_file in config['target_files']: - target_file_path = os.path.split(target_file)[0] - files_to_remove.append(os.path.join(target_file_path, config['module_include_file'].format(set='*'))) - files_to_remove.append(os.path.join(target_file_path, config['fields_include_file'].format(set='*'))) # Not very pythonic, but the easiest way w/o importing another Python module cmd = 'rm -vf {0}'.format(' '.join(files_to_remove)) execute(cmd) return success +def get_all_suites(suites_dir): + success = False + logging.info("No suites were given, compiling a list of all suites") + sdfs = [] + for f in os.listdir(suites_dir): + match = SUITE_DEFINITION_FILENAME_PATTERN.match(f) + if match: + logging.info('Adding suite definition file {}'.format(f)) + sdfs.append(f) + if sdfs: + success = True + return (success, sdfs) + def parse_suites(suites_dir, sdfs): - """Parse suite definition files for static build""" + """Parse suite definition files for prebuild""" logging.info('Parsing suite definition files ...') suites = [] for sdf in sdfs: @@ -398,7 +413,7 @@ def check_optional_arguments(metadata, arguments, optional_arguments): # Remove this var instance from list of var instances for this var_name metadata[var_name].remove(var) # Remove var_name from list of calling arguments for that subroutine - # (unless that module has been filtered out for the static build) + # (unless that module has been filtered out because none of the suites uses it) if module_name in arguments.keys(): arguments[module_name][scheme_name][subroutine_name].remove(var_name) elif optional_arguments[module_name][subroutine_name] == 'all': @@ -499,105 +514,6 @@ def compare_metadata(metadata_define, metadata_request, pset_request, psets_merg modules[pset] = sorted(list(set(modules[pset]))) return (success, modules, metadata) -def create_module_use_statements(modules, pset): - """Create Fortran module use statements to be included in the host cap.""" - logging.info('Generating module use statements for physics set {0} ...'.format(pset)) - success = True - module_use_statements = '' - cnt = 1 - for module in modules: - module_use_statements += 'use {0}\n'.format(module) - cnt += 1 - logging.info('Generated module use statements for {0} module(s)'.format(cnt)) - return (success, module_use_statements) - -def create_ccpp_field_add_statements(metadata, pset, ccpp_data_structure): - """Create Fortran code to add host model variables to the cdata - structure. The metadata container may contain multiple entries - of a variable with the same standard_name, but for different - "callers" (i.e. subroutines using it) with identical or - different local_name. We only need to add it once to - the add_field statement, since the target (i.e. the - original variable defined by the model) is the same.""" - logging.info('Generating ccpp_field_add statements for physics set {0} ...'.format(pset)) - success = True - ccpp_field_add_statements = '' - cnt = 0 - # Record the index for each variable added to cdata via ccpp_add_field() - ccpp_field_map = {} - # Important - adding the variables sorted is key to using hard-coded - # indices for faster retrieval of variables from cdata via ccpp_field_get - for var_name in sorted(metadata.keys()): - # Skip CCPP internal variables, these are treated differently - if var_name in CCPP_INTERNAL_VARIABLES.keys(): - continue - # Add variable with var_name = standard_name once - logging.debug('Generating ccpp_field_add statement for variable {0}'.format(var_name)) - var = metadata[var_name][0] - # Use print add with specified index number and register the index in ccpp_field_map; - # note: Python counters run from 0 to X, Fortran counters from 1 to X+1 - ccpp_field_add_statements += var.print_add(ccpp_data_structure, cnt+1) - ccpp_field_map[var_name] = cnt+1 - cnt += 1 - logging.info('Generated ccpp_field_add statements for {0} variable(s)'.format(cnt)) - return (success, ccpp_field_add_statements, ccpp_field_map) - -def generate_include_files(module_use_statements, ccpp_field_add_statements, - target_files, module_include_file, fields_include_file): - """Generate include files for modules and field-add statements for host model cap.""" - logging.info('Generating include files for host model caps {0} ...'.format(', '.join(target_files))) - success = True - target_dirs = [] - for target_file in target_files: - target_dirs.append(os.path.split(target_file)[0]) - target_dirs = sorted(list(set(target_dirs))) - for target_dir in target_dirs: - # module use statements - includefile = os.path.join(target_dir, module_include_file) - logging.info('Generated module-use include file {0}'.format(includefile)) - with open(includefile, "w") as f: - f.write(module_use_statements) - # ccpp_field_add statements - includefile = os.path.join(target_dir, fields_include_file) - logging.info('Generated fields-add include file {0}'.format(includefile)) - with open(includefile, "w") as f: - f.write(ccpp_field_add_statements) - return success - -def generate_scheme_caps(metadata_define, metadata_request, arguments, pset_schemes, ccpp_field_maps, caps_dir): - """Generate scheme caps for all schemes parsed.""" - success = True - # Change to caps directory - os.chdir(caps_dir) - # List of filenames of scheme caps - scheme_caps = [] - for module_name in arguments.keys(): - for scheme_name in arguments[module_name].keys(): - for subroutine_name in arguments[module_name][scheme_name].keys(): - # Skip subroutines without argument table or with empty argument table - if not arguments[module_name][scheme_name][subroutine_name]: - continue - # Create cap - cap = Cap() - cap.filename = "{0}_cap.F90".format(scheme_name) - scheme_caps.append(cap.filename) - # Parse all subroutines and their arguments to generate the cap - capdata = collections.OrderedDict() - for subroutine_name in arguments[module_name][scheme_name].keys(): - capdata[subroutine_name] = [] - for var_name in arguments[module_name][scheme_name][subroutine_name]: - container = encode_container(module_name, scheme_name, subroutine_name) - for var in metadata_request[var_name]: - if var.container == container: - capdata[subroutine_name].append(var) - break - # Write cap using the unique physics set for the scheme - pset = pset_schemes[scheme_name][0] - cap.write(module_name, capdata, ccpp_field_maps[pset], metadata_define) - # - os.chdir(BASEDIR) - return (success, scheme_caps) - def generate_suite_and_group_caps(suites, metadata_request, metadata_define, arguments, caps_dir): """Generate for the suite and for all groups parsed.""" logging.info("Generating suite and group caps ...") @@ -617,7 +533,7 @@ def generate_suite_and_group_caps(suites, metadata_request, metadata_define, arg return (success, suite_and_group_caps) def generate_static_api(suites, static_api_dir): - """Generate API for static build for a given suite""" + """Generate static API for given suite(s)""" success = True # Change to caps directory, create if necessary if not os.path.isdir(static_api_dir): @@ -629,30 +545,112 @@ def generate_static_api(suites, static_api_dir): os.chdir(BASEDIR) return (success, api) +def generate_typedefs_makefile(metadata_define, typedefs_makefile, typedefs_cmakefile, typedefs_sourcefile): + """Generate list of Fortran modules containing CCPP type/kind definitions, + and create makefile/cmakefile snippets for host model build system""" + logging.info('Generating list of Fortran modules containing CCPP type definitions ...') + success = True + # + typedefs = [] + # (1) Search for type definitions in the metadata, defined by: + # (a) the type not being a standard type, and + # (b) the type not being the CCPP framework internal type + # (c) the standard_name being identical to the type name + # (2) Search for kind definitions in the metadata, defined by: + # (a) the standard_name starting with "kind_" + # (b) the type being integer and the units being none + for key in metadata_define.keys(): + # derived data types + if not metadata_define[key][0].type in STANDARD_VARIABLE_TYPES and \ + not metadata_define[key][0].type == CCPP_TYPE and \ + metadata_define[key][0].type == metadata_define[key][0].standard_name: + container = decode_container_as_dict(metadata_define[key][0].container) + if not 'MODULE' in container.keys(): + logging.error("Invalid type definition for type {}: {}".format(metadata_define[key][0].type, metadata_define[key][0].print_debug())) + success = False + continue + # Fortran modules are lowercase and have the ending ".mod" + typedef_fortran_module = "{}.mod".format(container['MODULE']).lower() + if not typedef_fortran_module in typedefs: + typedefs.append(typedef_fortran_module) + # kind definitions + elif metadata_define[key][0].standard_name.startswith("kind_") and \ + metadata_define[key][0].type == STANDARD_INTEGER_TYPE and \ + metadata_define[key][0].units == 'none': + container = decode_container_as_dict(metadata_define[key][0].container) + if not 'MODULE' in container.keys(): + logging.error("Invalid kind definition for kind {}: {}".format(metadata_define[key][0].type, metadata_define[key][0].print_debug())) + success = False + continue + # Fortran modules are lowercase and have the ending ".mod" + typedef_fortran_module = "{}.mod".format(container['MODULE']).lower() + if not typedef_fortran_module in typedefs: + typedefs.append(typedef_fortran_module) + + logging.info('Generating typedefs makefile/cmakefile snippet ...') + # Write the Fortran modules without path - the build system knows where they are + makefile = TypedefsMakefile() + makefile.filename = typedefs_makefile + '.tmp' + cmakefile = TypedefsCMakefile() + cmakefile.filename = typedefs_cmakefile + '.tmp' + sourcefile = TypedefsSourcefile() + sourcefile.filename = typedefs_sourcefile + '.tmp' + makefile.write(typedefs) + cmakefile.write(typedefs) + sourcefile.write(typedefs) + if os.path.isfile(typedefs_makefile) and \ + filecmp.cmp(typedefs_makefile, makefile.filename): + os.remove(makefile.filename) + os.remove(cmakefile.filename) + os.remove(sourcefile.filename) + else: + if os.path.isfile(typedefs_makefile): + os.remove(typedefs_makefile) + if os.path.isfile(typedefs_cmakefile): + os.remove(typedefs_cmakefile) + if os.path.isfile(typedefs_sourcefile): + os.remove(typedefs_sourcefile) + os.rename(makefile.filename, typedefs_makefile) + os.rename(cmakefile.filename, typedefs_cmakefile) + os.rename(sourcefile.filename, typedefs_sourcefile) + # + logging.info('Added {0} typedefs to {1}, {2}, {3}'.format( + len(typedefs), typedefs_makefile, typedefs_cmakefile, typedefs_sourcefile)) + return success + def generate_schemes_makefile(schemes, schemes_makefile, schemes_cmakefile, schemes_sourcefile): """Generate makefile/cmakefile snippets for all schemes.""" logging.info('Generating schemes makefile/cmakefile snippet ...') success = True makefile = SchemesMakefile() - makefile.filename = schemes_makefile + makefile.filename = schemes_makefile + '.tmp' cmakefile = SchemesCMakefile() - cmakefile.filename = schemes_cmakefile + cmakefile.filename = schemes_cmakefile + '.tmp' sourcefile = SchemesSourcefile() - sourcefile.filename = schemes_sourcefile - # Adjust relative file path to schemes from caps makefile - schemes_with_path = [] - schemes_with_abspath = [] - schemes_makefile_dir = os.path.split(os.path.abspath(schemes_makefile))[0] - for scheme in schemes: - (scheme_filepath, scheme_filename) = os.path.split(os.path.abspath(scheme)) - relative_path = './{0}'.format(os.path.relpath(scheme_filepath, schemes_makefile_dir)) - schemes_with_path.append(os.path.join(relative_path, scheme_filename)) - schemes_with_abspath.append(os.path.abspath(scheme)) + sourcefile.filename = schemes_sourcefile + '.tmp' + # Generate list of schemes with absolute path + schemes_with_abspath = [ os.path.abspath(scheme) for scheme in schemes ] makefile.write(schemes_with_abspath) cmakefile.write(schemes_with_abspath) sourcefile.write(schemes_with_abspath) + if os.path.isfile(schemes_makefile) and \ + filecmp.cmp(schemes_makefile, makefile.filename): + os.remove(makefile.filename) + os.remove(cmakefile.filename) + os.remove(sourcefile.filename) + else: + if os.path.isfile(schemes_makefile): + os.remove(schemes_makefile) + if os.path.isfile(schemes_cmakefile): + os.remove(schemes_cmakefile) + if os.path.isfile(schemes_sourcefile): + os.remove(schemes_sourcefile) + os.rename(makefile.filename, schemes_makefile) + os.rename(cmakefile.filename, schemes_cmakefile) + os.rename(sourcefile.filename, schemes_sourcefile) + # logging.info('Added {0} schemes to {1}, {2}, {3}'.format( - len(schemes_with_path), makefile.filename, cmakefile.filename, sourcefile.filename)) + len(schemes_with_abspath), schemes_makefile, schemes_cmakefile, schemes_sourcefile)) return success def generate_caps_makefile(caps, caps_makefile, caps_cmakefile, caps_sourcefile, caps_dir): @@ -660,27 +658,40 @@ def generate_caps_makefile(caps, caps_makefile, caps_cmakefile, caps_sourcefile, logging.info('Generating caps makefile/cmakefile snippet ...') success = True makefile = CapsMakefile() - makefile.filename = caps_makefile + makefile.filename = caps_makefile + '.tmp' cmakefile = CapsCMakefile() - cmakefile.filename = caps_cmakefile + cmakefile.filename = caps_cmakefile + '.tmp' sourcefile = CapsSourcefile() - sourcefile.filename = caps_sourcefile - # Adjust relative file path to schemes from caps makefile - caps_makefile_dir = os.path.split(os.path.abspath(caps_makefile))[0] - relative_path = './{0}'.format(os.path.relpath(caps_dir, caps_makefile_dir)) - caps_with_path = [ os.path.join(relative_path, cap) for cap in caps] - caps_with_abspath = [ os.path.abspath(os.path.join(caps_dir, cap)) for cap in caps] + sourcefile.filename = caps_sourcefile + '.tmp' + # Generate list of caps with absolute path + caps_with_abspath = [ os.path.abspath(os.path.join(caps_dir, cap)) for cap in caps ] makefile.write(caps_with_abspath) cmakefile.write(caps_with_abspath) sourcefile.write(caps_with_abspath) - logging.info('Added {0} auto-generated caps to {1} and {2}'.format( - len(caps_with_path), makefile.filename, cmakefile.filename)) + if os.path.isfile(caps_makefile) and \ + filecmp.cmp(caps_makefile, makefile.filename): + os.remove(makefile.filename) + os.remove(cmakefile.filename) + os.remove(sourcefile.filename) + else: + if os.path.isfile(caps_makefile): + os.remove(caps_makefile) + if os.path.isfile(caps_cmakefile): + os.remove(caps_cmakefile) + if os.path.isfile(caps_sourcefile): + os.remove(caps_sourcefile) + os.rename(makefile.filename, caps_makefile) + os.rename(cmakefile.filename, caps_cmakefile) + os.rename(sourcefile.filename, caps_sourcefile) + # + logging.info('Added {0} auto-generated caps to {1} and {2}, {3}'.format( + len(caps_with_abspath), caps_makefile, caps_cmakefile, caps_sourcefile)) return success def main(): """Main routine that handles the CCPP prebuild for different host models.""" # Parse command line arguments - (success, configfile, clean, debug, static, sdfs, builddir) = parse_arguments() + (success, configfile, clean, debug, sdfs, builddir) = parse_arguments() if not success: raise Exception('Call to parse_arguments failed.') @@ -694,15 +705,20 @@ def main(): # Perform clean if requested, then exit if clean: - success = clean_files(config, static) + success = clean_files(config) logging.info('CCPP prebuild clean completed successfully, exiting.') sys.exit(0) - # Parse suite definition files for static build - if static: - (success, suites) = parse_suites(config['suites_dir'], sdfs) + # If no suite definition files were given, get all of them + if not sdfs: + (success, sdfs) = get_all_suites(config['suites_dir']) if not success: - raise Exception('Parsing suite definition files failed.') + raise Exception('Call to get_all_sdfs failed.') + + # Parse suite definition files for prebuild + (success, suites) = parse_suites(config['suites_dir'], sdfs) + if not success: + raise Exception('Parsing suite definition files failed.') # Check that each scheme only belongs to one set of physics # this is required for using the optimized version of ccpp_field_get @@ -726,12 +742,11 @@ def main(): if not success: raise Exception('Call to collect_physics_subroutines failed.') - # Filter metadata/pset/arguments for static build - remove whatever is not included in suite definition file - if static: - (success, metadata_request, pset_request, arguments_request) = filter_metadata(metadata_request, pset_request, - arguments_request, suites) - if not success: - raise Exception('Call to filter_metadata failed.') + # Filter metadata/pset/arguments - remove whatever is not included in suite definition files + (success, metadata_request, pset_request, arguments_request) = filter_metadata(metadata_request, pset_request, + arguments_request, suites) + if not success: + raise Exception('Call to filter_metadata failed.') # Process optional arguments based on configuration in above dictionary optional_arguments (success, metadata_request, arguments_request) = check_optional_arguments(metadata_request,arguments_request, @@ -752,67 +767,36 @@ def main(): if not success: raise Exception('Call to compare_metadata failed.') - if not static: - # Dictionary of indices of variables in the cdata structure, per pset - ccpp_field_maps = {} - for pset in psets_merged: - # Create module use statements to inject into the host model cap - (success, module_use_statements) = create_module_use_statements(modules[pset], pset) - if not success: - raise Exception('Call to create_module_use_statements failed.') - - # Only process variables that fall into this pset - metadata_filtered = { key : value for (key, value) in metadata.items() if pset in pset_request[key] } - - # Create ccpp_fiels_add statements to inject into the host model cap; - # this returns a ccpp_field_map that contains indices of variables in - # the cdata structure for the given pset - (success, ccpp_field_add_statements, ccpp_field_map) = create_ccpp_field_add_statements(metadata_filtered, - pset, config['ccpp_data_structure']) - if not success: - raise Exception('Call to create_ccpp_field_add_statements failed.') - ccpp_field_maps[pset] = ccpp_field_map - - # Generate include files for module_use_statements and ccpp_field_add_statements - success = generate_include_files(module_use_statements, ccpp_field_add_statements, config['target_files'], - config['module_include_file'].format(set=pset), - config['fields_include_file'].format(set=pset)) - if not success: - raise Exception('Call to generate_include_files failed.') + # Add Fortran module files of typedefs to makefile/cmakefile/shell script + success = generate_typedefs_makefile(metadata_define, config['typedefs_makefile'], + config['typedefs_cmakefile'], config['typedefs_sourcefile']) + if not success: + raise Exception('Call to generate_typedefs_makefile failed.') - # Add filenames of schemes to makefile - add dependencies for schemes - success = generate_schemes_makefile(config['scheme_files_dependencies'] + config['scheme_files'].keys(), + # Add filenames of schemes to makefile/cmakefile/shell script - add dependencies for schemes + success = generate_schemes_makefile(config['scheme_files_dependencies'] + list(config['scheme_files'].keys()), config['schemes_makefile'], config['schemes_cmakefile'], config['schemes_sourcefile']) if not success: raise Exception('Call to generate_schemes_makefile failed.') - if static: - # Static build: generate caps for entire suite and groups in the specified suite; generate API - (success, suite_and_group_caps) = generate_suite_and_group_caps(suites, metadata_request, metadata_define, - arguments_request, config['caps_dir']) - if not success: - raise Exception('Call to generate_suite_and_group_caps failed.') + # Static build: generate caps for entire suite and groups in the specified suite; generate API + (success, suite_and_group_caps) = generate_suite_and_group_caps(suites, metadata_request, metadata_define, + arguments_request, config['caps_dir']) + if not success: + raise Exception('Call to generate_suite_and_group_caps failed.') - (success, api) = generate_static_api(suites, config['static_api_dir']) - if not success: - raise Exception('Call to generate_static_api failed.') + (success, api) = generate_static_api(suites, config['static_api_dir']) + if not success: + raise Exception('Call to generate_static_api failed.') - success = api.write_sourcefile(config['static_api_srcfile']) - if not success: - raise Exception("Writing API sourcefile {sourcefile} failed".format(sourcefile=config['static_api_srcfile'])) - else: - # Generate scheme caps for each individual scheme - (success, scheme_caps) = generate_scheme_caps(metadata_define, metadata_request, arguments_request, - pset_schemes, ccpp_field_maps, config['caps_dir']) - if not success: - raise Exception('Call to generate_scheme_caps failed.') + success = api.write_sourcefile(config['static_api_srcfile']) + if not success: + raise Exception("Writing API sourcefile {sourcefile} failed".format(sourcefile=config['static_api_srcfile'])) + + # Add filenames of caps to makefile/cmakefile/shell script + all_caps = suite_and_group_caps - # Add filenames of caps to makefile - if static: - all_caps = suite_and_group_caps - else: - all_caps = scheme_caps success = generate_caps_makefile(all_caps, config['caps_makefile'], config['caps_cmakefile'], config['caps_sourcefile'], config['caps_dir']) if not success: diff --git a/scripts/common.py b/scripts/common.py index 4f37b7da..801ecfcc 100755 --- a/scripts/common.py +++ b/scripts/common.py @@ -33,13 +33,17 @@ CCPP_THREAD_NUMBER : 'cdata%thrd_no', } -STANDARD_VARIABLE_TYPES = [ 'character', 'integer', 'logical', 'real' ] STANDARD_CHARACTER_TYPE = 'character' +STANDARD_INTEGER_TYPE = 'integer' +STANDARD_VARIABLE_TYPES = [ STANDARD_CHARACTER_TYPE, STANDARD_INTEGER_TYPE, 'logical', 'real' ] # For static build CCPP_STATIC_API_MODULE = 'ccpp_static_api' CCPP_STATIC_SUBROUTINE_NAME = 'ccpp_physics_{stage}' +# Filename pattern for suite definition files +SUITE_DEFINITION_FILENAME_PATTERN = re.compile('^suite_(.*)\.xml$') + def execute(cmd, abort = True): """Runs a local command in a shell. Waits for completion and returns status, stdout and stderr. If abort = True, abort in @@ -55,35 +59,18 @@ def execute(cmd, abort = True): status = p.returncode if debug: message = 'Execution of "{0}" returned with exit code {1}\n'.format(cmd, status) - message += ' stdout: "{0}"\n'.format(stdout.rstrip('\n')) - message += ' stderr: "{0}"'.format(stderr.rstrip('\n')) + message += ' stdout: "{0}"\n'.format(stdout.decode('ascii').rstrip('\n')) + message += ' stderr: "{0}"'.format(stderr.decode('ascii').rstrip('\n')) logging.debug(message) if not status == 0: message = 'Execution of command {0} failed, exit code {1}\n'.format(cmd, status) - message += ' stdout: "{0}"\n'.format(stdout.rstrip('\n')) - message += ' stderr: "{0}"'.format(stderr.rstrip('\n')) + message += ' stdout: "{0}"\n'.format(stdout.decode('ascii').rstrip('\n')) + message += ' stderr: "{0}"'.format(stderr.decode('ascii').rstrip('\n')) if abort: raise Exception(message) else: logging.error(message) - return (status, stdout.rstrip('\n'), stderr.rstrip('\n')) - -def indent(elem, level=0): - """Subroutine for writing "pretty" XML; copied from - http://effbot.org/zone/element-lib.htm#prettyprint""" - i = "\n" + level*" " - if len(elem): - if not elem.text or not elem.text.strip(): - elem.text = i + " " - if not elem.tail or not elem.tail.strip(): - elem.tail = i - for elem in elem: - indent(elem, level+1) - if not elem.tail or not elem.tail.strip(): - elem.tail = i - else: - if level and (not elem.tail or not elem.tail.strip()): - elem.tail = i + return (status, stdout.decode('ascii').rstrip('\n'), stderr.decode('ascii').rstrip('\n')) def split_var_name_and_array_reference(var_name): """Split an expression like foo(:,a,1:ddt%ngas) @@ -126,7 +113,7 @@ def decode_container(container): items = container.split(' ') if not len(items) in [1, 2, 3]: raise Exception("decode_container not implemented for {0} items".format(len(items))) - for i in xrange(len(items)): + for i in range(len(items)): items[i] = items[i][:items[i].find('_')] + ' ' + items[i][items[i].find('_')+1:] return ' '.join(items) @@ -139,7 +126,7 @@ def decode_container_as_dict(container): if not len(items) in [1, 2, 3]: raise Exception("decode_container not implemented for {0} items".format(len(items))) itemsdict = {} - for i in xrange(len(items)): + for i in range(len(items)): key, value = (items[i][:items[i].find('_')], items[i][items[i].find('_')+1:]) itemsdict[key] = value return itemsdict diff --git a/scripts/conversion_tools/__init__.py b/scripts/conversion_tools/__init__.py index a723c9a3..4842889a 100644 --- a/scripts/conversion_tools/__init__.py +++ b/scripts/conversion_tools/__init__.py @@ -2,7 +2,53 @@ """ __all__ = [ - 'units', + 'cm__to__m', + 'm__to__cm', + 'mm__to__m', + 'm__to__mm', + 'um__to__m', + 'm__to__um', + 'm__to__km', + 'km__to__m', + 'mm__to__km', + 'km__to__mm', + 's__to__min', + 'min__to__s', + 's__to__h', + 'h__to__s', + 'h__to__d', + 'd__to__h', + 's__to__d', + 'd__to__s', + 'Pa__to__hPa', + 'hPa__to__Pa', + 'm_s_minus_1__to__km_h_minus_1', + 'km_h_minus_1__to__m_s_minus_1', + 'W_m_minus_2__to__erg_cm_minus_2_s_minus_1', + 'erg_cm_minus_2_s_minus_1__to__W_m_minus_2', ] -import unit_conversion +from .unit_conversion import cm__to__m +from .unit_conversion import m__to__cm +from .unit_conversion import mm__to__m +from .unit_conversion import m__to__mm +from .unit_conversion import um__to__m +from .unit_conversion import m__to__um +from .unit_conversion import m__to__km +from .unit_conversion import km__to__m +from .unit_conversion import mm__to__km +from .unit_conversion import km__to__mm +from .unit_conversion import s__to__min +from .unit_conversion import min__to__s +from .unit_conversion import s__to__h +from .unit_conversion import h__to__s +from .unit_conversion import h__to__d +from .unit_conversion import d__to__h +from .unit_conversion import s__to__d +from .unit_conversion import d__to__s +from .unit_conversion import Pa__to__hPa +from .unit_conversion import hPa__to__Pa +from .unit_conversion import m_s_minus_1__to__km_h_minus_1 +from .unit_conversion import km_h_minus_1__to__m_s_minus_1 +from .unit_conversion import W_m_minus_2__to__erg_cm_minus_2_s_minus_1 +from .unit_conversion import erg_cm_minus_2_s_minus_1__to__W_m_minus_2 diff --git a/scripts/conversion_tools/unit_conversion.py b/scripts/conversion_tools/unit_conversion.py index 3b3dd2af..811bee2d 100755 --- a/scripts/conversion_tools/unit_conversion.py +++ b/scripts/conversion_tools/unit_conversion.py @@ -23,6 +23,14 @@ def m__to__mm(): """Convert meter to millimeter""" return '1.0E+3{kind}*{var}' +def cm__to__m(): + """Convert centimeter to meter""" + return '1.0E-2{kind}*{var}' + +def m__to__cm(): + """Convert meter to centimeter""" + return '1.0E+2{kind}*{var}' + def um__to__m(): """Convert micrometer to meter""" return '1.0E-6{kind}*{var}' diff --git a/scripts/convert_metadata.py b/scripts/convert_metadata.py deleted file mode 100755 index 34082f77..00000000 --- a/scripts/convert_metadata.py +++ /dev/null @@ -1,718 +0,0 @@ -#!/usr/bin/env python - -# Python library imports -import sys -import os.path -import re -from collections import OrderedDict -import logging -# CCPP framework imports -from parse_tools import FORTRAN_ID, init_log, set_log_level -from fortran_tools import parse_fortran_file -from common import split_var_name_and_array_reference - -yes_re = re.compile(r"(?i)^\s*yes\s*$") -module_re = re.compile(r"(?i)\s*module\s+"+(FORTRAN_ID)+r"\s*.*$") -end_module_re = re.compile(r"(?i)\s*end\s*module\s+"+(FORTRAN_ID)+r"\s*.*$") -type_re = re.compile(r"(?i)\s*type\s+"+(FORTRAN_ID)+r"\s*.*$") -end_type_re = re.compile(r"(?i)\s*end\s*type\s+"+(FORTRAN_ID)+r"\s*.*$") -required_attrs = ['standard_name', 'units', 'dimensions', 'type'] -warning = True -__not_found__ = 'XX_NotFound_XX' - -# Configured models -MODELS = ['FV3'] - -######################################################################## - -def next_line(lines, max_line, cindex=-1): - nindex = cindex + 1 - if nindex > max_line: - return None, -1 - else: - return lines[nindex].rstrip('\n'), nindex - -######################################################################## - -def parse_module_line(line, mod_name): - match = module_re.match(line) - if match is not None: - mod_name = match.group(1) - else: - match = end_module_re.match(line) - if match is not None: - mod_name = None - # End if - # End if - return mod_name - -######################################################################## - -class MetadataEntry(OrderedDict): - - def __init__(self, local_name): - self._name = local_name - super(MetadataEntry, self).__init__() - - @property - def local_name(self): - return self._name - - def write(self, mdfile): - mdfile.write('[{}]\n'.format(self.local_name)) - for key in self.keys(): - mdfile.write(" {} = {}\n".format(key, self[key])) - # End for - -######################################################################## - -class MetadataTable(OrderedDict): - - def __init__(self, table_name, mod_name): - self._name = table_name - if (mod_name is not None) and (mod_name.lower() == table_name.lower()): - self._type = 'module' - elif table_name.split('_')[-1].lower() == 'type': - self._type = 'ddt' - else: - self._type = 'scheme' - # End if - super(MetadataTable, self).__init__() - - @property - def name(self): - return self._name - - @property - def type(self): - return self._type - - def has(self, varname): - hasvar = False - vartest = varname.lower() - for name in self.keys(): - if vartest == name.lower(): - hasvar = True - break - # End if - # End for - return hasvar - - def get(self, varname): - var = None - vartest = varname.lower() - for name in self.keys(): - if vartest == name.lower(): - var = self[name] - break - # End if - # End for - return var - - def write(self, mdfile): - mdfile.write('[ccpp-arg-table]\n') - mdfile.write(' name = {}\n'.format(self._name)) - mdfile.write(' type = {}\n'.format(self._type)) - for key in self.keys(): - self[key].write(mdfile) - -######################################################################## - -def convert_file(filename_in, filename_out, metadata_filename_out, model, logger=None): - """Convert a file's old metadata to the new format - Note that only the bare minimum error checking is done. - """ - if logger: - logger.info("Converting file {} ...".format(filename_in)) - else: - print "Converting file {} ...".format(filename_in) - current_module = None - # First, suck in the old file - do_convert = True - if not os.path.exists(filename_in): - raise IOError("convert_file: file, '{}', does not exist".format(filename_in)) - # End if - if os.path.exists(filename_out): - raise IOError("convert_file: file, '{}', already exists".format(filename_out)) - # End if - - # Lookup table local_name -> standard_name with data from ccpp_types.F90 - standard_names = { - 'cdata%blk_no' : 'ccpp_block_number', - 'cdata%thrd_no' : 'ccpp_thread_number', - 'cdata%errflg' : 'ccpp_error_flag', - 'cdata%errmsg' : 'ccpp_error_message', - 'cdata%loop_cnt': 'ccpp_loop_counter', - } - # Lookup table local_name -> dimensions - dimensions = {} - - # Read all lines of the file at once - with open(filename_in, 'r') as file: - fin_lines = file.readlines() - for index in xrange(len(fin_lines)): - fin_lines[index] = fin_lines[index].rstrip('\n') - # First loop through file to build dictionary with local names versus standard names - # and to record array dimensions from allocate statements - words = fin_lines[index].split('|') - if len(words)>=11: - # Create a dictionary with local names versus standard names in file - if words[0].strip() == '!!' and not words[1].strip() == 'local_name' and not words[2].strip() == 'standard_name' \ - and not "---" in words[1].strip() and not "---" in words[2].strip() : - local_name = words[1].strip().lower() - standard_name = words[2].strip() - if not standard_name: - continue - # No duplicates allowed - if local_name in standard_names.keys(): - raise Exception("Multiple definitions of local name {}".format(local_name)) - standard_names[local_name] = standard_name - elif 'allocate' in fin_lines[index]: - # Find all allocate statements to identify the correct dimensions - line_stripped = fin_lines[index].replace(' ','') - if 'allocate(' in line_stripped: - var_and_dims = line_stripped[line_stripped.find("allocate(")+9:line_stripped.rfind(")")] - # Variable to allocate, replace code with text used in metadata - var = var_and_dims[:var_and_dims.find("(")].lower() - # - # Begin model and file-dependent substitutions - if model == 'FV3': - if "GFS_typedefs" in filename_in: - var = var.replace("model%","gfs_control%") - var = var.replace("interstitial%","gfs_interstitial(cdata%thrd_no)%") - elif "CCPP_typedefs" in filename_in: - var = var.replace("interstitial%","ccpp_interstitial%") - # End model and file-dependent substitutions - # - # Dimensions to use, replace code with text used in metadata - dims = var_and_dims[var_and_dims.find("(")+1:var_and_dims.rfind(")")].split(',') - dims = [dim.lower() for dim in dims] - # - # Begin model and file-dependent substitutions - if model == 'FV3': - if "GFS_typedefs" in filename_in: - dims = [dim.replace("model%","gfs_control%") for dim in dims] - dims = [dim.replace("interstitial%","gfs_interstitial(cdata%thrd_no)%") for dim in dims] - elif "CCPP_typedefs" in filename_in: - dims = [dim.replace("interstitial%","ccpp_interstitial%") for dim in dims] - # Special handling of certain variables with multiple allocation lines in GFS_typedefs.F90 / CCPP_typedefs.F90 - if var == 'Diag%dq3dt'.lower(): - dims = ['im', 'gfs_control%levs', 'oz_coeff+5'] - elif var == 'ccpp_interstitial%cappa'.lower(): - dims = ['isd:ied', 'jsd:jed', '1:npzcappa'] - elif var in dimensions.keys() and not dims == dimensions[var]: - raise Exception("Multiple, conflicting allocations of variable with local name {}: {} vs {}".format( - var, dimensions[var], dims)) - # End model and file-dependent substitutions - else: - if var in dimensions.keys() and not dims == dimensions[var]: - raise Exception("Multiple, conflicting allocations of variable with local name {}: {} vs {}".format( - var, dimensions[var], dims)) - dimensions[var] = dims - # End if - # End if - # End if - # End for - # End with - - # Begin model and file-dependent substitutions - if model == 'FV3': - # Replace local dimensions in GFS_typedefs.F90, CCPP_typedefs.F90 and CCPP_data.F90 with correct standard names - for key in dimensions.keys(): - for i in xrange(len(dimensions[key])): - dim = dimensions[key][i] - if dim == 'im': - dimensions[key][i] = 'horizontal_dimension' - elif dim == 'interstitial%nvdiff': - dimensions[key][i] = 'number_of_vertical_diffusion_tracers' - elif dim == 'interstitial%nn': - dimensions[key][i] = 'number_of_tracers_for_convective_transport' - elif dim == 'gfs_control%levr+1': - dimensions[key][i] = 'number_of_vertical_layers_for_radiation_calculations_plus_one' - elif dim == 'gfs_control%levs+1': - dimensions[key][i] = 'vertical_dimension_plus_one' - elif dim == 'gfs_control%levs-1': - dimensions[key][i] = 'vertical_dimension_minus_one' - elif dim == 'gfs_control%levr+ltp': - dimensions[key][i] = 'adjusted_vertical_layer_dimension_for_radiation' - elif dim == 'gfs_control%levr+1+ltp': - dimensions[key][i] = 'adjusted_vertical_level_dimension_for_radiation' - elif dim in [ '-2:4', '4', '-2:0', '1:4', '6', '2', '3', '5', '7' ]: - continue - elif dim == 'levh2o': - dimensions[key][i] = 'vertical_dimension_of_h2o_forcing_data' - elif dim == 'h2o_coeff': - dimensions[key][i] = 'number_of_coefficients_in_h2o_forcing_data' - elif dim == 'levozp': - dimensions[key][i] = 'vertical_dimension_of_ozone_forcing_data' - elif dim == 'oz_coeff': - dimensions[key][i] = 'number_of_coefficients_in_ozone_forcing_data' - elif dim == 'oz_coeff+5': - dimensions[key][i] = 'number_of_coefficients_in_ozone_forcing_data_plus_five' - elif dim == '1:gfs_control%nblks': - dimensions[key][i] = 'number_of_blocks' - elif dim == 'ntrcaer': - dimensions[key][i] = 'number_of_aerosol_tracers_MG' - elif dim == 'nspc1': - dimensions[key][i] = 'number_of_species_for_aerosol_optical_depth' - elif dim == 'nbdlw': - dimensions[key][i] = 'number_of_aerosol_bands_for_longwave_radiation' - elif dim == 'nbdsw': - dimensions[key][i] = 'number_of_aerosol_bands_for_shortwave_radiation' - elif dim == 'nf_aelw': - dimensions[key][i] = 'number_of_aerosol_output_fields_for_longwave_radiation' - elif dim == 'nf_aesw': - dimensions[key][i] = 'number_of_aerosol_output_fields_for_shortwave_radiation' - elif dim == 'is:ie': - dimensions[key][i] = 'starting_x_direction_index:ending_x_direction_index' - elif dim == 'isd:ied': - dimensions[key][i] = 'starting_x_direction_index_domain:ending_x_direction_index_domain' - elif dim == 'js:je': - dimensions[key][i] = 'starting_y_direction_index:ending_y_direction_index' - elif dim == 'jsd:jed': - dimensions[key][i] = 'starting_y_direction_index_domain:ending_y_direction_index_domain' - elif dim == '1:npz': - dimensions[key][i] = '1:vertical_dimension_for_fast_physics' - elif dim == '1:npzcappa': - dimensions[key][i] = '1:vertical_dimension_for_cappa_at_Lagrangian_surface' - elif dim == '0:ccpp_interstitial%ngas': - dimensions[key][i] = '0:number_of_gases_for_multi_gases_physics' - elif dim in [ 'gfs_control%nfxr', - 'gfs_control%ntot2d', - 'gfs_control%ntot3d', - 'nf_clds', - '1:size(bk)', - 'nf_vgas', - '1:size(ak)', - 'nf_albd', - 'n', - ]: - dimensions[key][i] = dim + "_XX_SubstituteWithStandardName_XX" - elif not dim in standard_names.keys(): - raise Exception("Dimension {} not defined".format(dim)) - else: - dimensions[key][i] = standard_names[dim] - # End if - # End for - # End for - # End model and file-dependent substitutions - - max_line = len(fin_lines) - 1 - mdconfig = list() - in_preamble = True - in_type = False - ddt_references = {} - with open(filename_out, 'w') as file: - line, lindex = next_line(fin_lines, max_line) - while line is not None: - # Check for a module line - current_module = parse_module_line(line, current_module) - # Maintain a status of being in a DDT definition - if (not in_type) and type_re.match(line): - in_type = True - elif in_type and end_type_re.match(line): - in_type = False - # End if - # Check for end of preamble - if (not in_type) and (line.lstrip()[0:8].lower() == 'contains'): - in_preamble = False - # End if - - # Check for beginning of new table - words = line.split() - # This is case sensitive - if len(words) > 2 and words[0] in ['!!', '!>'] and '\section' in words[1] and 'arg_table_' in words[2]: - # We have a new table, parse the header - table_name = words[2].replace('arg_table_','') -##XXgoldyXX: Uncomment this after conversion is over -# logger.info('Found old metadata table, {}, on line {}'.format(table_name, lindex+1)) - # The header line is not modified - file.write(line+"\n") - # Create the table start section - mdtable = MetadataTable(table_name, current_module) - mdconfig.append(mdtable) - line, lindex = next_line(fin_lines, max_line, cindex=lindex) - words = line.split('|') - header_locs = {} - dim_names = [__not_found__]*15 - # Do not work on a blank table - if len(words) > 1: - # Write an include line for the metadata table - file.write('!! \htmlinclude {}.html\n'.format(table_name)) - # - table_header = [x.strip() for x in words[1:-1]] - for ind in xrange(len(table_header)): - header_locs[table_header[ind]] = ind - # End for - # Find the local_name index (exception if not found) - local_name_ind = header_locs['local_name'] - # Find the standard_name index (exception if not found) - standard_name_ind = header_locs['standard_name'] - # The table header line is not output - line, lindex = next_line(fin_lines, max_line, cindex=lindex) - # Parse the entries - while len(words) > 1: - line, lindex = next_line(fin_lines, max_line, cindex=lindex) - words = line.split('|') - if len(words) <= 1: - # End of table, just write and continue - file.write(line+'\n') - continue - # End if - entries = [x.strip() for x in words[1:-1]] - # Okay, one check - if len(entries) != len(header_locs): - raise ValueError("Malformed table entry") - # End if - # First output the local name - local_name = entries[local_name_ind] - # Then check the local name, skip variables without a standard_name - standard_name = entries[standard_name_ind] - if not standard_name: - if logger is None: - raise ValueError("{} does not have a standard name in {}".format(local_name, table_name)) - else: - logger.debug("{} does not have a standard name in {}".format(local_name, table_name)) - continue - else: - # Standard names cannot have dashes or periods - standard_name = standard_name.replace('-', '_').replace('.', '_') - # Create var_name: strip old-style DDT references from local_name and try to substitute array indices - var_name = local_name - if "(" in var_name: - if "%" in var_name and var_name.rfind("%") > var_name.rfind(")"): - if mdtable.type == 'ddt': - ddt_reference = var_name[:var_name.rfind('%')] - var_name = var_name[var_name.rfind('%')+1:] - else: - (actual_var_name, array_reference) = split_var_name_and_array_reference(var_name) - if mdtable.type == 'ddt': - ddt_reference = actual_var_name[:actual_var_name.rfind('%')] - actual_var_name = actual_var_name[actual_var_name.rfind('%')+1:] - for index in array_reference.lstrip("(").rstrip(")").split(","): - # Keep literals and colons, substitute variables - match = re.match(r"[0-9]+|:", index) - if match: - continue - else: - if index.lower() in standard_names.keys(): - array_reference = array_reference.replace(index, standard_names[index.lower()]) - else: - array_reference = array_reference.replace(index, index + "_XX_SubstituteWithStandardName_XX") - # End if - # End if - # End for - var_name = actual_var_name + array_reference - # End if - elif "%" in var_name: - if mdtable.type == 'ddt': - ddt_reference = var_name[:var_name.rfind('%')] - var_name = var_name[var_name.rfind('%')+1:] - else: - ddt_reference = '' - # End if - # - if mdtable.type == 'module': - ddt_reference = '' - if not current_module in ddt_references.keys(): - ddt_references[current_module] = {} - if not table_name in ddt_references[current_module].keys(): - ddt_references[current_module][table_name] = ddt_reference - elif not ddt_references[current_module][table_name] == ddt_reference: - raise Exception("Conflicting DDT references in table {}: {} vs {}".format( - table_name, ddt_references[current_module][table_name], ddt_reference)) - # - mdobj = MetadataEntry(var_name) - mdtable[var_name] = mdobj - # Now, create the rest of the entries - for ind in xrange(len(entries)): - attr_name = table_header[ind] - entry = entries[ind] - if attr_name == 'local_name': - # Already handled this - continue - elif attr_name == 'rank': - attr_name = 'dimensions' - rank = int(entry) - if rank>0: - # Search for key in dimensions dictionary - if local_name.lower() in dimensions.keys(): - dim_key = local_name.lower() - # Begin model and file-dependent substitutions - elif model == 'FV3': - if local_name.replace("GFS_Data(cdata%blk_no)%","").lower() in dimensions.keys(): - dim_key = local_name.replace("GFS_Data(cdata%blk_no)%","").lower() - elif local_name.replace("GFS_Data(cdata%blk_no)%Intdiag%","Diag%").lower() in dimensions.keys(): - dim_key = local_name.replace("GFS_Data(cdata%blk_no)%Intdiag%","Diag%").lower() - elif local_name.replace("GFS_Interstitial(cdata%thrd_no)%","Interstitial%").lower() in dimensions.keys(): - dim_key = local_name.replace("GFS_Interstitial(cdata%thrd_no)%","Interstitial%").lower() - elif local_name.replace("CCPP_Interstitial%","Interstitial%").lower() in dimensions.keys(): - dim_key = local_name.replace("CCPP_Interstitial%","Interstitial%").lower() - else: - dim_key = None - # End model and file-dependent substitution - else: - dim_key = None - - # Begin model and file-dependent substitutions - if model == 'FV3': - if dim_key and 'n_XX_SubstituteWithStandardName_XX' in dimensions[dim_key]: - if local_name in [ 'GFS_Data(cdata%blk_no)%Intdiag%sedim', - 'GFS_Data(cdata%blk_no)%Intdiag%drydep', - 'GFS_Data(cdata%blk_no)%Intdiag%wetdpl', - 'GFS_Data(cdata%blk_no)%Intdiag%wetdpc' ]: - entry = '(horizonal_dimension,number_of_chemical_tracers_for_diagnostics)' - elif local_name == 'GFS_Data(cdata%blk_no)%Intdiag%duem': - entry = '(horizonal_dimension,number_of_dust_bins_for_diagnostics)' - elif local_name == 'GFS_Data(cdata%blk_no)%Intdiag%ssem': - entry = '(horizonal_dimension,number_of_seasalt_bins_for_diagnostics)' - else: - raise Exception("No entry defined for variable {} with dimensions {}".format( - local_name, dimensions[dim_key])) - elif dim_key: - if not rank == len(dimensions[dim_key]): - raise Exception("ERROR, mismatch of variable rank and dimensions for variable {}".format(local_name)) - entry = '(' + ','.join(dimensions[dim_key]) + ')' - # Special handling for slices of arrays that do not have an entry in the dimensions dictionary - elif local_name.endswith('(:,1)') and ('at_lowest_model_layer' in standard_name or \ - 'at_lowest_model_interface' in standard_name): - entry = '(horizontal_dimension)' - elif 'GFS_Data(cdata%blk_no)%Tbd%phy_f2d(:,' in local_name and rank==1: - entry = '(horizontal_dimension)' - elif 'GFS_Data(cdata%blk_no)%Tbd%phy_f3d(:,:' in local_name and rank==2: - entry = '(horizontal_dimension,vertical_dimension)' - elif 'GFS_Data(cdata%blk_no)%Statein%qgrs(:,:,GFS_Control' in local_name or \ - 'GFS_Data(cdata%blk_no)%Stateout%gq0(:,:,GFS_Control' in local_name or \ - 'GFS_Interstitial(cdata%thrd_no)%save_q(:,:,GFS_Control' in local_name: - entry = '(horizontal_dimension,vertical_dimension)' - elif 'GFS_Data(cdata%blk_no)%Statein%qgrs(:,1,GFS_Control' in local_name or \ - 'GFS_Data(cdata%blk_no)%Stateout%gq0(:,1,GFS_Control' in local_name: - entry = '(horizontal_dimension)' - elif ("Intdiag%du3dt" in local_name or \ - "Intdiag%dv3dt" in local_name or \ - "Intdiag%dt3dt" in local_name or \ - "Intdiag%dq3dt" in local_name) and rank==2: - entry = '(horizontal_dimension,vertical_dimension)' - elif ("GFS_Interstitial(cdata%thrd_no)%clouds(:,:" in local_name or \ - "GFS_Interstitial(cdata%thrd_no)%clw(:,:" in local_name) and rank==2: - entry = '(horizontal_dimension,vertical_dimension)' - elif "GFS_Interstitial(cdata%thrd_no)%dqdt(:,:,GFS_Control" in local_name: - entry = '(horizontal_dimension,vertical_dimension)' - elif local_name == "GFS_Control%input_nml_file": - entry = '(number_of_lines_of_namelist_filename_for_internal_file_reads)' - elif local_name == 'GFS_Control%blksz': - entry = '(number_of_blocks)' - elif local_name in [ 'GFS_Control%idat', - 'GFS_Control%jdat', - ]: - entry = '(8)' - elif local_name == 'GFS_Control%idate': - entry = '(4)' - elif local_name in [ 'GFS_Control%psautco', - 'GFS_Control%prautco', - 'GFS_Control%wminco', - 'GFS_Control%mg_ts_auto_ice', - 'GFS_Control%mg_qcmin', - 'GFS_Control%flgmin', - 'GFS_Control%cgwf', - 'GFS_Control%ccwf', - 'GFS_Control%cdmbgwd', - 'GFS_Control%ctei_rm', - 'GFS_Control%dlqf', - 'GFS_Control%psauras', - 'GFS_Control%prauras', - 'GFS_Control%wminras', - ]: - entry = '(2)' - elif local_name in [ 'GFS_Control%cs_parm' ]: - entry = '(10)' - elif local_name in [ 'GFS_Control%crtrh' ]: - entry = '(3)' - elif local_name in [ 'GFS_Control%pertz0', - 'GFS_Control%pertzt', - 'GFS_Control%pertshc', - 'GFS_Control%pertlai', - 'GFS_Control%pertalb', - 'GFS_Control%pertvegf', - ]: - entry = '(5)' - elif 'GFS_Interstitial(cdata%thrd_no)%faerlw(:,:,:' in local_name and rank==3: - entry = '(horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_longwave_radiation)' - elif 'GFS_Interstitial(cdata%thrd_no)%faersw(:,:,:' in local_name and rank==3: - entry = '(horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_shortwave_radiation)' - elif 'GFS_Interstitial(cdata%thrd_no)%gasvmr(:,:' in local_name and rank==2: - entry = '(horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation)' - elif 'GFS_Interstitial(cdata%thrd_no)%sfcalb(:,' in local_name and rank==1: - entry = '(horizontal_dimension)' - elif local_name in [ - 'CCPP_interstitial%delp', - 'CCPP_interstitial%pt', - 'CCPP_interstitial%qv', - 'CCPP_interstitial%ql', - 'CCPP_interstitial%qi', - 'CCPP_interstitial%qr', - 'CCPP_interstitial%qs', - 'CCPP_interstitial%qg', - 'CCPP_interstitial%qc', - ]: - entry = '(starting_x_direction_index_domain:ending_x_direction_index_domain,starting_y_direction_index_domain:ending_y_direction_index_domain,1:vertical_dimension_for_fast_physics)' - elif local_name in [ - 'CCPP_interstitial%delz', - ]: - entry = '(starting_x_direction_index_domain:ending_x_direction_index_domain,starting_y_direction_index_domain:ending_y_direction_index_domain,1:vertical_dimension_for_thickness_at_Lagrangian_surface)' - elif local_name in [ - 'CCPP_interstitial%area', - 'CCPP_interstitial%phis', - ]: - entry = '(starting_x_direction_index_domain:ending_x_direction_index_domain,starting_y_direction_index_domain:ending_y_direction_index_domain)' - elif local_name in [ - 'CCPP_interstitial%peln', - ]: - entry = '(starting_x_direction_index:ending_x_direction_index,1:vertical_dimension_for_fast_physics_plus_one,starting_y_direction_index:ending_y_direction_index)' - elif local_name in [ - 'CCPP_interstitial%pkz', - ]: - entry = '(starting_x_direction_index:ending_x_direction_index,starting_y_direction_index:ending_y_direction_index,1:vertical_dimension_for_fast_physics)' - elif local_name in [ - 'CCPP_interstitial%qvi', - ]: - entry = '(starting_x_direction_index_domain:ending_x_direction_index_domain,starting_y_direction_index_domain:ending_y_direction_index_domain,1:vertical_dimension_for_fast_physics,1:number_of_gases_for_multi_gases_physics)' - elif local_name in [ - 'CCPP_interstitial%q_con', - ]: - entry = '(starting_x_direction_index_domain:ending_x_direction_index_domain,starting_y_direction_index_domain:ending_y_direction_index_domain,1:vertical_dimension_for_condensed_water_at_Lagrangian_surface)' - elif "CCPP_data" in filename_in and standard_name == 'GFS_data_type_instance_all_blocks': - entry = '(ccpp_block_number)' - elif "CCPP_data" in filename_in and standard_name == 'GFS_interstitial_type_instance_all_threads': - entry = '(ccpp_thread_number)' - else: - entry = '(' + ','.join(dim_names[0:rank]) + ')' - # End model and file-dependent substitutions - else: - if dim_key: - if not rank == len(dimensions[dim_key]): - raise Exception("ERROR, mismatch of variable rank and dimensions for variable {}".format(local_name)) - entry = '(' + ','.join(dimensions[dim_key]) + ')' - else: - entry = '(' + ','.join(dim_names[0:rank]) + ')' - # rank == 0 - else: - entry = '(' + ','.join(dim_names[0:rank]) + ')' - # End if - elif attr_name == 'standard_name': - # Parsing done earlier - entries[ind] = standard_name - entry = standard_name - elif attr_name == 'intent': - # Don't write intent attribute for variable/type definitions - if in_preamble: - entry = '' - elif entry.lower() == 'none': - if logger is None: - raise ValueError("{} has intent = none in {}".format(var_name, table_name)) - else: - logger.warning("{} has intent = none in {}".format(var_name, table_name)) - elif attr_name == 'optional': - # Don't write optional attribute for variable/type definitions - if in_preamble: - entry = '' - elif not entry in ['F', 'T']: - if logger is None: - raise ValueError("{} has optional = {} in {}".format(var_name, entry, table_name)) - else: - logger.warning("{} has optional = {} in {}".format(var_name, entry, table_name)) - # End if - # End if - # No else needed - # End if - # Add attribute - if (len(entry) > 0) or (attr_name in required_attrs): - mdobj[attr_name] = entry - # End if - # End for (done with entry) - # End while (done with table) - else: - # Just write the line (should be a table ending) - if line.strip() != '!!': - raise ValueError("All tables must end with !! line") - # End if - file.write(line+'\n') - # End if (blank table) - else: - # Not a table, just write and continue - file.write(line+'\n') - # End if - # Always load a new line - line, lindex = next_line(fin_lines, max_line, cindex=lindex) - # End while - # End with (file) - - # Write out finalized metadata file - with open(metadata_filename_out, 'w') as mdfile: - spacer = "" - # First pass: write type definitions, - # second pass: write module table - for count in xrange(2): - for table in mdconfig: - if (count == 0 and not table.type == 'ddt') or \ - (count == 1 and table.type == 'ddt'): - continue - if len(spacer) > 0: - mdfile.write(spacer) - # End if - table.write(mdfile) - spacer = '\n'+72*'#'+'\n' - # End for - # End for - # End with (mdfile) - - if ddt_references: - message = """Add the following statement to the CCPP prebuild config (add to existing entry): -TYPEDEFS_NEW_METADATA = { -""" - for module_name in ddt_references.keys(): - message += " '{module_name}' : {{\n".format(module_name=module_name) - for table_name in ddt_references[module_name].keys(): - message += " '{table_name}' : '{ddt_reference}',\n".format(table_name=table_name, - ddt_reference=ddt_references[module_name][table_name]) - message += " },\n" - message += " }\n" - if logger is not None: - logger.info(message) - else: - print message - -######################################################################## - -def usage(cmd): - print("Usage:") - print("{} ".format(cmd)) - print("") - print(" can be one of '{}'".format(MODELS)) - print("") - print("Translate the metadata in into a new file") - raise Exception - -######################################################################## - -if __name__ == "__main__": - # Process the files passed in - num_args = len(sys.argv) - if not num_args == 4: - usage(sys.argv[0]) - else: - ## Init this now so that all Exceptions can be trapped - logger = init_log('ccpp_capgen') - set_log_level(logger, logging.INFO) - ## To cause convert_metadata to stop when an error condition is found - ## (no metadata file), uncomment out the next line. - #logger = None - tbase = os.path.basename(sys.argv[2]) - tdir = os.path.dirname(sys.argv[2]) - if not sys.argv[3] in MODELS: - usage(sys.argv[0]) - mdfilename = "{}.meta".format('.'.join(tbase.split('.')[:-1])) - dest_mdfile = os.path.join(tdir, mdfilename) - convert_file(sys.argv[1], sys.argv[2], dest_mdfile, sys.argv[3], logger) - # End if -# End if diff --git a/scripts/convert_metadata_schemes_using_typedef_dims.py b/scripts/convert_metadata_schemes_using_typedef_dims.py deleted file mode 100755 index 2100c3df..00000000 --- a/scripts/convert_metadata_schemes_using_typedef_dims.py +++ /dev/null @@ -1,394 +0,0 @@ -#!/usr/bin/env python - -# Python library imports -import sys -import os.path -import re -from collections import OrderedDict -import logging -# CCPP framework imports -from parse_tools import FORTRAN_ID, init_log, set_log_level -from fortran_tools import parse_fortran_file -from metadata_table import MetadataHeader -from common import split_var_name_and_array_reference - -yes_re = re.compile(r"(?i)^\s*yes\s*$") -module_re = re.compile(r"(?i)\s*module\s+"+(FORTRAN_ID)+r"\s*.*$") -end_module_re = re.compile(r"(?i)\s*end\s*module\s+"+(FORTRAN_ID)+r"\s*.*$") -type_re = re.compile(r"(?i)\s*type\s+"+(FORTRAN_ID)+r"\s*.*$") -end_type_re = re.compile(r"(?i)\s*end\s*type\s+"+(FORTRAN_ID)+r"\s*.*$") -required_attrs = ['standard_name', 'units', 'dimensions', 'type'] -warning = True -__not_found__ = 'XX_NotFound_XX' - -# Configured models -#MODELS = ['FV3'] - -METADATA_TYPEDEFS = { - 'FV3' : [ - 'ccpp/physics/physics/machine.meta', - 'ccpp/physics/physics/radsw_param.meta', - 'ccpp/physics/physics/radlw_param.meta', - 'FV3/gfsphysics/CCPP_layer/CCPP_typedefs.meta', - 'FV3/gfsphysics/CCPP_layer/CCPP_data.meta', - 'FV3/gfsphysics/GFS_layer/GFS_typedefs.meta', - ], - } - -######################################################################## - -def parse_metadata_tables_typedefs(model): - # Lookup table local_name -> dimensions - dimensions = { - 'ccpp_error_flag' : [], - 'ccpp_error_message' : [], - 'ccpp_loop_counter' : [], - 'ccpp_block_number' : [], - 'ccpp_thread_number' : [], - 'ccpp_t' : [], - } - for filename in METADATA_TYPEDEFS[model]: - metadata_headers = MetadataHeader.parse_metadata_file(filename) - for metadata_header in metadata_headers: - for var in metadata_header.variable_list(): - standard_name = var.get_prop_value('standard_name') - if standard_name in dimensions.keys(): - raise ValueError("Duplicate standard name {} in type/variable definition metadata tables".format(standard_name)) - dimensions[standard_name] = var.get_prop_value('dimensions') - # - # Add missing variables (not used by FV3) - dimensions['lw_heating_rate_spectral'] = [ 'horizontal_dimension', 'adjusted_vertical_layer_dimension_for_radiation', 'number_of_aerosol_bands_for_longwave_radiation' ] - dimensions['lw_fluxes'] = ['horizontal_dimension', 'adjusted_vertical_level_dimension_for_radiation'] - dimensions['cloud_optical_depth'] = [ 'horizontal_dimension', 'adjusted_vertical_layer_dimension_for_radiation' ] - # - dimensions['sw_heating_rate_spectral'] = [ 'horizontal_dimension', 'adjusted_vertical_layer_dimension_for_radiation', 'number_of_aerosol_bands_for_shortwave_radiation' ] - dimensions['sw_fluxes'] = ['horizontal_dimension', 'adjusted_vertical_level_dimension_for_radiation'] - dimensions['cloud_single_scattering_albedo'] = [ 'horizontal_dimension', 'adjusted_vertical_layer_dimension_for_radiation' ] - dimensions['cloud_asymmetry_parameter'] = [ 'horizontal_dimension', 'adjusted_vertical_layer_dimension_for_radiation' ] - # - dimensions['specified_kinematic_surface_upward_sensible_heat_flux'] = [ 'horizontal_dimension' ] - dimensions['specified_kinematic_surface_upward_latent_heat_flux'] = [ 'horizontal_dimension' ] - dimensions['vonKarman_constant'] = [] - # - return dimensions - -######################################################################## - -def next_line(lines, max_line, cindex=-1): - nindex = cindex + 1 - if nindex > max_line: - return None, -1 - else: - return lines[nindex].rstrip('\n'), nindex - -######################################################################## - -def parse_module_line(line, mod_name): - match = module_re.match(line) - if match is not None: - mod_name = match.group(1) - else: - match = end_module_re.match(line) - if match is not None: - mod_name = None - # End if - # End if - return mod_name - -######################################################################## - -class MetadataEntry(OrderedDict): - - def __init__(self, local_name): - self._name = local_name - super(MetadataEntry, self).__init__() - - @property - def local_name(self): - return self._name - - def write(self, mdfile): - mdfile.write('[{}]\n'.format(self.local_name)) - for key in self.keys(): - mdfile.write(" {} = {}\n".format(key, self[key])) - # End for - -######################################################################## - -class MetadataTable(OrderedDict): - - def __init__(self, table_name, mod_name): - self._name = table_name - if (mod_name is not None) and (mod_name.lower() == table_name.lower()): - self._type = 'module' - elif table_name.split('_')[-1].lower() == 'type': - self._type = 'ddt' - else: - self._type = 'scheme' - # End if - super(MetadataTable, self).__init__() - - @property - def name(self): - return self._name - - @property - def type(self): - return self._type - - def has(self, varname): - hasvar = False - vartest = varname.lower() - for name in self.keys(): - if vartest == name.lower(): - hasvar = True - break - # End if - # End for - return hasvar - - def get(self, varname): - var = None - vartest = varname.lower() - for name in self.keys(): - if vartest == name.lower(): - var = self[name] - break - # End if - # End for - return var - - def write(self, mdfile): - mdfile.write('[ccpp-arg-table]\n') - mdfile.write(' name = {}\n'.format(self._name)) - mdfile.write(' type = {}\n'.format(self._type)) - for key in self.keys(): - self[key].write(mdfile) - -######################################################################## - -def convert_file(filename_in, filename_out, metadata_filename_out, typedef_dimensions, logger=None): - """Convert a file's old metadata to the new format - Note that only the bare minimum error checking is done. - """ - if logger: - logger.info("Converting file {} ...".format(filename_in)) - else: - print "Converting file {} ...".format(filename_in) - current_module = None - # First, suck in the old file - do_convert = True - if not os.path.exists(filename_in): - raise IOError("convert_file: file, '{}', does not exist".format(filename_in)) - # End if - if os.path.exists(filename_out): - raise IOError("convert_file: file, '{}', already exists".format(filename_out)) - # End if - - # Read all lines of the file at once - with open(filename_in, 'r') as file: - fin_lines = file.readlines() - for index in xrange(len(fin_lines)): - fin_lines[index] = fin_lines[index].rstrip('\n') - # End for - # End with - - max_line = len(fin_lines) - 1 - mdconfig = list() - in_preamble = True - in_type = False - with open(filename_out, 'w') as file: - line, lindex = next_line(fin_lines, max_line) - while line is not None: - # Check for a module line - current_module = parse_module_line(line, current_module) - # Maintain a status of being in a DDT definition - if (not in_type) and type_re.match(line): - in_type = True - elif in_type and end_type_re.match(line): - in_type = False - # End if - # Check for end of preamble - if (not in_type) and (line.lstrip()[0:8].lower() == 'contains'): - in_preamble = False - # End if - - # Check for beginning of new table - words = line.split() - # This is case sensitive - if len(words) > 2 and words[0] in ['!!', '!>'] and '\section' in words[1] and 'arg_table_' in words[2]: - # We have a new table, parse the header - table_name = words[2].replace('arg_table_','') -##XXgoldyXX: Uncomment this after conversion is over -# logger.info('Found old metadata table, {}, on line {}'.format(table_name, lindex+1)) - # The header line is not modified - file.write(line+"\n") - # Create the table start section - mdtable = MetadataTable(table_name, current_module) - mdconfig.append(mdtable) - line, lindex = next_line(fin_lines, max_line, cindex=lindex) - words = line.split('|') - header_locs = {} - dim_names = [__not_found__]*15 - # Do not work on a blank table - if len(words) > 1: - # Write an include line for the metadata table - file.write('!! \htmlinclude {}.html\n'.format(table_name)) - # - table_header = [x.strip() for x in words[1:-1]] - for ind in xrange(len(table_header)): - header_locs[table_header[ind]] = ind - # End for - # Find the local_name index (exception if not found) - local_name_ind = header_locs['local_name'] - # Find the standard_name index (exception if not found) - standard_name_ind = header_locs['standard_name'] - # The table header line is not output - line, lindex = next_line(fin_lines, max_line, cindex=lindex) - # Parse the entries - while len(words) > 1: - line, lindex = next_line(fin_lines, max_line, cindex=lindex) - words = line.split('|') - if len(words) <= 1: - # End of table, just write and continue - file.write(line+'\n') - continue - # End if - entries = [x.strip() for x in words[1:-1]] - # Okay, one check - if len(entries) != len(header_locs): - raise ValueError("Malformed table entry") - # End if - # First output the local name - local_name = entries[local_name_ind] - # Then check the local name, skip variables without a standard_name - standard_name = entries[standard_name_ind] - if not standard_name: - raise ValueError("{} does not have a standard name in {}".format(local_name, table_name)) - # Standard names cannot have dashes or periods - standard_name = standard_name.replace('-', '_').replace('.', '_') - # Create var_name: strip old-style DDT references from local_name and try to substitute array indices - var_name = local_name - # - mdobj = MetadataEntry(var_name) - mdtable[var_name] = mdobj - # Now, create the rest of the entries - for ind in xrange(len(entries)): - attr_name = table_header[ind] - entry = entries[ind] - if attr_name == 'local_name': - # Already handled this - continue - elif attr_name == 'rank': - attr_name = 'dimensions' - rank = int(entry) - # Search for standard_name key in typedef_dimensions dictionary - if not standard_name in typedef_dimensions.keys(): - raise ValueError("{} does not have an entry in the in typedef_dimensions dictionary".format(standard_name)) - if not rank == len(typedef_dimensions[standard_name]): - raise ValueError("Rank of {} in {} does not match with dimension information in typedef_dimensions".format( - standard_name, table_name)) - entry = '(' + ','.join(typedef_dimensions[standard_name]) + ')' - elif attr_name == 'standard_name': - # Parsing done earlier - entries[ind] = standard_name - entry = standard_name - elif attr_name == 'intent': - # Don't write intent attribute for variable/type definitions - if in_preamble: - entry = '' - elif entry.lower() == 'none': - if logger is None: - raise ValueError("{} has intent = none in {}".format(var_name, table_name)) - else: - logger.error("{} has intent = none in {}".format(var_name, table_name)) - elif attr_name == 'optional': - # Don't write optional attribute for variable/type definitions - if in_preamble: - entry = '' - elif not entry in ['F', 'T']: - if logger is None: - raise ValueError("{} has optional = {} in {}".format(var_name, entry, table_name)) - else: - logger.error("{} has optional = {} in {}".format(var_name, entry, table_name)) - # End if - # End if - # No else needed - # End if - # Add attribute - if (len(entry) > 0) or (attr_name in required_attrs): - mdobj[attr_name] = entry - # End if - # End for (done with entry) - # End while (done with table) - else: - # Just write the line (should be a table ending) - if line.strip() != '!!': - raise ValueError("All tables must end with !! line") - # End if - file.write(line+'\n') - # End if (blank table) - else: - # Not a table, just write and continue - file.write(line+'\n') - # End if - # Always load a new line - line, lindex = next_line(fin_lines, max_line, cindex=lindex) - # End while - # End with (file) - - # Write out finalized metadata file - with open(metadata_filename_out, 'w') as mdfile: - spacer = "" - # First pass: write type definitions, - # second pass: write module table - for count in xrange(2): - for table in mdconfig: - if (count == 0 and not table.type == 'ddt') or \ - (count == 1 and table.type == 'ddt'): - continue - if len(spacer) > 0: - mdfile.write(spacer) - # End if - table.write(mdfile) - spacer = '\n'+72*'#'+'\n' - # End for - # End for - # End with (mdfile) - -######################################################################## - -def usage(cmd): - print("Usage:") - print("{} ".format(cmd)) - print("") - print(" can be one of '{}'".format(METADATA_TYPEDEFS.keys())) - print("") - print("Translate the metadata in into a new file") - raise Exception - -######################################################################## - -if __name__ == "__main__": - # Process the files passed in - num_args = len(sys.argv) - if not num_args == 4: - usage(sys.argv[0]) - else: - ## Init this now so that all Exceptions can be trapped - logger = init_log('ccpp_capgen') - set_log_level(logger, logging.INFO) - ## To cause convert_metadata to stop when an error condition is found - ## (no metadata file), uncomment out the next line. - #logger = None - tbase = os.path.basename(sys.argv[2]) - tdir = os.path.dirname(sys.argv[2]) - if not sys.argv[3] in METADATA_TYPEDEFS.keys(): - usage(sys.argv[0]) - mdfilename = "{}.meta".format('.'.join(tbase.split('.')[:-1])) - dest_mdfile = os.path.join(tdir, mdfilename) - typedef_dimensions = parse_metadata_tables_typedefs(sys.argv[3]) - - convert_file(sys.argv[1], sys.argv[2], dest_mdfile, typedef_dimensions, logger) - # End if -# End if diff --git a/scripts/metadata_parser.py b/scripts/metadata_parser.py index eb64fa2b..4f8077e2 100755 --- a/scripts/metadata_parser.py +++ b/scripts/metadata_parser.py @@ -5,7 +5,7 @@ import subprocess from xml.etree import ElementTree as ET -from common import indent, encode_container +from common import encode_container from mkcap import Var import sys, os @@ -13,37 +13,8 @@ from parse_fortran import Ftype_type_decl from metadata_table import MetadataHeader -# The argument tables for schemes and variable definitions should have the following format: -# !! \section arg_table_SubroutineName (e.g. SubroutineName = SchemeName_run) OR \section arg_table_DerivedTypeName OR \section arg_table_ModuleName -# !! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -# !! |----------------|-------------------------------------------------------|------------------------------------------|---------|------|-----------|-----------|--------|----------| -# !! | im | horizontal_loop_extent | horizontal loop extent, start at 1 | index | 0 | integer | | in | F | -# !! | ix | horizontal_dimension | horizontal dimension | index | 0 | integer | | in | F | -# !! | ... | ... | | | | | | | | -# !! | errmsg | error_message | error message for error handling in CCPP | none | 0 | character | | out | F | -# !! | ierr | error_flag | error flag for error handling in CCPP | none | 0 | integer | | out | F | -# !! -# Notes on the input format: -# - if the argument table starts a new doxygen section, it should start with !> \section instead of !! \section -# - the "\section arg_table_{SubroutineName,DerivedTypeName,ModuleName}" command denotes the start of the table -# - SubroutineName must match the name of the subroutine that the argument table describes -# - DerivedTypeName must match the name of the derived type that the argument table describes -# - ModuleName must match the name of the module whose variables the argument table describes -# - the table must be placed immediately before the subroutine / derived data type, -# or immediately before the module variables (but within the module structure) -# - each line of the table must begin with the doxygen-delimiter '!!' -# - table headers are the first row, the second row must have the |---|-----| format -# - after the last row of the table, there must be a blank doxygen line (only '!!') to denote the end of the table -# - for variable type definitions and module variables, the intent and optional columns must be set to 'none' and 'F' -# - each argument table (and its subroutine) must accept the following two arguments for error handling: -# - character(len=512), intent(out) :: errmsg -# - errmsg must be initialized as '' and contains the error message in case an error occurs -# - integer, intent(out) :: ierr -# - ierr must be initialized as 0 and set to >1 in case of errors -# Output: This routine converts the argument tables for all subroutines / typedefs / module variables into an XML file -# suitable to be used with mkcap.py (which generates the fortran code for the scheme cap) -# - the script generates a separate file for each module within the given files - +# Output: This routine converts the argument tables for all subroutines / typedefs / kind / module variables +# into dictionaries suitable to be used with ccpp_prebuild.py (which generates the fortran code for the caps) # Items in this dictionary are used for checking valid entries in metadata tables. For columsn with no keys/keys # commented out, no check is performed. This is the case for 'type' and 'kind' right now, since models use their @@ -186,11 +157,14 @@ def parse_variable_tables(filename): # Read all lines of the file at once with (open(filename, 'r')) as file: - file_lines = file.readlines() + try: + file_lines = file.readlines() + except UnicodeDecodeError: + raise Exception("Decoding error while trying to read file {}, check that the file only contains ASCII characters".format(filename)) lines = [] buffer = '' - for i in xrange(len(file_lines)): + for i in range(len(file_lines)): line = file_lines[i].rstrip('\n').strip() # Skip empty lines if line == '' or line == '&': @@ -348,7 +322,7 @@ def parse_variable_tables(filename): metadata[var_name].append(var) else: - raise Exception("Invalid definition of new metadata format in file {0}".format(filename)) + raise Exception("Invalid definition of new metadata format in file {}, \htmlinclude must be preceeded by '!! ' : {}".format(filename, line)) line_counter += 1 continue # Check for blank table @@ -493,12 +467,15 @@ def parse_scheme_tables(filename): # Read all lines of the file at once with (open(filename, 'r')) as file: - file_lines = file.readlines() + try: + file_lines = file.readlines() + except UnicodeDecodeError: + raise Exception("Decoding error while trying to read file {}, check that the file only contains ASCII characters".format(filename)) lines = [] original_line_numbers = [] buffer = '' - for i in xrange(len(file_lines)): + for i in range(len(file_lines)): line = file_lines[i].rstrip('\n').strip() # Skip empty lines if line == '' or line == '&': @@ -651,6 +628,8 @@ def parse_scheme_tables(filename): ' existing: {0}\n'.format(existing_var.print_debug()) +\ ' vs. new: {0}'.format(var.print_debug())) metadata[var_name].append(var) + else: + raise Exception("Invalid definition of new metadata format in file {}, \htmlinclude must be preceeded by '!! ' : {}".format(filename, lines[header_line_number])) # Next line must denote the end of table, # i.e. look for a line containing only '!!' line_number = header_line_number+1 diff --git a/scripts/metadata_table.py b/scripts/metadata_table.py index 71273ce1..d99ade3b 100755 --- a/scripts/metadata_table.py +++ b/scripts/metadata_table.py @@ -517,7 +517,7 @@ def parse_metadata_file(cls, filename): mheaders = list() with open(filename, 'r') as file: fin_lines = file.readlines() - for index in xrange(len(fin_lines)): + for index in range(len(fin_lines)): fin_lines[index] = fin_lines[index].rstrip('\n') # End for # End with diff --git a/scripts/mkcap.py b/scripts/mkcap.py index 70a13420..6eb38ccb 100755 --- a/scripts/mkcap.py +++ b/scripts/mkcap.py @@ -185,7 +185,7 @@ def convert_to(self, units): function_name = '{0}__to__{1}'.format(string_to_python_identifier(self.units), string_to_python_identifier(units)) try: function = getattr(unit_conversion, function_name) - logging.info('Automatic unit conversion from {0} to {1} for {2} before entering {3}'.format(self.units, units, self.standard_name, self.container)) + logging.info('Automatic unit conversion from {0} to {1} for {2} after returning from {3}'.format(self.units, units, self.standard_name, self.container)) except AttributeError: raise Exception('Error, automatic unit conversion from {0} to {1} for {2} in {3} not implemented'.format(self.units, units, self.standard_name, self.container)) conversion = function() @@ -196,7 +196,7 @@ def convert_from(self, units): function_name = '{1}__to__{0}'.format(string_to_python_identifier(self.units), string_to_python_identifier(units)) try: function = getattr(unit_conversion, function_name) - logging.info('Automatic unit conversion from {0} to {1} for {2} after returning from {3}'.format(self.units, units, self.standard_name, self.container)) + logging.info('Automatic unit conversion from {0} to {1} for {2} before entering {3}'.format(self.units, units, self.standard_name, self.container)) except AttributeError: raise Exception('Error, automatic unit conversion from {1} to {0} for {2} in {3} not implemented'.format(self.units, units, self.standard_name, self.container)) conversion = function() @@ -211,22 +211,6 @@ def print_module_use(self): str = 'use {module}, only: {varname}'.format(module=module,varname=self.local_name) return str - def print_def_pointer(self): - '''Print the definition line for the variable, using pointers''' - if self.type in STANDARD_VARIABLE_TYPES: - if self.kind: - str = "{s.type}({s._kind}), pointer :: {s.local_name}{s.rank}" - else: - str = "{s.type}, pointer :: {s.local_name}{s.rank}" - else: - if self.kind: - error_message = "Generating variable definition statements for derived types with" + \ - " kind attributes not implemented; variable: {0}".format(self.standard_name) - raise Exception(error_message) - else: - str = "type({s.type}), pointer :: {s.local_name}{s.rank}" - return str.format(s=self) - def print_def_intent(self): '''Print the definition line for the variable, using intent.''' if self.type in STANDARD_VARIABLE_TYPES: @@ -268,116 +252,6 @@ def print_def_local(self): str = "type({s.type}) :: {s.local_name}" return str.format(s=self) - def print_get(self, index=0): - '''Print the data retrieval line for the variable. Depends on the type and of variable. - If index (= location of variable in cdata structure) is supplied, pass to Fortran call.''' - if index==0: - index_string = '' - else: - index_string = ', index={index}'.format(index=index) - if self.type in STANDARD_VARIABLE_TYPES and self.rank == '': - str=''' - call ccpp_field_get(cdata, '{s.standard_name}', {s.local_name}, ierr=ierr, kind=ckind{index_string}) -#ifdef DEBUG - if (ierr /= 0) then - call ccpp_error('Unable to retrieve {s.standard_name} from CCPP data structure') - return - end if - if (kind({s.local_name}).ne.ckind) then - call ccpp_error('Kind mismatch for variable {s.standard_name}') - ierr = 1 - return - end if -#endif - ''' - elif self.type in STANDARD_VARIABLE_TYPES: - str=''' - call ccpp_field_get(cdata, '{s.standard_name}', {s.local_name}, ierr=ierr, dims=cdims, kind=ckind{index_string}) -#ifdef DEBUG - if (ierr /= 0) then - call ccpp_error('Unable to retrieve {s.standard_name} from CCPP data structure') - return - end if - if (kind({s.local_name}).ne.ckind) then - call ccpp_error('Kind mismatch for variable {s.standard_name}') - ierr = 1 - return - end if -#endif - deallocate(cdims) - ''' - # Derived-type variables, scalar - elif self.rank == '': - str=''' - call ccpp_field_get(cdata, '{s.standard_name}', cptr, ierr=ierr, kind=ckind{index_string}) -#ifdef DEBUG - if (ierr /= 0) then - call ccpp_error('Unable to retrieve {s.standard_name} from CCPP data structure') - return - end if - if (ckind.ne.CCPP_GENERIC_KIND) then - call ccpp_error('Kind mismatch for variable {s.standard_name}') - ierr = 1 - return - end if -#endif - call c_f_pointer(cptr, {s.local_name})''' - # Derived-type variables, array - else: - str=''' - call ccpp_field_get(cdata, '{s.standard_name}', cptr, ierr=ierr, dims=cdims, kind=ckind{index_string}) -#ifdef DEBUG - if (ierr /= 0) then - call ccpp_error('Unable to retrieve {s.standard_name} from CCPP data structure') - return - end if - if (ckind.ne.CCPP_GENERIC_KIND) then - call ccpp_error('Kind mismatch for variable {s.standard_name}') - ierr = 1 - return - end if -#endif - call c_f_pointer(cptr, {s.local_name}, cdims) - deallocate(cdims) - ''' - return str.format(s=self, index_string=index_string) - - def print_add(self, ccpp_data_structure, index=0): - '''Print the data addition line for the variable. Depends on the type of variable. - Since the name of the ccpp data structure is not known, this needs to be filled later. - In case of errors a message is printed to screen; using 'return' statements as above - for ccpp_field_get is not possible, since the ccpp_field_add statements may be placed - inside OpenMP parallel regions. - If index (= location of variable in cdata structure) is supplied, pass to Fortran call.''' - # Index string to test that index generated by CCPP prebuild matches - # the actual index in the cdata lookup table - if index==0: - index_string = '' - else: - index_string = ', index={index}'.format(index=index) - # Standard-type variables, scalar and array - if self.type in STANDARD_VARIABLE_TYPES: - str=''' - call ccpp_field_add({ccpp_data_structure}, '{s.standard_name}', {s.target}, ierr=ierr, units='{s.units}'{index_string}) - if (ierr /= 0) then - call ccpp_error('Unable to add field "{s.standard_name}" to CCPP data structure') - end if''' - # Derived-type variables, scalar - elif self.rank == '': - str=''' - call ccpp_field_add({ccpp_data_structure}, '{s.standard_name}', '', c_loc({s.target}), ierr=ierr{index_string}) - if (ierr /= 0) then - call ccpp_error('Unable to add field "{s.standard_name}" to CCPP data structure') - end if''' - # Derived-type variables, array - else: - str=''' - call ccpp_field_add({ccpp_data_structure}, '{s.standard_name}', '', c_loc({s.target}), rank=size(shape({s.target})), dims=shape({s.target}), ierr=ierr{index_string}) - if (ierr /= 0) then - call ccpp_error('Unable to add field "{s.standard_name}" to CCPP data structure') - end if''' - return str.format(ccpp_data_structure=ccpp_data_structure, s=self, index_string=index_string) - def print_debug(self): '''Print the data retrieval line for the variable.''' str='''Contents of {s} (* = mandatory for compatibility): @@ -409,225 +283,6 @@ def from_table(cls, columns, data): var.optional = data[columns.index('optional')] return var - def to_xml(self, element): - element.set('name', self._standard_name) - sub_element = ET.SubElement(element, 'standard_name') - sub_element.text = self._standard_name - sub_element = ET.SubElement(element, 'long_name') - sub_element.text = self._long_name - sub_element = ET.SubElement(element, 'units') - sub_element.text = self._units - sub_element = ET.SubElement(element, 'local_name') - sub_element.text = self._local_name - sub_element = ET.SubElement(element, 'type') - sub_element.text = self._type - sub_element = ET.SubElement(element, 'rank') - sub_element.text = self._rank - sub_element = ET.SubElement(element, 'intent') - sub_element.text = self._intent - sub_element = ET.SubElement(element, 'optional') - sub_element.text = self._optional - sub_element = ET.SubElement(element, 'container') - sub_element.text = self._container - return element - -############################################################################### -class Cap(object): - - header=''' -! -! This work (Common Community Physics Package), identified by NOAA, NCAR, -! CU/CIRES, is free of known copyright restrictions and is placed in the -! public domain. -! -! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL -! THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER -! IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN -! CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -! - -!> -!! @brief Auto-generated cap module for the {module} scheme -!! -! -module {module}_cap - - use, intrinsic :: iso_c_binding, & - only: c_f_pointer, c_ptr, c_int32_t - use :: ccpp_types, & - only: ccpp_t, CCPP_GENERIC_KIND - use :: ccpp_fields, & - only: ccpp_field_get - use :: ccpp_errors, & - only: ccpp_error, ccpp_debug - use :: {module}, & - only: {subroutines} - ! Other modules required, e.g. type definitions - {module_use} - - implicit none - - private - public :: {subroutine_caps} - - contains - -''' - - sub=''' - function {subroutine}_cap(ptr) bind(c) result(ierr) - - integer(c_int32_t) :: ierr - type(c_ptr), intent(inout) :: ptr - - type(ccpp_t), pointer :: cdata - type(c_ptr) :: cptr - integer, allocatable :: cdims(:) - integer :: ckind -{var_defs} - - ierr = 0 - - call c_f_pointer(ptr, cdata) - -{var_gets} - -{actions_before} - - call {subroutine}({args}) - {ierr_assign} - -{actions_after} - - end function {subroutine}_cap -''' - - def __init__(self, **kwargs): - self._filename = 'sys.stdout' - for key, value in kwargs.items(): - setattr(self, "_"+key, value) - - def write(self, module, data, ccpp_field_map, metadata_define): - if (self.filename is not sys.stdout): - filepath = os.path.split(self.filename)[0] - if filepath and not os.path.isdir(filepath): - os.makedirs(filepath) - f = open(self.filename, 'w') - else: - f = sys.stdout - - subs = ','.join(["{0}".format(s) for s in data.keys()]) - sub_caps = ','.join(["{0}_cap".format(s) for s in data.keys()]) - - # Import variable type definitions for all subroutines (init, run, finalize) - module_use = [] - local_kind_and_type_vars = [] - for sub in data.keys(): - for var in data[sub]: - if var.type in STANDARD_VARIABLE_TYPES and var.kind and not var.type == STANDARD_CHARACTER_TYPE: - kind_var_standard_name = var.kind - if not kind_var_standard_name in local_kind_and_type_vars: - if not kind_var_standard_name in metadata_define.keys(): - raise Exception("Kind {kind} not defined by host model".format(kind=kind_var_standard_name)) - kind_var = metadata_define[kind_var_standard_name][0] - module_use.append(kind_var.print_module_use()) - local_kind_and_type_vars.append(kind_var_standard_name) - elif not var.type in STANDARD_VARIABLE_TYPES: - type_var_standard_name = var.type - if not type_var_standard_name in local_kind_and_type_vars: - if not type_var_standard_name in metadata_define.keys(): - raise Exception("Type {type} not defined by host model".format(type=type_var_standard_name)) - type_var = metadata_define[type_var_standard_name][0] - module_use.append(type_var.print_module_use()) - local_kind_and_type_vars.append(type_var_standard_name) - del local_kind_and_type_vars - - f.write(Cap.header.format(module = module, - module_use = '\n '.join(module_use), - subroutines = subs, - subroutine_caps = sub_caps)) - - for sub in data.keys(): - # Treat CCPP internal variables differently: do not retrieve - # via ccpp_field_get, use them directly via cdata%... - # (configured in common.py, needs to match what is is ccpp_types.F90) - var_defs = "\n".join([" "*8 + x.print_def_pointer() for x in data[sub] if x.standard_name not in CCPP_INTERNAL_VARIABLES.keys()]) - # Use lookup index in cdata from build time for faster retrieval - var_gets = "\n".join([x.print_get(ccpp_field_map[x.standard_name]) for x in data[sub]if x.standard_name not in CCPP_INTERNAL_VARIABLES.keys()]) - # Generate unit conversion statements on input and output. Special handling for - # unit conversions for intent(in) variables, these don't require defining a - # temporary variable, instead just pass the conversion function as argument - actions_before = '' - actions_after = '' - tmpvar_cnt = 0 - tmpvars = {} - for x in data[sub]: - if x.actions['out']: - tmpvar_cnt += 1 - tmpvar = copy.deepcopy(x) - tmpvar.local_name = 'tmpvar{0}'.format(tmpvar_cnt) - var_defs += '\n' + " "*8 + tmpvar.print_def_local() - if x.rank: - actions_before += ' allocate({t}, source={x})\n'.format(t=tmpvar.local_name, x=x.local_name) - if x.actions['in']: - actions_before += ' {t} = {c}\n'.format(t=tmpvar.local_name, - c=x.actions['in'].format(var=x.local_name, - kind='_' + x.kind if x.kind else '')) - actions_after += ' {x} = {c}\n'.format(x=x.local_name, - c=x.actions['out'].format(var=tmpvar.local_name, - kind='_' + x.kind if x.kind else '')) - if x.rank: - actions_after += ' deallocate({t})\n'.format(t=tmpvar.local_name) - tmpvars[x.local_name] = tmpvar.local_name - # Split args so that lines don't exceed 260 characters (for PGI) - args = '' - length = 0 - for x in data[sub]: - if x.standard_name in CCPP_INTERNAL_VARIABLES.keys(): - arg = "{0}={1},".format(x.local_name, CCPP_INTERNAL_VARIABLES[x.standard_name]) - elif x.local_name in tmpvars.keys(): - arg = "{0}={1},".format(x.local_name, tmpvars[x.local_name]) - elif x.actions['in'] and not x.actions['out']: - action = x.actions['in'].format(var=x.local_name, kind='_' + x.kind if x.kind else '') - arg = '{0}={1},'.format(x.local_name, action) - else: - arg = "{0}={0},".format(x.local_name) - args += arg - length += len(arg) - if length > 70 and not x == data[sub][-1]: - args += ' &\n ' - length = 0 - args = args.rstrip(',') - # If CCPP_ERROR_FLAG_VARIABLE is present, assign to ierr - ierr_assign = '' - for x in data[sub]: - if x.standard_name == CCPP_ERROR_FLAG_VARIABLE: - ierr_assign = 'ierr={0}'.format(CCPP_INTERNAL_VARIABLES[CCPP_ERROR_FLAG_VARIABLE]) - break - # Write to scheme cap - f.write(Cap.sub.format(subroutine=sub, - var_defs=var_defs, - var_gets=var_gets, - actions_before=actions_before.rstrip('\n'), - args=args, - ierr_assign=ierr_assign, - actions_after=actions_after.rstrip('\n'))) - f.write("end module {module}_cap\n".format(module = module)) - - if (f is not sys.stdout): - f.close() - - @property - def filename(self): - '''Get the filename of write the output to.''' - return self._filename - - @filename.setter - def filename(self, value): - self._filename = value - class CapsMakefile(object): header=''' @@ -684,15 +339,15 @@ def __init__(self, **kwargs): for key, value in kwargs.items(): setattr(self, "_"+key, value) - def write(self, schemes): + def write(self, caps): if (self.filename is not sys.stdout): f = open(self.filename, 'w') else: f = sys.stdout contents = self.header - for scheme in schemes: - contents += ' {0}\n'.format(scheme) + for cap in caps: + contents += ' {0}\n'.format(cap) contents += self.footer f.write(contents) @@ -711,7 +366,7 @@ def filename(self, value): class CapsSourcefile(object): header=''' -# All CCPP schemes are defined here. +# All CCPP caps are defined here. # # This file is auto-generated using ccpp_prebuild.py # at compile time, do not edit manually. @@ -725,18 +380,18 @@ def __init__(self, **kwargs): for key, value in kwargs.items(): setattr(self, "_"+key, value) - def write(self, schemes): + def write(self, caps): if (self.filename is not sys.stdout): filepath = os.path.split(self.filename)[0] - if not os.path.isdir(filepath): + if filepath and not os.path.isdir(filepath): os.makedirs(filepath) f = open(self.filename, 'w') else: f = sys.stdout contents = self.header - for scheme in schemes: - contents += '{0};'.format(scheme) + for cap in caps: + contents += '{0};'.format(cap) contents = contents.rstrip(';') contents += self.footer f.write(contents) @@ -836,7 +491,7 @@ def __init__(self, **kwargs): def write(self, schemes): if (self.filename is not sys.stdout): filepath = os.path.split(self.filename)[0] - if not os.path.isdir(filepath): + if filepath and not os.path.isdir(filepath): os.makedirs(filepath) f = open(self.filename, 'w') else: @@ -880,7 +535,7 @@ def __init__(self, **kwargs): def write(self, schemes): if (self.filename is not sys.stdout): filepath = os.path.split(self.filename)[0] - if not os.path.isdir(filepath): + if filepath and not os.path.isdir(filepath): os.makedirs(filepath) f = open(self.filename, 'w') else: @@ -905,6 +560,131 @@ def filename(self): def filename(self, value): self._filename = value +class TypedefsMakefile(object): + + header=''' +# All CCPP types are defined here. +# +# This file is auto-generated using ccpp_prebuild.py +# at compile time, do not edit manually. +# +TYPEDEFS =''' + + def __init__(self, **kwargs): + self._filename = 'sys.stdout' + for key, value in kwargs.items(): + setattr(self, "_"+key, value) + + def write(self, typedefs): + if (self.filename is not sys.stdout): + f = open(self.filename, 'w') + else: + f = sys.stdout + + contents = self.header + for typedef in typedefs: + contents += ' \\\n\t {0}'.format(typedef) + f.write(contents) + + if (f is not sys.stdout): + f.close() + + @property + def filename(self): + '''Get the filename of write the output to.''' + return self._filename + + @filename.setter + def filename(self, value): + self._filename = value + +class TypedefsCMakefile(object): + + header=''' +# All CCPP types are defined here. +# +# This file is auto-generated using ccpp_prebuild.py +# at compile time, do not edit manually. +# +set(TYPEDEFS +''' + footer=''') +''' + + def __init__(self, **kwargs): + self._filename = 'sys.stdout' + for key, value in kwargs.items(): + setattr(self, "_"+key, value) + + def write(self, typedefs): + if (self.filename is not sys.stdout): + f = open(self.filename, 'w') + else: + f = sys.stdout + + contents = self.header + for typedef in typedefs: + contents += ' {0}\n'.format(typedef) + contents += self.footer + f.write(contents) + + if (f is not sys.stdout): + f.close() + + @property + def filename(self): + '''Get the filename of write the output to.''' + return self._filename + + @filename.setter + def filename(self, value): + self._filename = value + +class TypedefsSourcefile(object): + + header=''' +# All CCPP types are defined here. +# +# This file is auto-generated using ccpp_prebuild.py +# at compile time, do not edit manually. +# +export CCPP_TYPEDEFS="''' + footer='''" +''' + + def __init__(self, **kwargs): + self._filename = 'sys.stdout' + for key, value in kwargs.items(): + setattr(self, "_"+key, value) + + def write(self, typedefs): + if (self.filename is not sys.stdout): + filepath = os.path.split(self.filename)[0] + if filepath and not os.path.isdir(filepath): + os.makedirs(filepath) + f = open(self.filename, 'w') + else: + f = sys.stdout + + contents = self.header + for typedef in typedefs: + contents += '{0};'.format(typedef) + contents = contents.rstrip(';') + contents += self.footer + f.write(contents) + + if (f is not sys.stdout): + f.close() + + @property + def filename(self): + '''Get the filename of write the output to.''' + return self._filename + + @filename.setter + def filename(self, value): + self._filename = value + ############################################################################### if __name__ == "__main__": main() diff --git a/scripts/mkdoc.py b/scripts/mkdoc.py index cbe15d01..45a7daf7 100755 --- a/scripts/mkdoc.py +++ b/scripts/mkdoc.py @@ -83,7 +83,7 @@ def metadata_to_latex(metadata_define, metadata_request, pset_request, model, fi shading = { 0 : 'darkgray', 1 : 'lightgray' } success = True - var_names = sorted(list(set(metadata_define.keys() + metadata_request.keys()))) + var_names = sorted(list(set(list(metadata_define.keys()) + list(metadata_request.keys())))) latex = '''\\documentclass[12pt,letterpaper,oneside,landscape]{{scrbook}} @@ -126,7 +126,7 @@ def metadata_to_latex(metadata_define, metadata_request, pset_request, model, fi if var_name in metadata_request.keys(): requested_list = [ escape_tex(decode_container(v.container)) for v in metadata_request[var_name] ] # for the purpose of the table, just output the name of the subroutine - for i in xrange(len(requested_list)): + for i in range(len(requested_list)): entry = requested_list[i] requested_list[i] = entry[entry.find('SUBROUTINE')+len('SUBROUTINE')+1:] requested = '\\newline '.join(sorted(requested_list)) diff --git a/scripts/mkstatic.py b/scripts/mkstatic.py index 7adeafa6..ed6fd6fd 100755 --- a/scripts/mkstatic.py +++ b/scripts/mkstatic.py @@ -4,6 +4,7 @@ import collections import copy import getopt +import filecmp import logging import os import sys @@ -37,7 +38,7 @@ def extract_parents_and_indices_from_local_name(local_name): # First, extract all variables/indices in parentheses (used for subsetting) indices = [] while '(' in local_name: - for i in xrange(len(local_name)): + for i in range(len(local_name)): if local_name[i] == '(': last_open = i elif local_name[i] == ')': @@ -203,6 +204,7 @@ def __init__(self, **kwargs): self._subroutines = None self._suites = [] self._directory = '.' + self._update_api = True for key, value in kwargs.items(): setattr(self, "_"+key, value) @@ -224,6 +226,15 @@ def directory(self): def directory(self, value): self._directory = value + @property + def update_api(self): + '''Get the update_api flag.''' + return self._update_api + + @update_api.setter + def update_api(self, value): + self._update_api = value + @property def module(self): '''Get the module name of the API.''' @@ -342,7 +353,21 @@ def write(self): filepath = os.path.split(self.filename)[0] if filepath and not os.path.isdir(filepath): os.makedirs(filepath) - f = open(self.filename, 'w') + # If the file exists, write to temporary file first and compare them: + # - if identical, delete the temporary file and keep the existing one + # and set the API update flag to false + # - if different, replace existing file with temporary file and set + # the API update flag to true (default value) + # - always replace the file if any of the suite caps has changed + # If the file does not exist, write the API an set the flag to true + if os.path.isfile(self.filename) and \ + not any([suite.update_cap for suite in suites]): + write_to_test_file = True + test_filename = self.filename + '.test' + f = open(test_filename, 'w') + else: + write_to_test_file = False + f = open(self.filename, 'w') else: f = sys.stdout f.write(API.header.format(module=self._module, @@ -352,6 +377,21 @@ def write(self): f.write(Suite.footer.format(module=self._module)) if (f is not sys.stdout): f.close() + # See comment above on updating the API or not + if write_to_test_file: + if filecmp.cmp(self.filename, test_filename): + # Files are equal, delete the test API and set update flag to False + os.remove(test_filename) + self.update_api = False + else: + # Files are different, replace existing API with + # the test API and set update flag to True + # Python 3 only: os.replace(test_filename, self.filename) + os.remove(self.filename) + os.rename(test_filename, self.filename) + self.update_api = True + else: + self.update_api = True return def write_sourcefile(self, source_filename): @@ -359,7 +399,18 @@ def write_sourcefile(self, source_filename): filepath = os.path.split(source_filename)[0] if filepath and not os.path.isdir(filepath): os.makedirs(filepath) - f = open(source_filename, 'w') + # If the file exists, write to temporary file first and compare them: + # - if identical, delete the temporary file and keep the existing one + # - if different, replace existing file with temporary file + # - however, always replace the file if the API update flag is true + if os.path.isfile(source_filename) and not self.update_api: + write_to_test_file = True + test_filename = source_filename + '.test' + f = open(test_filename, 'w') + else: + write_to_test_file = False + f = open(source_filename, 'w') + # Contents of shell/source file contents = """# The CCPP static API is defined here. # # This file is auto-generated using ccpp_prebuild.py @@ -369,8 +420,19 @@ def write_sourcefile(self, source_filename): """.format(filename=os.path.abspath(os.path.join(self.directory,self.filename))) f.write(contents) f.close() + # See comment above on updating the API or not + if write_to_test_file: + if filecmp.cmp(source_filename, test_filename): + # Files are equal, delete the test file + os.remove(test_filename) + else: + # Files are different, replace existing file + # Python 3 only: os.replace(test_filename, source_filename) + os.remove(source_filename) + os.rename(test_filename, source_filename) return success + class Suite(object): header=''' @@ -426,6 +488,7 @@ class Suite(object): def __init__(self, **kwargs): self._name = None + self._filename = sys.stdout self._sdf_name = None self._all_schemes_called = None self._all_subroutines_called = None @@ -434,6 +497,7 @@ def __init__(self, **kwargs): self._subroutines = None self._parents = { ccpp_stage : {} for ccpp_stage in CCPP_STAGES } self._arguments = { ccpp_stage : [] for ccpp_stage in CCPP_STAGES } + self._update_cap = True for key, value in kwargs.items(): setattr(self, "_"+key, value) @@ -451,6 +515,24 @@ def sdf_name(self): def sdf_name(self, value): self._sdf_name = value + @property + def filename(self): + '''Get the filename of write the output to.''' + return self._filename + + @filename.setter + def filename(self, value): + self._filename = value + + @property + def update_cap(self): + '''Get the update_cap flag.''' + return self._update_cap + + @update_cap.setter + def update_cap(self, value): + self._update_cap = value + def parse(self): '''Parse the suite definition file.''' success = True @@ -512,10 +594,10 @@ def parse(self): def print_debug(self): '''Basic debugging output about the suite.''' - print "ALL SUBROUTINES:" - print self._all_subroutines_called - print "STRUCTURED:" - print self._groups + print("ALL SUBROUTINES:") + print(self._all_subroutines_called) + print("STRUCTURED:") + print(self._groups) for group in self._groups: group.print_debug() @@ -572,7 +654,7 @@ def write(self, metadata_request, metadata_define, arguments): (calling the group caps one after another)""" # Set name of module and filename of cap self._module = 'ccpp_{suite_name}_cap'.format(suite_name=self._name) - self._filename = '{module_name}.F90'.format(module_name=self._module) + self.filename = '{module_name}.F90'.format(module_name=self._module) # Init self._subroutines = [] # Write group caps and generate module use statements; combine the argument lists @@ -627,8 +709,26 @@ def write(self, metadata_request, metadata_define, arguments): body=body) # Write cap to stdout or file - if (self._filename is not sys.stdout): - f = open(self._filename, 'w') + if (self.filename is not sys.stdout): + filepath = os.path.split(self.filename)[0] + if filepath and not os.path.isdir(filepath): + os.makedirs(filepath) + # If the file exists, write to temporary file first and compare them: + # - if identical, delete the temporary file and keep the existing one + # and set the suite cap update flag to false + # - if different, replace existing file with temporary file and set + # the suite cap update flag to true (default value) + # - however, if any of the group caps has changed, rewrite the suite + # cap as well and set the suite cap update flag to true + # If the file does not exist, write the cap an set the flag to true + if os.path.isfile(self.filename) and \ + not any([group.update_cap for group in self._groups]): + write_to_test_file = True + test_filename = self.filename + '.test' + f = open(test_filename, 'w') + else: + write_to_test_file = False + f = open(self.filename, 'w') else: f = sys.stdout f.write(Suite.header.format(module=self._module, @@ -638,9 +738,25 @@ def write(self, metadata_request, metadata_define, arguments): f.write(Suite.footer.format(module=self._module)) if (f is not sys.stdout): f.close() + # See comment above on updating the suite cap or not + if write_to_test_file: + if filecmp.cmp(self.filename, test_filename): + # Files are equal, delete the test cap + # and set update flag to False + os.remove(test_filename) + self.update_cap = False + else: + # Files are different, replace existing cap + # with test cap and set flag to True + # Python 3 only: os.replace(test_filename, self.filename) + os.remove(self.filename) + os.rename(test_filename, self.filename) + self.update_cap = True + else: + self.update_cap = True # Create list of all caps generated (for groups and suite) - self._caps = [ self._filename ] + self._caps = [ self.filename ] for group in self._groups: self._caps.append(group.filename) @@ -735,7 +851,7 @@ class Group(object): def __init__(self, **kwargs): self._name = '' self._suite = None - self._filename = 'sys.stdout' + self._filename = sys.stdout self._init = False self._finalize = False self._module = None @@ -743,6 +859,7 @@ def __init__(self, **kwargs): self._pset = None self._parents = { ccpp_stage : {} for ccpp_stage in CCPP_STAGES } self._arguments = { ccpp_stage : [] for ccpp_stage in CCPP_STAGES } + self._update_cap = True for key, value in kwargs.items(): setattr(self, "_"+key, value) @@ -827,12 +944,12 @@ def write(self, metadata_request, metadata_define, arguments): for local_name_define in [parent_local_name_define] + parent_local_names_define_indices: parent_standard_name = None parent_var = None - for i in xrange(FORTRAN_ARRAY_MAX_DIMS+1): + for i in range(FORTRAN_ARRAY_MAX_DIMS+1): if i==0: dims_string = '' else: # (:) for i==1, (:,:) for i==2, ... - dims_string = '(' + ','.join([':' for j in xrange(i)]) + ')' + dims_string = '(' + ','.join([':' for j in range(i)]) + ')' if local_name_define+dims_string in standard_name_by_local_name_define.keys(): parent_standard_name = standard_name_by_local_name_define[local_name_define+dims_string] parent_var = metadata_define[parent_standard_name][0] @@ -989,7 +1106,22 @@ def write(self, metadata_request, metadata_define, arguments): # Write output to stdout or file if (self.filename is not sys.stdout): - f = open(self.filename, 'w') + filepath = os.path.split(self.filename)[0] + if filepath and not os.path.isdir(filepath): + os.makedirs(filepath) + # If the file exists, write to temporary file first and compare them: + # - if identical, delete the temporary file and keep the existing one + # and set the group cap update flag to false + # - if different, replace existing file with temporary file and set + # the group cap update flag to true (default value) + # If the file does not exist, write the cap an set the flag to true + if os.path.isfile(self.filename): + write_to_test_file = True + test_filename = self.filename + '.test' + f = open(test_filename, 'w') + else: + write_to_test_file = False + f = open(self.filename, 'w') else: f = sys.stdout f.write(Group.header.format(group=self._name, @@ -1000,7 +1132,22 @@ def write(self, metadata_request, metadata_define, arguments): f.write(Group.footer.format(module=self._module)) if (f is not sys.stdout): f.close() - + # See comment above on updating the group cap or not + if write_to_test_file: + if filecmp.cmp(self.filename, test_filename): + # Files are equal, delete the test cap + # and set update flag to False + os.remove(test_filename) + self.update_cap = False + else: + # Files are different, replace existing cap + # with test cap and set flag to True + # Python 3 only: os.replace(test_filename, self.filename) + os.remove(self.filename) + os.rename(test_filename, self.filename) + self.update_cap = True + else: + self.update_cap = True return @property @@ -1021,6 +1168,15 @@ def filename(self): def filename(self, value): self._filename = value + @property + def update_cap(self): + '''Get the update_cap flag.''' + return self._update_cap + + @update_cap.setter + def update_cap(self, value): + self._update_cap = value + @property def init(self): '''Get the init flag.''' @@ -1065,7 +1221,7 @@ def subroutines(self): def print_debug(self): '''Basic debugging output about the group.''' - print self._name + print(self._name) for subcycle in self._subcycles: subcycle.print_debug() @@ -1129,9 +1285,9 @@ def schemes(self, value): def print_debug(self): '''Basic debugging output about the subcycle.''' - print self._loop + print(self._loop) for scheme in self._schemes: - print scheme + print(scheme) ############################################################################### diff --git a/scripts/parse_tools/__init__.py b/scripts/parse_tools/__init__.py index a7b9f438..6e5c23e2 100644 --- a/scripts/parse_tools/__init__.py +++ b/scripts/parse_tools/__init__.py @@ -28,20 +28,20 @@ 'setLogToStdout', ] -from parse_source import ParseContext, ParseSource -from parse_source import ParseSyntaxError, ParseInternalError -from parse_source import CCPPError, context_string -from parse_object import ParseObject -from parse_checkers import check_fortran_id, LITERAL_INT, FORTRAN_ID -from parse_checkers import FORTRAN_DP_RE -from parse_checkers import check_fortran_ref, FORTRAN_SCALAR_REF -from parse_checkers import check_fortran_intrinsic -from parse_checkers import check_fortran_type, check_balanced_paren -from parse_checkers import registered_fortran_ddt_name -from parse_checkers import register_fortran_ddt_name -from parse_checkers import check_dimensions, check_cf_standard_name -from parse_log import init_log, set_log_level -from parse_log import set_log_to_stdout, set_log_to_null -from parse_log import set_log_to_file -from preprocess import PreprocStack +from .parse_source import ParseContext, ParseSource +from .parse_source import ParseSyntaxError, ParseInternalError +from .parse_source import CCPPError, context_string +from .parse_object import ParseObject +from .parse_checkers import check_fortran_id, LITERAL_INT, FORTRAN_ID +from .parse_checkers import FORTRAN_DP_RE +from .parse_checkers import check_fortran_ref, FORTRAN_SCALAR_REF +from .parse_checkers import check_fortran_intrinsic +from .parse_checkers import check_fortran_type, check_balanced_paren +from .parse_checkers import registered_fortran_ddt_name +from .parse_checkers import register_fortran_ddt_name +from .parse_checkers import check_dimensions, check_cf_standard_name +from .parse_log import init_log, set_log_level +from .parse_log import set_log_to_stdout, set_log_to_null +from .parse_log import set_log_to_file +from .preprocess import PreprocStack # End if diff --git a/scripts/parse_tools/parse_checkers.py b/scripts/parse_tools/parse_checkers.py index ed96bdd0..f0c5fd03 100755 --- a/scripts/parse_tools/parse_checkers.py +++ b/scripts/parse_tools/parse_checkers.py @@ -5,7 +5,7 @@ # Python library imports import re # CCPP framework imports -from parse_source import CCPPError +from .parse_source import CCPPError ######################################################################## diff --git a/scripts/parse_tools/parse_object.py b/scripts/parse_tools/parse_object.py old mode 100644 new mode 100755 index afa4fead..2bff3d13 --- a/scripts/parse_tools/parse_object.py +++ b/scripts/parse_tools/parse_object.py @@ -4,7 +4,7 @@ # Python library imports import re # CCPP framework imports -from parse_source import ParseContext, CCPPError +from .parse_source import ParseContext, CCPPError ######################################################################## diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 2ca7447f..57944670 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -6,39 +6,10 @@ endif (NOT PROJECT) #------------------------------------------------------------------------------ # Set the sources -if(STATIC) - set(SOURCES_C) - set(SOURCES_F90 - ccpp_types.F90 - ccpp_errors.F90 - ccpp.F90 - ccpp_api.F90 - ) -else(STATIC) - set(SOURCES_C - ccpp_dl.h - ccpp_dl.c - ccpp_fields_idx.h - ccpp_fields_idx.c - ccpp_utils.h - ccpp_utils.c - ccpp_xml.h - ccpp_xml.c - ) - set(SOURCES_F90 - ccpp.F90 - ccpp_dl.F90 - ccpp_errors.F90 - ccpp_fcall.F90 - ccpp_fields.F90 - ccpp_strings.F90 - ccpp_scheme.F90 - ccpp_suite.F90 - ccpp_types.F90 - ccpp_xml.F90 - ccpp_api.F90 - ) -endif(STATIC) +set(SOURCES_F90 + ccpp_types.F90 + ccpp_api.F90 +) # Generate list of Fortran modules from defined sources foreach(source_f90 ${SOURCES_F90}) @@ -46,47 +17,11 @@ foreach(source_f90 ${SOURCES_F90}) list(APPEND MODULES_F90 ${CMAKE_CURRENT_BINARY_DIR}/${module_f90}) endforeach() -#------------------------------------------------------------------------------ -# Find/set libXML2 -if(LIBXML2_LIB_DIR AND LIBXML2_INCLUDE_DIR) - include_directories(${LIBXML2_INCLUDE_DIR}) - if (STATIC) - list(APPEND LIBS "${LIBXML2_LIB_DIR}/libxml2.a") - else (STATIC) - if(APPLE) - list(APPEND LIBS "${LIBXML2_LIB_DIR}/libxml2.dylib") - elseif(UNIX) - list(APPEND LIBS "${LIBXML2_LIB_DIR}/libxml2.so") - else (APPLE) - message (FATAL_ERROR "Unsupported platform, only Linux and MacOSX are supported at this time.") - endif(APPLE) - endif (STATIC) -else(LIBXML2_LIB_DIR AND LIBXML2_INCLUDE_DIR) - find_package(LibXml2 REQUIRED) - if(LIBXML2_FOUND) - include_directories(${LIBXML2_INCLUDE_DIR}) - list(APPEND LIBS ${LIBXML2_LIBRARIES}) - endif(LIBXML2_FOUND) -endif(LIBXML2_LIB_DIR AND LIBXML2_INCLUDE_DIR) - #------------------------------------------------------------------------------ # CMake Modules # Set the CMake module path list(APPEND CMAKE_MODULE_PATH "${CMAKE_CURRENT_SOURCE_DIR}/../cmake") -#------------------------------------------------------------------------------ -# The Fortran compiler/linker flag inserted by cmake to create shared libraries -# with the Intel compiler is deprecated (-i_dynamic), correct here. -# CMAKE_Fortran_COMPILER_ID = {"Intel", "PGI", "GNU", "Clang", "MSVC", ...} -if ("${CMAKE_Fortran_COMPILER_ID}" STREQUAL "Intel") - string(REPLACE "-i_dynamic" "-shared-intel" - CMAKE_SHARED_LIBRARY_CREATE_Fortran_FLAGS - "${CMAKE_SHARED_LIBRARY_CREATE_Fortran_FLAGS}") - string(REPLACE "-i_dynamic" "-shared-intel" - CMAKE_SHARED_LIBRARY_LINK_Fortran_FLAGS - "${CMAKE_SHARED_LIBRARY_LINK_Fortran_FLAGS}") -endif() - #------------------------------------------------------------------------------ # Set a default build type if none was specified if(NOT CMAKE_BUILD_TYPE AND NOT CMAKE_CONFIGURATION_TYPES) @@ -121,21 +56,9 @@ set(${PACKAGE}_LIB_DIRS "${CMAKE_CURRENT_BINARY_DIR}" CACHE FILEPATH "${PACKAGE} library directories") -#------------------------------------------------------------------------------ -# Add the tests (designed for DYNAMIC build only) -if(STATIC) - message(STATUS "Skipping tests, defined for dynamic build only") -else(STATIC) - add_subdirectory(tests) -endif(STATIC) - #------------------------------------------------------------------------------ # Define the executable and what to link -if(STATIC) - add_library(ccpp STATIC ${SOURCES_C} ${SOURCES_F90}) -else(STATIC) - add_library(ccpp SHARED ${SOURCES_C} ${SOURCES_F90}) -endif(STATIC) +add_library(ccpp STATIC ${SOURCES_F90}) target_link_libraries(ccpp LINK_PUBLIC ${LIBS} ${CMAKE_DL_LIBS}) set_target_properties(ccpp PROPERTIES VERSION ${PROJECT_VERSION} SOVERSION ${PROJECT_VERSION_MAJOR} @@ -144,12 +67,6 @@ set_target_properties(ccpp PROPERTIES VERSION ${PROJECT_VERSION} #------------------------------------------------------------------------------ # Installation # - -# Find all the C headers and Fortran modules -file(GLOB HEADERS_C - "${CMAKE_CURRENT_SOURCE_DIR}/ccpp*.h" -) - if (PROJECT STREQUAL "CCPP-FV3") target_include_directories(ccpp PUBLIC $ @@ -176,12 +93,9 @@ install(EXPORT ccpp-targets DESTINATION lib/cmake ) +# Define where to install the Fortran modules if (PROJECT STREQUAL "CCPP-FV3") - # Define where to install the C headers and Fortran modules - install(FILES ${HEADERS_C} DESTINATION include) install(FILES ${MODULES_F90} DESTINATION include) else (PROJECT STREQUAL "CCPP-SCM") - # Define where to install the C headers and Fortran modules - install(FILES ${HEADERS_C} DESTINATION include/${PROJECT_NAME}) install(FILES ${MODULES_F90} DESTINATION include/${PROJECT_NAME}) endif (PROJECT STREQUAL "CCPP-FV3") diff --git a/src/ccpp.F90 b/src/ccpp.F90 deleted file mode 100644 index 6bef125a..00000000 --- a/src/ccpp.F90 +++ /dev/null @@ -1,180 +0,0 @@ -! -! This work (Common Community Physics Package), identified by NOAA, NCAR, -! CU/CIRES, is free of known copyright restrictions and is placed in the -! public domain. -! -! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL -! THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER -! IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN -! CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -! - -!> -!! @brief The CCPP library main entry and exit points. -!! -! -module ccpp - -#ifdef STATIC - use :: ccpp_types, & - only: ccpp_t -#else - use, intrinsic :: iso_c_binding, & - only: c_ptr - use :: ccpp_types, & - only: ccpp_t, ccpp_suite_t - use :: ccpp_suite, & - only: ccpp_suite_init, ccpp_suite_finalize - use :: ccpp_fields, & - only: ccpp_fields_init, ccpp_fields_finalize -#endif - use :: ccpp_errors, & - only: ccpp_error, ccpp_debug - - implicit none - - private - - public :: ccpp_init, & - ccpp_finalize, & - ccpp_initialized - - contains - - !> - !! CCPP initialization subroutine. - !! - !! @param[in] suitename The suite name to use/load - !! @param[in,out] cdata The ccpp_t type data. - !! @param[ out] ierr Integer error flag. - !! @param[in] cdata_target An optional cdata instance to cope the suite from - !! @param[in] is_filename Switch to interpret suitename as filename/filepath - !! (for dynamic build only, default value .false.) - ! - subroutine ccpp_init(suitename, cdata, ierr, cdata_target, is_filename) - character(len=*), intent(in) :: suitename - type(ccpp_t), target, intent(inout) :: cdata - integer, intent( out) :: ierr - type(ccpp_t), target, intent(in), optional :: cdata_target - logical, intent(in), optional :: is_filename - ! Local variables - logical :: is_filename_local - character(len=256) :: filename_local - - ierr = 0 - - call ccpp_debug('Called ccpp_init') - -#ifndef STATIC - if (present(is_filename)) then - is_filename_local = is_filename - else - is_filename_local = .false. - end if - - if (is_filename_local) then - if (len(trim(suitename))>len(filename_local)) then - call ccpp_error('Length of suitename=filename exceeds length of local filename variable') - ierr = 1 - return - end if - filename_local = trim(suitename) - else - if (len('./suite_' // trim(suitename) // '.xml')>len(filename_local)) then - call ccpp_error('Length of suitename + 12 exceeds length of local filename variable') - ierr = 1 - return - end if - filename_local = './suite_' // trim(suitename) // '.xml' - end if - - if (present(cdata_target)) then - ! Copy the suite from the target cdata instance - cdata%suite => cdata_target%suite - cdata%suite_iscopy = .True. - else - ! Initialize the suite from the file - cdata%suite => cdata%suite_target - cdata%suite_iscopy = .False. - call ccpp_suite_init(filename_local, cdata%suite, ierr) - if (ierr /= 0) then - call ccpp_error('In initializing the CCPP suite') - return - end if - end if - - ! Initialize the fields - call ccpp_fields_init(cdata, ierr) - if (ierr /= 0) then - call ccpp_error('In initializing the CCPP fields') - return - end if -#endif - - ! Set flag indicating initialization state of cdata - cdata%initialized = .true. - - end subroutine ccpp_init - - !> - !! CCPP finalization subroutine. - !! - !! @param[in,out] cdata The ccpp_t type data. - !! @param[ out] ierr Integer error flag. - ! - subroutine ccpp_finalize(cdata, ierr) - type(ccpp_t), target, intent(inout) :: cdata - integer, intent( out) :: ierr - - ierr = 0 - - call ccpp_debug('Called ccpp_finalize') - -#ifndef STATIC - if (cdata%suite_iscopy) then - nullify(cdata%suite) - cdata%suite_iscopy = .False. - return - end if - - ! Finalize the suite - call ccpp_suite_finalize(cdata%suite, ierr) - if (ierr /= 0) then - call ccpp_error('In finalizing the CCPP suite') - return - end if - - ! Finalize the fields - call ccpp_fields_finalize(cdata, ierr) - if (ierr /= 0) then - call ccpp_error('In finalizing the CCPP fields') - return - end if - - nullify(cdata%suite) -#endif - - ! Set flag indicating initialization state of cdata - cdata%initialized = .false. - - end subroutine ccpp_finalize - - !> - !! CCPP test initialization routine - !! - !! @param[in] cdata The ccpp_t type data - !! @return initialized .true. or .false. - ! - function ccpp_initialized(cdata) result(initialized) - type(ccpp_t), target, intent(in) :: cdata - logical :: initialized - - call ccpp_debug('Called ccpp_initialized') - - initialized = cdata%initialized - - end function ccpp_initialized - -end module ccpp diff --git a/src/ccpp_api.F90 b/src/ccpp_api.F90 index 9fafddc7..bbaa2fd5 100644 --- a/src/ccpp_api.F90 +++ b/src/ccpp_api.F90 @@ -18,35 +18,10 @@ ! module ccpp_api - use ccpp_types, only: CCPP_STR_LEN, & - ccpp_t - use ccpp_errors, only: ccpp_error, & - ccpp_debug - use ccpp, only: ccpp_init, & - ccpp_finalize, & - ccpp_initialized -#ifndef STATIC - use ccpp_fcall, only: ccpp_physics_init, & - ccpp_physics_run, & - ccpp_physics_finalize - use ccpp_fields, only: ccpp_field_add, & - ccpp_field_get -#endif + use ccpp_types, only: ccpp_t implicit none - public :: CCPP_STR_LEN, & - ccpp_t, & - ccpp_error, & - ccpp_debug, & - ccpp_init, & - ccpp_finalize -#ifndef STATIC - public :: ccpp_physics_init, & - ccpp_physics_run, & - ccpp_physics_finalize, & - ccpp_field_add, & - ccpp_initialized -#endif + public :: ccpp_t end module ccpp_api diff --git a/src/ccpp_dl.F90 b/src/ccpp_dl.F90 deleted file mode 100644 index a81f7bae..00000000 --- a/src/ccpp_dl.F90 +++ /dev/null @@ -1,53 +0,0 @@ -!> -!! @brief The function pointer module. -!! -!! @details The routines for calling the specified functions. -!! This module contains no subroutines or functions it -!! only provies an interface to the C counterparts. -! -module ccpp_dl - - use, intrinsic :: iso_c_binding, & - only: c_int32_t, c_char, c_ptr - - implicit none - - private - public :: ccpp_dl_open, & - ccpp_dl_close, & - ccpp_dl_call - - interface - integer(c_int32_t) & - function ccpp_dl_open & - (name, library, version, fhdl, lhdl) & - bind(c, name='ccpp_dl_open') - import :: c_char, c_int32_t, c_ptr - character(kind=c_char), dimension(*) :: name - character(kind=c_char), dimension(*) :: library - character(kind=c_char), dimension(*) :: version - type(c_ptr) :: fhdl - type(c_ptr) :: lhdl - end function ccpp_dl_open - - integer(c_int32_t) & - function ccpp_dl_close & - (lhdl) & - bind(c, name='ccpp_dl_close') - import :: c_int32_t, c_ptr - type(c_ptr) :: lhdl - end function ccpp_dl_close - - integer(c_int32_t) & - function ccpp_dl_call & - (shdl, cdata) & - bind(c, name='ccpp_dl_call') - import :: c_int32_t, c_ptr - type(c_ptr) :: shdl - type(c_ptr) :: cdata - end function ccpp_dl_call - end interface - - contains - -end module ccpp_dl diff --git a/src/ccpp_dl.c b/src/ccpp_dl.c deleted file mode 100644 index f670d41a..00000000 --- a/src/ccpp_dl.c +++ /dev/null @@ -1,181 +0,0 @@ -/* - * This work (Common Community Physics Package), identified by NOAA, NCAR, - * CU/CIRES, is free of known copyright restrictions and is placed in the - * public domain. - * - * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR - * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, - * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL - * THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER - * IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN - * CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. - */ - -/** - * @file ccpp_dl.c - * - * Routines for the function/subroutine calls using dynamic loaded shared - * objects. - * - * @ingroup CCPP - * @{ - **/ - -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include - -#include "ccpp_dl.h" - -/** Shared library prefix and suffix for different platforms **/ -static const char prefix[] = "lib"; -#if __APPLE__ -static const char suffix[] = ".dylib"; -#elif __unix__ -static const char suffix[] = ".so"; -#endif - -/** - * Function call initialization routine. - * - * This dlopen()'s the library specified and tries to - * obtain a handle to the function/scheme cap. - * - * @param[in] scheme The scheme name to call. - * @param[in] lib The library continaing the physics scheme. - * @param[in] ver The library version number. - * @param[out] fhdl The scheme function pointer handle. - * @param[out] lhdl The library handle. - * @retval 0 If it was sucessful - * @retval 1 If there was an error - **/ -int -ccpp_dl_open(const char *scheme, const char *lib, const char *ver, - void **fhdl, void **lhdl) -{ - int i = 0; - int n = 0; - const char cap[] = "_cap"; - const char *l = NULL; - char *library = NULL; - char *scheme_cap = NULL; - char *error = NULL; - struct stat sbuf = {0}; - - /* Did we get an actual library file? */ - if (stat(lib, &sbuf) == 0) { - l = lib; - } else { - /* Generate the library name with the platform suffix */ - n = (strlen(prefix) + strlen(lib) + strlen(suffix) - + strlen(ver) +2) *sizeof(char); - library = malloc(n); - memset(library, 0, n); - if (strcmp(ver, "") != 0) { -#ifdef __APPLE__ - snprintf(library, n, "%s%s.%s%s", prefix, lib, - ver, suffix); -#elif defined(__linux__) || defined(__unix__) - snprintf(library, n, "%s%s%s.%s", prefix, lib, - suffix, ver); -#else - warnx("CCPP library name not configured for this operating system"); - return(EXIT_FAILURE); -#endif - } else { - snprintf(library, n, "%s%s%s", prefix, lib, suffix); - } - l = library; - } - - /* Generate the scheme cap function name */ - n = (strlen(scheme) +strlen(cap) +1)*sizeof(char); - scheme_cap = malloc(n); - memset(scheme_cap, 0, n); - - n = strlen(scheme); - for (i=0; i < n; ++i) { - scheme_cap[i] = tolower(scheme[i]); - } - - strncat(scheme_cap, cap, n); - - /* Open a handle to the library */ - *lhdl = dlopen(l, RTLD_NOW); - if (!*lhdl) { - warnx("%s", dlerror()); - return(EXIT_FAILURE); - } - - dlerror(); - *(void **)fhdl = dlsym(*lhdl, scheme_cap); - if ((error = dlerror()) != NULL) { - warnx("%s", error); - return(EXIT_FAILURE); - } - - /* Free the library filename */ - if (library) { - free(library); - library = NULL; - } - - /* Free the scheme cap function name */ - if (scheme_cap) { - free(scheme_cap); - scheme_cap = NULL; - } - - return(EXIT_SUCCESS); -} - -/** - * Function call library closing routine. - * - * @param[in] lhdl The library handle. - * @retval 0 If it was sucessful - * @retval 1 If there was an error - **/ -int -ccpp_dl_close(void **lhdl) -{ - char *error = NULL; - - dlerror(); - dlclose(*lhdl); - if ((error = dlerror()) != NULL) { - warnx("%s", error); - return(EXIT_FAILURE); - } - - return(EXIT_SUCCESS); -} - -/** - * The function cap calling routine. - * - * @param[in] f_ptr The scheme function pointer to call. - * @param[in] data The opaque ccpp_t data type to pass. - * @retval 0 If it was sucessful - * @retval !=0 If there was an error - **/ -int -ccpp_dl_call(void **f_ptr, void **data) -{ - int (*fun)(void **) = NULL; - - *(int **)(&fun) = *f_ptr; - - return(fun(data)); -} - -/** - * @} - **/ diff --git a/src/ccpp_dl.h b/src/ccpp_dl.h deleted file mode 100644 index 0657188c..00000000 --- a/src/ccpp_dl.h +++ /dev/null @@ -1,34 +0,0 @@ -/** - * @file ccpp_dl.h - * - * The function pointer routines using dynamic loaded shared objects. - * - * @ingroup CCPP - * @{ - **/ -#ifndef CCPP_DL_H -#define CCPP_DL_H - -#ifdef __cplusplus -extern "C" -{ -#endif - -/** Function libaray and cap function initialization routine. **/ -int ccpp_dl_open(const char *, const char *, const char *, void **, void **); - -/** Function library closing/unloading routine. **/ -int ccpp_dl_close(void **); - -/** Function pointer physics cap function call. **/ -int ccpp_dl_call(void **, void **); - -#ifdef __cplusplus -} /* extern "C" */ -#endif - -#endif /* CCPP_DL_H */ - -/** - * @} - **/ diff --git a/src/ccpp_errors.F90 b/src/ccpp_errors.F90 deleted file mode 100644 index 9a3fee02..00000000 --- a/src/ccpp_errors.F90 +++ /dev/null @@ -1,128 +0,0 @@ -! -! This work (Common Community Physics Package), identified by NOAA, NCAR, -! CU/CIRES, is free of known copyright restrictions and is placed in the -! public domain. -! -! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL -! THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER -! IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN -! CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -! - -!> -!! @brief Error/Warning reporting module. -!! -!! @details Subroutines for reporting warnings. -! -module ccpp_errors - - use, intrinsic :: iso_fortran_env, & - only: error_unit, output_unit - - implicit none - - private - public :: ccpp_error, & - ccpp_warn, & - ccpp_info, & - ccpp_debug, & - ccpp_if_error, & - ccpp_if_warn - - contains - - !> - !! Fatal error reporting. - !! - !! Write an error message to error_unit/stderr. - !! - !! @param[in] message The error message to write. - ! - subroutine ccpp_error(message) - character(len=*), intent(in) :: message - - write(error_unit, *) 'ERROR: ', trim(message) - end subroutine ccpp_error - - !> - !! Non-fatal warning reporting. - !! - !! Write an warning message to error_unit/stderr. - !! - !! @param[in] message The warning message to write. - ! - subroutine ccpp_warn(message) - character(len=*), intent(in) :: message - - write(error_unit, *) 'WARN: ', trim(message) - end subroutine ccpp_warn - - !> - !! Reporting on info level - !! - !! Write an info message to output_unit/stdout. - !! - !! @param[in] message The info message to write. - ! - subroutine ccpp_info(message) - character(len=*), intent(in) :: message - - write(output_unit, *) 'INFO: ', trim(message) - end subroutine ccpp_info - - !> - !! Reporting on debug level - !! - !! Write a debug message to output_unit/stdout. - !! - !! @param[in] message The debug message to write. - ! - subroutine ccpp_debug(message) - character(len=*), intent(in) :: message - -#ifdef DEBUG - write(output_unit, *) 'DEBUG: ', trim(message) -#endif - end subroutine ccpp_debug - - !> - !! Fatal error checking and reporting. - !! - !! Check to see if ierr is non-zero. If it is - !! write an error message to error_unit/stderr. - !! - !! @param[in] ierr The exit code. - !! @param[in] message The error message to write. - ! - subroutine ccpp_if_error(ierr, message) - integer, intent(in) :: ierr - character(len=*), intent(in) :: message - - if (ierr /= 0) then - write(error_unit, *) 'ERROR: ', trim(message) - end if - - end subroutine ccpp_if_error - - !> - !! Non-fatal warning checking and reporting. - !! - !! Check to see if ierr is non-zero. If it is - !! write an warning message to error_unit/stderr. - !! - !! @param[in] ierr The exit code. - !! @param[in] message The warning message to write. - ! - subroutine ccpp_if_warn(ierr, message) - integer, intent(in) :: ierr - character(len=*), intent(in) :: message - - if (ierr /= 0) then - write(error_unit, *) 'WARN: ', trim(message) - end if - - end subroutine ccpp_if_warn - -end module ccpp_errors diff --git a/src/ccpp_fcall.F90 b/src/ccpp_fcall.F90 deleted file mode 100644 index 62c5318f..00000000 --- a/src/ccpp_fcall.F90 +++ /dev/null @@ -1,472 +0,0 @@ -!> -!! @brief The CCPP function call module. -!! -!! @details The CCPP routines for calling the specified -!! physics group/subcyce/scheme. -! -module ccpp_fcall - - use, intrinsic :: iso_c_binding, & - only: c_int32_t, c_char, c_ptr, c_loc, c_funptr - use :: ccpp_types, & - only: ccpp_t, ccpp_suite_t, ccpp_group_t, & - ccpp_subcycle_t, ccpp_scheme_t, & - CCPP_STAGES, CCPP_DEFAULT_STAGE, & - CCPP_DEFAULT_LOOP_CNT - use :: ccpp_errors, & - only: ccpp_error, ccpp_debug - use :: ccpp_strings, & - only: ccpp_cstr - use :: ccpp_dl, & - only: ccpp_dl_call - - implicit none - - private - public :: ccpp_physics_init, ccpp_physics_run, ccpp_physics_finalize - - contains - - !! - !! Public CCPP physics init/run/finalize routines - !! - - !> - !! Single entry point for initializing ccpp physics. - !! - !! @param[in,out] cdata The CCPP data of type ccpp_t - !! @param[ out] ierr Integer error flag - ! - subroutine ccpp_physics_init(cdata, group_name, scheme_name, ierr) - - type(ccpp_t), target, intent(inout) :: cdata - character(len=*), optional, intent(in) :: group_name - character(len=*), optional, intent(in) :: scheme_name - integer, intent(out) :: ierr - - ! Local variables - type(ccpp_group_t) , pointer :: group - type(ccpp_scheme_t), pointer :: scheme - - ierr = 0 - call ccpp_debug('Called ccpp_physics_init') - - if (present(group_name) .and. present(scheme_name)) then - call ccpp_error('Logic error in ccpp_physics_init: group_name and scheme_name are mutually exclusive') - ierr = 1 - return - end if - - if (present(group_name)) then - ! Find the group to initialize from the suite - group => ccpp_find_group(cdata%suite, group_name, ierr=ierr) - if (ierr/=0) return - call ccpp_run_group(group, cdata, stage='init', ierr=ierr) - else if (present(scheme_name)) then - ! Find the scheme to initialize from the suite - scheme => ccpp_find_scheme(cdata%suite, scheme_name, ierr=ierr) - if (ierr/=0) return - call ccpp_run_scheme(scheme, cdata, stage='init', ierr=ierr) - else - ! Run the suite init scheme before the individual init schemes - if (allocated(cdata%suite%init%name)) then - scheme => cdata%suite%init - call ccpp_run_scheme(scheme, cdata, stage='init', ierr=ierr) - end if - ! Initialize all schemes - call ccpp_run_suite(cdata%suite, cdata, stage='init', ierr=ierr) - end if - - end subroutine ccpp_physics_init - - !> - !! Single entry point for running ccpp physics. - !! Optional arguments specify whether to run one - !! group or an individual scheme of the suite. - !! If no optional arguments are provided, the - !! entire suite attached to cdata is run. - !! group and scheme are mutually exclusive. - !! - !! @param[in,out] cdata The CCPP data of type ccpp_t - !! @param[in ] group The group of physics to run (optional) - !! @param[in ] scheme The name of a single scheme to run (optional) - !! @param[ out] ierr Integer error flag - ! - subroutine ccpp_physics_run(cdata, group_name, scheme_name, ierr) - - type(ccpp_t), target, intent(inout) :: cdata - character(len=*), optional, intent(in) :: group_name - character(len=*), optional, intent(in) :: scheme_name - integer, intent(out) :: ierr - - ! Local variables - type(ccpp_suite_t) , pointer :: suite - type(ccpp_group_t) , pointer :: group - type(ccpp_scheme_t) , pointer :: scheme - - ierr = 0 - call ccpp_debug('Called ccpp_physics_run') - - ! Consistency checks - if (present(group_name) .and. present(scheme_name)) then - call ccpp_error('Logic error in ccpp_physics_run: group_name and scheme_name are mutually exclusive') - ierr = 1 - return - end if - - suite => cdata%suite - - if (present(group_name)) then - ! Find the group to run from the suite - group => ccpp_find_group(suite, group_name, ierr=ierr) - if (ierr/=0) return - call ccpp_run_group(group, cdata, ierr=ierr) - else if (present(scheme_name)) then - ! Find the scheme to run from the suite - scheme => ccpp_find_scheme(suite, scheme_name, ierr=ierr) - if (ierr/=0) return - call ccpp_run_scheme(scheme, cdata, ierr=ierr) - else - ! If none of the optional arguments is present, run the entire suite - call ccpp_run_suite(suite, cdata, ierr=ierr) - end if - - end subroutine ccpp_physics_run - - !> - !! Single entry point for finalizing ccpp physics. - !! - !! @param[in,out] cdata The CCPP data of type ccpp_t - !! @param[ out] ierr Integer error flag - ! - subroutine ccpp_physics_finalize(cdata, group_name, scheme_name, ierr) - - type(ccpp_t), target, intent(inout) :: cdata - character(len=*), optional, intent(in) :: group_name - character(len=*), optional, intent(in) :: scheme_name - integer, intent(out) :: ierr - - ! Local variables - type(ccpp_group_t) , pointer :: group - type(ccpp_scheme_t), pointer :: scheme - - ierr = 0 - call ccpp_debug('Called ccpp_physics_finalize') - - if (present(group_name) .and. present(scheme_name)) then - call ccpp_error('Logic error in ccpp_physics_finalize: group_name and scheme_name are mutually exclusive') - ierr = 1 - return - end if - - if (present(group_name)) then - ! Find the group to finalize from the suite - group => ccpp_find_group(cdata%suite, group_name, ierr=ierr) - if (ierr/=0) return - call ccpp_run_group(group, cdata, stage='finalize', ierr=ierr) - else if (present(scheme_name)) then - ! Find the scheme to finalize from the suite - scheme => ccpp_find_scheme(cdata%suite, scheme_name, ierr=ierr) - if (ierr/=0) return - call ccpp_run_scheme(scheme, cdata, stage='finalize', ierr=ierr) - else - ! Finalize all schemes - call ccpp_run_suite(cdata%suite, cdata, stage='finalize', ierr=ierr) - ! Run the suite finalize scheme after the individual finalize schemes - if (allocated(cdata%suite%finalize%name)) then - scheme => cdata%suite%finalize - call ccpp_run_scheme(scheme, cdata, stage='finalize', ierr=ierr) - end if - end if - - end subroutine ccpp_physics_finalize - - !! - !! Private/internal routines for running suites, groups, subcycles and schemes *DH - !! - - !> - !! The run subroutine for a suite. This will call - !! the all groups within a suite. - !! - !! @param[in ] suite The suite to run - !! @param[in,out] cdata The CCPP data of type ccpp_t - !! @param[in ] stage The stage for which to run the suite - !! @param[ out] ierr Integer error flag - ! - subroutine ccpp_run_suite(suite, cdata, stage, ierr) - - type(ccpp_suite_t), intent(inout) :: suite - type(ccpp_t), target, intent(inout) :: cdata - character(len=*), intent(in), optional :: stage - integer, intent( out) :: ierr - - integer :: i - - ierr = 0 - - call ccpp_debug('Called ccpp_run_suite for stage ' // trim(stage)) - - do i=1,suite%groups_max - call ccpp_run_group(suite%groups(i), cdata, stage=stage, ierr=ierr) - if (ierr /= 0) then - return - end if - end do - - end subroutine ccpp_run_suite - - !> - !! The find subroutine for a group. This will return - !! the group that matches group_name and ierr=0, - !! or ierr=1 if no such group is found. - !! - !! @param[in ] suite The suite in which to find the group - !! @param[in ] group_name The name of the group to run - !! @param[ out] ierr Integer error flag - ! - function ccpp_find_group(suite, group_name, ierr) result(group) - - type(ccpp_suite_t), target, intent(in ) :: suite - character(len=*), intent(in ) :: group_name - integer, intent( out) :: ierr - type(ccpp_group_t), pointer :: group - - integer :: i - - call ccpp_debug('Called ccpp_find_group') - - ierr = 0 - do i=1, suite%groups_max - if (trim(suite%groups(i)%name) .eq. trim(group_name)) then - call ccpp_debug('Group ' // trim(group_name) // ' found in suite') - group => suite%groups(i) - return - end if - end do - - call ccpp_error('Group ' // trim(group_name) // ' not found in suite') - ierr = 1 - - end function ccpp_find_group - - !> - !! The run subroutine for a group. This will call - !! the all subcycles within a group. - !! - !! @param[in ] group The group to run - !! @param[in,out] cdata The CCPP data of type ccpp_t - !! @param[in ] stage The stage for which to run the group - !! @param[ out] ierr Integer error flag - ! - subroutine ccpp_run_group(group, cdata, stage, ierr) - - type(ccpp_group_t), intent(inout) :: group - type(ccpp_t), target, intent(inout) :: cdata - character(len=*), intent(in), optional :: stage - integer, intent( out) :: ierr - - integer :: i - - ierr = 0 - - call ccpp_debug('Called ccpp_run_group for stage ' // trim(stage)) - - do i=1,group%subcycles_max - call ccpp_run_subcycle(group%subcycles(i), cdata, stage=stage, ierr=ierr) - if (ierr /= 0) then - return - end if - end do - - end subroutine ccpp_run_group - - !> - !! The run subroutine for a subcycle. This will call - !! the all schemes within a subcycle. It will also - !! loop if the loop attribut is greater than 1. - !! - !! @param[in ] subcycle The subcycle to run - !! @param[in,out] cdata The CCPP data of type ccpp_t - !! @param[in ] stage The stage for which to run the subcycle - !! @param[ out] ierr Integer error flag - ! - subroutine ccpp_run_subcycle(subcycle, cdata, stage, ierr) - - type(ccpp_subcycle_t), intent(inout) :: subcycle - type(ccpp_t), target, intent(inout) :: cdata - character(len=*), intent(in), optional :: stage - integer, intent( out) :: ierr - - integer :: j - - ierr = 0 - - call ccpp_debug('Called ccpp_run_subcycle for stage ' // trim(stage)) - - associate(i=>cdata%loop_cnt) - do i=1,subcycle%loops_max - do j=1,subcycle%schemes_max - call ccpp_run_scheme(subcycle%schemes(j), cdata, stage=stage, ierr=ierr) - if (ierr /= 0) then - return - end if - end do - end do - end associate - - cdata%loop_cnt = CCPP_DEFAULT_LOOP_CNT - - end subroutine ccpp_run_subcycle - - !> - !! The find subroutine for a scheme. This will return - !! the scheme that matches scheme_name and ierr==0, - !! or ierr==1 if no such scheme is found. - !! - !! @param[in ] suite The suite in which to find the scheme - !! @param[in ] scheme_name The name of the scheme to run - !! @param[ out] ierr Integer error flag - ! - function ccpp_find_scheme(suite, scheme_name, ierr) result(scheme) - - type(ccpp_suite_t), target, intent(in ) :: suite - character(len=*), intent(in ) :: scheme_name - integer, intent( out) :: ierr - type(ccpp_scheme_t), pointer :: scheme - - integer :: i, j, k - - call ccpp_debug('Called ccpp_find_scheme') - - ierr = 0 - do i=1, suite%groups_max - do j=1, suite%groups(i)%subcycles_max - do k=1, suite%groups(i)%subcycles(j)%schemes_max - if (trim(suite%groups(i)%subcycles(j)%schemes(k)%name) .eq. trim(scheme_name)) then - call ccpp_debug('Scheme ' // trim(scheme_name) // ' found in suite') - scheme => suite%groups(i)%subcycles(j)%schemes(k) - return - end if - end do - end do - end do - - call ccpp_error('Scheme ' // trim(scheme_name) // ' not found in suite') - ierr = 1 - - end function ccpp_find_scheme - - !> - !! The run subroutine for a scheme. This will call - !! the single scheme specified. - !! - !! @param[in ] scheme The scheme to run - !! @param[in,out] cdata The CCPP data of type ccpp_t - !! @param[in ] stage The stage for which to run the scheme - !! @param[ out] ierr Integer error flag - ! - subroutine ccpp_run_scheme(scheme, cdata, stage, ierr) - - type(ccpp_scheme_t), intent(inout) :: scheme - type(ccpp_t), target, intent(inout) :: cdata - character(len=*), intent(in), optional :: stage - integer, intent( out) :: ierr - - character(:), allocatable :: stage_local - character(:), allocatable :: function_name - integer :: l - - ierr = 0 - - if (present(stage)) then - stage_local = trim(stage) - else - stage_local = trim(CCPP_DEFAULT_STAGE) - end if - - call ccpp_debug('Called ccpp_run_scheme for ' // trim(scheme%name) & - //' in stage ' // trim(stage_local)) - - if (trim(stage_local) == 'init' .and. scheme%initialized) then - call ccpp_debug('Scheme ' // trim(scheme%name) // ' already initialized, skip.') - return - else if (trim(stage_local) == 'finalize' .and. .not.scheme%initialized) then - call ccpp_debug('Scheme ' // trim(scheme%name) // ' not initialized, skip.') - return - ! Check for default run stage that scheme is initialized - else if (trim(stage_local) == trim(CCPP_DEFAULT_STAGE) .and. .not.scheme%initialized) then - call ccpp_error('Error in ccpp_run_scheme, stage ' // trim(stage_local) // & - ': ' // trim(scheme%name) // ' not initialized.') - ierr = 1 - return - end if - - function_name = trim(scheme%get_function_name(stage_local)) - - do l=1,scheme%functions_max - associate (f=>scheme%functions(l)) - if (trim(function_name) == trim(f%name)) then - ierr = ccpp_dl_call(f%function_hdl, c_loc(cdata)) - if (ierr /= 0) then - call ccpp_error('A problem occured calling '// trim(f%name) & - //' of scheme ' // trim(scheme%name) & - //' in stage ' // trim(stage_local)) - else if (trim(stage_local) == 'init') then - scheme%initialized = .true. - else if (trim(stage_local) == 'finalize') then - scheme%initialized = .false. - end if - ! Return after calling the scheme, with or without error - return - end if - end associate - end do - - ! If we reach this point, the required function was not found - ierr = 1 - do l=1,size(CCPP_STAGES) - if (trim(stage_local) == trim(CCPP_STAGES(l))) then - ! Stage is valid --> problem with the scheme - call ccpp_error('Function ' // trim(function_name) & - //' of scheme ' // trim(scheme%name) & - //' for stage ' // trim(stage_local) & - //' not found in suite') - return - end if - end do - ! Stage is invalid - call ccpp_error('Invalid stage ' // trim(stage_local) & - //' requested in ccpp_run_scheme') - - end subroutine ccpp_run_scheme - -#if 0 - ! DH 20180504 - keep for future use - !> - !! The run subroutine for a function pointer. This - !! will call the single function specified. - !! - !! @param[in ] scheme The scheme to run - !! @param[in,out] cdata The CCPP data of type ccpp_t - !! @param[ out] ierr Integer error flag - ! - subroutine ccpp_run_fptr(fptr, cdata, ierr) - - type(c_ptr), intent(in ) :: fptr - type(ccpp_t), target, intent(inout) :: cdata - integer, intent( out) :: ierr - - ierr = 0 - - call ccpp_debug('Called ccpp_run_fptr') - - ierr = ccpp_dl_call(fptr, c_loc(cdata)) - if (ierr /= 0) then - call ccpp_error('A problem occured calling function pointer') - end if - - end subroutine ccpp_run_fptr -#endif - -end module ccpp_fcall diff --git a/src/ccpp_fields.F90 b/src/ccpp_fields.F90 deleted file mode 100644 index 76f12663..00000000 --- a/src/ccpp_fields.F90 +++ /dev/null @@ -1,2151 +0,0 @@ -! -! This work (Common Community Physics Package), identified by NOAA, NCAR, -! CU/CIRES, is free of known copyright restrictions and is placed in the -! public domain. -! -! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL -! THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER -! IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN -! CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -! - -!> -!! @brief Physics fields module. -!! -!! Routines and functions to interact with physics fields. -!! Most of the work is carried out in C (ccpp_field_idx.c). -!! The IPD contains an array of C pointers to all the -!! fields passed around. This array needs an index so -!! one can field the requested field. -!! -!! Example usage in the atmosphere driver cap. -!! @code{.f90} -!! -!! ! Add a field, for example the eastward_wind. -!! call ccpp_field_add(ipd_data, 'eastward_wind', & -!! u, ierr, 'm s-1') -!! if (ierr /= 0) then -!! call exit(ierr) -!! end if -!! -!! @endcode -!! -!! Example usage in a physics scheme cap. -!! @code{.f90} -!! -!! ! Extract a field, for example the eastward_wind. -!! call ccpp_field_get(ipd_data, 'eastward_wind', u, ierr) -!! if (ierr /= 0) then -!! call exit(ierr) -!! end if -!! -!! @endcode -! -module ccpp_fields - - use, intrinsic :: iso_fortran_env, & - only: INT8, INT16, INT32, INT64, & - REAL32, REAL64, REAL128 - use, intrinsic :: iso_c_binding, & - only: c_f_pointer, c_loc, c_ptr, c_int32_t, c_char - use :: ccpp_types, & - only: ccpp_t, ccpp_field_t, CCPP_GENERIC_KIND - use :: ccpp_strings, & - only: ccpp_cstr - use :: ccpp_errors, & - only: ccpp_debug, ccpp_info, ccpp_warn, ccpp_error - - implicit none - - private - public :: ccpp_fields_init, & - ccpp_fields_finalize, & - ccpp_fields_find, & - ccpp_field_add, & - ccpp_field_get - - ! DH* TODO can use new Fortran syntax? - ! type(*), dimension(..), intent(in) :: a - ! for arrays of any type, any rank? *DH - - !> - !! Module precedence for adding a field. - ! - interface ccpp_field_add - module procedure & - ccpp_field_add_i32_0, & - ccpp_field_add_i32_1, & - ccpp_field_add_i32_2, & - ccpp_field_add_i32_3, & - ccpp_field_add_i32_4, & - ccpp_field_add_i32_5, & - ccpp_field_add_i32_6, & - ccpp_field_add_i32_7, & - - ccpp_field_add_i64_0, & - ccpp_field_add_i64_1, & - ccpp_field_add_i64_2, & - ccpp_field_add_i64_3, & - ccpp_field_add_i64_4, & - ccpp_field_add_i64_5, & - ccpp_field_add_i64_6, & - ccpp_field_add_i64_7, & - - ccpp_field_add_r32_0, & - ccpp_field_add_r32_1, & - ccpp_field_add_r32_2, & - ccpp_field_add_r32_3, & - ccpp_field_add_r32_4, & - ccpp_field_add_r32_5, & - ccpp_field_add_r32_6, & - ccpp_field_add_r32_7, & - - ccpp_field_add_r64_0, & - ccpp_field_add_r64_1, & - ccpp_field_add_r64_2, & - ccpp_field_add_r64_3, & - ccpp_field_add_r64_4, & - ccpp_field_add_r64_5, & - ccpp_field_add_r64_6, & - ccpp_field_add_r64_7, & - - ccpp_field_add_l_0, & - ccpp_field_add_l_1, & - ccpp_field_add_l_2, & - ccpp_field_add_l_3, & - ccpp_field_add_l_4, & - ccpp_field_add_l_5, & - ccpp_field_add_l_6, & - ccpp_field_add_l_7, & - - ccpp_field_add_c_0, & - ccpp_field_add_c_1, & - - ccpp_field_add_ptr - end interface ccpp_field_add - - !> - !! Module precedence for getting a field. - ! - interface ccpp_field_get - module procedure & - ccpp_field_get_i32_0, & - ccpp_field_get_i32_1, & - ccpp_field_get_i32_2, & - ccpp_field_get_i32_3, & - ccpp_field_get_i32_4, & - ccpp_field_get_i32_5, & - ccpp_field_get_i32_6, & - ccpp_field_get_i32_7, & - - ccpp_field_get_i64_0, & - ccpp_field_get_i64_1, & - ccpp_field_get_i64_2, & - ccpp_field_get_i64_3, & - ccpp_field_get_i64_4, & - ccpp_field_get_i64_5, & - ccpp_field_get_i64_6, & - ccpp_field_get_i64_7, & - - ccpp_field_get_r32_0, & - ccpp_field_get_r32_1, & - ccpp_field_get_r32_2, & - ccpp_field_get_r32_3, & - ccpp_field_get_r32_4, & - ccpp_field_get_r32_5, & - ccpp_field_get_r32_6, & - ccpp_field_get_r32_7, & - - ccpp_field_get_r64_0, & - ccpp_field_get_r64_1, & - ccpp_field_get_r64_2, & - ccpp_field_get_r64_3, & - ccpp_field_get_r64_4, & - ccpp_field_get_r64_5, & - ccpp_field_get_r64_6, & - ccpp_field_get_r64_7, & - - ccpp_field_get_l_0, & - ccpp_field_get_l_1, & - ccpp_field_get_l_2, & - ccpp_field_get_l_3, & - ccpp_field_get_l_4, & - ccpp_field_get_l_5, & - ccpp_field_get_l_6, & - ccpp_field_get_l_7, & - - ccpp_field_get_c_0, & - ccpp_field_get_c_1, & - - ccpp_field_get_ptr - end interface ccpp_field_get - - !> - !! Interface to all the C field index functions. - ! - interface - integer(c_int32_t) & - function ccpp_field_idx_init & - (idx) & - bind(c, name='ccpp_field_idx_init') - import :: c_int32_t, c_ptr - type(c_ptr) :: idx - end function ccpp_field_idx_init - - integer(c_int32_t) & - function ccpp_field_idx_finalize & - (idx) & - bind(c, name='ccpp_field_idx_finalize') - import :: c_int32_t, c_ptr - type(c_ptr) :: idx - end function ccpp_field_idx_finalize - - integer(c_int32_t) & - function ccpp_field_idx_add & - (name, idx) & - bind(c, name='ccpp_field_idx_add') - import :: c_int32_t, c_char, c_ptr - character(kind=c_char), dimension(*) :: name - type(c_ptr) :: idx - end function ccpp_field_idx_add - - integer(c_int32_t) & - function ccpp_field_idx_find & - (name, idx) & - bind(c, name='ccpp_field_idx_find') - import :: c_char, c_int32_t, c_ptr - character(kind=c_char), dimension(*) :: name - type(c_ptr) :: idx - end function ccpp_field_idx_find - - integer(c_int32_t) & - function ccpp_field_idx_max & - (idx) & - bind(c, name='ccpp_field_idx_max') - import :: c_int32_t, c_ptr - type(c_ptr) :: idx - end function ccpp_field_idx_max - - end interface - - contains - - !> - !! CCPP fields initialization subroutine. - !! - !! @param[in,out] cdata The ccpp_t type data. - !! @param[ out] ierr Integer error flag. - ! - subroutine ccpp_fields_init(cdata, ierr) - type(ccpp_t), target, intent(inout) :: cdata - integer, intent( out) :: ierr - - integer :: fields_max - - ierr = 0 - - ierr = ccpp_field_idx_init(cdata%fields_idx) - if (ierr /= 0) then - call ccpp_warn('Unable to initalize cdata field index') - return - end if - - fields_max = ccpp_field_idx_max(cdata%fields_idx) - - allocate(cdata%fields(fields_max), stat=ierr) - if (ierr /= 0) then - call ccpp_warn('Unable to allocate cdata fields') - return - end if - - ! Add CCPP-internal fields to data structure, harcoded - - end subroutine ccpp_fields_init - - !> - !! CCPP fields finalization subroutine. - !! - !! @param[in,out] cdata The ccpp_t type data. - !! @param[ out] ierr Integer error flag. - ! - subroutine ccpp_fields_finalize(cdata, ierr) - type(ccpp_t), intent(inout) :: cdata - integer, intent( out) :: ierr - - ierr = 0 - - if (allocated(cdata%fields)) then - deallocate(cdata%fields) - end if - - ierr = ccpp_field_idx_finalize(cdata%fields_idx) - if (ierr /= 0) then - call ccpp_warn('Unable to clean up cdata field index') - return - end if - - end subroutine ccpp_fields_finalize - - !> - !! CCPP fields addition subroutine. - !! - !! @param[in,out] cdata The ccpp_t type data. - !! @param[in ] standard_name The standard name for the data. - !! @param[in ] units The SI units for the data. - !! @param[in ] ptr A C pointer to the data. - !! @param[in ] rank Optional rank of the data. - !! @param[in ] dims Optional dimensions of the data. - !! @param[ out] ierr Integer error flag. - ! - subroutine ccpp_field_add_ptr(cdata, standard_name, units, ptr, & - rank, dims, kind, index, ierr) - type(ccpp_t), intent(inout) :: cdata - character(len=*), intent(in) :: standard_name - character(len=*), intent(in) :: units - type(c_ptr), intent(in) :: ptr - integer, optional, intent(in) :: rank - integer, dimension(:), optional, intent(in) :: dims - integer, optional, intent(in) :: kind - integer, optional, intent(in) :: index - integer, optional, intent( out) :: ierr - - integer :: i - integer :: ierr_local - integer :: old_fields_max - integer :: new_fields_max - type(ccpp_field_t), allocatable, dimension(:) :: tmp - - call ccpp_debug('Called ccpp_field_add_ptr for field ' // trim(standard_name)) - - ierr_local = 0 - - ! Get the current/old fields max - old_fields_max = ccpp_field_idx_max(cdata%fields_idx) - - ! Add ourselves to the index and get our array position - i = ccpp_field_idx_add(ccpp_cstr(standard_name), cdata%fields_idx) - if (i .lt. 1) then - call ccpp_warn('Unable to add field index: '//trim(standard_name)) - return - end if - - ! If optional index is specified, make sure it matches the return value - ! from ccpp_field_idx_add; if not, issue warning but allow to proceed - if (present(index)) then - if (index/=i) then - call ccpp_warn('Supplied index for adding variable ' // trim(standard_name) // & - ' does not match return value from ccpp_field_idx_add') - end if - end if - - ! Get the new fields max - new_fields_max = ccpp_field_idx_max(cdata%fields_idx) - - if (old_fields_max .lt. new_fields_max) then - allocate(tmp(new_fields_max), stat=ierr_local) - if (ierr_local /= 0) then - call ccpp_warn('Unable to grow cdata fields array') - if (present(ierr)) ierr=ierr_local - return - end if - tmp(1:size(cdata%fields)) = cdata%fields - call move_alloc(tmp, cdata%fields) - end if - - cdata%fields(i)%standard_name = standard_name - cdata%fields(i)%units = units - cdata%fields(i)%ptr = ptr - - if (present(rank)) then - cdata%fields(i)%rank = rank - else - cdata%fields(i)%rank = 0 - end if - - if (present(dims)) then - allocate(cdata%fields(i)%dims(rank), stat=ierr_local) - if (ierr_local /= 0) then - call ccpp_warn('Unable to allocate cdata fields dims') - if (present(ierr)) ierr=ierr_local - return - end if - cdata%fields(i)%dims = dims - end if - - if (present(kind)) then - cdata%fields(i)%kind = kind - else - cdata%fields(i)%kind = CCPP_GENERIC_KIND - end if - - if (present(ierr)) ierr=ierr_local - - end subroutine ccpp_field_add_ptr - - !> - !! CCPP fields retrieval subroutine. - !! - !! @param[in,out] cdata The ccpp_t type data. - !! @param[in ] standard_name The standard name for the data. - !! @param[ out] ptr A C pointer to the data. - !! @param[ out] ierr Integer error flag. - !! @param[ out] units Optional the SI units for the data. - !! @param[ out] rank Optional rank of the data. - !! @param[ out] dims Optional dimensions of the data. - ! - subroutine ccpp_field_get_ptr(cdata, standard_name, ptr, ierr, & - units, rank, dims, kind, index) - type(ccpp_t), intent(in) :: cdata - character(len=*), intent(in) :: standard_name - type(c_ptr), intent( out) :: ptr - integer, optional, intent( out) :: ierr - character(len=*), optional, intent( out) :: units - integer, optional, intent( out) :: rank - integer, allocatable, optional, intent( out) :: dims(:) - integer, optional, intent( out) :: kind - integer, optional, intent(in) :: index - - integer :: idx - integer :: ierr_local - - call ccpp_debug('Called ccpp_field_get_ptr for field ' // trim(standard_name)) - - ierr_local = 0 - - if (present(index)) then - if (index<=size(cdata%fields)) then - if (trim(standard_name)==trim(cdata%fields(index)%standard_name)) then - idx = index - call ccpp_debug('Found requested field ' // trim(standard_name) // ' at supplied index') - else - idx = ccpp_fields_find(cdata, standard_name, ierr_local) - call ccpp_warn('Could not find requested field ' // trim(standard_name) // & - ' at supplied index, falling back to standard search') - end if - else - idx = ccpp_fields_find(cdata, standard_name, ierr_local) - call ccpp_warn('Supplied index for requested field ' // trim(standard_name) // & - ' out of range, falling back to standard search') - end if - else - ! Lookup the standard name in the index - idx = ccpp_fields_find(cdata, standard_name, ierr_local) - call ccpp_info('No index supplied for requested field ' // trim(standard_name) // ', falling back to standard search') - end if - if (ierr_local /= 0) then - call ccpp_warn('Unable to find requested field ' // trim(standard_name)) - if (present(ierr)) ierr=ierr_local - return - end if - - ptr = cdata%fields(idx)%ptr - - if (present(units)) then - units = cdata%fields(idx)%units - end if - - if (present(rank)) then - rank = cdata%fields(idx)%rank - end if - - if (present(dims)) then - if (allocated(dims)) then - deallocate(dims) - end if - allocate(dims(cdata%fields(idx)%rank), stat=ierr_local) - if (ierr_local /= 0) then - call ccpp_warn('Unable to allocate cdata fields dims') - if (present(ierr)) ierr=ierr_local - return - end if - dims = cdata%fields(idx)%dims - end if - - if (present(kind)) then - kind = cdata%fields(idx)%kind - end if - - if (present(ierr)) ierr=ierr_local - - end subroutine ccpp_field_get_ptr - - - !> - !! CCPP find a fields location/array index by standard name. - !! - !! @param[in,out] cdata The ccpp_t type data. - !! @param[in ] standard_name The standard name for the data. - !! @param[ out] ierr Integer error flag. - ! - function ccpp_fields_find(cdata, standard_name, ierr) result(location) - type(ccpp_t), intent(in) :: cdata - character(len=*), intent(in) :: standard_name - integer, intent( out) :: ierr - - integer :: location - - location = ccpp_field_idx_find(ccpp_cstr(standard_name), & - cdata%fields_idx) - if (location <= 0) then - ierr = 1 - end if - - end function ccpp_fields_find - - ! TODO: Subroutine to iterate over all fields. - - - !------------------------------------------------------------------! - !> - !! Single precision (32-bit) integer field addition subroutines. - ! - !------------------------------------------------------------------! - subroutine ccpp_field_add_i32_0(cdata, standard_name, ptr, ierr, units, index) - type(ccpp_t), intent(inout) :: cdata - character(len=*), intent(in) :: standard_name - integer(kind=INT32), target, intent(in) :: ptr - integer, intent( out) :: ierr - character(len=*), optional, intent(in) :: units - integer, optional, intent(in) :: index - - ierr = 0 - call ccpp_field_add_ptr(cdata, standard_name, units, & - c_loc(ptr), kind=kind(ptr), index=index, ierr=ierr) - - end subroutine ccpp_field_add_i32_0 - - subroutine ccpp_field_add_i32_1(cdata, standard_name, ptr, ierr, units, index) - type(ccpp_t), intent(inout) :: cdata - character(len=*), intent(in) :: standard_name - integer(kind=INT32), target, intent(in) :: ptr(:) - integer, intent( out) :: ierr - character(len=*), optional, intent(in) :: units - integer, optional, intent(in) :: index - - ierr = 0 - call ccpp_field_add_ptr(cdata, standard_name, units, & - c_loc(ptr), size(shape(ptr)), shape(ptr), kind=kind(ptr), index=index, ierr=ierr) - - end subroutine ccpp_field_add_i32_1 - - subroutine ccpp_field_add_i32_2(cdata, standard_name, ptr, ierr, units, index) - type(ccpp_t), intent(inout) :: cdata - character(len=*), intent(in) :: standard_name - integer(kind=INT32), target, intent(in) :: ptr(:,:) - integer, intent( out) :: ierr - character(len=*), optional, intent(in) :: units - integer, optional, intent(in) :: index - - ierr = 0 - call ccpp_field_add_ptr(cdata, standard_name, units, & - c_loc(ptr), size(shape(ptr)), shape(ptr), kind=kind(ptr), index=index, ierr=ierr) - - end subroutine ccpp_field_add_i32_2 - - subroutine ccpp_field_add_i32_3(cdata, standard_name, ptr, ierr, units, index) - type(ccpp_t), intent(inout) :: cdata - character(len=*), intent(in) :: standard_name - integer(kind=INT32), target, intent(in) :: ptr(:,:,:) - integer, intent( out) :: ierr - character(len=*), optional, intent(in) :: units - integer, optional, intent(in) :: index - - ierr = 0 - call ccpp_field_add_ptr(cdata, standard_name, units, & - c_loc(ptr), size(shape(ptr)), shape(ptr), kind=kind(ptr), index=index, ierr=ierr) - - end subroutine ccpp_field_add_i32_3 - - subroutine ccpp_field_add_i32_4(cdata, standard_name, ptr, ierr, units, index) - type(ccpp_t), intent(inout) :: cdata - character(len=*), intent(in) :: standard_name - integer(kind=INT32), target, intent(in) :: ptr(:,:,:,:) - integer, intent( out) :: ierr - character(len=*), optional, intent(in) :: units - integer, optional, intent(in) :: index - - ierr = 0 - call ccpp_field_add_ptr(cdata, standard_name, units, & - c_loc(ptr), size(shape(ptr)), shape(ptr), kind=kind(ptr), index=index, ierr=ierr) - - end subroutine ccpp_field_add_i32_4 - - subroutine ccpp_field_add_i32_5(cdata, standard_name, ptr, ierr, units, index) - type(ccpp_t), intent(inout) :: cdata - character(len=*), intent(in) :: standard_name - integer(kind=INT32), target, intent(in) :: ptr(:,:,:,:,:) - integer, intent( out) :: ierr - character(len=*), optional, intent(in) :: units - integer, optional, intent(in) :: index - - ierr = 0 - call ccpp_field_add_ptr(cdata, standard_name, units, & - c_loc(ptr), size(shape(ptr)), shape(ptr), kind=kind(ptr), index=index, ierr=ierr) - - end subroutine ccpp_field_add_i32_5 - - subroutine ccpp_field_add_i32_6(cdata, standard_name, ptr, ierr, units, index) - type(ccpp_t), intent(inout) :: cdata - character(len=*), intent(in) :: standard_name - integer(kind=INT32), target, intent(in) :: ptr(:,:,:,:,:,:) - integer, intent( out) :: ierr - character(len=*), optional, intent(in) :: units - integer, optional, intent(in) :: index - - ierr = 0 - call ccpp_field_add_ptr(cdata, standard_name, units, & - c_loc(ptr), size(shape(ptr)), shape(ptr), kind=kind(ptr), index=index, ierr=ierr) - - end subroutine ccpp_field_add_i32_6 - - subroutine ccpp_field_add_i32_7(cdata, standard_name, ptr, ierr, units, index) - type(ccpp_t), intent(inout) :: cdata - character(len=*), intent(in) :: standard_name - integer(kind=INT32), target, intent(in) :: ptr(:,:,:,:,:,:,:) - integer, intent( out) :: ierr - character(len=*), optional, intent(in) :: units - integer, optional, intent(in) :: index - - ierr = 0 - call ccpp_field_add_ptr(cdata, standard_name, units, & - c_loc(ptr), size(shape(ptr)), shape(ptr), kind=kind(ptr), index=index, ierr=ierr) - - end subroutine ccpp_field_add_i32_7 - - !------------------------------------------------------------------! - !> - !! Double precision (64-bit) integer field addition subroutines. - ! - !------------------------------------------------------------------! - subroutine ccpp_field_add_i64_0(cdata, standard_name, ptr, ierr, units, index) - type(ccpp_t), intent(inout) :: cdata - character(len=*), intent(in) :: standard_name - integer(kind=INT64), target, intent(in) :: ptr - integer, intent( out) :: ierr - character(len=*), optional, intent(in) :: units - integer, optional, intent(in) :: index - - ierr = 0 - call ccpp_field_add_ptr(cdata, standard_name, units, & - c_loc(ptr), kind=kind(ptr), index=index, ierr=ierr) - - end subroutine ccpp_field_add_i64_0 - - subroutine ccpp_field_add_i64_1(cdata, standard_name, ptr, ierr, units, index) - type(ccpp_t), intent(inout) :: cdata - character(len=*), intent(in) :: standard_name - integer(kind=INT64), target, intent(in) :: ptr(:) - integer, intent( out) :: ierr - character(len=*), optional, intent(in) :: units - integer, optional, intent(in) :: index - - ierr = 0 - call ccpp_field_add_ptr(cdata, standard_name, units, & - c_loc(ptr), size(shape(ptr)), shape(ptr), kind=kind(ptr), index=index, ierr=ierr) - - end subroutine ccpp_field_add_i64_1 - - subroutine ccpp_field_add_i64_2(cdata, standard_name, ptr, ierr, units, index) - type(ccpp_t), intent(inout) :: cdata - character(len=*), intent(in) :: standard_name - integer(kind=INT64), target, intent(in) :: ptr(:,:) - integer, intent( out) :: ierr - character(len=*), optional, intent(in) :: units - integer, optional, intent(in) :: index - - ierr = 0 - call ccpp_field_add_ptr(cdata, standard_name, units, & - c_loc(ptr), size(shape(ptr)), shape(ptr), kind=kind(ptr), index=index, ierr=ierr) - - end subroutine ccpp_field_add_i64_2 - - subroutine ccpp_field_add_i64_3(cdata, standard_name, ptr, ierr, units, index) - type(ccpp_t), intent(inout) :: cdata - character(len=*), intent(in) :: standard_name - integer(kind=INT64), target, intent(in) :: ptr(:,:,:) - integer, intent( out) :: ierr - character(len=*), optional, intent(in) :: units - integer, optional, intent(in) :: index - - ierr = 0 - call ccpp_field_add_ptr(cdata, standard_name, units, & - c_loc(ptr), size(shape(ptr)), shape(ptr), kind=kind(ptr), index=index, ierr=ierr) - - end subroutine ccpp_field_add_i64_3 - - subroutine ccpp_field_add_i64_4(cdata, standard_name, ptr, ierr, units, index) - type(ccpp_t), intent(inout) :: cdata - character(len=*), intent(in) :: standard_name - integer(kind=INT64), target, intent(in) :: ptr(:,:,:,:) - integer, intent( out) :: ierr - character(len=*), optional, intent(in) :: units - integer, optional, intent(in) :: index - - ierr = 0 - call ccpp_field_add_ptr(cdata, standard_name, units, & - c_loc(ptr), size(shape(ptr)), shape(ptr), kind=kind(ptr), index=index, ierr=ierr) - - end subroutine ccpp_field_add_i64_4 - - subroutine ccpp_field_add_i64_5(cdata, standard_name, ptr, ierr, units, index) - type(ccpp_t), intent(inout) :: cdata - character(len=*), intent(in) :: standard_name - integer(kind=INT64), target, intent(in) :: ptr(:,:,:,:,:) - integer, intent( out) :: ierr - character(len=*), optional, intent(in) :: units - integer, optional, intent(in) :: index - - ierr = 0 - call ccpp_field_add_ptr(cdata, standard_name, units, & - c_loc(ptr), size(shape(ptr)), shape(ptr), kind=kind(ptr), index=index, ierr=ierr) - - end subroutine ccpp_field_add_i64_5 - - subroutine ccpp_field_add_i64_6(cdata, standard_name, ptr, ierr, units, index) - type(ccpp_t), intent(inout) :: cdata - character(len=*), intent(in) :: standard_name - integer(kind=INT64), target, intent(in) :: ptr(:,:,:,:,:,:) - integer, intent( out) :: ierr - character(len=*), optional, intent(in) :: units - integer, optional, intent(in) :: index - - ierr = 0 - call ccpp_field_add_ptr(cdata, standard_name, units, & - c_loc(ptr), size(shape(ptr)), shape(ptr), kind=kind(ptr), index=index, ierr=ierr) - - end subroutine ccpp_field_add_i64_6 - - subroutine ccpp_field_add_i64_7(cdata, standard_name, ptr, ierr, units, index) - type(ccpp_t), intent(inout) :: cdata - character(len=*), intent(in) :: standard_name - integer(kind=INT64), target, intent(in) :: ptr(:,:,:,:,:,:,:) - integer, intent( out) :: ierr - character(len=*), optional, intent(in) :: units - integer, optional, intent(in) :: index - - ierr = 0 - call ccpp_field_add_ptr(cdata, standard_name, units, & - c_loc(ptr), size(shape(ptr)), shape(ptr), kind=kind(ptr), index=index, ierr=ierr) - - end subroutine ccpp_field_add_i64_7 - - !------------------------------------------------------------------! - !> - !! Single precision (32-bit) real field addition subroutines. - ! - !------------------------------------------------------------------! - subroutine ccpp_field_add_r32_0(cdata, standard_name, ptr, ierr, units, index) - type(ccpp_t), intent(inout) :: cdata - character(len=*), intent(in) :: standard_name - real(kind=REAL32), target, intent(in) :: ptr - integer, intent( out) :: ierr - character(len=*), optional, intent(in) :: units - integer, optional, intent(in) :: index - - ierr = 0 - call ccpp_field_add_ptr(cdata, standard_name, units, & - c_loc(ptr), kind=kind(ptr), index=index, ierr=ierr) - - end subroutine ccpp_field_add_r32_0 - - subroutine ccpp_field_add_r32_1(cdata, standard_name, ptr, ierr, units, index) - type(ccpp_t), intent(inout) :: cdata - character(len=*), intent(in) :: standard_name - real(kind=REAL32), target, intent(in) :: ptr(:) - integer, intent( out) :: ierr - character(len=*), optional, intent(in) :: units - integer, optional, intent(in) :: index - - ierr = 0 - call ccpp_field_add_ptr(cdata, standard_name, units, & - c_loc(ptr), size(shape(ptr)), shape(ptr), kind=kind(ptr), index=index, ierr=ierr) - - end subroutine ccpp_field_add_r32_1 - - subroutine ccpp_field_add_r32_2(cdata, standard_name, ptr, ierr, units, index) - type(ccpp_t), intent(inout) :: cdata - character(len=*), intent(in) :: standard_name - real(kind=REAL32), target, intent(in) :: ptr(:,:) - integer, intent( out) :: ierr - character(len=*), optional, intent(in) :: units - integer, optional, intent(in) :: index - - ierr = 0 - call ccpp_field_add_ptr(cdata, standard_name, units, & - c_loc(ptr), size(shape(ptr)), shape(ptr), kind=kind(ptr), index=index, ierr=ierr) - - end subroutine ccpp_field_add_r32_2 - - subroutine ccpp_field_add_r32_3(cdata, standard_name, ptr, ierr, units, index) - type(ccpp_t), intent(inout) :: cdata - character(len=*), intent(in) :: standard_name - real(kind=REAL32), target, intent(in) :: ptr(:,:,:) - integer, intent( out) :: ierr - character(len=*), optional, intent(in) :: units - integer, optional, intent(in) :: index - - ierr = 0 - call ccpp_field_add_ptr(cdata, standard_name, units, & - c_loc(ptr), size(shape(ptr)), shape(ptr), kind=kind(ptr), index=index, ierr=ierr) - - end subroutine ccpp_field_add_r32_3 - - subroutine ccpp_field_add_r32_4(cdata, standard_name, ptr, ierr, units, index) - type(ccpp_t), intent(inout) :: cdata - character(len=*), intent(in) :: standard_name - real(kind=REAL32), target, intent(in) :: ptr(:,:,:,:) - integer, intent( out) :: ierr - character(len=*), optional, intent(in) :: units - integer, optional, intent(in) :: index - - ierr = 0 - call ccpp_field_add_ptr(cdata, standard_name, units, & - c_loc(ptr), size(shape(ptr)), shape(ptr), kind=kind(ptr), index=index, ierr=ierr) - - end subroutine ccpp_field_add_r32_4 - - subroutine ccpp_field_add_r32_5(cdata, standard_name, ptr, ierr, units, index) - type(ccpp_t), intent(inout) :: cdata - character(len=*), intent(in) :: standard_name - real(kind=REAL32), target, intent(in) :: ptr(:,:,:,:,:) - integer, intent( out) :: ierr - character(len=*), optional, intent(in) :: units - integer, optional, intent(in) :: index - - ierr = 0 - call ccpp_field_add_ptr(cdata, standard_name, units, & - c_loc(ptr), size(shape(ptr)), shape(ptr), kind=kind(ptr), index=index, ierr=ierr) - - end subroutine ccpp_field_add_r32_5 - - subroutine ccpp_field_add_r32_6(cdata, standard_name, ptr, ierr, units, index) - type(ccpp_t), intent(inout) :: cdata - character(len=*), intent(in) :: standard_name - real(kind=REAL32), target, intent(in) :: ptr(:,:,:,:,:,:) - integer, intent( out) :: ierr - character(len=*), optional, intent(in) :: units - integer, optional, intent(in) :: index - - ierr = 0 - call ccpp_field_add_ptr(cdata, standard_name, units, & - c_loc(ptr), size(shape(ptr)), shape(ptr), kind=kind(ptr), index=index, ierr=ierr) - - end subroutine ccpp_field_add_r32_6 - - subroutine ccpp_field_add_r32_7(cdata, standard_name, ptr, ierr, units, index) - type(ccpp_t), intent(inout) :: cdata - character(len=*), intent(in) :: standard_name - real(kind=REAL32), target, intent(in) :: ptr(:,:,:,:,:,:,:) - integer, intent( out) :: ierr - character(len=*), optional, intent(in) :: units - integer, optional, intent(in) :: index - - ierr = 0 - call ccpp_field_add_ptr(cdata, standard_name, units, & - c_loc(ptr), size(shape(ptr)), shape(ptr), kind=kind(ptr), index=index, ierr=ierr) - - end subroutine ccpp_field_add_r32_7 - - !------------------------------------------------------------------! - !> - !! Double precision (64-bit) real field addition subroutines. - ! - !------------------------------------------------------------------! - subroutine ccpp_field_add_r64_0(cdata, standard_name, ptr, ierr, units, index) - type(ccpp_t), intent(inout) :: cdata - character(len=*), intent(in) :: standard_name - real(kind=REAL64), target, intent(in) :: ptr - integer, intent( out) :: ierr - character(len=*), optional, intent(in) :: units - integer, optional, intent(in) :: index - - ierr = 0 - call ccpp_field_add_ptr(cdata, standard_name, units, & - c_loc(ptr), kind=kind(ptr), index=index, ierr=ierr) - - end subroutine ccpp_field_add_r64_0 - - subroutine ccpp_field_add_r64_1(cdata, standard_name, ptr, ierr, units, index) - type(ccpp_t), intent(inout) :: cdata - character(len=*), intent(in) :: standard_name - real(kind=REAL64), target, intent(in) :: ptr(:) - integer, intent( out) :: ierr - character(len=*), optional, intent(in) :: units - integer, optional, intent(in) :: index - - ierr = 0 - call ccpp_field_add_ptr(cdata, standard_name, units, & - c_loc(ptr), size(shape(ptr)), shape(ptr), kind=kind(ptr), index=index, ierr=ierr) - - end subroutine ccpp_field_add_r64_1 - - subroutine ccpp_field_add_r64_2(cdata, standard_name, ptr, ierr, units, index) - type(ccpp_t), intent(inout) :: cdata - character(len=*), intent(in) :: standard_name - real(kind=REAL64), target, intent(in) :: ptr(:,:) - integer, intent( out) :: ierr - character(len=*), optional, intent(in) :: units - integer, optional, intent(in) :: index - - ierr = 0 - call ccpp_field_add_ptr(cdata, standard_name, units, & - c_loc(ptr), size(shape(ptr)), shape(ptr), kind=kind(ptr), index=index, ierr=ierr) - - end subroutine ccpp_field_add_r64_2 - - subroutine ccpp_field_add_r64_3(cdata, standard_name, ptr, ierr, units, index) - type(ccpp_t), intent(inout) :: cdata - character(len=*), intent(in) :: standard_name - real(kind=REAL64), target, intent(in) :: ptr(:,:,:) - integer, intent( out) :: ierr - character(len=*), optional, intent(in) :: units - integer, optional, intent(in) :: index - - ierr = 0 - call ccpp_field_add_ptr(cdata, standard_name, units, & - c_loc(ptr), size(shape(ptr)), shape(ptr), kind=kind(ptr), index=index, ierr=ierr) - - end subroutine ccpp_field_add_r64_3 - - subroutine ccpp_field_add_r64_4(cdata, standard_name, ptr, ierr, units, index) - type(ccpp_t), intent(inout) :: cdata - character(len=*), intent(in) :: standard_name - real(kind=REAL64), target, intent(in) :: ptr(:,:,:,:) - integer, intent( out) :: ierr - character(len=*), optional, intent(in) :: units - integer, optional, intent(in) :: index - - ierr = 0 - call ccpp_field_add_ptr(cdata, standard_name, units, & - c_loc(ptr), size(shape(ptr)), shape(ptr), kind=kind(ptr), index=index, ierr=ierr) - - end subroutine ccpp_field_add_r64_4 - - subroutine ccpp_field_add_r64_5(cdata, standard_name, ptr, ierr, units, index) - type(ccpp_t), intent(inout) :: cdata - character(len=*), intent(in) :: standard_name - real(kind=REAL64), target, intent(in) :: ptr(:,:,:,:,:) - integer, intent( out) :: ierr - character(len=*), optional, intent(in) :: units - integer, optional, intent(in) :: index - - ierr = 0 - call ccpp_field_add_ptr(cdata, standard_name, units, & - c_loc(ptr), size(shape(ptr)), shape(ptr), kind=kind(ptr), index=index, ierr=ierr) - - end subroutine ccpp_field_add_r64_5 - - subroutine ccpp_field_add_r64_6(cdata, standard_name, ptr, ierr, units, index) - type(ccpp_t), intent(inout) :: cdata - character(len=*), intent(in) :: standard_name - real(kind=REAL64), target, intent(in) :: ptr(:,:,:,:,:,:) - integer, intent( out) :: ierr - character(len=*), optional, intent(in) :: units - integer, optional, intent(in) :: index - - ierr = 0 - call ccpp_field_add_ptr(cdata, standard_name, units, & - c_loc(ptr), size(shape(ptr)), shape(ptr), kind=kind(ptr), index=index, ierr=ierr) - - end subroutine ccpp_field_add_r64_6 - - subroutine ccpp_field_add_r64_7(cdata, standard_name, ptr, ierr, units, index) - type(ccpp_t), intent(inout) :: cdata - character(len=*), intent(in) :: standard_name - real(kind=REAL64), target, intent(in) :: ptr(:,:,:,:,:,:,:) - integer, intent( out) :: ierr - character(len=*), optional, intent(in) :: units - integer, optional, intent(in) :: index - - ierr = 0 - call ccpp_field_add_ptr(cdata, standard_name, units, & - c_loc(ptr), size(shape(ptr)), shape(ptr), kind=kind(ptr), index=index, ierr=ierr) - - end subroutine ccpp_field_add_r64_7 - - !------------------------------------------------------------------! - !> - !! Logical field addition subroutines. - ! - !------------------------------------------------------------------! - subroutine ccpp_field_add_l_0(cdata, standard_name, ptr, ierr, units, index) - type(ccpp_t), intent(inout) :: cdata - character(len=*), intent(in) :: standard_name - logical, target, intent(in) :: ptr - integer, intent( out) :: ierr - character(len=*), optional, intent(in) :: units - integer, optional, intent(in) :: index - - ierr = 0 - call ccpp_field_add_ptr(cdata, standard_name, units, & - c_loc(ptr), kind=kind(ptr), index=index, ierr=ierr) - - end subroutine ccpp_field_add_l_0 - - subroutine ccpp_field_add_l_1(cdata, standard_name, ptr, ierr, units, index) - type(ccpp_t), intent(inout) :: cdata - character(len=*), intent(in) :: standard_name - logical, target, intent(in) :: ptr(:) - integer, intent( out) :: ierr - character(len=*), optional, intent(in) :: units - integer, optional, intent(in) :: index - - ierr = 0 - call ccpp_field_add_ptr(cdata, standard_name, units, & - c_loc(ptr), size(shape(ptr)), shape(ptr), kind=kind(ptr), index=index, ierr=ierr) - - end subroutine ccpp_field_add_l_1 - - subroutine ccpp_field_add_l_2(cdata, standard_name, ptr, ierr, units, index) - type(ccpp_t), intent(inout) :: cdata - character(len=*), intent(in) :: standard_name - logical, target, intent(in) :: ptr(:,:) - integer, intent( out) :: ierr - character(len=*), optional, intent(in) :: units - integer, optional, intent(in) :: index - - ierr = 0 - call ccpp_field_add_ptr(cdata, standard_name, units, & - c_loc(ptr), size(shape(ptr)), shape(ptr), kind=kind(ptr), index=index, ierr=ierr) - - end subroutine ccpp_field_add_l_2 - - subroutine ccpp_field_add_l_3(cdata, standard_name, ptr, ierr, units, index) - type(ccpp_t), intent(inout) :: cdata - character(len=*), intent(in) :: standard_name - logical, target, intent(in) :: ptr(:,:,:) - integer, intent( out) :: ierr - character(len=*), optional, intent(in) :: units - integer, optional, intent(in) :: index - - ierr = 0 - call ccpp_field_add_ptr(cdata, standard_name, units, & - c_loc(ptr), size(shape(ptr)), shape(ptr), kind=kind(ptr), index=index, ierr=ierr) - - end subroutine ccpp_field_add_l_3 - - subroutine ccpp_field_add_l_4(cdata, standard_name, ptr, ierr, units, index) - type(ccpp_t), intent(inout) :: cdata - character(len=*), intent(in) :: standard_name - logical, target, intent(in) :: ptr(:,:,:,:) - integer, intent( out) :: ierr - character(len=*), optional, intent(in) :: units - integer, optional, intent(in) :: index - - ierr = 0 - call ccpp_field_add_ptr(cdata, standard_name, units, & - c_loc(ptr), size(shape(ptr)), shape(ptr), kind=kind(ptr), index=index, ierr=ierr) - - end subroutine ccpp_field_add_l_4 - - subroutine ccpp_field_add_l_5(cdata, standard_name, ptr, ierr, units, index) - type(ccpp_t), intent(inout) :: cdata - character(len=*), intent(in) :: standard_name - logical, target, intent(in) :: ptr(:,:,:,:,:) - integer, intent( out) :: ierr - character(len=*), optional, intent(in) :: units - integer, optional, intent(in) :: index - - ierr = 0 - call ccpp_field_add_ptr(cdata, standard_name, units, & - c_loc(ptr), size(shape(ptr)), shape(ptr), kind=kind(ptr), index=index, ierr=ierr) - - end subroutine ccpp_field_add_l_5 - - subroutine ccpp_field_add_l_6(cdata, standard_name, ptr, ierr, units, index) - type(ccpp_t), intent(inout) :: cdata - character(len=*), intent(in) :: standard_name - logical, target, intent(in) :: ptr(:,:,:,:,:,:) - integer, intent( out) :: ierr - character(len=*), optional, intent(in) :: units - integer, optional, intent(in) :: index - - ierr = 0 - call ccpp_field_add_ptr(cdata, standard_name, units, & - c_loc(ptr), size(shape(ptr)), shape(ptr), kind=kind(ptr), index=index, ierr=ierr) - - end subroutine ccpp_field_add_l_6 - - subroutine ccpp_field_add_l_7(cdata, standard_name, ptr, ierr, units, index) - type(ccpp_t), intent(inout) :: cdata - character(len=*), intent(in) :: standard_name - logical, target, intent(in) :: ptr(:,:,:,:,:,:,:) - integer, intent( out) :: ierr - character(len=*), optional, intent(in) :: units - integer, optional, intent(in) :: index - - ierr = 0 - call ccpp_field_add_ptr(cdata, standard_name, units, & - c_loc(ptr), size(shape(ptr)), shape(ptr), kind=kind(ptr), index=index, ierr=ierr) - - end subroutine ccpp_field_add_l_7 - - !------------------------------------------------------------------! - !> - !! Character field addition subroutines. - ! - !------------------------------------------------------------------! - subroutine ccpp_field_add_c_0(cdata, standard_name, ptr, ierr, units, index) - type(ccpp_t), intent(inout) :: cdata - character(len=*), intent(in) :: standard_name - character(len=*), target, intent(in) :: ptr - integer, intent( out) :: ierr - character(len=*), optional, intent(in) :: units - integer, optional, intent(in) :: index - - ierr = 0 - call ccpp_field_add_ptr(cdata, standard_name, units, & - c_loc(ptr), kind=kind(ptr), index=index, ierr=ierr) - - end subroutine ccpp_field_add_c_0 - - subroutine ccpp_field_add_c_1(cdata, standard_name, ptr, ierr, units, index) - type(ccpp_t), intent(inout) :: cdata - character(len=*), intent(in) :: standard_name - character(len=*), target, intent(in) :: ptr(:) - integer, intent( out) :: ierr - character(len=*), optional, intent(in) :: units - integer, optional, intent(in) :: index - - ierr = 0 - call ccpp_field_add_ptr(cdata, standard_name, units, & - c_loc(ptr), size(shape(ptr)), shape(ptr), kind=kind(ptr), index=index, ierr=ierr) - - end subroutine ccpp_field_add_c_1 - - !------------------------------------------------------------------! - !> - !! Single precision (32-bit) integer field retrieval subroutines. - ! - !------------------------------------------------------------------! - subroutine ccpp_field_get_i32_0(cdata, standard_name, ptr, ierr, units, rank, kind, index) - type(ccpp_t), intent(in) :: cdata - character(len=*), intent(in) :: standard_name - integer(kind=INT32), pointer, intent( out) :: ptr - integer, intent( out) :: ierr - character(len=*), optional, intent( out) :: units - integer, optional, intent( out) :: rank - integer, optional, intent( out) :: kind - integer, optional, intent(in) :: index - - integer :: idx - type(c_ptr) :: cptr - - ierr = 0 - call ccpp_field_get_ptr(cdata, standard_name, cptr, ierr=ierr, & - units=units, rank=rank, kind=kind, index=index) - - if (ierr /=0) return - - call c_f_pointer(cptr, ptr) - - end subroutine ccpp_field_get_i32_0 - - subroutine ccpp_field_get_i32_1(cdata, standard_name, ptr, ierr, units, rank, dims, kind, index) - type(ccpp_t), intent(in) :: cdata - character(len=*), intent(in) :: standard_name - integer(kind=INT32), pointer, intent( out) :: ptr(:) - integer, intent( out) :: ierr - character(len=*), optional, intent( out) :: units - integer, optional, intent( out) :: rank - integer, allocatable, optional, intent( out) :: dims(:) - integer, optional, intent( out) :: kind - integer, optional, intent(in) :: index - - integer :: idx - type(c_ptr) :: cptr - - ierr = 0 - call ccpp_field_get_ptr(cdata, standard_name, cptr, ierr=ierr, & - units=units, rank=rank, dims=dims, kind=kind, index=index) - - if (ierr /=0) return - - call c_f_pointer(cptr, ptr, dims) - - end subroutine ccpp_field_get_i32_1 - - subroutine ccpp_field_get_i32_2(cdata, standard_name, ptr, ierr, units, rank, dims, kind, index) - type(ccpp_t), intent(in) :: cdata - character(len=*), intent(in) :: standard_name - integer(kind=INT32), pointer, intent( out) :: ptr(:,:) - integer, intent( out) :: ierr - character(len=*), optional, intent( out) :: units - integer, optional, intent( out) :: rank - integer, allocatable, optional, intent( out) :: dims(:) - integer, optional, intent( out) :: kind - integer, optional, intent(in) :: index - - integer :: idx - type(c_ptr) :: cptr - - ierr = 0 - call ccpp_field_get_ptr(cdata, standard_name, cptr, ierr=ierr, & - units=units, rank=rank, dims=dims, kind=kind, index=index) - - if (ierr /=0) return - - call c_f_pointer(cptr, ptr, dims) - - end subroutine ccpp_field_get_i32_2 - - subroutine ccpp_field_get_i32_3(cdata, standard_name, ptr, ierr, units, rank, dims, kind, index) - type(ccpp_t), intent(in) :: cdata - character(len=*), intent(in) :: standard_name - integer(kind=INT32), pointer, intent( out) :: ptr(:,:,:) - integer, intent( out) :: ierr - character(len=*), optional, intent( out) :: units - integer, optional, intent( out) :: rank - integer, allocatable, optional, intent( out) :: dims(:) - integer, optional, intent( out) :: kind - integer, optional, intent(in) :: index - - integer :: idx - type(c_ptr) :: cptr - - ierr = 0 - call ccpp_field_get_ptr(cdata, standard_name, cptr, ierr=ierr, & - units=units, rank=rank, dims=dims, kind=kind, index=index) - - if (ierr /=0) return - - call c_f_pointer(cptr, ptr, dims) - - end subroutine ccpp_field_get_i32_3 - - subroutine ccpp_field_get_i32_4(cdata, standard_name, ptr, ierr, units, rank, dims, kind, index) - type(ccpp_t), intent(in) :: cdata - character(len=*), intent(in) :: standard_name - integer(kind=INT32), pointer, intent( out) :: ptr(:,:,:,:) - integer, intent( out) :: ierr - character(len=*), optional, intent( out) :: units - integer, optional, intent( out) :: rank - integer, allocatable, optional, intent( out) :: dims(:) - integer, optional, intent( out) :: kind - integer, optional, intent(in) :: index - - integer :: idx - type(c_ptr) :: cptr - - ierr = 0 - call ccpp_field_get_ptr(cdata, standard_name, cptr, ierr=ierr, & - units=units, rank=rank, dims=dims, kind=kind, index=index) - - if (ierr /=0) return - - call c_f_pointer(cptr, ptr, dims) - - end subroutine ccpp_field_get_i32_4 - - subroutine ccpp_field_get_i32_5(cdata, standard_name, ptr, ierr, units, rank, dims, kind, index) - type(ccpp_t), intent(in) :: cdata - character(len=*), intent(in) :: standard_name - integer(kind=INT32), pointer, intent( out) :: ptr(:,:,:,:,:) - integer, intent( out) :: ierr - character(len=*), optional, intent( out) :: units - integer, optional, intent( out) :: rank - integer, allocatable, optional, intent( out) :: dims(:) - integer, optional, intent( out) :: kind - integer, optional, intent(in) :: index - - integer :: idx - type(c_ptr) :: cptr - - ierr = 0 - call ccpp_field_get_ptr(cdata, standard_name, cptr, ierr=ierr, & - units=units, rank=rank, dims=dims, kind=kind, index=index) - - if (ierr /=0) return - - call c_f_pointer(cptr, ptr, dims) - - end subroutine ccpp_field_get_i32_5 - - subroutine ccpp_field_get_i32_6(cdata, standard_name, ptr, ierr, units, rank, dims, kind, index) - type(ccpp_t), intent(in) :: cdata - character(len=*), intent(in) :: standard_name - integer(kind=INT32), pointer, intent( out) :: ptr(:,:,:,:,:,:) - integer, intent( out) :: ierr - character(len=*), optional, intent( out) :: units - integer, optional, intent( out) :: rank - integer, allocatable, optional, intent( out) :: dims(:) - integer, optional, intent( out) :: kind - integer, optional, intent(in) :: index - - integer :: idx - type(c_ptr) :: cptr - - ierr = 0 - call ccpp_field_get_ptr(cdata, standard_name, cptr, ierr=ierr, & - units=units, rank=rank, dims=dims, kind=kind, index=index) - - if (ierr /=0) return - - call c_f_pointer(cptr, ptr, dims) - - end subroutine ccpp_field_get_i32_6 - - subroutine ccpp_field_get_i32_7(cdata, standard_name, ptr, ierr, units, rank, dims, kind, index) - type(ccpp_t), intent(in) :: cdata - character(len=*), intent(in) :: standard_name - integer(kind=INT32), pointer, intent( out) :: ptr(:,:,:,:,:,:,:) - integer, intent( out) :: ierr - character(len=*), optional, intent( out) :: units - integer, optional, intent( out) :: rank - integer, allocatable, optional, intent( out) :: dims(:) - integer, optional, intent( out) :: kind - integer, optional, intent(in) :: index - - integer :: idx - type(c_ptr) :: cptr - - ierr = 0 - call ccpp_field_get_ptr(cdata, standard_name, cptr, ierr=ierr, & - units=units, rank=rank, dims=dims, kind=kind, index=index) - - if (ierr /=0) return - - call c_f_pointer(cptr, ptr, dims) - - end subroutine ccpp_field_get_i32_7 - - !------------------------------------------------------------------! - !> - !! Double precision (64-bit) integer field retrieval subroutines. - ! - !------------------------------------------------------------------! - subroutine ccpp_field_get_i64_0(cdata, standard_name, ptr, ierr, units, rank, kind, index) - type(ccpp_t), intent(in) :: cdata - character(len=*), intent(in) :: standard_name - integer(kind=INT64), pointer, intent( out) :: ptr - integer, intent( out) :: ierr - character(len=*), optional, intent( out) :: units - integer, optional, intent( out) :: rank - integer, optional, intent( out) :: kind - integer, optional, intent(in) :: index - - integer :: idx - type(c_ptr) :: cptr - - ierr = 0 - call ccpp_field_get_ptr(cdata, standard_name, cptr, ierr=ierr, & - units=units, rank=rank, kind=kind, index=index) - - if (ierr /=0) return - - call c_f_pointer(cptr, ptr) - - end subroutine ccpp_field_get_i64_0 - - subroutine ccpp_field_get_i64_1(cdata, standard_name, ptr, ierr, units, rank, dims, kind, index) - type(ccpp_t), intent(in) :: cdata - character(len=*), intent(in) :: standard_name - integer(kind=INT64), pointer, intent( out) :: ptr(:) - integer, intent( out) :: ierr - character(len=*), optional, intent( out) :: units - integer, optional, intent( out) :: rank - integer, allocatable, optional, intent( out) :: dims(:) - integer, optional, intent( out) :: kind - integer, optional, intent(in) :: index - - integer :: idx - type(c_ptr) :: cptr - - ierr = 0 - call ccpp_field_get_ptr(cdata, standard_name, cptr, ierr=ierr, & - units=units, rank=rank, dims=dims, kind=kind, index=index) - - if (ierr /=0) return - - call c_f_pointer(cptr, ptr, dims) - - end subroutine ccpp_field_get_i64_1 - - subroutine ccpp_field_get_i64_2(cdata, standard_name, ptr, ierr, units, rank, dims, kind, index) - type(ccpp_t), intent(in) :: cdata - character(len=*), intent(in) :: standard_name - integer(kind=INT64), pointer, intent( out) :: ptr(:,:) - integer, intent( out) :: ierr - character(len=*), optional, intent( out) :: units - integer, optional, intent( out) :: rank - integer, allocatable, optional, intent( out) :: dims(:) - integer, optional, intent( out) :: kind - integer, optional, intent(in) :: index - - integer :: idx - type(c_ptr) :: cptr - - ierr = 0 - call ccpp_field_get_ptr(cdata, standard_name, cptr, ierr=ierr, & - units=units, rank=rank, dims=dims, kind=kind, index=index) - - if (ierr /=0) return - - call c_f_pointer(cptr, ptr, dims) - - end subroutine ccpp_field_get_i64_2 - - subroutine ccpp_field_get_i64_3(cdata, standard_name, ptr, ierr, units, rank, dims, kind, index) - type(ccpp_t), intent(in) :: cdata - character(len=*), intent(in) :: standard_name - integer(kind=INT64), pointer, intent( out) :: ptr(:,:,:) - integer, intent( out) :: ierr - character(len=*), optional, intent( out) :: units - integer, optional, intent( out) :: rank - integer, allocatable, optional, intent( out) :: dims(:) - integer, optional, intent( out) :: kind - integer, optional, intent(in) :: index - - integer :: idx - type(c_ptr) :: cptr - - ierr = 0 - call ccpp_field_get_ptr(cdata, standard_name, cptr, ierr=ierr, & - units=units, rank=rank, dims=dims, kind=kind, index=index) - - if (ierr /=0) return - - call c_f_pointer(cptr, ptr, dims) - - end subroutine ccpp_field_get_i64_3 - - subroutine ccpp_field_get_i64_4(cdata, standard_name, ptr, ierr, units, rank, dims, kind, index) - type(ccpp_t), intent(in) :: cdata - character(len=*), intent(in) :: standard_name - integer(kind=INT64), pointer, intent( out) :: ptr(:,:,:,:) - integer, intent( out) :: ierr - character(len=*), optional, intent( out) :: units - integer, optional, intent( out) :: rank - integer, allocatable, optional, intent( out) :: dims(:) - integer, optional, intent( out) :: kind - integer, optional, intent(in) :: index - - integer :: idx - type(c_ptr) :: cptr - - ierr = 0 - call ccpp_field_get_ptr(cdata, standard_name, cptr, ierr=ierr, & - units=units, rank=rank, dims=dims, kind=kind, index=index) - - if (ierr /=0) return - - call c_f_pointer(cptr, ptr, dims) - - end subroutine ccpp_field_get_i64_4 - - subroutine ccpp_field_get_i64_5(cdata, standard_name, ptr, ierr, units, rank, dims, kind, index) - type(ccpp_t), intent(in) :: cdata - character(len=*), intent(in) :: standard_name - integer(kind=INT64), pointer, intent( out) :: ptr(:,:,:,:,:) - integer, intent( out) :: ierr - character(len=*), optional, intent( out) :: units - integer, optional, intent( out) :: rank - integer, allocatable, optional, intent( out) :: dims(:) - integer, optional, intent( out) :: kind - integer, optional, intent(in) :: index - - integer :: idx - type(c_ptr) :: cptr - - ierr = 0 - call ccpp_field_get_ptr(cdata, standard_name, cptr, ierr=ierr, & - units=units, rank=rank, dims=dims, kind=kind, index=index) - - if (ierr /=0) return - - call c_f_pointer(cptr, ptr, dims) - - end subroutine ccpp_field_get_i64_5 - - subroutine ccpp_field_get_i64_6(cdata, standard_name, ptr, ierr, units, rank, dims, kind, index) - type(ccpp_t), intent(in) :: cdata - character(len=*), intent(in) :: standard_name - integer(kind=INT64), pointer, intent( out) :: ptr(:,:,:,:,:,:) - integer, intent( out) :: ierr - character(len=*), optional, intent( out) :: units - integer, optional, intent( out) :: rank - integer, allocatable, optional, intent( out) :: dims(:) - integer, optional, intent( out) :: kind - integer, optional, intent(in) :: index - - integer :: idx - type(c_ptr) :: cptr - - ierr = 0 - call ccpp_field_get_ptr(cdata, standard_name, cptr, ierr=ierr, & - units=units, rank=rank, dims=dims, kind=kind, index=index) - - if (ierr /=0) return - - call c_f_pointer(cptr, ptr, dims) - - end subroutine ccpp_field_get_i64_6 - - subroutine ccpp_field_get_i64_7(cdata, standard_name, ptr, ierr, units, rank, dims, kind, index) - type(ccpp_t), intent(in) :: cdata - character(len=*), intent(in) :: standard_name - integer(kind=INT64), pointer, intent( out) :: ptr(:,:,:,:,:,:,:) - integer, intent( out) :: ierr - character(len=*), optional, intent( out) :: units - integer, optional, intent( out) :: rank - integer, allocatable, optional, intent( out) :: dims(:) - integer, optional, intent( out) :: kind - integer, optional, intent(in) :: index - - integer :: idx - type(c_ptr) :: cptr - - ierr = 0 - call ccpp_field_get_ptr(cdata, standard_name, cptr, ierr=ierr, & - units=units, rank=rank, dims=dims, kind=kind, index=index) - - if (ierr /=0) return - - call c_f_pointer(cptr, ptr, dims) - - end subroutine ccpp_field_get_i64_7 - - !------------------------------------------------------------------! - !> - !! Single precision (32-bit) real field retrieval subroutines. - ! - !------------------------------------------------------------------! - subroutine ccpp_field_get_r32_0(cdata, standard_name, ptr, ierr, units, rank, kind, index) - type(ccpp_t), intent(in) :: cdata - character(len=*), intent(in) :: standard_name - real(kind=REAL32), pointer, intent( out) :: ptr - integer, intent( out) :: ierr - character(len=*), optional, intent( out) :: units - integer, optional, intent( out) :: rank - integer, optional, intent( out) :: kind - integer, optional, intent(in) :: index - - integer :: idx - type(c_ptr) :: cptr - - ierr = 0 - call ccpp_field_get_ptr(cdata, standard_name, cptr, ierr=ierr, & - units=units, rank=rank, kind=kind, index=index) - - if (ierr /=0) return - - call c_f_pointer(cptr, ptr) - - end subroutine ccpp_field_get_r32_0 - - subroutine ccpp_field_get_r32_1(cdata, standard_name, ptr, ierr, units, rank, dims, kind, index) - type(ccpp_t), intent(in) :: cdata - character(len=*), intent(in) :: standard_name - real(kind=REAL32), pointer, intent( out) :: ptr(:) - integer, intent( out) :: ierr - character(len=*), optional, intent( out) :: units - integer, optional, intent( out) :: rank - integer, allocatable, optional, intent( out) :: dims(:) - integer, optional, intent( out) :: kind - integer, optional, intent(in) :: index - - integer :: idx - type(c_ptr) :: cptr - - ierr = 0 - call ccpp_field_get_ptr(cdata, standard_name, cptr, ierr=ierr, & - units=units, rank=rank, dims=dims, kind=kind, index=index) - - if (ierr /=0) return - - call c_f_pointer(cptr, ptr, dims) - - end subroutine ccpp_field_get_r32_1 - - subroutine ccpp_field_get_r32_2(cdata, standard_name, ptr, ierr, units, rank, dims, kind, index) - type(ccpp_t), intent(in) :: cdata - character(len=*), intent(in) :: standard_name - real(kind=REAL32), pointer, intent( out) :: ptr(:,:) - integer, intent( out) :: ierr - character(len=*), optional, intent( out) :: units - integer, optional, intent( out) :: rank - integer, allocatable, optional, intent( out) :: dims(:) - integer, optional, intent( out) :: kind - integer, optional, intent(in) :: index - - integer :: idx - type(c_ptr) :: cptr - - ierr = 0 - call ccpp_field_get_ptr(cdata, standard_name, cptr, ierr=ierr, & - units=units, rank=rank, dims=dims, kind=kind, index=index) - if (ierr /=0) return - - call c_f_pointer(cptr, ptr, dims) - - end subroutine ccpp_field_get_r32_2 - - subroutine ccpp_field_get_r32_3(cdata, standard_name, ptr, ierr, units, rank, dims, kind, index) - type(ccpp_t), intent(in) :: cdata - character(len=*), intent(in) :: standard_name - real(kind=REAL32), pointer, intent( out) :: ptr(:,:,:) - integer, intent( out) :: ierr - character(len=*), optional, intent( out) :: units - integer, optional, intent( out) :: rank - integer, allocatable, optional, intent( out) :: dims(:) - integer, optional, intent( out) :: kind - integer, optional, intent(in) :: index - - integer :: idx - type(c_ptr) :: cptr - - ierr = 0 - call ccpp_field_get_ptr(cdata, standard_name, cptr, ierr=ierr, & - units=units, rank=rank, dims=dims, kind=kind, index=index) - - if (ierr /=0) return - - call c_f_pointer(cptr, ptr, dims) - - end subroutine ccpp_field_get_r32_3 - - subroutine ccpp_field_get_r32_4(cdata, standard_name, ptr, ierr, units, rank, dims, kind, index) - type(ccpp_t), intent(in) :: cdata - character(len=*), intent(in) :: standard_name - real(kind=REAL32), pointer, intent( out) :: ptr(:,:,:,:) - integer, intent( out) :: ierr - character(len=*), optional, intent( out) :: units - integer, optional, intent( out) :: rank - integer, allocatable, optional, intent( out) :: dims(:) - integer, optional, intent( out) :: kind - integer, optional, intent(in) :: index - - integer :: idx - type(c_ptr) :: cptr - - ierr = 0 - call ccpp_field_get_ptr(cdata, standard_name, cptr, ierr=ierr, & - units=units, rank=rank, dims=dims, kind=kind, index=index) - - if (ierr /=0) return - - call c_f_pointer(cptr, ptr, dims) - - end subroutine ccpp_field_get_r32_4 - - subroutine ccpp_field_get_r32_5(cdata, standard_name, ptr, ierr, units, rank, dims, kind, index) - type(ccpp_t), intent(in) :: cdata - character(len=*), intent(in) :: standard_name - real(kind=REAL32), pointer, intent( out) :: ptr(:,:,:,:,:) - integer, intent( out) :: ierr - character(len=*), optional, intent( out) :: units - integer, optional, intent( out) :: rank - integer, allocatable, optional, intent( out) :: dims(:) - integer, optional, intent( out) :: kind - integer, optional, intent(in) :: index - - integer :: idx - type(c_ptr) :: cptr - - ierr = 0 - call ccpp_field_get_ptr(cdata, standard_name, cptr, ierr=ierr, & - units=units, rank=rank, dims=dims, kind=kind, index=index) - - if (ierr /=0) return - - call c_f_pointer(cptr, ptr, dims) - - end subroutine ccpp_field_get_r32_5 - - subroutine ccpp_field_get_r32_6(cdata, standard_name, ptr, ierr, units, rank, dims, kind, index) - type(ccpp_t), intent(in) :: cdata - character(len=*), intent(in) :: standard_name - real(kind=REAL32), pointer, intent( out) :: ptr(:,:,:,:,:,:) - integer, intent( out) :: ierr - character(len=*), optional, intent( out) :: units - integer, optional, intent( out) :: rank - integer, allocatable, optional, intent( out) :: dims(:) - integer, optional, intent( out) :: kind - integer, optional, intent(in) :: index - - integer :: idx - type(c_ptr) :: cptr - - ierr = 0 - call ccpp_field_get_ptr(cdata, standard_name, cptr, ierr=ierr, & - units=units, rank=rank, dims=dims, kind=kind, index=index) - - if (ierr /=0) return - - call c_f_pointer(cptr, ptr, dims) - - end subroutine ccpp_field_get_r32_6 - - subroutine ccpp_field_get_r32_7(cdata, standard_name, ptr, ierr, units, rank, dims, kind, index) - type(ccpp_t), intent(in) :: cdata - character(len=*), intent(in) :: standard_name - real(kind=REAL32), pointer, intent( out) :: ptr(:,:,:,:,:,:,:) - integer, intent( out) :: ierr - character(len=*), optional, intent( out) :: units - integer, optional, intent( out) :: rank - integer, allocatable, optional, intent( out) :: dims(:) - integer, optional, intent( out) :: kind - integer, optional, intent(in) :: index - - integer :: idx - type(c_ptr) :: cptr - - ierr = 0 - call ccpp_field_get_ptr(cdata, standard_name, cptr, ierr=ierr, & - units=units, rank=rank, dims=dims, kind=kind, index=index) - - if (ierr /=0) return - - call c_f_pointer(cptr, ptr, dims) - - end subroutine ccpp_field_get_r32_7 - - !------------------------------------------------------------------! - !> - !! Double precision (64-bit) real field retrieval subroutines. - ! - !------------------------------------------------------------------! - subroutine ccpp_field_get_r64_0(cdata, standard_name, ptr, ierr, units, rank, kind, index) - type(ccpp_t), intent(in) :: cdata - character(len=*), intent(in) :: standard_name - real(kind=REAL64), pointer, intent( out) :: ptr - integer, intent( out) :: ierr - character(len=*), optional, intent( out) :: units - integer, optional, intent( out) :: rank - integer, optional, intent( out) :: kind - integer, optional, intent(in) :: index - - integer :: idx - type(c_ptr) :: cptr - - ierr = 0 - call ccpp_field_get_ptr(cdata, standard_name, cptr, ierr=ierr, & - units=units, rank=rank, kind=kind, index=index) - - if (ierr /=0) return - - call c_f_pointer(cptr, ptr) - - end subroutine ccpp_field_get_r64_0 - - subroutine ccpp_field_get_r64_1(cdata, standard_name, ptr, ierr, units, rank, dims, kind, index) - type(ccpp_t), intent(in) :: cdata - character(len=*), intent(in) :: standard_name - real(kind=REAL64), pointer, intent( out) :: ptr(:) - integer, intent( out) :: ierr - character(len=*), optional, intent( out) :: units - integer, optional, intent( out) :: rank - integer, allocatable, optional, intent( out) :: dims(:) - integer, optional, intent( out) :: kind - integer, optional, intent(in) :: index - - integer :: idx - type(c_ptr) :: cptr - - ierr = 0 - call ccpp_field_get_ptr(cdata, standard_name, cptr, ierr=ierr, & - units=units, rank=rank, dims=dims, kind=kind, index=index) - - if (ierr /=0) return - - call c_f_pointer(cptr, ptr, dims) - - end subroutine ccpp_field_get_r64_1 - - subroutine ccpp_field_get_r64_2(cdata, standard_name, ptr, ierr, units, rank, dims, kind, index) - type(ccpp_t), intent(in) :: cdata - character(len=*), intent(in) :: standard_name - real(kind=REAL64), pointer, intent( out) :: ptr(:,:) - integer, intent( out) :: ierr - character(len=*), optional, intent( out) :: units - integer, optional, intent( out) :: rank - integer, allocatable, optional, intent( out) :: dims(:) - integer, optional, intent( out) :: kind - integer, optional, intent(in) :: index - - integer :: idx - type(c_ptr) :: cptr - - ierr = 0 - call ccpp_field_get_ptr(cdata, standard_name, cptr, ierr=ierr, & - units=units, rank=rank, dims=dims, kind=kind, index=index) - - if (ierr /=0) return - - call c_f_pointer(cptr, ptr, dims) - - end subroutine ccpp_field_get_r64_2 - - subroutine ccpp_field_get_r64_3(cdata, standard_name, ptr, ierr, units, rank, dims, kind, index) - type(ccpp_t), intent(in) :: cdata - character(len=*), intent(in) :: standard_name - real(kind=REAL64), pointer, intent( out) :: ptr(:,:,:) - integer, intent( out) :: ierr - character(len=*), optional, intent( out) :: units - integer, optional, intent( out) :: rank - integer, allocatable, optional, intent( out) :: dims(:) - integer, optional, intent( out) :: kind - integer, optional, intent(in) :: index - - integer :: idx - type(c_ptr) :: cptr - - ierr = 0 - call ccpp_field_get_ptr(cdata, standard_name, cptr, ierr=ierr, & - units=units, rank=rank, dims=dims, kind=kind, index=index) - - if (ierr /=0) return - - call c_f_pointer(cptr, ptr, dims) - - end subroutine ccpp_field_get_r64_3 - - subroutine ccpp_field_get_r64_4(cdata, standard_name, ptr, ierr, units, rank, dims, kind, index) - type(ccpp_t), intent(in) :: cdata - character(len=*), intent(in) :: standard_name - real(kind=REAL64), pointer, intent( out) :: ptr(:,:,:,:) - integer, intent( out) :: ierr - character(len=*), optional, intent( out) :: units - integer, optional, intent( out) :: rank - integer, allocatable, optional, intent( out) :: dims(:) - integer, optional, intent( out) :: kind - integer, optional, intent(in) :: index - - integer :: idx - type(c_ptr) :: cptr - - ierr = 0 - call ccpp_field_get_ptr(cdata, standard_name, cptr, ierr=ierr, & - units=units, rank=rank, dims=dims, kind=kind, index=index) - - if (ierr /=0) return - - call c_f_pointer(cptr, ptr, dims) - - end subroutine ccpp_field_get_r64_4 - - subroutine ccpp_field_get_r64_5(cdata, standard_name, ptr, ierr, units, rank, dims, kind, index) - type(ccpp_t), intent(in) :: cdata - character(len=*), intent(in) :: standard_name - real(kind=REAL64), pointer, intent( out) :: ptr(:,:,:,:,:) - integer, intent( out) :: ierr - character(len=*), optional, intent( out) :: units - integer, optional, intent( out) :: rank - integer, allocatable, optional, intent( out) :: dims(:) - integer, optional, intent( out) :: kind - integer, optional, intent(in) :: index - - integer :: idx - type(c_ptr) :: cptr - - ierr = 0 - call ccpp_field_get_ptr(cdata, standard_name, cptr, ierr=ierr, & - units=units, rank=rank, dims=dims, kind=kind, index=index) - - if (ierr /=0) return - - call c_f_pointer(cptr, ptr, dims) - - end subroutine ccpp_field_get_r64_5 - - subroutine ccpp_field_get_r64_6(cdata, standard_name, ptr, ierr, units, rank, dims, kind, index) - type(ccpp_t), intent(in) :: cdata - character(len=*), intent(in) :: standard_name - real(kind=REAL64), pointer, intent( out) :: ptr(:,:,:,:,:,:) - integer, intent( out) :: ierr - character(len=*), optional, intent( out) :: units - integer, optional, intent( out) :: rank - integer, allocatable, optional, intent( out) :: dims(:) - integer, optional, intent( out) :: kind - integer, optional, intent(in) :: index - - integer :: idx - type(c_ptr) :: cptr - - ierr = 0 - call ccpp_field_get_ptr(cdata, standard_name, cptr, ierr=ierr, & - units=units, rank=rank, dims=dims, kind=kind, index=index) - - if (ierr /=0) return - - call c_f_pointer(cptr, ptr, dims) - - end subroutine ccpp_field_get_r64_6 - - subroutine ccpp_field_get_r64_7(cdata, standard_name, ptr, ierr, units, rank, dims, kind, index) - type(ccpp_t), intent(in) :: cdata - character(len=*), intent(in) :: standard_name - real(kind=REAL64), pointer, intent( out) :: ptr(:,:,:,:,:,:,:) - integer, intent( out) :: ierr - character(len=*), optional, intent( out) :: units - integer, optional, intent( out) :: rank - integer, allocatable, optional, intent( out) :: dims(:) - integer, optional, intent( out) :: kind - integer, optional, intent(in) :: index - - integer :: idx - type(c_ptr) :: cptr - - ierr = 0 - call ccpp_field_get_ptr(cdata, standard_name, cptr, ierr=ierr, & - units=units, rank=rank, dims=dims, kind=kind, index=index) - - if (ierr /=0) return - - call c_f_pointer(cptr, ptr, dims) - - end subroutine ccpp_field_get_r64_7 - - !------------------------------------------------------------------! - !> - !! Logical field retrieval subroutines. - ! - !------------------------------------------------------------------! - subroutine ccpp_field_get_l_0(cdata, standard_name, ptr, ierr, units, rank, kind, index) - type(ccpp_t), intent(in) :: cdata - character(len=*), intent(in) :: standard_name - logical, pointer, intent( out) :: ptr - integer, intent( out) :: ierr - character(len=*), optional, intent( out) :: units - integer, optional, intent( out) :: rank - integer, optional, intent( out) :: kind - integer, optional, intent(in) :: index - - integer :: idx - type(c_ptr) :: cptr - - ierr = 0 - call ccpp_field_get_ptr(cdata, standard_name, cptr, ierr=ierr, & - units=units, rank=rank, kind=kind, index=index) - - if (ierr /=0) return - - call c_f_pointer(cptr, ptr) - - end subroutine ccpp_field_get_l_0 - - subroutine ccpp_field_get_l_1(cdata, standard_name, ptr, ierr, units, rank, dims, kind, index) - type(ccpp_t), intent(in) :: cdata - character(len=*), intent(in) :: standard_name - logical, pointer, intent( out) :: ptr(:) - integer, intent( out) :: ierr - character(len=*), optional, intent( out) :: units - integer, optional, intent( out) :: rank - integer, allocatable, optional, intent( out) :: dims(:) - integer, optional, intent( out) :: kind - integer, optional, intent(in) :: index - - integer :: idx - type(c_ptr) :: cptr - - ierr = 0 - call ccpp_field_get_ptr(cdata, standard_name, cptr, ierr=ierr, & - units=units, rank=rank, dims=dims, kind=kind, index=index) - - if (ierr /=0) return - - call c_f_pointer(cptr, ptr, dims) - - end subroutine ccpp_field_get_l_1 - - subroutine ccpp_field_get_l_2(cdata, standard_name, ptr, ierr, units, rank, dims, kind, index) - type(ccpp_t), intent(in) :: cdata - character(len=*), intent(in) :: standard_name - logical, pointer, intent( out) :: ptr(:,:) - integer, intent( out) :: ierr - character(len=*), optional, intent( out) :: units - integer, optional, intent( out) :: rank - integer, allocatable, optional, intent( out) :: dims(:) - integer, optional, intent( out) :: kind - integer, optional, intent(in) :: index - - integer :: idx - type(c_ptr) :: cptr - - ierr = 0 - call ccpp_field_get_ptr(cdata, standard_name, cptr, ierr=ierr, & - units=units, rank=rank, dims=dims, kind=kind, index=index) - - if (ierr /=0) return - - call c_f_pointer(cptr, ptr, dims) - - end subroutine ccpp_field_get_l_2 - - subroutine ccpp_field_get_l_3(cdata, standard_name, ptr, ierr, units, rank, dims, kind, index) - type(ccpp_t), intent(in) :: cdata - character(len=*), intent(in) :: standard_name - logical, pointer, intent( out) :: ptr(:,:,:) - integer, intent( out) :: ierr - character(len=*), optional, intent( out) :: units - integer, optional, intent( out) :: rank - integer, allocatable, optional, intent( out) :: dims(:) - integer, optional, intent( out) :: kind - integer, optional, intent(in) :: index - - integer :: idx - type(c_ptr) :: cptr - - ierr = 0 - call ccpp_field_get_ptr(cdata, standard_name, cptr, ierr=ierr, & - units=units, rank=rank, dims=dims, kind=kind, index=index) - - if (ierr /=0) return - - call c_f_pointer(cptr, ptr, dims) - - end subroutine ccpp_field_get_l_3 - - subroutine ccpp_field_get_l_4(cdata, standard_name, ptr, ierr, units, rank, dims, kind, index) - type(ccpp_t), intent(in) :: cdata - character(len=*), intent(in) :: standard_name - logical, pointer, intent( out) :: ptr(:,:,:,:) - integer, intent( out) :: ierr - character(len=*), optional, intent( out) :: units - integer, optional, intent( out) :: rank - integer, allocatable, optional, intent( out) :: dims(:) - integer, optional, intent( out) :: kind - integer, optional, intent(in) :: index - - integer :: idx - type(c_ptr) :: cptr - - ierr = 0 - call ccpp_field_get_ptr(cdata, standard_name, cptr, ierr=ierr, & - units=units, rank=rank, dims=dims, kind=kind, index=index) - - if (ierr /=0) return - - call c_f_pointer(cptr, ptr, dims) - - end subroutine ccpp_field_get_l_4 - - subroutine ccpp_field_get_l_5(cdata, standard_name, ptr, ierr, units, rank, dims, kind, index) - type(ccpp_t), intent(in) :: cdata - character(len=*), intent(in) :: standard_name - logical, pointer, intent( out) :: ptr(:,:,:,:,:) - integer, intent( out) :: ierr - character(len=*), optional, intent( out) :: units - integer, optional, intent( out) :: rank - integer, allocatable, optional, intent( out) :: dims(:) - integer, optional, intent( out) :: kind - integer, optional, intent(in) :: index - - integer :: idx - type(c_ptr) :: cptr - - ierr = 0 - call ccpp_field_get_ptr(cdata, standard_name, cptr, ierr=ierr, & - units=units, rank=rank, dims=dims, kind=kind, index=index) - - if (ierr /=0) return - - call c_f_pointer(cptr, ptr, dims) - - end subroutine ccpp_field_get_l_5 - - subroutine ccpp_field_get_l_6(cdata, standard_name, ptr, ierr, units, rank, dims, kind, index) - type(ccpp_t), intent(in) :: cdata - character(len=*), intent(in) :: standard_name - logical, pointer, intent( out) :: ptr(:,:,:,:,:,:) - integer, intent( out) :: ierr - character(len=*), optional, intent( out) :: units - integer, optional, intent( out) :: rank - integer, allocatable, optional, intent( out) :: dims(:) - integer, optional, intent( out) :: kind - integer, optional, intent(in) :: index - - integer :: idx - type(c_ptr) :: cptr - - ierr = 0 - call ccpp_field_get_ptr(cdata, standard_name, cptr, ierr=ierr, & - units=units, rank=rank, dims=dims, kind=kind, index=index) - - if (ierr /=0) return - - call c_f_pointer(cptr, ptr, dims) - - end subroutine ccpp_field_get_l_6 - - subroutine ccpp_field_get_l_7(cdata, standard_name, ptr, ierr, units, rank, dims, kind, index) - type(ccpp_t), intent(in) :: cdata - character(len=*), intent(in) :: standard_name - logical, pointer, intent( out) :: ptr(:,:,:,:,:,:,:) - integer, intent( out) :: ierr - character(len=*), optional, intent( out) :: units - integer, optional, intent( out) :: rank - integer, allocatable, optional, intent( out) :: dims(:) - integer, optional, intent( out) :: kind - integer, optional, intent(in) :: index - - integer :: idx - type(c_ptr) :: cptr - - ierr = 0 - call ccpp_field_get_ptr(cdata, standard_name, cptr, ierr=ierr, & - units=units, rank=rank, dims=dims, kind=kind, index=index) - - if (ierr /=0) return - - call c_f_pointer(cptr, ptr, dims) - - end subroutine ccpp_field_get_l_7 - - !------------------------------------------------------------------! - !> - !! Character field retrieval subroutines. - ! - !------------------------------------------------------------------! - subroutine ccpp_field_get_c_0(cdata, standard_name, ptr, ierr, units, rank, kind, index) - type(ccpp_t), intent(in) :: cdata - character(len=*), intent(in) :: standard_name - character(len=*), pointer, intent( out) :: ptr - integer, intent( out) :: ierr - character(len=*), optional, intent( out) :: units - integer, optional, intent( out) :: rank - integer, optional, intent( out) :: kind - integer, optional, intent(in) :: index - - integer :: idx - type(c_ptr) :: cptr - - ierr = 0 - call ccpp_field_get_ptr(cdata, standard_name, cptr, ierr=ierr, & - units=units, rank=rank, kind=kind, index=index) - - if (ierr /=0) return - - call c_f_pointer(cptr, ptr) - - end subroutine ccpp_field_get_c_0 - - subroutine ccpp_field_get_c_1(cdata, standard_name, ptr, ierr, units, rank, dims, kind, index) - type(ccpp_t), intent(in) :: cdata - character(len=*), intent(in) :: standard_name - character(len=*), pointer, intent( out) :: ptr(:) - integer, intent( out) :: ierr - character(len=*), optional, intent( out) :: units - integer, optional, intent( out) :: rank - integer, allocatable, optional, intent( out) :: dims(:) - integer, optional, intent( out) :: kind - integer, optional, intent(in) :: index - - integer :: idx - type(c_ptr) :: cptr - - ierr = 0 - call ccpp_field_get_ptr(cdata, standard_name, cptr, ierr=ierr, & - units=units, rank=rank, dims=dims, kind=kind, index=index) - - if (ierr /=0) return - - call c_f_pointer(cptr, ptr, dims) - - end subroutine ccpp_field_get_c_1 - - !------------------------------------------------------------------! - -end module ccpp_fields diff --git a/src/ccpp_fields_idx.c b/src/ccpp_fields_idx.c deleted file mode 100644 index add0d50b..00000000 --- a/src/ccpp_fields_idx.c +++ /dev/null @@ -1,285 +0,0 @@ -/* - * This work (Common Community Physics Package), identified by NOAA, NCAR, - * CU/CIRES, is free of known copyright restrictions and is placed in the - * public domain. - * - * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR - * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, - * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL - * THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER - * IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN - * CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. - */ - -/** - * @file ccpp_fields_idx.c - * - * @brief Routines and functions to generate and lookup fields/variables - * needed for the physics routines. - * - * @details The fields are stored in an array of C pointers within the - * ccpp_t type. There is also an index array in this type. - * We poppulate this index array with the standard name of - * each variable in the fields array. We use a binary search - * on the sorted index array to retreive the array index for - * the field witin the fields array. - * - * TODO - * - Test the sort and lookup times for qsort() and bsearch(). - * - Implement this as a hash-map instead. - * - * @ingroup Physics - * @{ - **/ - -#include -#include -#include -#include -#include -#include - -#include "ccpp_fields_idx.h" - -/** - * Comparison function. - * - * Compares the name of two index elements using strcmp(). - * It returns an integer less than, equal to, or greater than - * zero if the name in f1 is found, respectively, to be less - * than, to match, or be greater than the name in f2. - * - * @param[in] f1 The first field. - * @param[in] f2 The second field. - **/ -static int -cmp(const void *f1, const void *f2) -{ - struct ccpp_field *f_1; - struct ccpp_field *f_2; - f_1 = *(struct ccpp_field * const *) f1; - f_2 = *(struct ccpp_field * const *) f2; - return strcmp(f_1->name, f_2->name); -} - -/** - * Initialization routine. - * - * Allocates an array for the field indices. - * - * @param[in,out] index The index array. - * @retval 0 If it was sucessful. - * @retval 1 If there was an error. - **/ -int -ccpp_field_idx_init(void **index) -{ - struct ccpp_field_idx *f_index; - f_index = NULL; - - *index = (struct ccpp_field_idx *)malloc(sizeof(struct ccpp_field_idx)); - if (*index == NULL) { - warnx("Unable to allocate field index"); - return(EXIT_FAILURE); - } - - f_index = (struct ccpp_field_idx *)(*index); - - f_index->sorted = 0; - f_index->n = 0; - f_index->max = CCPP_FIELD_IDX_MAX; - f_index->fields = malloc(CCPP_FIELD_IDX_MAX * sizeof(struct ccpp_field *)); - - return(EXIT_SUCCESS); -} - -/** - * Finalization routine. - * - * Deallocates the field indices array. - * - * @param[in] index The index array. - * @retval 0 If it was sucessful. - **/ -int -ccpp_field_idx_finalize(void **index) -{ - int i; - - struct ccpp_field_idx *f_index; - - f_index = (struct ccpp_field_idx *)(*index); - - for (i = 0; i < f_index->n; ++i) { - if (f_index->fields[i]->name) { - free(f_index->fields[i]->name); - f_index->fields[i]->name = NULL; - } - free(f_index->fields[i]); - f_index->fields[i] = NULL; - } - free(f_index->fields); - f_index->fields = NULL; - - free(f_index); - f_index = NULL; - - return(EXIT_SUCCESS); -} - -/** - * Add/Insert a field into the index. - * - * @param[in] name The name to add to the index array. - * @param[in,out] index The index array. - * @retval > 0 The index location. - * @retval -1 If there was an error. - **/ -int -ccpp_field_idx_add(const char *name, void **index) -{ - struct ccpp_field_idx *f_index; - int n; - size_t len; - f_index = (struct ccpp_field_idx *)(*index); - n = 0; - len = 0; - - n = f_index->n; - if (n == f_index->max) { - if (ccpp_field_idx_grow(index)) { - warnx("Unable to grow field index array"); - return(-1); - } - } - f_index->fields[n] = malloc(sizeof(struct ccpp_field)); - - len = strlen(name); - - f_index->fields[n]->name = malloc((len + 1) * sizeof(char)); - - strncpy(f_index->fields[n]->name, name, len * sizeof(char)); - f_index->fields[n]->name[len] = '\0'; - f_index->fields[n]->n = n+1; - f_index->sorted = 0; - f_index->n++; - - return(n+1); -} - - -/** - * Find the index number of a field. - * - * @param[in] name The field name to find the index array. - * @param[in,out] index The index array. - * @retval > 0 The position in the index array of the requested field. - * @retval -1 If there was an error. - **/ -int -ccpp_field_idx_find(const char *name, void **index) -{ - int n; - struct ccpp_field *key; - struct ccpp_field **res; - struct ccpp_field_idx *f_index; - n = 0; - key = NULL; - res = NULL; - f_index = (struct ccpp_field_idx *)(*index); - - if (f_index->sorted == 0) { - ccpp_field_idx_sort(index); - } - - key = malloc(sizeof(struct ccpp_field)); - n = strlen(name); - key->name = malloc((n+1) * sizeof(char)); - strncpy(key->name, name, n); - key->name[n] = '\0'; - - res = bsearch(&key, f_index->fields, f_index->n, - sizeof(struct ccpp_field *), cmp); - if (*res == NULL) { - warnx("Unable to find in index: %s", name); - return(-1); - } - - free(key->name); - free(key); - - return((*res)->n); -} - -/** - * Sort the index by calling qsort() and using cmp() as the - * comparison function. - * - * @param[in,out] index The index array. - * @retval 0 If there was no error. - **/ -static int -ccpp_field_idx_sort(void **index) -{ - struct ccpp_field_idx *f_index; - f_index = (struct ccpp_field_idx *)(*index); - - qsort(f_index->fields, f_index->n, sizeof(struct ccpp_field *), cmp); - f_index->sorted = 1; - - return(EXIT_SUCCESS); -} - -/** - * Grow the index field array. - * - * @param[in,out] index The index array. - * @retval 0 If there was no error. - **/ -static int -ccpp_field_idx_grow(void **index) -{ - // Warn user that field index array needs to grow - warnx("Growing field index array"); - - struct ccpp_field_idx *f_index; - struct ccpp_field **new; - int new_max; - f_index = (struct ccpp_field_idx *)(*index); - new = NULL; - new_max = 0; - - new_max = f_index->max * CCPP_FIELD_IDX_GROW; - - new = realloc(f_index->fields, new_max * sizeof(struct ccpp_field *)); - if (new == NULL) { - warnx("Unable to expand the field index array"); - return(EXIT_FAILURE); - } - f_index->fields = new; - f_index->max = new_max; - - return(EXIT_SUCCESS); -} - -/** - * Get the maximum number of fields the index array can hold. - * - * @param[in,out] index The index array. - * @retval >= 0 The maximum number of fields. - **/ -int -ccpp_field_idx_max(void **index) -{ - struct ccpp_field_idx *f_index; - f_index = (struct ccpp_field_idx *)(*index); - - assert(f_index->max > 0); - - return(f_index->max); - -} - -/** - * @} - **/ diff --git a/src/ccpp_fields_idx.h b/src/ccpp_fields_idx.h deleted file mode 100644 index 053fe9c2..00000000 --- a/src/ccpp_fields_idx.h +++ /dev/null @@ -1,80 +0,0 @@ -/* - * This work (Common Community Physics Package), identified by NOAA, NCAR, - * CU/CIRES, is free of known copyright restrictions and is placed in the - * public domain. - * - * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR - * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, - * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL - * THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER - * IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN - * CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. - */ - -/** - * @file ccpp_fields_idx.h - * - * Routines and functions to generate and lookup - * fields/variables needed for the physics routines. - * - * @ingroup Physics - * @{ - **/ -#ifndef CCPP_FIELD_IDX_H -#define CCPP_FIELD_IDX_H - -#ifdef __cplusplus -extern "C" -{ -#endif - - -#define CCPP_FIELD_IDX_MAX 1500 -#define CCPP_FIELD_IDX_GROW 2 - - -struct ccpp_field { - int n; /**< Location within nodes array **/ - char *name; /**< Name of the field **/ -}; - -struct ccpp_field_idx { - int sorted; /**< Sorted flag. 0=unsorted, 1=sorted **/ - int n; /**< Current number of used nodes **/ - int max; /**< Maximum nodes allocated **/ - struct ccpp_field **fields; /**< Array of fields **/ -}; - - -/** CCPP field index initialization routine. **/ -int ccpp_field_idx_init(void **); - -/** CCPP field index finalization routine. **/ -int ccpp_field_idx_finalize(void **); - -/** CCPP field index add/insert a field. **/ -int ccpp_field_idx_add(const char *, void **); - -/** CCPP field index find a field location. **/ -int ccpp_field_idx_find(const char *, void **); - -/** CCPP field index sorting routine. **/ -static int ccpp_field_idx_sort(void **); - -/** CCPP field index array extension. **/ -static int ccpp_field_idx_grow(void **); - -/** CCPP field index maximum number of fields. **/ -int ccpp_field_idx_max(void **); - - -#ifdef __cplusplus -} /* extern "C" */ -#endif - -#endif /* CCPP_FIELD_IDX_H */ - - -/** - * @} - **/ diff --git a/src/ccpp_scheme.F90 b/src/ccpp_scheme.F90 deleted file mode 100644 index 0306f129..00000000 --- a/src/ccpp_scheme.F90 +++ /dev/null @@ -1,159 +0,0 @@ -! -! This work (Common Community Physics Package), identified by NOAA, NCAR, -! CU/CIRES, is free of known copyright restrictions and is placed in the -! public domain. -! -! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL -! THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER -! IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN -! CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -! - -!> -!! @brief Physics scheme infrastructure module. -! -module ccpp_scheme - - use :: ccpp_types, & - only: ccpp_scheme_t, CCPP_STAGES - use :: ccpp_errors, & - only: ccpp_error, ccpp_debug - use :: ccpp_strings, & - only: ccpp_cstr - use :: ccpp_dl, & - only: ccpp_dl_open, ccpp_dl_close - - implicit none - - private - public :: ccpp_scheme_init, & - ccpp_scheme_finalize, & - ccpp_scheme_load, & - ccpp_scheme_unload - - contains - - !> - !! Scheme initialization subroutine. - !! - !! @param[in,out] scheme The ccpp_scheme_t type to initalize - !! @param[ out] ierr Integer error flag - ! - subroutine ccpp_scheme_init(scheme, ierr) - - type(ccpp_scheme_t), intent(inout) :: scheme - integer , intent( out) :: ierr - - integer :: i - - call ccpp_debug('Called ccpp_scheme_init') - - ierr = 0 - - scheme%functions_max = size(CCPP_STAGES) - - allocate(scheme%functions(1:scheme%functions_max)) - do i=1,scheme%functions_max - scheme%functions(i)%name = trim(scheme%get_function_name(trim(CCPP_STAGES(i)))) - end do - - end subroutine ccpp_scheme_init - - !> - !! Scheme finalization subroutine. - !! - !! @param[in,out] scheme The ccpp_scheme_t type to finalize - !! @param[ out] ierr Integer error flag - ! - subroutine ccpp_scheme_finalize(scheme, ierr) - - type(ccpp_scheme_t), intent(inout) :: scheme - integer , intent( out) :: ierr - - integer :: i - - call ccpp_debug('Called ccpp_scheme_finalize') - - ierr = 0 - - if (.not.(allocated(scheme%functions))) return - - do i=1,scheme%functions_max - if (allocated(scheme%functions(i)%name)) & - deallocate(scheme%functions(i)%name) - end do - - deallocate(scheme%functions) - - end subroutine ccpp_scheme_finalize - - !> - !! Scheme loading subroutine. - !! - !! @param[in,out] scheme The ccpp_scheme_t type to load - !! @param[ out] ierr Integer error flag - ! - subroutine ccpp_scheme_load(scheme, ierr) - - type(ccpp_scheme_t), intent(inout) :: scheme - integer , intent( out) :: ierr - - integer :: i - - call ccpp_debug('Called ccpp_scheme_load') - - ierr = 0 - - do i=1, scheme%functions_max - associate (f => scheme%functions(i)) - call ccpp_debug('Loading ' // trim(f%name) & - // ' from ' // trim(scheme%library)) - ierr = ccpp_dl_open(ccpp_cstr(f%name), & - ccpp_cstr(scheme%library), & - ccpp_cstr(scheme%version), & - f%function_hdl, & - f%library_hdl) - if (ierr /= 0) then - call ccpp_error('A problem occured loading ' & - // trim(f%name) // ' from ' & - // trim(scheme%library)) - return - end if - end associate - end do - - end subroutine ccpp_scheme_load - - !> - !! Scheme unloading subroutine. - !! - !! @param[in,out] scheme The ccpp_scheme_t type to unload - !! @param[ out] ierr Integer error flag - ! - subroutine ccpp_scheme_unload(scheme, ierr) - - type(ccpp_scheme_t), intent(inout) :: scheme - integer , intent( out) :: ierr - - integer :: i - - call ccpp_debug('Called ccpp_scheme_unload') - - ierr = 0 - - do i=1, scheme%functions_max - associate (f => scheme%functions(i)) - ierr = ccpp_dl_close(f%library_hdl) - if (ierr /= 0) then - call ccpp_error('A problem occured closing ' & - // trim(scheme%library)) - return - end if - end associate - end do - - end subroutine ccpp_scheme_unload - -end module ccpp_scheme diff --git a/src/ccpp_strings.F90 b/src/ccpp_strings.F90 deleted file mode 100644 index 3e2e0ecd..00000000 --- a/src/ccpp_strings.F90 +++ /dev/null @@ -1,101 +0,0 @@ -! -! This work (Common Community Physics Package), identified by NOAA, NCAR, -! CU/CIRES, is free of known copyright restrictions and is placed in the -! public domain. -! -! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL -! THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER -! IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN -! CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -! - -!> -!! @brief String routines module. -!! -!! @details A module continaing subroutines and functions to -!! manipulate strings. -! -module ccpp_strings - - use, intrinsic :: iso_c_binding, & - only: c_char, c_null_char, c_size_t, & - c_f_pointer, c_ptr - use :: ccpp_errors, & - only: ccpp_error - - implicit none - - private - public :: ccpp_fstr, & - ccpp_cstr, & - ccpp_free - - interface - integer(c_size_t) & - function strlen(s) & - bind(c, name='strlen') - import :: c_size_t, c_ptr - type(c_ptr), value, intent(in) :: s - end function strlen - - subroutine ccpp_free(s) & - bind(c, name='free') - import :: c_ptr - type(c_ptr), value, intent(in) :: s - end subroutine ccpp_free - end interface - - contains - - !> - !! ccpp_fstr converts an array of characters into a string. - !! - !! This function is needed to pass C char arrays to Fortran. - !! - !! @param[in] str1 The character array. - !! @returns str2 The fortran string. - ! - function ccpp_fstr(str1) result(str2) - type(c_ptr), intent(in) :: str1 - character(len=:), allocatable :: str2 - - integer :: ierr - integer :: i ! Temporary loop indexer - integer :: n ! Length of the str1 - character(kind=c_char), pointer :: cstr(:) - - n = strlen(str1) - - call c_f_pointer(str1, cstr, [strlen(str1)]) - - allocate(character(n) :: str2, stat=ierr) - if (ierr /= 0) then - call ccpp_error('Unable to allocate a string') - return - end if - - i = 1 - do i=1,n - str2(i:i) = cstr(i) - enddo - - end function ccpp_fstr - - !> - !! ccpp_cstr converts a string to a trimmed null terminated string. - !! - !! This function is needed to pass Fortran strings to C. - !! - !! @param[in] str1 The fortran string. - !! @returns str2 The trimmed, null terminated string. - ! - function ccpp_cstr(str1) result(str2) - character(len=*) :: str1 - character(len=:), allocatable :: str2 - - str2 = trim(str1)//c_null_char - end function ccpp_cstr - -end module ccpp_strings diff --git a/src/ccpp_suite.F90 b/src/ccpp_suite.F90 deleted file mode 100644 index 637e9de4..00000000 --- a/src/ccpp_suite.F90 +++ /dev/null @@ -1,438 +0,0 @@ -! -! This work (Common Community Physics Package), identified by NOAA, NCAR, -! CU/CIRES, is free of known copyright restrictions and is placed in the -! public domain. -! -! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL -! THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER -! IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN -! CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -! - -!> -!! @brief Physics suite infrastructure module. -! -module ccpp_suite - - use, intrinsic :: iso_c_binding, & - only: c_ptr, c_null_ptr - use :: ccpp_types, & - only: ccpp_suite_t - use :: ccpp_errors, & - only: ccpp_error, ccpp_info, ccpp_debug - use :: ccpp_strings, & - only: ccpp_cstr - use :: ccpp_xml - use :: ccpp_scheme, & - only: ccpp_scheme_init, ccpp_scheme_finalize, & - ccpp_scheme_load, ccpp_scheme_unload - - implicit none - - private - public :: ccpp_suite_init, & - ccpp_suite_finalize, & - ccpp_suite_load, & - ccpp_suite_unload - - contains - - !> - !! Suite initialization subroutine. - !! - !! @param[in] filename The file name of the XML scheme file to load. - !! @param[in,out] suite The ccpp_suite_t type to initalize from - !! the scheme XML file. - !! @param[ out] ierr Integer error flag. - ! - subroutine ccpp_suite_init(filename, suite, ierr) - - implicit none - - character(len=*), intent(in) :: filename - type(ccpp_suite_t), intent(inout) :: suite - integer, intent( out) :: ierr - - integer :: i - integer :: j - integer :: k - integer :: l - type(c_ptr) :: xml - type(c_ptr) :: root - type(c_ptr) :: group - type(c_ptr) :: subcycle - type(c_ptr) :: scheme - type(c_ptr), target :: tmp - character(len=*), parameter :: err_msg = & - 'Please validate the suite xml file: ' - - ierr = 0 - tmp = c_null_ptr - - call ccpp_debug('Called ccpp_suite_init') - - ! Load the xml document. - ierr = ccpp_xml_load(ccpp_cstr(filename), xml, root) - if (ierr /= 0) then - call ccpp_error('Unable to load suite from: ' // trim(filename)) - return - end if - - ! Parse the suite element - call ccpp_xml_parse(root, suite, ierr) - if (ierr /= 0) then - call ccpp_error(err_msg // trim(filename)) - return - end if - - call ccpp_info('Parsing suite ' //trim(suite%name)) - ! Find the init subroutine - call ccpp_xml_ele_find(root, ccpp_cstr(CCPP_XML_ELE_INIT), tmp, ierr) - if (ierr == 0) then - ! Get the init subroutine name - call ccpp_xml_parse(tmp, suite%library, suite%version, & - suite%init, ierr) - if (ierr /= 0) then - call ccpp_error('Unable to load initialization subroutine') - call ccpp_error(err_msg // trim(filename)) - return - end if - ! Do not allow empty init constructs < - if (trim(suite%init%name) == '') then - call ccpp_error('CCPP does not allow empty ' & - // ' XML elements; remove if not used') - ierr = 1 - return - end if - ! Initialize the scheme - call ccpp_scheme_init(suite%init, ierr) - end if - - ! Find the finalize subroutine - call ccpp_xml_ele_find(root, ccpp_cstr(CCPP_XML_ELE_FINALIZE), & - tmp, ierr) - if (ierr == 0) then - ! Get the finalize subroutine name - call ccpp_xml_parse(tmp, suite%library, suite%version, & - suite%finalize, ierr) - if (ierr /= 0) then - call ccpp_error('Unable to load finalization subroutine') - call ccpp_error(err_msg // trim(filename)) - return - end if - ! Do not allow empty init constructs < - if (trim(suite%finalize%name) == '') then - call ccpp_error('CCPP does not allow empty ' & - // 'XML elements; remove if not used') - ierr = 1 - return - end if - ! Initialize the scheme - call ccpp_scheme_init(suite%finalize, ierr) - if (ierr /= 0) return - end if - - ! Find the first group - call ccpp_xml_ele_find(root, CCPP_XML_ELE_GROUP, group, ierr) - if (ierr /= 0) then - call ccpp_error('Unable to find first group') - call ccpp_error(err_msg // trim(filename)) - return - end if - - ! Loop over all groups - do i=1, suite%groups_max - - ! Parse the group - call ccpp_xml_parse(group, suite%groups_max, suite%groups(i), ierr) - if (ierr /= 0) then - call ccpp_error(err_msg // trim(filename)) - return - end if - - ! Find the first subcycle - call ccpp_xml_ele_find(group, CCPP_XML_ELE_SUBCYCLE, subcycle, ierr) - if (ierr /= 0) then - call ccpp_error('Unable to locate element: ' & - // CCPP_XML_ELE_SUBCYCLE) - call ccpp_error(err_msg // trim(filename)) - return - end if - - ! Loop over all subcycles - do j=1, suite%groups(i)%subcycles_max - - ! Parse the subcycle - call ccpp_xml_parse(subcycle, & - suite%groups(i)%subcycles_max, & - suite%groups(i)%subcycles(j), & - ierr) - if (ierr /= 0) then - call ccpp_error(err_msg // trim(filename)) - return - end if - - ! Find the first scheme - call ccpp_xml_ele_find(subcycle, CCPP_XML_ELE_SCHEME, & - scheme, ierr) - - ! Loop over all scheme - do k=1, suite%groups(i)%subcycles(j)%schemes_max - ! Parse the scheme - call ccpp_xml_parse(scheme, suite%library, suite%version, & - suite%groups(i)%subcycles(j)%schemes(k), & - ierr) - - ! Initialize the scheme - call ccpp_scheme_init(suite%groups(i)%subcycles(j)%schemes(k), ierr) - if (ierr /= 0) return - - ! Find the next scheme - call ccpp_xml_ele_next(scheme, CCPP_XML_ELE_SCHEME, & - scheme, ierr) - end do - ! Find the next subcycle - call ccpp_xml_ele_next(subcycle, CCPP_XML_ELE_SUBCYCLE, & - subcycle, ierr) - end do - ! Find the next group - call ccpp_xml_ele_next(group, CCPP_XML_ELE_GROUP, group, ierr) - end do - -#ifdef DEBUG - write(6, '(A)') '--------------------------------------------------------------------------------' - write(6, '(A)') 'CCPP suite configuration parsed from SDF ' // trim(filename) - write(6, '(A)') '--------------------------------------------------------------------------------' - write(6, '(*(A))') & - '' - - write(6, '(A, I0)') '[suite%groups_max] = ', suite%groups_max - do i=1, suite%groups_max - write(6, '(A, A, A)') ' ' - write(6, '(A, I0)') ' [suite%groups(i)%subcycles_max] = ', suite%groups(i)%subcycles_max - do j=1, suite%groups(i)%subcycles_max - write(6, '(A, I0, A)') ' ' - write(6, '(A, I0)') ' [suite%groups(i)%subcycles(j)%schemes_max] = ', & - suite%groups(i)%subcycles(j)%schemes_max - do k=1, suite%groups(i)%subcycles(j)%schemes_max - write(6, '(*(A))') & - ' ' - write(6, '(A, I0)') ' [suite%groups(i)%subcycles(j)%schemes(k)%functions_max] = ', & - suite%groups(i)%subcycles(j)%schemes(k)%functions_max - do l=1, suite%groups(i)%subcycles(j)%schemes(k)%functions_max - write(6, '(*(A))') & - ' ', & - trim(suite%groups(i)%subcycles(j)%schemes(k)%functions(l)%name), & - '' - end do - write(6, '(A)') ' ' - end do - write(6, '(A)') ' ' - end do - write(6, '(A)') ' ' - end do - write(6, '(A)') '' - write(6, '(A)') '--------------------------------------------------------------------------------' -#endif - - ierr = ccpp_xml_unload(xml) - call ccpp_suite_load(suite, ierr) - - end subroutine ccpp_suite_init - - !> - !! Suite finalization subroutine. - !! - !! @param[in,out] suite The suite_t type to finalize. - !! @param[ out] ierr Integer error flag. - ! - subroutine ccpp_suite_finalize(suite, ierr) - type(ccpp_suite_t), intent(inout) :: suite - integer, intent( out) :: ierr - - integer :: i - integer :: j - integer :: k - - ierr = 0 - - call ccpp_debug('Called ccpp_suite_finalize') - -#ifndef STATIC - do i=1, suite%groups_max - do j=1, suite%groups(i)%subcycles_max - do k=1, suite%groups(i)%subcycles(j)%schemes_max - call ccpp_scheme_finalize(suite%groups(i)%subcycles(j)%schemes(k), ierr) - if (ierr /= 0) return - if (allocated(suite%groups(i)%subcycles(j)%schemes(k)%name)) then - deallocate(suite%groups(i)%subcycles(j)%schemes(k)%name) - end if - if (allocated(suite%groups(i)%subcycles(j)%schemes(k)%library)) & - then - deallocate(suite%groups(i)%subcycles(j)%schemes(k)%library) - end if - if (allocated(suite%groups(i)%subcycles(j)%schemes(k)%version)) & - then - deallocate(suite%groups(i)%subcycles(j)%schemes(k)%version) - end if - end do - if (allocated(suite%groups(i)%subcycles(j)%schemes)) then - deallocate(suite%groups(i)%subcycles(j)%schemes) - end if - end do - if (allocated(suite%groups(i)%subcycles)) then - deallocate(suite%groups(i)%subcycles) - end if - end do -#endif - - if (allocated(suite%groups)) then - deallocate(suite%groups) - end if - -#ifndef STATIC - ! Clean up the init scheme - call ccpp_scheme_finalize(suite%init, ierr) - if (ierr /=0) return -#endif - - if (allocated(suite%init%name)) then - deallocate(suite%init%name) - end if - - if (allocated(suite%init%library)) then - deallocate(suite%init%library) - end if - - if (allocated(suite%init%version)) then - deallocate(suite%init%version) - end if - -#ifndef STATIC - ! Clean up the finalize scheme - call ccpp_scheme_finalize(suite%finalize, ierr) - if (ierr /=0) return -#endif - - if (allocated(suite%finalize%name)) then - deallocate(suite%finalize%name) - end if - - if (allocated(suite%finalize%library)) then - deallocate(suite%finalize%library) - end if - - if (allocated(suite%finalize%version)) then - deallocate(suite%finalize%version) - end if - - ! Clean up ourself - if (allocated(suite%name)) then - deallocate(suite%name) - end if - - if (allocated(suite%library)) then - deallocate(suite%library) - end if - - if (allocated(suite%version)) then - deallocate(suite%version) - end if - - suite%groups_max = 0 - - end subroutine ccpp_suite_finalize - - !> - !! Suite sub-components loading. - !! - !! @param[in,out] suite The suite_t type to load all sub-components. - !! @param[ out] ierr Integer error flag. - ! - subroutine ccpp_suite_load(suite, ierr) - type(ccpp_suite_t), intent(inout) :: suite - integer, intent( out) :: ierr - - integer :: i - integer :: j - integer :: k - - ierr = 0 - - call ccpp_debug('Called ccpp_suite_load') - - if (allocated(suite%init%name)) then - call ccpp_scheme_load(suite%init, ierr) - if (ierr /= 0) return - end if - - if (allocated(suite%finalize%name)) then - call ccpp_scheme_load(suite%finalize, ierr) - if (ierr /= 0) return - end if - - do i=1, suite%groups_max - do j=1, suite%groups(i)%subcycles_max - do k=1, suite%groups(i)%subcycles(j)%schemes_max - call ccpp_scheme_load(suite%groups(i)%subcycles(j)%schemes(k), ierr) - if (ierr /= 0) return - end do - end do - end do - - end subroutine ccpp_suite_load - - !> - !! Suite unload subroutine. - !! - !! This loops over all defined schemes to close - !! the handle to the scheme library - !! - !! @param[in,out] cdata The CCPP data of type ccpp_t - !! @param[ out] ierr Integer error flag - ! - subroutine ccpp_suite_unload(suite, ierr) - - type(ccpp_suite_t), intent(inout) :: suite - integer , intent( out) :: ierr - - integer :: i - integer :: j - integer :: k - - ierr = 0 - - call ccpp_debug('Called ccpp_suite_unload') - - if (allocated(suite%init%name)) then - call ccpp_scheme_unload(suite%init, ierr) - if (ierr /= 0) return - end if - - if (allocated(suite%finalize%name)) then - call ccpp_scheme_unload(suite%finalize, ierr) - if (ierr /= 0) return - end if - - do i=1, suite%groups_max - do j=1, suite%groups(i)%subcycles_max - do k=1, suite%groups(i)%subcycles(j)%schemes_max - call ccpp_scheme_unload(suite%groups(i)%subcycles(j)%schemes(k), ierr) - if (ierr /= 0) return - end do - end do - end do - - end subroutine ccpp_suite_unload - -end module ccpp_suite diff --git a/src/ccpp_types.F90 b/src/ccpp_types.F90 index 95bcb1e9..903efd98 100644 --- a/src/ccpp_types.F90 +++ b/src/ccpp_types.F90 @@ -23,38 +23,10 @@ module ccpp_types !! \htmlinclude ccpp_types.html !! - use, intrinsic :: iso_c_binding, & - only: c_ptr, c_funptr - implicit none private - public :: CCPP_STR_LEN, & - CCPP_STAGES, & - CCPP_DEFAULT_STAGE, & - CCPP_DEFAULT_LOOP_CNT, & - CCPP_GENERIC_KIND, & - ccpp_t, & - ccpp_field_t, & - ccpp_scheme_t, & - ccpp_suite_t, & - ccpp_group_t, & - ccpp_subcycle_t - - !> @var CCPP_STR_LEN Parameter defined for string lengths. - integer, parameter :: CCPP_STR_LEN = 256 - - !> @var The stages=functions that are defined for each scheme. - character(len=*), dimension(1:3), parameter :: CCPP_STAGES = & - & (/ 'init ', & - & 'run ', & - & 'finalize' /) - - !> @var The default stage if not specified - character(len=*), parameter :: CCPP_DEFAULT_STAGE = 'run' - - !> @var The default "kind" for a generic pointer / derived data type - integer, parameter :: CCPP_GENERIC_KIND = -999 + public :: ccpp_t !> @var The default loop counter indicating outside of a subcycle loop integer, parameter :: CCPP_DEFAULT_LOOP_CNT = -999 @@ -62,96 +34,9 @@ module ccpp_types !> @var The default values for block and thread numbers indicating invalid data integer, parameter :: CCPP_DEFAULT_BLOCK_AND_THREAD_NUMBER = -999 - !> - !! @brief CCPP field type - !! - !! The field type contains all the information/meta-data and data - !! for fields that need to be passed between the atmosphere driver - !! and the physics drivers. - type :: ccpp_field_t - character(len=CCPP_STR_LEN) :: standard_name - character(len=CCPP_STR_LEN) :: long_name - character(len=CCPP_STR_LEN) :: units - integer :: rank - integer, allocatable, dimension(:) :: dims - integer :: kind - type(c_ptr) :: ptr - end type ccpp_field_t - - !> - !! @brief CCPP scheme function type - !! - !! The scheme function type contains one function of a scheme. - ! - type :: ccpp_function_t - character(:), allocatable :: name - type(c_ptr) :: function_hdl - type(c_ptr) :: library_hdl - end type ccpp_function_t - - !> - !! @brief CCPP scheme type - !! - !! The scheme type contains all the scheme information. - ! - type :: ccpp_scheme_t - character(:), allocatable :: name - character(:), allocatable :: library - character(:), allocatable :: version - integer :: functions_max - type(ccpp_function_t), allocatable, dimension(:) :: functions - logical :: initialized = .false. - contains - procedure :: get_function_name => scheme_get_function_name - end type ccpp_scheme_t - - !> - !! @brief CCPP subcycle type - !! - !! The subcycle type contains all the scheme names and the number of - !! times the subcycle will loop. It is a direct mapping to the group - !! suite subcycle XML. - ! - type :: ccpp_subcycle_t - integer :: loops_max - integer :: schemes_max - type(ccpp_scheme_t), allocatable, dimension(:) :: schemes - end type ccpp_subcycle_t - - !> - !! @brief CCPP group type - !! - !! The group type contains all the subcycles and the name of - !! the group call. It is a direct mapping to the group element in XML. - ! - type :: ccpp_group_t - character(:), allocatable :: name - integer :: subcycles_max - type(ccpp_subcycle_t), allocatable, dimension(:) :: subcycles - end type ccpp_group_t - - !> - !! @brief CCPP suite type - !! - !! The suite type contains all the group parts names and number of - !! times the subcycle will loop. It is a direct mapping to the - !! suite element in XML. - ! - type :: ccpp_suite_t - character(:), allocatable :: name - character(:), allocatable :: library - character(:), allocatable :: version - type(ccpp_scheme_t) :: init - type(ccpp_scheme_t) :: finalize - integer :: groups_max - type(ccpp_group_t), allocatable, dimension(:) :: groups - end type ccpp_suite_t - -#if 0 !! \section arg_table_ccpp_t !! \htmlinclude ccpp_t.html !! -#endif !> !! @brief CCPP physics type. !! @@ -162,41 +47,29 @@ module ccpp_types !! - The suite definitions in a ccpp_suite_t type. ! type :: ccpp_t - type(c_ptr) :: fields_idx - type(ccpp_field_t), allocatable, dimension(:) :: fields - type(ccpp_suite_t), pointer :: suite => null() - type(ccpp_suite_t) :: suite_target - logical :: suite_iscopy - logical :: initialized = .false. - ! CCPP-internal variables for physics schemes - integer :: errflg = 0 - character(len=512) :: errmsg = '' - integer :: loop_cnt = CCPP_DEFAULT_LOOP_CNT - integer :: blk_no = CCPP_DEFAULT_BLOCK_AND_THREAD_NUMBER - integer :: thrd_no = CCPP_DEFAULT_BLOCK_AND_THREAD_NUMBER - end type ccpp_t + ! CCPP-internal variables for physics schemes + integer :: errflg = 0 + character(len=512) :: errmsg = '' + integer :: loop_cnt = CCPP_DEFAULT_LOOP_CNT + integer :: blk_no = CCPP_DEFAULT_BLOCK_AND_THREAD_NUMBER + integer :: thrd_no = CCPP_DEFAULT_BLOCK_AND_THREAD_NUMBER -contains + contains - !> - !! @brief Internal routine that returns the name of - !! a function for a given scheme and stage - !! - !! @param[in ] scheme The ccpp_scheme_t type - !! @param[in ] stage The current stage - !! @return function_name The name of the function - ! - pure function scheme_get_function_name(s, stage) result(function_name) + procedure :: initialized => ccpp_t_initialized - implicit none - - class(ccpp_scheme_t), intent(in) :: s - character(len=*), intent(in) :: stage - - character(:), allocatable :: function_name + end type ccpp_t - function_name = trim(s%name) // '_' // trim(stage) +contains - end function scheme_get_function_name + function ccpp_t_initialized(ccpp_d) result(initialized) + implicit none + ! + class(ccpp_t) :: ccpp_d + logical :: initialized + ! + initialized = (ccpp_d%blk_no /= CCPP_DEFAULT_BLOCK_AND_THREAD_NUMBER .and. & + ccpp_d%thrd_no /= CCPP_DEFAULT_BLOCK_AND_THREAD_NUMBER) + end function ccpp_t_initialized end module ccpp_types diff --git a/src/ccpp_utils.c b/src/ccpp_utils.c deleted file mode 100644 index fa545405..00000000 --- a/src/ccpp_utils.c +++ /dev/null @@ -1,89 +0,0 @@ -/* - * This work (Common Community Physics Package), identified by NOAA, NCAR, - * CU/CIRES, is free of known copyright restrictions and is placed in the - * public domain. - * - * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR - * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, - * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL - * THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER - * IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN - * CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. - */ - -/** - * @file ccpp_utils.c - * - * Utility routines that are commonly used in CCPP. - * - * @ingroup common - * @{ - **/ - -#include -#include -#include -#include -#include -#include -#include - -/** - * Resolves the absolute path when given a relative path. - * - * @param[in] rel Relative path name - * @param[out] abs Absolute path name - * @retval 0 If the path was resolved - * @retval 1 If we were unable to resolve the path - **/ -int -ccpp_abs_path(const char *rel, char **abs) -{ - long bsize = 0; - char *buf = NULL; - struct stat sbuf = {0}; - - /* make sure we were given a relative path */ - if (rel == NULL) { - warn("Unable to resolve null relative filename"); - return(EXIT_FAILURE); - } - - /* make sure the absolute path holder is null */ - if (*abs != NULL) { - warn("Unable to write to non-null absolute filename pointer"); - return(EXIT_FAILURE); - } - - /* make sure relative path actually exists */ - if (stat(rel, &sbuf) < 0) { - warn("Unable to stat %s", rel); - return(EXIT_FAILURE); - } - - if ((bsize = pathconf(".", _PC_PATH_MAX)) < 0) { - warn("Unable to obtain maximum size of pathname"); - return(EXIT_FAILURE); - } - - buf = malloc((bsize + 1) * sizeof(char)); - - /* find the absolute path */ - if (realpath(rel, buf) == NULL) { - warn("Unable to resolve %s an error occurred at %s", rel, buf); - free(buf); - return(EXIT_FAILURE); - } - - bsize = strlen(buf); - /* malloc the absolute path */ - *abs = malloc((bsize + 1) * sizeof(char)); - strncpy(*abs, buf, bsize); - (*abs)[bsize] = '\0'; - - /* free up temporary stuff */ - free(buf); - buf = NULL; - - return(EXIT_SUCCESS); -} diff --git a/src/ccpp_utils.h b/src/ccpp_utils.h deleted file mode 100644 index 78d54fc7..00000000 --- a/src/ccpp_utils.h +++ /dev/null @@ -1,41 +0,0 @@ -/* - * This work (Common Community Physics Package), identified by NOAA, NCAR, - * CU/CIRES, is free of known copyright restrictions and is placed in the - * public domain. - * - * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR - * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, - * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL - * THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER - * IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN - * CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. - */ - -/** - * \file ccpp_utils.h - * - * CCPP utility functions. - * - * \ingroup CCPP - * \{ - **/ -#ifndef CCPP_UTILS_H -#define CCPP_UTILS_H - -#ifdef __cplusplus -extern "C" -{ -#endif - -/** Resolves the absolute path when given a relative path. **/ -int ccpp_abs_path(const char *, char **); - -#ifdef __cplusplus -} /* extern "C" */ -#endif - -#endif /* CCPP_UTILS_H */ - -/** - * \} - **/ diff --git a/src/ccpp_xml.F90 b/src/ccpp_xml.F90 deleted file mode 100644 index 0c90e730..00000000 --- a/src/ccpp_xml.F90 +++ /dev/null @@ -1,396 +0,0 @@ -! -! This work (Common Community Physics Package), identified by NOAA, NCAR, -! CU/CIRES, is free of known copyright restrictions and is placed in the -! public domain. -! -! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL -! THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER -! IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN -! CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -! - -!> -!! @brief XML functions and subroutines module. -!! -!! @details The XML module provides functions and -!! subroutines for accessing the C versions -!! of the functions. -! -module ccpp_xml - - use, intrinsic :: iso_c_binding - use :: ccpp_types, & - only: ccpp_suite_t, ccpp_group_t, & - ccpp_subcycle_t, ccpp_scheme_t, & - CCPP_STR_LEN - use :: ccpp_strings, & - only: ccpp_fstr, ccpp_cstr, ccpp_free - use :: ccpp_errors, & - only: ccpp_error, ccpp_warn - - - implicit none - - private - public :: ccpp_xml_load, & - ccpp_xml_unload, & - ccpp_xml_ele_find, & - ccpp_xml_ele_next, & - ccpp_xml_parse, & - CCPP_XML_ELE_SUITE, & - CCPP_XML_ELE_INIT, & - CCPP_XML_ELE_FINALIZE, & - CCPP_XML_ELE_GROUP, & - CCPP_XML_ELE_SUBCYCLE, & - CCPP_XML_ELE_SCHEME - - interface ccpp_xml_parse - module procedure ccpp_xml_parse_suite, & - ccpp_xml_parse_group, & - ccpp_xml_parse_subcycle, & - ccpp_xml_parse_fptr - end interface ccpp_xml_parse - - !> - !! @brief XML tags for a suite file. - !! - !! @details These suite xml tags must match the elements and attributes - !! of the suite.xsd. - ! - character(len=*), parameter :: CCPP_XML_ELE_SUITE = "suite" - character(len=*), parameter :: CCPP_XML_ELE_INIT = "init" - character(len=*), parameter :: CCPP_XML_ELE_FINALIZE = "finalize" - character(len=*), parameter :: CCPP_XML_ELE_GROUP = "group" - character(len=*), parameter :: CCPP_XML_ELE_SUBCYCLE = "subcycle" - character(len=*), parameter :: CCPP_XML_ELE_SCHEME = "scheme" - - character(len=*), parameter :: CCPP_XML_ATT_NAME = "name" - character(len=*), parameter :: CCPP_XML_ATT_LOOP = "loop" - character(len=*), parameter :: CCPP_XML_ATT_LIB = "lib" - character(len=*), parameter :: CCPP_XML_ATT_VER = "ver" - - interface - integer(c_int32_t) & - function ccpp_xml_load & - (filename, xml, root) & - bind(c, name='ccpp_xml_load') - import :: c_int32_t, c_char, c_ptr - character(kind=c_char), dimension(*) :: filename - type(c_ptr) :: xml - type(c_ptr) :: root - end function ccpp_xml_load - - integer(c_int32_t) & - function ccpp_xml_unload & - (xml) & - bind(c, name='ccpp_xml_unload') - import :: c_int32_t, c_ptr - type(c_ptr) :: xml - end function ccpp_xml_unload - - integer(c_int32_t) & - function ccpp_xml_ele_find_c & - (xml, name, ele) & - bind(c, name='ccpp_xml_ele_find') - import :: c_int32_t, c_ptr, c_char - type(c_ptr) :: xml - character(kind=c_char), dimension(*) :: name - type(c_ptr) :: ele - end function ccpp_xml_ele_find_c - - integer(c_int32_t) & - function ccpp_xml_ele_next_c & - (xml, name, ele) & - bind(c, name='ccpp_xml_ele_next') - import :: c_int32_t, c_ptr, c_char - type(c_ptr) :: xml - character(kind=c_char), dimension(*) :: name - type(c_ptr) :: ele - end function ccpp_xml_ele_next_c - - integer(c_int32_t) & - function ccpp_xml_ele_contents & - (xml, val) & - bind(c, name='ccpp_xml_ele_contents') - import :: c_int32_t, c_ptr, c_char - type(c_ptr) :: xml - type(c_ptr) :: val - end function ccpp_xml_ele_contents - - integer(c_int32_t) & - function ccpp_xml_ele_count & - (xml, name, n) & - bind(c, name='ccpp_xml_ele_count') - import :: c_int32_t, c_ptr, c_char - type(c_ptr) :: xml - character(kind=c_char), dimension(*) :: name - integer(c_int32_t) :: n - end function ccpp_xml_ele_count - - integer(c_int32_t) & - function ccpp_xml_ele_att & - (node, name, val) & - bind(c, name='ccpp_xml_ele_att') - import :: c_int32_t, c_ptr, c_char - type(c_ptr) :: node - character(kind=c_char), dimension(*) :: name - type(c_ptr) :: val - end function ccpp_xml_ele_att - - end interface - - contains - - !> - !! Find an element in a XML structure. - !! - !! @param[in ] xml The xml structure. - !! @param[in,out] name The element name to find. - !! @param[ out] ele The element (if found). - !! @param[ out] ierr Integer error flag. - ! - subroutine ccpp_xml_ele_find(xml, name, ele, ierr) - type(c_ptr), intent(in ) :: xml - character(len=*), intent(in ) :: name - type(c_ptr), intent( out) :: ele - integer, intent( out) :: ierr - - ierr = ccpp_xml_ele_find_c(xml, ccpp_cstr(name), ele) - end subroutine ccpp_xml_ele_find - - !> - !! Move to the next occurance of an element in a - !! XML structure. - !! - !! @param[in ] xml The xml structure. - !! @param[in,out] name The element name to find. - !! @param[ out] ele The element (if found). - !! @param[ out] ierr Integer error flag. - ! - subroutine ccpp_xml_ele_next(xml, name, ele, ierr) - type(c_ptr), intent(inout) :: xml - character(len=*), intent(in ) :: name - type(c_ptr), intent(inout) :: ele - integer, intent( out) :: ierr - - ierr = ccpp_xml_ele_next_c(xml, ccpp_cstr(name), ele) - end subroutine ccpp_xml_ele_next - - !> - !! Parse a suite element from an XML structure. - !! - !! @param[in ] node The current xml node. - !! @param[in,out] suite The ccpp_suite_t type to parse into. - !! @param[ out] ierr Integer error flag. - ! - subroutine ccpp_xml_parse_suite(node, suite, ierr) - type(c_ptr), intent(in ) :: node - type(ccpp_suite_t), intent(inout) :: suite - integer, intent( out) :: ierr - - type(c_ptr), target :: tmp - - tmp = c_null_ptr - - ! Get the suite name - ierr = ccpp_xml_ele_att(node, ccpp_cstr(CCPP_XML_ATT_NAME), tmp) - if (ierr /= 0) then - call ccpp_error('Unable to retrieve suite name') - return - end if - suite%name = ccpp_fstr(tmp) - call ccpp_free(tmp) - - tmp = c_null_ptr - - ! Get the optional library name - ierr = ccpp_xml_ele_att(node, ccpp_cstr(CCPP_XML_ATT_LIB), tmp) - if (ierr == 0) then - suite%library = ccpp_fstr(tmp) - call ccpp_free(tmp) - tmp = c_null_ptr - else - suite%library = suite%name - end if - - ! Get the optional library version - ierr = ccpp_xml_ele_att(node, ccpp_cstr(CCPP_XML_ATT_VER), tmp) - if (ierr == 0) then - suite%version = ccpp_fstr(tmp) - call ccpp_free(tmp) - tmp = c_null_ptr - else - allocate(character(CCPP_STR_LEN) :: suite%version, stat=ierr) - if (ierr /= 0) then - call ccpp_error('Unable to allocate suite library version') - return - end if - suite%version = '' - ierr = 0 - end if - - ! Count the number of groups - ierr = ccpp_xml_ele_count(node, ccpp_cstr(CCPP_XML_ELE_GROUP), suite%groups_max) - if (ierr /= 0) then - call ccpp_error('Unable count the number of groups') - return - end if - - allocate(suite%groups(suite%groups_max), stat=ierr) - if (ierr /= 0) then - call ccpp_error('Unable to allocate groups') - return - end if - - end subroutine ccpp_xml_parse_suite - - !! Group parsing from an XML file. - !! - !! @param[in ] node The current xml node. - !! @param[in ] max_groups The maximum number of groups. - !! @param[in,out] group The ccpp_group_t type to parse into. - !! @param[ out] ierr Integer error flag. - ! - subroutine ccpp_xml_parse_group(node, max_groups, group, ierr) - type(c_ptr), intent(in ) :: node - integer, intent(in ) :: max_groups - type(ccpp_group_t), intent(inout) :: group - integer, intent( out) :: ierr - - type(c_ptr), target :: tmp - character(kind=c_char), target :: stmp(CCPP_STR_LEN) - - tmp = c_null_ptr - - ! Get the group name - ierr = ccpp_xml_ele_att(node, ccpp_cstr(CCPP_XML_ATT_NAME), tmp) - if (ierr /= 0) then - call ccpp_error('Unable to retrieve group name') - return - end if - group%name = ccpp_fstr(tmp) - call ccpp_free(tmp) - - tmp = c_null_ptr - - ! Count the number of subcycles in this group - ierr = ccpp_xml_ele_count(node, ccpp_cstr(CCPP_XML_ELE_SUBCYCLE), & - group%subcycles_max) - if (ierr /= 0) then - call ccpp_error('Unable to count the number of: ' // & - CCPP_XML_ELE_SUBCYCLE) - return - end if - - allocate(group%subcycles(group%subcycles_max), stat=ierr) - if (ierr /= 0) then - call ccpp_error('Unable to allocate subcycles') - return - end if - - end subroutine ccpp_xml_parse_group - - !> - !! Subcycle parsing from an XML file. - !! - !! @param[in ] node The current xml node. - !! @param[in ] max_subcycles The maximum number of subcycles. - !! @param[in,out] subcycle The ccpp_subcycle_t type to parse into. - !! @param[ out] ierr Integer error flag. - ! - subroutine ccpp_xml_parse_subcycle(node, max_subcycles, subcycle, ierr) - type(c_ptr), intent(in ) :: node - integer, intent(in ) :: max_subcycles - type(ccpp_subcycle_t), intent(inout) :: subcycle - integer, intent( out) :: ierr - - type(c_ptr), target :: tmp - character(kind=c_char), target :: stmp(CCPP_STR_LEN) - - - tmp = c_null_ptr - - ! Get the subcycle loop number - ierr = ccpp_xml_ele_att(node, ccpp_cstr(CCPP_XML_ATT_LOOP), tmp) - if (ierr /= 0) then - call ccpp_error('Unable to find subcycle attribute: ' // CCPP_XML_ATT_LOOP) - return - else - stmp = ccpp_fstr(tmp) - read(stmp, *, iostat=ierr) subcycle%loops_max - call ccpp_free(tmp) - tmp = c_null_ptr - if (ierr /= 0) then - call ccpp_error('Unable to convert subcycle attribute "' // & - CCPP_XML_ATT_LOOP // '" to an integer') - return - end if - end if - - ! Count the number of schemes - ierr = ccpp_xml_ele_count(node, ccpp_cstr(CCPP_XML_ELE_SCHEME), & - subcycle%schemes_max) - if (ierr /= 0) then - call ccpp_error('Unable to count the number of: ' // & - CCPP_XML_ELE_SCHEME) - return - end if - - allocate(subcycle%schemes(subcycle%schemes_max), stat=ierr) - if (ierr /= 0) then - call ccpp_error('Unable to allocate subcycles') - return - end if - - end subroutine ccpp_xml_parse_subcycle - - !> - !! Function pointer (scheme/init/finalize) parsing from an XML file. - !! - !! @param[in ] node The current xml node. - !! @param[in ] lib The default library name. - !! @param[in ] ver The default library version. - !! @param[in,out] fptr The ccpp_scheme_t type to load into. - !! @param[ out] ierr Integer error flag. - ! - subroutine ccpp_xml_parse_fptr(node, lib, ver, fptr, ierr) - type(c_ptr), intent(in ) :: node - character(len=*), intent(in ) :: lib - character(len=*), intent(in ) :: ver - type(ccpp_scheme_t), intent(inout) :: fptr - integer, intent( out) :: ierr - - type(c_ptr), target :: tmp - - tmp = c_null_ptr - - ierr = ccpp_xml_ele_contents(node, tmp) - if (ierr /= 0) then - return - end if - - fptr%name = ccpp_fstr(tmp) - call ccpp_free(tmp) - - ierr = ccpp_xml_ele_att(node, ccpp_cstr(CCPP_XML_ATT_LIB), tmp) - if (ierr == 0) then - fptr%library = ccpp_fstr(tmp) - call ccpp_free(tmp) - else - fptr%library = lib - end if - - ierr = ccpp_xml_ele_att(node, ccpp_cstr(CCPP_XML_ATT_VER), tmp) - if (ierr == 0) then - fptr%version = ccpp_fstr(tmp) - call ccpp_free(tmp) - else - fptr%version = ver - end if - - ierr = 0 - end subroutine ccpp_xml_parse_fptr - -end module ccpp_xml diff --git a/src/ccpp_xml.c b/src/ccpp_xml.c deleted file mode 100644 index 0335d074..00000000 --- a/src/ccpp_xml.c +++ /dev/null @@ -1,246 +0,0 @@ -/* - * This work (Common Community Physics Package), identified by NOAA, NCAR, - * CU/CIRES, is free of known copyright restrictions and is placed in the - * public domain. - * - * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR - * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, - * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL - * THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER - * IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN - * CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. - */ - -/** - * @file ccpp_xml.c - * - * @brief Routines and functions for processing a XML file. - * This is a very thin layer around libxml2. - * - * - * @ingroup XML - * @{ - **/ - -#include -#include -#include -#include -#include - -#include -#include - -#include "ccpp_xml.h" - -/** - * Read a xml file and load the information. - * - * @param[in] filename The xml file name. - * @param[out] xml The xml document pointer. - * @param[out] root The root node of the xml document. - * @retval 0 If it was sucessful. - * @retval 1 If there was an error. - **/ -int -ccpp_xml_load(const char *filename, void **xml, void **root) -{ - - /* Read the file into a document tree */ - *xml = (void *)xmlReadFile(filename, NULL, 0); - if (*xml == NULL) { - warnx("Failed to parse %s", filename); - return(EXIT_FAILURE); - } - - *root = (void *)xmlDocGetRootElement((xmlDocPtr)(*xml)); - - return(EXIT_SUCCESS); -} - -/** - * Unload the XML document and clean-up the XML parser. - * - * @param[in] xml The xml document pointer. - * @retval 0 If it was sucessful. - * @retval 1 If there was an error. - **/ -int -ccpp_xml_unload(void **xml) -{ - xmlDocPtr doc = NULL; /**< XML document tree **/ - - doc = (xmlDocPtr)(*xml); - - /* Free the document tree */ - xmlFreeDoc(doc); - - /* Clean up the parser */ - xmlCleanupParser(); - - return(EXIT_SUCCESS); -} - -/** - * Get the first occurance of the node. - * - * @param[in] node The toplevel node pointer to start from. - * @param[in] name The name element to retrieve. - * @param[out] ele The first occurance of the element. - * @retval 0 If it was sucessful. - * @retval 1 If there was an error. - **/ -int -ccpp_xml_ele_find(void **node, const char *name, void **ele) -{ - xmlNodePtr cur = NULL; /**< XML tree root node **/ - - cur = (xmlNodePtr)(*node); - - /* Loop through all children finding the first requested element*/ - cur = cur->xmlChildrenNode; - while (cur != NULL) { - if (xmlStrcmp(cur->name, (const xmlChar *)name) == 0) { - *ele = (void *)cur; - break; - } - cur = cur->next; - } - if (!*ele) { - return(EXIT_FAILURE); - } - - return(EXIT_SUCCESS); -} - -/** - * Get the next occurance of the node. - * - * This uses xmlNextElementSibling() followed by a check of - * the name. - * - * @param[in] node The toplevel node pointer to start from. - * @param[in] name The name element to retrieve. - * @param[out] ele The next occurance of the element. - * @retval 0 If it was sucessful. - * @retval 1 If there was an error. - **/ -int -ccpp_xml_ele_next(void **node, const char *name, void **ele) -{ - xmlNodePtr cur = NULL; /**< XML tree root node **/ - - cur = (xmlNodePtr)(*node); - - cur = xmlNextElementSibling(cur); - /* Loop through all siblings finding the element requested */ - while (cur != NULL) { - if (xmlStrcmp(cur->name, (const xmlChar *)name) == 0) { - *ele = (void *)cur; - break; - } - cur = xmlNextElementSibling(cur); - } - if (!*ele) { - return(EXIT_FAILURE); - } - - return(EXIT_SUCCESS); -} - -/** - * Count the number of elements within the XML node. - * - * @param[in] node The toplevel node pointer to start from. - * @param[in] name The name element to count. - * @param[out] n The number of times the element was found. - * @retval 0 If it was sucessful. - * @retval 1 If there was an error. - **/ -int -ccpp_xml_ele_count(void **node, const char *name, int *n) -{ - xmlNodePtr cur = NULL; /**< XML tree root node **/ - - cur = (xmlNodePtr)(*node); - - *n = 0; - - /* Count the number of elements */ - cur = cur->xmlChildrenNode; - while (cur != NULL) { - if (xmlStrcmp(cur->name, (const xmlChar *)name) == 0) { - ++(*n); - } - cur = cur->next; - } - - return(EXIT_SUCCESS); -} - -/** - * Get the contents of a node. - * - * @param[in] node The toplevel node pointer to start from. - * @param[out] value The value of the attribute. - * @retval 0 If it was sucessful. - * @retval 1 If there was an error. - **/ -int -ccpp_xml_ele_contents(void **node, char **value) -{ - int n = 0; /**< String length **/ - xmlNodePtr cur = NULL; /**< XML tree node **/ - xmlChar *tmp = NULL; /**< The contents value **/ - - cur = (xmlNodePtr)(*node); - - tmp = xmlNodeGetContent(cur); - if (!tmp) { - return(EXIT_FAILURE); - } - - n = strlen((char *)tmp); - *value = malloc((n+1) * sizeof(char)); - strncpy(*value, (char *)tmp, n * sizeof(char)); - (*value)[n] = '\0'; - xmlFree(tmp); - - return(EXIT_SUCCESS); -} - -/** - * Get the attribute at the node. - * - * @param[in] node The toplevel node pointer to start from. - * @param[in] name The name of the attribute to get. - * @param[out] value The value of the attribute. - * @retval 0 If it was sucessful. - * @retval 1 If there was an error. - **/ -int -ccpp_xml_ele_att(void **node, const char *name, char **value) -{ - int n = 0; /**< String length **/ - xmlNodePtr cur = NULL; /**< XML tree node **/ - xmlChar *tmp = NULL; /**< The attribute value **/ - - cur = (xmlNodePtr)(*node); - - tmp = xmlGetProp(cur, (const xmlChar *)name); - if (!tmp) { - return(EXIT_FAILURE); - } - - n = strlen((char *)tmp); - *value = malloc((n+1) * sizeof(char)); - strncpy(*value, (char *)tmp, n * sizeof(char)); - (*value)[n] = '\0'; - xmlFree(tmp); - - return(EXIT_SUCCESS); -} - -/** - * @} - **/ diff --git a/src/ccpp_xml.h b/src/ccpp_xml.h deleted file mode 100644 index 7274bf3d..00000000 --- a/src/ccpp_xml.h +++ /dev/null @@ -1,60 +0,0 @@ -/* - * This work (Common Community Physics Package), identified by NOAA, NCAR, - * CU/CIRES, is free of known copyright restrictions and is placed in the - * public domain. - * - * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR - * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, - * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL - * THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER - * IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN - * CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. - */ - -/** - * @file ccpp_xml.h - * - * Routines and functions for processing xml files. - * - * @ingroup XML - * @{ - **/ -#ifndef CCPP_XML_H -#define CCPP_XML_H - -#ifdef __cplusplus -extern "C" -{ -#endif - -/** Load a XML file. **/ -int ccpp_xml_load(const char *, void **, void **); - -/** Unload the XML document and finish using the XML library **/ -int ccpp_xml_unload(void **); - -/** Find the first occurance of the specified element within in a XML - * document/node **/ -int ccpp_xml_ele_find(void **, const char *, void **); - -/** Find the next occurance of the specified element within in a XML node **/ -int ccpp_xml_ele_next(void **, const char *, void **); - -/** Get the contents of the node **/ -int ccpp_xml_ele_contents(void **, char **); - -/** Count the number of specifid elements within in a XML document/node **/ -int ccpp_xml_ele_count(void **, const char *, int *); - -/** Get the attribute at the node. **/ -int ccpp_xml_ele_att(void **, const char *, char **); - -#ifdef __cplusplus -} /* extern "C" */ -#endif - -#endif /* CCPP_XML_H */ - -/** - * @} - **/ diff --git a/src/tests/CMakeLists.txt b/src/tests/CMakeLists.txt deleted file mode 100644 index 4342303f..00000000 --- a/src/tests/CMakeLists.txt +++ /dev/null @@ -1,53 +0,0 @@ - -#------------------------------------------------------------------------------ -# Add all the tests -add_executable(test_init_finalize test_init_finalize.f90) -target_link_libraries(test_init_finalize ccpp) - -add_executable(test_fields test_fields.c) -target_link_libraries(test_fields ccpp) - -add_executable(test_check test_check.f90) -target_link_libraries(test_check ccpp) - - -#------------------------------------------------------------------------------ -# Run all the tests - -# Make sure we can accept valid xml suites and reject invalid ones -add_test(XML_1 test_init_finalize ${CMAKE_CURRENT_SOURCE_DIR}/suite_noop_1.xml) -add_test(XML_2 test_init_finalize ${CMAKE_CURRENT_SOURCE_DIR}/suite_noop_2.xml) -add_test(XML_3 test_init_finalize ${CMAKE_CURRENT_SOURCE_DIR}/suite_noop_3.xml) -add_test(XML_4 test_init_finalize ${CMAKE_CURRENT_SOURCE_DIR}/suite_noop_4.xml) -add_test(XML_5 test_init_finalize ${CMAKE_CURRENT_SOURCE_DIR}/suite_noop_5.xml) -add_test(XML_6 test_init_finalize ${CMAKE_CURRENT_SOURCE_DIR}/suite_noop_6.xml) - -# Make sure we can grow the fields index -add_test(FIELDS test_fields) - -# Make sure we can do the cap call -add_test(CHECK_1 test_check ${CMAKE_CURRENT_SOURCE_DIR}/suite_check_1.xml) -add_test(CHECK_2 test_check ${CMAKE_CURRENT_SOURCE_DIR}/suite_check_2.xml) -add_test(CHECK_3 test_check ${CMAKE_CURRENT_SOURCE_DIR}/suite_check_3.xml) - -set_tests_properties(XML_3 PROPERTIES WILL_FAIL TRUE) - -set_tests_properties(XML_1 - XML_2 - XML_3 - XML_4 - XML_5 - XML_6 - CHECK_1 - CHECK_2 - CHECK_3 - PROPERTIES ENVIRONMENT "LD_LIBRARY_PATH=${CMAKE_CURRENT_BINARY_DIR}/../../schemes/check/src/check-build:$ENV{LD_LIBRARY_PATH}") - -#------------------------------------------------------------------------------ -# Coverage tests -if(CMAKE_COMPILER_IS_GNUCC AND (CMAKE_BUILD_TYPE STREQUAL "Coverage")) - setup_target_for_coverage(coverage - "test_check - ${CMAKE_CURRENT_SOURCE_DIR}/suite_check_1.xml" - coverage) -endif() diff --git a/src/tests/suite.xsd b/src/tests/suite.xsd deleted file mode 100644 index df7e9c6c..00000000 --- a/src/tests/suite.xsd +++ /dev/null @@ -1,49 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/src/tests/suite_EXAMPLE.xml b/src/tests/suite_EXAMPLE.xml deleted file mode 100644 index 5e45643e..00000000 --- a/src/tests/suite_EXAMPLE.xml +++ /dev/null @@ -1,10 +0,0 @@ - - - - - - test - - - - diff --git a/src/tests/suite_check_1.xml b/src/tests/suite_check_1.xml deleted file mode 100644 index b77e1be5..00000000 --- a/src/tests/suite_check_1.xml +++ /dev/null @@ -1,10 +0,0 @@ - - - - - - test - - - - diff --git a/src/tests/suite_check_2.xml b/src/tests/suite_check_2.xml deleted file mode 100644 index 562c1b7c..00000000 --- a/src/tests/suite_check_2.xml +++ /dev/null @@ -1,10 +0,0 @@ - - - - - - test - - - - diff --git a/src/tests/suite_check_3.xml b/src/tests/suite_check_3.xml deleted file mode 100644 index ae6949b9..00000000 --- a/src/tests/suite_check_3.xml +++ /dev/null @@ -1,10 +0,0 @@ - - - - - - test - - - - diff --git a/src/tests/suite_noop_1.xml b/src/tests/suite_noop_1.xml deleted file mode 100644 index 8066e51c..00000000 --- a/src/tests/suite_noop_1.xml +++ /dev/null @@ -1,10 +0,0 @@ - - - - - - noop - - - - diff --git a/src/tests/suite_noop_2.xml b/src/tests/suite_noop_2.xml deleted file mode 100644 index 2cdcce84..00000000 --- a/src/tests/suite_noop_2.xml +++ /dev/null @@ -1,10 +0,0 @@ - - - - - - noop - - - - diff --git a/src/tests/suite_noop_3.xml b/src/tests/suite_noop_3.xml deleted file mode 100644 index 36e6d4d9..00000000 --- a/src/tests/suite_noop_3.xml +++ /dev/null @@ -1,10 +0,0 @@ - - - - - - noop - - - - diff --git a/src/tests/suite_noop_4.xml b/src/tests/suite_noop_4.xml deleted file mode 100644 index a53ee1df..00000000 --- a/src/tests/suite_noop_4.xml +++ /dev/null @@ -1,22 +0,0 @@ - - - - - - noop - - - - - noop - - - - - noop - noop - noop - - - - diff --git a/src/tests/suite_noop_5.xml b/src/tests/suite_noop_5.xml deleted file mode 100644 index 2aeb67c2..00000000 --- a/src/tests/suite_noop_5.xml +++ /dev/null @@ -1,13 +0,0 @@ - - - - - - noop - - - noop - - - - diff --git a/src/tests/suite_noop_6.xml b/src/tests/suite_noop_6.xml deleted file mode 100644 index 711ee02e..00000000 --- a/src/tests/suite_noop_6.xml +++ /dev/null @@ -1,10 +0,0 @@ - - - - - - noop - - - - diff --git a/src/tests/test_check.f90 b/src/tests/test_check.f90 deleted file mode 100644 index 68016019..00000000 --- a/src/tests/test_check.f90 +++ /dev/null @@ -1,168 +0,0 @@ -! -! This work (Common Community Physics Package), identified by NOAA, NCAR, -! CU/CIRES, is free of known copyright restrictions and is placed in the -! public domain. -! -! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL -! THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER -! IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN -! CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -! - -!> -!! @brief A Test Atmospheric Driver Program. -!! -program test_check - -!! \section arg_table_test_check -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |-------------------------------------------|----------------------------|---------|------|-----------|----------|--------|----------| -!! | gravity | gravitational_acceleration | gravitational acceleration | m s-2 | 0 | real | | none | F | -!! | u | x_wind | zonal wind | m s-1 | 2 | real | | none | F | -!! | v | y_wind | meridional wind | m s-1 | 2 | real | | none | F | -!! | tsfc | surface_skin_temperature | surface skin temperature | K | 1 | real | | none | F | -!! - - use, intrinsic :: iso_c_binding, & - only: c_loc, c_f_pointer - use :: ccpp_api, & - only: CCPP_STR_LEN, & - ccpp_t, & - ccpp_init, & - ccpp_finalize, & - ccpp_physics_init, & - ccpp_physics_run, & - ccpp_physics_finalize, & - ccpp_field_add - - implicit none - - type(ccpp_t), target :: cdata - character(len=CCPP_STR_LEN) :: filename - integer :: len - integer :: ierr - integer :: asize - real, target :: gravity - real, target, allocatable, dimension(:,:) :: u - real, target, allocatable, dimension(:,:) :: v - real, target, allocatable, dimension(:) :: tsfc - - ierr = 0 - - call get_command_argument(1, filename, len, ierr) - if (ierr /= 0) then - call exit(1) - end if - - ! Allocate the data - asize = 5 - allocate(tsfc(asize), stat=ierr) - if (ierr /= 0) then - print *, 'Unable to allocate surface temperature array' - call exit(1) - end if - - allocate(u(asize,asize), stat=ierr) - if (ierr /= 0) then - print *, 'Unable to allocate U array' - call exit(1) - end if - - allocate(v(asize,asize), stat=ierr) - if (ierr /= 0) then - print *, 'Unable to allocate U array' - call exit(1) - end if - - ! Generate data to pass into a physics driver - gravity = 9.80665 - tsfc = [290.0, 291.0, 292.0, 293.0, 294.0] - u = 0.0 - v = 10.0 - - ! Initalize the CCPP framework (with the filename - ! of the suite to load instead of the suite name) - call ccpp_init(trim(filename), cdata, ierr, is_filename=.true.) - if (ierr /= 0) then - call exit(1) - end if - - call ccpp_field_add(cdata, 'ccpp_error_flag', cdata%errflg, ierr, 'flag') - if (ierr /= 0) then - call exit(1) - end if - - call ccpp_field_add(cdata, 'ccpp_error_message', cdata%errmsg, ierr, 'none') - if (ierr /= 0) then - call exit(1) - end if - - call ccpp_field_add(cdata, 'ccpp_loop_counter', cdata%loop_cnt, ierr, 'index') - if (ierr /= 0) then - call exit(1) - end if - - ! Add all the fields we want to expose to the physics driver. - call ccpp_field_add(cdata, 'gravitational_acceleration', gravity, ierr, 'm s-2') - if (ierr /= 0) then - call exit(1) - end if - - call ccpp_field_add(cdata, 'surface_skin_temperature', tsfc, ierr, 'K') - if (ierr /= 0) then - call exit(1) - end if - - call ccpp_field_add(cdata, 'x_wind', u, ierr, 'm s-1') - if (ierr /= 0) then - call exit(1) - end if - - call ccpp_field_add(cdata, 'y_wind', v, ierr, 'm s-1') - if (ierr /= 0) then - call exit(1) - end if - - ! Initialize the test scheme - call ccpp_physics_init(cdata, ierr=ierr) - if (ierr /= 0) then - call exit(1) - end if - - ! Run the test scheme - call ccpp_physics_run(cdata, scheme_name="test", ierr=ierr) - if (ierr /= 0) then - print *, "Call to scheme test failed, error message: '" // trim(cdata%errmsg) // "'" - call exit(1) - end if - - print *, 'In test dummy main' - print *, 'gravity: ', gravity - print *, 'tsfc: ', tsfc(1:2) - print *, 'u: ', u(1,1) - print *, 'v: ', v(1,1) - - ! Finalize the test scheme - call ccpp_physics_finalize(cdata, ierr=ierr) - if (ierr /= 0) then - call exit(1) - end if - - ! Finalize the CCPP framework - call ccpp_finalize(cdata, ierr) - - if (allocated(tsfc)) then - deallocate(tsfc) - end if - - if (allocated(u)) then - deallocate(u) - end if - - if (allocated(v)) then - deallocate(v) - end if - -end program test_check diff --git a/src/tests/test_fields.c b/src/tests/test_fields.c deleted file mode 100644 index 235e2b35..00000000 --- a/src/tests/test_fields.c +++ /dev/null @@ -1,50 +0,0 @@ -/* - * This work (Common Community Physics Package), identified by NOAA, NCAR, - * CU/CIRES, is free of known copyright restrictions and is placed in the - * public domain. - * - * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR - * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, - * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL - * THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER - * IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN - * CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. - */ - -/** - * A test to make sure the field array is growable. - **/ - -#include -#include - -#include "ccpp_fields_idx.h" - -int -main(int argc, char **argv) -{ - int i = 0; - int n = 100; - char f[10] = {0}; - void *cdata = NULL; - - if (ccpp_field_idx_init(&cdata)) { - return(EXIT_FAILURE); - } - - for (i = 0; i < n; ++i) { - sprintf(f, "f_%d", i); - if (ccpp_field_idx_add(f, &cdata) <= 0) { - return(EXIT_FAILURE); - } - } - - i = ccpp_field_idx_find("f_90", &cdata); - printf("%d\n", i); - - if (ccpp_field_idx_finalize(&cdata)) { - return(EXIT_FAILURE); - } - - return(EXIT_SUCCESS); -} diff --git a/src/tests/test_init_finalize.f90 b/src/tests/test_init_finalize.f90 deleted file mode 100644 index b922173f..00000000 --- a/src/tests/test_init_finalize.f90 +++ /dev/null @@ -1,58 +0,0 @@ -! -! This work (Common Community Physics Package), identified by NOAA, NCAR, -! CU/CIRES, is free of known copyright restrictions and is placed in the -! public domain. -! -! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL -! THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER -! IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN -! CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -! - -!> -!! @brief A test program to test the CCPP. -!! -!! @details This will test the -!! - initialization and finalization subroutines of -!! -- CCPP -!! -- Suite -!! -- Fields -!! It can be used multipile times to test the parsing -!! of various suite XML files. -! -program test_init_finalize - - use :: ccpp_types, & - only: CCPP_STR_LEN, ccpp_t - use :: ccpp, & - only: ccpp_init, ccpp_finalize - - implicit none - - integer :: ierr - integer :: len - character(len=CCPP_STR_LEN) :: filename - type(ccpp_t), target :: cdata - - - ierr = 0 - - call get_command_argument(1, filename, len, ierr) - if (ierr /= 0) then - print *, 'Error: no suite XML file specified.' - call exit(ierr) - end if - - call ccpp_init(trim(filename), cdata, ierr, is_filename=.true.) - if (ierr /= 0) then - call exit(ierr) - end if - - call ccpp_finalize(cdata, ierr) - if (ierr /= 0) then - call exit(ierr) - end if - -end program test_init_finalize