[flang] Implement IPARITY, PARITY, and FINDLOC reductions

[klausler]

Summary

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

[PeteSteinfeld]

Other than the typo in .../runtime/reduction.h, all builds, tests, and looks good.

flang/runtime/reduction.h

147

While looking at this file, I noticed a typo on line 27. "casse" should be "cases". Since you're updating this file, now is a good time to fix it.

[klausler]

You bet, will fix that comment before pushing. Thanks!

flang/runtime/reduction.h

 #include "flang/Common/uint128.h"
 #include <complex>
 #include <cstdint>
 
 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.
 //
 // Reductions that return arrays are the remaining cases in which
 // the argument rank is greater than one and there is a DIM=
 // argument present.  These cases establish and allocate their
 // results in a caller-supplied descriptor, which is assumed to
void RTNAME(CppProductComplex10)(std::complex<long double> &,
     const Descriptor *mask = nullptr);
 void RTNAME(CppProductComplex16)(std::complex<long double> &,
     const Descriptor &, const char *source, int line, int dim = 0,
     const Descriptor *mask = nullptr);
 
 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);
 
 // MAXVAL and MINVAL
 std::int8_t RTNAME(MaxvalInteger1)(const Descriptor &, const char *source,
     int line, int dim = 0, const Descriptor *mask = nullptr);
 std::int16_t RTNAME(MaxvalInteger2)(const Descriptor &, const char *source,
     int line, int dim = 0, const Descriptor *mask = nullptr);

 void RTNAME(MinvalCharacter)(Descriptor &, const Descriptor &,
     const char *source, int line, const Descriptor *mask = nullptr);
 
 void RTNAME(MaxvalDim)(Descriptor &, const Descriptor &, int dim,
     const char *source, int line, const Descriptor *mask = nullptr);
 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);
 bool RTNAME(Any)(const Descriptor &, const char *source, int line, int dim = 0);
 void RTNAME(AnyDim)(Descriptor &result, const Descriptor &, int dim,
     const char *source, int line);
 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
 #endif // FORTRAN_RUNTIME_REDUCTION_H_

flang/runtime/reduction.cpp

 //===-- runtime/reduction.cpp ---------------------------------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
-// 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
 //   for positive and negative elements independently.
 // * 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
 //   length results, dynamically allocated in a caller-supplied descriptor
 
 #include "reduction.h"
 #include "character.h"
 #include "cpp-type.h"

 // classes that incrementally build up the result (or an element thereof) during
 // a traversal of the unmasked elements of an array.  Each accumulator class
 // supports a constructor (which captures a reference to the array), an
 // AccumulateAt() member function that applies supplied subscripts to the
 // array and does something with a scalar element, and a GetResult()
 // 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,
     Terminator &terminator) {
   if (dim < 0 || dim > 1) {
     terminator.Crash(
         "%s: bad DIM=%d for argument with rank %d", intrinsic, dim, x.rank());
   }
inline void GetExpandedSubscripts(SubscriptValue at[],
   }
   for (++j; j < rank; ++j) {
     at[j] += from[j - 1] - 1;
   }
 }
 
 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)};
   SubscriptValue at{dim.LowerBound()};
   for (auto n{dim.Extent()}; n-- > 0; ++at) {
     xAt[zeroBasedDim] = at;
     if (!accumulator.template AccumulateAt<TYPE>(xAt)) {
       break;
     }
   }
 #ifdef _MSC_VER // work around MSVC spurious error
   accumulator.GetResult(result, zeroBasedDim);
 #else
   accumulator.template GetResult(result, zeroBasedDim);
 #endif
 }
 
 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);
   const auto &xDim{x.GetDimension(zeroBasedDim)};
   SubscriptValue xPos{xDim.LowerBound()};
   const auto &maskDim{mask.GetDimension(zeroBasedDim)};
   SubscriptValue maskPos{maskDim.LowerBound()};
   for (auto n{x.GetDimension(zeroBasedDim).Extent()}; n-- > 0;
terminator.Crash(
         "%s: could not allocate memory for result; STAT=%d", intrinsic, stat);
   }
 }
 
 // Partial reductions with DIM=
 
 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];
   result.GetLowerBounds(at);
   INTERNAL_CHECK(at[0] == 1);
   using CppType = CppTypeFor<CAT, KIND>;
   if (mask) {
     CheckConformability(x, *mask, terminator, intrinsic, "ARRAY", "MASK");
     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));
       }
       return;
     }
   }
   // 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>
 inline void TypedPartialNumericReduction(Descriptor &result,
     const Descriptor &x, int dim, const char *source, int line,
     const Descriptor *mask, const char *intrinsic) {
   Terminator terminator{source, line};
   auto catKind{x.type().GetCategoryAndKind()};
   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());
   }
+}
 
 // SUM()
 
 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_);
   }
   template <typename A> bool AccumulateAt(const SubscriptValue at[]) {
     sum_ += *array_.Element<A>(at);
     return true;
   }
 
 private:
   const Descriptor &array_;
   INTERMEDIATE sum_{0};
 };
 
 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_);
   }
   template <typename A> void GetResult(A *p, int /*zeroBasedDim*/ = -1) const {
     *p = Result<A>();
   }
   template <typename A> bool Accumulate(A x) {

 private:
   const Descriptor &array_;
   INTERMEDIATE positives_{0.0}, negatives_{0.0}, inOrder_{0.0};
 };
 
 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>(),
         imaginaries_.template Result<ResultPart>()};
   }
   template <typename A> bool Accumulate(const A &z) {
     reals_.Accumulate(z.real());
     imaginaries_.Accumulate(z.imag());

 } // extern "C"
 
 // PRODUCT()
 
 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_);
   }
   template <typename A> bool AccumulateAt(const SubscriptValue at[]) {
     product_ *= *array_.Element<A>(at);
     return product_ != 0;
   }
 
 private:
   const Descriptor &array_;
   INTERMEDIATE product_{1};
 };
 
 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()),
         static_cast<ResultPart>(product_.imag())};
   }
   template <typename A> bool AccumulateAt(const SubscriptValue at[]) {
     product_ *= *array_.Element<A>(at);
     return true;

 void RTNAME(ProductDim)(Descriptor &result, const Descriptor &x, int dim,
     const char *source, int line, const Descriptor *mask) {
   TypedPartialNumericReduction<NonComplexProductAccumulator,
       NonComplexProductAccumulator, ComplexProductAccumulator>(
       result, x, dim, source, line, mask, "PRODUCT");
 }
 } // 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 {
       return value < previous;
     }
   }
 };
 
 template <typename T, bool IS_MAX, bool BACK> class CharacterCompare {
 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 {
       return cmp < 0;
     }
   }
 
 private:
   std::size_t chars_;
 };
 
 template <typename COMPARE> class ExtremumLocAccumulator {
 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) {
     if (zeroBasedDim >= 0) {
       *p = extremumLoc_[zeroBasedDim];
     } else {
       for (int j{0}; j < argRank_; ++j) {
         p[j] = extremumLoc_[j];

 private:
   const Descriptor &array_;
   int argRank_;
   SubscriptValue extremumLoc_[maxRank];
   const Type *previous_{nullptr};
   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,
     template <typename, bool, bool> class COMPARE>
 inline void DoMaxOrMinLoc(const char *intrinsic, Descriptor &result,
     const Descriptor &x, int kind, const char *source, int line,
     const Descriptor *mask, bool back) {
   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,
     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(
         "%s: could not allocate memory for result; STAT=%d", intrinsic, stat);
   }
   CheckIntegerKind(terminator, kind, intrinsic);
   auto catKind{x.type().GetCategoryAndKind()};
   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());
   }
+}
 
 extern "C" {
 void RTNAME(Maxloc)(Descriptor &result, const Descriptor &x, int kind,
     const char *source, int line, const Descriptor *mask, bool back) {
   TypedMaxOrMinLoc<true>("MAXLOC", result, x, kind, source, line, mask, back);
 }
 void RTNAME(Minloc)(Descriptor &result, const Descriptor &x, int kind,
     const char *source, int line, const Descriptor *mask, bool back) {
   TypedMaxOrMinLoc<false>("MINLOC", result, x, kind, source, line, mask, back);
 }
 } // extern "C"
 
 // 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,
     template <typename, bool, bool> class COMPARE>
 inline void DoPartialMaxOrMinLoc(const char *intrinsic, Descriptor &result,
     const Descriptor &x, int kind, int dim, const Descriptor *mask, bool back,
     Terminator &terminator) {
   if (back) {
     DoPartialMaxOrMinLocDirection<CAT, KIND, IS_MAX, COMPARE, true>(
         intrinsic, result, x, kind, dim, mask, terminator);
   } else {
     DoPartialMaxOrMinLocDirection<CAT, KIND, IS_MAX, COMPARE, false>(
         intrinsic, result, x, kind, dim, mask, terminator);
   }
 }
 
+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,
     const Descriptor *mask, bool back) {
   Terminator terminator{source, line};
   CheckIntegerKind(terminator, kind, intrinsic);
   auto catKind{x.type().GetCategoryAndKind()};
   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());
   }
+}
 
 extern "C" {
 void RTNAME(MaxlocDim)(Descriptor &result, const Descriptor &x, int kind,
     int dim, const char *source, int line, const Descriptor *mask, bool back) {
   TypedPartialMaxOrMinLoc<true>(
       "MAXLOC", result, x, kind, dim, source, line, mask, back);
 }
 void RTNAME(MinlocDim)(Descriptor &result, const Descriptor &x, int kind,
     int dim, const char *source, int line, const Descriptor *mask, bool back) {
   TypedPartialMaxOrMinLoc<false>(
       "MINLOC", result, x, kind, dim, source, line, mask, back);
 }
 } // 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 {
   using Type = CppTypeFor<CAT, KIND>;
   static constexpr Type Value() {
     return IS_MAXVAL ? std::numeric_limits<Type>::lowest()
                      : std::numeric_limits<Type>::max();
   }
 };
 
 // std::numeric_limits<> may not know int128_t
 template <bool IS_MAXVAL>
 struct MaxOrMinIdentity<TypeCategory::Integer, 16, IS_MAXVAL> {
   using Type = CppTypeFor<TypeCategory::Integer, 16>;
   static constexpr Type Value() {
     return IS_MAXVAL ? Type{1} << 127 : ~Type{0} >> 1;
   }
 };
 
 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_;
   }
   bool Accumulate(Type x) {
     if constexpr (IS_MAXVAL) {
       if (x > extremum_) {
         extremum_ = x;
       }
if (int stat{result.Allocate()}) {
       terminator.Crash(
           "%s: could not allocate memory for result; STAT=%d", intrinsic, stat);
     }
     ACCUMULATOR<CAT, KIND, IS_MAXVAL> accumulator{x};
     DoTotalReduction<Type>(x, dim, mask, accumulator, intrinsic, terminator);
     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,
     const char *intrinsic) {
   Terminator terminator{source, line};
   auto type{x.type().GetCategoryAndKind()};
   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());
   }
+}
 
 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_) {
       std::memcpy(p, extremum_, charLen_);
     } else {
       // empty array: result is all zero-valued characters
       std::memset(p, 0, charLen_);
     }
public:
   }
 
 private:
   const Descriptor &array_;
   std::size_t charLen_;
   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,
     const char *intrinsic) {
   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" {
 CppTypeFor<TypeCategory::Integer, 1> RTNAME(MaxvalInteger1)(const Descriptor &x,
     const char *source, int line, int dim, const Descriptor *mask) {
   return TotalNumericMaxOrMin<TypeCategory::Integer, 1, true>(
       x, source, line, dim, mask, "MAXVAL");
 }
if (x.type().IsCharacter()) {
     CharacterMaxOrMin<false>(result, x, dim, source, line, mask, "MINVAL");
   } else {
     NumericMaxOrMin<false>(result, x, dim, source, line, mask, "MINVAL");
   }
 }
 
 } // extern "C"
 
-// ALL, ANY, & COUNT
+// ALL, ANY, COUNT, & PARITY
+
+enum class LogicalReduction { All, Any, Parity };
 
-template <bool IS_ALL> class LogicalAccumulator {
+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[]) {
     return Accumulate(IsLogicalElementTrue(array_, at));
   }
 
 private:
   const Descriptor &array_;
-  bool result_{IS_ALL};
+  bool result_{REDUCTION == LogicalReduction::All};
 };
 
 template <typename ACCUMULATOR>
 inline auto GetTotalLogicalReduction(const Descriptor &x, const char *source,
     int line, int dim, ACCUMULATOR &&accumulator, const char *intrinsic) ->
     typename ACCUMULATOR::Type {
   Terminator terminator{source, line};
   if (dim < 0 || dim > 1) {
for (auto n{dim.Extent()}; n-- > 0; ++at) {
     xAt[zeroBasedDim] = at;
     if (!accumulator.AccumulateAt(xAt)) {
       break;
     }
   }
   return accumulator.Result();
 }
 
-template <bool IS_ALL, int KIND>
-inline void ReduceLogicalDimension(Descriptor &result, const Descriptor &x,
-    int dim, Terminator &terminator, const char *intrinsic) {
+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());
+      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);
+            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
 
 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[]) {
     if (IsLogicalElementTrue(array_, at)) {
       ++result_;
     }
     return true;
   }
 
 private:
   const Descriptor &array_;
   Type result_{0};
 };
 
-template <int KIND>
-inline void CountDimension(
-    Descriptor &result, const Descriptor &x, int dim, Terminator &terminator) {
+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)(
     const Descriptor &x, const char *source, int line, int dim) {
   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"
 } // namespace Fortran::runtime

flang/runtime/terminator.h

 // A mixin class for statement-specific image error termination
 // for errors detected in the runtime library
 class Terminator {
 public:
   Terminator() {}
   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;
   }
   [[noreturn]] void Crash(const char *message, ...) const;
   [[noreturn]] void CrashArgs(const char *message, va_list &) const;
   [[noreturn]] void CheckFailed(
       const char *predicate, const char *file, int line) const;

flang/runtime/tools.h

 //===-- runtime/tools.h -----------------------------------------*- C++ -*-===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 #ifndef FORTRAN_RUNTIME_TOOLS_H_
 #define FORTRAN_RUNTIME_TOOLS_H_
 
 #include "cpp-type.h"
 #include "descriptor.h"
 #include "memory.h"
 #include "terminator.h"
+#include "flang/Common/long-double.h"
 #include <functional>
 #include <map>
 #include <type_traits>
 
 namespace Fortran::runtime {
 
 class Terminator;
 
inline bool SetInteger(INT &x, int kind, std::int64_t value) {
   case 8:
     reinterpret_cast<CppTypeFor<TypeCategory::Integer, 8> &>(x) = value;
     return true;
   default:
     return false;
   }
 }
 
+// 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_

flang/unittests/RuntimeGTest/Reduction.cpp

TEST(Reductions, DoubleMaxMin) {
   EXPECT_EQ(*loc.ZeroBasedIndexedElement<std::int16_t>(11), 2); // 22
   loc.Destroy();
 }
 
 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()));
   EXPECT_EQ(std::memcmp(res.OffsetElement<char>(), "mno", 3), 0);
   res.Destroy();
   RTNAME(MinvalCharacter)(res, *array, __FILE__, __LINE__);
   EXPECT_EQ(res.rank(), 0);
   EXPECT_EQ(res.type().raw(), (TypeCode{TypeCategory::Character, 1}.raw()));
(res, *array, /*KIND=*/4, __FILE__, __LINE__, /*MASK=*/&*mask,
       /*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();
+  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) {
   std::vector<int> shape{2, 2};
   auto array{MakeArray<TypeCategory::Logical, 4>(
       shape, std::vector<std::int32_t>{false, false, true, true})};
   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()));
   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), 1);
   res.Destroy();
TEST(Reductions, Logical) {
   RTNAME(AnyDim)(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(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()));
   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), 2);
   res.Destroy();
   RTNAME(CountDim)(res, *array, /*DIM=*/2, /*KIND=*/8, __FILE__, __LINE__);
   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).Extent(), 2);
   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();
 }