[flang] Support lowering intrinsic `selected_real_kind` for variables

[peixin]

Summary

As Fortran 2018 16.9.170, the argument of selected_real_kind is integer
scalar, and result is default integer scalar. The constant expression in
this intrinsic has been supported by folding the constant expression.
This supports lowering this intrinsic for variables using runtime.

[peixin]

flang/lib/Optimizer/Builder/Runtime/Numeric.cpp

164

I am thinking if it is possible to refactor the Forced### ? For multiple arguments, the combination will result in a large amount of helpers. Or leave it there when more intrinsics have this problem.

[peixin]

Fix the error.

[jeanPerier]

I think this is way too much entry point for a not so performance critical important intrinsic (that is folded 90% of the cases).
Have you considered using a single select_real_kind(void* precision , int precisionKind, void* range, int rangeKind, void* radix, int radixKind) interface ? It should also allow a better handling of the dynamically absent cases.
(Simplifying the interface for select_int_kind is also actually probably worth it, but since it is simpler, I am also OK with its current form).

flang/runtime/numeric.cpp

121

Right now I think there would be an issue if RADIX is absent, lowering would set it to zero, causing the runtime to return an error while the runtime says there is no requirement is about the radix if it is dynamically absent (say it is an absent optional).

I think it would be better to have the runtime interface be const Descriptor*/void* so that the dynamically absent case can be handled by the runtime.

[peixin]

Use the new approach as @jeanPerier suggested.

[peixin]

Rebase due to application patch conflict.

[jeanPerier]

Thanks, looks good to me

flang/include/flang/Optimizer/Builder/Runtime/Numeric.h

 /// Generate call to RRSpacing intrinsic runtime routine.
 mlir::Value genRRSpacing(fir::FirOpBuilder &builder, mlir::Location loc,
                          mlir::Value x);
 
 /// Generate call to Scale intrinsic runtime routine.
 mlir::Value genScale(fir::FirOpBuilder &builder, mlir::Location loc,
                      mlir::Value x, mlir::Value i);
 
+/// Generate call to Selected_real_kind intrinsic runtime routine.
+mlir::Value genSelectedRealKind(fir::FirOpBuilder &builder, mlir::Location loc,
+                                mlir::Value precision, mlir::Value range,
+                                mlir::Value radix);
+
 /// Generate call to Set_exponent intrinsic runtime routine.
 mlir::Value genSetExponent(fir::FirOpBuilder &builder, mlir::Location loc,
                            mlir::Value x, mlir::Value i);
 
 /// Generate call to Spacing intrinsic runtime routine.
 mlir::Value genSpacing(fir::FirOpBuilder &builder, mlir::Location loc,
                        mlir::Value x);
 
 } // namespace fir::runtime
 #endif // FORTRAN_OPTIMIZER_BUILDER_RUNTIME_NUMERIC_H

flang/include/flang/Runtime/numeric.h

 CppTypeFor<TypeCategory::Real, 10> RTNAME(Scale10)(
     CppTypeFor<TypeCategory::Real, 10>, std::int64_t);
 #endif
 #if LDBL_MANT_DIG == 113 || HAS_FLOAT128
 CppTypeFor<TypeCategory::Real, 16> RTNAME(Scale16)(
     CppTypeFor<TypeCategory::Real, 16>, std::int64_t);
 #endif
 
+// SELECTED_REAL_KIND
+CppTypeFor<TypeCategory::Integer, 4> RTNAME(SelectedRealKind8_8_8)(
+    CppTypeFor<TypeCategory::Integer, 8>, CppTypeFor<TypeCategory::Integer, 8>,
+    CppTypeFor<TypeCategory::Integer, 8>);
+#ifdef __SIZEOF_INT128__
+CppTypeFor<TypeCategory::Integer, 4> RTNAME(SelectedRealKind16_8_8)(
+    CppTypeFor<TypeCategory::Integer, 16>, CppTypeFor<TypeCategory::Integer, 8>,
+    CppTypeFor<TypeCategory::Integer, 8>);
+CppTypeFor<TypeCategory::Integer, 4> RTNAME(SelectedRealKind8_16_8)(
+    CppTypeFor<TypeCategory::Integer, 8>, CppTypeFor<TypeCategory::Integer, 16>,
+    CppTypeFor<TypeCategory::Integer, 8>);
+CppTypeFor<TypeCategory::Integer, 4> RTNAME(SelectedRealKind16_16_8)(
+    CppTypeFor<TypeCategory::Integer, 16>,
+    CppTypeFor<TypeCategory::Integer, 16>,
+    CppTypeFor<TypeCategory::Integer, 8>);
+CppTypeFor<TypeCategory::Integer, 4> RTNAME(SelectedRealKind8_8_16)(
+    CppTypeFor<TypeCategory::Integer, 8>, CppTypeFor<TypeCategory::Integer, 8>,
+    CppTypeFor<TypeCategory::Integer, 16>);
+CppTypeFor<TypeCategory::Integer, 4> RTNAME(SelectedRealKind16_8_16)(
+    CppTypeFor<TypeCategory::Integer, 16>, CppTypeFor<TypeCategory::Integer, 8>,
+    CppTypeFor<TypeCategory::Integer, 16>);
+CppTypeFor<TypeCategory::Integer, 4> RTNAME(SelectedRealKind8_16_16)(
+    CppTypeFor<TypeCategory::Integer, 8>, CppTypeFor<TypeCategory::Integer, 16>,
+    CppTypeFor<TypeCategory::Integer, 16>);
+CppTypeFor<TypeCategory::Integer, 4> RTNAME(SelectedRealKind16_16_16)(
+    CppTypeFor<TypeCategory::Integer, 16>,
+    CppTypeFor<TypeCategory::Integer, 16>,
+    CppTypeFor<TypeCategory::Integer, 16>);
+#endif
+
 // SPACING
 CppTypeFor<TypeCategory::Real, 4> RTNAME(Spacing4)(
     CppTypeFor<TypeCategory::Real, 4>);
 CppTypeFor<TypeCategory::Real, 8> RTNAME(Spacing8)(
     CppTypeFor<TypeCategory::Real, 8>);
 #if LDBL_MANT_DIG == 64
 CppTypeFor<TypeCategory::Real, 10> RTNAME(Spacing10)(
     CppTypeFor<TypeCategory::Real, 10>);

flang/lib/Lower/IntrinsicCall.cpp

struct IntrinsicLibrary {
   void genRandomNumber(llvm::ArrayRef<fir::ExtendedValue>);
   void genRandomSeed(llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genRepeat(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genReshape(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   mlir::Value genRRSpacing(mlir::Type resultType,
                            llvm::ArrayRef<mlir::Value> args);
   mlir::Value genScale(mlir::Type, llvm::ArrayRef<mlir::Value>);
   fir::ExtendedValue genScan(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
+  mlir::Value genSelectedRealKind(mlir::Type, llvm::ArrayRef<mlir::Value>);
   mlir::Value genSetExponent(mlir::Type resultType,
                              llvm::ArrayRef<mlir::Value> args);
   mlir::Value genSign(mlir::Type, llvm::ArrayRef<mlir::Value>);
   fir::ExtendedValue genSize(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   mlir::Value genSpacing(mlir::Type resultType,
                          llvm::ArrayRef<mlir::Value> args);
   fir::ExtendedValue genSpread(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genSum(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
static constexpr IntrinsicHandler handlers[]{
      /*isElemental=*/true},
     {"scan",
      &I::genScan,
      {{{"string", asAddr},
        {"set", asAddr},
        {"back", asValue, handleDynamicOptional},
        {"kind", asValue}}},
      /*isElemental=*/true},
+    {"selected_real_kind",
+     &I::genSelectedRealKind,
+     {{{"precision", asValue, handleDynamicOptional},
+       {"range", asValue, handleDynamicOptional},
+       {"radix", asValue, handleDynamicOptional}}},
+     /*isElemental=*/false},
     {"set_exponent", &I::genSetExponent},
     {"sign", &I::genSign},
     {"size",
      &I::genSize,
      {{{"array", asBox},
        {"dim", asAddr, handleDynamicOptional},
        {"kind", asValue}}},
      /*isElemental=*/false},
IntrinsicLibrary::genScan(mlir::Type resultType,
 
   fir::runtime::genScanDescriptor(builder, loc, resultIrBox, string, set, back,
                                   kind);
 
   // Handle cleanup of allocatable result descriptor and return
   return readAndAddCleanUp(resultMutableBox, resultType, "SCAN");
 }
 
+// SELECTED_INT_KIND
+mlir::Value
+IntrinsicLibrary::genSelectedRealKind(mlir::Type resultType,
+                                      llvm::ArrayRef<mlir::Value> args) {
+  assert(args.size() == 3);
+
+  // Handle optional precision(P) argument
+  mlir::Value precision =
+      isStaticallyAbsent(args[0])
+          ? builder.createIntegerConstant(loc, builder.getI1Type(), 0)
+          : fir::getBase(args[0]);
+
+  // Handle optional range(R) argument
+  mlir::Value range =
+      isStaticallyAbsent(args[1])
+          ? builder.createIntegerConstant(loc, builder.getI1Type(), 0)
+          : fir::getBase(args[1]);
+
+  // Handle optional radix(RADIX) argument
+  mlir::Value radix =
+      isStaticallyAbsent(args[2])
+          ? builder.createIntegerConstant(loc, builder.getI1Type(), 2)
+          : fir::getBase(args[2]);
+
+  return builder.createConvert(
+      loc, resultType,
+      fir::runtime::genSelectedRealKind(builder, loc, precision, range, radix));
+}
+
 // SET_EXPONENT
 mlir::Value IntrinsicLibrary::genSetExponent(mlir::Type resultType,
                                              llvm::ArrayRef<mlir::Value> args) {
   assert(args.size() == 2);
 
   return builder.createConvert(
       loc, resultType,
       fir::runtime::genSetExponent(builder, loc, fir::getBase(args[0]),

flang/lib/Optimizer/Builder/Runtime/Numeric.cpp

static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
     return [](mlir::MLIRContext *ctx) {
       auto fltTy = mlir::FloatType::getF128(ctx);
       auto intTy = mlir::IntegerType::get(ctx, 64);
       return mlir::FunctionType::get(ctx, {fltTy, intTy}, {fltTy});
     };
   }
 };
 
+/// Placeholder for integer*16 version of SelectedRealKind Intrinsic
+struct ForcedSelectedRealKind16_8_8 {
+  static constexpr const char *name =
+      ExpandAndQuoteKey(RTNAME(SelectedRealKind16_8_8));
+  static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
+    return [](mlir::MLIRContext *ctx) {
+      auto int128Ty = mlir::IntegerType::get(ctx, 128);
+      auto int64Ty = mlir::IntegerType::get(ctx, 64);
+      auto int32Ty = mlir::IntegerType::get(ctx, 32);
+      return mlir::FunctionType::get(ctx, {int128Ty, int64Ty, int64Ty},
+                                     {int32Ty});
+    };
+  }
+};
+
+struct ForcedSelectedRealKind8_16_8 {
+  static constexpr const char *name =
+      ExpandAndQuoteKey(RTNAME(SelectedRealKind8_16_8));
+  static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
+    return [](mlir::MLIRContext *ctx) {
+      auto int128Ty = mlir::IntegerType::get(ctx, 128);
+      auto int64Ty = mlir::IntegerType::get(ctx, 64);
+      auto int32Ty = mlir::IntegerType::get(ctx, 32);
+      return mlir::FunctionType::get(ctx, {int64Ty, int128Ty, int64Ty},
+                                     {int32Ty});
+    };
+  }
+};
+
+struct ForcedSelectedRealKind16_16_8 {
+  static constexpr const char *name =
+      ExpandAndQuoteKey(RTNAME(SelectedRealKind16_16_8));
+  static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
+    return [](mlir::MLIRContext *ctx) {
+      auto int128Ty = mlir::IntegerType::get(ctx, 128);
+      auto int64Ty = mlir::IntegerType::get(ctx, 64);
+      auto int32Ty = mlir::IntegerType::get(ctx, 32);
+      return mlir::FunctionType::get(ctx, {int128Ty, int128Ty, int64Ty},
+                                     {int32Ty});
+    };
+  }
+};
+
+struct ForcedSelectedRealKind8_8_16 {
+  static constexpr const char *name =
+      ExpandAndQuoteKey(RTNAME(SelectedRealKind8_8_16));
+  static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
+    return [](mlir::MLIRContext *ctx) {
+      auto int128Ty = mlir::IntegerType::get(ctx, 128);
+      auto int64Ty = mlir::IntegerType::get(ctx, 64);
+      auto int32Ty = mlir::IntegerType::get(ctx, 32);
+      return mlir::FunctionType::get(ctx, {int64Ty, int64Ty, int128Ty},
+                                     {int32Ty});
+    };
+  }
+};
+
+struct ForcedSelectedRealKind16_8_16 {
+  static constexpr const char *name =
+      ExpandAndQuoteKey(RTNAME(SelectedRealKind16_8_16));
+  static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
+    return [](mlir::MLIRContext *ctx) {
+      auto int128Ty = mlir::IntegerType::get(ctx, 128);
+      auto int64Ty = mlir::IntegerType::get(ctx, 64);
+      auto int32Ty = mlir::IntegerType::get(ctx, 32);
+      return mlir::FunctionType::get(ctx, {int128Ty, int64Ty, int128Ty},
+                                     {int32Ty});
+    };
+  }
+};
+
+struct ForcedSelectedRealKind8_16_16 {
+  static constexpr const char *name =
+      ExpandAndQuoteKey(RTNAME(SelectedRealKind8_16_16));
+  static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
+    return [](mlir::MLIRContext *ctx) {
+      auto int128Ty = mlir::IntegerType::get(ctx, 128);
+      auto int64Ty = mlir::IntegerType::get(ctx, 64);
+      auto int32Ty = mlir::IntegerType::get(ctx, 32);
+      return mlir::FunctionType::get(ctx, {int64Ty, int128Ty, int128Ty},
+                                     {int32Ty});
+    };
+  }
+};
+
+struct ForcedSelectedRealKind16_16_16 {
+  static constexpr const char *name =
+      ExpandAndQuoteKey(RTNAME(SelectedRealKind16_16_16));
+  static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
+    return [](mlir::MLIRContext *ctx) {
+      auto int128Ty = mlir::IntegerType::get(ctx, 128);
+      auto int32Ty = mlir::IntegerType::get(ctx, 32);
+      return mlir::FunctionType::get(ctx, {int128Ty, int128Ty, int128Ty},
+                                     {int32Ty});
+    };
+  }
+};
+
 /// Placeholder for real*10 version of RRSpacing Intrinsic
 struct ForcedSetExponent10 {
   static constexpr const char *name = ExpandAndQuoteKey(RTNAME(SetExponent10));
   static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
     return [](mlir::MLIRContext *ctx) {
       auto fltTy = mlir::FloatType::getF80(ctx);
       auto intTy = mlir::IntegerType::get(ctx, 64);
       return mlir::FunctionType::get(ctx, {fltTy, intTy}, {fltTy});
else
     fir::emitFatalError(loc, "unsupported REAL kind in SCALE");
 
   auto funcTy = func.getFunctionType();
   auto args = fir::runtime::createArguments(builder, loc, funcTy, x, i);
 
   return builder.create<fir::CallOp>(loc, func, args).getResult(0);
 }
 
+/// Generate call to Selected_real_kind intrinsic runtime routine.
+mlir::Value fir::runtime::genSelectedRealKind(fir::FirOpBuilder &builder,
+                                              mlir::Location loc,
+                                              mlir::Value precision,
+                                              mlir::Value range,
+                                              mlir::Value radix) {
+  mlir::func::FuncOp func;
+  mlir::Type pTy = precision.getType();
+  mlir::Type rTy = range.getType();
+  mlir::Type dTy = radix.getType();
+  int pKindLabel = (pTy.isInteger(8) || pTy.isInteger(16) ||
+                    pTy.isInteger(32) || pTy.isInteger(64))
+                       ? 0
+                       : (pTy.isInteger(128) ? 1 : -1);
+  int rKindLabel = (rTy.isInteger(8) || rTy.isInteger(16) ||
+                    rTy.isInteger(32) || rTy.isInteger(64))
+                       ? 0
+                       : (rTy.isInteger(128) ? 1 : -1);
+  int dKindLabel = (dTy.isInteger(8) || dTy.isInteger(16) ||
+                    dTy.isInteger(32) || dTy.isInteger(64))
+                       ? 0
+                       : (dTy.isInteger(128) ? 1 : -1);
+  if (pKindLabel == -1 || rKindLabel == -1 || dKindLabel == -1)
+    fir::emitFatalError(loc, "unsupported kind in SELECTED_REAL_KIND");
+
+  mlir::Value pVal = precision;
+  mlir::Value rVal = range;
+  mlir::Value dVal = radix;
+  mlir::Type i64Ty = mlir::IntegerType::get(builder.getContext(), 64);
+  if (pKindLabel == 0)
+    pVal = builder.createConvert(loc, i64Ty, precision);
+  if (rKindLabel == 0)
+    rVal = builder.createConvert(loc, i64Ty, range);
+  if (dKindLabel == 0)
+    dVal = builder.createConvert(loc, i64Ty, radix);
+
+  int kindLabel = pKindLabel + rKindLabel * 2 + dKindLabel * 2 * 2;
+  switch (kindLabel) {
+  case 0:
+    func = fir::runtime::getRuntimeFunc<mkRTKey(SelectedRealKind8_8_8)>(
+        loc, builder);
+    break;
+  case 1:
+    func = fir::runtime::getRuntimeFunc<ForcedSelectedRealKind16_8_8>(loc,
+                                                                      builder);
+    break;
+  case 2:
+    func = fir::runtime::getRuntimeFunc<ForcedSelectedRealKind8_16_8>(loc,
+                                                                      builder);
+    break;
+  case 3:
+    func = fir::runtime::getRuntimeFunc<ForcedSelectedRealKind16_16_8>(loc,
+                                                                       builder);
+    break;
+  case 4:
+    func = fir::runtime::getRuntimeFunc<ForcedSelectedRealKind8_8_16>(loc,
+                                                                      builder);
+    break;
+  case 5:
+    func = fir::runtime::getRuntimeFunc<ForcedSelectedRealKind16_8_16>(loc,
+                                                                       builder);
+    break;
+  case 6:
+    func = fir::runtime::getRuntimeFunc<ForcedSelectedRealKind8_16_16>(loc,
+                                                                       builder);
+    break;
+  case 7:
+    func = fir::runtime::getRuntimeFunc<ForcedSelectedRealKind16_16_16>(
+        loc, builder);
+    break;
+  default:
+    fir::emitFatalError(loc, "unsupported kind in SELECTED_REAL_KIND");
+  }
+
+  auto funcTy = func.getFunctionType();
+  auto args =
+      fir::runtime::createArguments(builder, loc, funcTy, pVal, rVal, dVal);
+
+  return builder.create<fir::CallOp>(loc, func, args).getResult(0);
+}
+
 /// Generate call to Set_exponent instrinsic runtime routine.
 mlir::Value fir::runtime::genSetExponent(fir::FirOpBuilder &builder,
                                          mlir::Location loc, mlir::Value x,
                                          mlir::Value i) {
   mlir::func::FuncOp func;
   mlir::Type fltTy = x.getType();
 
   if (fltTy.isF16())

flang/runtime/numeric.cpp

template <typename T> inline T Scale(T x, std::int64_t p) {
   auto ip{static_cast<int>(p)};
   if (ip != p) {
     ip = p < 0 ? std::numeric_limits<int>::min()
                : std::numeric_limits<int>::max();
   }
   return std::ldexp(x, p); // x*2**p
 }
 
+// SELECTED_REAL_KIND (16.9.170)
+template <typename P, typename R, typename D>
+inline CppTypeFor<TypeCategory::Integer, 4> SelectedRealKind(P p, R r, D d) {
+  if (d != 2) {
+    return -5;
+  }
+
+  int error{0};
+  int kind{0};
+  if (p <= 3) {
+    kind = 2;
+  } else if (p <= 6) {
+    kind = 4;
+  } else if (p <= 15) {
+    kind = 8;
+#if LDBL_MANT_DIG == 64
+  } else if (p <= 18) {
+    kind = 10;
+  } else if (p <= 33) {
+    kind = 16;
+#elif LDBL_MANT_DIG == 113
+  } else if (p <= 33) {
+    kind = 16;
+#endif
+  } else {
+    error -= 1;
+  }
+
+  if (r <= 4) {
+    kind = kind < 2 ? 2 : kind;
+  } else if (r <= 37) {
+    kind = kind < 3 ? 3 : kind;
+  } else if (r <= 307) {
+    kind = kind < 8 ? 8 : kind;
+#if LDBL_MANT_DIG == 64
+  } else if (r <= 4931) {
+    kind = kind < 10 ? 10 : kind;
+#elif LDBL_MANT_DIG == 113
+  } else if (r <= 4931) {
+    kind = kind < 16 ? 16 : kind;
+#endif
+  } else {
+    error -= 2;
+  }
+
+  return error ? error : kind;
+}
+
 // SET_EXPONENT (16.9.171)
 template <typename T> inline T SetExponent(T x, std::int64_t p) {
   if (std::isnan(x)) {
     return x; // NaN -> same NaN
   } else if (std::isinf(x)) {
     return std::numeric_limits<T>::quiet_NaN(); // +/-Inf -> NaN
   } else if (x == 0) {
     return x; // return negative zero if x is negative zero

 }
 #elif LDBL_MANT_DIG == 113
 CppTypeFor<TypeCategory::Real, 16> RTNAME(Scale16)(
     CppTypeFor<TypeCategory::Real, 16> x, std::int64_t p) {
   return Scale(x, p);
 }
 #endif
 
+// SELECTED_REAL_KIND
+CppTypeFor<TypeCategory::Integer, 4> RTNAME(SelectedRealKind8_8_8)(
+    CppTypeFor<TypeCategory::Integer, 8> p,
+    CppTypeFor<TypeCategory::Integer, 8> r,
+    CppTypeFor<TypeCategory::Integer, 8> d) {
+  return SelectedRealKind(p, r, d);
+}
+#ifdef __SIZEOF_INT128__
+CppTypeFor<TypeCategory::Integer, 4> RTNAME(SelectedRealKind16_8_8)(
+    CppTypeFor<TypeCategory::Integer, 16> p,
+    CppTypeFor<TypeCategory::Integer, 8> r,
+    CppTypeFor<TypeCategory::Integer, 8> d) {
+  return SelectedRealKind(p, r, d);
+}
+CppTypeFor<TypeCategory::Integer, 4> RTNAME(SelectedRealKind8_16_8)(
+    CppTypeFor<TypeCategory::Integer, 8> p,
+    CppTypeFor<TypeCategory::Integer, 16> r,
+    CppTypeFor<TypeCategory::Integer, 8> d) {
+  return SelectedRealKind(p, r, d);
+}
+CppTypeFor<TypeCategory::Integer, 4> RTNAME(SelectedRealKind16_16_8)(
+    CppTypeFor<TypeCategory::Integer, 16> p,
+    CppTypeFor<TypeCategory::Integer, 16> r,
+    CppTypeFor<TypeCategory::Integer, 8> d) {
+  return SelectedRealKind(p, r, d);
+}
+CppTypeFor<TypeCategory::Integer, 4> RTNAME(SelectedRealKind8_8_16)(
+    CppTypeFor<TypeCategory::Integer, 8> p,
+    CppTypeFor<TypeCategory::Integer, 8> r,
+    CppTypeFor<TypeCategory::Integer, 16> d) {
+  return SelectedRealKind(p, r, d);
+}
+CppTypeFor<TypeCategory::Integer, 4> RTNAME(SelectedRealKind16_8_16)(
+    CppTypeFor<TypeCategory::Integer, 16> p,
+    CppTypeFor<TypeCategory::Integer, 8> r,
+    CppTypeFor<TypeCategory::Integer, 16> d) {
+  return SelectedRealKind(p, r, d);
+}
+CppTypeFor<TypeCategory::Integer, 4> RTNAME(SelectedRealKind8_16_16)(
+    CppTypeFor<TypeCategory::Integer, 8> p,
+    CppTypeFor<TypeCategory::Integer, 16> r,
+    CppTypeFor<TypeCategory::Integer, 16> d) {
+  return SelectedRealKind(p, r, d);
+}
+CppTypeFor<TypeCategory::Integer, 4> RTNAME(SelectedRealKind16_16_16)(
+    CppTypeFor<TypeCategory::Integer, 16> p,
+    CppTypeFor<TypeCategory::Integer, 16> r,
+    CppTypeFor<TypeCategory::Integer, 16> d) {
+  return SelectedRealKind(p, r, d);
+}
+#endif
+
 CppTypeFor<TypeCategory::Real, 4> RTNAME(Spacing4)(
     CppTypeFor<TypeCategory::Real, 4> x) {
   return Spacing<24>(x);
 }
 CppTypeFor<TypeCategory::Real, 8> RTNAME(Spacing8)(
     CppTypeFor<TypeCategory::Real, 8> x) {
   return Spacing<53>(x);
 }

flang/test/Lower/Intrinsics/selected_real_kind.f90

+! REQUIRES: shell
+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+! CHECK-LABEL: func.func @_QPselected_real_kind_test1(
+! CHECK-SAME:                                         %[[VAL_0:.*]]: !fir.ref<i8> {fir.bindc_name = "p"},
+! CHECK-SAME:                                         %[[VAL_1:.*]]: !fir.ref<i8> {fir.bindc_name = "r"},
+! CHECK-SAME:                                         %[[VAL_2:.*]]: !fir.ref<i8> {fir.bindc_name = "d"}) {
+! CHECK:         %[[VAL_3:.*]] = fir.alloca i8 {bindc_name = "res", uniq_name = "_QFselected_real_kind_test1Eres"}
+! CHECK:         %[[VAL_4:.*]] = fir.load %[[VAL_0]] : !fir.ref<i8>
+! CHECK:         %[[VAL_5:.*]] = fir.load %[[VAL_1]] : !fir.ref<i8>
+! CHECK:         %[[VAL_6:.*]] = fir.load %[[VAL_2]] : !fir.ref<i8>
+! CHECK:         %[[VAL_7:.*]] = fir.convert %[[VAL_4]] : (i8) -> i64
+! CHECK:         %[[VAL_8:.*]] = fir.convert %[[VAL_5]] : (i8) -> i64
+! CHECK:         %[[VAL_9:.*]] = fir.convert %[[VAL_6]] : (i8) -> i64
+! CHECK:         %[[VAL_10:.*]] = fir.call @_FortranASelectedRealKind8_8_8(%[[VAL_7]], %[[VAL_8]], %[[VAL_9]]) : (i64, i64, i64) -> i32
+! CHECK:         %[[VAL_11:.*]] = fir.convert %[[VAL_10]] : (i32) -> i8
+! CHECK:         fir.store %[[VAL_11]] to %[[VAL_3]] : !fir.ref<i8>
+! CHECK:         return
+! CHECK:       }
+
+subroutine selected_real_kind_test1(p, r, d)
+  integer(1) :: p, r, d, res
+  res = selected_real_kind(P=p, R=r, RADIX=d)
+end
+
+! CHECK-LABEL: func.func @_QPselected_real_kind_test2(
+! CHECK-SAME:                                         %[[VAL_0:.*]]: !fir.ref<i16> {fir.bindc_name = "p"},
+! CHECK-SAME:                                         %[[VAL_1:.*]]: !fir.ref<i16> {fir.bindc_name = "r"},
+! CHECK-SAME:                                         %[[VAL_2:.*]]: !fir.ref<i16> {fir.bindc_name = "d"}) {
+! CHECK:         %[[VAL_3:.*]] = fir.alloca i16 {bindc_name = "res", uniq_name = "_QFselected_real_kind_test2Eres"}
+! CHECK:         %[[VAL_4:.*]] = fir.load %[[VAL_0]] : !fir.ref<i16>
+! CHECK:         %[[VAL_5:.*]] = fir.load %[[VAL_1]] : !fir.ref<i16>
+! CHECK:         %[[VAL_6:.*]] = fir.load %[[VAL_2]] : !fir.ref<i16>
+! CHECK:         %[[VAL_7:.*]] = fir.convert %[[VAL_4]] : (i16) -> i64
+! CHECK:         %[[VAL_8:.*]] = fir.convert %[[VAL_5]] : (i16) -> i64
+! CHECK:         %[[VAL_9:.*]] = fir.convert %[[VAL_6]] : (i16) -> i64
+! CHECK:         %[[VAL_10:.*]] = fir.call @_FortranASelectedRealKind8_8_8(%[[VAL_7]], %[[VAL_8]], %[[VAL_9]]) : (i64, i64, i64) -> i32
+! CHECK:         %[[VAL_11:.*]] = fir.convert %[[VAL_10]] : (i32) -> i16
+! CHECK:         fir.store %[[VAL_11]] to %[[VAL_3]] : !fir.ref<i16>
+! CHECK:         return
+! CHECK:       }
+
+subroutine selected_real_kind_test2(p, r, d)
+  integer(2) :: p, r, d, res
+  res = selected_real_kind(P=p, R=r, RADIX=d)
+end
+
+! CHECK-LABEL: func.func @_QPselected_real_kind_test4(
+! CHECK-SAME:                                         %[[VAL_0:.*]]: !fir.ref<i32> {fir.bindc_name = "p"},
+! CHECK-SAME:                                         %[[VAL_1:.*]]: !fir.ref<i32> {fir.bindc_name = "r"},
+! CHECK-SAME:                                         %[[VAL_2:.*]]: !fir.ref<i32> {fir.bindc_name = "d"}) {
+! CHECK:         %[[VAL_3:.*]] = fir.alloca i32 {bindc_name = "res", uniq_name = "_QFselected_real_kind_test4Eres"}
+! CHECK:         %[[VAL_4:.*]] = fir.load %[[VAL_0]] : !fir.ref<i32>
+! CHECK:         %[[VAL_5:.*]] = fir.load %[[VAL_1]] : !fir.ref<i32>
+! CHECK:         %[[VAL_6:.*]] = fir.load %[[VAL_2]] : !fir.ref<i32>
+! CHECK:         %[[VAL_7:.*]] = fir.convert %[[VAL_4]] : (i32) -> i64
+! CHECK:         %[[VAL_8:.*]] = fir.convert %[[VAL_5]] : (i32) -> i64
+! CHECK:         %[[VAL_9:.*]] = fir.convert %[[VAL_6]] : (i32) -> i64
+! CHECK:         %[[VAL_10:.*]] = fir.call @_FortranASelectedRealKind8_8_8(%[[VAL_7]], %[[VAL_8]], %[[VAL_9]]) : (i64, i64, i64) -> i32
+! CHECK:         fir.store %[[VAL_10]] to %[[VAL_3]] : !fir.ref<i32>
+! CHECK:         return
+! CHECK:       }
+
+subroutine selected_real_kind_test4(p, r, d)
+  integer(4) :: p, r, d, res
+  res = selected_real_kind(P=p, R=r, RADIX=d)
+end
+
+! CHECK-LABEL: func.func @_QPselected_real_kind_test8(
+! CHECK-SAME:                                         %[[VAL_0:.*]]: !fir.ref<i64> {fir.bindc_name = "p"},
+! CHECK-SAME:                                         %[[VAL_1:.*]]: !fir.ref<i64> {fir.bindc_name = "r"},
+! CHECK-SAME:                                         %[[VAL_2:.*]]: !fir.ref<i64> {fir.bindc_name = "d"}) {
+! CHECK:         %[[VAL_3:.*]] = fir.alloca i64 {bindc_name = "res", uniq_name = "_QFselected_real_kind_test8Eres"}
+! CHECK:         %[[VAL_4:.*]] = fir.load %[[VAL_0]] : !fir.ref<i64>
+! CHECK:         %[[VAL_5:.*]] = fir.load %[[VAL_1]] : !fir.ref<i64>
+! CHECK:         %[[VAL_6:.*]] = fir.load %[[VAL_2]] : !fir.ref<i64>
+! CHECK:         %[[VAL_7:.*]] = fir.call @_FortranASelectedRealKind8_8_8(%[[VAL_4]], %[[VAL_5]], %[[VAL_6]]) : (i64, i64, i64) -> i32
+! CHECK:         %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (i32) -> i64
+! CHECK:         fir.store %[[VAL_8]] to %[[VAL_3]] : !fir.ref<i64>
+! CHECK:         return
+! CHECK:       }
+
+subroutine selected_real_kind_test8(p, r, d)
+  integer(8) :: p, r, d, res
+  res = selected_real_kind(P=p, R=r, RADIX=d)
+end
+
+! CHECK-LABEL: func.func @_QPselected_real_kind_test16(
+! CHECK-SAME:                                          %[[VAL_0:.*]]: !fir.ref<i128> {fir.bindc_name = "p"},
+! CHECK-SAME:                                          %[[VAL_1:.*]]: !fir.ref<i128> {fir.bindc_name = "r"},
+! CHECK-SAME:                                          %[[VAL_2:.*]]: !fir.ref<i128> {fir.bindc_name = "d"}) {
+! CHECK:         %[[VAL_3:.*]] = fir.alloca i128 {bindc_name = "res", uniq_name = "_QFselected_real_kind_test16Eres"}
+! CHECK:         %[[VAL_4:.*]] = fir.load %[[VAL_0]] : !fir.ref<i128>
+! CHECK:         %[[VAL_5:.*]] = fir.load %[[VAL_1]] : !fir.ref<i128>
+! CHECK:         %[[VAL_6:.*]] = fir.load %[[VAL_2]] : !fir.ref<i128>
+! CHECK:         %[[VAL_7:.*]] = fir.call @_FortranASelectedRealKind16_16_16(%[[VAL_4]], %[[VAL_5]], %[[VAL_6]]) : (i128, i128, i128) -> i32
+! CHECK:         %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (i32) -> i128
+! CHECK:         fir.store %[[VAL_8]] to %[[VAL_3]] : !fir.ref<i128>
+! CHECK:         return
+! CHECK:       }
+
+subroutine selected_real_kind_test16(p, r, d)
+  integer(16) :: p, r, d, res
+  res = selected_real_kind(P=p, R=r, RADIX=d)
+end

flang/unittests/Runtime/Numeric.cpp

TEST(Numeric, SetExponent) {
   EXPECT_EQ(RTNAME(SetExponent4)(Real<4>{1.0}, 1), 1.0);
   EXPECT_EQ(RTNAME(SetExponent4)(Real<4>{1.0}, -1), 0.25);
   EXPECT_TRUE(std::isnan(
       RTNAME(SetExponent4)(std::numeric_limits<Real<4>>::infinity(), 1)));
   EXPECT_TRUE(std::isnan(
       RTNAME(SetExponent8)(std::numeric_limits<Real<8>>::quiet_NaN(), 1)));
 }
 
+TEST(Numeric, SelectedRealKind) {
+  EXPECT_EQ(
+      RTNAME(SelectedRealKind8_8_8)(Int<8>{-10}, Int<8>{-1}, Int<8>{2}), 2);
+  EXPECT_EQ(RTNAME(SelectedRealKind8_8_8)(Int<8>{1}, Int<8>{1}, Int<8>{1}), -5);
+  EXPECT_EQ(RTNAME(SelectedRealKind8_8_8)(Int<8>{1}, Int<8>{1}, Int<8>{2}), 2);
+  EXPECT_EQ(RTNAME(SelectedRealKind8_8_8)(Int<8>{4}, Int<8>{1}, Int<8>{2}), 4);
+  EXPECT_EQ(
+      RTNAME(SelectedRealKind8_8_8)(Int<8>{50}, Int<8>{1}, Int<8>{2}), -1);
+  EXPECT_EQ(RTNAME(SelectedRealKind8_8_8)(Int<8>{1}, Int<8>{1}, Int<8>{2}), 2);
+  EXPECT_EQ(RTNAME(SelectedRealKind8_8_8)(Int<8>{1}, Int<8>{20}, Int<8>{2}), 3);
+  EXPECT_EQ(RTNAME(SelectedRealKind8_8_8)(Int<8>{4}, Int<8>{20}, Int<8>{2}), 4);
+  EXPECT_EQ(
+      RTNAME(SelectedRealKind8_8_8)(Int<8>{1}, Int<8>{100}, Int<8>{2}), 8);
+  EXPECT_EQ(
+      RTNAME(SelectedRealKind8_8_8)(Int<8>{1}, Int<8>{5000}, Int<8>{2}), -2);
+  EXPECT_EQ(
+      RTNAME(SelectedRealKind8_8_8)(Int<8>{50}, Int<8>{5000}, Int<8>{2}), -3);
+}
+
 TEST(Numeric, Spacing) {
   EXPECT_EQ(RTNAME(Spacing8)(Real<8>{0}), std::numeric_limits<Real<8>>::min());
   EXPECT_EQ(RTNAME(Spacing4)(Real<4>{3.0}), std::ldexp(Real<4>{1.0}, -22));
   EXPECT_TRUE(
       std::isnan(RTNAME(Spacing4)(std::numeric_limits<Real<4>>::infinity())));
   EXPECT_TRUE(
       std::isnan(RTNAME(Spacing8)(std::numeric_limits<Real<8>>::quiet_NaN())));
 }