From 8d672c0b3e70b060e215cbd13536a10b50f6fab2 Mon Sep 17 00:00:00 2001
From: peter klausler <pklausler@nvidia.com>
Date: Tue, 20 Apr 2021 09:19:21 -0700
Subject: [PATCH] [flang] Implement IPARITY, PARITY, and FINDLOC reductions

Define APIs for, and implement, these three more recently-introduced
standard reduction transformational intrinsic functions to the runtime.

Differential Revision: https://reviews.llvm.org/D100863
---
 flang/runtime/reduction.cpp                | 1123 +++++++++++++++++-----------
 flang/runtime/reduction.h                  |   42 +-
 flang/runtime/terminator.h                 |    4 +
 flang/runtime/tools.h                      |   79 ++
 flang/unittests/RuntimeGTest/Reduction.cpp |  168 ++++-
 5 files changed, 956 insertions(+), 460 deletions(-)

diff --git a/flang/runtime/reduction.cpp b/flang/runtime/reduction.cpp
index 1f4ed50..50fbc5b 100644
--- a/flang/runtime/reduction.cpp
+++ b/flang/runtime/reduction.cpp
@@ -6,9 +6,9 @@
 //
 //===----------------------------------------------------------------------===//
 
-// Implements ALL, ANY, COUNT, MAXLOC, MAXVAL, MINLOC, MINVAL, PRODUCT, and SUM
-// for all required operand types and shapes and (for MAXLOC & MINLOC) kinds of
-// results.
+// Implements ALL, ANY, COUNT, FINDLOC, IPARITY, MAXLOC, MAXVAL, MINLOC, MINVAL,
+// PARITY, PRODUCT, and SUM for all required operand types and shapes and,
+// for FINDLOC, MAXLOC, & MINLOC, kinds of results.
 //
 // * Real and complex SUM reductions attempt to reduce floating-point
 //   cancellation on intermediate results by adding up partial sums
@@ -16,7 +16,7 @@
 // * Partial reductions (i.e., those with DIM= arguments that are not
 //   required to be 1 by the rank of the argument) return arrays that
 //   are dynamically allocated in a caller-supplied descriptor.
-// * Total reductions (i.e., no DIM= argument) with MAXLOC & MINLOC
+// * Total reductions (i.e., no DIM= argument) with FINDLOC, MAXLOC, & MINLOC
 //   return integer vectors of some kind, not scalars; a caller-supplied
 //   descriptor is used
 // * Character-valued reductions (MAXVAL & MINVAL) return arbitrary
@@ -46,8 +46,8 @@ namespace Fortran::runtime {
 // member function that copies a final result into its destination.
 
 // Total reduction of the array argument to a scalar (or to a vector in the
-// cases of MAXLOC & MINLOC).  These are the cases without DIM= or cases
-// where the argument has rank 1 and DIM=, if present, must be 1.
+// cases of FINDLOC, MAXLOC, & MINLOC).  These are the cases without DIM= or
+// cases where the argument has rank 1 and DIM=, if present, must be 1.
 template <typename TYPE, typename ACCUMULATOR>
 inline void DoTotalReduction(const Descriptor &x, int dim,
     const Descriptor *mask, ACCUMULATOR &accumulator, const char *intrinsic,
@@ -122,8 +122,7 @@ inline void GetExpandedSubscripts(SubscriptValue at[],
 
 template <typename TYPE, typename ACCUMULATOR>
 inline void ReduceDimToScalar(const Descriptor &x, int zeroBasedDim,
-    SubscriptValue subscripts[], TYPE *result) {
-  ACCUMULATOR accumulator{x};
+    SubscriptValue subscripts[], TYPE *result, ACCUMULATOR &accumulator) {
   SubscriptValue xAt[maxRank];
   GetExpandedSubscripts(xAt, x, zeroBasedDim, subscripts);
   const auto &dim{x.GetDimension(zeroBasedDim)};
@@ -143,8 +142,8 @@ inline void ReduceDimToScalar(const Descriptor &x, int zeroBasedDim,
 
 template <typename TYPE, typename ACCUMULATOR>
 inline void ReduceDimMaskToScalar(const Descriptor &x, int zeroBasedDim,
-    SubscriptValue subscripts[], const Descriptor &mask, TYPE *result) {
-  ACCUMULATOR accumulator{x};
+    SubscriptValue subscripts[], const Descriptor &mask, TYPE *result,
+    ACCUMULATOR &accumulator) {
   SubscriptValue xAt[maxRank], maskAt[maxRank];
   GetExpandedSubscripts(xAt, x, zeroBasedDim, subscripts);
   GetExpandedSubscripts(maskAt, mask, zeroBasedDim, subscripts);
@@ -201,7 +200,8 @@ static void CreatePartialReductionResult(Descriptor &result,
 
 template <typename ACCUMULATOR, TypeCategory CAT, int KIND>
 inline void PartialReduction(Descriptor &result, const Descriptor &x, int dim,
-    const Descriptor *mask, Terminator &terminator, const char *intrinsic) {
+    const Descriptor *mask, Terminator &terminator, const char *intrinsic,
+    ACCUMULATOR &accumulator) {
   CreatePartialReductionResult(
       result, x, dim, terminator, intrinsic, TypeCode{CAT, KIND});
   SubscriptValue at[maxRank];
@@ -213,13 +213,14 @@ inline void PartialReduction(Descriptor &result, const Descriptor &x, int dim,
     SubscriptValue maskAt[maxRank]; // contents unused
     if (mask->rank() > 0) {
       for (auto n{result.Elements()}; n-- > 0; result.IncrementSubscripts(at)) {
+        accumulator.Reinitialize();
         ReduceDimMaskToScalar<CppType, ACCUMULATOR>(
-            x, dim - 1, at, *mask, result.Element<CppType>(at));
+            x, dim - 1, at, *mask, result.Element<CppType>(at), accumulator);
       }
       return;
     } else if (!IsLogicalElementTrue(*mask, maskAt)) {
       // scalar MASK=.FALSE.
-      ACCUMULATOR accumulator{x};
+      accumulator.Reinitialize();
       for (auto n{result.Elements()}; n-- > 0; result.IncrementSubscripts(at)) {
         accumulator.GetResult(result.Element<CppType>(at));
       }
@@ -228,11 +229,54 @@ inline void PartialReduction(Descriptor &result, const Descriptor &x, int dim,
   }
   // No MASK= or scalar MASK=.TRUE.
   for (auto n{result.Elements()}; n-- > 0; result.IncrementSubscripts(at)) {
+    accumulator.Reinitialize();
     ReduceDimToScalar<CppType, ACCUMULATOR>(
-        x, dim - 1, at, result.Element<CppType>(at));
+        x, dim - 1, at, result.Element<CppType>(at), accumulator);
   }
 }
 
+template <template <typename> class ACCUM>
+struct PartialIntegerReductionHelper {
+  template <int KIND> struct Functor {
+    static constexpr int Intermediate{
+        std::max(KIND, 4)}; // use at least "int" for intermediate results
+    void operator()(Descriptor &result, const Descriptor &x, int dim,
+        const Descriptor *mask, Terminator &terminator,
+        const char *intrinsic) const {
+      using Accumulator =
+          ACCUM<CppTypeFor<TypeCategory::Integer, Intermediate>>;
+      Accumulator accumulator{x};
+      PartialReduction<Accumulator, TypeCategory::Integer, KIND>(
+          result, x, dim, mask, terminator, intrinsic, accumulator);
+    }
+  };
+};
+
+template <template <typename> class INTEGER_ACCUM>
+inline void PartialIntegerReduction(Descriptor &result, const Descriptor &x,
+    int dim, int kind, const Descriptor *mask, const char *intrinsic,
+    Terminator &terminator) {
+  ApplyIntegerKind<
+      PartialIntegerReductionHelper<INTEGER_ACCUM>::template Functor, void>(
+      kind, terminator, result, x, dim, mask, terminator, intrinsic);
+}
+
+template <TypeCategory CAT, template <typename> class ACCUM>
+struct PartialFloatingReductionHelper {
+  template <int KIND> struct Functor {
+    static constexpr int Intermediate{
+        std::max(KIND, 8)}; // use at least "double" for intermediate results
+    void operator()(Descriptor &result, const Descriptor &x, int dim,
+        const Descriptor *mask, Terminator &terminator,
+        const char *intrinsic) const {
+      using Accumulator = ACCUM<CppTypeFor<TypeCategory::Real, Intermediate>>;
+      Accumulator accumulator{x};
+      PartialReduction<Accumulator, CAT, KIND>(
+          result, x, dim, mask, terminator, intrinsic, accumulator);
+    }
+  };
+};
+
 template <template <typename> class INTEGER_ACCUM,
     template <typename> class REAL_ACCUM,
     template <typename> class COMPLEX_ACCUM>
@@ -244,98 +288,24 @@ inline void TypedPartialNumericReduction(Descriptor &result,
   RUNTIME_CHECK(terminator, catKind.has_value());
   switch (catKind->first) {
   case TypeCategory::Integer:
-    switch (catKind->second) {
-    case 1:
-      PartialReduction<INTEGER_ACCUM<CppTypeFor<TypeCategory::Integer, 4>>,
-          TypeCategory::Integer, 1>(
-          result, x, dim, mask, terminator, intrinsic);
-      return;
-    case 2:
-      PartialReduction<INTEGER_ACCUM<CppTypeFor<TypeCategory::Integer, 4>>,
-          TypeCategory::Integer, 2>(
-          result, x, dim, mask, terminator, intrinsic);
-      return;
-    case 4:
-      PartialReduction<INTEGER_ACCUM<CppTypeFor<TypeCategory::Integer, 4>>,
-          TypeCategory::Integer, 4>(
-          result, x, dim, mask, terminator, intrinsic);
-      return;
-    case 8:
-      PartialReduction<INTEGER_ACCUM<CppTypeFor<TypeCategory::Integer, 8>>,
-          TypeCategory::Integer, 8>(
-          result, x, dim, mask, terminator, intrinsic);
-      return;
-#ifdef __SIZEOF_INT128__
-    case 16:
-      PartialReduction<INTEGER_ACCUM<CppTypeFor<TypeCategory::Integer, 16>>,
-          TypeCategory::Integer, 16>(
-          result, x, dim, mask, terminator, intrinsic);
-      return;
-#endif
-    }
+    PartialIntegerReduction<INTEGER_ACCUM>(
+        result, x, dim, catKind->second, mask, intrinsic, terminator);
     break;
   case TypeCategory::Real:
-    switch (catKind->second) {
-#if 0 // TODO
-    case 2:
-    case 3:
-#endif
-    case 4:
-      PartialReduction<REAL_ACCUM<CppTypeFor<TypeCategory::Real, 8>>,
-          TypeCategory::Real, 4>(result, x, dim, mask, terminator, intrinsic);
-      return;
-    case 8:
-      PartialReduction<REAL_ACCUM<CppTypeFor<TypeCategory::Real, 8>>,
-          TypeCategory::Real, 8>(result, x, dim, mask, terminator, intrinsic);
-      return;
-#if LONG_DOUBLE == 80
-    case 10:
-      PartialReduction<REAL_ACCUM<CppTypeFor<TypeCategory::Real, 10>>,
-          TypeCategory::Real, 10>(result, x, dim, mask, terminator, intrinsic);
-      return;
-#elif LONG_DOUBLE == 128
-    case 16:
-      PartialReduction<REAL_ACCUM<CppTypeFor<TypeCategory::Real, 16>>,
-          TypeCategory::Real, 16>(result, x, dim, mask, terminator, intrinsic);
-      return;
-#endif
-    }
+    ApplyFloatingPointKind<PartialFloatingReductionHelper<TypeCategory::Real,
+                               REAL_ACCUM>::template Functor,
+        void>(catKind->second, terminator, result, x, dim, mask, terminator,
+        intrinsic);
     break;
   case TypeCategory::Complex:
-    switch (catKind->second) {
-#if 0 // TODO
-    case 2:
-    case 3:
-#endif
-    case 4:
-      PartialReduction<COMPLEX_ACCUM<CppTypeFor<TypeCategory::Real, 8>>,
-          TypeCategory::Complex, 4>(
-          result, x, dim, mask, terminator, intrinsic);
-      return;
-    case 8:
-      PartialReduction<COMPLEX_ACCUM<CppTypeFor<TypeCategory::Real, 8>>,
-          TypeCategory::Complex, 8>(
-          result, x, dim, mask, terminator, intrinsic);
-      return;
-#if LONG_DOUBLE == 80
-    case 10:
-      PartialReduction<COMPLEX_ACCUM<CppTypeFor<TypeCategory::Real, 10>>,
-          TypeCategory::Complex, 10>(
-          result, x, dim, mask, terminator, intrinsic);
-      return;
-#elif LONG_DOUBLE == 128
-    case 16:
-      PartialReduction<COMPLEX_ACCUM<CppTypeFor<TypeCategory::Real, 16>>,
-          TypeCategory::Complex, 16>(
-          result, x, dim, mask, terminator, intrinsic);
-      return;
-#endif
-    }
+    ApplyFloatingPointKind<PartialFloatingReductionHelper<TypeCategory::Complex,
+                               COMPLEX_ACCUM>::template Functor,
+        void>(catKind->second, terminator, result, x, dim, mask, terminator,
+        intrinsic);
     break;
   default:
-    break;
+    terminator.Crash("%s: invalid type code %d", intrinsic, x.type().raw());
   }
-  terminator.Crash("%s: invalid type code %d", intrinsic, x.type().raw());
 }
 
 // SUM()
@@ -343,6 +313,7 @@ inline void TypedPartialNumericReduction(Descriptor &result,
 template <typename INTERMEDIATE> class IntegerSumAccumulator {
 public:
   explicit IntegerSumAccumulator(const Descriptor &array) : array_{array} {}
+  void Reinitialize() { sum_ = 0; }
   template <typename A> void GetResult(A *p, int /*zeroBasedDim*/ = -1) const {
     *p = static_cast<A>(sum_);
   }
@@ -359,6 +330,7 @@ private:
 template <typename INTERMEDIATE> class RealSumAccumulator {
 public:
   explicit RealSumAccumulator(const Descriptor &array) : array_{array} {}
+  void Reinitialize() { positives_ = negatives_ = inOrder_ = 0; }
   template <typename A> A Result() const {
     auto sum{static_cast<A>(positives_ + negatives_)};
     return std::isfinite(sum) ? sum : static_cast<A>(inOrder_);
@@ -390,6 +362,10 @@ private:
 template <typename PART> class ComplexSumAccumulator {
 public:
   explicit ComplexSumAccumulator(const Descriptor &array) : array_{array} {}
+  void Reinitialize() {
+    reals_.Reinitialize();
+    imaginaries_.Reinitialize();
+  }
   template <typename A> void GetResult(A *p, int /*zeroBasedDim*/ = -1) const {
     using ResultPart = typename A::value_type;
     *p = {reals_.template Result<ResultPart>(),
@@ -505,6 +481,7 @@ template <typename INTERMEDIATE> class NonComplexProductAccumulator {
 public:
   explicit NonComplexProductAccumulator(const Descriptor &array)
       : array_{array} {}
+  void Reinitialize() { product_ = 1; }
   template <typename A> void GetResult(A *p, int /*zeroBasedDim*/ = -1) const {
     *p = static_cast<A>(product_);
   }
@@ -521,6 +498,7 @@ private:
 template <typename PART> class ComplexProductAccumulator {
 public:
   explicit ComplexProductAccumulator(const Descriptor &array) : array_{array} {}
+  void Reinitialize() { product_ = std::complex<PART>{1, 0}; }
   template <typename A> void GetResult(A *p, int /*zeroBasedDim*/ = -1) const {
     using ResultPart = typename A::value_type;
     *p = {static_cast<ResultPart>(product_.real()),
@@ -645,14 +623,77 @@ void RTNAME(ProductDim)(Descriptor &result, const Descriptor &x, int dim,
 }
 } // extern "C"
 
-// MAXLOC and MINLOC
+// IPARITY()
+
+template <typename INTERMEDIATE> class IntegerXorAccumulator {
+public:
+  explicit IntegerXorAccumulator(const Descriptor &array) : array_{array} {}
+  void Reinitialize() { xor_ = 0; }
+  template <typename A> void GetResult(A *p, int /*zeroBasedDim*/ = -1) const {
+    *p = static_cast<A>(xor_);
+  }
+  template <typename A> bool AccumulateAt(const SubscriptValue at[]) {
+    xor_ ^= *array_.Element<A>(at);
+    return true;
+  }
+
+private:
+  const Descriptor &array_;
+  INTERMEDIATE xor_{0};
+};
+
+extern "C" {
+CppTypeFor<TypeCategory::Integer, 1> RTNAME(IParity1)(const Descriptor &x,
+    const char *source, int line, int dim, const Descriptor *mask) {
+  return GetTotalReduction<TypeCategory::Integer, 1>(x, source, line, dim, mask,
+      IntegerXorAccumulator<CppTypeFor<TypeCategory::Integer, 4>>{x},
+      "IPARITY");
+}
+CppTypeFor<TypeCategory::Integer, 2> RTNAME(IParity2)(const Descriptor &x,
+    const char *source, int line, int dim, const Descriptor *mask) {
+  return GetTotalReduction<TypeCategory::Integer, 2>(x, source, line, dim, mask,
+      IntegerXorAccumulator<CppTypeFor<TypeCategory::Integer, 4>>{x},
+      "IPARITY");
+}
+CppTypeFor<TypeCategory::Integer, 4> RTNAME(IParity4)(const Descriptor &x,
+    const char *source, int line, int dim, const Descriptor *mask) {
+  return GetTotalReduction<TypeCategory::Integer, 4>(x, source, line, dim, mask,
+      IntegerXorAccumulator<CppTypeFor<TypeCategory::Integer, 4>>{x},
+      "IPARITY");
+}
+CppTypeFor<TypeCategory::Integer, 8> RTNAME(IParity8)(const Descriptor &x,
+    const char *source, int line, int dim, const Descriptor *mask) {
+  return GetTotalReduction<TypeCategory::Integer, 8>(x, source, line, dim, mask,
+      IntegerXorAccumulator<CppTypeFor<TypeCategory::Integer, 8>>{x},
+      "IPARITY");
+}
+#ifdef __SIZEOF_INT128__
+CppTypeFor<TypeCategory::Integer, 16> RTNAME(IParity16)(const Descriptor &x,
+    const char *source, int line, int dim, const Descriptor *mask) {
+  return GetTotalReduction<TypeCategory::Integer, 16>(x, source, line, dim,
+      mask, IntegerXorAccumulator<CppTypeFor<TypeCategory::Integer, 16>>{x},
+      "IPARITY");
+}
+#endif
+void RTNAME(IParityDim)(Descriptor &result, const Descriptor &x, int dim,
+    const char *source, int line, const Descriptor *mask) {
+  Terminator terminator{source, line};
+  auto catKind{x.type().GetCategoryAndKind()};
+  RUNTIME_CHECK(terminator,
+      catKind.has_value() && catKind->first == TypeCategory::Integer);
+  PartialIntegerReduction<IntegerXorAccumulator>(
+      result, x, dim, catKind->second, mask, "IPARITY", terminator);
+}
+}
+
+// MAXLOC & MINLOC
 
 template <typename T, bool IS_MAX, bool BACK> struct NumericCompare {
   using Type = T;
   explicit NumericCompare(std::size_t /*elemLen; ignored*/) {}
-  bool operator()(const T &value, const T &previous) {
-    if (BACK && value == previous) {
-      return true;
+  bool operator()(const T &value, const T &previous) const {
+    if (value == previous) {
+      return BACK;
     } else if constexpr (IS_MAX) {
       return value > previous;
     } else {
@@ -666,10 +707,10 @@ public:
   using Type = T;
   explicit CharacterCompare(std::size_t elemLen)
       : chars_{elemLen / sizeof(T)} {}
-  bool operator()(const T &value, const T &previous) {
+  bool operator()(const T &value, const T &previous) const {
     int cmp{CharacterScalarCompare<T>(&value, &previous, chars_, chars_)};
-    if (BACK && cmp == 0) {
-      return true;
+    if (cmp == 0) {
+      return BACK;
     } else if constexpr (IS_MAX) {
       return cmp > 0;
     } else {
@@ -686,10 +727,14 @@ public:
   using Type = typename COMPARE::Type;
   ExtremumLocAccumulator(const Descriptor &array, std::size_t chars = 0)
       : array_{array}, argRank_{array.rank()}, compare_{array.ElementBytes()} {
+    Reinitialize();
+  }
+  void Reinitialize() {
     // per standard: result indices are all zero if no data
     for (int j{0}; j < argRank_; ++j) {
       extremumLoc_[j] = 0;
     }
+    previous_ = nullptr;
   }
   int argRank() const { return argRank_; }
   template <typename A> void GetResult(A *p, int zeroBasedDim = -1) {
@@ -720,38 +765,23 @@ private:
   COMPARE compare_;
 };
 
-template <typename COMPARE, typename CPPTYPE>
-static void DoMaxOrMinLocHelper(const char *intrinsic, Descriptor &result,
+template <typename ACCUMULATOR> struct LocationResultHelper {
+  template <int KIND> struct Functor {
+    void operator()(ACCUMULATOR &accumulator, const Descriptor &result) const {
+      accumulator.GetResult(
+          result.OffsetElement<CppTypeFor<TypeCategory::Integer, KIND>>());
+    }
+  };
+};
+
+template <typename ACCUMULATOR, typename CPPTYPE>
+static void LocationHelper(const char *intrinsic, Descriptor &result,
     const Descriptor &x, int kind, const Descriptor *mask,
     Terminator &terminator) {
-  ExtremumLocAccumulator<COMPARE> accumulator{x};
+  ACCUMULATOR accumulator{x};
   DoTotalReduction<CPPTYPE>(x, 0, mask, accumulator, intrinsic, terminator);
-  switch (kind) {
-  case 1:
-    accumulator.GetResult(
-        result.OffsetElement<CppTypeFor<TypeCategory::Integer, 1>>());
-    break;
-  case 2:
-    accumulator.GetResult(
-        result.OffsetElement<CppTypeFor<TypeCategory::Integer, 2>>());
-    break;
-  case 4:
-    accumulator.GetResult(
-        result.OffsetElement<CppTypeFor<TypeCategory::Integer, 4>>());
-    break;
-  case 8:
-    accumulator.GetResult(
-        result.OffsetElement<CppTypeFor<TypeCategory::Integer, 8>>());
-    break;
-#ifdef __SIZEOF_INT128__
-  case 16:
-    accumulator.GetResult(
-        result.OffsetElement<CppTypeFor<TypeCategory::Integer, 16>>());
-    break;
-#endif
-  default:
-    terminator.Crash("%s: bad KIND=%d", intrinsic, kind);
-  }
+  ApplyIntegerKind<LocationResultHelper<ACCUMULATOR>::template Functor, void>(
+      kind, terminator, accumulator, result);
 }
 
 template <TypeCategory CAT, int KIND, bool IS_MAX,
@@ -762,14 +792,25 @@ inline void DoMaxOrMinLoc(const char *intrinsic, Descriptor &result,
   using CppType = CppTypeFor<CAT, KIND>;
   Terminator terminator{source, line};
   if (back) {
-    DoMaxOrMinLocHelper<COMPARE<CppType, IS_MAX, true>, CppType>(
-        intrinsic, result, x, kind, mask, terminator);
+    LocationHelper<ExtremumLocAccumulator<COMPARE<CppType, IS_MAX, true>>,
+        CppType>(intrinsic, result, x, kind, mask, terminator);
   } else {
-    DoMaxOrMinLocHelper<COMPARE<CppType, IS_MAX, false>, CppType>(
-        intrinsic, result, x, kind, mask, terminator);
+    LocationHelper<ExtremumLocAccumulator<COMPARE<CppType, IS_MAX, false>>,
+        CppType>(intrinsic, result, x, kind, mask, terminator);
   }
 }
 
+template <TypeCategory CAT, bool IS_MAX> struct TypedMaxOrMinLocHelper {
+  template <int KIND> struct Functor {
+    void operator()(const char *intrinsic, Descriptor &result,
+        const Descriptor &x, int kind, const char *source, int line,
+        const Descriptor *mask, bool back) const {
+      DoMaxOrMinLoc<TypeCategory::Integer, KIND, IS_MAX, NumericCompare>(
+          intrinsic, result, x, kind, source, line, mask, back);
+    }
+  };
+};
+
 template <bool IS_MAX>
 inline void TypedMaxOrMinLoc(const char *intrinsic, Descriptor &result,
     const Descriptor &x, int kind, const char *source, int line,
@@ -789,76 +830,27 @@ inline void TypedMaxOrMinLoc(const char *intrinsic, Descriptor &result,
   RUNTIME_CHECK(terminator, catKind.has_value());
   switch (catKind->first) {
   case TypeCategory::Integer:
-    switch (catKind->second) {
-    case 1:
-      DoMaxOrMinLoc<TypeCategory::Integer, 1, IS_MAX, NumericCompare>(
-          intrinsic, result, x, kind, source, line, mask, back);
-      return;
-    case 2:
-      DoMaxOrMinLoc<TypeCategory::Integer, 2, IS_MAX, NumericCompare>(
-          intrinsic, result, x, kind, source, line, mask, back);
-      return;
-    case 4:
-      DoMaxOrMinLoc<TypeCategory::Integer, 4, IS_MAX, NumericCompare>(
-          intrinsic, result, x, kind, source, line, mask, back);
-      return;
-    case 8:
-      DoMaxOrMinLoc<TypeCategory::Integer, 8, IS_MAX, NumericCompare>(
-          intrinsic, result, x, kind, source, line, mask, back);
-      return;
-#ifdef __SIZEOF_INT128__
-    case 16:
-      DoMaxOrMinLoc<TypeCategory::Integer, 16, IS_MAX, NumericCompare>(
-          intrinsic, result, x, kind, source, line, mask, back);
-      return;
-#endif
-    }
+    ApplyIntegerKind<
+        TypedMaxOrMinLocHelper<TypeCategory::Integer, IS_MAX>::template Functor,
+        void>(catKind->second, terminator, intrinsic, result, x, kind, source,
+        line, mask, back);
     break;
   case TypeCategory::Real:
-    switch (catKind->second) {
-    // TODO: REAL(2 & 3)
-    case 4:
-      DoMaxOrMinLoc<TypeCategory::Real, 4, IS_MAX, NumericCompare>(
-          intrinsic, result, x, kind, source, line, mask, back);
-      return;
-    case 8:
-      DoMaxOrMinLoc<TypeCategory::Real, 8, IS_MAX, NumericCompare>(
-          intrinsic, result, x, kind, source, line, mask, back);
-      return;
-#if LONG_DOUBLE == 80
-    case 10:
-      DoMaxOrMinLoc<TypeCategory::Real, 10, IS_MAX, NumericCompare>(
-          intrinsic, result, x, kind, source, line, mask, back);
-      return;
-#elif LONG_DOUBLE == 128
-    case 16:
-      DoMaxOrMinLoc<TypeCategory::Real, 16, IS_MAX, NumericCompare>(
-          intrinsic, result, x, kind, source, line, mask, back);
-      return;
-#endif
-    }
+    ApplyFloatingPointKind<
+        TypedMaxOrMinLocHelper<TypeCategory::Real, IS_MAX>::template Functor,
+        void>(catKind->second, terminator, intrinsic, result, x, kind, source,
+        line, mask, back);
     break;
   case TypeCategory::Character:
-    switch (catKind->second) {
-    case 1:
-      DoMaxOrMinLoc<TypeCategory::Character, 1, IS_MAX, CharacterCompare>(
-          intrinsic, result, x, kind, source, line, mask, back);
-      return;
-    case 2:
-      DoMaxOrMinLoc<TypeCategory::Character, 2, IS_MAX, CharacterCompare>(
-          intrinsic, result, x, kind, source, line, mask, back);
-      return;
-    case 4:
-      DoMaxOrMinLoc<TypeCategory::Character, 4, IS_MAX, CharacterCompare>(
-          intrinsic, result, x, kind, source, line, mask, back);
-      return;
-    }
+    ApplyCharacterKind<TypedMaxOrMinLocHelper<TypeCategory::Character,
+                           IS_MAX>::template Functor,
+        void>(catKind->second, terminator, intrinsic, result, x, kind, source,
+        line, mask, back);
     break;
   default:
-    break;
+    terminator.Crash(
+        "%s: Bad data type code (%d) for array", intrinsic, x.type().raw());
   }
-  terminator.Crash(
-      "%s: Bad data type code (%d) for array", intrinsic, x.type().raw());
 }
 
 extern "C" {
@@ -874,38 +866,28 @@ void RTNAME(Minloc)(Descriptor &result, const Descriptor &x, int kind,
 
 // MAXLOC/MINLOC with DIM=
 
+template <typename ACCUMULATOR> struct PartialLocationHelper {
+  template <int KIND> struct Functor {
+    void operator()(Descriptor &result, const Descriptor &x, int dim,
+        const Descriptor *mask, Terminator &terminator, const char *intrinsic,
+        ACCUMULATOR &accumulator) const {
+      PartialReduction<ACCUMULATOR, TypeCategory::Integer, KIND>(
+          result, x, dim, mask, terminator, intrinsic, accumulator);
+    }
+  };
+};
+
 template <TypeCategory CAT, int KIND, bool IS_MAX,
     template <typename, bool, bool> class COMPARE, bool BACK>
 static void DoPartialMaxOrMinLocDirection(const char *intrinsic,
     Descriptor &result, const Descriptor &x, int kind, int dim,
     const Descriptor *mask, Terminator &terminator) {
   using CppType = CppTypeFor<CAT, KIND>;
-  switch (kind) {
-  case 1:
-    PartialReduction<ExtremumLocAccumulator<COMPARE<CppType, IS_MAX, BACK>>,
-        TypeCategory::Integer, 1>(result, x, dim, mask, terminator, intrinsic);
-    break;
-  case 2:
-    PartialReduction<ExtremumLocAccumulator<COMPARE<CppType, IS_MAX, BACK>>,
-        TypeCategory::Integer, 2>(result, x, dim, mask, terminator, intrinsic);
-    break;
-  case 4:
-    PartialReduction<ExtremumLocAccumulator<COMPARE<CppType, IS_MAX, BACK>>,
-        TypeCategory::Integer, 4>(result, x, dim, mask, terminator, intrinsic);
-    break;
-  case 8:
-    PartialReduction<ExtremumLocAccumulator<COMPARE<CppType, IS_MAX, BACK>>,
-        TypeCategory::Integer, 8>(result, x, dim, mask, terminator, intrinsic);
-    break;
-#ifdef __SIZEOF_INT128__
-  case 16:
-    PartialReduction<ExtremumLocAccumulator<COMPARE<CppType, IS_MAX, BACK>>,
-        TypeCategory::Integer, 16>(result, x, dim, mask, terminator, intrinsic);
-    break;
-#endif
-  default:
-    terminator.Crash("%s: bad KIND=%d", intrinsic, kind);
-  }
+  using Accumulator = ExtremumLocAccumulator<COMPARE<CppType, IS_MAX, BACK>>;
+  Accumulator accumulator{x};
+  ApplyIntegerKind<PartialLocationHelper<Accumulator>::template Functor, void>(
+      kind, terminator, result, x, dim, mask, terminator, intrinsic,
+      accumulator);
 }
 
 template <TypeCategory CAT, int KIND, bool IS_MAX,
@@ -922,6 +904,19 @@ inline void DoPartialMaxOrMinLoc(const char *intrinsic, Descriptor &result,
   }
 }
 
+template <TypeCategory CAT, bool IS_MAX,
+    template <typename, bool, bool> class COMPARE>
+struct DoPartialMaxOrMinLocHelper {
+  template <int KIND> struct Functor {
+    void operator()(const char *intrinsic, Descriptor &result,
+        const Descriptor &x, int kind, int dim, const Descriptor *mask,
+        bool back, Terminator &terminator) const {
+      DoPartialMaxOrMinLoc<CAT, KIND, IS_MAX, COMPARE>(
+          intrinsic, result, x, kind, dim, mask, back, terminator);
+    }
+  };
+};
+
 template <bool IS_MAX>
 inline void TypedPartialMaxOrMinLoc(const char *intrinsic, Descriptor &result,
     const Descriptor &x, int kind, int dim, const char *source, int line,
@@ -932,79 +927,27 @@ inline void TypedPartialMaxOrMinLoc(const char *intrinsic, Descriptor &result,
   RUNTIME_CHECK(terminator, catKind.has_value());
   switch (catKind->first) {
   case TypeCategory::Integer:
-    switch (catKind->second) {
-    case 1:
-      DoPartialMaxOrMinLoc<TypeCategory::Integer, 1, IS_MAX, NumericCompare>(
-          intrinsic, result, x, kind, dim, mask, back, terminator);
-      return;
-    case 2:
-      DoPartialMaxOrMinLoc<TypeCategory::Integer, 2, IS_MAX, NumericCompare>(
-          intrinsic, result, x, kind, dim, mask, back, terminator);
-      return;
-    case 4:
-      DoPartialMaxOrMinLoc<TypeCategory::Integer, 4, IS_MAX, NumericCompare>(
-          intrinsic, result, x, kind, dim, mask, back, terminator);
-      return;
-    case 8:
-      DoPartialMaxOrMinLoc<TypeCategory::Integer, 8, IS_MAX, NumericCompare>(
-          intrinsic, result, x, kind, dim, mask, back, terminator);
-      return;
-#ifdef __SIZEOF_INT128__
-    case 16:
-      DoPartialMaxOrMinLoc<TypeCategory::Integer, 16, IS_MAX, NumericCompare>(
-          intrinsic, result, x, kind, dim, mask, back, terminator);
-      return;
-#endif
-    }
+    ApplyIntegerKind<DoPartialMaxOrMinLocHelper<TypeCategory::Integer, IS_MAX,
+                         NumericCompare>::template Functor,
+        void>(catKind->second, terminator, intrinsic, result, x, kind, dim,
+        mask, back, terminator);
     break;
   case TypeCategory::Real:
-    switch (catKind->second) {
-    // TODO: REAL(2 & 3)
-    case 4:
-      DoPartialMaxOrMinLoc<TypeCategory::Real, 4, IS_MAX, NumericCompare>(
-          intrinsic, result, x, kind, dim, mask, back, terminator);
-      return;
-    case 8:
-      DoPartialMaxOrMinLoc<TypeCategory::Real, 8, IS_MAX, NumericCompare>(
-          intrinsic, result, x, kind, dim, mask, back, terminator);
-      return;
-#if LONG_DOUBLE == 80
-    case 10:
-      DoPartialMaxOrMinLoc<TypeCategory::Real, 10, IS_MAX, NumericCompare>(
-          intrinsic, result, x, kind, dim, mask, back, terminator);
-      return;
-#elif LONG_DOUBLE == 128
-    case 16:
-      DoPartialMaxOrMinLoc<TypeCategory::Real, 16, IS_MAX, NumericCompare>(
-          intrinsic, result, x, kind, dim, mask, back, terminator);
-      return;
-#endif
-    }
+    ApplyFloatingPointKind<DoPartialMaxOrMinLocHelper<TypeCategory::Real,
+                               IS_MAX, NumericCompare>::template Functor,
+        void>(catKind->second, terminator, intrinsic, result, x, kind, dim,
+        mask, back, terminator);
     break;
   case TypeCategory::Character:
-    switch (catKind->second) {
-    case 1:
-      DoPartialMaxOrMinLoc<TypeCategory::Character, 1, IS_MAX,
-          CharacterCompare>(
-          intrinsic, result, x, kind, dim, mask, back, terminator);
-      return;
-    case 2:
-      DoPartialMaxOrMinLoc<TypeCategory::Character, 2, IS_MAX,
-          CharacterCompare>(
-          intrinsic, result, x, kind, dim, mask, back, terminator);
-      return;
-    case 4:
-      DoPartialMaxOrMinLoc<TypeCategory::Character, 4, IS_MAX,
-          CharacterCompare>(
-          intrinsic, result, x, kind, dim, mask, back, terminator);
-      return;
-    }
+    ApplyCharacterKind<DoPartialMaxOrMinLocHelper<TypeCategory::Character,
+                           IS_MAX, CharacterCompare>::template Functor,
+        void>(catKind->second, terminator, intrinsic, result, x, kind, dim,
+        mask, back, terminator);
     break;
   default:
-    break;
+    terminator.Crash(
+        "%s: Bad data type code (%d) for array", intrinsic, x.type().raw());
   }
-  terminator.Crash(
-      "%s: Bad data type code (%d) for array", intrinsic, x.type().raw());
 }
 
 extern "C" {
@@ -1020,6 +963,329 @@ void RTNAME(MinlocDim)(Descriptor &result, const Descriptor &x, int kind,
 }
 } // extern "C"
 
+// FINDLOC
+
+template <TypeCategory CAT1, int KIND1, TypeCategory CAT2, int KIND2>
+struct Equality {
+  using Type1 = CppTypeFor<CAT1, KIND1>;
+  using Type2 = CppTypeFor<CAT2, KIND2>;
+  bool operator()(const Descriptor &array, const SubscriptValue at[],
+      const Descriptor &target) const {
+    return *array.Element<Type1>(at) == *target.OffsetElement<Type2>();
+  }
+};
+
+template <int KIND1, int KIND2>
+struct Equality<TypeCategory::Complex, KIND1, TypeCategory::Complex, KIND2> {
+  using Type1 = CppTypeFor<TypeCategory::Complex, KIND1>;
+  using Type2 = CppTypeFor<TypeCategory::Complex, KIND2>;
+  bool operator()(const Descriptor &array, const SubscriptValue at[],
+      const Descriptor &target) const {
+    const Type1 &xz{*array.Element<Type1>(at)};
+    const Type2 &tz{*target.OffsetElement<Type2>()};
+    return xz.real() == tz.real() && xz.imag() == tz.imag();
+  }
+};
+
+template <int KIND1, TypeCategory CAT2, int KIND2>
+struct Equality<TypeCategory::Complex, KIND1, CAT2, KIND2> {
+  using Type1 = CppTypeFor<TypeCategory::Complex, KIND1>;
+  using Type2 = CppTypeFor<CAT2, KIND2>;
+  bool operator()(const Descriptor &array, const SubscriptValue at[],
+      const Descriptor &target) const {
+    const Type1 &z{*array.Element<Type1>(at)};
+    return z.imag() == 0 && z.real() == *target.OffsetElement<Type2>();
+  }
+};
+
+template <TypeCategory CAT1, int KIND1, int KIND2>
+struct Equality<CAT1, KIND1, TypeCategory::Complex, KIND2> {
+  using Type1 = CppTypeFor<CAT1, KIND1>;
+  using Type2 = CppTypeFor<TypeCategory::Complex, KIND2>;
+  bool operator()(const Descriptor &array, const SubscriptValue at[],
+      const Descriptor &target) const {
+    const Type2 &z{*target.OffsetElement<Type2>()};
+    return *array.Element<Type1>(at) == z.real() && z.imag() == 0;
+  }
+};
+
+template <int KIND> struct CharacterEquality {
+  using Type = CppTypeFor<TypeCategory::Character, KIND>;
+  bool operator()(const Descriptor &array, const SubscriptValue at[],
+      const Descriptor &target) const {
+    return CharacterScalarCompare<Type>(array.Element<Type>(at),
+               target.OffsetElement<Type>(),
+               array.ElementBytes() / static_cast<unsigned>(KIND),
+               target.ElementBytes() / static_cast<unsigned>(KIND)) == 0;
+  }
+};
+
+struct LogicalEquivalence {
+  bool operator()(const Descriptor &array, const SubscriptValue at[],
+      const Descriptor &target) const {
+    return IsLogicalElementTrue(array, at) ==
+        IsLogicalElementTrue(target, at /*ignored*/);
+  }
+};
+
+template <typename EQUALITY> class LocationAccumulator {
+public:
+  LocationAccumulator(
+      const Descriptor &array, const Descriptor &target, bool back)
+      : array_{array}, target_{target}, back_{back} {
+    Reinitialize();
+  }
+  void Reinitialize() {
+    // per standard: result indices are all zero if no data
+    for (int j{0}; j < rank_; ++j) {
+      location_[j] = 0;
+    }
+  }
+  template <typename A> void GetResult(A *p, int zeroBasedDim = -1) {
+    if (zeroBasedDim >= 0) {
+      *p = location_[zeroBasedDim];
+    } else {
+      for (int j{0}; j < rank_; ++j) {
+        p[j] = location_[j];
+      }
+    }
+  }
+  template <typename IGNORED> bool AccumulateAt(const SubscriptValue at[]) {
+    if (equality_(array_, at, target_)) {
+      for (int j{0}; j < rank_; ++j) {
+        location_[j] = at[j];
+      }
+      return back_;
+    } else {
+      return true;
+    }
+  }
+
+private:
+  const Descriptor &array_;
+  const Descriptor &target_;
+  const bool back_{false};
+  const int rank_{array_.rank()};
+  SubscriptValue location_[maxRank];
+  const EQUALITY equality_{};
+};
+
+template <TypeCategory XCAT, int XKIND, TypeCategory TARGET_CAT>
+struct TotalNumericFindlocHelper {
+  template <int TARGET_KIND> struct Functor {
+    void operator()(Descriptor &result, const Descriptor &x,
+        const Descriptor &target, int kind, int dim, const Descriptor *mask,
+        bool back, Terminator &terminator) const {
+      using Eq = Equality<XCAT, XKIND, TARGET_CAT, TARGET_KIND>;
+      using Accumulator = LocationAccumulator<Eq>;
+      Accumulator accumulator{x, target, back};
+      DoTotalReduction<void>(x, dim, mask, accumulator, "FINDLOC", terminator);
+      ApplyIntegerKind<LocationResultHelper<Accumulator>::template Functor,
+          void>(kind, terminator, accumulator, result);
+    }
+  };
+};
+
+template <TypeCategory CAT,
+    template <TypeCategory XCAT, int XKIND, TypeCategory TARGET_CAT>
+    class HELPER>
+struct NumericFindlocHelper {
+  template <int KIND> struct Functor {
+    void operator()(TypeCategory targetCat, int targetKind, Descriptor &result,
+        const Descriptor &x, const Descriptor &target, int kind, int dim,
+        const Descriptor *mask, bool back, Terminator &terminator) const {
+      switch (targetCat) {
+      case TypeCategory::Integer:
+        ApplyIntegerKind<
+            HELPER<CAT, KIND, TypeCategory::Integer>::template Functor, void>(
+            targetKind, terminator, result, x, target, kind, dim, mask, back,
+            terminator);
+        break;
+      case TypeCategory::Real:
+        ApplyFloatingPointKind<
+            HELPER<CAT, KIND, TypeCategory::Real>::template Functor, void>(
+            targetKind, terminator, result, x, target, kind, dim, mask, back,
+            terminator);
+        break;
+      case TypeCategory::Complex:
+        ApplyFloatingPointKind<
+            HELPER<CAT, KIND, TypeCategory::Complex>::template Functor, void>(
+            targetKind, terminator, result, x, target, kind, dim, mask, back,
+            terminator);
+        break;
+      default:
+        terminator.Crash(
+            "FINDLOC: bad target category %d for array category %d",
+            static_cast<int>(targetCat), static_cast<int>(CAT));
+      }
+    }
+  };
+};
+
+template <int KIND> struct CharacterFindlocHelper {
+  void operator()(Descriptor &result, const Descriptor &x,
+      const Descriptor &target, int kind, const Descriptor *mask, bool back,
+      Terminator &terminator) {
+    using Accumulator = LocationAccumulator<CharacterEquality<KIND>>;
+    Accumulator accumulator{x, target, back};
+    DoTotalReduction<void>(x, 0, mask, accumulator, "FINDLOC", terminator);
+    ApplyIntegerKind<LocationResultHelper<Accumulator>::template Functor, void>(
+        kind, terminator, accumulator, result);
+  }
+};
+
+static void LogicalFindlocHelper(Descriptor &result, const Descriptor &x,
+    const Descriptor &target, int kind, const Descriptor *mask, bool back,
+    Terminator &terminator) {
+  using Accumulator = LocationAccumulator<LogicalEquivalence>;
+  Accumulator accumulator{x, target, back};
+  DoTotalReduction<void>(x, 0, mask, accumulator, "FINDLOC", terminator);
+  ApplyIntegerKind<LocationResultHelper<Accumulator>::template Functor, void>(
+      kind, terminator, accumulator, result);
+}
+
+extern "C" {
+void RTNAME(Findloc)(Descriptor &result, const Descriptor &x,
+    const Descriptor &target, int kind, const char *source, int line,
+    const Descriptor *mask, bool back) {
+  int rank{x.rank()};
+  SubscriptValue extent[1]{rank};
+  result.Establish(TypeCategory::Integer, kind, nullptr, 1, extent,
+      CFI_attribute_allocatable);
+  result.GetDimension(0).SetBounds(1, extent[0]);
+  Terminator terminator{source, line};
+  if (int stat{result.Allocate()}) {
+    terminator.Crash(
+        "FINDLOC: could not allocate memory for result; STAT=%d", stat);
+  }
+  CheckIntegerKind(terminator, kind, "FINDLOC");
+  auto xType{x.type().GetCategoryAndKind()};
+  auto targetType{target.type().GetCategoryAndKind()};
+  RUNTIME_CHECK(terminator, xType.has_value() && targetType.has_value());
+  switch (xType->first) {
+  case TypeCategory::Integer:
+    ApplyIntegerKind<NumericFindlocHelper<TypeCategory::Integer,
+                         TotalNumericFindlocHelper>::template Functor,
+        void>(xType->second, terminator, targetType->first, targetType->second,
+        result, x, target, kind, 0, mask, back, terminator);
+    break;
+  case TypeCategory::Real:
+    ApplyFloatingPointKind<NumericFindlocHelper<TypeCategory::Real,
+                               TotalNumericFindlocHelper>::template Functor,
+        void>(xType->second, terminator, targetType->first, targetType->second,
+        result, x, target, kind, 0, mask, back, terminator);
+    break;
+  case TypeCategory::Complex:
+    ApplyFloatingPointKind<NumericFindlocHelper<TypeCategory::Complex,
+                               TotalNumericFindlocHelper>::template Functor,
+        void>(xType->second, terminator, targetType->first, targetType->second,
+        result, x, target, kind, 0, mask, back, terminator);
+    break;
+  case TypeCategory::Character:
+    RUNTIME_CHECK(terminator,
+        targetType->first == TypeCategory::Character &&
+            targetType->second == xType->second);
+    ApplyCharacterKind<CharacterFindlocHelper, void>(xType->second, terminator,
+        result, x, target, kind, mask, back, terminator);
+    break;
+  case TypeCategory::Logical:
+    RUNTIME_CHECK(terminator, targetType->first == TypeCategory::Logical);
+    LogicalFindlocHelper(result, x, target, kind, mask, back, terminator);
+    break;
+  default:
+    terminator.Crash(
+        "FINDLOC: Bad data type code (%d) for array", x.type().raw());
+  }
+}
+} // extern "C"
+
+// FINDLOC with DIM=
+
+template <TypeCategory XCAT, int XKIND, TypeCategory TARGET_CAT>
+struct PartialNumericFindlocHelper {
+  template <int TARGET_KIND> struct Functor {
+    void operator()(Descriptor &result, const Descriptor &x,
+        const Descriptor &target, int kind, int dim, const Descriptor *mask,
+        bool back, Terminator &terminator) const {
+      using Eq = Equality<XCAT, XKIND, TARGET_CAT, TARGET_KIND>;
+      using Accumulator = LocationAccumulator<Eq>;
+      Accumulator accumulator{x, target, back};
+      ApplyIntegerKind<PartialLocationHelper<Accumulator>::template Functor,
+          void>(kind, terminator, result, x, dim, mask, terminator, "FINDLOC",
+          accumulator);
+    }
+  };
+};
+
+template <int KIND> struct PartialCharacterFindlocHelper {
+  void operator()(Descriptor &result, const Descriptor &x,
+      const Descriptor &target, int kind, int dim, const Descriptor *mask,
+      bool back, Terminator &terminator) {
+    using Accumulator = LocationAccumulator<CharacterEquality<KIND>>;
+    Accumulator accumulator{x, target, back};
+    ApplyIntegerKind<PartialLocationHelper<Accumulator>::template Functor,
+        void>(kind, terminator, result, x, dim, mask, terminator, "FINDLOC",
+        accumulator);
+  }
+};
+
+static void PartialLogicalFindlocHelper(Descriptor &result, const Descriptor &x,
+    const Descriptor &target, int kind, int dim, const Descriptor *mask,
+    bool back, Terminator &terminator) {
+  using Accumulator = LocationAccumulator<LogicalEquivalence>;
+  Accumulator accumulator{x, target, back};
+  ApplyIntegerKind<PartialLocationHelper<Accumulator>::template Functor, void>(
+      kind, terminator, result, x, dim, mask, terminator, "FINDLOC",
+      accumulator);
+}
+
+extern "C" {
+void RTNAME(FindlocDim)(Descriptor &result, const Descriptor &x,
+    const Descriptor &target, int kind, int dim, const char *source, int line,
+    const Descriptor *mask, bool back) {
+  Terminator terminator{source, line};
+  CheckIntegerKind(terminator, kind, "FINDLOC");
+  auto xType{x.type().GetCategoryAndKind()};
+  auto targetType{target.type().GetCategoryAndKind()};
+  RUNTIME_CHECK(terminator, xType.has_value() && targetType.has_value());
+  switch (xType->first) {
+  case TypeCategory::Integer:
+    ApplyIntegerKind<NumericFindlocHelper<TypeCategory::Integer,
+                         PartialNumericFindlocHelper>::template Functor,
+        void>(xType->second, terminator, targetType->first, targetType->second,
+        result, x, target, kind, dim, mask, back, terminator);
+    break;
+  case TypeCategory::Real:
+    ApplyFloatingPointKind<NumericFindlocHelper<TypeCategory::Real,
+                               PartialNumericFindlocHelper>::template Functor,
+        void>(xType->second, terminator, targetType->first, targetType->second,
+        result, x, target, kind, dim, mask, back, terminator);
+    break;
+  case TypeCategory::Complex:
+    ApplyFloatingPointKind<NumericFindlocHelper<TypeCategory::Complex,
+                               PartialNumericFindlocHelper>::template Functor,
+        void>(xType->second, terminator, targetType->first, targetType->second,
+        result, x, target, kind, dim, mask, back, terminator);
+    break;
+  case TypeCategory::Character:
+    RUNTIME_CHECK(terminator,
+        targetType->first == TypeCategory::Character &&
+            targetType->second == xType->second);
+    ApplyCharacterKind<PartialCharacterFindlocHelper, void>(xType->second,
+        terminator, result, x, target, kind, dim, mask, back, terminator);
+    break;
+  case TypeCategory::Logical:
+    RUNTIME_CHECK(terminator, targetType->first == TypeCategory::Logical);
+    PartialLogicalFindlocHelper(
+        result, x, target, kind, dim, mask, back, terminator);
+    break;
+  default:
+    terminator.Crash(
+        "FINDLOC: Bad data type code (%d) for array", x.type().raw());
+  }
+}
+} // extern "C"
+
 // MAXVAL and MINVAL
 
 template <TypeCategory CAT, int KIND, bool IS_MAXVAL> struct MaxOrMinIdentity {
@@ -1043,7 +1309,11 @@ template <TypeCategory CAT, int KIND, bool IS_MAXVAL>
 class NumericExtremumAccumulator {
 public:
   using Type = CppTypeFor<CAT, KIND>;
-  NumericExtremumAccumulator(const Descriptor &array) : array_{array} {}
+  explicit NumericExtremumAccumulator(const Descriptor &array)
+      : array_{array} {}
+  void Reinitialize() {
+    extremum_ = MaxOrMinIdentity<CAT, KIND, IS_MAXVAL>::Value();
+  }
   template <typename A> void GetResult(A *p, int /*zeroBasedDim*/ = -1) const {
     *p = extremum_;
   }
@@ -1092,11 +1362,24 @@ static void DoMaxOrMin(Descriptor &result, const Descriptor &x, int dim,
     accumulator.GetResult(result.OffsetElement<Type>());
   } else {
     // Partial reduction
-    PartialReduction<ACCUMULATOR<CAT, KIND, IS_MAXVAL>, CAT, KIND>(
-        result, x, dim, mask, terminator, intrinsic);
+    using Accumulator = ACCUMULATOR<CAT, KIND, IS_MAXVAL>;
+    Accumulator accumulator{x};
+    PartialReduction<Accumulator, CAT, KIND>(
+        result, x, dim, mask, terminator, intrinsic, accumulator);
   }
 }
 
+template <TypeCategory CAT, bool IS_MAXVAL> struct MaxOrMinHelper {
+  template <int KIND> struct Functor {
+    void operator()(Descriptor &result, const Descriptor &x, int dim,
+        const Descriptor *mask, const char *intrinsic,
+        Terminator &terminator) const {
+      DoMaxOrMin<CAT, KIND, IS_MAXVAL, NumericExtremumAccumulator>(
+          result, x, dim, mask, intrinsic, terminator);
+    }
+  };
+};
+
 template <bool IS_MAXVAL>
 inline void NumericMaxOrMin(Descriptor &result, const Descriptor &x, int dim,
     const char *source, int line, const Descriptor *mask,
@@ -1106,72 +1389,28 @@ inline void NumericMaxOrMin(Descriptor &result, const Descriptor &x, int dim,
   RUNTIME_CHECK(terminator, type);
   switch (type->first) {
   case TypeCategory::Integer:
-    switch (type->second) {
-    case 1:
-      DoMaxOrMin<TypeCategory::Integer, 1, IS_MAXVAL,
-          NumericExtremumAccumulator>(
-          result, x, dim, mask, intrinsic, terminator);
-      return;
-    case 2:
-      DoMaxOrMin<TypeCategory::Integer, 2, IS_MAXVAL,
-          NumericExtremumAccumulator>(
-          result, x, dim, mask, intrinsic, terminator);
-      return;
-    case 4:
-      DoMaxOrMin<TypeCategory::Integer, 4, IS_MAXVAL,
-          NumericExtremumAccumulator>(
-          result, x, dim, mask, intrinsic, terminator);
-      return;
-    case 8:
-      DoMaxOrMin<TypeCategory::Integer, 8, IS_MAXVAL,
-          NumericExtremumAccumulator>(
-          result, x, dim, mask, intrinsic, terminator);
-      return;
-#ifdef __SIZEOF_INT128__
-    case 16:
-      DoMaxOrMin<TypeCategory::Integer, 16, IS_MAXVAL,
-          NumericExtremumAccumulator>(
-          result, x, dim, mask, intrinsic, terminator);
-      return;
-#endif
-    }
+    ApplyIntegerKind<
+        MaxOrMinHelper<TypeCategory::Integer, IS_MAXVAL>::template Functor,
+        void>(
+        type->second, terminator, result, x, dim, mask, intrinsic, terminator);
     break;
   case TypeCategory::Real:
-    switch (type->second) {
-    // TODO: REAL(2 & 3)
-    case 4:
-      DoMaxOrMin<TypeCategory::Real, 4, IS_MAXVAL, NumericExtremumAccumulator>(
-          result, x, dim, mask, intrinsic, terminator);
-      return;
-    case 8:
-      DoMaxOrMin<TypeCategory::Real, 8, IS_MAXVAL, NumericExtremumAccumulator>(
-          result, x, dim, mask, intrinsic, terminator);
-      return;
-#if LONG_DOUBLE == 80
-    case 10:
-      DoMaxOrMin<TypeCategory::Real, 10, IS_MAXVAL, NumericExtremumAccumulator>(
-          result, x, dim, mask, intrinsic, terminator);
-      return;
-#elif LONG_DOUBLE == 128
-    case 16:
-      DoMaxOrMin<TypeCategory::Real, 16, IS_MAXVAL, NumericExtremumAccumulator>(
-          result, x, dim, mask, intrinsic, terminator);
-      return;
-#endif
-    }
+    ApplyFloatingPointKind<
+        MaxOrMinHelper<TypeCategory::Real, IS_MAXVAL>::template Functor, void>(
+        type->second, terminator, result, x, dim, mask, intrinsic, terminator);
     break;
   default:
-    break;
+    terminator.Crash("%s: bad type code %d", intrinsic, x.type().raw());
   }
-  terminator.Crash("%s: bad type code %d", intrinsic, x.type().raw());
 }
 
 template <TypeCategory, int KIND, bool IS_MAXVAL>
 class CharacterExtremumAccumulator {
 public:
   using Type = CppTypeFor<TypeCategory::Character, KIND>;
-  CharacterExtremumAccumulator(const Descriptor &array)
+  explicit CharacterExtremumAccumulator(const Descriptor &array)
       : array_{array}, charLen_{array_.ElementBytes() / KIND} {}
+  void Reinitialize() { extremum_ = nullptr; }
   template <typename A> void GetResult(A *p, int /*zeroBasedDim*/ = -1) const {
     static_assert(std::is_same_v<A, Type>);
     if (extremum_) {
@@ -1202,6 +1441,18 @@ private:
   const Type *extremum_{nullptr};
 };
 
+template <bool IS_MAXVAL> struct CharacterMaxOrMinHelper {
+  template <int KIND> struct Functor {
+    void operator()(Descriptor &result, const Descriptor &x, int dim,
+        const Descriptor *mask, const char *intrinsic,
+        Terminator &terminator) const {
+      DoMaxOrMin<TypeCategory::Character, KIND, IS_MAXVAL,
+          CharacterExtremumAccumulator>(
+          result, x, dim, mask, intrinsic, terminator);
+    }
+  };
+};
+
 template <bool IS_MAXVAL>
 inline void CharacterMaxOrMin(Descriptor &result, const Descriptor &x, int dim,
     const char *source, int line, const Descriptor *mask,
@@ -1209,25 +1460,9 @@ inline void CharacterMaxOrMin(Descriptor &result, const Descriptor &x, int dim,
   Terminator terminator{source, line};
   auto type{x.type().GetCategoryAndKind()};
   RUNTIME_CHECK(terminator, type && type->first == TypeCategory::Character);
-  switch (type->second) {
-  case 1:
-    DoMaxOrMin<TypeCategory::Character, 1, IS_MAXVAL,
-        CharacterExtremumAccumulator>(
-        result, x, dim, mask, intrinsic, terminator);
-    break;
-  case 2:
-    DoMaxOrMin<TypeCategory::Character, 2, IS_MAXVAL,
-        CharacterExtremumAccumulator>(
-        result, x, dim, mask, intrinsic, terminator);
-    break;
-  case 4:
-    DoMaxOrMin<TypeCategory::Character, 4, IS_MAXVAL,
-        CharacterExtremumAccumulator>(
-        result, x, dim, mask, intrinsic, terminator);
-    break;
-  default:
-    terminator.Crash("%s: bad character kind %d", intrinsic, type->second);
-  }
+  ApplyCharacterKind<CharacterMaxOrMinHelper<IS_MAXVAL>::template Functor,
+      void>(
+      type->second, terminator, result, x, dim, mask, intrinsic, terminator);
 }
 
 extern "C" {
@@ -1368,20 +1603,24 @@ void RTNAME(MinvalDim)(Descriptor &result, const Descriptor &x, int dim,
 
 } // extern "C"
 
-// ALL, ANY, & COUNT
+// ALL, ANY, COUNT, & PARITY
 
-template <bool IS_ALL> class LogicalAccumulator {
+enum class LogicalReduction { All, Any, Parity };
+
+template <LogicalReduction REDUCTION> class LogicalAccumulator {
 public:
   using Type = bool;
   explicit LogicalAccumulator(const Descriptor &array) : array_{array} {}
+  void Reinitialize() { result_ = REDUCTION == LogicalReduction::All; }
   bool Result() const { return result_; }
   bool Accumulate(bool x) {
-    if (x == IS_ALL) {
-      return true;
-    } else {
+    if constexpr (REDUCTION == LogicalReduction::Parity) {
+      result_ = result_ != x;
+    } else if (x != (REDUCTION == LogicalReduction::All)) {
       result_ = x;
       return false;
     }
+    return true;
   }
   template <typename IGNORED = void>
   bool AccumulateAt(const SubscriptValue at[]) {
@@ -1390,7 +1629,7 @@ public:
 
 private:
   const Descriptor &array_;
-  bool result_{IS_ALL};
+  bool result_{REDUCTION == LogicalReduction::All};
 };
 
 template <typename ACCUMULATOR>
@@ -1428,43 +1667,33 @@ inline auto ReduceLogicalDimToScalar(const Descriptor &x, int zeroBasedDim,
   return accumulator.Result();
 }
 
-template <bool IS_ALL, int KIND>
-inline void ReduceLogicalDimension(Descriptor &result, const Descriptor &x,
-    int dim, Terminator &terminator, const char *intrinsic) {
-  // Standard requires result to have same LOGICAL kind as argument.
-  CreatePartialReductionResult(result, x, dim, terminator, intrinsic, x.type());
-  SubscriptValue at[maxRank];
-  result.GetLowerBounds(at);
-  INTERNAL_CHECK(at[0] == 1);
-  using CppType = CppTypeFor<TypeCategory::Logical, KIND>;
-  for (auto n{result.Elements()}; n-- > 0; result.IncrementSubscripts(at)) {
-    *result.Element<CppType>(at) =
-        ReduceLogicalDimToScalar<LogicalAccumulator<IS_ALL>>(x, dim - 1, at);
-  }
-}
+template <LogicalReduction REDUCTION> struct LogicalReduceHelper {
+  template <int KIND> struct Functor {
+    void operator()(Descriptor &result, const Descriptor &x, int dim,
+        Terminator &terminator, const char *intrinsic) const {
+      // Standard requires result to have same LOGICAL kind as argument.
+      CreatePartialReductionResult(
+          result, x, dim, terminator, intrinsic, x.type());
+      SubscriptValue at[maxRank];
+      result.GetLowerBounds(at);
+      INTERNAL_CHECK(at[0] == 1);
+      using CppType = CppTypeFor<TypeCategory::Logical, KIND>;
+      for (auto n{result.Elements()}; n-- > 0; result.IncrementSubscripts(at)) {
+        *result.Element<CppType>(at) =
+            ReduceLogicalDimToScalar<LogicalAccumulator<REDUCTION>>(
+                x, dim - 1, at);
+      }
+    }
+  };
+};
 
-template <bool IS_ALL>
+template <LogicalReduction REDUCTION>
 inline void DoReduceLogicalDimension(Descriptor &result, const Descriptor &x,
     int dim, Terminator &terminator, const char *intrinsic) {
   auto catKind{x.type().GetCategoryAndKind()};
   RUNTIME_CHECK(terminator, catKind && catKind->first == TypeCategory::Logical);
-  switch (catKind->second) {
-  case 1:
-    ReduceLogicalDimension<IS_ALL, 1>(result, x, dim, terminator, intrinsic);
-    break;
-  case 2:
-    ReduceLogicalDimension<IS_ALL, 2>(result, x, dim, terminator, intrinsic);
-    break;
-  case 4:
-    ReduceLogicalDimension<IS_ALL, 4>(result, x, dim, terminator, intrinsic);
-    break;
-  case 8:
-    ReduceLogicalDimension<IS_ALL, 8>(result, x, dim, terminator, intrinsic);
-    break;
-  default:
-    terminator.Crash(
-        "%s: bad argument type LOGICAL(%d)", intrinsic, catKind->second);
-  }
+  ApplyLogicalKind<LogicalReduceHelper<REDUCTION>::template Functor, void>(
+      catKind->second, terminator, result, x, dim, terminator, intrinsic);
 }
 
 // COUNT
@@ -1473,6 +1702,7 @@ class CountAccumulator {
 public:
   using Type = std::int64_t;
   explicit CountAccumulator(const Descriptor &array) : array_{array} {}
+  void Reinitialize() { result_ = 0; }
   Type Result() const { return result_; }
   template <typename IGNORED = void>
   bool AccumulateAt(const SubscriptValue at[]) {
@@ -1487,41 +1717,44 @@ private:
   Type result_{0};
 };
 
-template <int KIND>
-inline void CountDimension(
-    Descriptor &result, const Descriptor &x, int dim, Terminator &terminator) {
-  CreatePartialReductionResult(result, x, dim, terminator, "COUNT",
-      TypeCode{TypeCategory::Integer, KIND});
-  SubscriptValue at[maxRank];
-  result.GetLowerBounds(at);
-  INTERNAL_CHECK(at[0] == 1);
-  using CppType = CppTypeFor<TypeCategory::Integer, KIND>;
-  for (auto n{result.Elements()}; n-- > 0; result.IncrementSubscripts(at)) {
-    *result.Element<CppType>(at) =
-        ReduceLogicalDimToScalar<CountAccumulator>(x, dim - 1, at);
+template <int KIND> struct CountDimension {
+  void operator()(Descriptor &result, const Descriptor &x, int dim,
+      Terminator &terminator) const {
+    CreatePartialReductionResult(result, x, dim, terminator, "COUNT",
+        TypeCode{TypeCategory::Integer, KIND});
+    SubscriptValue at[maxRank];
+    result.GetLowerBounds(at);
+    INTERNAL_CHECK(at[0] == 1);
+    using CppType = CppTypeFor<TypeCategory::Integer, KIND>;
+    for (auto n{result.Elements()}; n-- > 0; result.IncrementSubscripts(at)) {
+      *result.Element<CppType>(at) =
+          ReduceLogicalDimToScalar<CountAccumulator>(x, dim - 1, at);
+    }
   }
-}
+};
 
 extern "C" {
 
 bool RTNAME(All)(const Descriptor &x, const char *source, int line, int dim) {
-  return GetTotalLogicalReduction(
-      x, source, line, dim, LogicalAccumulator<true>{x}, "ALL");
+  return GetTotalLogicalReduction(x, source, line, dim,
+      LogicalAccumulator<LogicalReduction::All>{x}, "ALL");
 }
 void RTNAME(AllDim)(Descriptor &result, const Descriptor &x, int dim,
     const char *source, int line) {
   Terminator terminator{source, line};
-  DoReduceLogicalDimension<true>(result, x, dim, terminator, "ALL");
+  DoReduceLogicalDimension<LogicalReduction::All>(
+      result, x, dim, terminator, "ALL");
 }
 
 bool RTNAME(Any)(const Descriptor &x, const char *source, int line, int dim) {
-  return GetTotalLogicalReduction(
-      x, source, line, dim, LogicalAccumulator<false>{x}, "ANY");
+  return GetTotalLogicalReduction(x, source, line, dim,
+      LogicalAccumulator<LogicalReduction::Any>{x}, "ANY");
 }
 void RTNAME(AnyDim)(Descriptor &result, const Descriptor &x, int dim,
     const char *source, int line) {
   Terminator terminator{source, line};
-  DoReduceLogicalDimension<false>(result, x, dim, terminator, "ANY");
+  DoReduceLogicalDimension<LogicalReduction::Any>(
+      result, x, dim, terminator, "ANY");
 }
 
 std::int64_t RTNAME(Count)(
@@ -1529,30 +1762,24 @@ std::int64_t RTNAME(Count)(
   return GetTotalLogicalReduction(
       x, source, line, dim, CountAccumulator{x}, "COUNT");
 }
+
 void RTNAME(CountDim)(Descriptor &result, const Descriptor &x, int dim,
     int kind, const char *source, int line) {
   Terminator terminator{source, line};
-  switch (kind) {
-  case 1:
-    CountDimension<1>(result, x, dim, terminator);
-    break;
-  case 2:
-    CountDimension<2>(result, x, dim, terminator);
-    break;
-  case 4:
-    CountDimension<4>(result, x, dim, terminator);
-    break;
-  case 8:
-    CountDimension<8>(result, x, dim, terminator);
-    break;
-#ifdef __SIZEOF_INT128__
-  case 16:
-    CountDimension<16>(result, x, dim, terminator);
-    break;
-#endif
-  default:
-    terminator.Crash("COUNT: bad KIND=%d", kind);
-  }
+  ApplyIntegerKind<CountDimension, void>(
+      kind, terminator, result, x, dim, terminator);
+}
+
+bool RTNAME(Parity)(
+    const Descriptor &x, const char *source, int line, int dim) {
+  return GetTotalLogicalReduction(x, source, line, dim,
+      LogicalAccumulator<LogicalReduction::Parity>{x}, "PARITY");
+}
+void RTNAME(ParityDim)(Descriptor &result, const Descriptor &x, int dim,
+    const char *source, int line) {
+  Terminator terminator{source, line};
+  DoReduceLogicalDimension<LogicalReduction::Parity>(
+      result, x, dim, terminator, "PARITY");
 }
 
 } // extern "C"
diff --git a/flang/runtime/reduction.h b/flang/runtime/reduction.h
index ea9e93a..39604b8 100644
--- a/flang/runtime/reduction.h
+++ b/flang/runtime/reduction.h
@@ -24,8 +24,8 @@ namespace Fortran::runtime {
 extern "C" {
 
 // Reductions that are known to return scalars have per-type entry
-// points.  These cover the casse that either have no DIM=
-// argument, or have an argument rank of 1.  Pass 0 for no DIM=
+// points.  These cover the cases that either have no DIM=
+// argument or have an argument rank of 1.  Pass 0 for no DIM=
 // or the value of the DIM= argument so that it may be checked.
 // The data type in the descriptor is checked against the expected
 // return type.
@@ -144,20 +144,42 @@ void RTNAME(CppProductComplex16)(std::complex<long double> &,
 void RTNAME(ProductDim)(Descriptor &result, const Descriptor &array, int dim,
     const char *source, int line, const Descriptor *mask = nullptr);
 
-// MAXLOC and MINLOC
+// IPARITY()
+std::int8_t RTNAME(IParity1)(const Descriptor &, const char *source, int line,
+    int dim = 0, const Descriptor *mask = nullptr);
+std::int16_t RTNAME(IParity2)(const Descriptor &, const char *source, int line,
+    int dim = 0, const Descriptor *mask = nullptr);
+std::int32_t RTNAME(IParity4)(const Descriptor &, const char *source, int line,
+    int dim = 0, const Descriptor *mask = nullptr);
+std::int64_t RTNAME(IParity8)(const Descriptor &, const char *source, int line,
+    int dim = 0, const Descriptor *mask = nullptr);
+#ifdef __SIZEOF_INT128__
+common::int128_t RTNAME(IParity16)(const Descriptor &, const char *source,
+    int line, int dim = 0, const Descriptor *mask = nullptr);
+#endif
+void RTNAME(IParityDim)(Descriptor &result, const Descriptor &array, int dim,
+    const char *source, int line, const Descriptor *mask = nullptr);
+
+// FINDLOC, MAXLOC, & MINLOC
 // These return allocated arrays in the supplied descriptor.
 // The default value for KIND= should be the default INTEGER in effect at
 // compilation time.
-void RTNAME(Maxloc)(Descriptor &, const Descriptor &, int kind,
+void RTNAME(Findloc)(Descriptor &, const Descriptor &x,
+    const Descriptor &target, int kind, const char *source, int line,
+    const Descriptor *mask = nullptr, bool back = false);
+void RTNAME(FindlocDim)(Descriptor &, const Descriptor &x,
+    const Descriptor &target, int kind, int dim, const char *source, int line,
+    const Descriptor *mask = nullptr, bool back = false);
+void RTNAME(Maxloc)(Descriptor &, const Descriptor &x, int kind,
     const char *source, int line, const Descriptor *mask = nullptr,
     bool back = false);
-void RTNAME(MaxlocDim)(Descriptor &, const Descriptor &, int kind, int dim,
+void RTNAME(MaxlocDim)(Descriptor &, const Descriptor &x, int kind, int dim,
     const char *source, int line, const Descriptor *mask = nullptr,
     bool back = false);
-void RTNAME(Minloc)(Descriptor &, const Descriptor &, int kind,
+void RTNAME(Minloc)(Descriptor &, const Descriptor &x, int kind,
     const char *source, int line, const Descriptor *mask = nullptr,
     bool back = false);
-void RTNAME(MinlocDim)(Descriptor &, const Descriptor &, int kind, int dim,
+void RTNAME(MinlocDim)(Descriptor &, const Descriptor &x, int kind, int dim,
     const char *source, int line, const Descriptor *mask = nullptr,
     bool back = false);
 
@@ -221,7 +243,7 @@ void RTNAME(MaxvalDim)(Descriptor &, const Descriptor &, int dim,
 void RTNAME(MinvalDim)(Descriptor &, const Descriptor &, int dim,
     const char *source, int line, const Descriptor *mask = nullptr);
 
-// ALL, ANY, & COUNT logical reductions
+// ALL, ANY, COUNT, & PARITY logical reductions
 bool RTNAME(All)(const Descriptor &, const char *source, int line, int dim = 0);
 void RTNAME(AllDim)(Descriptor &result, const Descriptor &, int dim,
     const char *source, int line);
@@ -232,6 +254,10 @@ std::int64_t RTNAME(Count)(
     const Descriptor &, const char *source, int line, int dim = 0);
 void RTNAME(CountDim)(Descriptor &result, const Descriptor &, int dim, int kind,
     const char *source, int line);
+bool RTNAME(Parity)(
+    const Descriptor &, const char *source, int line, int dim = 0);
+void RTNAME(ParityDim)(Descriptor &result, const Descriptor &, int dim,
+    const char *source, int line);
 
 } // extern "C"
 } // namespace Fortran::runtime
diff --git a/flang/runtime/terminator.h b/flang/runtime/terminator.h
index c63f895..02d97be 100644
--- a/flang/runtime/terminator.h
+++ b/flang/runtime/terminator.h
@@ -24,6 +24,10 @@ public:
   Terminator(const Terminator &) = default;
   explicit Terminator(const char *sourceFileName, int sourceLine = 0)
       : sourceFileName_{sourceFileName}, sourceLine_{sourceLine} {}
+
+  const char *sourceFileName() const { return sourceFileName_; }
+  int sourceLine() const { return sourceLine_; }
+
   void SetLocation(const char *sourceFileName = nullptr, int sourceLine = 0) {
     sourceFileName_ = sourceFileName;
     sourceLine_ = sourceLine;
diff --git a/flang/runtime/tools.h b/flang/runtime/tools.h
index 1b988d9..c5996dc 100644
--- a/flang/runtime/tools.h
+++ b/flang/runtime/tools.h
@@ -13,6 +13,7 @@
 #include "descriptor.h"
 #include "memory.h"
 #include "terminator.h"
+#include "flang/Common/long-double.h"
 #include <functional>
 #include <map>
 #include <type_traits>
@@ -101,5 +102,83 @@ inline bool SetInteger(INT &x, int kind, std::int64_t value) {
   }
 }
 
+// Maps a runtime INTEGER kind value to the appropriate instantiation of
+// a function object template and calls it with the supplied arguments.
+template <template <int KIND> class FUNC, typename RESULT, typename... A>
+inline RESULT ApplyIntegerKind(int kind, Terminator &terminator, A &&...x) {
+  switch (kind) {
+  case 1:
+    return FUNC<1>{}(std::forward<A>(x)...);
+  case 2:
+    return FUNC<2>{}(std::forward<A>(x)...);
+  case 4:
+    return FUNC<4>{}(std::forward<A>(x)...);
+  case 8:
+    return FUNC<8>{}(std::forward<A>(x)...);
+#ifdef __SIZEOF_INT128__
+  case 16:
+    return FUNC<16>{}(std::forward<A>(x)...);
+#endif
+  default:
+    terminator.Crash("unsupported INTEGER(KIND=%d)", kind);
+  }
+}
+
+template <template <int KIND> class FUNC, typename RESULT, typename... A>
+inline RESULT ApplyFloatingPointKind(
+    int kind, Terminator &terminator, A &&...x) {
+  switch (kind) {
+#if 0 // TODO: REAL/COMPLEX (2 & 3)
+  case 2:
+    return FUNC<2>{}(std::forward<A>(x)...);
+  case 3:
+    return FUNC<3>{}(std::forward<A>(x)...);
+#endif
+  case 4:
+    return FUNC<4>{}(std::forward<A>(x)...);
+  case 8:
+    return FUNC<8>{}(std::forward<A>(x)...);
+#if LONG_DOUBLE == 80
+  case 10:
+    return FUNC<10>{}(std::forward<A>(x)...);
+#elif LONG_DOUBLE == 128
+  case 16:
+    return FUNC<16>{}(std::forward<A>(x)...);
+#endif
+  default:
+    terminator.Crash("unsupported REAL/COMPLEX(KIND=%d)", kind);
+  }
+}
+
+template <template <int KIND> class FUNC, typename RESULT, typename... A>
+inline RESULT ApplyCharacterKind(int kind, Terminator &terminator, A &&...x) {
+  switch (kind) {
+  case 1:
+    return FUNC<1>{}(std::forward<A>(x)...);
+  case 2:
+    return FUNC<2>{}(std::forward<A>(x)...);
+  case 4:
+    return FUNC<4>{}(std::forward<A>(x)...);
+  default:
+    terminator.Crash("unsupported CHARACTER(KIND=%d)", kind);
+  }
+}
+
+template <template <int KIND> class FUNC, typename RESULT, typename... A>
+inline RESULT ApplyLogicalKind(int kind, Terminator &terminator, A &&...x) {
+  switch (kind) {
+  case 1:
+    return FUNC<1>{}(std::forward<A>(x)...);
+  case 2:
+    return FUNC<2>{}(std::forward<A>(x)...);
+  case 4:
+    return FUNC<4>{}(std::forward<A>(x)...);
+  case 8:
+    return FUNC<8>{}(std::forward<A>(x)...);
+  default:
+    terminator.Crash("unsupported LOGICAL(KIND=%d)", kind);
+  }
+}
+
 } // namespace Fortran::runtime
 #endif // FORTRAN_RUNTIME_TOOLS_H_
diff --git a/flang/unittests/RuntimeGTest/Reduction.cpp b/flang/unittests/RuntimeGTest/Reduction.cpp
index 111b567..181f44d 100644
--- a/flang/unittests/RuntimeGTest/Reduction.cpp
+++ b/flang/unittests/RuntimeGTest/Reduction.cpp
@@ -138,8 +138,8 @@ TEST(Reductions, Character) {
   std::vector<int> shape{2, 3};
   auto array{MakeArray<TypeCategory::Character, 1>(shape,
       std::vector<std::string>{"abc", "def", "ghi", "jkl", "mno", "abc"}, 3)};
-  StaticDescriptor<1> statDesc;
-  Descriptor &res{statDesc.descriptor()};
+  StaticDescriptor<1> statDesc[2];
+  Descriptor &res{statDesc[0].descriptor()};
   RTNAME(MaxvalCharacter)(res, *array, __FILE__, __LINE__);
   EXPECT_EQ(res.rank(), 0);
   EXPECT_EQ(res.type().raw(), (TypeCode{TypeCategory::Character, 1}.raw()));
@@ -202,6 +202,30 @@ TEST(Reductions, Character) {
   EXPECT_EQ(*res.ZeroBasedIndexedElement<std::int32_t>(0), 2);
   EXPECT_EQ(*res.ZeroBasedIndexedElement<std::int32_t>(1), 3);
   res.Destroy();
+  static const char targetChar[]{"abc"};
+  Descriptor &target{statDesc[1].descriptor()};
+  target.Establish(1, std::strlen(targetChar),
+      const_cast<void *>(static_cast<const void *>(&targetChar)), 0, nullptr,
+      CFI_attribute_pointer);
+  RTNAME(Findloc)
+  (res, *array, target, /*KIND=*/4, __FILE__, __LINE__, nullptr,
+      /*BACK=*/false);
+  EXPECT_EQ(res.rank(), 1);
+  EXPECT_EQ(res.type().raw(), (TypeCode{TypeCategory::Integer, 4}.raw()));
+  EXPECT_EQ(res.GetDimension(0).LowerBound(), 1);
+  EXPECT_EQ(res.GetDimension(0).Extent(), 2);
+  EXPECT_EQ(*res.ZeroBasedIndexedElement<std::int32_t>(0), 1);
+  EXPECT_EQ(*res.ZeroBasedIndexedElement<std::int32_t>(1), 1);
+  res.Destroy();
+  RTNAME(Findloc)
+  (res, *array, target, /*KIND=*/4, __FILE__, __LINE__, nullptr, /*BACK=*/true);
+  EXPECT_EQ(res.rank(), 1);
+  EXPECT_EQ(res.type().raw(), (TypeCode{TypeCategory::Integer, 4}.raw()));
+  EXPECT_EQ(res.GetDimension(0).LowerBound(), 1);
+  EXPECT_EQ(res.GetDimension(0).Extent(), 2);
+  EXPECT_EQ(*res.ZeroBasedIndexedElement<std::int32_t>(0), 2);
+  EXPECT_EQ(*res.ZeroBasedIndexedElement<std::int32_t>(1), 3);
+  res.Destroy();
 }
 
 TEST(Reductions, Logical) {
@@ -211,9 +235,10 @@ TEST(Reductions, Logical) {
   ASSERT_EQ(array->ElementBytes(), std::size_t{4});
   EXPECT_EQ(RTNAME(All)(*array, __FILE__, __LINE__), false);
   EXPECT_EQ(RTNAME(Any)(*array, __FILE__, __LINE__), true);
+  EXPECT_EQ(RTNAME(Parity)(*array, __FILE__, __LINE__), false);
   EXPECT_EQ(RTNAME(Count)(*array, __FILE__, __LINE__), 2);
-  StaticDescriptor<2> statDesc;
-  Descriptor &res{statDesc.descriptor()};
+  StaticDescriptor<2> statDesc[2];
+  Descriptor &res{statDesc[0].descriptor()};
   RTNAME(AllDim)(res, *array, /*DIM=*/1, __FILE__, __LINE__);
   EXPECT_EQ(res.rank(), 1);
   EXPECT_EQ(res.type().raw(), (TypeCode{TypeCategory::Logical, 4}.raw()));
@@ -246,6 +271,22 @@ TEST(Reductions, Logical) {
   EXPECT_EQ(*res.ZeroBasedIndexedElement<std::int32_t>(0), 1);
   EXPECT_EQ(*res.ZeroBasedIndexedElement<std::int32_t>(1), 1);
   res.Destroy();
+  RTNAME(ParityDim)(res, *array, /*DIM=*/1, __FILE__, __LINE__);
+  EXPECT_EQ(res.rank(), 1);
+  EXPECT_EQ(res.type().raw(), (TypeCode{TypeCategory::Logical, 4}.raw()));
+  EXPECT_EQ(res.GetDimension(0).LowerBound(), 1);
+  EXPECT_EQ(res.GetDimension(0).Extent(), 2);
+  EXPECT_EQ(*res.ZeroBasedIndexedElement<std::int32_t>(0), 0);
+  EXPECT_EQ(*res.ZeroBasedIndexedElement<std::int32_t>(1), 0);
+  res.Destroy();
+  RTNAME(ParityDim)(res, *array, /*DIM=*/2, __FILE__, __LINE__);
+  EXPECT_EQ(res.rank(), 1);
+  EXPECT_EQ(res.type().raw(), (TypeCode{TypeCategory::Logical, 4}.raw()));
+  EXPECT_EQ(res.GetDimension(0).LowerBound(), 1);
+  EXPECT_EQ(res.GetDimension(0).Extent(), 2);
+  EXPECT_EQ(*res.ZeroBasedIndexedElement<std::int32_t>(0), 1);
+  EXPECT_EQ(*res.ZeroBasedIndexedElement<std::int32_t>(1), 1);
+  res.Destroy();
   RTNAME(CountDim)(res, *array, /*DIM=*/1, /*KIND=*/4, __FILE__, __LINE__);
   EXPECT_EQ(res.rank(), 1);
   EXPECT_EQ(res.type().raw(), (TypeCode{TypeCategory::Integer, 4}.raw()));
@@ -262,4 +303,123 @@ TEST(Reductions, Logical) {
   EXPECT_EQ(*res.ZeroBasedIndexedElement<std::int64_t>(0), 1);
   EXPECT_EQ(*res.ZeroBasedIndexedElement<std::int64_t>(1), 1);
   res.Destroy();
+  bool boolValue{false};
+  Descriptor &target{statDesc[1].descriptor()};
+  target.Establish(TypeCategory::Logical, 1, static_cast<void *>(&boolValue), 0,
+      nullptr, CFI_attribute_pointer);
+  RTNAME(Findloc)
+  (res, *array, target, /*KIND=*/4, __FILE__, __LINE__, nullptr,
+      /*BACK=*/false);
+  EXPECT_EQ(res.rank(), 1);
+  EXPECT_EQ(res.type().raw(), (TypeCode{TypeCategory::Integer, 4}.raw()));
+  EXPECT_EQ(res.GetDimension(0).LowerBound(), 1);
+  EXPECT_EQ(res.GetDimension(0).Extent(), 2);
+  EXPECT_EQ(*res.ZeroBasedIndexedElement<std::int32_t>(0), 1);
+  EXPECT_EQ(*res.ZeroBasedIndexedElement<std::int32_t>(1), 1);
+  res.Destroy();
+  boolValue = true;
+  RTNAME(Findloc)
+  (res, *array, target, /*KIND=*/4, __FILE__, __LINE__, nullptr, /*BACK=*/true);
+  EXPECT_EQ(res.rank(), 1);
+  EXPECT_EQ(res.type().raw(), (TypeCode{TypeCategory::Integer, 4}.raw()));
+  EXPECT_EQ(res.GetDimension(0).LowerBound(), 1);
+  EXPECT_EQ(res.GetDimension(0).Extent(), 2);
+  EXPECT_EQ(*res.ZeroBasedIndexedElement<std::int32_t>(0), 2);
+  EXPECT_EQ(*res.ZeroBasedIndexedElement<std::int32_t>(1), 2);
+  res.Destroy();
+}
+
+TEST(Reductions, FindlocNumeric) {
+  std::vector<int> shape{2, 3};
+  auto realArray{MakeArray<TypeCategory::Real, 8>(shape,
+      std::vector<double>{0.0, -0.0, 1.0, 3.14,
+          std::numeric_limits<double>::quiet_NaN(),
+          std::numeric_limits<double>::infinity()})};
+  ASSERT_EQ(realArray->ElementBytes(), sizeof(double));
+  StaticDescriptor<2> statDesc[2];
+  Descriptor &res{statDesc[0].descriptor()};
+  // Find the first zero
+  Descriptor &target{statDesc[1].descriptor()};
+  double value{0.0};
+  target.Establish(TypeCategory::Real, 8, static_cast<void *>(&value), 0,
+      nullptr, CFI_attribute_pointer);
+  RTNAME(Findloc)
+  (res, *realArray, target, 8, __FILE__, __LINE__, nullptr, /*BACK=*/false);
+  EXPECT_EQ(res.rank(), 1);
+  EXPECT_EQ(res.type().raw(), (TypeCode{TypeCategory::Integer, 8}.raw()));
+  EXPECT_EQ(res.GetDimension(0).LowerBound(), 1);
+  EXPECT_EQ(res.GetDimension(0).UpperBound(), 2);
+  EXPECT_EQ(*res.ZeroBasedIndexedElement<SubscriptValue>(0), 1);
+  EXPECT_EQ(*res.ZeroBasedIndexedElement<SubscriptValue>(1), 1);
+  res.Destroy();
+  // Find last zero (even though it's negative)
+  RTNAME(Findloc)
+  (res, *realArray, target, 8, __FILE__, __LINE__, nullptr, /*BACK=*/true);
+  EXPECT_EQ(res.rank(), 1);
+  EXPECT_EQ(res.type().raw(), (TypeCode{TypeCategory::Integer, 8}.raw()));
+  EXPECT_EQ(res.GetDimension(0).LowerBound(), 1);
+  EXPECT_EQ(res.GetDimension(0).UpperBound(), 2);
+  EXPECT_EQ(*res.ZeroBasedIndexedElement<SubscriptValue>(0), 2);
+  EXPECT_EQ(*res.ZeroBasedIndexedElement<SubscriptValue>(1), 1);
+  res.Destroy();
+  // Find the +Inf
+  value = std::numeric_limits<double>::infinity();
+  RTNAME(Findloc)
+  (res, *realArray, target, 8, __FILE__, __LINE__, nullptr, /*BACK=*/false);
+  EXPECT_EQ(res.rank(), 1);
+  EXPECT_EQ(res.type().raw(), (TypeCode{TypeCategory::Integer, 8}.raw()));
+  EXPECT_EQ(res.GetDimension(0).LowerBound(), 1);
+  EXPECT_EQ(res.GetDimension(0).UpperBound(), 2);
+  EXPECT_EQ(*res.ZeroBasedIndexedElement<SubscriptValue>(0), 2);
+  EXPECT_EQ(*res.ZeroBasedIndexedElement<SubscriptValue>(1), 3);
+  res.Destroy();
+  // Ensure that we can't find a NaN
+  value = std::numeric_limits<double>::quiet_NaN();
+  RTNAME(Findloc)
+  (res, *realArray, target, 8, __FILE__, __LINE__, nullptr, /*BACK=*/false);
+  EXPECT_EQ(res.rank(), 1);
+  EXPECT_EQ(res.type().raw(), (TypeCode{TypeCategory::Integer, 8}.raw()));
+  EXPECT_EQ(res.GetDimension(0).LowerBound(), 1);
+  EXPECT_EQ(res.GetDimension(0).UpperBound(), 2);
+  EXPECT_EQ(*res.ZeroBasedIndexedElement<SubscriptValue>(0), 0);
+  EXPECT_EQ(*res.ZeroBasedIndexedElement<SubscriptValue>(1), 0);
+  res.Destroy();
+  // Find a value of a distinct type
+  int intValue{1};
+  target.Establish(TypeCategory::Integer, 4, static_cast<void *>(&intValue), 0,
+      nullptr, CFI_attribute_pointer);
+  RTNAME(Findloc)
+  (res, *realArray, target, 8, __FILE__, __LINE__, nullptr, /*BACK=*/false);
+  EXPECT_EQ(res.rank(), 1);
+  EXPECT_EQ(res.type().raw(), (TypeCode{TypeCategory::Integer, 8}.raw()));
+  EXPECT_EQ(res.GetDimension(0).LowerBound(), 1);
+  EXPECT_EQ(res.GetDimension(0).UpperBound(), 2);
+  EXPECT_EQ(*res.ZeroBasedIndexedElement<SubscriptValue>(0), 1);
+  EXPECT_EQ(*res.ZeroBasedIndexedElement<SubscriptValue>(1), 2);
+  res.Destroy();
+  // Partial reductions
+  value = 1.0;
+  target.Establish(TypeCategory::Real, 8, static_cast<void *>(&value), 0,
+      nullptr, CFI_attribute_pointer);
+  RTNAME(FindlocDim)
+  (res, *realArray, target, 8, /*DIM=*/1, __FILE__, __LINE__, nullptr,
+      /*BACK=*/false);
+  EXPECT_EQ(res.rank(), 1);
+  EXPECT_EQ(res.type().raw(), (TypeCode{TypeCategory::Integer, 8}.raw()));
+  EXPECT_EQ(res.GetDimension(0).LowerBound(), 1);
+  EXPECT_EQ(res.GetDimension(0).UpperBound(), 3);
+  EXPECT_EQ(*res.ZeroBasedIndexedElement<SubscriptValue>(0), 0);
+  EXPECT_EQ(*res.ZeroBasedIndexedElement<SubscriptValue>(1), 1);
+  EXPECT_EQ(*res.ZeroBasedIndexedElement<SubscriptValue>(2), 0);
+  res.Destroy();
+  RTNAME(FindlocDim)
+  (res, *realArray, target, 8, /*DIM=*/2, __FILE__, __LINE__, nullptr,
+      /*BACK=*/true);
+  EXPECT_EQ(res.rank(), 1);
+  EXPECT_EQ(res.type().raw(), (TypeCode{TypeCategory::Integer, 8}.raw()));
+  EXPECT_EQ(res.GetDimension(0).LowerBound(), 1);
+  EXPECT_EQ(res.GetDimension(0).UpperBound(), 2);
+  EXPECT_EQ(*res.ZeroBasedIndexedElement<SubscriptValue>(0), 2);
+  EXPECT_EQ(*res.ZeroBasedIndexedElement<SubscriptValue>(1), 0);
+  res.Destroy();
 }
-- 
2.7.4