//===-- runtime/extrema.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 MAXLOC, MINLOC, MAXVAL, & MINVAL for all required operand types
// and shapes and (for MAXLOC & MINLOC) result integer kinds.  Also implements
// NORM2 using common infrastructure.

#include "reduction-templates.h"
#include "flang/Common/float128.h"
#include "flang/Runtime/character.h"
#include "flang/Runtime/reduction.h"
#include <algorithm>
#include <cfloat>
#include <cinttypes>
#include <cmath>
#include <optional>
#include <type_traits>

namespace Fortran::runtime {

// MAXLOC & MINLOC

template <typename T, bool IS_MAX, bool BACK> struct NumericCompare {
  using Type = T;
  explicit RT_API_ATTRS NumericCompare(std::size_t /*elemLen; ignored*/) {}
  RT_API_ATTRS bool operator()(const T &value, const T &previous) const {
    if (std::is_floating_point_v<T> && previous != previous) {
      return BACK || value == value; // replace NaN
    } else 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 RT_API_ATTRS CharacterCompare(std::size_t elemLen)
      : chars_{elemLen / sizeof(T)} {}
  RT_API_ATTRS bool operator()(const T &value, const T &previous) const {
    int cmp{CharacterScalarCompare<T>(&value, &previous, chars_, chars_)};
    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;
  RT_API_ATTRS ExtremumLocAccumulator(const Descriptor &array)
      : array_{array}, argRank_{array.rank()}, compare_{array.ElementBytes()} {
    Reinitialize();
  }
  RT_API_ATTRS void Reinitialize() {
    // per standard: result indices are all zero if no data
    for (int j{0}; j < argRank_; ++j) {
      extremumLoc_[j] = 0;
    }
    previous_ = nullptr;
  }
  RT_API_ATTRS int argRank() const { return argRank_; }
  template <typename A>
  RT_API_ATTRS 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];
      }
    }
  }
  template <typename IGNORED>
  RT_API_ATTRS bool AccumulateAt(const SubscriptValue at[]) {
    const auto &value{*array_.Element<Type>(at)};
    if (!previous_ || compare_(value, *previous_)) {
      previous_ = &value;
      for (int j{0}; j < argRank_; ++j) {
        extremumLoc_[j] = at[j] - array_.GetDimension(j).LowerBound() + 1;
      }
    }
    return true;
  }

private:
  const Descriptor &array_;
  int argRank_;
  SubscriptValue extremumLoc_[maxRank];
  const Type *previous_{nullptr};
  COMPARE compare_;
};

template <typename ACCUMULATOR, typename CPPTYPE>
static RT_API_ATTRS void LocationHelper(const char *intrinsic,
    Descriptor &result, const Descriptor &x, int kind, const Descriptor *mask,
    Terminator &terminator) {
  ACCUMULATOR accumulator{x};
  DoTotalReduction<CPPTYPE>(x, 0, mask, accumulator, intrinsic, terminator);
  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 RT_API_ATTRS 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) {
    LocationHelper<ExtremumLocAccumulator<COMPARE<CppType, IS_MAX, true>>,
        CppType>(intrinsic, result, x, kind, mask, terminator);
  } else {
    LocationHelper<ExtremumLocAccumulator<COMPARE<CppType, IS_MAX, false>>,
        CppType>(intrinsic, result, x, kind, mask, terminator);
  }
}

template <bool IS_MAX> struct CharacterMaxOrMinLocHelper {
  template <int KIND> struct Functor {
    RT_API_ATTRS 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::Character, KIND, IS_MAX, CharacterCompare>(
          intrinsic, result, x, kind, source, line, mask, back);
    }
  };
};

template <bool IS_MAX>
inline RT_API_ATTRS void CharacterMaxOrMinLoc(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::Character:
    ApplyCharacterKind<CharacterMaxOrMinLocHelper<IS_MAX>::template Functor,
        void>(catKind->second, terminator, intrinsic, result, x, kind, source,
        line, mask, back);
    break;
  default:
    terminator.Crash(
        "%s: bad data type code (%d) for array", intrinsic, x.type().raw());
  }
}

template <TypeCategory CAT, int KIND, bool IS_MAXVAL>
inline RT_API_ATTRS void TotalNumericMaxOrMinLoc(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);
  RUNTIME_CHECK(terminator, TypeCode(CAT, KIND) == x.type());
  DoMaxOrMinLoc<CAT, KIND, IS_MAXVAL, NumericCompare>(
      intrinsic, result, x, kind, source, line, mask, back);
}

extern "C" {
RT_EXT_API_GROUP_BEGIN

void RTDEF(MaxlocCharacter)(Descriptor &result, const Descriptor &x, int kind,
    const char *source, int line, const Descriptor *mask, bool back) {
  CharacterMaxOrMinLoc<true>(
      "MAXLOC", result, x, kind, source, line, mask, back);
}
void RTDEF(MaxlocInteger1)(Descriptor &result, const Descriptor &x, int kind,
    const char *source, int line, const Descriptor *mask, bool back) {
  TotalNumericMaxOrMinLoc<TypeCategory::Integer, 1, true>(
      "MAXLOC", result, x, kind, source, line, mask, back);
}
void RTDEF(MaxlocInteger2)(Descriptor &result, const Descriptor &x, int kind,
    const char *source, int line, const Descriptor *mask, bool back) {
  TotalNumericMaxOrMinLoc<TypeCategory::Integer, 2, true>(
      "MAXLOC", result, x, kind, source, line, mask, back);
}
void RTDEF(MaxlocInteger4)(Descriptor &result, const Descriptor &x, int kind,
    const char *source, int line, const Descriptor *mask, bool back) {
  TotalNumericMaxOrMinLoc<TypeCategory::Integer, 4, true>(
      "MAXLOC", result, x, kind, source, line, mask, back);
}
void RTDEF(MaxlocInteger8)(Descriptor &result, const Descriptor &x, int kind,
    const char *source, int line, const Descriptor *mask, bool back) {
  TotalNumericMaxOrMinLoc<TypeCategory::Integer, 8, true>(
      "MAXLOC", result, x, kind, source, line, mask, back);
}
#ifdef __SIZEOF_INT128__
void RTDEF(MaxlocInteger16)(Descriptor &result, const Descriptor &x, int kind,
    const char *source, int line, const Descriptor *mask, bool back) {
  TotalNumericMaxOrMinLoc<TypeCategory::Integer, 16, true>(
      "MAXLOC", result, x, kind, source, line, mask, back);
}
#endif
void RTDEF(MaxlocReal4)(Descriptor &result, const Descriptor &x, int kind,
    const char *source, int line, const Descriptor *mask, bool back) {
  TotalNumericMaxOrMinLoc<TypeCategory::Real, 4, true>(
      "MAXLOC", result, x, kind, source, line, mask, back);
}
void RTDEF(MaxlocReal8)(Descriptor &result, const Descriptor &x, int kind,
    const char *source, int line, const Descriptor *mask, bool back) {
  TotalNumericMaxOrMinLoc<TypeCategory::Real, 8, true>(
      "MAXLOC", result, x, kind, source, line, mask, back);
}
#if LDBL_MANT_DIG == 64
void RTDEF(MaxlocReal10)(Descriptor &result, const Descriptor &x, int kind,
    const char *source, int line, const Descriptor *mask, bool back) {
  TotalNumericMaxOrMinLoc<TypeCategory::Real, 10, true>(
      "MAXLOC", result, x, kind, source, line, mask, back);
}
#endif
#if LDBL_MANT_DIG == 113 || HAS_FLOAT128
void RTDEF(MaxlocReal16)(Descriptor &result, const Descriptor &x, int kind,
    const char *source, int line, const Descriptor *mask, bool back) {
  TotalNumericMaxOrMinLoc<TypeCategory::Real, 16, true>(
      "MAXLOC", result, x, kind, source, line, mask, back);
}
#endif
void RTDEF(MinlocCharacter)(Descriptor &result, const Descriptor &x, int kind,
    const char *source, int line, const Descriptor *mask, bool back) {
  CharacterMaxOrMinLoc<false>(
      "MINLOC", result, x, kind, source, line, mask, back);
}
void RTDEF(MinlocInteger1)(Descriptor &result, const Descriptor &x, int kind,
    const char *source, int line, const Descriptor *mask, bool back) {
  TotalNumericMaxOrMinLoc<TypeCategory::Integer, 1, false>(
      "MINLOC", result, x, kind, source, line, mask, back);
}
void RTDEF(MinlocInteger2)(Descriptor &result, const Descriptor &x, int kind,
    const char *source, int line, const Descriptor *mask, bool back) {
  TotalNumericMaxOrMinLoc<TypeCategory::Integer, 2, false>(
      "MINLOC", result, x, kind, source, line, mask, back);
}
void RTDEF(MinlocInteger4)(Descriptor &result, const Descriptor &x, int kind,
    const char *source, int line, const Descriptor *mask, bool back) {
  TotalNumericMaxOrMinLoc<TypeCategory::Integer, 4, false>(
      "MINLOC", result, x, kind, source, line, mask, back);
}
void RTDEF(MinlocInteger8)(Descriptor &result, const Descriptor &x, int kind,
    const char *source, int line, const Descriptor *mask, bool back) {
  TotalNumericMaxOrMinLoc<TypeCategory::Integer, 8, false>(
      "MINLOC", result, x, kind, source, line, mask, back);
}
#ifdef __SIZEOF_INT128__
void RTDEF(MinlocInteger16)(Descriptor &result, const Descriptor &x, int kind,
    const char *source, int line, const Descriptor *mask, bool back) {
  TotalNumericMaxOrMinLoc<TypeCategory::Integer, 16, false>(
      "MINLOC", result, x, kind, source, line, mask, back);
}
#endif
void RTDEF(MinlocReal4)(Descriptor &result, const Descriptor &x, int kind,
    const char *source, int line, const Descriptor *mask, bool back) {
  TotalNumericMaxOrMinLoc<TypeCategory::Real, 4, false>(
      "MINLOC", result, x, kind, source, line, mask, back);
}
void RTDEF(MinlocReal8)(Descriptor &result, const Descriptor &x, int kind,
    const char *source, int line, const Descriptor *mask, bool back) {
  TotalNumericMaxOrMinLoc<TypeCategory::Real, 8, false>(
      "MINLOC", result, x, kind, source, line, mask, back);
}
#if LDBL_MANT_DIG == 64
void RTDEF(MinlocReal10)(Descriptor &result, const Descriptor &x, int kind,
    const char *source, int line, const Descriptor *mask, bool back) {
  TotalNumericMaxOrMinLoc<TypeCategory::Real, 10, false>(
      "MINLOC", result, x, kind, source, line, mask, back);
}
#endif
#if LDBL_MANT_DIG == 113 || HAS_FLOAT128
void RTDEF(MinlocReal16)(Descriptor &result, const Descriptor &x, int kind,
    const char *source, int line, const Descriptor *mask, bool back) {
  TotalNumericMaxOrMinLoc<TypeCategory::Real, 16, false>(
      "MINLOC", result, x, kind, source, line, mask, back);
}
#endif

RT_EXT_API_GROUP_END
} // extern "C"

// MAXLOC/MINLOC with DIM=

template <TypeCategory CAT, int KIND, bool IS_MAX,
    template <typename, bool, bool> class COMPARE, bool BACK>
static RT_API_ATTRS void DoPartialMaxOrMinLocDirection(const char *intrinsic,
    Descriptor &result, const Descriptor &x, int kind, int dim,
    const Descriptor *mask, Terminator &terminator) {
  using CppType = CppTypeFor<CAT, 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 RT_API_ATTRS 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 {
    RT_API_ATTRS 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 RT_API_ATTRS 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());
  const Descriptor *maskToUse{mask};
  SubscriptValue maskAt[maxRank]; // contents unused
  if (mask && mask->rank() == 0) {
    if (IsLogicalElementTrue(*mask, maskAt)) {
      // A scalar MASK that's .TRUE.  In this case, just get rid of the MASK.
      maskToUse = nullptr;
    } else {
      // For scalar MASK arguments that are .FALSE., return all zeroes

      // Element size of the destination descriptor is the size
      // of {TypeCategory::Integer, kind}.
      CreatePartialReductionResult(result, x,
          Descriptor::BytesFor(TypeCategory::Integer, kind), dim, terminator,
          intrinsic, TypeCode{TypeCategory::Integer, kind});
      std::memset(
          result.OffsetElement(), 0, result.Elements() * result.ElementBytes());
      return;
    }
  }
  switch (catKind->first) {
  case TypeCategory::Integer:
    ApplyIntegerKind<DoPartialMaxOrMinLocHelper<TypeCategory::Integer, IS_MAX,
                         NumericCompare>::template Functor,
        void>(catKind->second, terminator, intrinsic, result, x, kind, dim,
        maskToUse, back, terminator);
    break;
  case TypeCategory::Real:
    ApplyFloatingPointKind<DoPartialMaxOrMinLocHelper<TypeCategory::Real,
                               IS_MAX, NumericCompare>::template Functor,
        void>(catKind->second, terminator, intrinsic, result, x, kind, dim,
        maskToUse, back, terminator);
    break;
  case TypeCategory::Character:
    ApplyCharacterKind<DoPartialMaxOrMinLocHelper<TypeCategory::Character,
                           IS_MAX, CharacterCompare>::template Functor,
        void>(catKind->second, terminator, intrinsic, result, x, kind, dim,
        maskToUse, back, terminator);
    break;
  default:
    terminator.Crash(
        "%s: bad data type code (%d) for array", intrinsic, x.type().raw());
  }
}

extern "C" {
RT_EXT_API_GROUP_BEGIN

void RTDEF(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 RTDEF(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);
}

RT_EXT_API_GROUP_END
} // extern "C"

// MAXVAL and MINVAL

template <TypeCategory CAT, int KIND, bool IS_MAXVAL, typename Enable = void>
struct MaxOrMinIdentity {
  using Type = CppTypeFor<CAT, KIND>;
  static constexpr RT_API_ATTRS 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 RT_API_ATTRS Type Value() {
    return IS_MAXVAL ? Type{1} << 127 : ~Type{0} >> 1;
  }
};

#if HAS_FLOAT128
// std::numeric_limits<> may not support __float128.
//
// Usage of GCC quadmath.h's FLT128_MAX is complicated by the fact that
// even GCC complains about 'Q' literal suffix under -Wpedantic.
// We just recreate FLT128_MAX ourselves.
//
// This specialization must engage only when
// CppTypeFor<TypeCategory::Real, 16> is __float128.
template <bool IS_MAXVAL>
struct MaxOrMinIdentity<TypeCategory::Real, 16, IS_MAXVAL,
    typename std::enable_if_t<
        std::is_same_v<CppTypeFor<TypeCategory::Real, 16>, __float128>>> {
  using Type = __float128;
  static RT_API_ATTRS Type Value() {
    // Create a buffer to store binary representation of __float128 constant.
    constexpr std::size_t alignment =
        std::max(alignof(Type), alignof(std::uint64_t));
    alignas(alignment) char data[sizeof(Type)];

    // First, verify that our interpretation of __float128 format is correct,
    // e.g. by checking at least one known constant.
    *reinterpret_cast<Type *>(data) = Type(1.0);
    if (*reinterpret_cast<std::uint64_t *>(data) != 0 ||
        *(reinterpret_cast<std::uint64_t *>(data) + 1) != 0x3FFF000000000000) {
      Terminator terminator{__FILE__, __LINE__};
      terminator.Crash("not yet implemented: no full support for __float128");
    }

    // Recreate FLT128_MAX.
    *reinterpret_cast<std::uint64_t *>(data) = 0xFFFFFFFFFFFFFFFF;
    *(reinterpret_cast<std::uint64_t *>(data) + 1) = 0x7FFEFFFFFFFFFFFF;
    Type max = *reinterpret_cast<Type *>(data);
    return IS_MAXVAL ? -max : max;
  }
};
#endif // HAS_FLOAT128

template <TypeCategory CAT, int KIND, bool IS_MAXVAL>
class NumericExtremumAccumulator {
public:
  using Type = CppTypeFor<CAT, KIND>;
  explicit RT_API_ATTRS NumericExtremumAccumulator(const Descriptor &array)
      : array_{array} {}
  RT_API_ATTRS void Reinitialize() {
    any_ = false;
    extremum_ = MaxOrMinIdentity<CAT, KIND, IS_MAXVAL>::Value();
  }
  template <typename A>
  RT_API_ATTRS void GetResult(A *p, int /*zeroBasedDim*/ = -1) const {
    *p = extremum_;
  }
  RT_API_ATTRS bool Accumulate(Type x) {
    if (!any_) {
      extremum_ = x;
      any_ = true;
    } else if (CAT == TypeCategory::Real && extremum_ != extremum_) {
      extremum_ = x; // replace NaN
    } else if constexpr (IS_MAXVAL) {
      if (x > extremum_) {
        extremum_ = x;
      }
    } else if (x < extremum_) {
      extremum_ = x;
    }
    return true;
  }
  template <typename A>
  RT_API_ATTRS bool AccumulateAt(const SubscriptValue at[]) {
    return Accumulate(*array_.Element<A>(at));
  }

private:
  const Descriptor &array_;
  bool any_{false};
  Type extremum_{MaxOrMinIdentity<CAT, KIND, IS_MAXVAL>::Value()};
};

template <TypeCategory CAT, int KIND, bool IS_MAXVAL>
inline RT_API_ATTRS CppTypeFor<CAT, KIND> TotalNumericMaxOrMin(
    const Descriptor &x, const char *source, int line, int dim,
    const Descriptor *mask, const char *intrinsic) {
  return GetTotalReduction<CAT, KIND>(x, source, line, dim, mask,
      NumericExtremumAccumulator<CAT, KIND, IS_MAXVAL>{x}, intrinsic);
}

template <TypeCategory CAT, int KIND, typename ACCUMULATOR>
static RT_API_ATTRS void DoMaxMinNorm2(Descriptor &result, const Descriptor &x,
    int dim, const Descriptor *mask, const char *intrinsic,
    Terminator &terminator) {
  using Type = CppTypeFor<CAT, KIND>;
  ACCUMULATOR accumulator{x};
  if (dim == 0 || x.rank() == 1) {
    // Total reduction

    // Element size of the destination descriptor is the same
    // as the element size of the source.
    result.Establish(x.type(), x.ElementBytes(), nullptr, 0, nullptr,
        CFI_attribute_allocatable);
    if (int stat{result.Allocate()}) {
      terminator.Crash(
          "%s: could not allocate memory for result; STAT=%d", intrinsic, stat);
    }
    DoTotalReduction<Type>(x, dim, mask, accumulator, intrinsic, terminator);
    accumulator.GetResult(result.OffsetElement<Type>());
  } else {
    // Partial reduction

    // Element size of the destination descriptor is the same
    // as the element size of the source.
    PartialReduction<ACCUMULATOR, CAT, KIND>(result, x, x.ElementBytes(), dim,
        mask, terminator, intrinsic, accumulator);
  }
}

template <TypeCategory CAT, bool IS_MAXVAL> struct MaxOrMinHelper {
  template <int KIND> struct Functor {
    RT_API_ATTRS void operator()(Descriptor &result, const Descriptor &x,
        int dim, const Descriptor *mask, const char *intrinsic,
        Terminator &terminator) const {
      DoMaxMinNorm2<CAT, KIND,
          NumericExtremumAccumulator<CAT, KIND, IS_MAXVAL>>(
          result, x, dim, mask, intrinsic, terminator);
    }
  };
};

template <bool IS_MAXVAL>
inline RT_API_ATTRS 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:
    ApplyIntegerKind<
        MaxOrMinHelper<TypeCategory::Integer, IS_MAXVAL>::template Functor,
        void>(
        type->second, terminator, result, x, dim, mask, intrinsic, terminator);
    break;
  case TypeCategory::Real:
    ApplyFloatingPointKind<
        MaxOrMinHelper<TypeCategory::Real, IS_MAXVAL>::template Functor, void>(
        type->second, terminator, result, x, dim, mask, intrinsic, terminator);
    break;
  default:
    terminator.Crash("%s: bad type code %d", intrinsic, x.type().raw());
  }
}

template <int KIND, bool IS_MAXVAL> class CharacterExtremumAccumulator {
public:
  using Type = CppTypeFor<TypeCategory::Character, KIND>;
  explicit RT_API_ATTRS CharacterExtremumAccumulator(const Descriptor &array)
      : array_{array}, charLen_{array_.ElementBytes() / KIND} {}
  RT_API_ATTRS void Reinitialize() { extremum_ = nullptr; }
  template <typename A>
  RT_API_ATTRS void GetResult(A *p, int /*zeroBasedDim*/ = -1) const {
    static_assert(std::is_same_v<A, Type>);
    std::size_t byteSize{array_.ElementBytes()};
    if (extremum_) {
      std::memcpy(p, extremum_, byteSize);
    } else {
      // Empty array; fill with character 0 for MAXVAL.
      // For MINVAL, set all of the bits.
      std::memset(p, IS_MAXVAL ? 0 : 255, byteSize);
    }
  }
  RT_API_ATTRS bool Accumulate(const Type *x) {
    if (!extremum_) {
      extremum_ = x;
    } else {
      int cmp{CharacterScalarCompare(x, extremum_, charLen_, charLen_)};
      if (IS_MAXVAL == (cmp > 0)) {
        extremum_ = x;
      }
    }
    return true;
  }
  template <typename A>
  RT_API_ATTRS bool AccumulateAt(const SubscriptValue at[]) {
    return Accumulate(array_.Element<A>(at));
  }

private:
  const Descriptor &array_;
  std::size_t charLen_;
  const Type *extremum_{nullptr};
};

template <bool IS_MAXVAL> struct CharacterMaxOrMinHelper {
  template <int KIND> struct Functor {
    RT_API_ATTRS void operator()(Descriptor &result, const Descriptor &x,
        int dim, const Descriptor *mask, const char *intrinsic,
        Terminator &terminator) const {
      DoMaxMinNorm2<TypeCategory::Character, KIND,
          CharacterExtremumAccumulator<KIND, IS_MAXVAL>>(
          result, x, dim, mask, intrinsic, terminator);
    }
  };
};

template <bool IS_MAXVAL>
inline RT_API_ATTRS 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);
  ApplyCharacterKind<CharacterMaxOrMinHelper<IS_MAXVAL>::template Functor,
      void>(
      type->second, terminator, result, x, dim, mask, intrinsic, terminator);
}

extern "C" {
RT_EXT_API_GROUP_BEGIN

CppTypeFor<TypeCategory::Integer, 1> RTDEF(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");
}
CppTypeFor<TypeCategory::Integer, 2> RTDEF(MaxvalInteger2)(const Descriptor &x,
    const char *source, int line, int dim, const Descriptor *mask) {
  return TotalNumericMaxOrMin<TypeCategory::Integer, 2, true>(
      x, source, line, dim, mask, "MAXVAL");
}
CppTypeFor<TypeCategory::Integer, 4> RTDEF(MaxvalInteger4)(const Descriptor &x,
    const char *source, int line, int dim, const Descriptor *mask) {
  return TotalNumericMaxOrMin<TypeCategory::Integer, 4, true>(
      x, source, line, dim, mask, "MAXVAL");
}
CppTypeFor<TypeCategory::Integer, 8> RTDEF(MaxvalInteger8)(const Descriptor &x,
    const char *source, int line, int dim, const Descriptor *mask) {
  return TotalNumericMaxOrMin<TypeCategory::Integer, 8, true>(
      x, source, line, dim, mask, "MAXVAL");
}
#ifdef __SIZEOF_INT128__
CppTypeFor<TypeCategory::Integer, 16> RTDEF(MaxvalInteger16)(
    const Descriptor &x, const char *source, int line, int dim,
    const Descriptor *mask) {
  return TotalNumericMaxOrMin<TypeCategory::Integer, 16, true>(
      x, source, line, dim, mask, "MAXVAL");
}
#endif

// TODO: REAL(2 & 3)
CppTypeFor<TypeCategory::Real, 4> RTDEF(MaxvalReal4)(const Descriptor &x,
    const char *source, int line, int dim, const Descriptor *mask) {
  return TotalNumericMaxOrMin<TypeCategory::Real, 4, true>(
      x, source, line, dim, mask, "MAXVAL");
}
CppTypeFor<TypeCategory::Real, 8> RTDEF(MaxvalReal8)(const Descriptor &x,
    const char *source, int line, int dim, const Descriptor *mask) {
  return TotalNumericMaxOrMin<TypeCategory::Real, 8, true>(
      x, source, line, dim, mask, "MAXVAL");
}
#if LDBL_MANT_DIG == 64
CppTypeFor<TypeCategory::Real, 10> RTDEF(MaxvalReal10)(const Descriptor &x,
    const char *source, int line, int dim, const Descriptor *mask) {
  return TotalNumericMaxOrMin<TypeCategory::Real, 10, true>(
      x, source, line, dim, mask, "MAXVAL");
}
#endif
#if LDBL_MANT_DIG == 113 || HAS_FLOAT128
CppTypeFor<TypeCategory::Real, 16> RTDEF(MaxvalReal16)(const Descriptor &x,
    const char *source, int line, int dim, const Descriptor *mask) {
  return TotalNumericMaxOrMin<TypeCategory::Real, 16, true>(
      x, source, line, dim, mask, "MAXVAL");
}
#endif

void RTDEF(MaxvalCharacter)(Descriptor &result, const Descriptor &x,
    const char *source, int line, const Descriptor *mask) {
  CharacterMaxOrMin<true>(result, x, 0, source, line, mask, "MAXVAL");
}

CppTypeFor<TypeCategory::Integer, 1> RTDEF(MinvalInteger1)(const Descriptor &x,
    const char *source, int line, int dim, const Descriptor *mask) {
  return TotalNumericMaxOrMin<TypeCategory::Integer, 1, false>(
      x, source, line, dim, mask, "MINVAL");
}
CppTypeFor<TypeCategory::Integer, 2> RTDEF(MinvalInteger2)(const Descriptor &x,
    const char *source, int line, int dim, const Descriptor *mask) {
  return TotalNumericMaxOrMin<TypeCategory::Integer, 2, false>(
      x, source, line, dim, mask, "MINVAL");
}
CppTypeFor<TypeCategory::Integer, 4> RTDEF(MinvalInteger4)(const Descriptor &x,
    const char *source, int line, int dim, const Descriptor *mask) {
  return TotalNumericMaxOrMin<TypeCategory::Integer, 4, false>(
      x, source, line, dim, mask, "MINVAL");
}
CppTypeFor<TypeCategory::Integer, 8> RTDEF(MinvalInteger8)(const Descriptor &x,
    const char *source, int line, int dim, const Descriptor *mask) {
  return TotalNumericMaxOrMin<TypeCategory::Integer, 8, false>(
      x, source, line, dim, mask, "MINVAL");
}
#ifdef __SIZEOF_INT128__
CppTypeFor<TypeCategory::Integer, 16> RTDEF(MinvalInteger16)(
    const Descriptor &x, const char *source, int line, int dim,
    const Descriptor *mask) {
  return TotalNumericMaxOrMin<TypeCategory::Integer, 16, false>(
      x, source, line, dim, mask, "MINVAL");
}
#endif

// TODO: REAL(2 & 3)
CppTypeFor<TypeCategory::Real, 4> RTDEF(MinvalReal4)(const Descriptor &x,
    const char *source, int line, int dim, const Descriptor *mask) {
  return TotalNumericMaxOrMin<TypeCategory::Real, 4, false>(
      x, source, line, dim, mask, "MINVAL");
}
CppTypeFor<TypeCategory::Real, 8> RTDEF(MinvalReal8)(const Descriptor &x,
    const char *source, int line, int dim, const Descriptor *mask) {
  return TotalNumericMaxOrMin<TypeCategory::Real, 8, false>(
      x, source, line, dim, mask, "MINVAL");
}
#if LDBL_MANT_DIG == 64
CppTypeFor<TypeCategory::Real, 10> RTDEF(MinvalReal10)(const Descriptor &x,
    const char *source, int line, int dim, const Descriptor *mask) {
  return TotalNumericMaxOrMin<TypeCategory::Real, 10, false>(
      x, source, line, dim, mask, "MINVAL");
}
#endif
#if LDBL_MANT_DIG == 113 || HAS_FLOAT128
CppTypeFor<TypeCategory::Real, 16> RTDEF(MinvalReal16)(const Descriptor &x,
    const char *source, int line, int dim, const Descriptor *mask) {
  return TotalNumericMaxOrMin<TypeCategory::Real, 16, false>(
      x, source, line, dim, mask, "MINVAL");
}
#endif

void RTDEF(MinvalCharacter)(Descriptor &result, const Descriptor &x,
    const char *source, int line, const Descriptor *mask) {
  CharacterMaxOrMin<false>(result, x, 0, source, line, mask, "MINVAL");
}

void RTDEF(MaxvalDim)(Descriptor &result, const Descriptor &x, int dim,
    const char *source, int line, const Descriptor *mask) {
  if (x.type().IsCharacter()) {
    CharacterMaxOrMin<true>(result, x, dim, source, line, mask, "MAXVAL");
  } else {
    NumericMaxOrMin<true>(result, x, dim, source, line, mask, "MAXVAL");
  }
}
void RTDEF(MinvalDim)(Descriptor &result, const Descriptor &x, int dim,
    const char *source, int line, const Descriptor *mask) {
  if (x.type().IsCharacter()) {
    CharacterMaxOrMin<false>(result, x, dim, source, line, mask, "MINVAL");
  } else {
    NumericMaxOrMin<false>(result, x, dim, source, line, mask, "MINVAL");
  }
}

RT_EXT_API_GROUP_END
} // extern "C"

// NORM2

RT_VAR_GROUP_BEGIN

// Use at least double precision for accumulators.
// Don't use __float128, it doesn't work with abs() or sqrt() yet.
static constexpr RT_CONST_VAR_ATTRS int largestLDKind {
#if LDBL_MANT_DIG == 113
  16
#elif LDBL_MANT_DIG == 64
  10
#else
  8
#endif
};

RT_VAR_GROUP_END

template <int KIND> class Norm2Accumulator {
public:
  using Type = CppTypeFor<TypeCategory::Real, KIND>;
  using AccumType =
      CppTypeFor<TypeCategory::Real, std::clamp(KIND, 8, largestLDKind)>;
  explicit RT_API_ATTRS Norm2Accumulator(const Descriptor &array)
      : array_{array} {}
  RT_API_ATTRS void Reinitialize() { max_ = sum_ = 0; }
  template <typename A>
  RT_API_ATTRS void GetResult(A *p, int /*zeroBasedDim*/ = -1) const {
    // m * sqrt(1 + sum((others(:)/m)**2))
    *p = static_cast<Type>(max_ * std::sqrt(1 + sum_));
  }
  RT_API_ATTRS bool Accumulate(Type x) {
    auto absX{std::abs(static_cast<AccumType>(x))};
    if (!max_) {
      max_ = absX;
    } else if (absX > max_) {
      auto t{max_ / absX}; // < 1.0
      auto tsq{t * t};
      sum_ *= tsq; // scale sum to reflect change to the max
      sum_ += tsq; // include a term for the previous max
      max_ = absX;
    } else { // absX <= max_
      auto t{absX / max_};
      sum_ += t * t;
    }
    return true;
  }
  template <typename A>
  RT_API_ATTRS bool AccumulateAt(const SubscriptValue at[]) {
    return Accumulate(*array_.Element<A>(at));
  }

private:
  const Descriptor &array_;
  AccumType max_{0}; // value (m) with largest magnitude
  AccumType sum_{0}; // sum((others(:)/m)**2)
};

template <int KIND> struct Norm2Helper {
  RT_API_ATTRS void operator()(Descriptor &result, const Descriptor &x, int dim,
      const Descriptor *mask, Terminator &terminator) const {
    DoMaxMinNorm2<TypeCategory::Real, KIND, Norm2Accumulator<KIND>>(
        result, x, dim, mask, "NORM2", terminator);
  }
};

extern "C" {
RT_EXT_API_GROUP_BEGIN

// TODO: REAL(2 & 3)
CppTypeFor<TypeCategory::Real, 4> RTDEF(Norm2_4)(
    const Descriptor &x, const char *source, int line, int dim) {
  return GetTotalReduction<TypeCategory::Real, 4>(
      x, source, line, dim, nullptr, Norm2Accumulator<4>{x}, "NORM2");
}
CppTypeFor<TypeCategory::Real, 8> RTDEF(Norm2_8)(
    const Descriptor &x, const char *source, int line, int dim) {
  return GetTotalReduction<TypeCategory::Real, 8>(
      x, source, line, dim, nullptr, Norm2Accumulator<8>{x}, "NORM2");
}
#if LDBL_MANT_DIG == 64
CppTypeFor<TypeCategory::Real, 10> RTDEF(Norm2_10)(
    const Descriptor &x, const char *source, int line, int dim) {
  return GetTotalReduction<TypeCategory::Real, 10>(
      x, source, line, dim, nullptr, Norm2Accumulator<10>{x}, "NORM2");
}
#endif
#if LDBL_MANT_DIG == 113
CppTypeFor<TypeCategory::Real, 16> RTDEF(Norm2_16)(
    const Descriptor &x, const char *source, int line, int dim) {
  return GetTotalReduction<TypeCategory::Real, 16>(
      x, source, line, dim, nullptr, Norm2Accumulator<16>{x}, "NORM2");
}
#endif

void RTDEF(Norm2Dim)(Descriptor &result, const Descriptor &x, int dim,
    const char *source, int line) {
  Terminator terminator{source, line};
  auto type{x.type().GetCategoryAndKind()};
  RUNTIME_CHECK(terminator, type);
  if (type->first == TypeCategory::Real) {
    ApplyFloatingPointKind<Norm2Helper, void>(
        type->second, terminator, result, x, dim, nullptr, terminator);
  } else {
    terminator.Crash("NORM2: bad type code %d", x.type().raw());
  }
}

RT_EXT_API_GROUP_END
} // extern "C"
} // namespace Fortran::runtime