diff --git a/flang/include/flang/Evaluate/characteristics.h b/flang/include/flang/Evaluate/characteristics.h
index 8f87868441b02..932f3220c2bcb 100644
--- a/flang/include/flang/Evaluate/characteristics.h
+++ b/flang/include/flang/Evaluate/characteristics.h
@@ -81,23 +81,24 @@ class TypeAndShape {
   bool operator!=(const TypeAndShape &that) const { return !(*this == that); }
 
   static std::optional<TypeAndShape> Characterize(
-      const semantics::Symbol &, FoldingContext &);
+      const semantics::Symbol &, FoldingContext &, bool invariantOnly = false);
   static std::optional<TypeAndShape> Characterize(
-      const semantics::DeclTypeSpec &, FoldingContext &);
+      const semantics::DeclTypeSpec &, FoldingContext &,
+      bool invariantOnly = false);
   static std::optional<TypeAndShape> Characterize(
-      const ActualArgument &, FoldingContext &);
+      const ActualArgument &, FoldingContext &, bool invariantOnly = false);
 
   // General case for Expr<T>, ActualArgument, &c.
   template <typename A>
   static std::optional<TypeAndShape> Characterize(
-      const A &x, FoldingContext &context) {
+      const A &x, FoldingContext &context, bool invariantOnly = false) {
     if (const auto *symbol{UnwrapWholeSymbolOrComponentDataRef(x)}) {
-      if (auto result{Characterize(*symbol, context)}) {
+      if (auto result{Characterize(*symbol, context, invariantOnly)}) {
         return result;
       }
     }
     if (auto type{x.GetType()}) {
-      TypeAndShape result{*type, GetShape(context, x)};
+      TypeAndShape result{*type, GetShape(context, x, invariantOnly)};
       if (type->category() == TypeCategory::Character) {
         if (const auto *chExpr{UnwrapExpr<Expr<SomeCharacter>>(x)}) {
           if (auto length{chExpr->LEN()}) {
@@ -114,14 +115,14 @@ class TypeAndShape {
   template <int KIND>
   static std::optional<TypeAndShape> Characterize(
       const Designator<Type<TypeCategory::Character, KIND>> &x,
-      FoldingContext &context) {
+      FoldingContext &context, bool invariantOnly = true) {
     if (const auto *symbol{UnwrapWholeSymbolOrComponentDataRef(x)}) {
-      if (auto result{Characterize(*symbol, context)}) {
+      if (auto result{Characterize(*symbol, context, invariantOnly)}) {
         return result;
       }
     }
     if (auto type{x.GetType()}) {
-      TypeAndShape result{*type, GetShape(context, x)};
+      TypeAndShape result{*type, GetShape(context, x, invariantOnly)};
       if (auto length{x.LEN()}) {
         result.set_LEN(std::move(*length));
       }
@@ -131,19 +132,19 @@ class TypeAndShape {
   }
 
   template <typename A>
-  static std::optional<TypeAndShape> Characterize(
-      const std::optional<A> &x, FoldingContext &context) {
+  static std::optional<TypeAndShape> Characterize(const std::optional<A> &x,
+      FoldingContext &context, bool invariantOnly = false) {
     if (x) {
-      return Characterize(*x, context);
+      return Characterize(*x, context, invariantOnly);
     } else {
       return std::nullopt;
     }
   }
   template <typename A>
   static std::optional<TypeAndShape> Characterize(
-      A *ptr, FoldingContext &context) {
+      A *ptr, FoldingContext &context, bool invariantOnly = false) {
     if (ptr) {
-      return Characterize(std::as_const(*ptr), context);
+      return Characterize(std::as_const(*ptr), context, invariantOnly);
     } else {
       return std::nullopt;
     }
@@ -181,7 +182,8 @@ class TypeAndShape {
 
 private:
   static std::optional<TypeAndShape> Characterize(
-      const semantics::AssocEntityDetails &, FoldingContext &);
+      const semantics::AssocEntityDetails &, FoldingContext &,
+      bool invariantOnly = true);
   static std::optional<TypeAndShape> Characterize(
       const semantics::ProcEntityDetails &, FoldingContext &);
   void AcquireAttrs(const semantics::Symbol &);
diff --git a/flang/include/flang/Evaluate/shape.h b/flang/include/flang/Evaluate/shape.h
index dce24b7cb052b..5acc7f13d27da 100644
--- a/flang/include/flang/Evaluate/shape.h
+++ b/flang/include/flang/Evaluate/shape.h
@@ -54,9 +54,14 @@ inline int GetRank(const Shape &s) { return static_cast<int>(s.size()); }
 Shape Fold(FoldingContext &, Shape &&);
 std::optional<Shape> Fold(FoldingContext &, std::optional<Shape> &&);
 
+// Computes shapes in terms of expressions that are scope-invariant, by
+// default, which is nearly always what one wants outside of procedure
+// characterization.
 template <typename A>
-std::optional<Shape> GetShape(FoldingContext &, const A &);
-template <typename A> std::optional<Shape> GetShape(const A &);
+std::optional<Shape> GetShape(
+    FoldingContext &, const A &, bool invariantOnly = true);
+template <typename A>
+std::optional<Shape> GetShape(const A &, bool invariantOnly = true);
 
 // The dimension argument to these inquiries is zero-based,
 // unlike the DIM= arguments to many intrinsics.
@@ -68,31 +73,42 @@ template <typename A> std::optional<Shape> GetShape(const A &);
 // in those circumstances.
 // Similarly, GetUBOUND result will be forced to 0 on an empty dimension,
 // but will fail if the extent is not a compile time constant.
-ExtentExpr GetRawLowerBound(const NamedEntity &, int dimension);
 ExtentExpr GetRawLowerBound(
-    FoldingContext &, const NamedEntity &, int dimension);
-MaybeExtentExpr GetLBOUND(const NamedEntity &, int dimension);
-MaybeExtentExpr GetLBOUND(FoldingContext &, const NamedEntity &, int dimension);
-MaybeExtentExpr GetRawUpperBound(const NamedEntity &, int dimension);
+    const NamedEntity &, int dimension, bool invariantOnly = true);
+ExtentExpr GetRawLowerBound(FoldingContext &, const NamedEntity &,
+    int dimension, bool invariantOnly = true);
+MaybeExtentExpr GetLBOUND(
+    const NamedEntity &, int dimension, bool invariantOnly = true);
+MaybeExtentExpr GetLBOUND(FoldingContext &, const NamedEntity &, int dimension,
+    bool invariantOnly = true);
 MaybeExtentExpr GetRawUpperBound(
-    FoldingContext &, const NamedEntity &, int dimension);
-MaybeExtentExpr GetUBOUND(const NamedEntity &, int dimension);
-MaybeExtentExpr GetUBOUND(FoldingContext &, const NamedEntity &, int dimension);
+    const NamedEntity &, int dimension, bool invariantOnly = true);
+MaybeExtentExpr GetRawUpperBound(FoldingContext &, const NamedEntity &,
+    int dimension, bool invariantOnly = true);
+MaybeExtentExpr GetUBOUND(
+    const NamedEntity &, int dimension, bool invariantOnly = true);
+MaybeExtentExpr GetUBOUND(FoldingContext &, const NamedEntity &, int dimension,
+    bool invariantOnly = true);
 MaybeExtentExpr ComputeUpperBound(ExtentExpr &&lower, MaybeExtentExpr &&extent);
 MaybeExtentExpr ComputeUpperBound(
     FoldingContext &, ExtentExpr &&lower, MaybeExtentExpr &&extent);
-Shape GetRawLowerBounds(const NamedEntity &);
-Shape GetRawLowerBounds(FoldingContext &, const NamedEntity &);
-Shape GetLBOUNDs(const NamedEntity &);
-Shape GetLBOUNDs(FoldingContext &, const NamedEntity &);
-Shape GetUBOUNDs(const NamedEntity &);
-Shape GetUBOUNDs(FoldingContext &, const NamedEntity &);
-MaybeExtentExpr GetExtent(const NamedEntity &, int dimension);
-MaybeExtentExpr GetExtent(FoldingContext &, const NamedEntity &, int dimension);
-MaybeExtentExpr GetExtent(
-    const Subscript &, const NamedEntity &, int dimension);
+Shape GetRawLowerBounds(const NamedEntity &, bool invariantOnly = true);
+Shape GetRawLowerBounds(
+    FoldingContext &, const NamedEntity &, bool invariantOnly = true);
+Shape GetLBOUNDs(const NamedEntity &, bool invariantOnly = true);
+Shape GetLBOUNDs(
+    FoldingContext &, const NamedEntity &, bool invariantOnly = true);
+Shape GetUBOUNDs(const NamedEntity &, bool invariantOnly = true);
+Shape GetUBOUNDs(
+    FoldingContext &, const NamedEntity &, bool invariantOnly = true);
 MaybeExtentExpr GetExtent(
-    FoldingContext &, const Subscript &, const NamedEntity &, int dimension);
+    const NamedEntity &, int dimension, bool invariantOnly = true);
+MaybeExtentExpr GetExtent(FoldingContext &, const NamedEntity &, int dimension,
+    bool invariantOnly = true);
+MaybeExtentExpr GetExtent(const Subscript &, const NamedEntity &, int dimension,
+    bool invariantOnly = true);
+MaybeExtentExpr GetExtent(FoldingContext &, const Subscript &,
+    const NamedEntity &, int dimension, bool invariantOnly = true);
 
 // Compute an element count for a triplet or trip count for a DO.
 ExtentExpr CountTrips(
@@ -115,11 +131,14 @@ class GetShapeHelper
   using Result = std::optional<Shape>;
   using Base = AnyTraverse<GetShapeHelper, Result>;
   using Base::operator();
-  GetShapeHelper() : Base{*this} {}
-  explicit GetShapeHelper(FoldingContext &c) : Base{*this}, context_{&c} {}
-  explicit GetShapeHelper(FoldingContext &c, bool useResultSymbolShape)
-      : Base{*this}, context_{&c}, useResultSymbolShape_{useResultSymbolShape} {
-  }
+  explicit GetShapeHelper(bool invariantOnly)
+      : Base{*this}, invariantOnly_{invariantOnly} {}
+  explicit GetShapeHelper(FoldingContext &c, bool invariantOnly)
+      : Base{*this}, context_{&c}, invariantOnly_{invariantOnly} {}
+  explicit GetShapeHelper(
+      FoldingContext &c, bool useResultSymbolShape, bool invariantOnly)
+      : Base{*this}, context_{&c}, useResultSymbolShape_{useResultSymbolShape},
+        invariantOnly_{invariantOnly} {}
 
   Result operator()(const ImpliedDoIndex &) const { return ScalarShape(); }
   Result operator()(const DescriptorInquiry &) const { return ScalarShape(); }
@@ -160,7 +179,7 @@ class GetShapeHelper
   static Result ScalarShape() { return Shape{}; }
   static Shape ConstantShape(const Constant<ExtentType> &);
   Result AsShapeResult(ExtentExpr &&) const;
-  static Shape CreateShape(int rank, NamedEntity &);
+  Shape CreateShape(int rank, NamedEntity &) const;
 
   template <typename T>
   MaybeExtentExpr GetArrayConstructorValueExtent(
@@ -215,34 +234,40 @@ class GetShapeHelper
 
   FoldingContext *context_{nullptr};
   bool useResultSymbolShape_{true};
+  // When invariantOnly=false, the returned shape need not be invariant
+  // in its scope; in particular, it may contain references to dummy arguments.
+  bool invariantOnly_{true};
 };
 
 template <typename A>
-std::optional<Shape> GetShape(FoldingContext &context, const A &x) {
-  if (auto shape{GetShapeHelper{context}(x)}) {
+std::optional<Shape> GetShape(
+    FoldingContext &context, const A &x, bool invariantOnly) {
+  if (auto shape{GetShapeHelper{context, invariantOnly}(x)}) {
     return Fold(context, std::move(shape));
   } else {
     return std::nullopt;
   }
 }
 
-template <typename A> std::optional<Shape> GetShape(const A &x) {
-  return GetShapeHelper{}(x);
+template <typename A>
+std::optional<Shape> GetShape(const A &x, bool invariantOnly) {
+  return GetShapeHelper{invariantOnly}(x);
 }
 
 template <typename A>
-std::optional<Shape> GetShape(FoldingContext *context, const A &x) {
+std::optional<Shape> GetShape(
+    FoldingContext *context, const A &x, bool invariantOnly = true) {
   if (context) {
-    return GetShape(*context, x);
+    return GetShape(*context, x, invariantOnly);
   } else {
-    return GetShapeHelper{}(x);
+    return GetShapeHelper{invariantOnly}(x);
   }
 }
 
 template <typename A>
 std::optional<Constant<ExtentType>> GetConstantShape(
     FoldingContext &context, const A &x) {
-  if (auto shape{GetShape(context, x)}) {
+  if (auto shape{GetShape(context, x, /*invariantonly=*/true)}) {
     return AsConstantShape(context, *shape);
   } else {
     return std::nullopt;
@@ -252,7 +277,7 @@ std::optional<Constant<ExtentType>> GetConstantShape(
 template <typename A>
 std::optional<ConstantSubscripts> GetConstantExtents(
     FoldingContext &context, const A &x) {
-  if (auto shape{GetShape(context, x)}) {
+  if (auto shape{GetShape(context, x, /*invariantOnly=*/true)}) {
     return AsConstantExtents(context, *shape);
   } else {
     return std::nullopt;
@@ -265,7 +290,8 @@ std::optional<ConstantSubscripts> GetConstantExtents(
 // arguments).
 template <typename A>
 std::optional<Shape> GetContextFreeShape(FoldingContext &context, const A &x) {
-  return GetShapeHelper{context, false}(x);
+  return GetShapeHelper{
+      context, /*useResultSymbolShape=*/false, /*invariantOnly=*/true}(x);
 }
 
 // Compilation-time shape conformance checking, when corresponding extents
diff --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h
index 0a9e7ce87be38..b3f8f4a67a7b5 100644
--- a/flang/include/flang/Evaluate/tools.h
+++ b/flang/include/flang/Evaluate/tools.h
@@ -1184,6 +1184,7 @@ const Symbol *GetMainEntry(const Symbol *);
 bool IsVariableName(const Symbol &);
 bool IsPureProcedure(const Symbol &);
 bool IsPureProcedure(const Scope &);
+bool IsExplicitlyImpureProcedure(const Symbol &);
 bool IsElementalProcedure(const Symbol &);
 bool IsFunction(const Symbol &);
 bool IsFunction(const Scope &);
diff --git a/flang/lib/Evaluate/characteristics.cpp b/flang/lib/Evaluate/characteristics.cpp
index 694f6a1abf4cb..8d52eabc16d50 100644
--- a/flang/lib/Evaluate/characteristics.cpp
+++ b/flang/lib/Evaluate/characteristics.cpp
@@ -73,24 +73,26 @@ TypeAndShape &TypeAndShape::Rewrite(FoldingContext &context) {
 }
 
 std::optional<TypeAndShape> TypeAndShape::Characterize(
-    const semantics::Symbol &symbol, FoldingContext &context) {
+    const semantics::Symbol &symbol, FoldingContext &context,
+    bool invariantOnly) {
   const auto &ultimate{symbol.GetUltimate()};
   return common::visit(
       common::visitors{
           [&](const semantics::ProcEntityDetails &proc) {
             if (proc.procInterface()) {
-              return Characterize(*proc.procInterface(), context);
+              return Characterize(
+                  *proc.procInterface(), context, invariantOnly);
             } else if (proc.type()) {
-              return Characterize(*proc.type(), context);
+              return Characterize(*proc.type(), context, invariantOnly);
             } else {
               return std::optional<TypeAndShape>{};
             }
           },
           [&](const semantics::AssocEntityDetails &assoc) {
-            return Characterize(assoc, context);
+            return Characterize(assoc, context, invariantOnly);
           },
           [&](const semantics::ProcBindingDetails &binding) {
-            return Characterize(binding.symbol(), context);
+            return Characterize(binding.symbol(), context, invariantOnly);
           },
           [&](const auto &x) -> std::optional<TypeAndShape> {
             using Ty = std::decay_t<decltype(x)>;
@@ -99,8 +101,8 @@ std::optional<TypeAndShape> TypeAndShape::Characterize(
                 std::is_same_v<Ty, semantics::TypeParamDetails>) {
               if (const semantics::DeclTypeSpec * type{ultimate.GetType()}) {
                 if (auto dyType{DynamicType::From(*type)}) {
-                  TypeAndShape result{
-                      std::move(*dyType), GetShape(context, ultimate)};
+                  TypeAndShape result{std::move(*dyType),
+                      GetShape(context, ultimate, invariantOnly)};
                   result.AcquireAttrs(ultimate);
                   result.AcquireLEN(ultimate);
                   return std::move(result.Rewrite(context));
@@ -117,14 +119,15 @@ std::optional<TypeAndShape> TypeAndShape::Characterize(
 }
 
 std::optional<TypeAndShape> TypeAndShape::Characterize(
-    const semantics::AssocEntityDetails &assoc, FoldingContext &context) {
+    const semantics::AssocEntityDetails &assoc, FoldingContext &context,
+    bool invariantOnly) {
   std::optional<TypeAndShape> result;
   if (auto type{DynamicType::From(assoc.type())}) {
     if (auto rank{assoc.rank()}) {
       if (*rank >= 0 && *rank <= common::maxRank) {
         result = TypeAndShape{std::move(*type), Shape(*rank)};
       }
-    } else if (auto shape{GetShape(context, assoc.expr())}) {
+    } else if (auto shape{GetShape(context, assoc.expr(), invariantOnly)}) {
       result = TypeAndShape{std::move(*type), std::move(*shape)};
     }
     if (result && type->category() == TypeCategory::Character) {
@@ -139,7 +142,8 @@ std::optional<TypeAndShape> TypeAndShape::Characterize(
 }
 
 std::optional<TypeAndShape> TypeAndShape::Characterize(
-    const semantics::DeclTypeSpec &spec, FoldingContext &context) {
+    const semantics::DeclTypeSpec &spec, FoldingContext &context,
+    bool /*invariantOnly=*/) {
   if (auto type{DynamicType::From(spec)}) {
     return Fold(context, TypeAndShape{std::move(*type)});
   } else {
@@ -148,11 +152,11 @@ std::optional<TypeAndShape> TypeAndShape::Characterize(
 }
 
 std::optional<TypeAndShape> TypeAndShape::Characterize(
-    const ActualArgument &arg, FoldingContext &context) {
+    const ActualArgument &arg, FoldingContext &context, bool invariantOnly) {
   if (const auto *expr{arg.UnwrapExpr()}) {
-    return Characterize(*expr, context);
+    return Characterize(*expr, context, invariantOnly);
   } else if (const Symbol * assumed{arg.GetAssumedTypeDummy()}) {
-    return Characterize(*assumed, context);
+    return Characterize(*assumed, context, invariantOnly);
   } else {
     return std::nullopt;
   }
@@ -386,7 +390,8 @@ std::optional<DummyDataObject> DummyDataObject::Characterize(
     const semantics::Symbol &symbol, FoldingContext &context) {
   if (const auto *object{symbol.detailsIf<semantics::ObjectEntityDetails>()};
       object || symbol.has<semantics::EntityDetails>()) {
-    if (auto type{TypeAndShape::Characterize(symbol, context)}) {
+    if (auto type{TypeAndShape::Characterize(
+            symbol, context, /*invariantOnly=*/false)}) {
       std::optional<DummyDataObject> result{std::move(*type)};
       using semantics::Attr;
       CopyAttrs<DummyDataObject, DummyDataObject::Attr>(symbol, *result,
@@ -525,7 +530,6 @@ static std::optional<FunctionResult> CharacterizeFunctionResult(
 static std::optional<Procedure> CharacterizeProcedure(
     const semantics::Symbol &original, FoldingContext &context,
     semantics::UnorderedSymbolSet seenProcs) {
-  Procedure result;
   const auto &symbol{ResolveAssociations(original)};
   if (seenProcs.find(symbol) != seenProcs.end()) {
     std::string procsList{GetSeenProcs(seenProcs)};
@@ -536,22 +540,11 @@ static std::optional<Procedure> CharacterizeProcedure(
     return std::nullopt;
   }
   seenProcs.insert(symbol);
-  if (IsElementalProcedure(symbol)) {
-    result.attrs.set(Procedure::Attr::Elemental);
-  }
-  CopyAttrs<Procedure, Procedure::Attr>(symbol, result,
-      {
-          {semantics::Attr::BIND_C, Procedure::Attr::BindC},
-      });
-  if (IsPureProcedure(symbol) || // works for ENTRY too
-      (!symbol.attrs().test(semantics::Attr::IMPURE) &&
-          result.attrs.test(Procedure::Attr::Elemental))) {
-    result.attrs.set(Procedure::Attr::Pure);
-  }
-  return common::visit(
+  auto result{common::visit(
       common::visitors{
           [&](const semantics::SubprogramDetails &subp)
               -> std::optional<Procedure> {
+            Procedure result;
             if (subp.isFunction()) {
               if (auto fr{CharacterizeFunctionResult(
                       subp.result(), context, seenProcs)}) {
@@ -578,7 +571,7 @@ static std::optional<Procedure> CharacterizeProcedure(
               }
             }
             result.cudaSubprogramAttrs = subp.cudaSubprogramAttrs();
-            return result;
+            return std::move(result);
           },
           [&](const semantics::ProcEntityDetails &proc)
               -> std::optional<Procedure> {
@@ -597,14 +590,17 @@ static std::optional<Procedure> CharacterizeProcedure(
             }
             if (const semantics::Symbol *
                 interfaceSymbol{proc.procInterface()}) {
-              auto interface {
-                CharacterizeProcedure(*interfaceSymbol, context, seenProcs)
-              };
-              if (interface && IsPointer(symbol)) {
-                interface->attrs.reset(Procedure::Attr::Elemental);
+              auto result{
+                  CharacterizeProcedure(*interfaceSymbol, context, seenProcs)};
+              if (result && (IsDummy(symbol) || IsPointer(symbol))) {
+                // Dummy procedures and procedure pointers may not be
+                // ELEMENTAL, but we do accept the use of elemental intrinsic
+                // functions as their interfaces.
+                result->attrs.reset(Procedure::Attr::Elemental);
               }
-              return interface;
+              return result;
             } else {
+              Procedure result;
               result.attrs.set(Procedure::Attr::ImplicitInterface);
               const semantics::DeclTypeSpec *type{proc.type()};
               if (symbol.test(semantics::Symbol::Flag::Subroutine)) {
@@ -624,7 +620,7 @@ static std::optional<Procedure> CharacterizeProcedure(
                 return std::nullopt;
               }
               // The PASS name, if any, is not a characteristic.
-              return result;
+              return std::move(result);
             }
           },
           [&](const semantics::ProcBindingDetails &binding) {
@@ -683,7 +679,20 @@ static std::optional<Procedure> CharacterizeProcedure(
             return std::optional<Procedure>{};
           },
       },
-      symbol.details());
+      symbol.details())};
+  if (result && !symbol.has<semantics::ProcBindingDetails>()) {
+    CopyAttrs<Procedure, Procedure::Attr>(DEREF(GetMainEntry(&symbol)), *result,
+        {
+            {semantics::Attr::BIND_C, Procedure::Attr::BindC},
+            {semantics::Attr::ELEMENTAL, Procedure::Attr::Elemental},
+        });
+    if (IsPureProcedure(symbol) || // works for ENTRY too
+        (!IsExplicitlyImpureProcedure(symbol) &&
+            result->attrs.test(Procedure::Attr::Elemental))) {
+      result->attrs.set(Procedure::Attr::Pure);
+    }
+  }
+  return result;
 }
 
 static std::optional<DummyProcedure> CharacterizeDummyProcedure(
@@ -918,7 +927,8 @@ static std::optional<FunctionResult> CharacterizeFunctionResult(
     const semantics::Symbol &symbol, FoldingContext &context,
     semantics::UnorderedSymbolSet seenProcs) {
   if (const auto *object{symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
-    if (auto type{TypeAndShape::Characterize(symbol, context)}) {
+    if (auto type{TypeAndShape::Characterize(
+            symbol, context, /*invariantOnly=*/false)}) {
       FunctionResult result{std::move(*type)};
       CopyAttrs<FunctionResult, FunctionResult::Attr>(symbol, result,
           {
@@ -996,21 +1006,18 @@ bool FunctionResult::CanBeReturnedViaImplicitInterface() const {
   }
 }
 
-static bool AreCompatibleFunctionResultShapes(const Shape &x, const Shape &y) {
+static std::optional<std::string> AreIncompatibleFunctionResultShapes(
+    const Shape &x, const Shape &y) {
   int rank{GetRank(x)};
-  if (GetRank(y) != rank) {
-    return false;
+  if (int yrank{GetRank(y)}; yrank != rank) {
+    return "rank "s + std::to_string(rank) + " vs " + std::to_string(yrank);
   }
   for (int j{0}; j < rank; ++j) {
-    if (auto xDim{ToInt64(x[j])}) {
-      if (auto yDim{ToInt64(y[j])}) {
-        if (*xDim != *yDim) {
-          return false;
-        }
-      }
+    if (x[j] && y[j] && !(*x[j] == *y[j])) {
+      return x[j]->AsFortran() + " vs " + y[j]->AsFortran();
     }
   }
-  return true;
+  return std::nullopt;
 }
 
 bool FunctionResult::IsCompatibleWith(
@@ -1029,38 +1036,45 @@ bool FunctionResult::IsCompatibleWith(
     }
   } else if (const auto *ifaceTypeShape{std::get_if<TypeAndShape>(&u)}) {
     if (const auto *actualTypeShape{std::get_if<TypeAndShape>(&actual.u)}) {
+      std::optional<std::string> details;
       if (ifaceTypeShape->Rank() != actualTypeShape->Rank()) {
         if (whyNot) {
           *whyNot = "function results have distinct ranks";
         }
       } else if (!attrs.test(Attr::Allocatable) && !attrs.test(Attr::Pointer) &&
-          !AreCompatibleFunctionResultShapes(
-              ifaceTypeShape->shape(), actualTypeShape->shape())) {
+          (details = AreIncompatibleFunctionResultShapes(
+               ifaceTypeShape->shape(), actualTypeShape->shape()))) {
         if (whyNot) {
-          *whyNot = "function results have distinct constant extents";
+          *whyNot = "function results have distinct extents (" + *details + ')';
         }
       } else if (ifaceTypeShape->type() != actualTypeShape->type()) {
-        if (ifaceTypeShape->type().category() ==
+        if (ifaceTypeShape->type().category() !=
             actualTypeShape->type().category()) {
-          if (ifaceTypeShape->type().category() == TypeCategory::Character) {
-            if (ifaceTypeShape->type().kind() ==
-                actualTypeShape->type().kind()) {
-              auto ifaceLen{ifaceTypeShape->type().knownLength()};
-              auto actualLen{actualTypeShape->type().knownLength()};
-              if (!ifaceLen || !actualLen || *ifaceLen == *actualLen) {
+        } else if (ifaceTypeShape->type().category() ==
+            TypeCategory::Character) {
+          if (ifaceTypeShape->type().kind() == actualTypeShape->type().kind()) {
+            if (IsAssumedLengthCharacter() ||
+                actual.IsAssumedLengthCharacter()) {
+              return true;
+            } else {
+              const auto *ifaceLenParam{
+                  ifaceTypeShape->type().charLengthParamValue()};
+              const auto *actualLenParam{
+                  actualTypeShape->type().charLengthParamValue()};
+              if (ifaceLenParam && actualLenParam &&
+                  *ifaceLenParam == *actualLenParam) {
                 return true;
               }
             }
-          } else if (ifaceTypeShape->type().category() ==
-              TypeCategory::Derived) {
-            if (ifaceTypeShape->type().IsPolymorphic() ==
-                    actualTypeShape->type().IsPolymorphic() &&
-                !ifaceTypeShape->type().IsUnlimitedPolymorphic() &&
-                !actualTypeShape->type().IsUnlimitedPolymorphic() &&
-                AreSameDerivedType(ifaceTypeShape->type().GetDerivedTypeSpec(),
-                    actualTypeShape->type().GetDerivedTypeSpec())) {
-              return true;
-            }
+          }
+        } else if (ifaceTypeShape->type().category() == TypeCategory::Derived) {
+          if (ifaceTypeShape->type().IsPolymorphic() ==
+                  actualTypeShape->type().IsPolymorphic() &&
+              !ifaceTypeShape->type().IsUnlimitedPolymorphic() &&
+              !actualTypeShape->type().IsUnlimitedPolymorphic() &&
+              AreSameDerivedType(ifaceTypeShape->type().GetDerivedTypeSpec(),
+                  actualTypeShape->type().GetDerivedTypeSpec())) {
+            return true;
           }
         }
         if (whyNot) {
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index 45c54b37dd1d5..fd549dd816559 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -3025,7 +3025,7 @@ static bool ApplySpecificChecks(SpecificCall &call, FoldingContext &context) {
           }
           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);
+                "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(
diff --git a/flang/lib/Evaluate/shape.cpp b/flang/lib/Evaluate/shape.cpp
index c86498fa413f4..ada26ac46af83 100644
--- a/flang/lib/Evaluate/shape.cpp
+++ b/flang/lib/Evaluate/shape.cpp
@@ -76,10 +76,10 @@ auto GetShapeHelper::AsShapeResult(ExtentExpr &&arrayExpr) const -> Result {
   }
 }
 
-Shape GetShapeHelper::CreateShape(int rank, NamedEntity &base) {
+Shape GetShapeHelper::CreateShape(int rank, NamedEntity &base) const {
   Shape shape;
   for (int dimension{0}; dimension < rank; ++dimension) {
-    shape.emplace_back(GetExtent(base, dimension));
+    shape.emplace_back(GetExtent(base, dimension, invariantOnly_));
   }
   return shape;
 }
@@ -236,8 +236,10 @@ class GetLowerBoundHelper
   using Result = RESULT;
   using Base = Traverse<GetLowerBoundHelper, RESULT>;
   using Base::operator();
-  explicit GetLowerBoundHelper(int d, FoldingContext *context)
-      : Base{*this}, dimension_{d}, context_{context} {}
+  explicit GetLowerBoundHelper(
+      int d, FoldingContext *context, bool invariantOnly)
+      : Base{*this}, dimension_{d}, context_{context},
+        invariantOnly_{invariantOnly} {}
   static Result Default() { return Result{1}; }
   static Result Combine(Result &&, Result &&) {
     // Operator results and array references always have lower bounds == 1
@@ -259,7 +261,7 @@ class GetLowerBoundHelper
               if (dimension_ == rank - 1 && details->IsAssumedSize()) {
                 // last dimension of assumed-size dummy array: don't worry
                 // about handling an empty dimension
-                ok = IsScopeInvariantExpr(*lbound);
+                ok = !invariantOnly_ || IsScopeInvariantExpr(*lbound);
               } else if (lbValue.value_or(0) == 1) {
                 // Lower bound is 1, regardless of extent
                 ok = true;
@@ -371,60 +373,69 @@ class GetLowerBoundHelper
 private:
   int dimension_; // zero-based
   FoldingContext *context_{nullptr};
+  bool invariantOnly_{false};
 };
 
-ExtentExpr GetRawLowerBound(const NamedEntity &base, int dimension) {
-  return GetLowerBoundHelper<ExtentExpr, false>{dimension, nullptr}(base);
+ExtentExpr GetRawLowerBound(
+    const NamedEntity &base, int dimension, bool invariantOnly) {
+  return GetLowerBoundHelper<ExtentExpr, false>{
+      dimension, nullptr, invariantOnly}(base);
 }
 
-ExtentExpr GetRawLowerBound(
-    FoldingContext &context, const NamedEntity &base, int dimension) {
+ExtentExpr GetRawLowerBound(FoldingContext &context, const NamedEntity &base,
+    int dimension, bool invariantOnly) {
   return Fold(context,
-      GetLowerBoundHelper<ExtentExpr, false>{dimension, &context}(base));
+      GetLowerBoundHelper<ExtentExpr, false>{
+          dimension, &context, invariantOnly}(base));
 }
 
-MaybeExtentExpr GetLBOUND(const NamedEntity &base, int dimension) {
-  return GetLowerBoundHelper<MaybeExtentExpr, true>{dimension, nullptr}(base);
+MaybeExtentExpr GetLBOUND(
+    const NamedEntity &base, int dimension, bool invariantOnly) {
+  return GetLowerBoundHelper<MaybeExtentExpr, true>{
+      dimension, nullptr, invariantOnly}(base);
 }
 
-MaybeExtentExpr GetLBOUND(
-    FoldingContext &context, const NamedEntity &base, int dimension) {
+MaybeExtentExpr GetLBOUND(FoldingContext &context, const NamedEntity &base,
+    int dimension, bool invariantOnly) {
   return Fold(context,
-      GetLowerBoundHelper<MaybeExtentExpr, true>{dimension, &context}(base));
+      GetLowerBoundHelper<MaybeExtentExpr, true>{
+          dimension, &context, invariantOnly}(base));
 }
 
-Shape GetRawLowerBounds(const NamedEntity &base) {
+Shape GetRawLowerBounds(const NamedEntity &base, bool invariantOnly) {
   Shape result;
   int rank{base.Rank()};
   for (int dim{0}; dim < rank; ++dim) {
-    result.emplace_back(GetRawLowerBound(base, dim));
+    result.emplace_back(GetRawLowerBound(base, dim, invariantOnly));
   }
   return result;
 }
 
-Shape GetRawLowerBounds(FoldingContext &context, const NamedEntity &base) {
+Shape GetRawLowerBounds(
+    FoldingContext &context, const NamedEntity &base, bool invariantOnly) {
   Shape result;
   int rank{base.Rank()};
   for (int dim{0}; dim < rank; ++dim) {
-    result.emplace_back(GetRawLowerBound(context, base, dim));
+    result.emplace_back(GetRawLowerBound(context, base, dim, invariantOnly));
   }
   return result;
 }
 
-Shape GetLBOUNDs(const NamedEntity &base) {
+Shape GetLBOUNDs(const NamedEntity &base, bool invariantOnly) {
   Shape result;
   int rank{base.Rank()};
   for (int dim{0}; dim < rank; ++dim) {
-    result.emplace_back(GetLBOUND(base, dim));
+    result.emplace_back(GetLBOUND(base, dim, invariantOnly));
   }
   return result;
 }
 
-Shape GetLBOUNDs(FoldingContext &context, const NamedEntity &base) {
+Shape GetLBOUNDs(
+    FoldingContext &context, const NamedEntity &base, bool invariantOnly) {
   Shape result;
   int rank{base.Rank()};
   for (int dim{0}; dim < rank; ++dim) {
-    result.emplace_back(GetLBOUND(context, base, dim));
+    result.emplace_back(GetLBOUND(context, base, dim, invariantOnly));
   }
   return result;
 }
@@ -433,7 +444,7 @@ Shape GetLBOUNDs(FoldingContext &context, const NamedEntity &base) {
 // the extent.  In particular, if the upper bound is less than the lower bound,
 // return zero.
 static MaybeExtentExpr GetNonNegativeExtent(
-    const semantics::ShapeSpec &shapeSpec) {
+    const semantics::ShapeSpec &shapeSpec, bool invariantOnly) {
   const auto &ubound{shapeSpec.ubound().GetExplicit()};
   const auto &lbound{shapeSpec.lbound().GetExplicit()};
   std::optional<ConstantSubscript> uval{ToInt64(ubound)};
@@ -444,8 +455,9 @@ static MaybeExtentExpr GetNonNegativeExtent(
     } else {
       return ExtentExpr{*uval - *lval + 1};
     }
-  } else if (lbound && ubound && IsScopeInvariantExpr(*lbound) &&
-      IsScopeInvariantExpr(*ubound)) {
+  } else if (lbound && ubound &&
+      (!invariantOnly ||
+          (IsScopeInvariantExpr(*lbound) && IsScopeInvariantExpr(*ubound)))) {
     // Apply effective IDIM (MAX calculation with 0) so thet the
     // result is never negative
     if (lval.value_or(0) == 1) {
@@ -481,7 +493,8 @@ MaybeExtentExpr GetAssociatedExtent(const NamedEntity &base,
   return std::nullopt;
 }
 
-MaybeExtentExpr GetExtent(const NamedEntity &base, int dimension) {
+MaybeExtentExpr GetExtent(
+    const NamedEntity &base, int dimension, bool invariantOnly) {
   CHECK(dimension >= 0);
   const Symbol &last{base.GetLastSymbol()};
   const Symbol &symbol{ResolveAssociationsExceptSelectRank(last)};
@@ -506,7 +519,7 @@ MaybeExtentExpr GetExtent(const NamedEntity &base, int dimension) {
       int j{0};
       for (const auto &shapeSpec : details->shape()) {
         if (j++ == dimension) {
-          if (auto extent{GetNonNegativeExtent(shapeSpec)}) {
+          if (auto extent{GetNonNegativeExtent(shapeSpec, invariantOnly)}) {
             return extent;
           } else if (details->IsAssumedSize() && j == symbol.Rank()) {
             return std::nullopt;
@@ -523,23 +536,23 @@ MaybeExtentExpr GetExtent(const NamedEntity &base, int dimension) {
   return std::nullopt;
 }
 
-MaybeExtentExpr GetExtent(
-    FoldingContext &context, const NamedEntity &base, int dimension) {
-  return Fold(context, GetExtent(base, dimension));
+MaybeExtentExpr GetExtent(FoldingContext &context, const NamedEntity &base,
+    int dimension, bool invariantOnly) {
+  return Fold(context, GetExtent(base, dimension, invariantOnly));
 }
 
-MaybeExtentExpr GetExtent(
-    const Subscript &subscript, const NamedEntity &base, int dimension) {
+MaybeExtentExpr GetExtent(const Subscript &subscript, const NamedEntity &base,
+    int dimension, bool invariantOnly) {
   return common::visit(
       common::visitors{
           [&](const Triplet &triplet) -> MaybeExtentExpr {
             MaybeExtentExpr upper{triplet.upper()};
             if (!upper) {
-              upper = GetUBOUND(base, dimension);
+              upper = GetUBOUND(base, dimension, invariantOnly);
             }
             MaybeExtentExpr lower{triplet.lower()};
             if (!lower) {
-              lower = GetLBOUND(base, dimension);
+              lower = GetLBOUND(base, dimension, invariantOnly);
             }
             return CountTrips(std::move(lower), std::move(upper),
                 MaybeExtentExpr{triplet.stride()});
@@ -558,8 +571,8 @@ MaybeExtentExpr GetExtent(
 }
 
 MaybeExtentExpr GetExtent(FoldingContext &context, const Subscript &subscript,
-    const NamedEntity &base, int dimension) {
-  return Fold(context, GetExtent(subscript, base, dimension));
+    const NamedEntity &base, int dimension, bool invariantOnly) {
+  return Fold(context, GetExtent(subscript, base, dimension, invariantOnly));
 }
 
 MaybeExtentExpr ComputeUpperBound(
@@ -580,14 +593,15 @@ MaybeExtentExpr ComputeUpperBound(
   return Fold(context, ComputeUpperBound(std::move(lower), std::move(extent)));
 }
 
-MaybeExtentExpr GetRawUpperBound(const NamedEntity &base, int dimension) {
+MaybeExtentExpr GetRawUpperBound(
+    const NamedEntity &base, int dimension, bool invariantOnly) {
   const Symbol &symbol{
       ResolveAssociationsExceptSelectRank(base.GetLastSymbol())};
   if (const auto *details{symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
     int rank{details->shape().Rank()};
     if (dimension < rank) {
       const auto &bound{details->shape()[dimension].ubound().GetExplicit()};
-      if (bound && IsScopeInvariantExpr(*bound)) {
+      if (bound && (!invariantOnly || IsScopeInvariantExpr(*bound))) {
         return *bound;
       } else if (details->IsAssumedSize() && dimension + 1 == symbol.Rank()) {
         return std::nullopt;
@@ -606,16 +620,16 @@ MaybeExtentExpr GetRawUpperBound(const NamedEntity &base, int dimension) {
   return std::nullopt;
 }
 
-MaybeExtentExpr GetRawUpperBound(
-    FoldingContext &context, const NamedEntity &base, int dimension) {
-  return Fold(context, GetRawUpperBound(base, dimension));
+MaybeExtentExpr GetRawUpperBound(FoldingContext &context,
+    const NamedEntity &base, int dimension, bool invariantOnly) {
+  return Fold(context, GetRawUpperBound(base, dimension, invariantOnly));
 }
 
-static MaybeExtentExpr GetExplicitUBOUND(
-    FoldingContext *context, const semantics::ShapeSpec &shapeSpec) {
+static MaybeExtentExpr GetExplicitUBOUND(FoldingContext *context,
+    const semantics::ShapeSpec &shapeSpec, bool invariantOnly) {
   const auto &ubound{shapeSpec.ubound().GetExplicit()};
-  if (ubound && IsScopeInvariantExpr(*ubound)) {
-    if (auto extent{GetNonNegativeExtent(shapeSpec)}) {
+  if (ubound && (!invariantOnly || IsScopeInvariantExpr(*ubound))) {
+    if (auto extent{GetNonNegativeExtent(shapeSpec, invariantOnly)}) {
       if (auto cstExtent{ToInt64(
               context ? Fold(*context, std::move(*extent)) : *extent)}) {
         if (cstExtent > 0) {
@@ -629,20 +643,21 @@ static MaybeExtentExpr GetExplicitUBOUND(
   return std::nullopt;
 }
 
-static MaybeExtentExpr GetUBOUND(
-    FoldingContext *context, const NamedEntity &base, int dimension) {
+static MaybeExtentExpr GetUBOUND(FoldingContext *context,
+    const NamedEntity &base, int dimension, bool invariantOnly) {
   const Symbol &symbol{
       ResolveAssociationsExceptSelectRank(base.GetLastSymbol())};
   if (const auto *details{symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
     int rank{details->shape().Rank()};
     if (dimension < rank) {
       const semantics::ShapeSpec &shapeSpec{details->shape()[dimension]};
-      if (auto ubound{GetExplicitUBOUND(context, shapeSpec)}) {
+      if (auto ubound{GetExplicitUBOUND(context, shapeSpec, invariantOnly)}) {
         return *ubound;
       } else if (details->IsAssumedSize() && dimension + 1 == symbol.Rank()) {
         return std::nullopt; // UBOUND() folding replaces with -1
-      } else if (auto lb{GetLBOUND(base, dimension)}) {
-        return ComputeUpperBound(std::move(*lb), GetExtent(base, dimension));
+      } else if (auto lb{GetLBOUND(base, dimension, invariantOnly)}) {
+        return ComputeUpperBound(
+            std::move(*lb), GetExtent(base, dimension, invariantOnly));
       }
     }
   } else if (const auto *assoc{
@@ -658,7 +673,7 @@ static MaybeExtentExpr GetUBOUND(
       }
     } else if (assoc->expr()) {
       if (auto extent{GetAssociatedExtent(base, *assoc, dimension)}) {
-        if (auto lb{GetLBOUND(base, dimension)}) {
+        if (auto lb{GetLBOUND(base, dimension, invariantOnly)}) {
           return ComputeUpperBound(std::move(*lb), std::move(extent));
         }
       }
@@ -667,29 +682,34 @@ static MaybeExtentExpr GetUBOUND(
   return std::nullopt;
 }
 
-MaybeExtentExpr GetUBOUND(const NamedEntity &base, int dimension) {
-  return GetUBOUND(nullptr, base, dimension);
+MaybeExtentExpr GetUBOUND(
+    const NamedEntity &base, int dimension, bool invariantOnly) {
+  return GetUBOUND(nullptr, base, dimension, invariantOnly);
 }
 
-MaybeExtentExpr GetUBOUND(
-    FoldingContext &context, const NamedEntity &base, int dimension) {
-  return Fold(context, GetUBOUND(&context, base, dimension));
+MaybeExtentExpr GetUBOUND(FoldingContext &context, const NamedEntity &base,
+    int dimension, bool invariantOnly) {
+  return Fold(context, GetUBOUND(&context, base, dimension, invariantOnly));
 }
 
-static Shape GetUBOUNDs(FoldingContext *context, const NamedEntity &base) {
+static Shape GetUBOUNDs(
+    FoldingContext *context, const NamedEntity &base, bool invariantOnly) {
   Shape result;
   int rank{base.Rank()};
   for (int dim{0}; dim < rank; ++dim) {
-    result.emplace_back(GetUBOUND(context, base, dim));
+    result.emplace_back(GetUBOUND(context, base, dim, invariantOnly));
   }
   return result;
 }
 
-Shape GetUBOUNDs(FoldingContext &context, const NamedEntity &base) {
-  return Fold(context, GetUBOUNDs(&context, base));
+Shape GetUBOUNDs(
+    FoldingContext &context, const NamedEntity &base, bool invariantOnly) {
+  return Fold(context, GetUBOUNDs(&context, base, invariantOnly));
 }
 
-Shape GetUBOUNDs(const NamedEntity &base) { return GetUBOUNDs(nullptr, base); }
+Shape GetUBOUNDs(const NamedEntity &base, bool invariantOnly) {
+  return GetUBOUNDs(nullptr, base, invariantOnly);
+}
 
 auto GetShapeHelper::operator()(const Symbol &symbol) const -> Result {
   return common::visit(
diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp
index 86777ac44745e..d2fa5c9b5f36b 100644
--- a/flang/lib/Evaluate/tools.cpp
+++ b/flang/lib/Evaluate/tools.cpp
@@ -1324,23 +1324,26 @@ bool IsPureProcedure(const Scope &scope) {
   return symbol && IsPureProcedure(*symbol);
 }
 
+bool IsExplicitlyImpureProcedure(const Symbol &original) {
+  // An ENTRY is IMPURE if its containing subprogram is so
+  return DEREF(GetMainEntry(&original.GetUltimate()))
+      .attrs()
+      .test(Attr::IMPURE);
+}
+
 bool IsElementalProcedure(const Symbol &original) {
   // An ENTRY is elemental if its containing subprogram is
   const Symbol &symbol{DEREF(GetMainEntry(&original.GetUltimate()))};
-  if (const auto *procDetails{symbol.detailsIf<ProcEntityDetails>()}) {
-    if (const Symbol * procInterface{procDetails->procInterface()}) {
-      // procedure with an elemental interface, ignoring the elemental
-      // aspect of intrinsic functions
-      return !procInterface->attrs().test(Attr::INTRINSIC) &&
-          IsElementalProcedure(*procInterface);
-    }
-  } else if (const auto *details{symbol.detailsIf<ProcBindingDetails>()}) {
-    return !details->symbol().attrs().test(Attr::INTRINSIC) &&
-        IsElementalProcedure(details->symbol());
-  } else if (!IsProcedure(symbol)) {
+  if (IsProcedure(symbol)) {
+    auto &foldingContext{symbol.owner().context().foldingContext()};
+    auto restorer{foldingContext.messages().DiscardMessages()};
+    auto proc{evaluate::characteristics::Procedure::Characterize(
+        symbol, foldingContext)};
+    return proc &&
+        proc->attrs.test(evaluate::characteristics::Procedure::Attr::Elemental);
+  } else {
     return false;
   }
-  return symbol.attrs().test(Attr::ELEMENTAL);
 }
 
 bool IsFunction(const Symbol &symbol) {
diff --git a/flang/lib/Evaluate/variable.cpp b/flang/lib/Evaluate/variable.cpp
index 083b6bae57589..29483b103054c 100644
--- a/flang/lib/Evaluate/variable.cpp
+++ b/flang/lib/Evaluate/variable.cpp
@@ -639,16 +639,32 @@ NamedEntity CoarrayRef::GetBase() const { return AsNamedEntity(base_); }
 
 // For the purposes of comparing type parameter expressions while
 // testing the compatibility of procedure characteristics, two
-// object dummy arguments with the same name are considered equal.
+// dummy arguments with the same position are considered equal.
+static std::optional<int> GetDummyArgPosition(const Symbol &original) {
+  const Symbol &symbol(original.GetUltimate());
+  if (IsDummy(symbol)) {
+    if (const Symbol * proc{symbol.owner().symbol()}) {
+      if (const auto *subp{proc->detailsIf<semantics::SubprogramDetails>()}) {
+        int j{0};
+        for (const Symbol *arg : subp->dummyArgs()) {
+          if (arg == &symbol) {
+            return j;
+          }
+          ++j;
+        }
+      }
+    }
+  }
+  return std::nullopt;
+}
+
 static bool AreSameSymbol(const Symbol &x, const Symbol &y) {
   if (&x == &y) {
     return true;
   }
-  if (x.name() == y.name()) {
-    if (const auto *xObject{x.detailsIf<semantics::ObjectEntityDetails>()}) {
-      if (const auto *yObject{y.detailsIf<semantics::ObjectEntityDetails>()}) {
-        return xObject->isDummy() && yObject->isDummy();
-      }
+  if (auto xPos{GetDummyArgPosition(x)}) {
+    if (auto yPos{GetDummyArgPosition(y)}) {
+      return *xPos == *yPos;
     }
   }
   return false;
diff --git a/flang/lib/Lower/ConvertType.cpp b/flang/lib/Lower/ConvertType.cpp
index 9dfe982a65048..e8179b43afc7d 100644
--- a/flang/lib/Lower/ConvertType.cpp
+++ b/flang/lib/Lower/ConvertType.cpp
@@ -276,8 +276,8 @@ struct TypeBuilderImpl {
                           Fortran::semantics::IsUnlimitedPolymorphic(symbol)) &&
                          !Fortran::semantics::IsAssumedType(symbol);
     if (ultimate.IsObjectArray()) {
-      auto shapeExpr = Fortran::evaluate::GetShapeHelper{
-          converter.getFoldingContext()}(ultimate);
+      auto shapeExpr =
+          Fortran::evaluate::GetShape(converter.getFoldingContext(), ultimate);
       if (!shapeExpr)
         TODO(loc, "assumed rank symbol type");
       fir::SequenceType::Shape shape;
diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index 62efd8b49d385..e7e091ed024c4 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -1024,7 +1024,7 @@ void CheckHelper::CheckPointerInitialization(const Symbol &symbol) {
         if (auto designator{evaluate::AsGenericExpr(symbol)}) {
           auto restorer{messages_.SetLocation(symbol.name())};
           context_.set_location(symbol.name());
-          CheckInitialTarget(
+          CheckInitialDataPointerTarget(
               context_, *designator, *object->init(), DEREF(scope_));
         }
       }
@@ -1033,28 +1033,36 @@ void CheckHelper::CheckPointerInitialization(const Symbol &symbol) {
         // C1519 - must be nonelemental external or module procedure,
         // or an unrestricted specific intrinsic function.
         const Symbol &ultimate{(*proc->init())->GetUltimate()};
+        bool checkTarget{true};
         if (ultimate.attrs().test(Attr::INTRINSIC)) {
-          if (const auto intrinsic{
-                  context_.intrinsics().IsSpecificIntrinsicFunction(
-                      ultimate.name().ToString())};
+          if (auto intrinsic{context_.intrinsics().IsSpecificIntrinsicFunction(
+                  ultimate.name().ToString())};
               !intrinsic || intrinsic->isRestrictedSpecific) { // C1030
             context_.Say(
                 "Intrinsic procedure '%s' is not an unrestricted specific "
                 "intrinsic permitted for use as the initializer for procedure "
                 "pointer '%s'"_err_en_US,
                 ultimate.name(), symbol.name());
+            checkTarget = false;
           }
-        } else if (!ultimate.attrs().test(Attr::EXTERNAL) &&
-            ultimate.owner().kind() != Scope::Kind::Module) {
+        } else if ((!ultimate.attrs().test(Attr::EXTERNAL) &&
+                       ultimate.owner().kind() != Scope::Kind::Module) ||
+            IsDummy(ultimate) || IsPointer(ultimate)) {
           context_.Say("Procedure pointer '%s' initializer '%s' is neither "
                        "an external nor a module procedure"_err_en_US,
               symbol.name(), ultimate.name());
+          checkTarget = false;
         } else if (IsElementalProcedure(ultimate)) {
           context_.Say("Procedure pointer '%s' cannot be initialized with the "
-                       "elemental procedure '%s"_err_en_US,
+                       "elemental procedure '%s'"_err_en_US,
               symbol.name(), ultimate.name());
-        } else {
-          // TODO: Check the "shalls" in the 15.4.3.6 paragraphs 7-10.
+          checkTarget = false;
+        }
+        if (checkTarget) {
+          SomeExpr lhs{evaluate::ProcedureDesignator{symbol}};
+          SomeExpr rhs{evaluate::ProcedureDesignator{**proc->init()}};
+          CheckPointerAssignment(context_, lhs, rhs,
+              GetProgramUnitOrBlockConstructContaining(symbol));
         }
       }
     }
@@ -1148,6 +1156,9 @@ void CheckHelper::CheckArraySpec(
 void CheckHelper::CheckProcEntity(
     const Symbol &symbol, const ProcEntityDetails &details) {
   CheckSymbolType(symbol);
+  const Symbol *interface {
+    details.procInterface() ? &details.procInterface()->GetUltimate() : nullptr
+  };
   if (details.isDummy()) {
     if (!symbol.attrs().test(Attr::POINTER) && // C843
         (symbol.attrs().test(Attr::INTENT_IN) ||
@@ -1160,20 +1171,19 @@ void CheckHelper::CheckProcEntity(
       messages_.Say(
           "An ELEMENTAL subprogram may not have a dummy procedure"_err_en_US);
     }
-    const Symbol *interface {
-      details.procInterface()
-    };
-    if (!symbol.attrs().test(Attr::INTRINSIC) &&
-        (IsElementalProcedure(symbol) ||
-            (interface && !interface->attrs().test(Attr::INTRINSIC) &&
-                IsElementalProcedure(*interface)))) {
+    if (interface && IsElementalProcedure(*interface)) {
       // There's no explicit constraint or "shall" that we can find in the
       // standard for this check, but it seems to be implied in multiple
       // sites, and ELEMENTAL non-intrinsic actual arguments *are*
       // explicitly forbidden.  But we allow "PROCEDURE(SIN)::dummy"
       // because it is explicitly legal to *pass* the specific intrinsic
       // function SIN as an actual argument.
-      messages_.Say("A dummy procedure may not be ELEMENTAL"_err_en_US);
+      if (interface->attrs().test(Attr::INTRINSIC)) {
+        messages_.Say(
+            "A dummy procedure should not have an ELEMENTAL intrinsic as its interface"_port_en_US);
+      } else {
+        messages_.Say("A dummy procedure may not be ELEMENTAL"_err_en_US);
+      }
     }
   } else if (symbol.attrs().test(Attr::INTENT_IN) ||
       symbol.attrs().test(Attr::INTENT_OUT) ||
@@ -1183,35 +1193,35 @@ void CheckHelper::CheckProcEntity(
   } else if (IsOptional(symbol)) {
     messages_.Say("OPTIONAL attribute may apply only to a dummy "
                   "argument"_err_en_US); // C849
-  } else if (symbol.owner().IsDerivedType()) {
-    if (!symbol.attrs().test(Attr::POINTER)) { // C756
-      const auto &name{symbol.name()};
-      messages_.Say(name,
-          "Procedure component '%s' must have POINTER attribute"_err_en_US,
-          name);
-    }
-    CheckPassArg(symbol, details.procInterface(), details);
-  }
-  if (IsPointer(symbol)) {
+  } else if (IsPointer(symbol)) {
     CheckPointerInitialization(symbol);
-    if (const Symbol * interface{details.procInterface()}) {
-      const Symbol &ultimate{interface->GetUltimate()};
-      if (ultimate.attrs().test(Attr::INTRINSIC)) {
-        if (const auto intrinsic{
-                context_.intrinsics().IsSpecificIntrinsicFunction(
-                    ultimate.name().ToString())};
-            !intrinsic || intrinsic->isRestrictedSpecific) { // C1515
+    if (interface) {
+      if (interface->attrs().test(Attr::INTRINSIC)) {
+        auto intrinsic{context_.intrinsics().IsSpecificIntrinsicFunction(
+            interface->name().ToString())};
+        if (!intrinsic || intrinsic->isRestrictedSpecific) { // C1515
           messages_.Say(
               "Intrinsic procedure '%s' is not an unrestricted specific "
               "intrinsic permitted for use as the definition of the interface "
               "to procedure pointer '%s'"_err_en_US,
-              ultimate.name(), symbol.name());
+              interface->name(), symbol.name());
+        } else if (IsElementalProcedure(*interface)) {
+          messages_.Say(
+              "Procedure pointer '%s' should not have an ELEMENTAL intrinsic as its interface"_port_en_US,
+              symbol.name()); // C1517
         }
       } else if (IsElementalProcedure(*interface)) {
         messages_.Say("Procedure pointer '%s' may not be ELEMENTAL"_err_en_US,
             symbol.name()); // C1517
       }
     }
+    if (symbol.owner().IsDerivedType()) {
+      CheckPassArg(symbol, interface, details);
+    }
+  } else if (symbol.owner().IsDerivedType()) {
+    const auto &name{symbol.name()};
+    messages_.Say(name,
+        "Procedure component '%s' must have POINTER attribute"_err_en_US, name);
   }
   CheckExternal(symbol);
 }
diff --git a/flang/lib/Semantics/data-to-inits.cpp b/flang/lib/Semantics/data-to-inits.cpp
index 04088f915efc5..6fbe044aa4618 100644
--- a/flang/lib/Semantics/data-to-inits.cpp
+++ b/flang/lib/Semantics/data-to-inits.cpp
@@ -406,7 +406,7 @@ bool DataInitializationCompiler<DSV>::InitElement(
       exprAnalyzer_.Say(
           "Procedure '%s' may not be used to initialize '%s', which is not a procedure pointer"_err_en_US,
           expr->AsFortran(), DescribeElement());
-    } else if (CheckInitialTarget(
+    } else if (CheckInitialDataPointerTarget(
                    exprAnalyzer_.context(), designator, *expr, DEREF(scope_))) {
       GetImage().AddPointer(offsetSymbol.offset(), *expr);
       return true;
diff --git a/flang/lib/Semantics/pointer-assignment.cpp b/flang/lib/Semantics/pointer-assignment.cpp
index ba63159cee97c..e75e936694211 100644
--- a/flang/lib/Semantics/pointer-assignment.cpp
+++ b/flang/lib/Semantics/pointer-assignment.cpp
@@ -360,7 +360,8 @@ bool PointerAssignmentChecker::Check(parser::CharBlock rhsName, bool isCall,
 }
 
 bool PointerAssignmentChecker::Check(const evaluate::ProcedureDesignator &d) {
-  if (const Symbol * symbol{d.GetSymbol()}) {
+  const Symbol *symbol{d.GetSymbol()};
+  if (symbol) {
     if (const auto *subp{
             symbol->GetUltimate().detailsIf<SubprogramDetails>()}) {
       if (subp->stmtFunction()) {
@@ -377,6 +378,10 @@ bool PointerAssignmentChecker::Check(const evaluate::ProcedureDesignator &d) {
     }
   }
   if (auto chars{Procedure::Characterize(d, foldingContext_)}) {
+    // Disregard the elemental attribute of RHS intrinsics.
+    if (symbol && symbol->GetUltimate().attrs().test(Attr::INTRINSIC)) {
+      chars->attrs.reset(Procedure::Attr::Elemental);
+    }
     return Check(d.GetName(), false, &*chars, d.GetSpecificIntrinsic());
   } else {
     return Check(d.GetName(), false);
@@ -517,8 +522,8 @@ bool CheckPointerAssignment(SemanticsContext &context, parser::CharBlock source,
       .Check(rhs);
 }
 
-bool CheckInitialTarget(SemanticsContext &context, const SomeExpr &pointer,
-    const SomeExpr &init, const Scope &scope) {
+bool CheckInitialDataPointerTarget(SemanticsContext &context,
+    const SomeExpr &pointer, const SomeExpr &init, const Scope &scope) {
   return evaluate::IsInitialDataTarget(
              init, &context.foldingContext().messages()) &&
       CheckPointerAssignment(context, pointer, init, scope);
diff --git a/flang/lib/Semantics/pointer-assignment.h b/flang/lib/Semantics/pointer-assignment.h
index c6f89c4949146..5ac258d03a0a2 100644
--- a/flang/lib/Semantics/pointer-assignment.h
+++ b/flang/lib/Semantics/pointer-assignment.h
@@ -27,16 +27,17 @@ bool CheckPointerAssignment(
     SemanticsContext &, const evaluate::Assignment &, const Scope &);
 bool CheckPointerAssignment(SemanticsContext &, const SomeExpr &lhs,
     const SomeExpr &rhs, const Scope &, bool isBoundsRemapping = false);
-bool CheckStructConstructorPointerComponent(
-    SemanticsContext &, const Symbol &lhs, const SomeExpr &rhs, const Scope &);
 bool CheckPointerAssignment(SemanticsContext &, parser::CharBlock source,
     const std::string &description,
     const evaluate::characteristics::DummyDataObject &, const SomeExpr &rhs,
     const Scope &);
 
+bool CheckStructConstructorPointerComponent(
+    SemanticsContext &, const Symbol &lhs, const SomeExpr &rhs, const Scope &);
+
 // Checks whether an expression is a valid static initializer for a
 // particular pointer designator.
-bool CheckInitialTarget(SemanticsContext &, const SomeExpr &pointer,
+bool CheckInitialDataPointerTarget(SemanticsContext &, const SomeExpr &pointer,
     const SomeExpr &init, const Scope &);
 
 } // namespace Fortran::semantics
diff --git a/flang/test/Semantics/block-data01.f90 b/flang/test/Semantics/block-data01.f90
index 4c8b8b7bf8bb7..7065bff75ddf7 100644
--- a/flang/test/Semantics/block-data01.f90
+++ b/flang/test/Semantics/block-data01.f90
@@ -7,6 +7,7 @@ block data foo
   !ERROR: An initialized variable in BLOCK DATA must be in a COMMON block
   integer :: notInCommon = 1
   integer :: uninitialized ! ok
+  !PORTABILITY: Procedure pointer 'q' should not have an ELEMENTAL intrinsic as its interface
   !ERROR: 'q' may not appear in a BLOCK DATA subprogram
   procedure(sin), pointer :: q => cos
   !ERROR: 'p' may not be a procedure as it is in a COMMON block
diff --git a/flang/test/Semantics/c_loc01.f90 b/flang/test/Semantics/c_loc01.f90
index 21fd1eb14e6df..774ebc2f382e9 100644
--- a/flang/test/Semantics/c_loc01.f90
+++ b/flang/test/Semantics/c_loc01.f90
@@ -11,6 +11,7 @@ subroutine test(assumedType, poly, nclen)
     type(c_ptr) cp
     type(c_funptr) cfp
     real notATarget
+    !PORTABILITY: Procedure pointer 'pptr' should not have an ELEMENTAL intrinsic as its interface
     procedure(sin), pointer :: pptr
     real, target :: arr(3)
     type(hasLen(1)), target :: clen
diff --git a/flang/test/Semantics/call02.f90 b/flang/test/Semantics/call02.f90
index 264a79f8983a5..902b8883b723c 100644
--- a/flang/test/Semantics/call02.f90
+++ b/flang/test/Semantics/call02.f90
@@ -8,6 +8,7 @@ elemental real function elem(x)
       real, intent(in), value :: x
     end function
     subroutine subr(dummy)
+      !PORTABILITY: A dummy procedure should not have an ELEMENTAL intrinsic as its interface
       procedure(sin) :: dummy
     end subroutine
     subroutine badsubr(dummy)
@@ -16,9 +17,11 @@ subroutine badsubr(dummy)
       procedure(elem) :: dummy
     end subroutine
     subroutine optionalsubr(dummy)
+      !PORTABILITY: A dummy procedure should not have an ELEMENTAL intrinsic as its interface
       procedure(sin), optional :: dummy
     end subroutine
     subroutine ptrsubr(dummy)
+      !PORTABILITY: A dummy procedure should not have an ELEMENTAL intrinsic as its interface
       procedure(sin), pointer, intent(in) :: dummy
     end subroutine
   end interface
diff --git a/flang/test/Semantics/call09.f90 b/flang/test/Semantics/call09.f90
index a4b2b64f0f4eb..463f03bc62ff4 100644
--- a/flang/test/Semantics/call09.f90
+++ b/flang/test/Semantics/call09.f90
@@ -37,6 +37,7 @@ subroutine s05(p)
   end subroutine
 
   subroutine selemental1(p)
+    !PORTABILITY: A dummy procedure should not have an ELEMENTAL intrinsic as its interface
     procedure(cos) :: p ! ok
   end subroutine
 
diff --git a/flang/test/Semantics/io11.f90 b/flang/test/Semantics/io11.f90
index 413283cdfc72b..6c002e4db41da 100644
--- a/flang/test/Semantics/io11.f90
+++ b/flang/test/Semantics/io11.f90
@@ -80,9 +80,10 @@ module m4
 contains
   !ERROR: Dummy argument 0 of 'formattedreadproc' must be a data object
   !ERROR: Cannot use an alternate return as the passed-object dummy argument
-  subroutine formattedReadProc(*, unit, iotype, vlist, iostat, iomsg) 
+  subroutine formattedReadProc(*, unit, iotype, vlist, iostat, iomsg)
     !ERROR: Dummy argument 'unit' must be a data object
     !ERROR: A dummy procedure without the POINTER attribute may not have an INTENT attribute
+    !PORTABILITY: A dummy procedure should not have an ELEMENTAL intrinsic as its interface
     procedure(sin), intent(in) :: unit
     character(len=*), intent(in) :: iotype
     integer, intent(in) :: vlist(:)
diff --git a/flang/test/Semantics/modfile49.f90 b/flang/test/Semantics/modfile49.f90
index 9c48c8a480128..2069d21aad92b 100644
--- a/flang/test/Semantics/modfile49.f90
+++ b/flang/test/Semantics/modfile49.f90
@@ -4,7 +4,11 @@
 module m
   type :: t
   end type
-  procedure(sin) :: ext
+  abstract interface
+    subroutine iface
+    end
+  end interface
+  procedure(iface) :: ext
   interface
     subroutine subr(p1,p2)
       import ext, t
@@ -22,8 +26,11 @@ function fun() result(res)
 !module m
 !type::t
 !end type
-!intrinsic::sin
-!procedure(sin)::ext
+!abstract interface
+!subroutine iface()
+!end
+!end interface
+!procedure(iface)::ext
 !interface
 !subroutine subr(p1,p2)
 !import::ext
diff --git a/flang/test/Semantics/procinterface01.f90 b/flang/test/Semantics/procinterface01.f90
index 3363fbc69ccc0..73040b0987bd0 100644
--- a/flang/test/Semantics/procinterface01.f90
+++ b/flang/test/Semantics/procinterface01.f90
@@ -48,7 +48,7 @@ end function tan
  type :: derived1
   !REF: /module1/abstract1
   !DEF: /module1/derived1/p1 NOPASS, POINTER (Function) ProcEntity REAL(4)
-  !DEF: /module1/nested1 PUBLIC (Function) Subprogram REAL(4)
+  !DEF: /module1/nested1 PUBLIC, PURE (Function) Subprogram REAL(4)
   procedure(abstract1), pointer, nopass :: p1 => nested1
   !REF: /module1/explicit1
   !DEF: /module1/derived1/p2 NOPASS, POINTER (Function) ProcEntity REAL(4)
@@ -81,7 +81,7 @@ end function tan
 
  !REF: /module1/nested1
  !DEF: /module1/nested1/x INTENT(IN) ObjectEntity REAL(4)
- real function nested1(x)
+ pure real function nested1(x)
   !REF: /module1/nested1/x
   real, intent(in) :: x
   !DEF: /module1/nested1/nested1 ObjectEntity REAL(4)
diff --git a/flang/test/Semantics/procinterface02.f90 b/flang/test/Semantics/procinterface02.f90
index 3f73e2e75f8db..ca0c62c150d44 100644
--- a/flang/test/Semantics/procinterface02.f90
+++ b/flang/test/Semantics/procinterface02.f90
@@ -12,6 +12,7 @@ real function foo_nonelemental(x)
     end function
   end interface
   real :: A(:), B(:)
+  !PORTABILITY: A dummy procedure should not have an ELEMENTAL intrinsic as its interface
   procedure(sqrt), pointer :: P
   !ERROR: Rank of dummy argument is 0, but actual argument has rank 1
   A = P(B)
diff --git a/flang/test/Semantics/procinterface04.f90 b/flang/test/Semantics/procinterface04.f90
new file mode 100644
index 0000000000000..5bc5413375d90
--- /dev/null
+++ b/flang/test/Semantics/procinterface04.f90
@@ -0,0 +1,24 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+subroutine test(dp1, dp2)
+  intrinsic sin
+  interface
+    elemental real function elemental(x)
+      real, intent(in) :: x
+    end
+    pure real function nonelemental(x)
+      real, intent(in) :: x
+    end
+  end interface
+  !PORTABILITY: A dummy procedure should not have an ELEMENTAL intrinsic as its interface
+  procedure(sin) :: dp1
+  !ERROR: A dummy procedure may not be ELEMENTAL
+  procedure(elemental) :: dp2
+  !PORTABILITY: Procedure pointer 'pp1' should not have an ELEMENTAL intrinsic as its interface
+  procedure(sin), pointer :: pp1
+  !ERROR: Procedure pointer 'pp2' may not be ELEMENTAL
+  procedure(elemental), pointer :: pp2
+  procedure(elemental) :: pp3 ! ok, external
+  procedure(nonelemental), pointer :: pp4 => sin ! ok, special case
+  !ERROR: Procedure pointer 'pp5' cannot be initialized with the elemental procedure 'elemental'
+  procedure(nonelemental), pointer :: pp5 => elemental
+end
diff --git a/flang/test/Semantics/reduce01.f90 b/flang/test/Semantics/reduce01.f90
index fe58004ff30af..8c5a46312ec0a 100644
--- a/flang/test/Semantics/reduce01.f90
+++ b/flang/test/Semantics/reduce01.f90
@@ -70,13 +70,13 @@ subroutine errors
     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: 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, 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
+    !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, f7)
-    !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: 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, 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
+    !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)
diff --git a/flang/test/Semantics/resolve114.f90 b/flang/test/Semantics/resolve114.f90
index d7022e697e110..02923e32a2a14 100644
--- a/flang/test/Semantics/resolve114.f90
+++ b/flang/test/Semantics/resolve114.f90
@@ -34,7 +34,9 @@ end module m2
 subroutine s2a
   use m1
   use m2
+  !PORTABILITY: Procedure pointer 'p1' should not have an ELEMENTAL intrinsic as its interface
   procedure(sin), pointer :: p1 => sin
+  !PORTABILITY: Procedure pointer 'p2' should not have an ELEMENTAL intrinsic as its interface
   procedure(iabs), pointer :: p2 => iabs
   procedure(ext1), pointer :: p3 => ext1
   procedure(ext2), pointer :: p4 => ext2
@@ -44,7 +46,9 @@ subroutine s2b
   use m1, only: x1 => sin, x2 => iabs, x3 => ext1, x4 => ext2
   use m2, only: x1 => sin, x2 => iabs, x3 => ext1, x4 => ext2
   use m1, only: iface1 => sin, iface2 => iabs, iface3 => ext1, iface4 => ext2
+  !PORTABILITY: Procedure pointer 'p1' should not have an ELEMENTAL intrinsic as its interface
   procedure(iface1), pointer :: p1 => x1
+  !PORTABILITY: Procedure pointer 'p2' should not have an ELEMENTAL intrinsic as its interface
   procedure(iface2), pointer :: p2 => x2
   procedure(iface3), pointer :: p3 => x3
   procedure(iface4), pointer :: p4 => x4
@@ -56,7 +60,9 @@ module m3
 end module
 subroutine s3
   use m3
+  !PORTABILITY: Procedure pointer 'p1' should not have an ELEMENTAL intrinsic as its interface
   procedure(sin), pointer :: p1 => sin
+  !PORTABILITY: Procedure pointer 'p2' should not have an ELEMENTAL intrinsic as its interface
   procedure(iabs), pointer :: p2 => iabs
   procedure(ext1), pointer :: p3 => ext1
   procedure(ext2), pointer :: p4 => ext2
@@ -69,7 +75,9 @@ module m4
 subroutine s4
   use m4
   use m1, only: iface1 => sin, iface2 => iabs, iface3 => ext1, iface4 => ext2
+  !PORTABILITY: Procedure pointer 'p1' should not have an ELEMENTAL intrinsic as its interface
   procedure(iface1), pointer :: p1 => x1
+  !PORTABILITY: Procedure pointer 'p2' should not have an ELEMENTAL intrinsic as its interface
   procedure(iface2), pointer :: p2 => x2
   procedure(iface3), pointer :: p3 => x3
   procedure(iface4), pointer :: p4 => x4
@@ -79,8 +87,10 @@ subroutine s5
   use m1, only: x1 => sin, x2 => iabs, x3 => ext1, x4 => ext2
   use m2, only: x1 => tan, x2 => idim, x3 => ext2, x4 => ext1
   use m1, only: iface1 => sin, iface2 => iabs, iface3 => ext1, iface4 => ext2
+  !PORTABILITY: Procedure pointer 'p1' should not have an ELEMENTAL intrinsic as its interface
   !ERROR: Reference to 'x1' is ambiguous
   procedure(iface1), pointer :: p1 => x1
+  !PORTABILITY: Procedure pointer 'p2' should not have an ELEMENTAL intrinsic as its interface
   !ERROR: Reference to 'x2' is ambiguous
   procedure(iface2), pointer :: p2 => x2
   !ERROR: Reference to 'x3' is ambiguous
diff --git a/flang/test/Semantics/resolve46.f90 b/flang/test/Semantics/resolve46.f90
index 0f8d3b1c423c2..784ffa427031c 100644
--- a/flang/test/Semantics/resolve46.f90
+++ b/flang/test/Semantics/resolve46.f90
@@ -20,6 +20,7 @@ logical function chrcmp(a,b)
      end function chrcmp
   end interface
 
+  !PORTABILITY: Procedure pointer 'p' should not have an ELEMENTAL intrinsic as its interface
   procedure(sin), pointer :: p => cos
   !ERROR: Intrinsic procedure 'amin0' is not an unrestricted specific intrinsic permitted for use as the definition of the interface to procedure pointer 'q'
   procedure(amin0), pointer :: q
@@ -28,6 +29,7 @@ end function chrcmp
   !ERROR: Intrinsic procedure 'llt' is not an unrestricted specific intrinsic permitted for use as the initializer for procedure pointer 's'
   procedure(chrcmp), pointer :: s => llt
   !ERROR: Intrinsic procedure 'bessel_j0' is not an unrestricted specific intrinsic permitted for use as the initializer for procedure pointer 't'
+  !PORTABILITY: Procedure pointer 't' should not have an ELEMENTAL intrinsic as its interface
   procedure(cos), pointer :: t => bessel_j0
   procedure(chrcmp), pointer :: u
   p => alog ! valid use of an unrestricted specific intrinsic
diff --git a/flang/test/Semantics/resolve59.f90 b/flang/test/Semantics/resolve59.f90
index 7458710c52d9c..aae0aff5f072e 100644
--- a/flang/test/Semantics/resolve59.f90
+++ b/flang/test/Semantics/resolve59.f90
@@ -114,6 +114,7 @@ function f4() result(r)
   end function
   function f5(x) result(r)
     real :: x
+    !PORTABILITY: Procedure pointer 'r' should not have an ELEMENTAL intrinsic as its interface
     procedure(acos), pointer :: r
     r => acos
     !ERROR: Actual argument for 'x=' may not be a procedure