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