diff --git a/flang/lib/evaluate/fold.cc b/flang/lib/evaluate/fold.cc
index cf0f09776286..3e311227d32a 100644
--- a/flang/lib/evaluate/fold.cc
+++ b/flang/lib/evaluate/fold.cc
@@ -364,7 +364,6 @@ Expr<T> Reshape(FoldingContext &context, FunctionRef<T> &&funcRef) {
   std::optional<std::vector<ConstantSubscript>> shape{
       GetIntegerVector<ConstantSubscript>(args[1])};
   std::optional<std::vector<int>> order{GetIntegerVector<int>(args[3])};
-
   if (!source || !shape || (args[2] && !pad) || (args[3] && !order)) {
     return Expr<T>{std::move(funcRef)};  // Non-constant arguments
   } else if (!IsValidShape(shape.value())) {
@@ -565,6 +564,17 @@ Expr<T> FoldOperation(FoldingContext &context, FunctionRef<T> &&funcRef) {
   return Expr<T>{std::move(funcRef)};
 }
 
+template<typename T>
+Expr<T> FoldMerge(FoldingContext &context, FunctionRef<T> &&funcRef) {
+  return FoldElementalIntrinsic<T, T, T, LogicalResult>(context,
+      std::move(funcRef),
+      ScalarFunc<T, T, T, LogicalResult>(
+          [](const Scalar<T> &ifTrue, const Scalar<T> &ifFalse,
+              const Scalar<LogicalResult> &predicate) -> Scalar<T> {
+            return predicate.IsTrue() ? ifTrue : ifFalse;
+          }));
+}
+
 template<int KIND>
 Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
     FoldingContext &context,
@@ -587,6 +597,18 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
         }));
   } else if (name == "bit_size") {
     return Expr<T>{Scalar<T>::bits};
+  } else if (name == "count") {
+    if (!args[1]) {  // TODO: COUNT(x,DIM=d)
+      if (const auto *constant{UnwrapConstantValue<LogicalResult>(args[0])}) {
+        std::int64_t result{0};
+        for (const auto &element : constant->values()) {
+          if (element.IsTrue()) {
+            ++result;
+          }
+        }
+        return Expr<T>{result};
+      }
+    }
   } else if (name == "digits") {
     if (const auto *cx{UnwrapExpr<Expr<SomeInteger>>(args[0])}) {
       return Expr<T>{std::visit(
@@ -780,6 +802,8 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
           },
           sx->u);
     }
+  } else if (name == "merge") {
+    return FoldMerge<T>(context, std::move(funcRef));
   } else if (name == "merge_bits") {
     return FoldElementalIntrinsic<T, T, T, T>(
         context, std::move(funcRef), &Scalar<T>::MERGE_BITS);
@@ -898,9 +922,9 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
     return UBOUND(context, std::move(funcRef));
   }
   // TODO:
-  // ceiling, count, cshift, dot_product, eoshift,
+  // ceiling, cshift, dot_product, eoshift,
   // findloc, floor, iall, iany, iparity, ibits, image_status, index, ishftc,
-  // len_trim, matmul, max, maxloc, maxval, merge, min,
+  // len_trim, matmul, maxloc, maxval,
   // minloc, minval, mod, modulo, nint, not, pack, product, reduce,
   // scan, sign, spread, sum, transfer, transpose, unpack, verify
   return Expr<T>{std::move(funcRef)};
@@ -1037,6 +1061,8 @@ Expr<Type<TypeCategory::Real, KIND>> FoldIntrinsicFunction(
     return Expr<T>{Scalar<T>::HUGE()};
   } else if (name == "max") {
     return FoldMINorMAX(context, std::move(funcRef), Ordering::Greater);
+  } else if (name == "merge") {
+    return FoldMerge<T>(context, std::move(funcRef));
   } else if (name == "min") {
     return FoldMINorMAX(context, std::move(funcRef), Ordering::Less);
   } else if (name == "real") {
@@ -1050,7 +1076,7 @@ Expr<Type<TypeCategory::Real, KIND>> FoldIntrinsicFunction(
     return Expr<T>{Scalar<T>::TINY()};
   }
   // TODO: anint, cshift, dim, dot_product, eoshift, fraction, matmul,
-  // max, maxval, merge, min, minval, modulo, nearest, norm2, pack, product,
+  // maxval, minval, modulo, nearest, norm2, pack, product,
   // reduce, rrspacing, scale, set_exponent, spacing, spread,
   // sum, transfer, transpose, unpack, bessel_jn (transformational) and
   // bessel_yn (transformational)
@@ -1100,8 +1126,10 @@ Expr<Type<TypeCategory::Complex, KIND>> FoldIntrinsicFunction(
     return Fold(context,
         Expr<T>{ComplexConstructor<KIND>{ToReal<KIND>(context, std::move(re)),
             ToReal<KIND>(context, std::move(im))}});
+  } else if (name == "merge") {
+    return FoldMerge<T>(context, std::move(funcRef));
   }
-  // TODO: cshift, dot_product, eoshift, matmul, merge, pack, product,
+  // TODO: cshift, dot_product, eoshift, matmul, pack, product,
   // reduce, spread, sum, transfer, transpose, unpack
   return Expr<T>{std::move(funcRef)};
 }
@@ -1172,9 +1200,11 @@ Expr<Type<TypeCategory::Logical, KIND>> FoldIntrinsicFunction(
             [&fptr](const Scalar<LargestInt> &i, const Scalar<LargestInt> &j) {
               return Scalar<T>{std::invoke(fptr, i, j)};
             }));
+  } else if (name == "merge") {
+    return FoldMerge<T>(context, std::move(funcRef));
   }
   // TODO: btest, cshift, dot_product, eoshift, is_iostat_end,
-  // is_iostat_eor, lge, lgt, lle, llt, logical, matmul, merge, out_of_range,
+  // is_iostat_eor, lge, lgt, lle, llt, logical, matmul, out_of_range,
   // pack, parity, reduce, spread, transfer, transpose, unpack
   return Expr<T>{std::move(funcRef)};
 }
@@ -1201,12 +1231,14 @@ Expr<Type<TypeCategory::Character, KIND>> FoldIntrinsicFunction(
         context, std::move(funcRef), CharacterUtils<KIND>::ADJUSTR);
   } else if (name == "max") {
     return FoldMINorMAX(context, std::move(funcRef), Ordering::Greater);
+  } else if (name == "merge") {
+    return FoldMerge<T>(context, std::move(funcRef));
   } else if (name == "min") {
     return FoldMINorMAX(context, std::move(funcRef), Ordering::Less);
   } else if (name == "new_line") {
     return Expr<T>{Constant<T>{CharacterUtils<KIND>::NEW_LINE()}};
   }
-  // TODO: cshift, eoshift, max, maxval, merge, min, minval, pack, reduce,
+  // TODO: cshift, eoshift, maxval, minval, pack, reduce,
   // repeat, spread, transfer, transpose, trim, unpack
   return Expr<T>{std::move(funcRef)};
 }
@@ -1643,10 +1675,7 @@ private:
         Fold(context_, Expr<SubscriptInteger>{iDo.stride()})};
     std::optional<ConstantSubscript> start{ToInt64(lower)}, end{ToInt64(upper)},
         step{ToInt64(stride)};
-    if (start && end && step) {
-      if (*step == 0) {
-        return false;
-      }
+    if (start && end && step && *step != 0) {
       bool result{true};
       ConstantSubscript &j{context_.StartImpliedDo(iDo.name(), *start)};
       if (*step > 0) {
diff --git a/flang/lib/semantics/expression.cc b/flang/lib/semantics/expression.cc
index 90a06a3292e5..9d32f98fedf0 100644
--- a/flang/lib/semantics/expression.cc
+++ b/flang/lib/semantics/expression.cc
@@ -1058,31 +1058,83 @@ int ExpressionAnalyzer::IntegerTypeSpecKind(
 
 // Array constructors
 
-class ArrayConstructorContext : private ExpressionAnalyzer {
+// Inverts a collection of generic ArrayConstructorValues<SomeType> that
+// all happen to have the same actual type T into one ArrayConstructor<T>.
+template<typename T>
+ArrayConstructorValues<T> MakeSpecific(
+    ArrayConstructorValues<SomeType> &&from) {
+  ArrayConstructorValues<T> to;
+  for (ArrayConstructorValue<SomeType> &x : from) {
+    std::visit(
+        common::visitors{
+            [&](common::CopyableIndirection<Expr<SomeType>> &&expr) {
+              auto *typed{UnwrapExpr<Expr<T>>(expr.value())};
+              to.Push(std::move(DEREF(typed)));
+            },
+            [&](ImpliedDo<SomeType> &&impliedDo) {
+              to.Push(ImpliedDo<T>{impliedDo.name(),
+                  std::move(impliedDo.lower()), std::move(impliedDo.upper()),
+                  std::move(impliedDo.stride()),
+                  MakeSpecific<T>(std::move(impliedDo.values()))});
+            },
+        },
+        std::move(x.u));
+  }
+  return to;
+}
+
+class ArrayConstructorContext {
 public:
   ArrayConstructorContext(
-      ExpressionAnalyzer &c, std::optional<DynamicTypeWithLength> &t)
-    : ExpressionAnalyzer{c}, type_{t} {}
-  ArrayConstructorContext(ArrayConstructorContext &) = default;
-  void Push(MaybeExpr &&);
-  void Add(const parser::AcValue &);
-  std::optional<DynamicTypeWithLength> &type() const { return type_; }
-  const ArrayConstructorValues<SomeType> &values() { return values_; }
+      ExpressionAnalyzer &c, std::optional<DynamicTypeWithLength> &&t)
+    : exprAnalyzer_{c}, type_{std::move(t)} {}
 
-private:
-  template<int KIND, typename A>
-  std::optional<Expr<Type<TypeCategory::Integer, KIND>>> GetSpecificIntExpr(
-      const A &x) {
-    if (MaybeExpr y{Analyze(x)}) {
-      Expr<SomeInteger> *intExpr{UnwrapExpr<Expr<SomeInteger>>(*y)};
-      CHECK(intExpr);
-      return ConvertToType<Type<TypeCategory::Integer, KIND>>(
-          std::move(*intExpr));
+  void Add(const parser::AcValue &);
+  MaybeExpr ToExpr();
+
+  // These interfaces allow *this to be used as a type visitor argument to
+  // common::SearchTypes() to convert the array constructor to a typed
+  // expression in ToExpr().
+  using Result = MaybeExpr;
+  using Types = AllTypes;
+  template<typename T> Result Test() {
+    if (type_ && type_->category() == T::category) {
+      if constexpr (T::category == TypeCategory::Derived) {
+        return AsMaybeExpr(ArrayConstructor<T>{
+            type_->GetDerivedTypeSpec(), MakeSpecific<T>(std::move(values_))});
+      } else if (type_->kind() == T::kind) {
+        if constexpr (T::category == TypeCategory::Character) {
+          if (auto len{type_->LEN()}) {
+            return AsMaybeExpr(ArrayConstructor<T>{
+                *std::move(len), MakeSpecific<T>(std::move(values_))});
+          }
+        } else {
+          return AsMaybeExpr(
+              ArrayConstructor<T>{MakeSpecific<T>(std::move(values_))});
+        }
+      }
     }
     return std::nullopt;
   }
 
-  std::optional<DynamicTypeWithLength> &type_;
+private:
+  void Push(MaybeExpr &&);
+
+  template<int KIND, typename A>
+  std::optional<Expr<Type<TypeCategory::Integer, KIND>>> GetSpecificIntExpr(
+      const A &x) {
+    if (MaybeExpr y{exprAnalyzer_.Analyze(x)}) {
+      Expr<SomeInteger> *intExpr{UnwrapExpr<Expr<SomeInteger>>(*y)};
+      return ConvertToType<Type<TypeCategory::Integer, KIND>>(
+          std::move(DEREF(intExpr)));
+    }
+    return std::nullopt;
+  }
+
+  // Nested array constructors all reference the same ExpressionAnalyzer,
+  // which represents the nest of active implied DO loop indices.
+  ExpressionAnalyzer &exprAnalyzer_;
+  std::optional<DynamicTypeWithLength> type_;
   bool explicitType_{type_.has_value()};
   std::optional<std::int64_t> constantLength_;
   ArrayConstructorValues<SomeType> values_;
@@ -1117,9 +1169,10 @@ void ArrayConstructorContext::Push(MaybeExpr &&x) {
         values_.Push(std::move(*x));
         if (auto thisLen{ToInt64(xType.LEN())}) {
           if (constantLength_) {
-            if (context().warnOnNonstandardUsage() &&
+            if (exprAnalyzer_.context().warnOnNonstandardUsage() &&
                 *thisLen != *constantLength_) {
-              Say("Character literal in array constructor without explicit "
+              exprAnalyzer_.Say(
+                  "Character literal in array constructor without explicit "
                   "type has different length than earlier element"_en_US);
             }
             if (*thisLen > *constantLength_) {
@@ -1135,14 +1188,16 @@ void ArrayConstructorContext::Push(MaybeExpr &&x) {
           }
         }
       } else {
-        Say("Values in array constructor must have the same declared type "
+        exprAnalyzer_.Say(
+            "Values in array constructor must have the same declared type "
             "when no explicit type appears"_err_en_US);
       }
     } else {
       if (auto cast{ConvertToType(*type_, std::move(*x))}) {
         values_.Push(std::move(*cast));
       } else {
-        Say("Value in array constructor could not be converted to the type "
+        exprAnalyzer_.Say(
+            "Value in array constructor could not be converted to the type "
             "of the array"_err_en_US);
       }
     }
@@ -1168,19 +1223,19 @@ void ArrayConstructorContext::Add(const parser::AcValue &x) {
               if (!type_) {
                 type_ = DynamicTypeWithLength{IntType::GetType()};
               }
-              ArrayConstructorContext nested{*this};
-              parser::CharBlock name;
-              nested.Push(Expr<SomeType>{
-                  Expr<SomeInteger>{Expr<IntType>{ImpliedDoIndex{name}}}});
-              values_.Push(ImpliedDo<SomeType>{name, std::move(*lower),
-                  std::move(*upper), std::move(*stride),
-                  std::move(nested.values_)});
+              auto v{std::move(values_)};
+              parser::CharBlock anonymous;
+              Push(Expr<SomeType>{
+                  Expr<SomeInteger>{Expr<IntType>{ImpliedDoIndex{anonymous}}}});
+              std::swap(v, values_);
+              values_.Push(ImpliedDo<SomeType>{anonymous, std::move(*lower),
+                  std::move(*upper), std::move(*stride), std::move(v)});
             }
           },
           [&](const common::Indirection<parser::Expr> &expr) {
-            auto restorer{
-                GetContextualMessages().SetLocation(expr.value().source)};
-            if (MaybeExpr v{Analyze(expr.value())}) {
+            auto restorer{exprAnalyzer_.GetContextualMessages().SetLocation(
+                expr.value().source)};
+            if (MaybeExpr v{exprAnalyzer_.Analyze(expr.value())}) {
               Push(std::move(*v));
             }
           },
@@ -1189,111 +1244,55 @@ void ArrayConstructorContext::Add(const parser::AcValue &x) {
                 std::get<parser::AcImpliedDoControl>(impliedDo.value().t)};
             const auto &bounds{
                 std::get<parser::AcImpliedDoControl::Bounds>(control.t)};
-            Analyze(bounds.name);
+            exprAnalyzer_.Analyze(bounds.name);
             parser::CharBlock name{bounds.name.thing.thing.source};
             const Symbol *symbol{bounds.name.thing.thing.symbol};
             int kind{IntType::kind};
             if (const auto dynamicType{DynamicType::From(symbol)}) {
               kind = dynamicType->kind();
             }
-            bool inserted{AddAcImpliedDo(name, kind)};
-            if (!inserted) {
-              SayAt(name,
+            if (exprAnalyzer_.AddAcImpliedDo(name, kind)) {
+              std::optional<Expr<IntType>> lower{
+                  GetSpecificIntExpr<IntType::kind>(bounds.lower)};
+              std::optional<Expr<IntType>> upper{
+                  GetSpecificIntExpr<IntType::kind>(bounds.upper)};
+              if (lower && upper) {
+                std::optional<Expr<IntType>> stride{
+                    GetSpecificIntExpr<IntType::kind>(bounds.step)};
+                auto v{std::move(values_)};
+                for (const auto &value :
+                    std::get<std::list<parser::AcValue>>(impliedDo.value().t)) {
+                  Add(value);
+                }
+                if (!stride) {
+                  stride = Expr<IntType>{1};
+                }
+                std::swap(v, values_);
+                values_.Push(ImpliedDo<SomeType>{name, std::move(*lower),
+                    std::move(*upper), std::move(*stride), std::move(v)});
+              }
+              exprAnalyzer_.RemoveAcImpliedDo(name);
+            } else {
+              exprAnalyzer_.SayAt(name,
                   "Implied DO index is active in surrounding implied DO loop "
                   "and may not have the same name"_err_en_US);
             }
-            std::optional<Expr<IntType>> lower{
-                GetSpecificIntExpr<IntType::kind>(bounds.lower)};
-            std::optional<Expr<IntType>> upper{
-                GetSpecificIntExpr<IntType::kind>(bounds.upper)};
-            std::optional<Expr<IntType>> stride{
-                GetSpecificIntExpr<IntType::kind>(bounds.step)};
-            ArrayConstructorContext nested{*this};
-            for (const auto &value :
-                std::get<std::list<parser::AcValue>>(impliedDo.value().t)) {
-              nested.Add(value);
-            }
-            if (lower && upper) {
-              if (!stride) {
-                stride = Expr<IntType>{1};
-              }
-              values_.Push(ImpliedDo<SomeType>{name, std::move(*lower),
-                  std::move(*upper), std::move(*stride),
-                  std::move(nested.values_)});
-            }
-            if (inserted) {
-              RemoveAcImpliedDo(name);
-            }
           },
       },
       x.u);
 }
 
-// Inverts a collection of generic ArrayConstructorValues<SomeType> that
-// all happen to have the same actual type T into one ArrayConstructor<T>.
-template<typename T>
-ArrayConstructorValues<T> MakeSpecific(
-    ArrayConstructorValues<SomeType> &&from) {
-  ArrayConstructorValues<T> to;
-  for (ArrayConstructorValue<SomeType> &x : from) {
-    std::visit(
-        common::visitors{
-            [&](common::CopyableIndirection<Expr<SomeType>> &&expr) {
-              auto *typed{UnwrapExpr<Expr<T>>(expr.value())};
-              CHECK(typed);
-              to.Push(std::move(*typed));
-            },
-            [&](ImpliedDo<SomeType> &&impliedDo) {
-              to.Push(ImpliedDo<T>{impliedDo.name(),
-                  std::move(impliedDo.lower()), std::move(impliedDo.upper()),
-                  std::move(impliedDo.stride()),
-                  MakeSpecific<T>(std::move(impliedDo.values()))});
-            },
-        },
-        std::move(x.u));
-  }
-  return to;
+MaybeExpr ArrayConstructorContext::ToExpr() {
+  return common::SearchTypes(std::move(*this));
 }
 
-struct ArrayConstructorTypeVisitor {
-  using Result = MaybeExpr;
-  using Types = AllTypes;
-  template<typename T> Result Test() {
-    if (type.category() == T::category) {
-      if constexpr (T::category == TypeCategory::Derived) {
-        return AsMaybeExpr(ArrayConstructor<T>{
-            type.GetDerivedTypeSpec(), MakeSpecific<T>(std::move(values))});
-      } else if (type.kind() == T::kind) {
-        if constexpr (T::category == TypeCategory::Character) {
-          if (auto len{type.LEN()}) {
-            return AsMaybeExpr(ArrayConstructor<T>{
-                *std::move(len), MakeSpecific<T>(std::move(values))});
-          }
-        } else {
-          return AsMaybeExpr(
-              ArrayConstructor<T>{MakeSpecific<T>(std::move(values))});
-        }
-      }
-    }
-    return std::nullopt;
-  }
-  DynamicTypeWithLength type;
-  ArrayConstructorValues<SomeType> values;
-};
-
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::ArrayConstructor &array) {
   const parser::AcSpec &acSpec{array.v};
-  std::optional<DynamicTypeWithLength> type{AnalyzeTypeSpec(acSpec.type)};
-  ArrayConstructorContext context{*this, type};
+  ArrayConstructorContext acContext{*this, AnalyzeTypeSpec(acSpec.type)};
   for (const parser::AcValue &value : acSpec.values) {
-    context.Add(value);
+    acContext.Add(value);
   }
-  if (type) {
-    ArrayConstructorTypeVisitor visitor{
-        std::move(*type), std::move(context.values())};
-    return common::SearchTypes(std::move(visitor));
-  }
-  return std::nullopt;
+  return acContext.ToExpr();
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(
diff --git a/flang/module/iso_fortran_env.f90 b/flang/module/iso_fortran_env.f90
index c15dd199f4f3..b47f8955330b 100644
--- a/flang/module/iso_fortran_env.f90
+++ b/flang/module/iso_fortran_env.f90
@@ -19,20 +19,113 @@ include '../runtime/magic-numbers.h' ! for IOSTAT= error/end code values
 
 module iso_fortran_env
 
-  integer, parameter :: atomic_int_kind = 8
-  integer, parameter :: atomic_logical_kind = 8
+  implicit none
 
-  integer, parameter :: character_kinds(*) = [1, 2, 4]
-  integer, parameter :: int8 = 1, int16 = 2, int32 = 4, int64 = 8, int128 = 16
-  integer, parameter :: integer_kinds(*) = [int8, int16, int32, int64, int128]
+  integer, parameter :: atomic_int_kind = selected_int_kind(18)
+  integer, parameter :: atomic_logical_kind = atomic_int_kind
+
+  ! TODO: Use PACK([x],test) in place of the array constructor idiom
+  ! [(x, integer::j=1,COUNT([test]))] below once PACK() can be folded.
+
+  integer, parameter, private :: &
+    selectedASCII = selected_char_kind('ASCII'), &
+    selectedUCS_2 = selected_char_kind('UCS-2'), &
+    selectedUnicode = selected_char_kind('ISO_10646')
+  integer, parameter :: character_kinds(*) = [ &
+    [(selectedASCII, integer :: j=1, count([selectedASCII >= 0]))], &
+    [(selectedUCS_2, integer :: j=1, count([selectedUCS_2 >= 0]))], &
+    [(selectedUnicode, integer :: j=1, count([selectedUnicode >= 0]))]]
+
+  integer, parameter, private :: &
+    selectedInt8 = selected_int_kind(2), &
+    selectedInt16 = selected_int_kind(4), &
+    selectedInt32 = selected_int_kind(9), &
+    selectedInt64 = selected_int_kind(18),&
+    selectedInt128 = selected_int_kind(38), &
+    safeInt8 = merge(selectedInt8, selected_int_kind(0), &
+                     selectedInt8 >= 0), &
+    safeInt16 = merge(selectedInt16, selected_int_kind(0), &
+                      selectedInt16 >= 0), &
+    safeInt32 = merge(selectedInt32, selected_int_kind(0), &
+                      selectedInt32 >= 0), &
+    safeInt64 = merge(selectedInt64, selected_int_kind(0), &
+                      selectedInt64 >= 0), &
+    safeInt128 = merge(selectedInt128, selected_int_kind(0), &
+                       selectedInt128 >= 0)
   integer, parameter :: &
-    logical8 = 1, logical16 = 2, logical32 = 4, logical64 = 8
-  integer, parameter :: logical_kinds(*) = &
-    [logical8, logical16, logical32, logical64]
+    int8 = merge(selectedInt8, merge(-2, -1, selectedInt8 >= 0), &
+                 digits(int(0,kind=safeInt8)) == 7), &
+    int16 = merge(selectedInt16, merge(-2, -1, selectedInt16 >= 0), &
+                  digits(int(0,kind=safeInt16)) == 15), &
+    int32 = merge(selectedInt32, merge(-2, -1, selectedInt32 >= 0), &
+                  digits(int(0,kind=safeInt32)) == 31), &
+    int64 = merge(selectedInt64, merge(-2, -1, selectedInt64 >= 0), &
+                  digits(int(0,kind=safeInt64)) == 63), &
+    int128 = merge(selectedInt128, merge(-2, -1, selectedInt128 >= 0), &
+                   digits(int(0,kind=safeInt128)) == 127)
+
+  integer, parameter :: integer_kinds(*) = [ &
+    selected_int_kind(0), &
+    ((selected_int_kind(k), &
+      integer :: j=1, count([selected_int_kind(k) >= 0 .and. &
+                             selected_int_kind(k) /= &
+                               selected_int_kind(k-1)])), &
+     integer :: k=1, 39)]
+
   integer, parameter :: &
-    real16 = 2, real32 = 4, real64 = 8, real80 = 10, real128 = 16
-  integer, parameter :: real_kinds(*) = &
-    [real16, 3, real32, real64, real80, real128]
+    logical8 = int8, logical16 = int16, logical32 = int32, logical64 = int64
+  integer, parameter :: logical_kinds(*) = [ &
+    [(logical8, integer :: j=1, count([logical8 >= 0]))], &
+    [(logical16, integer :: j=1, count([logical16 >= 0]))], &
+    [(logical32, integer :: j=1, count([logical32 >= 0]))], &
+    [(logical64, integer :: j=1, count([logical64 >= 0]))]]
+
+  integer, parameter, private :: &
+    selectedReal16 = selected_real_kind(3, 4), &      ! IEEE half
+    selectedBfloat16 = selected_real_kind(2, 37), &   ! truncated IEEE single
+    selectedReal32 = selected_real_kind(6, 37), &     ! IEEE single
+    selectedReal64 = selected_real_kind(15, 307), &   ! IEEE double
+    selectedReal80 = selected_real_kind(18, 4931), &  ! 80x87 extended
+    selectedReal64x2 = selected_real_kind(31, 307), & ! "double-double"
+    selectedReal128 = selected_real_kind(33, 9863), & ! IEEE quad
+    safeReal16 = merge(selectedReal16, selected_real_kind(0,0), &
+                       selectedReal16 >= 0), &
+    safeBfloat16 = merge(selectedBfloat16, selected_real_kind(0,0), &
+                         selectedBfloat16 >= 0), &
+    safeReal32 = merge(selectedReal32, selected_real_kind(0,0), &
+                       selectedReal32 >= 0), &
+    safeReal64 = merge(selectedReal64, selected_real_kind(0,0), &
+                       selectedReal64 >= 0), &
+    safeReal80 = merge(selectedReal80, selected_real_kind(0,0), &
+                       selectedReal80 >= 0), &
+    safeReal64x2 = merge(selectedReal64x2, selected_real_kind(0,0), &
+                         selectedReal64x2 >= 0), &
+    safeReal128 = merge(selectedReal128, selected_real_kind(0,0), &
+                        selectedReal128 >= 0)
+  integer, parameter :: &
+    real16 = merge(selectedReal16, merge(-2, -1, selectedReal16 >= 0), &
+                   digits(real(0,kind=safeReal16)) == 11), &
+    bfloat16 = merge(selectedBfloat16, merge(-2, -1, selectedBfloat16 >= 0), &
+                     digits(real(0,kind=safeBfloat16)) == 8), &
+    real32 = merge(selectedReal32, merge(-2, -1, selectedReal32 >= 0), &
+                   digits(real(0,kind=safeReal32)) == 24), &
+    real64 = merge(selectedReal64, merge(-2, -1, selectedReal64 >= 0), &
+                   digits(real(0,kind=safeReal64)) == 53), &
+    real80 = merge(selectedReal80, merge(-2, -1, selectedReal80 >= 0), &
+                   digits(real(0,kind=safeReal80)) == 64), &
+    real64x2 = merge(selectedReal64x2, merge(-2, -1, selectedReal64x2 >= 0), &
+                     digits(real(0,kind=safeReal64x2)) == 106), &
+    real128 = merge(selectedReal128, merge(-2, -1, selectedReal128 >= 0), &
+                    digits(real(0,kind=safeReal128)) == 112)
+
+  integer, parameter :: real_kinds(*) = [ &
+    [(real16, integer :: j=1, count([real16 >= 0]))], &
+    [(bfloat16, integer :: j=1, count([bfloat16 >= 0]))], &
+    [(real32, integer :: j=1, count([real32 >= 0]))], &
+    [(real64, integer :: j=1, count([real64 >= 0]))], &
+    [(real80, integer :: j=1, count([real80 >= 0]))], &
+    [(real64x2, integer :: j=1, count([real64x2 >= 0]))], &
+    [(real128, integer :: j=1, count([real128 >= 0]))]]
 
   integer, parameter :: current_team = -1, initial_team = -2, parent_team = -3
 
@@ -76,4 +169,3 @@ module iso_fortran_env
     compiler_version = 'f18 in development'
   end function compiler_version
 end module iso_fortran_env
-