diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index c5faf319fafb7..08cec73d88ced 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -2330,6 +2330,12 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
         }
         if (auto dc{characteristics::DummyArgument::FromActual(std::move(kw),
                 *expr, context, /*forImplicitInterface=*/false)}) {
+          if (auto *dummyProc{
+                  std::get_if<characteristics::DummyProcedure>(&dc->u)}) {
+            // Dummy procedures are never elemental.
+            dummyProc->procedure.value().attrs.reset(
+                characteristics::Procedure::Attr::Elemental);
+          }
           dummyArgs.emplace_back(std::move(*dc));
           if (d.typePattern.kindCode == KindCode::same && !sameDummyArg) {
             sameDummyArg = j;
@@ -2874,8 +2880,7 @@ static bool CheckAtomicDefineAndRef(FoldingContext &context,
 }
 
 // Applies any semantic checks peculiar to an intrinsic.
-// TODO: Move the rest of these checks to Semantics/check-call.cpp, which is
-// where ASSOCIATED() and TRANSFER() are now validated.
+// TODO: Move the rest of these checks to Semantics/check-call.cpp.
 static bool ApplySpecificChecks(SpecificCall &call, FoldingContext &context) {
   bool ok{true};
   const std::string &name{call.specificIntrinsic.name};
@@ -2891,7 +2896,7 @@ static bool ApplySpecificChecks(SpecificCall &call, FoldingContext &context) {
           arg ? arg->sourceLocation() : context.messages().at(),
           "Argument of ALLOCATED() must be an ALLOCATABLE object or component"_err_en_US);
     }
-  } else if (name == "associated") {
+  } else if (name == "associated" || name == "reduce") {
     // Now handled in Semantics/check-call.cpp
   } else if (name == "atomic_and" || name == "atomic_or" ||
       name == "atomic_xor") {
@@ -2967,90 +2972,6 @@ static bool ApplySpecificChecks(SpecificCall &call, FoldingContext &context) {
           arg ? arg->sourceLocation() : context.messages().at(),
           "Argument of PRESENT() must be the name of an OPTIONAL dummy argument"_err_en_US);
     }
-  } else if (name == "reduce") { // 16.9.161
-    std::optional<DynamicType> arrayType;
-    if (const auto &array{call.arguments[0]}) {
-      arrayType = array->GetType();
-    }
-    std::optional<characteristics::Procedure> procChars;
-    parser::CharBlock at{context.messages().at()};
-    if (const auto &operation{call.arguments[1]}) {
-      if (const auto *expr{operation->UnwrapExpr()}) {
-        if (const auto *designator{
-                std::get_if<ProcedureDesignator>(&expr->u)}) {
-          procChars =
-              characteristics::Procedure::Characterize(*designator, context);
-        } else if (const auto *ref{std::get_if<ProcedureRef>(&expr->u)}) {
-          procChars = characteristics::Procedure::Characterize(*ref, context);
-        }
-      }
-      if (auto operationAt{operation->sourceLocation()}) {
-        at = *operationAt;
-      }
-    }
-    if (!arrayType || !procChars) {
-      ok = false; // error recovery
-    } else {
-      const auto *result{procChars->functionResult->GetTypeAndShape()};
-      if (!procChars->IsPure() || procChars->dummyArguments.size() != 2 ||
-          !procChars->functionResult) {
-        ok = false;
-        context.messages().Say(at,
-            "OPERATION= argument of REDUCE() must be a pure function of two data arguments"_err_en_US);
-      } else if (!result || result->Rank() != 0) {
-        ok = false;
-        context.messages().Say(at,
-            "OPERATION= argument of REDUCE() must be a scalar function"_err_en_US);
-      } else if (result->type().IsPolymorphic() ||
-          !arrayType->IsTkLenCompatibleWith(result->type())) {
-        ok = false;
-        context.messages().Say(at,
-            "OPERATION= argument of REDUCE() must have the same type as ARRAY="_err_en_US);
-      } else {
-        const characteristics::DummyDataObject *data[2]{};
-        for (int j{0}; j < 2; ++j) {
-          const auto &dummy{procChars->dummyArguments.at(j)};
-          data[j] = std::get_if<characteristics::DummyDataObject>(&dummy.u);
-          ok = ok && data[j];
-        }
-        if (!ok) {
-          context.messages().Say(at,
-              "OPERATION= argument of REDUCE() may not have dummy procedure arguments"_err_en_US);
-        } else {
-          for (int j{0}; j < 2; ++j) {
-            ok = ok &&
-                !data[j]->attrs.test(
-                    characteristics::DummyDataObject::Attr::Optional) &&
-                !data[j]->attrs.test(
-                    characteristics::DummyDataObject::Attr::Allocatable) &&
-                !data[j]->attrs.test(
-                    characteristics::DummyDataObject::Attr::Pointer) &&
-                data[j]->type.Rank() == 0 &&
-                !data[j]->type.type().IsPolymorphic() &&
-                data[j]->type.type().IsTkCompatibleWith(*arrayType);
-          }
-          if (!ok) {
-            context.messages().Say(at,
-                "Arguments of OPERATION= procedure of REDUCE() must be both scalar of the same type as ARRAY=, and neither allocatable, pointer, polymorphic, nor optional"_err_en_US);
-          } else if (data[0]->attrs.test(characteristics::DummyDataObject::
-                             Attr::Asynchronous) !=
-                  data[1]->attrs.test(
-                      characteristics::DummyDataObject::Attr::Asynchronous) ||
-              data[0]->attrs.test(
-                  characteristics::DummyDataObject::Attr::Volatile) !=
-                  data[1]->attrs.test(
-                      characteristics::DummyDataObject::Attr::Volatile) ||
-              data[0]->attrs.test(
-                  characteristics::DummyDataObject::Attr::Target) !=
-                  data[1]->attrs.test(
-                      characteristics::DummyDataObject::Attr::Target)) {
-            ok = false;
-            context.messages().Say(at,
-                "If either argument of the OPERATION= procedure of REDUCE() has the ASYNCHRONOUS, VOLATILE, or TARGET attribute, both must have that attribute"_err_en_US);
-          }
-        }
-      }
-    }
   } else if (name == "ucobound") {
     return CheckDimAgainstCorank(call, context);
   }
@@ -3143,6 +3064,28 @@ std::optional<SpecificCall> IntrinsicProcTable::Implementation::Probe(
         } else if (buffer.empty()) {
           buffer.Annex(std::move(localBuffer));
         } else {
+          // When there are multiple entries in the table for an
+          // intrinsic that has multiple forms depending on the
+          // presence of DIM=, use messages from a later entry if
+          // the messages from an earlier entry complain about the
+          // DIM= argument and it wasn't specified with a keyword.
+          for (const auto &m : buffer.messages()) {
+            if (m.ToString().find("'dim='") != std::string::npos) {
+              bool hadDimKeyword{false};
+              for (const auto &a : arguments) {
+                if (a) {
+                  if (auto kw{a->keyword()}; kw && kw == "dim") {
+                    hadDimKeyword = true;
+                    break;
+                  }
+                }
+              }
+              if (!hadDimKeyword) {
+                buffer = std::move(localBuffer);
+              }
+              break;
+            }
+          }
           localBuffer.clear();
         }
         return std::nullopt;
diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index b3f3b74b04ee1..f28a44e27ad68 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -1162,7 +1162,7 @@ static void CheckExplicitInterfaceArg(evaluate::ActualArgument &arg,
                   messages.Say(
                       "Assumed-type '%s' may be associated only with an assumed-type %s"_err_en_US,
                       assumed.name(), dummyName);
-                } else if (object.type.attrs().test(evaluate::characteristics::
+                } else if (object.type.attrs().test(characteristics::
                                    TypeAndShape::Attr::AssumedRank) &&
                     !IsAssumedShape(assumed) &&
                     !evaluate::IsAssumedRank(assumed)) {
@@ -1414,6 +1414,142 @@ static void CheckAssociated(evaluate::ActualArguments &arguments,
   }
 }
 
+// REDUCE (F'2023 16.9.173)
+static void CheckReduce(
+    evaluate::ActualArguments &arguments, evaluate::FoldingContext &context) {
+  std::optional<evaluate::DynamicType> arrayType;
+  parser::ContextualMessages &messages{context.messages()};
+  if (const auto &array{arguments[0]}) {
+    arrayType = array->GetType();
+    if (!arguments[/*identity=*/4]) {
+      if (const auto *expr{array->UnwrapExpr()}) {
+        if (auto shape{
+                evaluate::GetShape(context, *expr, /*invariantOnly=*/false)}) {
+          if (const auto &dim{arguments[2]}; dim && array->Rank() > 1) {
+            // Partial reduction
+            auto dimVal{evaluate::ToInt64(dim->UnwrapExpr())};
+            std::int64_t j{0};
+            int zeroDims{0};
+            bool isSelectedDimEmpty{false};
+            for (const auto &extent : *shape) {
+              ++j;
+              if (evaluate::ToInt64(extent) == 0) {
+                ++zeroDims;
+                isSelectedDimEmpty |= dimVal && j == *dimVal;
+              }
+            }
+            if (isSelectedDimEmpty && zeroDims == 1) {
+              messages.Say(
+                  "IDENTITY= must be present when DIM=%d and the array has zero extent on that dimension"_err_en_US,
+                  static_cast<int>(dimVal.value()));
+            }
+          } else { // no DIM= or DIM=1 on a vector: total reduction
+            for (const auto &extent : *shape) {
+              if (evaluate::ToInt64(extent) == 0) {
+                messages.Say(
+                    "IDENTITY= must be present when the array is empty and the result is scalar"_err_en_US);
+                break;
+              }
+            }
+          }
+        }
+      }
+    }
+  }
+  std::optional<characteristics::Procedure> procChars;
+  if (const auto &operation{arguments[1]}) {
+    if (const auto *expr{operation->UnwrapExpr()}) {
+      if (const auto *designator{
+              std::get_if<evaluate::ProcedureDesignator>(&expr->u)}) {
+        procChars =
+            characteristics::Procedure::Characterize(*designator, context);
+      } else if (const auto *ref{
+                     std::get_if<evaluate::ProcedureRef>(&expr->u)}) {
+        procChars = characteristics::Procedure::Characterize(*ref, context);
+      }
+    }
+  }
+  const auto *result{
+      procChars ? procChars->functionResult->GetTypeAndShape() : nullptr};
+  if (!procChars || !procChars->IsPure() ||
+      procChars->dummyArguments.size() != 2 || !procChars->functionResult) {
+    messages.Say(
+        "OPERATION= argument of REDUCE() must be a pure function of two data arguments"_err_en_US);
+  } else if (!result || result->Rank() != 0) {
+    messages.Say(
+        "OPERATION= argument of REDUCE() must be a scalar function"_err_en_US);
+  } else if (result->type().IsPolymorphic() ||
+      (arrayType && !arrayType->IsTkLenCompatibleWith(result->type()))) {
+    messages.Say(
+        "OPERATION= argument of REDUCE() must have the same type as ARRAY="_err_en_US);
+  } else {
+    const characteristics::DummyDataObject *data[2]{};
+    for (int j{0}; j < 2; ++j) {
+      const auto &dummy{procChars->dummyArguments.at(j)};
+      data[j] = std::get_if<characteristics::DummyDataObject>(&dummy.u);
+    }
+    if (!data[0] || !data[1]) {
+      messages.Say(
+          "OPERATION= argument of REDUCE() may not have dummy procedure arguments"_err_en_US);
+    } else {
+      for (int j{0}; j < 2; ++j) {
+        if (data[j]->attrs.test(
+                characteristics::DummyDataObject::Attr::Optional) ||
+            data[j]->attrs.test(
+                characteristics::DummyDataObject::Attr::Allocatable) ||
+            data[j]->attrs.test(
+                characteristics::DummyDataObject::Attr::Pointer) ||
+            data[j]->type.Rank() != 0 || data[j]->type.type().IsPolymorphic() ||
+            (arrayType &&
+                !data[j]->type.type().IsTkCompatibleWith(*arrayType))) {
+          messages.Say(
+              "Arguments of OPERATION= procedure of REDUCE() must be both scalar of the same type as ARRAY=, and neither allocatable, pointer, polymorphic, nor optional"_err_en_US);
+        }
+      }
+      static constexpr characteristics::DummyDataObject::Attr attrs[]{
+          characteristics::DummyDataObject::Attr::Asynchronous,
+          characteristics::DummyDataObject::Attr::Target,
+          characteristics::DummyDataObject::Attr::Value,
+      };
+      for (std::size_t j{0}; j < sizeof attrs / sizeof *attrs; ++j) {
+        if (data[0]->attrs.test(attrs[j]) != data[1]->attrs.test(attrs[j])) {
+          messages.Say(
+              "If either argument of the OPERATION= procedure of REDUCE() has the ASYNCHRONOUS, TARGET, or VALUE attribute, both must have that attribute"_err_en_US);
+          break;
+        }
+      }
+    }
+  }
+  // When the MASK= is present and has no .TRUE. element, and there is
+  // no IDENTITY=, it's an error.
+  if (const auto &mask{arguments[3]}; mask && !arguments[/*identity*/ 4]) {
+    if (const auto *expr{mask->UnwrapExpr()}) {
+      if (const auto *logical{
+              std::get_if<evaluate::Expr<evaluate::SomeLogical>>(&expr->u)}) {
+        if (common::visit(
+                [](const auto &kindExpr) {
+                  using KindExprType = std::decay_t<decltype(kindExpr)>;
+                  using KindLogical = typename KindExprType::Result;
+                  if (const auto *c{evaluate::UnwrapConstantValue<KindLogical>(
+                          kindExpr)}) {
+                    for (const auto &element : c->values()) {
+                      if (element.IsTrue()) {
+                        return false;
+                      }
+                    }
+                    return true;
+                  }
+                  return false;
+                },
+                logical->u)) {
+          messages.Say(
+              "MASK= has no .TRUE. element, so IDENTITY= must be present"_err_en_US);
+        }
+      }
+    }
+  }
+}
+
 // TRANSFER (16.9.193)
 static void CheckTransferOperandType(SemanticsContext &context,
     const evaluate::DynamicType &type, const char *which) {
@@ -1486,6 +1622,8 @@ static void CheckSpecificIntrinsic(evaluate::ActualArguments &arguments,
     const evaluate::SpecificIntrinsic &intrinsic) {
   if (intrinsic.name == "associated") {
     CheckAssociated(arguments, context, scope);
+  } else if (intrinsic.name == "reduce") {
+    CheckReduce(arguments, context.foldingContext());
   } else if (intrinsic.name == "transfer") {
     CheckTransfer(arguments, context, scope);
   }
diff --git a/flang/test/Semantics/misc-intrinsics.f90 b/flang/test/Semantics/misc-intrinsics.f90
index 195906eef9d79..14dcdb05ac6c6 100644
--- a/flang/test/Semantics/misc-intrinsics.f90
+++ b/flang/test/Semantics/misc-intrinsics.f90
@@ -10,17 +10,17 @@ subroutine test(arg, assumedRank)
     real, dimension(..) :: assumedRank
     !ERROR: A dim= argument is required for 'size' when the array is assumed-size
     print *, size(arg)
-    !ERROR: missing mandatory 'dim=' argument
+    !ERROR: A dim= argument is required for 'ubound' when the array is assumed-size
     print *, ubound(arg)
     !ERROR: The 'source=' argument to the intrinsic function 'shape' may not be assumed-size
     print *, shape(arg)
     !ERROR: The 'harvest=' argument to the intrinsic procedure 'random_number' may not be assumed-size
     call random_number(arg)
-    !ERROR: missing mandatory 'dim=' argument
+    !ERROR: 'array=' argument has unacceptable rank 0
     print *, lbound(scalar)
     !ERROR: 'array=' argument has unacceptable rank 0
     print *, size(scalar)
-    !ERROR: missing mandatory 'dim=' argument
+    !ERROR: 'array=' argument has unacceptable rank 0
     print *, ubound(scalar)
     !ERROR: DIM=0 dimension must be positive
     print *, lbound(arg, 0)
@@ -45,7 +45,7 @@ subroutine test(arg, assumedRank)
     rank(*)
       !ERROR: A dim= argument is required for 'size' when the array is assumed-size
       print *, size(assumedRank)
-      !ERROR: missing mandatory 'dim=' argument
+      !ERROR: A dim= argument is required for 'ubound' when the array is assumed-size
       print *, ubound(assumedRank)
       !ERROR: The 'source=' argument to the intrinsic function 'shape' may not be assumed-size
       print *, shape(assumedRank)
diff --git a/flang/test/Semantics/reduce01.f90 b/flang/test/Semantics/reduce01.f90
index 8c5a46312ec0a..ad63a42d73cae 100644
--- a/flang/test/Semantics/reduce01.f90
+++ b/flang/test/Semantics/reduce01.f90
@@ -5,6 +5,10 @@ module m
     character(len=len) :: ch
   end type
  contains
+  pure real function f(x,y)
+    real, intent(in) :: x, y
+    f = x + y
+  end function
   impure real function f1(x,y)
     f1 = x + y
   end function
@@ -47,10 +51,20 @@ pure real function f9(x,y)
     real, intent(in) :: y
     f9 = x + y
   end function
-  pure real function f10(x,y)
+  pure real function f10a(x,y)
+    real, intent(in), asynchronous :: x
+    real, intent(in) :: y
+    f10a = x + y
+  end function
+  pure real function f10b(x,y)
     real, intent(in), target :: x
     real, intent(in) :: y
-    f10 = x + y
+    f10b = x + y
+  end function
+  pure real function f10c(x,y)
+    real, intent(in), value :: x
+    real, intent(in) :: y
+    f10c = x + y
   end function
   pure function f11(x,y) result(res)
     type(pdt(*)), intent(in) :: x, y
@@ -59,7 +73,7 @@ pure function f11(x,y) result(res)
   end function
 
   subroutine errors
-    real :: a(10,10), b
+    real :: a(10,10), b, c(10)
     !ERROR: OPERATION= argument of REDUCE() must be a pure function of two data arguments
     b = reduce(a, f1)
     !ERROR: OPERATION= argument of REDUCE() must be a scalar function
@@ -78,8 +92,29 @@ subroutine errors
     b = reduce(a, f8)
     !ERROR: Arguments of OPERATION= procedure of REDUCE() must be both scalar of the same type as ARRAY=, and neither allocatable, pointer, polymorphic, nor optional
     b = reduce(a, f9)
-    !ERROR: If either argument of the OPERATION= procedure of REDUCE() has the ASYNCHRONOUS, VOLATILE, or TARGET attribute, both must have that attribute
-    b = reduce(a, f10)
+    !ERROR: If either argument of the OPERATION= procedure of REDUCE() has the ASYNCHRONOUS, TARGET, or VALUE attribute, both must have that attribute
+    b = reduce(a, f10a)
+    !ERROR: If either argument of the OPERATION= procedure of REDUCE() has the ASYNCHRONOUS, TARGET, or VALUE attribute, both must have that attribute
+    b = reduce(a, f10b)
+    !ERROR: If either argument of the OPERATION= procedure of REDUCE() has the ASYNCHRONOUS, TARGET, or VALUE attribute, both must have that attribute
+    b = reduce(a, f10c)
+    !ERROR: IDENTITY= must be present when the array is empty and the result is scalar
+    b = reduce(a(1:0,:), f)
+    !ERROR: IDENTITY= must be present when the array is empty and the result is scalar
+    b = reduce(a(1:0, 1), f, dim=1)
+    !ERROR: IDENTITY= must be present when DIM=1 and the array has zero extent on that dimension
+    c = reduce(a(1:0, :), f, dim=1)
+    !ERROR: IDENTITY= must be present when DIM=1 and the array has zero extent on that dimension
+    c = reduce(a(1:0, :), f, dim=1)
+    !ERROR: IDENTITY= must be present when DIM=2 and the array has zero extent on that dimension
+    c = reduce(a(:, 1:0), f, dim=2)
+    c(1:0) = reduce(a(1:0, 1:0), f, dim=1) ! ok, result is empty
+    c(1:0) = reduce(a(1:0, 1:0), f, dim=2) ! ok, result is empty
+    !ERROR: MASK= has no .TRUE. element, so IDENTITY= must be present
+    b = reduce(a, f, .false.)
+    !ERROR: MASK= has no .TRUE. element, so IDENTITY= must be present
+    b = reduce(a, f, reshape([(j > 100, j=1, 100)], shape(a)))
+    b = reduce(a, f, reshape([(j == 50, j=1, 100)], shape(a))) ! ok
   end subroutine
   subroutine not_errors
     type(pdt(10)) :: a(10), b