diff --git a/flang/docs/Intrinsics.md b/flang/docs/Intrinsics.md
--- a/flang/docs/Intrinsics.md
+++ b/flang/docs/Intrinsics.md
@@ -752,7 +752,6 @@
 | Non-standard intrinsic functions | AND, OR, XOR, SHIFT, ZEXT, IZEXT, COSD, SIND, TAND, ACOSD, ASIND, ATAND, ATAN2D, COMPL, EQV, NEQV, INT8, JINT, JNINT, KNINT, QCMPLX, DREAL, DFLOAT, QEXT, QFLOAT, QREAL, DNUM, NUM, JNUM, KNUM, QNUM, RNUM, RAN, RANF, ILEN, SIZEOF, MCLOCK, SECNDS, COTAN, IBCHNG, ISHA, ISHC, ISHL, IXOR, IARG, IARGC, NARGS, NUMARG, BADDRESS, IADDR, CACHESIZE, EOF, FP_CLASS, INT_PTR_KIND, ISNAN, MALLOC |
 | Intrinsic subroutines |MVBITS (elemental), CPU_TIME, DATE_AND_TIME, EVENT_QUERY, EXECUTE_COMMAND_LINE, GET_COMMAND, GET_COMMAND_ARGUMENT, GET_ENVIRONMENT_VARIABLE, MOVE_ALLOC, RANDOM_INIT, RANDOM_NUMBER, RANDOM_SEED, SYSTEM_CLOCK |
 | Atomic intrinsic subroutines | ATOMIC_ADD |
-| Collective intrinsic subroutines | CO_REDUCE |
 
 
 ### Intrinsic Function Folding
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -1276,6 +1276,18 @@
             {"errmsg", DefaultChar, Rank::scalar, Optionality::optional,
                 common::Intent::InOut}},
         {}, Rank::elemental, IntrinsicClass::collectiveSubroutine},
+    {"co_reduce",
+        {{"a", SameType, Rank::anyOrAssumedRank, Optionality::required,
+             common::Intent::InOut},
+            {"operation", SameType, Rank::reduceOperation,
+                Optionality::required, common::Intent::In},
+            {"result_image", AnyInt, Rank::scalar, Optionality::optional,
+                common::Intent::In},
+            {"stat", AnyInt, Rank::scalar, Optionality::optional,
+                common::Intent::Out},
+            {"errmsg", DefaultChar, Rank::scalar, Optionality::optional,
+                common::Intent::InOut}},
+        {}, Rank::elemental, IntrinsicClass::collectiveSubroutine},
     {"co_sum",
         {{"a", AnyNumeric, Rank::anyOrAssumedRank, Optionality::required,
              common::Intent::InOut},
@@ -1388,7 +1400,6 @@
 
 // TODO: Intrinsic subroutine EVENT_QUERY
 // TODO: Atomic intrinsic subroutines: ATOMIC_ADD
-// TODO: Collective intrinsic subroutines: co_reduce
 
 // Finds a built-in derived type and returns it as a DynamicType.
 static DynamicType GetBuiltinDerivedType(
@@ -2786,6 +2797,127 @@
       CheckForCoindexedObject(context, statArg, procName, "stat");
 }
 
+static bool CheckReduceAndCoReduce(
+    SpecificCall &call, FoldingContext &context) {
+  bool ok{true};
+  std::string name{call.specificIntrinsic.name};
+  const std::string argName{name == "reduce" ? "ARRAY" : "a"};
+  CHECK(name == "reduce" || name == "co_reduce");
+  if (name == "reduce") {
+    std::transform(name.begin(), name.end(), name.begin(), ::toupper);
+  }
+
+  std::optional<DynamicType> argType;
+  if (const auto &arg{call.arguments[0]}) {
+    argType = arg->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 (!argType || !procChars) {
+    ok = false; // error recovery
+  } else {
+    const auto *result{procChars->functionResult->GetTypeAndShape()};
+    const auto resultAttrs{procChars->functionResult->attrs};
+
+    if (name == "co_reduce") {
+      if (resultAttrs.test(
+              characteristics::FunctionResult::Attr::Allocatable)) {
+        ok = false;
+        context.messages().Say(at,
+            "Result of OPERATION= procedure of %s() must not be allocatable"_err_en_US,
+            name);
+      } else if (resultAttrs.test(
+                     characteristics::FunctionResult::Attr::Pointer)) {
+        ok = false;
+        context.messages().Say(at,
+            "Result of OPERATION= procedure of %s() must not be a pointer"_err_en_US,
+            name);
+      }
+    }
+
+    if (ok) {
+      if (!procChars->IsPure() || procChars->dummyArguments.size() != 2 ||
+          !procChars->functionResult) {
+        ok = false;
+        context.messages().Say(at,
+            "OPERATION= argument of %s() must be a pure function of two data arguments"_err_en_US,
+            name);
+      } else if (!result || result->Rank() != 0) {
+        ok = false;
+        context.messages().Say(at,
+            "OPERATION= argument of %s() must be a scalar function"_err_en_US,
+            name);
+      } else if (result->type().IsPolymorphic() ||
+          !argType->IsTkLenCompatibleWith(result->type())) {
+        ok = false;
+        context.messages().Say(at,
+            "OPERATION= argument of %s() must have the same type as %s="_err_en_US,
+            name, argName);
+      } 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 %s() may not have dummy procedure arguments"_err_en_US,
+              name);
+        } 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(*argType);
+          }
+          if (!ok) {
+            context.messages().Say(at,
+                "Arguments of OPERATION= procedure of %s() must be both scalar of the same type as %s=, and neither allocatable, pointer, polymorphic, or optional"_err_en_US,
+                name, argName);
+          } 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::Value) !=
+                  data[1]->attrs.test(
+                      characteristics::DummyDataObject::Attr::Value) ||
+              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 %s() has the ASYNCHRONOUS, VALUE, or TARGET attribute, both must have that attribute"_err_en_US,
+                name);
+          }
+        }
+      }
+    }
+  }
+  return ok;
+}
+
 // 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.
@@ -2822,12 +2954,24 @@
         context, call.arguments[1], call.arguments[0], call.arguments[2], name);
   } else if (name == "co_broadcast" || name == "co_max" || name == "co_min" ||
       name == "co_sum") {
-    bool aOk{CheckForCoindexedObject(context, call.arguments[0], name, "a")};
-    bool statOk{
-        CheckForCoindexedObject(context, call.arguments[2], name, "stat")};
-    bool errmsgOk{
-        CheckForCoindexedObject(context, call.arguments[3], name, "errmsg")};
-    ok = aOk && statOk && errmsgOk;
+    ok &= CheckForCoindexedObject(context, call.arguments[0], name, "a");
+    ok &= CheckForCoindexedObject(context, call.arguments[2], name, "stat");
+    ok &= CheckForCoindexedObject(context, call.arguments[3], name, "errmsg");
+  } else if (name == "co_reduce") {
+    const auto &aArg{call.arguments[0]};
+
+    if (aArg->UnwrapExpr()->GetType()->IsPolymorphic()) {
+      ok = false;
+      context.messages().Say(aArg->sourceLocation(),
+          "'a=' argument for intrinsic '%s' must not be polymorphic"_err_en_US,
+          name);
+    } else {
+      ok = CheckReduceAndCoReduce(call, context);
+    }
+
+    ok &= CheckForCoindexedObject(context, call.arguments[0], name, "a");
+    ok &= CheckForCoindexedObject(context, call.arguments[3], name, "stat");
+    ok &= CheckForCoindexedObject(context, call.arguments[4], name, "errmsg");
   } else if (name == "image_status") {
     if (const auto &arg{call.arguments[0]}) {
       ok = CheckForNonPositiveValues(context, *arg, name, "image");
@@ -2881,89 +3025,7 @@
           "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, or 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);
-          }
-        }
-      }
-    }
+    return CheckReduceAndCoReduce(call, context);
   } else if (name == "ucobound") {
     return CheckDimAgainstCorank(call, context);
   }
diff --git a/flang/test/Semantics/collectives05.f90 b/flang/test/Semantics/collectives05.f90
--- a/flang/test/Semantics/collectives05.f90
+++ b/flang/test/Semantics/collectives05.f90
@@ -1,8 +1,6 @@
 ! RUN: %python %S/test_errors.py %s %flang_fc1
-! XFAIL: *
 ! This test checks for semantic errors in co_reduce subroutine calls based on
 ! the co_reduce interface defined in section 16.9.49 of the Fortran 2018 standard.
-! To Do: add co_reduce to the list of intrinsics
 
 module foo_m
   implicit none
@@ -25,16 +23,16 @@
 end module foo_m
 
 program main
-  use foo_m, only : foo_t
+  use foo_m, only : foo_t, derived_type_op
   implicit none
 
   type(foo_t) foo
   class(foo_t), allocatable :: polymorphic
-  integer i, status, integer_array(1)
+  integer i, status, integer_array(1), repeated_status
   real x
   real vector(1)
   real array(1,1,1, 1,1,1, 1,1,1, 1,1,1, 1,1,1)
-  character(len=1) string, message, character_array(1)
+  character(len=1) string, message, character_array(1), coindexed_string[*], repeated_message
   integer coindexed[*]
   logical bool
 
@@ -53,6 +51,9 @@
   call co_reduce(foo,    operation=left,    result_image=1, stat=status, errmsg=message)
 
   call co_reduce(result_image=1, operation=left,     a=foo, errmsg=message, stat=status)
+  call co_reduce(i, value_match)
+  call co_reduce(i, target_match)
+  call co_reduce(i, asynchronous_match)
 
   allocate(foo_t :: polymorphic)
 
@@ -62,126 +63,142 @@
   ! executes in a single image might be standard-conforming even if the same code
   ! executing in multiple images is not.
 
-  ! argument 'a' cannot be polymorphic
-  !ERROR: to be determined
+  !ERROR: 'a=' argument for intrinsic 'co_reduce' must not be polymorphic
   call co_reduce(polymorphic, derived_type_op)
 
-  ! argument 'a' cannot be coindexed
-  !ERROR: (message to be determined)
+  !ERROR: 'a' argument to 'co_reduce' may not be a coindexed object
   call co_reduce(coindexed[1], int_op)
 
-  ! argument 'a' is intent(inout)
-  !ERROR: (message to be determined)
+  !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'a=' is not definable
+  !ERROR: 'i+1_4' is not a variable or pointer
   call co_reduce(i + 1, int_op)
 
-  ! operation must be a pure function
-  !ERROR: (message to be determined)
+  !ERROR: OPERATION= argument of co_reduce() must be a pure function of two data arguments
   call co_reduce(i, operation=not_pure)
 
-  ! operation must have exactly two arguments
-  !ERROR: (message to be determined)
+  !ERROR: OPERATION= argument of co_reduce() must be a pure function of two data arguments
   call co_reduce(i, too_many_args)
 
-  ! operation result must be a scalar
-  !ERROR: (message to be determined)
+  !ERROR: OPERATION= argument of co_reduce() must be a scalar function
   call co_reduce(i, array_result)
 
-  ! operation result must be non-allocatable
-  !ERROR: (message to be determined)
+  !ERROR: Result of OPERATION= procedure of co_reduce() must not be allocatable
   call co_reduce(i, allocatable_result)
 
-  ! operation result must be non-pointer
-  !ERROR: (message to be determined)
+  !ERROR: Result of OPERATION= procedure of co_reduce() must not be a pointer
   call co_reduce(i, pointer_result)
 
-  ! operation's arguments must be scalars
-  !ERROR: (message to be determined)
+  !ERROR: Arguments of OPERATION= procedure of co_reduce() must be both scalar of the same type as a=, and neither allocatable, pointer, polymorphic, or optional
   call co_reduce(i, array_args)
 
-  ! operation arguments must be non-allocatable
-  !ERROR: (message to be determined)
+  !ERROR: Arguments of OPERATION= procedure of co_reduce() must be both scalar of the same type as a=, and neither allocatable, pointer, polymorphic, or optional
   call co_reduce(i, allocatable_args)
 
-  ! operation arguments must be non-pointer
-  !ERROR: (message to be determined)
+  !ERROR: Arguments of OPERATION= procedure of co_reduce() must be both scalar of the same type as a=, and neither allocatable, pointer, polymorphic, or optional
   call co_reduce(i, pointer_args)
 
-  ! operation arguments must be non-polymorphic
-  !ERROR: (message to be determined)
+  !ERROR: OPERATION= argument of co_reduce() must have the same type as a=
   call co_reduce(i, polymorphic_args)
 
-  ! operation: type of 'operation' result and arguments must match type of argument 'a'
-  !ERROR: (message to be determined)
+  !ERROR: OPERATION= argument of co_reduce() must have the same type as a=
   call co_reduce(i, real_op)
 
   ! operation: kind type parameter of 'operation' result and arguments must match kind type parameter of argument 'a'
-  !ERROR: (message to be determined)
+  !ERROR: OPERATION= argument of co_reduce() must have the same type as a=
   call co_reduce(x, double_precision_op)
 
-  ! arguments must be non-optional
-  !ERROR: (message to be determined)
+  !ERROR: Arguments of OPERATION= procedure of co_reduce() must be both scalar of the same type as a=, and neither allocatable, pointer, polymorphic, or optional
   call co_reduce(i, optional_args)
 
-  ! if one argument is asynchronous, the other must be also
-  !ERROR: (message to be determined)
+  !ERROR: If either argument of the OPERATION= procedure of co_reduce() has the ASYNCHRONOUS, VALUE, or TARGET attribute, both must have that attribute
   call co_reduce(i, asynchronous_mismatch)
 
-  ! if one argument is a target, the other must be also
-  !ERROR: (message to be determined)
+  !ERROR: If either argument of the OPERATION= procedure of co_reduce() has the ASYNCHRONOUS, VALUE, or TARGET attribute, both must have that attribute
   call co_reduce(i, target_mismatch)
 
-  ! if one argument has the value attribute, the other must have it also
-  !ERROR: (message to be determined)
+  !ERROR: If either argument of the OPERATION= procedure of co_reduce() has the ASYNCHRONOUS, VALUE, or TARGET attribute, both must have that attribute
   call co_reduce(i, value_mismatch)
 
-  ! result_image argument must be an integer scalar
-  !ERROR: to be determined
+  !ERROR: 'result_image=' argument has unacceptable rank 1
   call co_reduce(i, int_op, result_image=integer_array)
 
-  ! result_image argument must be an integer
-  !ERROR: to be determined
+  !ERROR: Actual argument for 'result_image=' has bad type 'LOGICAL(4)'
   call co_reduce(i, int_op, result_image=bool)
 
-  ! stat not allowed to be coindexed
-  !ERROR: to be determined
+  !ERROR: 'stat' argument to 'co_reduce' may not be a coindexed object
   call co_reduce(i, int_op, stat=coindexed[1])
 
-  ! stat argument must be an integer scalar
-  !ERROR: to be determined
+  !ERROR: 'stat=' argument has unacceptable rank 1
   call co_reduce(i, int_op, result_image=1, stat=integer_array)
 
-  ! stat argument has incorrect type
   !ERROR: Actual argument for 'stat=' has bad type 'CHARACTER(KIND=1,LEN=1_8)'
-  call co_reduce(i, int_op, result_image=1, string)
+  call co_reduce(i, int_op, result_image=1, stat=string)
 
-  ! stat argument is intent(out)
-  !ERROR: to be determined
+  !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'stat=' is not definable
+  !ERROR: '2_4' is not a variable or pointer
   call co_reduce(i, int_op, result_image=1, stat=1+1)
 
-  ! errmsg argument must not be coindexed
-  !ERROR: to be determined
-  call co_reduce(i, int_op, result_image=1, stat=status, errmsg=conindexed_string[1])
+  !ERROR: 'errmsg' argument to 'co_reduce' may not be a coindexed object
+  call co_reduce(i, int_op, result_image=1, stat=status, errmsg=coindexed_string[1])
 
-  ! errmsg argument must be a character scalar
-  !ERROR: to be determined
+  !ERROR: 'errmsg=' argument has unacceptable rank 1
   call co_reduce(i, int_op, result_image=1, stat=status, errmsg=character_array)
 
-  ! errmsg argument must be a character
-  !ERROR: to be determined
+  !ERROR: Actual argument for 'errmsg=' has bad type 'INTEGER(4)'
   call co_reduce(i, int_op, result_image=1, stat=status, errmsg=i)
 
-  ! errmsg argument is intent(inout)
-  !ERROR: to be determined
+  !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'errmsg=' is not definable
+  !ERROR: '"literal constant"' is not a variable or pointer
   call co_reduce(i, int_op, result_image=1, stat=status, errmsg="literal constant")
 
-  ! too many arguments to the co_reduce() call
   !ERROR: too many actual arguments for intrinsic 'co_reduce'
-  call co_reduce(i, int_op, result_image=1, stat=status, errmsg=message, 3.4)
+  call co_reduce(i, int_op, 1, status, message, 3.4)
+
+  !ERROR: actual argument #5 without a keyword may not follow an actual argument with a keyword
+  call co_reduce(i, int_op, result_image=1, stat=status, message)
 
-  ! non-existent keyword argument
   !ERROR: unknown keyword argument to intrinsic 'co_reduce'
   call co_reduce(fake=3.4)
 
+  !ERROR: missing mandatory 'a=' argument
+  call co_reduce()
+
+  !ERROR: missing mandatory 'a=' argument
+  call co_reduce(operation=int_op)
+
+  !ERROR: missing mandatory 'operation=' argument
+  call co_reduce(i)
+
+  !ERROR: repeated keyword argument to intrinsic 'co_reduce'
+  call co_reduce(a=i, a=i, operation=int_op)
+
+  !ERROR: repeated keyword argument to intrinsic 'co_reduce'
+  call co_reduce(i, operation=int_op, operation=repeated_int_op)
+
+  !ERROR: repeated keyword argument to intrinsic 'co_reduce'
+  call co_reduce(i, int_op, result_image=1, result_image=2)
+
+  !ERROR: repeated keyword argument to intrinsic 'co_reduce'
+  call co_reduce(stat=status, a=i, operation=int_op, result_image=1, stat=repeated_status)
+
+  !ERROR: repeated keyword argument to intrinsic 'co_reduce'
+  call co_reduce(i, int_op, 1, errmsg=message, errmsg=repeated_message)
+
+  !ERROR: keyword argument to intrinsic 'co_reduce' was supplied positionally by an earlier actual argument
+  call co_reduce(i, int_op, a=i)
+
+  !ERROR: keyword argument to intrinsic 'co_reduce' was supplied positionally by an earlier actual argument
+  call co_reduce(i, int_op, operation=repeated_int_op)
+
+  !ERROR: keyword argument to intrinsic 'co_reduce' was supplied positionally by an earlier actual argument
+  call co_reduce(i, int_op, 1, result_image=2)
+
+  !ERROR: keyword argument to intrinsic 'co_reduce' was supplied positionally by an earlier actual argument
+  call co_reduce(i, int_op, 1, status, stat=repeated_status)
+
+  !ERROR: keyword argument to intrinsic 'co_reduce' was supplied positionally by an earlier actual argument
+  call co_reduce(i, int_op, 1, status, message, errmsg=repeated_message)
+
 contains
 
   pure function left(lhs, rhs) result(lhs_op_rhs)
@@ -215,6 +232,12 @@
     lhs_op_rhs = lhs + rhs
   end function
 
+  pure function repeated_int_op(lhs, rhs) result(lhs_op_rhs)
+    integer, intent(in) :: lhs, rhs
+    integer :: lhs_op_rhs
+    lhs_op_rhs = lhs + rhs
+  end function
+
   function not_pure(lhs, rhs) result(lhs_op_rhs)
     integer, intent(in) :: lhs, rhs
     integer :: lhs_op_rhs
@@ -286,6 +309,12 @@
     lhs_op_rhs = lhs + rhs
   end function
 
+  pure function target_match(lhs, rhs) result(lhs_op_rhs)
+    integer, intent(in), target :: lhs, rhs
+    integer lhs_op_rhs
+    lhs_op_rhs = lhs + rhs
+  end function
+
   pure function value_mismatch(lhs, rhs) result(lhs_op_rhs)
     integer, intent(in), value:: lhs
     integer, intent(in) :: rhs
@@ -293,6 +322,12 @@
     lhs_op_rhs = lhs + rhs
   end function
 
+  pure function value_match(lhs, rhs) result(lhs_op_rhs)
+    integer, intent(in), value :: lhs, rhs
+    integer lhs_op_rhs
+    lhs_op_rhs = lhs + rhs
+  end function
+
   pure function asynchronous_mismatch(lhs, rhs) result(lhs_op_rhs)
     integer, intent(in), asynchronous:: lhs
     integer, intent(in) :: rhs
@@ -300,4 +335,10 @@
     lhs_op_rhs = lhs + rhs
   end function
 
+  pure function asynchronous_match(lhs, rhs) result(lhs_op_rhs)
+    integer, intent(in), asynchronous :: lhs, rhs
+    integer lhs_op_rhs
+    lhs_op_rhs = lhs + rhs
+  end function
+
 end program
diff --git a/flang/test/Semantics/reduce01.f90 b/flang/test/Semantics/reduce01.f90
--- a/flang/test/Semantics/reduce01.f90
+++ b/flang/test/Semantics/reduce01.f90
@@ -1,5 +1,6 @@
 ! RUN: %python %S/test_errors.py %s %flang_fc1
 module m
+  use iso_fortran_env, only: REAL128
   type :: pdt(len)
     integer, len :: len
     character(len=len) :: ch
@@ -28,35 +29,68 @@
     real, intent(in) :: x, y
     f5 = x + y
   end function
-  pure real function f6(x,y)
-    real, intent(in) :: x(*), y(*)
-    f6 = x(1) + y(1)
+  pure real(kind=REAL128) function f6(x,y)
+    real(kind=REAL128), intent(in) :: x, y
+    f6 = x + y
   end function
   pure real function f7(x,y)
-    real, intent(in), allocatable :: x
-    real, intent(in) :: y
+    real(kind=REAL128), intent(in) :: x, y
     f7 = x + y
   end function
   pure real function f8(x,y)
-    real, intent(in), pointer :: x
-    real, intent(in) :: y
-    f8 = x + y
+    real, intent(in) :: x(*), y(*)
+    f8 = x(1) + y(1)
   end function
   pure real function f9(x,y)
-    real, intent(in), optional :: x
+    real, intent(in), allocatable :: x
     real, intent(in) :: y
     f9 = x + y
   end function
   pure real function f10(x,y)
-    real, intent(in), target :: x
+    real, intent(in), pointer :: x
     real, intent(in) :: y
     f10 = x + y
   end function
-  pure function f11(x,y) result(res)
+  pure real function f11(x,y)
+    real, intent(in), optional :: x
+    real, intent(in) :: y
+    f11 = x + y
+  end function
+  pure real function f12(x,y)
+    real, intent(in), target :: x
+    real, intent(in) :: y
+    f12 = x + y
+  end function
+  pure real function f13(x,y)
+    real, intent(in), value :: x
+    real, intent(in) :: y
+    f13 = x + y
+  end function
+  pure real function f14(x,y)
+    real, intent(in), asynchronous :: x
+    real, intent(in) :: y
+    f14 = x + y
+  end function
+  pure function f15(x,y) result(res)
     type(pdt(*)), intent(in) :: x, y
     type(pdt(max(x%len, y%len))) :: res
     res%ch = x%ch // y%ch
   end function
+  pure real function f16(x,y)
+    real, intent(in), value :: x
+    real, intent(in), value :: y
+    f16 = x + y
+  end function
+  pure real function f17(x,y)
+    real, intent(in), asynchronous :: x
+    real, intent(in), asynchronous :: y
+    f17 = x + y
+  end function
+  pure real function f18(x,y)
+    real, intent(in), target :: x
+    real, intent(in), target :: y
+    f18 = x + y
+  end function
 
   subroutine errors
     real :: a(10,10), b
@@ -70,7 +104,7 @@
     b = reduce(a, f4)
     !ERROR: OPERATION= argument of REDUCE() must have the same type as ARRAY=
     b = reduce(a, f5)
-    !ERROR: Arguments of OPERATION= procedure of REDUCE() must be both scalar of the same type as ARRAY=, and neither allocatable, pointer, polymorphic, or optional
+    !ERROR: OPERATION= argument of REDUCE() must have the same type as ARRAY=
     b = reduce(a, f6)
     !ERROR: Arguments of OPERATION= procedure of REDUCE() must be both scalar of the same type as ARRAY=, and neither allocatable, pointer, polymorphic, or optional
     b = reduce(a, f7)
@@ -78,11 +112,23 @@
     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, or 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
+    !ERROR: Arguments of OPERATION= procedure of REDUCE() must be both scalar of the same type as ARRAY=, and neither allocatable, pointer, polymorphic, or optional
     b = reduce(a, f10)
+    !ERROR: Arguments of OPERATION= procedure of REDUCE() must be both scalar of the same type as ARRAY=, and neither allocatable, pointer, polymorphic, or optional
+    b = reduce(a, f11)
+    !ERROR: If either argument of the OPERATION= procedure of REDUCE() has the ASYNCHRONOUS, VALUE, or TARGET attribute, both must have that attribute
+    b = reduce(a, f12)
+    !ERROR: If either argument of the OPERATION= procedure of REDUCE() has the ASYNCHRONOUS, VALUE, or TARGET attribute, both must have that attribute
+    b = reduce(a, f13)
+    !ERROR: If either argument of the OPERATION= procedure of REDUCE() has the ASYNCHRONOUS, VALUE, or TARGET attribute, both must have that attribute
+    b = reduce(a, f14)
   end subroutine
   subroutine not_errors
     type(pdt(10)) :: a(10), b
-    b = reduce(a, f11) ! check no bogus type incompatibility diagnostic
+    real :: c(10,10), d
+    b = reduce(a, f15) ! check no bogus type incompatibility diagnostic
+    d = reduce(c, f16)
+    d = reduce(c, f17)
+    d = reduce(c, f18)
   end subroutine
 end module