diff --git a/.gitmodules b/.gitmodules
index 949b88cd..1fc97042 100644
--- a/.gitmodules
+++ b/.gitmodules
@@ -14,7 +14,7 @@
[submodule "ncar-physics"]
path = src/physics/ncar_ccpp
url = https://github.com/ESCOMP/atmospheric_physics
- fxtag = atmos_phys0_05_000
+ fxtag = atmos_phys0_05_001
fxrequired = AlwaysRequired
fxDONOTUSEurl = https://github.com/ESCOMP/atmospheric_physics
[submodule "ccs_config"]
diff --git a/cime_config/cam_autogen.py b/cime_config/cam_autogen.py
index eeb31229..863806ec 100644
--- a/cime_config/cam_autogen.py
+++ b/cime_config/cam_autogen.py
@@ -435,10 +435,15 @@ def generate_physics_suites(build_cache, preproc_defs, host_name,
if not os.path.exists(physics_blddir):
os.makedirs(physics_blddir)
# End if
- # Collect all source directories
- atm_phys_src_dir = os.path.join(atm_root, "src", "physics", "ncar_ccpp")
- source_search = [source_mods_dir, atm_phys_src_dir]
- # Find all metadata files, organize by scheme name
+ # Set top-level CCPP physics directory
+ atm_phys_top_dir = os.path.join(atm_root, "src", "physics", "ncar_ccpp")
+ # Collect all possible Suite Definition File (SDF) locations
+ atm_suites_path = os.path.join(atm_phys_top_dir, "suites")
+ atm_test_suites_path = os.path.join(atm_phys_top_dir, "test", "test_suites")
+ suite_search = [source_mods_dir, atm_suites_path, atm_test_suites_path]
+ # Find all scheme metadata files, organized by scheme name
+ atm_schemes_path = os.path.join(atm_phys_top_dir, "schemes")
+ source_search = [source_mods_dir, atm_schemes_path]
all_scheme_files = _find_metadata_files(source_search, find_scheme_names)
# Find the SDFs specified for this model build
@@ -446,11 +451,15 @@ def generate_physics_suites(build_cache, preproc_defs, host_name,
scheme_files = []
xml_files = {} # key is scheme, value is xml file path
for sdf in phys_suites_str.split(';'):
- sdf_path = _find_file(f"suite_{sdf}.xml", source_search)
+ sdf_path = _find_file(f"suite_{sdf}.xml", suite_search)
if not sdf_path:
emsg = f"ERROR: Unable to find SDF for suite '{sdf}'"
raise CamAutoGenError(emsg)
# End if
+ if os.path.dirname(os.path.abspath(sdf_path)) == atm_test_suites_path:
+ #Notify user that a test suite is being used
+ _LOGGER.info("Using non-standard test suite: %s", sdf)
+ # End if
sdfs.append(sdf_path)
# Given an SDF, find all the schemes it calls
_, suite = read_xml_file(sdf_path)
@@ -587,7 +596,7 @@ def generate_physics_suites(build_cache, preproc_defs, host_name,
# there to the bld directory:
if do_gen_ccpp:
# Set CCPP physics "utilities" path
- atm_phys_util_dir = os.path.join(atm_phys_src_dir, "utilities")
+ atm_phys_util_dir = os.path.join(atm_schemes_path, "utilities")
# Check that directory exists
if not os.path.isdir(atm_phys_util_dir):
diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml
index 9b715c97..c93a9de8 100644
--- a/cime_config/config_component.xml
+++ b/cime_config/config_component.xml
@@ -159,12 +159,10 @@
-nlev 145 -->
-
+
+ --physics-suites tj2016 --analytic_ic
+
--physics-suites kessler --analytic_ic
--physics-suites held_suarez_1994 --analytic_ic
--dyn none --physics-suites adiabatic
diff --git a/src/physics/ncar_ccpp b/src/physics/ncar_ccpp
index 93a1dbf9..f8ce60bf 160000
--- a/src/physics/ncar_ccpp
+++ b/src/physics/ncar_ccpp
@@ -1 +1 @@
-Subproject commit 93a1dbf9c47ccedb8d8a48eba640e48ab2048774
+Subproject commit f8ce60bf40f800623f8eb3065021ec5dfa9e6b45
diff --git a/test/include/Makefile b/test/include/Makefile
deleted file mode 100644
index 699930a6..00000000
--- a/test/include/Makefile
+++ /dev/null
@@ -1,14 +0,0 @@
-FC = gfortran
-FFLAGS = -c -DCPRGNU
-
-SOURCES = shr_kind_mod.F90 shr_infnan_mod.F90 ccpp_kinds.F90 cam_abortutils.F90
-SOURCES += spmd_utils.F90 cam_logfile.F90
-OBJS = $(SOURCES:.F90=.o)
-
-all: objs
-
-objs: $(SOURCES)
- $(FC) $(FFLAGS) $(SOURCES)
-
-clean:
- ${RM} *.o *.mod
diff --git a/test/include/cam_abortutils.F90 b/test/include/cam_abortutils.F90
deleted file mode 100644
index 8db9729e..00000000
--- a/test/include/cam_abortutils.F90
+++ /dev/null
@@ -1,17 +0,0 @@
-module cam_abortutils
-
- implicit none
- private
-
- public endrun
-
-CONTAINS
-
- subroutine endrun(msg)
- character(len=*), intent(in) :: msg
-
- write(6, *) msg
- STOP
- end subroutine endrun
-
-end module cam_abortutils
diff --git a/test/include/cam_logfile.F90 b/test/include/cam_logfile.F90
deleted file mode 100644
index 8e1a8998..00000000
--- a/test/include/cam_logfile.F90
+++ /dev/null
@@ -1,96 +0,0 @@
-module cam_logfile
-
-!-----------------------------------------------------------------------
-!
-! Purpose: This module is responsible for managing the logical unit
-! of CAM's output log
-!
-! Author: mvr, Sep 2007
-!
-!-----------------------------------------------------------------------
-
-!-----------------------------------------------------------------------
-!- use statements ------------------------------------------------------
-!-----------------------------------------------------------------------
-!-----------------------------------------------------------------------
-!- module boilerplate --------------------------------------------------
-!-----------------------------------------------------------------------
- implicit none
- private
- save
-
-!-----------------------------------------------------------------------
-! Public interfaces ----------------------------------------------------
-!-----------------------------------------------------------------------
- public :: cam_set_log_unit
- public :: cam_logfile_readnl
- public :: cam_log_multiwrite
-!-----------------------------------------------------------------------
-! Public data ----------------------------------------------------------
-!-----------------------------------------------------------------------
- integer, public, protected :: iulog = 6
- integer, public, parameter :: DEBUGOUT_NONE = 0
- integer, public, parameter :: DEBUGOUT_INFO = 1
- integer, public, parameter :: DEBUGOUT_VERBOSE = 2
- integer, public, parameter :: DEBUGOUT_DEBUG = 3
- integer, public, protected :: debug_output = DEBUGOUT_NONE
-
-!-----------------------------------------------------------------------
-! Private data ---------------------------------------------------------
-!-----------------------------------------------------------------------
- logical :: iulog_set = .true.
-
- interface cam_log_multiwrite
- module procedure cam_log_multiwrite_ni ! Multiple integers
- end interface cam_log_multiwrite
-
-CONTAINS
-
-!-----------------------------------------------------------------------
-! Subroutines and functions --------------------------------------------
-!-----------------------------------------------------------------------
-
- subroutine cam_set_log_unit(unit_num)
-
- integer, intent(in) :: unit_num
-
- ! Change iulog to unit_num on this PE or log a waring
- ! The log unit number can be set at most once per run
- if (iulog_set) then
- write(iulog, *) 'cam_set_log_unit: Cannot change log unit during run'
- else
- iulog = unit_num
- iulog_set = .true.
- end if
- end subroutine cam_set_log_unit
-
- subroutine cam_logfile_readnl(nlfile)
-
- ! nlfile: filepath for file containing namelist input
- character(len=*), intent(in) :: nlfile
-
- end subroutine cam_logfile_readnl
-
- subroutine cam_log_multiwrite_ni(subname, headers, fmt_string, values)
- ! Print out values from every task
- use spmd_utils, only: masterproc
-
- ! Dummy arguments
- character(len=*), intent(in) :: subname
- character(len=*), intent(in) :: headers
- character(len=*), intent(in) :: fmt_string
- integer, intent(in) :: values(:)
- ! Local variables
- integer :: num_fields
- integer :: fnum
-
- num_fields = size(values, 1)
-
- if (masterproc) then
- write(iulog, '(2a)') trim(subname), trim(headers)
- write(iulog, fmt_string) subname, 0, &
- (values(fnum), fnum = 1, num_fields)
- end if
- end subroutine cam_log_multiwrite_ni
-
-end module cam_logfile
diff --git a/test/include/ccpp_kinds.F90 b/test/include/ccpp_kinds.F90
deleted file mode 100644
index c90c9cae..00000000
--- a/test/include/ccpp_kinds.F90
+++ /dev/null
@@ -1,10 +0,0 @@
-module ccpp_kinds
-
- use ISO_FORTRAN_ENV, only: kind_phys => REAL64
-
- implicit none
- private
-
- public kind_phys
-
-end module ccpp_kinds
diff --git a/test/include/shr_infnan_mod.F90 b/test/include/shr_infnan_mod.F90
deleted file mode 100644
index 8863882d..00000000
--- a/test/include/shr_infnan_mod.F90
+++ /dev/null
@@ -1,1907 +0,0 @@
-! This file is a stand-in for CIME's shr_infnan_mod.F90.in
-!===================================================
-
-! Flag representing compiler support of Fortran 2003's
-! ieee_arithmetic intrinsic module.
-#if defined CPRIBM || defined CPRPGI || defined CPRINTEL || defined CPRCRAY || defined CPRNAG
-#define HAVE_IEEE_ARITHMETIC
-#endif
-
-module shr_infnan_mod
-!---------------------------------------------------------------------
-! Module to test for IEEE Inf and NaN values, which also provides a
-! method of setting +/-Inf and signaling or quiet NaN.
-!
-! All functions are elemental, and thus work on arrays.
-!---------------------------------------------------------------------
-! To test for these values, just call the corresponding function, e.g:
-!
-! var_is_nan = shr_infnan_isnan(x)
-!
-! You can also use it on arrays:
-!
-! array_contains_nan = any(shr_infnan_isnan(my_array))
-!
-!---------------------------------------------------------------------
-! To generate these values, assign one of the provided derived-type
-! variables to a real:
-!
-! use shr_infnan_mod, only: nan => shr_infnan_nan, &
-! inf => shr_infnan_inf, &
-! assignment(=)
-! real(r4) :: my_nan
-! real(r8) :: my_inf_array(2,2)
-! my_nan = nan
-! my_inf_array = inf
-!
-! Keep in mind that "shr_infnan_nan" and "shr_infnan_inf" cannot be
-! passed to functions that expect real arguments. To pass a real
-! NaN, you will have to use shr_infnan_nan to set a local real of
-! the correct kind.
-!---------------------------------------------------------------------
-
-use shr_kind_mod, only: &
- r4 => SHR_KIND_R4, &
- r8 => SHR_KIND_R8
-
-#ifdef HAVE_IEEE_ARITHMETIC
-
-! If we have IEEE_ARITHMETIC, the NaN test is provided for us.
-use, intrinsic :: ieee_arithmetic, only: &
- shr_infnan_isnan => ieee_is_nan
-
-#else
-
-! Integers of correct size for bit patterns below.
-use shr_kind_mod, only: i4 => shr_kind_i4, i8 => shr_kind_i8
-
-#endif
-
-implicit none
-private
-save
-
-! Test functions for NaN/Inf values.
-public :: shr_infnan_isnan
-public :: shr_infnan_isinf
-public :: shr_infnan_isposinf
-public :: shr_infnan_isneginf
-
-! Locally defined isnan.
-#ifndef HAVE_IEEE_ARITHMETIC
-
-interface shr_infnan_isnan
- ! TYPE double,real
- module procedure shr_infnan_isnan_double
- ! TYPE double,real
- module procedure shr_infnan_isnan_real
-end interface
-#endif
-
-
-interface shr_infnan_isinf
- ! TYPE double,real
- module procedure shr_infnan_isinf_double
- ! TYPE double,real
- module procedure shr_infnan_isinf_real
-end interface
-
-
-interface shr_infnan_isposinf
- ! TYPE double,real
- module procedure shr_infnan_isposinf_double
- ! TYPE double,real
- module procedure shr_infnan_isposinf_real
-end interface
-
-
-interface shr_infnan_isneginf
- ! TYPE double,real
- module procedure shr_infnan_isneginf_double
- ! TYPE double,real
- module procedure shr_infnan_isneginf_real
-end interface
-
-! Derived types for generation of NaN/Inf
-! Even though there's no reason to "use" the types directly, some compilers
-! might have trouble with an object being used without its type.
-public :: shr_infnan_nan_type
-public :: shr_infnan_inf_type
-public :: assignment(=)
-public :: shr_infnan_to_r4
-public :: shr_infnan_to_r8
-
-! Type representing Not A Number.
-type :: shr_infnan_nan_type
- logical :: quiet = .false.
-end type shr_infnan_nan_type
-
-! Type representing +/-Infinity.
-type :: shr_infnan_inf_type
- logical :: positive = .true.
-end type shr_infnan_inf_type
-
-! Allow assigning reals to NaN or Inf.
-
-interface assignment(=)
- ! TYPE double,real
- ! DIMS 0,1,2,3,4,5,6,7
- module procedure set_nan_0d_double
- ! TYPE double,real
- ! DIMS 0,1,2,3,4,5,6,7
- module procedure set_nan_1d_double
- ! TYPE double,real
- ! DIMS 0,1,2,3,4,5,6,7
- module procedure set_nan_2d_double
- ! TYPE double,real
- ! DIMS 0,1,2,3,4,5,6,7
- module procedure set_nan_3d_double
- ! TYPE double,real
- ! DIMS 0,1,2,3,4,5,6,7
- module procedure set_nan_4d_double
- ! TYPE double,real
- ! DIMS 0,1,2,3,4,5,6,7
- module procedure set_nan_5d_double
- ! TYPE double,real
- ! DIMS 0,1,2,3,4,5,6,7
- module procedure set_nan_6d_double
- ! TYPE double,real
- ! DIMS 0,1,2,3,4,5,6,7
- module procedure set_nan_7d_double
- ! TYPE double,real
- ! DIMS 0,1,2,3,4,5,6,7
- module procedure set_nan_0d_real
- ! TYPE double,real
- ! DIMS 0,1,2,3,4,5,6,7
- module procedure set_nan_1d_real
- ! TYPE double,real
- ! DIMS 0,1,2,3,4,5,6,7
- module procedure set_nan_2d_real
- ! TYPE double,real
- ! DIMS 0,1,2,3,4,5,6,7
- module procedure set_nan_3d_real
- ! TYPE double,real
- ! DIMS 0,1,2,3,4,5,6,7
- module procedure set_nan_4d_real
- ! TYPE double,real
- ! DIMS 0,1,2,3,4,5,6,7
- module procedure set_nan_5d_real
- ! TYPE double,real
- ! DIMS 0,1,2,3,4,5,6,7
- module procedure set_nan_6d_real
- ! TYPE double,real
- ! DIMS 0,1,2,3,4,5,6,7
- module procedure set_nan_7d_real
- ! TYPE double,real
- ! DIMS 0,1,2,3,4,5,6,7
- module procedure set_inf_0d_double
- ! TYPE double,real
- ! DIMS 0,1,2,3,4,5,6,7
- module procedure set_inf_1d_double
- ! TYPE double,real
- ! DIMS 0,1,2,3,4,5,6,7
- module procedure set_inf_2d_double
- ! TYPE double,real
- ! DIMS 0,1,2,3,4,5,6,7
- module procedure set_inf_3d_double
- ! TYPE double,real
- ! DIMS 0,1,2,3,4,5,6,7
- module procedure set_inf_4d_double
- ! TYPE double,real
- ! DIMS 0,1,2,3,4,5,6,7
- module procedure set_inf_5d_double
- ! TYPE double,real
- ! DIMS 0,1,2,3,4,5,6,7
- module procedure set_inf_6d_double
- ! TYPE double,real
- ! DIMS 0,1,2,3,4,5,6,7
- module procedure set_inf_7d_double
- ! TYPE double,real
- ! DIMS 0,1,2,3,4,5,6,7
- module procedure set_inf_0d_real
- ! TYPE double,real
- ! DIMS 0,1,2,3,4,5,6,7
- module procedure set_inf_1d_real
- ! TYPE double,real
- ! DIMS 0,1,2,3,4,5,6,7
- module procedure set_inf_2d_real
- ! TYPE double,real
- ! DIMS 0,1,2,3,4,5,6,7
- module procedure set_inf_3d_real
- ! TYPE double,real
- ! DIMS 0,1,2,3,4,5,6,7
- module procedure set_inf_4d_real
- ! TYPE double,real
- ! DIMS 0,1,2,3,4,5,6,7
- module procedure set_inf_5d_real
- ! TYPE double,real
- ! DIMS 0,1,2,3,4,5,6,7
- module procedure set_inf_6d_real
- ! TYPE double,real
- ! DIMS 0,1,2,3,4,5,6,7
- module procedure set_inf_7d_real
-end interface
-
-! Conversion functions.
-
-interface shr_infnan_to_r8
- module procedure nan_r8
- module procedure inf_r8
-end interface
-
-
-interface shr_infnan_to_r4
- module procedure nan_r4
- module procedure inf_r4
-end interface
-
-! Initialize objects of NaN/Inf type for other modules to use.
-
-! Default NaN is signaling, but also provide snan and qnan to choose
-! explicitly.
-type(shr_infnan_nan_type), public, parameter :: shr_infnan_nan = &
- shr_infnan_nan_type(.false.)
-type(shr_infnan_nan_type), public, parameter :: shr_infnan_snan = &
- shr_infnan_nan_type(.false.)
-type(shr_infnan_nan_type), public, parameter :: shr_infnan_qnan = &
- shr_infnan_nan_type(.true.)
-
-! Default Inf is positive, but provide posinf to go with neginf.
-type(shr_infnan_inf_type), public, parameter :: shr_infnan_inf = &
- shr_infnan_inf_type(.true.)
-type(shr_infnan_inf_type), public, parameter :: shr_infnan_posinf = &
- shr_infnan_inf_type(.true.)
-type(shr_infnan_inf_type), public, parameter :: shr_infnan_neginf = &
- shr_infnan_inf_type(.false.)
-
-! Bit patterns for implementation without ieee_arithmetic.
-! Note that in order to satisfy gfortran's range check, we have to use
-! ibset to set the sign bit from a BOZ pattern.
-#ifndef HAVE_IEEE_ARITHMETIC
-! Single precision.
-integer(i4), parameter :: ssnan_pat = int(Z'7FA00000',i4)
-integer(i4), parameter :: sqnan_pat = int(Z'7FC00000',i4)
-integer(i4), parameter :: sposinf_pat = int(Z'7F800000',i4)
-integer(i4), parameter :: sneginf_pat = ibset(sposinf_pat,bit_size(1_i4)-1)
-! Double precision.
-integer(i8), parameter :: dsnan_pat = int(Z'7FF4000000000000',i8)
-integer(i8), parameter :: dqnan_pat = int(Z'7FF8000000000000',i8)
-integer(i8), parameter :: dposinf_pat = int(Z'7FF0000000000000',i8)
-integer(i8), parameter :: dneginf_pat = ibset(dposinf_pat,bit_size(1_i8)-1)
-#endif
-
-
-contains
-
-!---------------------------------------------------------------------
-! TEST FUNCTIONS
-!---------------------------------------------------------------------
-! The "isinf" function simply calls "isposinf" and "isneginf".
-!---------------------------------------------------------------------
-
-! TYPE double,real
-
-elemental function shr_infnan_isinf_double(x) result(isinf)
- real(r8), intent(in) :: x
- logical :: isinf
-
- isinf = shr_infnan_isposinf(x) .or. shr_infnan_isneginf(x)
-
-
-end function shr_infnan_isinf_double
-! TYPE double,real
-
-elemental function shr_infnan_isinf_real(x) result(isinf)
- real(r4), intent(in) :: x
- logical :: isinf
-
- isinf = shr_infnan_isposinf(x) .or. shr_infnan_isneginf(x)
-
-
-end function shr_infnan_isinf_real
-
-#ifdef HAVE_IEEE_ARITHMETIC
-
-!---------------------------------------------------------------------
-! The "isposinf" and "isneginf" functions get the IEEE class of a
-! real, and test to see if the class is equal to ieee_positive_inf
-! or ieee_negative_inf.
-!---------------------------------------------------------------------
-
-! TYPE double,real
-
-elemental function shr_infnan_isposinf_double(x) result(isposinf)
- use, intrinsic :: ieee_arithmetic, only: &
- ieee_class, &
- ieee_positive_inf, &
- operator(==)
- real(r8), intent(in) :: x
- logical :: isposinf
-
- isposinf = (ieee_positive_inf == ieee_class(x))
-
-
-end function shr_infnan_isposinf_double
-! TYPE double,real
-
-elemental function shr_infnan_isposinf_real(x) result(isposinf)
- use, intrinsic :: ieee_arithmetic, only: &
- ieee_class, &
- ieee_positive_inf, &
- operator(==)
- real(r4), intent(in) :: x
- logical :: isposinf
-
- isposinf = (ieee_positive_inf == ieee_class(x))
-
-
-end function shr_infnan_isposinf_real
-
-! TYPE double,real
-
-elemental function shr_infnan_isneginf_double(x) result(isneginf)
- use, intrinsic :: ieee_arithmetic, only: &
- ieee_class, &
- ieee_negative_inf, &
- operator(==)
- real(r8), intent(in) :: x
- logical :: isneginf
-
- isneginf = (ieee_negative_inf == ieee_class(x))
-
-
-end function shr_infnan_isneginf_double
-! TYPE double,real
-
-elemental function shr_infnan_isneginf_real(x) result(isneginf)
- use, intrinsic :: ieee_arithmetic, only: &
- ieee_class, &
- ieee_negative_inf, &
- operator(==)
- real(r4), intent(in) :: x
- logical :: isneginf
-
- isneginf = (ieee_negative_inf == ieee_class(x))
-
-
-end function shr_infnan_isneginf_real
-
-#else
-! Don't have ieee_arithmetic.
-
-#ifdef CPRGNU
-! NaN testing on gfortran.
-! TYPE double,real
-
-elemental function shr_infnan_isnan_double(x) result(is_nan)
- real(r8), intent(in) :: x
- logical :: is_nan
-
- is_nan = isnan(x)
-
-
-end function shr_infnan_isnan_double
-! TYPE double,real
-
-elemental function shr_infnan_isnan_real(x) result(is_nan)
- real(r4), intent(in) :: x
- logical :: is_nan
-
- is_nan = isnan(x)
-
-
-end function shr_infnan_isnan_real
-! End GNU section.
-#endif
-
-!---------------------------------------------------------------------
-! The "isposinf" and "isneginf" functions just test against a known
-! bit pattern if we don't have ieee_arithmetic.
-!---------------------------------------------------------------------
-
-! TYPE double,real
-
-elemental function shr_infnan_isposinf_double(x) result(isposinf)
- real(r8), intent(in) :: x
- logical :: isposinf
-#if (102 == TYPEREAL)
- integer(i4), parameter :: posinf_pat = sposinf_pat
-#else
- integer(i8), parameter :: posinf_pat = dposinf_pat
-#endif
-
- isposinf = (x == transfer(posinf_pat,x))
-
-
-end function shr_infnan_isposinf_double
-! TYPE double,real
-
-elemental function shr_infnan_isposinf_real(x) result(isposinf)
- real(r4), intent(in) :: x
- logical :: isposinf
-#if (101 == TYPEREAL)
- integer(i4), parameter :: posinf_pat = sposinf_pat
-#else
- integer(i8), parameter :: posinf_pat = dposinf_pat
-#endif
-
- isposinf = (x == transfer(posinf_pat,x))
-
-
-end function shr_infnan_isposinf_real
-
-! TYPE double,real
-
-elemental function shr_infnan_isneginf_double(x) result(isneginf)
- real(r8), intent(in) :: x
- logical :: isneginf
-#if (102 == TYPEREAL)
- integer(i4), parameter :: neginf_pat = sneginf_pat
-#else
- integer(i8), parameter :: neginf_pat = dneginf_pat
-#endif
-
- isneginf = (x == transfer(neginf_pat,x))
-
-
-end function shr_infnan_isneginf_double
-! TYPE double,real
-
-elemental function shr_infnan_isneginf_real(x) result(isneginf)
- real(r4), intent(in) :: x
- logical :: isneginf
-#if (101 == TYPEREAL)
- integer(i4), parameter :: neginf_pat = sneginf_pat
-#else
- integer(i8), parameter :: neginf_pat = dneginf_pat
-#endif
-
- isneginf = (x == transfer(neginf_pat,x))
-
-
-end function shr_infnan_isneginf_real
-
-! End ieee_arithmetic conditional.
-#endif
-
-!---------------------------------------------------------------------
-! GENERATION FUNCTIONS
-!---------------------------------------------------------------------
-! Two approaches for generation of NaN and Inf values:
-! 1. With Fortran 2003, use the ieee_value intrinsic to get a value
-! from the corresponding class. These are:
-! - ieee_signaling_nan
-! - ieee_quiet_nan
-! - ieee_positive_inf
-! - ieee_negative_inf
-! 2. Without Fortran 2003, set the IEEE bit patterns directly.
-! Use BOZ literals to get an integer with the correct bit
-! pattern, then use "transfer" to transfer those bits into a
-! real.
-!---------------------------------------------------------------------
-
-! TYPE double,real
-! DIMS 0,1,2,3,4,5,6,7
-
-pure subroutine set_nan_0d_double(output, nan)
-#ifdef HAVE_IEEE_ARITHMETIC
- use, intrinsic :: ieee_arithmetic, only: &
- ieee_signaling_nan, &
- ieee_quiet_nan, &
- ieee_value
-#else
-#if (102 == TYPEREAL)
- integer(i4), parameter :: snan_pat = ssnan_pat
- integer(i4), parameter :: qnan_pat = sqnan_pat
-#else
- integer(i8), parameter :: snan_pat = dsnan_pat
- integer(i8), parameter :: qnan_pat = dqnan_pat
-#endif
-#endif
- real(r8), intent(out) :: output
- type(shr_infnan_nan_type), intent(in) :: nan
-
- ! Use scalar temporary for performance reasons, to reduce the cost of
- ! the ieee_value call.
- real(r8) :: tmp
-
-#ifdef HAVE_IEEE_ARITHMETIC
- if (nan%quiet) then
- tmp = ieee_value(tmp, ieee_quiet_nan)
- else
- tmp = ieee_value(tmp, ieee_signaling_nan)
- end if
-#else
- if (nan%quiet) then
- tmp = transfer(qnan_pat, tmp)
- else
- tmp = transfer(snan_pat, tmp)
- end if
-#endif
-
- output = tmp
-
-
-end subroutine set_nan_0d_double
-! TYPE double,real
-! DIMS 0,1,2,3,4,5,6,7
-
-pure subroutine set_nan_1d_double(output, nan)
-#ifdef HAVE_IEEE_ARITHMETIC
- use, intrinsic :: ieee_arithmetic, only: &
- ieee_signaling_nan, &
- ieee_quiet_nan, &
- ieee_value
-#else
-#if (102 == TYPEREAL)
- integer(i4), parameter :: snan_pat = ssnan_pat
- integer(i4), parameter :: qnan_pat = sqnan_pat
-#else
- integer(i8), parameter :: snan_pat = dsnan_pat
- integer(i8), parameter :: qnan_pat = dqnan_pat
-#endif
-#endif
- real(r8), intent(out) :: output(:)
- type(shr_infnan_nan_type), intent(in) :: nan
-
- ! Use scalar temporary for performance reasons, to reduce the cost of
- ! the ieee_value call.
- real(r8) :: tmp
-
-#ifdef HAVE_IEEE_ARITHMETIC
- if (nan%quiet) then
- tmp = ieee_value(tmp, ieee_quiet_nan)
- else
- tmp = ieee_value(tmp, ieee_signaling_nan)
- end if
-#else
- if (nan%quiet) then
- tmp = transfer(qnan_pat, tmp)
- else
- tmp = transfer(snan_pat, tmp)
- end if
-#endif
-
- output = tmp
-
-
-end subroutine set_nan_1d_double
-! TYPE double,real
-! DIMS 0,1,2,3,4,5,6,7
-
-pure subroutine set_nan_2d_double(output, nan)
-#ifdef HAVE_IEEE_ARITHMETIC
- use, intrinsic :: ieee_arithmetic, only: &
- ieee_signaling_nan, &
- ieee_quiet_nan, &
- ieee_value
-#else
-#if (102 == TYPEREAL)
- integer(i4), parameter :: snan_pat = ssnan_pat
- integer(i4), parameter :: qnan_pat = sqnan_pat
-#else
- integer(i8), parameter :: snan_pat = dsnan_pat
- integer(i8), parameter :: qnan_pat = dqnan_pat
-#endif
-#endif
- real(r8), intent(out) :: output(:,:)
- type(shr_infnan_nan_type), intent(in) :: nan
-
- ! Use scalar temporary for performance reasons, to reduce the cost of
- ! the ieee_value call.
- real(r8) :: tmp
-
-#ifdef HAVE_IEEE_ARITHMETIC
- if (nan%quiet) then
- tmp = ieee_value(tmp, ieee_quiet_nan)
- else
- tmp = ieee_value(tmp, ieee_signaling_nan)
- end if
-#else
- if (nan%quiet) then
- tmp = transfer(qnan_pat, tmp)
- else
- tmp = transfer(snan_pat, tmp)
- end if
-#endif
-
- output = tmp
-
-
-end subroutine set_nan_2d_double
-! TYPE double,real
-! DIMS 0,1,2,3,4,5,6,7
-
-pure subroutine set_nan_3d_double(output, nan)
-#ifdef HAVE_IEEE_ARITHMETIC
- use, intrinsic :: ieee_arithmetic, only: &
- ieee_signaling_nan, &
- ieee_quiet_nan, &
- ieee_value
-#else
-#if (102 == TYPEREAL)
- integer(i4), parameter :: snan_pat = ssnan_pat
- integer(i4), parameter :: qnan_pat = sqnan_pat
-#else
- integer(i8), parameter :: snan_pat = dsnan_pat
- integer(i8), parameter :: qnan_pat = dqnan_pat
-#endif
-#endif
- real(r8), intent(out) :: output(:,:,:)
- type(shr_infnan_nan_type), intent(in) :: nan
-
- ! Use scalar temporary for performance reasons, to reduce the cost of
- ! the ieee_value call.
- real(r8) :: tmp
-
-#ifdef HAVE_IEEE_ARITHMETIC
- if (nan%quiet) then
- tmp = ieee_value(tmp, ieee_quiet_nan)
- else
- tmp = ieee_value(tmp, ieee_signaling_nan)
- end if
-#else
- if (nan%quiet) then
- tmp = transfer(qnan_pat, tmp)
- else
- tmp = transfer(snan_pat, tmp)
- end if
-#endif
-
- output = tmp
-
-
-end subroutine set_nan_3d_double
-! TYPE double,real
-! DIMS 0,1,2,3,4,5,6,7
-
-pure subroutine set_nan_4d_double(output, nan)
-#ifdef HAVE_IEEE_ARITHMETIC
- use, intrinsic :: ieee_arithmetic, only: &
- ieee_signaling_nan, &
- ieee_quiet_nan, &
- ieee_value
-#else
-#if (102 == TYPEREAL)
- integer(i4), parameter :: snan_pat = ssnan_pat
- integer(i4), parameter :: qnan_pat = sqnan_pat
-#else
- integer(i8), parameter :: snan_pat = dsnan_pat
- integer(i8), parameter :: qnan_pat = dqnan_pat
-#endif
-#endif
- real(r8), intent(out) :: output(:,:,:,:)
- type(shr_infnan_nan_type), intent(in) :: nan
-
- ! Use scalar temporary for performance reasons, to reduce the cost of
- ! the ieee_value call.
- real(r8) :: tmp
-
-#ifdef HAVE_IEEE_ARITHMETIC
- if (nan%quiet) then
- tmp = ieee_value(tmp, ieee_quiet_nan)
- else
- tmp = ieee_value(tmp, ieee_signaling_nan)
- end if
-#else
- if (nan%quiet) then
- tmp = transfer(qnan_pat, tmp)
- else
- tmp = transfer(snan_pat, tmp)
- end if
-#endif
-
- output = tmp
-
-
-end subroutine set_nan_4d_double
-! TYPE double,real
-! DIMS 0,1,2,3,4,5,6,7
-
-pure subroutine set_nan_5d_double(output, nan)
-#ifdef HAVE_IEEE_ARITHMETIC
- use, intrinsic :: ieee_arithmetic, only: &
- ieee_signaling_nan, &
- ieee_quiet_nan, &
- ieee_value
-#else
-#if (102 == TYPEREAL)
- integer(i4), parameter :: snan_pat = ssnan_pat
- integer(i4), parameter :: qnan_pat = sqnan_pat
-#else
- integer(i8), parameter :: snan_pat = dsnan_pat
- integer(i8), parameter :: qnan_pat = dqnan_pat
-#endif
-#endif
- real(r8), intent(out) :: output(:,:,:,:,:)
- type(shr_infnan_nan_type), intent(in) :: nan
-
- ! Use scalar temporary for performance reasons, to reduce the cost of
- ! the ieee_value call.
- real(r8) :: tmp
-
-#ifdef HAVE_IEEE_ARITHMETIC
- if (nan%quiet) then
- tmp = ieee_value(tmp, ieee_quiet_nan)
- else
- tmp = ieee_value(tmp, ieee_signaling_nan)
- end if
-#else
- if (nan%quiet) then
- tmp = transfer(qnan_pat, tmp)
- else
- tmp = transfer(snan_pat, tmp)
- end if
-#endif
-
- output = tmp
-
-
-end subroutine set_nan_5d_double
-! TYPE double,real
-! DIMS 0,1,2,3,4,5,6,7
-
-pure subroutine set_nan_6d_double(output, nan)
-#ifdef HAVE_IEEE_ARITHMETIC
- use, intrinsic :: ieee_arithmetic, only: &
- ieee_signaling_nan, &
- ieee_quiet_nan, &
- ieee_value
-#else
-#if (102 == TYPEREAL)
- integer(i4), parameter :: snan_pat = ssnan_pat
- integer(i4), parameter :: qnan_pat = sqnan_pat
-#else
- integer(i8), parameter :: snan_pat = dsnan_pat
- integer(i8), parameter :: qnan_pat = dqnan_pat
-#endif
-#endif
- real(r8), intent(out) :: output(:,:,:,:,:,:)
- type(shr_infnan_nan_type), intent(in) :: nan
-
- ! Use scalar temporary for performance reasons, to reduce the cost of
- ! the ieee_value call.
- real(r8) :: tmp
-
-#ifdef HAVE_IEEE_ARITHMETIC
- if (nan%quiet) then
- tmp = ieee_value(tmp, ieee_quiet_nan)
- else
- tmp = ieee_value(tmp, ieee_signaling_nan)
- end if
-#else
- if (nan%quiet) then
- tmp = transfer(qnan_pat, tmp)
- else
- tmp = transfer(snan_pat, tmp)
- end if
-#endif
-
- output = tmp
-
-
-end subroutine set_nan_6d_double
-! TYPE double,real
-! DIMS 0,1,2,3,4,5,6,7
-
-pure subroutine set_nan_7d_double(output, nan)
-#ifdef HAVE_IEEE_ARITHMETIC
- use, intrinsic :: ieee_arithmetic, only: &
- ieee_signaling_nan, &
- ieee_quiet_nan, &
- ieee_value
-#else
-#if (102 == TYPEREAL)
- integer(i4), parameter :: snan_pat = ssnan_pat
- integer(i4), parameter :: qnan_pat = sqnan_pat
-#else
- integer(i8), parameter :: snan_pat = dsnan_pat
- integer(i8), parameter :: qnan_pat = dqnan_pat
-#endif
-#endif
- real(r8), intent(out) :: output(:,:,:,:,:,:,:)
- type(shr_infnan_nan_type), intent(in) :: nan
-
- ! Use scalar temporary for performance reasons, to reduce the cost of
- ! the ieee_value call.
- real(r8) :: tmp
-
-#ifdef HAVE_IEEE_ARITHMETIC
- if (nan%quiet) then
- tmp = ieee_value(tmp, ieee_quiet_nan)
- else
- tmp = ieee_value(tmp, ieee_signaling_nan)
- end if
-#else
- if (nan%quiet) then
- tmp = transfer(qnan_pat, tmp)
- else
- tmp = transfer(snan_pat, tmp)
- end if
-#endif
-
- output = tmp
-
-
-end subroutine set_nan_7d_double
-! TYPE double,real
-! DIMS 0,1,2,3,4,5,6,7
-
-pure subroutine set_nan_0d_real(output, nan)
-#ifdef HAVE_IEEE_ARITHMETIC
- use, intrinsic :: ieee_arithmetic, only: &
- ieee_signaling_nan, &
- ieee_quiet_nan, &
- ieee_value
-#else
-#if (101 == TYPEREAL)
- integer(i4), parameter :: snan_pat = ssnan_pat
- integer(i4), parameter :: qnan_pat = sqnan_pat
-#else
- integer(i8), parameter :: snan_pat = dsnan_pat
- integer(i8), parameter :: qnan_pat = dqnan_pat
-#endif
-#endif
- real(r4), intent(out) :: output
- type(shr_infnan_nan_type), intent(in) :: nan
-
- ! Use scalar temporary for performance reasons, to reduce the cost of
- ! the ieee_value call.
- real(r4) :: tmp
-
-#ifdef HAVE_IEEE_ARITHMETIC
- if (nan%quiet) then
- tmp = ieee_value(tmp, ieee_quiet_nan)
- else
- tmp = ieee_value(tmp, ieee_signaling_nan)
- end if
-#else
- if (nan%quiet) then
- tmp = transfer(qnan_pat, tmp)
- else
- tmp = transfer(snan_pat, tmp)
- end if
-#endif
-
- output = tmp
-
-
-end subroutine set_nan_0d_real
-! TYPE double,real
-! DIMS 0,1,2,3,4,5,6,7
-
-pure subroutine set_nan_1d_real(output, nan)
-#ifdef HAVE_IEEE_ARITHMETIC
- use, intrinsic :: ieee_arithmetic, only: &
- ieee_signaling_nan, &
- ieee_quiet_nan, &
- ieee_value
-#else
-#if (101 == TYPEREAL)
- integer(i4), parameter :: snan_pat = ssnan_pat
- integer(i4), parameter :: qnan_pat = sqnan_pat
-#else
- integer(i8), parameter :: snan_pat = dsnan_pat
- integer(i8), parameter :: qnan_pat = dqnan_pat
-#endif
-#endif
- real(r4), intent(out) :: output(:)
- type(shr_infnan_nan_type), intent(in) :: nan
-
- ! Use scalar temporary for performance reasons, to reduce the cost of
- ! the ieee_value call.
- real(r4) :: tmp
-
-#ifdef HAVE_IEEE_ARITHMETIC
- if (nan%quiet) then
- tmp = ieee_value(tmp, ieee_quiet_nan)
- else
- tmp = ieee_value(tmp, ieee_signaling_nan)
- end if
-#else
- if (nan%quiet) then
- tmp = transfer(qnan_pat, tmp)
- else
- tmp = transfer(snan_pat, tmp)
- end if
-#endif
-
- output = tmp
-
-
-end subroutine set_nan_1d_real
-! TYPE double,real
-! DIMS 0,1,2,3,4,5,6,7
-
-pure subroutine set_nan_2d_real(output, nan)
-#ifdef HAVE_IEEE_ARITHMETIC
- use, intrinsic :: ieee_arithmetic, only: &
- ieee_signaling_nan, &
- ieee_quiet_nan, &
- ieee_value
-#else
-#if (101 == TYPEREAL)
- integer(i4), parameter :: snan_pat = ssnan_pat
- integer(i4), parameter :: qnan_pat = sqnan_pat
-#else
- integer(i8), parameter :: snan_pat = dsnan_pat
- integer(i8), parameter :: qnan_pat = dqnan_pat
-#endif
-#endif
- real(r4), intent(out) :: output(:,:)
- type(shr_infnan_nan_type), intent(in) :: nan
-
- ! Use scalar temporary for performance reasons, to reduce the cost of
- ! the ieee_value call.
- real(r4) :: tmp
-
-#ifdef HAVE_IEEE_ARITHMETIC
- if (nan%quiet) then
- tmp = ieee_value(tmp, ieee_quiet_nan)
- else
- tmp = ieee_value(tmp, ieee_signaling_nan)
- end if
-#else
- if (nan%quiet) then
- tmp = transfer(qnan_pat, tmp)
- else
- tmp = transfer(snan_pat, tmp)
- end if
-#endif
-
- output = tmp
-
-
-end subroutine set_nan_2d_real
-! TYPE double,real
-! DIMS 0,1,2,3,4,5,6,7
-
-pure subroutine set_nan_3d_real(output, nan)
-#ifdef HAVE_IEEE_ARITHMETIC
- use, intrinsic :: ieee_arithmetic, only: &
- ieee_signaling_nan, &
- ieee_quiet_nan, &
- ieee_value
-#else
-#if (101 == TYPEREAL)
- integer(i4), parameter :: snan_pat = ssnan_pat
- integer(i4), parameter :: qnan_pat = sqnan_pat
-#else
- integer(i8), parameter :: snan_pat = dsnan_pat
- integer(i8), parameter :: qnan_pat = dqnan_pat
-#endif
-#endif
- real(r4), intent(out) :: output(:,:,:)
- type(shr_infnan_nan_type), intent(in) :: nan
-
- ! Use scalar temporary for performance reasons, to reduce the cost of
- ! the ieee_value call.
- real(r4) :: tmp
-
-#ifdef HAVE_IEEE_ARITHMETIC
- if (nan%quiet) then
- tmp = ieee_value(tmp, ieee_quiet_nan)
- else
- tmp = ieee_value(tmp, ieee_signaling_nan)
- end if
-#else
- if (nan%quiet) then
- tmp = transfer(qnan_pat, tmp)
- else
- tmp = transfer(snan_pat, tmp)
- end if
-#endif
-
- output = tmp
-
-
-end subroutine set_nan_3d_real
-! TYPE double,real
-! DIMS 0,1,2,3,4,5,6,7
-
-pure subroutine set_nan_4d_real(output, nan)
-#ifdef HAVE_IEEE_ARITHMETIC
- use, intrinsic :: ieee_arithmetic, only: &
- ieee_signaling_nan, &
- ieee_quiet_nan, &
- ieee_value
-#else
-#if (101 == TYPEREAL)
- integer(i4), parameter :: snan_pat = ssnan_pat
- integer(i4), parameter :: qnan_pat = sqnan_pat
-#else
- integer(i8), parameter :: snan_pat = dsnan_pat
- integer(i8), parameter :: qnan_pat = dqnan_pat
-#endif
-#endif
- real(r4), intent(out) :: output(:,:,:,:)
- type(shr_infnan_nan_type), intent(in) :: nan
-
- ! Use scalar temporary for performance reasons, to reduce the cost of
- ! the ieee_value call.
- real(r4) :: tmp
-
-#ifdef HAVE_IEEE_ARITHMETIC
- if (nan%quiet) then
- tmp = ieee_value(tmp, ieee_quiet_nan)
- else
- tmp = ieee_value(tmp, ieee_signaling_nan)
- end if
-#else
- if (nan%quiet) then
- tmp = transfer(qnan_pat, tmp)
- else
- tmp = transfer(snan_pat, tmp)
- end if
-#endif
-
- output = tmp
-
-
-end subroutine set_nan_4d_real
-! TYPE double,real
-! DIMS 0,1,2,3,4,5,6,7
-
-pure subroutine set_nan_5d_real(output, nan)
-#ifdef HAVE_IEEE_ARITHMETIC
- use, intrinsic :: ieee_arithmetic, only: &
- ieee_signaling_nan, &
- ieee_quiet_nan, &
- ieee_value
-#else
-#if (101 == TYPEREAL)
- integer(i4), parameter :: snan_pat = ssnan_pat
- integer(i4), parameter :: qnan_pat = sqnan_pat
-#else
- integer(i8), parameter :: snan_pat = dsnan_pat
- integer(i8), parameter :: qnan_pat = dqnan_pat
-#endif
-#endif
- real(r4), intent(out) :: output(:,:,:,:,:)
- type(shr_infnan_nan_type), intent(in) :: nan
-
- ! Use scalar temporary for performance reasons, to reduce the cost of
- ! the ieee_value call.
- real(r4) :: tmp
-
-#ifdef HAVE_IEEE_ARITHMETIC
- if (nan%quiet) then
- tmp = ieee_value(tmp, ieee_quiet_nan)
- else
- tmp = ieee_value(tmp, ieee_signaling_nan)
- end if
-#else
- if (nan%quiet) then
- tmp = transfer(qnan_pat, tmp)
- else
- tmp = transfer(snan_pat, tmp)
- end if
-#endif
-
- output = tmp
-
-
-end subroutine set_nan_5d_real
-! TYPE double,real
-! DIMS 0,1,2,3,4,5,6,7
-
-pure subroutine set_nan_6d_real(output, nan)
-#ifdef HAVE_IEEE_ARITHMETIC
- use, intrinsic :: ieee_arithmetic, only: &
- ieee_signaling_nan, &
- ieee_quiet_nan, &
- ieee_value
-#else
-#if (101 == TYPEREAL)
- integer(i4), parameter :: snan_pat = ssnan_pat
- integer(i4), parameter :: qnan_pat = sqnan_pat
-#else
- integer(i8), parameter :: snan_pat = dsnan_pat
- integer(i8), parameter :: qnan_pat = dqnan_pat
-#endif
-#endif
- real(r4), intent(out) :: output(:,:,:,:,:,:)
- type(shr_infnan_nan_type), intent(in) :: nan
-
- ! Use scalar temporary for performance reasons, to reduce the cost of
- ! the ieee_value call.
- real(r4) :: tmp
-
-#ifdef HAVE_IEEE_ARITHMETIC
- if (nan%quiet) then
- tmp = ieee_value(tmp, ieee_quiet_nan)
- else
- tmp = ieee_value(tmp, ieee_signaling_nan)
- end if
-#else
- if (nan%quiet) then
- tmp = transfer(qnan_pat, tmp)
- else
- tmp = transfer(snan_pat, tmp)
- end if
-#endif
-
- output = tmp
-
-
-end subroutine set_nan_6d_real
-! TYPE double,real
-! DIMS 0,1,2,3,4,5,6,7
-
-pure subroutine set_nan_7d_real(output, nan)
-#ifdef HAVE_IEEE_ARITHMETIC
- use, intrinsic :: ieee_arithmetic, only: &
- ieee_signaling_nan, &
- ieee_quiet_nan, &
- ieee_value
-#else
-#if (101 == TYPEREAL)
- integer(i4), parameter :: snan_pat = ssnan_pat
- integer(i4), parameter :: qnan_pat = sqnan_pat
-#else
- integer(i8), parameter :: snan_pat = dsnan_pat
- integer(i8), parameter :: qnan_pat = dqnan_pat
-#endif
-#endif
- real(r4), intent(out) :: output(:,:,:,:,:,:,:)
- type(shr_infnan_nan_type), intent(in) :: nan
-
- ! Use scalar temporary for performance reasons, to reduce the cost of
- ! the ieee_value call.
- real(r4) :: tmp
-
-#ifdef HAVE_IEEE_ARITHMETIC
- if (nan%quiet) then
- tmp = ieee_value(tmp, ieee_quiet_nan)
- else
- tmp = ieee_value(tmp, ieee_signaling_nan)
- end if
-#else
- if (nan%quiet) then
- tmp = transfer(qnan_pat, tmp)
- else
- tmp = transfer(snan_pat, tmp)
- end if
-#endif
-
- output = tmp
-
-
-end subroutine set_nan_7d_real
-
-! TYPE double,real
-! DIMS 0,1,2,3,4,5,6,7
-
-pure subroutine set_inf_0d_double(output, inf)
-#ifdef HAVE_IEEE_ARITHMETIC
- use, intrinsic :: ieee_arithmetic, only: &
- ieee_positive_inf, &
- ieee_negative_inf, &
- ieee_value
-#else
-#if (102 == TYPEREAL)
- integer(i4), parameter :: posinf_pat = sposinf_pat
- integer(i4), parameter :: neginf_pat = sneginf_pat
-#else
- integer(i8), parameter :: posinf_pat = dposinf_pat
- integer(i8), parameter :: neginf_pat = dneginf_pat
-#endif
-#endif
- real(r8), intent(out) :: output
- type(shr_infnan_inf_type), intent(in) :: inf
-
- ! Use scalar temporary for performance reasons, to reduce the cost of
- ! the ieee_value call.
- real(r8) :: tmp
-
-#ifdef HAVE_IEEE_ARITHMETIC
- if (inf%positive) then
- tmp = ieee_value(tmp,ieee_positive_inf)
- else
- tmp = ieee_value(tmp,ieee_negative_inf)
- end if
-#else
- if (inf%positive) then
- tmp = transfer(posinf_pat, tmp)
- else
- tmp = transfer(neginf_pat, tmp)
- end if
-#endif
-
- output = tmp
-
-
-end subroutine set_inf_0d_double
-! TYPE double,real
-! DIMS 0,1,2,3,4,5,6,7
-
-pure subroutine set_inf_1d_double(output, inf)
-#ifdef HAVE_IEEE_ARITHMETIC
- use, intrinsic :: ieee_arithmetic, only: &
- ieee_positive_inf, &
- ieee_negative_inf, &
- ieee_value
-#else
-#if (102 == TYPEREAL)
- integer(i4), parameter :: posinf_pat = sposinf_pat
- integer(i4), parameter :: neginf_pat = sneginf_pat
-#else
- integer(i8), parameter :: posinf_pat = dposinf_pat
- integer(i8), parameter :: neginf_pat = dneginf_pat
-#endif
-#endif
- real(r8), intent(out) :: output(:)
- type(shr_infnan_inf_type), intent(in) :: inf
-
- ! Use scalar temporary for performance reasons, to reduce the cost of
- ! the ieee_value call.
- real(r8) :: tmp
-
-#ifdef HAVE_IEEE_ARITHMETIC
- if (inf%positive) then
- tmp = ieee_value(tmp,ieee_positive_inf)
- else
- tmp = ieee_value(tmp,ieee_negative_inf)
- end if
-#else
- if (inf%positive) then
- tmp = transfer(posinf_pat, tmp)
- else
- tmp = transfer(neginf_pat, tmp)
- end if
-#endif
-
- output = tmp
-
-
-end subroutine set_inf_1d_double
-! TYPE double,real
-! DIMS 0,1,2,3,4,5,6,7
-
-pure subroutine set_inf_2d_double(output, inf)
-#ifdef HAVE_IEEE_ARITHMETIC
- use, intrinsic :: ieee_arithmetic, only: &
- ieee_positive_inf, &
- ieee_negative_inf, &
- ieee_value
-#else
-#if (102 == TYPEREAL)
- integer(i4), parameter :: posinf_pat = sposinf_pat
- integer(i4), parameter :: neginf_pat = sneginf_pat
-#else
- integer(i8), parameter :: posinf_pat = dposinf_pat
- integer(i8), parameter :: neginf_pat = dneginf_pat
-#endif
-#endif
- real(r8), intent(out) :: output(:,:)
- type(shr_infnan_inf_type), intent(in) :: inf
-
- ! Use scalar temporary for performance reasons, to reduce the cost of
- ! the ieee_value call.
- real(r8) :: tmp
-
-#ifdef HAVE_IEEE_ARITHMETIC
- if (inf%positive) then
- tmp = ieee_value(tmp,ieee_positive_inf)
- else
- tmp = ieee_value(tmp,ieee_negative_inf)
- end if
-#else
- if (inf%positive) then
- tmp = transfer(posinf_pat, tmp)
- else
- tmp = transfer(neginf_pat, tmp)
- end if
-#endif
-
- output = tmp
-
-
-end subroutine set_inf_2d_double
-! TYPE double,real
-! DIMS 0,1,2,3,4,5,6,7
-
-pure subroutine set_inf_3d_double(output, inf)
-#ifdef HAVE_IEEE_ARITHMETIC
- use, intrinsic :: ieee_arithmetic, only: &
- ieee_positive_inf, &
- ieee_negative_inf, &
- ieee_value
-#else
-#if (102 == TYPEREAL)
- integer(i4), parameter :: posinf_pat = sposinf_pat
- integer(i4), parameter :: neginf_pat = sneginf_pat
-#else
- integer(i8), parameter :: posinf_pat = dposinf_pat
- integer(i8), parameter :: neginf_pat = dneginf_pat
-#endif
-#endif
- real(r8), intent(out) :: output(:,:,:)
- type(shr_infnan_inf_type), intent(in) :: inf
-
- ! Use scalar temporary for performance reasons, to reduce the cost of
- ! the ieee_value call.
- real(r8) :: tmp
-
-#ifdef HAVE_IEEE_ARITHMETIC
- if (inf%positive) then
- tmp = ieee_value(tmp,ieee_positive_inf)
- else
- tmp = ieee_value(tmp,ieee_negative_inf)
- end if
-#else
- if (inf%positive) then
- tmp = transfer(posinf_pat, tmp)
- else
- tmp = transfer(neginf_pat, tmp)
- end if
-#endif
-
- output = tmp
-
-
-end subroutine set_inf_3d_double
-! TYPE double,real
-! DIMS 0,1,2,3,4,5,6,7
-
-pure subroutine set_inf_4d_double(output, inf)
-#ifdef HAVE_IEEE_ARITHMETIC
- use, intrinsic :: ieee_arithmetic, only: &
- ieee_positive_inf, &
- ieee_negative_inf, &
- ieee_value
-#else
-#if (102 == TYPEREAL)
- integer(i4), parameter :: posinf_pat = sposinf_pat
- integer(i4), parameter :: neginf_pat = sneginf_pat
-#else
- integer(i8), parameter :: posinf_pat = dposinf_pat
- integer(i8), parameter :: neginf_pat = dneginf_pat
-#endif
-#endif
- real(r8), intent(out) :: output(:,:,:,:)
- type(shr_infnan_inf_type), intent(in) :: inf
-
- ! Use scalar temporary for performance reasons, to reduce the cost of
- ! the ieee_value call.
- real(r8) :: tmp
-
-#ifdef HAVE_IEEE_ARITHMETIC
- if (inf%positive) then
- tmp = ieee_value(tmp,ieee_positive_inf)
- else
- tmp = ieee_value(tmp,ieee_negative_inf)
- end if
-#else
- if (inf%positive) then
- tmp = transfer(posinf_pat, tmp)
- else
- tmp = transfer(neginf_pat, tmp)
- end if
-#endif
-
- output = tmp
-
-
-end subroutine set_inf_4d_double
-! TYPE double,real
-! DIMS 0,1,2,3,4,5,6,7
-
-pure subroutine set_inf_5d_double(output, inf)
-#ifdef HAVE_IEEE_ARITHMETIC
- use, intrinsic :: ieee_arithmetic, only: &
- ieee_positive_inf, &
- ieee_negative_inf, &
- ieee_value
-#else
-#if (102 == TYPEREAL)
- integer(i4), parameter :: posinf_pat = sposinf_pat
- integer(i4), parameter :: neginf_pat = sneginf_pat
-#else
- integer(i8), parameter :: posinf_pat = dposinf_pat
- integer(i8), parameter :: neginf_pat = dneginf_pat
-#endif
-#endif
- real(r8), intent(out) :: output(:,:,:,:,:)
- type(shr_infnan_inf_type), intent(in) :: inf
-
- ! Use scalar temporary for performance reasons, to reduce the cost of
- ! the ieee_value call.
- real(r8) :: tmp
-
-#ifdef HAVE_IEEE_ARITHMETIC
- if (inf%positive) then
- tmp = ieee_value(tmp,ieee_positive_inf)
- else
- tmp = ieee_value(tmp,ieee_negative_inf)
- end if
-#else
- if (inf%positive) then
- tmp = transfer(posinf_pat, tmp)
- else
- tmp = transfer(neginf_pat, tmp)
- end if
-#endif
-
- output = tmp
-
-
-end subroutine set_inf_5d_double
-! TYPE double,real
-! DIMS 0,1,2,3,4,5,6,7
-
-pure subroutine set_inf_6d_double(output, inf)
-#ifdef HAVE_IEEE_ARITHMETIC
- use, intrinsic :: ieee_arithmetic, only: &
- ieee_positive_inf, &
- ieee_negative_inf, &
- ieee_value
-#else
-#if (102 == TYPEREAL)
- integer(i4), parameter :: posinf_pat = sposinf_pat
- integer(i4), parameter :: neginf_pat = sneginf_pat
-#else
- integer(i8), parameter :: posinf_pat = dposinf_pat
- integer(i8), parameter :: neginf_pat = dneginf_pat
-#endif
-#endif
- real(r8), intent(out) :: output(:,:,:,:,:,:)
- type(shr_infnan_inf_type), intent(in) :: inf
-
- ! Use scalar temporary for performance reasons, to reduce the cost of
- ! the ieee_value call.
- real(r8) :: tmp
-
-#ifdef HAVE_IEEE_ARITHMETIC
- if (inf%positive) then
- tmp = ieee_value(tmp,ieee_positive_inf)
- else
- tmp = ieee_value(tmp,ieee_negative_inf)
- end if
-#else
- if (inf%positive) then
- tmp = transfer(posinf_pat, tmp)
- else
- tmp = transfer(neginf_pat, tmp)
- end if
-#endif
-
- output = tmp
-
-
-end subroutine set_inf_6d_double
-! TYPE double,real
-! DIMS 0,1,2,3,4,5,6,7
-
-pure subroutine set_inf_7d_double(output, inf)
-#ifdef HAVE_IEEE_ARITHMETIC
- use, intrinsic :: ieee_arithmetic, only: &
- ieee_positive_inf, &
- ieee_negative_inf, &
- ieee_value
-#else
-#if (102 == TYPEREAL)
- integer(i4), parameter :: posinf_pat = sposinf_pat
- integer(i4), parameter :: neginf_pat = sneginf_pat
-#else
- integer(i8), parameter :: posinf_pat = dposinf_pat
- integer(i8), parameter :: neginf_pat = dneginf_pat
-#endif
-#endif
- real(r8), intent(out) :: output(:,:,:,:,:,:,:)
- type(shr_infnan_inf_type), intent(in) :: inf
-
- ! Use scalar temporary for performance reasons, to reduce the cost of
- ! the ieee_value call.
- real(r8) :: tmp
-
-#ifdef HAVE_IEEE_ARITHMETIC
- if (inf%positive) then
- tmp = ieee_value(tmp,ieee_positive_inf)
- else
- tmp = ieee_value(tmp,ieee_negative_inf)
- end if
-#else
- if (inf%positive) then
- tmp = transfer(posinf_pat, tmp)
- else
- tmp = transfer(neginf_pat, tmp)
- end if
-#endif
-
- output = tmp
-
-
-end subroutine set_inf_7d_double
-! TYPE double,real
-! DIMS 0,1,2,3,4,5,6,7
-
-pure subroutine set_inf_0d_real(output, inf)
-#ifdef HAVE_IEEE_ARITHMETIC
- use, intrinsic :: ieee_arithmetic, only: &
- ieee_positive_inf, &
- ieee_negative_inf, &
- ieee_value
-#else
-#if (101 == TYPEREAL)
- integer(i4), parameter :: posinf_pat = sposinf_pat
- integer(i4), parameter :: neginf_pat = sneginf_pat
-#else
- integer(i8), parameter :: posinf_pat = dposinf_pat
- integer(i8), parameter :: neginf_pat = dneginf_pat
-#endif
-#endif
- real(r4), intent(out) :: output
- type(shr_infnan_inf_type), intent(in) :: inf
-
- ! Use scalar temporary for performance reasons, to reduce the cost of
- ! the ieee_value call.
- real(r4) :: tmp
-
-#ifdef HAVE_IEEE_ARITHMETIC
- if (inf%positive) then
- tmp = ieee_value(tmp,ieee_positive_inf)
- else
- tmp = ieee_value(tmp,ieee_negative_inf)
- end if
-#else
- if (inf%positive) then
- tmp = transfer(posinf_pat, tmp)
- else
- tmp = transfer(neginf_pat, tmp)
- end if
-#endif
-
- output = tmp
-
-
-end subroutine set_inf_0d_real
-! TYPE double,real
-! DIMS 0,1,2,3,4,5,6,7
-
-pure subroutine set_inf_1d_real(output, inf)
-#ifdef HAVE_IEEE_ARITHMETIC
- use, intrinsic :: ieee_arithmetic, only: &
- ieee_positive_inf, &
- ieee_negative_inf, &
- ieee_value
-#else
-#if (101 == TYPEREAL)
- integer(i4), parameter :: posinf_pat = sposinf_pat
- integer(i4), parameter :: neginf_pat = sneginf_pat
-#else
- integer(i8), parameter :: posinf_pat = dposinf_pat
- integer(i8), parameter :: neginf_pat = dneginf_pat
-#endif
-#endif
- real(r4), intent(out) :: output(:)
- type(shr_infnan_inf_type), intent(in) :: inf
-
- ! Use scalar temporary for performance reasons, to reduce the cost of
- ! the ieee_value call.
- real(r4) :: tmp
-
-#ifdef HAVE_IEEE_ARITHMETIC
- if (inf%positive) then
- tmp = ieee_value(tmp,ieee_positive_inf)
- else
- tmp = ieee_value(tmp,ieee_negative_inf)
- end if
-#else
- if (inf%positive) then
- tmp = transfer(posinf_pat, tmp)
- else
- tmp = transfer(neginf_pat, tmp)
- end if
-#endif
-
- output = tmp
-
-
-end subroutine set_inf_1d_real
-! TYPE double,real
-! DIMS 0,1,2,3,4,5,6,7
-
-pure subroutine set_inf_2d_real(output, inf)
-#ifdef HAVE_IEEE_ARITHMETIC
- use, intrinsic :: ieee_arithmetic, only: &
- ieee_positive_inf, &
- ieee_negative_inf, &
- ieee_value
-#else
-#if (101 == TYPEREAL)
- integer(i4), parameter :: posinf_pat = sposinf_pat
- integer(i4), parameter :: neginf_pat = sneginf_pat
-#else
- integer(i8), parameter :: posinf_pat = dposinf_pat
- integer(i8), parameter :: neginf_pat = dneginf_pat
-#endif
-#endif
- real(r4), intent(out) :: output(:,:)
- type(shr_infnan_inf_type), intent(in) :: inf
-
- ! Use scalar temporary for performance reasons, to reduce the cost of
- ! the ieee_value call.
- real(r4) :: tmp
-
-#ifdef HAVE_IEEE_ARITHMETIC
- if (inf%positive) then
- tmp = ieee_value(tmp,ieee_positive_inf)
- else
- tmp = ieee_value(tmp,ieee_negative_inf)
- end if
-#else
- if (inf%positive) then
- tmp = transfer(posinf_pat, tmp)
- else
- tmp = transfer(neginf_pat, tmp)
- end if
-#endif
-
- output = tmp
-
-
-end subroutine set_inf_2d_real
-! TYPE double,real
-! DIMS 0,1,2,3,4,5,6,7
-
-pure subroutine set_inf_3d_real(output, inf)
-#ifdef HAVE_IEEE_ARITHMETIC
- use, intrinsic :: ieee_arithmetic, only: &
- ieee_positive_inf, &
- ieee_negative_inf, &
- ieee_value
-#else
-#if (101 == TYPEREAL)
- integer(i4), parameter :: posinf_pat = sposinf_pat
- integer(i4), parameter :: neginf_pat = sneginf_pat
-#else
- integer(i8), parameter :: posinf_pat = dposinf_pat
- integer(i8), parameter :: neginf_pat = dneginf_pat
-#endif
-#endif
- real(r4), intent(out) :: output(:,:,:)
- type(shr_infnan_inf_type), intent(in) :: inf
-
- ! Use scalar temporary for performance reasons, to reduce the cost of
- ! the ieee_value call.
- real(r4) :: tmp
-
-#ifdef HAVE_IEEE_ARITHMETIC
- if (inf%positive) then
- tmp = ieee_value(tmp,ieee_positive_inf)
- else
- tmp = ieee_value(tmp,ieee_negative_inf)
- end if
-#else
- if (inf%positive) then
- tmp = transfer(posinf_pat, tmp)
- else
- tmp = transfer(neginf_pat, tmp)
- end if
-#endif
-
- output = tmp
-
-
-end subroutine set_inf_3d_real
-! TYPE double,real
-! DIMS 0,1,2,3,4,5,6,7
-
-pure subroutine set_inf_4d_real(output, inf)
-#ifdef HAVE_IEEE_ARITHMETIC
- use, intrinsic :: ieee_arithmetic, only: &
- ieee_positive_inf, &
- ieee_negative_inf, &
- ieee_value
-#else
-#if (101 == TYPEREAL)
- integer(i4), parameter :: posinf_pat = sposinf_pat
- integer(i4), parameter :: neginf_pat = sneginf_pat
-#else
- integer(i8), parameter :: posinf_pat = dposinf_pat
- integer(i8), parameter :: neginf_pat = dneginf_pat
-#endif
-#endif
- real(r4), intent(out) :: output(:,:,:,:)
- type(shr_infnan_inf_type), intent(in) :: inf
-
- ! Use scalar temporary for performance reasons, to reduce the cost of
- ! the ieee_value call.
- real(r4) :: tmp
-
-#ifdef HAVE_IEEE_ARITHMETIC
- if (inf%positive) then
- tmp = ieee_value(tmp,ieee_positive_inf)
- else
- tmp = ieee_value(tmp,ieee_negative_inf)
- end if
-#else
- if (inf%positive) then
- tmp = transfer(posinf_pat, tmp)
- else
- tmp = transfer(neginf_pat, tmp)
- end if
-#endif
-
- output = tmp
-
-
-end subroutine set_inf_4d_real
-! TYPE double,real
-! DIMS 0,1,2,3,4,5,6,7
-
-pure subroutine set_inf_5d_real(output, inf)
-#ifdef HAVE_IEEE_ARITHMETIC
- use, intrinsic :: ieee_arithmetic, only: &
- ieee_positive_inf, &
- ieee_negative_inf, &
- ieee_value
-#else
-#if (101 == TYPEREAL)
- integer(i4), parameter :: posinf_pat = sposinf_pat
- integer(i4), parameter :: neginf_pat = sneginf_pat
-#else
- integer(i8), parameter :: posinf_pat = dposinf_pat
- integer(i8), parameter :: neginf_pat = dneginf_pat
-#endif
-#endif
- real(r4), intent(out) :: output(:,:,:,:,:)
- type(shr_infnan_inf_type), intent(in) :: inf
-
- ! Use scalar temporary for performance reasons, to reduce the cost of
- ! the ieee_value call.
- real(r4) :: tmp
-
-#ifdef HAVE_IEEE_ARITHMETIC
- if (inf%positive) then
- tmp = ieee_value(tmp,ieee_positive_inf)
- else
- tmp = ieee_value(tmp,ieee_negative_inf)
- end if
-#else
- if (inf%positive) then
- tmp = transfer(posinf_pat, tmp)
- else
- tmp = transfer(neginf_pat, tmp)
- end if
-#endif
-
- output = tmp
-
-
-end subroutine set_inf_5d_real
-! TYPE double,real
-! DIMS 0,1,2,3,4,5,6,7
-
-pure subroutine set_inf_6d_real(output, inf)
-#ifdef HAVE_IEEE_ARITHMETIC
- use, intrinsic :: ieee_arithmetic, only: &
- ieee_positive_inf, &
- ieee_negative_inf, &
- ieee_value
-#else
-#if (101 == TYPEREAL)
- integer(i4), parameter :: posinf_pat = sposinf_pat
- integer(i4), parameter :: neginf_pat = sneginf_pat
-#else
- integer(i8), parameter :: posinf_pat = dposinf_pat
- integer(i8), parameter :: neginf_pat = dneginf_pat
-#endif
-#endif
- real(r4), intent(out) :: output(:,:,:,:,:,:)
- type(shr_infnan_inf_type), intent(in) :: inf
-
- ! Use scalar temporary for performance reasons, to reduce the cost of
- ! the ieee_value call.
- real(r4) :: tmp
-
-#ifdef HAVE_IEEE_ARITHMETIC
- if (inf%positive) then
- tmp = ieee_value(tmp,ieee_positive_inf)
- else
- tmp = ieee_value(tmp,ieee_negative_inf)
- end if
-#else
- if (inf%positive) then
- tmp = transfer(posinf_pat, tmp)
- else
- tmp = transfer(neginf_pat, tmp)
- end if
-#endif
-
- output = tmp
-
-
-end subroutine set_inf_6d_real
-! TYPE double,real
-! DIMS 0,1,2,3,4,5,6,7
-
-pure subroutine set_inf_7d_real(output, inf)
-#ifdef HAVE_IEEE_ARITHMETIC
- use, intrinsic :: ieee_arithmetic, only: &
- ieee_positive_inf, &
- ieee_negative_inf, &
- ieee_value
-#else
-#if (101 == TYPEREAL)
- integer(i4), parameter :: posinf_pat = sposinf_pat
- integer(i4), parameter :: neginf_pat = sneginf_pat
-#else
- integer(i8), parameter :: posinf_pat = dposinf_pat
- integer(i8), parameter :: neginf_pat = dneginf_pat
-#endif
-#endif
- real(r4), intent(out) :: output(:,:,:,:,:,:,:)
- type(shr_infnan_inf_type), intent(in) :: inf
-
- ! Use scalar temporary for performance reasons, to reduce the cost of
- ! the ieee_value call.
- real(r4) :: tmp
-
-#ifdef HAVE_IEEE_ARITHMETIC
- if (inf%positive) then
- tmp = ieee_value(tmp,ieee_positive_inf)
- else
- tmp = ieee_value(tmp,ieee_negative_inf)
- end if
-#else
- if (inf%positive) then
- tmp = transfer(posinf_pat, tmp)
- else
- tmp = transfer(neginf_pat, tmp)
- end if
-#endif
-
- output = tmp
-
-
-end subroutine set_inf_7d_real
-
-!---------------------------------------------------------------------
-! CONVERSION INTERFACES.
-!---------------------------------------------------------------------
-! Function methods to get reals from nan/inf types.
-!---------------------------------------------------------------------
-
-
-pure function nan_r8(nan) result(output)
- class(shr_infnan_nan_type), intent(in) :: nan
- real(r8) :: output
-
- output = nan
-
-
-end function nan_r8
-
-
-pure function nan_r4(nan) result(output)
- class(shr_infnan_nan_type), intent(in) :: nan
- real(r4) :: output
-
- output = nan
-
-
-end function nan_r4
-
-
-pure function inf_r8(inf) result(output)
- class(shr_infnan_inf_type), intent(in) :: inf
- real(r8) :: output
-
- output = inf
-
-
-end function inf_r8
-
-
-pure function inf_r4(inf) result(output)
- class(shr_infnan_inf_type), intent(in) :: inf
- real(r4) :: output
-
- output = inf
-
-
-end function inf_r4
-
-end module shr_infnan_mod
diff --git a/test/include/shr_kind_mod.F90 b/test/include/shr_kind_mod.F90
deleted file mode 100644
index e9e7d170..00000000
--- a/test/include/shr_kind_mod.F90
+++ /dev/null
@@ -1,19 +0,0 @@
-MODULE shr_kind_mod
-
- !----------------------------------------------------------------------------
- ! precision/kind constants add data public
- !----------------------------------------------------------------------------
- public
- integer,parameter :: SHR_KIND_R8 = selected_real_kind(12) ! 8 byte real
- integer,parameter :: SHR_KIND_R4 = selected_real_kind( 6) ! 4 byte real
- integer,parameter :: SHR_KIND_RN = kind(1.0) ! native real
- integer,parameter :: SHR_KIND_I8 = selected_int_kind (13) ! 8 byte integer
- integer,parameter :: SHR_KIND_I4 = selected_int_kind ( 6) ! 4 byte integer
- integer,parameter :: SHR_KIND_IN = kind(1) ! native integer
- integer,parameter :: SHR_KIND_CS = 80 ! short char
- integer,parameter :: SHR_KIND_CM = 160 ! mid-sized char
- integer,parameter :: SHR_KIND_CL = 256 ! long char
- integer,parameter :: SHR_KIND_CX = 512 ! extra-long char
- integer,parameter :: SHR_KIND_CXX= 4096 ! extra-extra-long char
-
-END MODULE shr_kind_mod
diff --git a/test/include/spmd_utils.F90 b/test/include/spmd_utils.F90
deleted file mode 100644
index c827ac56..00000000
--- a/test/include/spmd_utils.F90
+++ /dev/null
@@ -1,11 +0,0 @@
-module spmd_utils
-
- implicit none
- private
-
- integer, parameter, public :: masterprocid = 0
- integer, parameter, public :: iam = 0
- integer, parameter, public :: npes = 1
- logical, parameter, public :: masterproc = .true.
-
-end module spmd_utils