diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -391,22 +391,25 @@
   }
 
   // Definability
-  const char *reason{nullptr};
-  if (dummy.intent == common::Intent::Out) {
-    reason = "INTENT(OUT)";
-  } else if (dummy.intent == common::Intent::InOut) {
-    reason = "INTENT(IN OUT)";
-  }
-  if (reason && scope) {
-    DefinabilityFlags flags;
-    if (isElemental || dummyIsValue) { // 15.5.2.4(21)
-      flags.set(DefinabilityFlag::VectorSubscriptIsOk);
-    }
-    if (auto whyNot{WhyNotDefinable(messages.at(), *scope, flags, actual)}) {
-      if (auto *msg{messages.Say(
-              "Actual argument associated with %s %s is not definable"_err_en_US,
-              reason, dummyName)}) {
-        msg->Attach(std::move(*whyNot));
+  if (scope) {
+    const char *reason{nullptr};
+    // Problems with polymorphism are caught in the callee's definition.
+    DefinabilityFlags flags{DefinabilityFlag::PolymorphicOkInPure};
+    if (dummy.intent == common::Intent::Out) {
+      reason = "INTENT(OUT)";
+    } else if (dummy.intent == common::Intent::InOut) {
+      reason = "INTENT(IN OUT)";
+    }
+    if (reason) {
+      if (isElemental || dummyIsValue) { // 15.5.2.4(21)
+        flags.set(DefinabilityFlag::VectorSubscriptIsOk);
+      }
+      if (auto whyNot{WhyNotDefinable(messages.at(), *scope, flags, actual)}) {
+        if (auto *msg{messages.Say(
+                "Actual argument associated with %s %s is not definable"_err_en_US,
+                reason, dummyName)}) {
+          msg->Attach(std::move(*whyNot));
+        }
       }
     }
   }
diff --git a/flang/lib/Semantics/definable.h b/flang/lib/Semantics/definable.h
--- a/flang/lib/Semantics/definable.h
+++ b/flang/lib/Semantics/definable.h
@@ -27,7 +27,8 @@
 
 ENUM_CLASS(DefinabilityFlag,
     VectorSubscriptIsOk, // a vector subscript may appear (i.e., assignment)
-    PointerDefinition) // a pointer is being defined, not its target
+    PointerDefinition, // a pointer is being defined, not its target
+    PolymorphicOkInPure) // don't check for polymorphic type in pure subprogram
 
 using DefinabilityFlags =
     common::EnumSet<DefinabilityFlag, DefinabilityFlag_enumSize>;
diff --git a/flang/lib/Semantics/definable.cpp b/flang/lib/Semantics/definable.cpp
--- a/flang/lib/Semantics/definable.cpp
+++ b/flang/lib/Semantics/definable.cpp
@@ -149,7 +149,8 @@
         "'%s' is an entity with either an EVENT_TYPE or LOCK_TYPE"_en_US,
         original);
   }
-  if (FindPureProcedureContaining(scope)) {
+  if (!flags.test(DefinabilityFlag::PolymorphicOkInPure) &&
+      FindPureProcedureContaining(scope)) {
     if (auto dyType{evaluate::DynamicType::From(ultimate)}) {
       if (dyType->IsPolymorphic()) { // C1596
         return BlameSymbol(at,
diff --git a/flang/test/Semantics/call28.f90 b/flang/test/Semantics/call28.f90
new file mode 100644
--- /dev/null
+++ b/flang/test/Semantics/call28.f90
@@ -0,0 +1,22 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+
+module m1
+  type :: t
+  end type
+ contains
+  pure subroutine s1(x)
+    class(t), intent(in out) :: x
+    call s2(x)
+    call s3(x)
+  end subroutine
+  pure subroutine s2(x)
+    class(t), intent(in out) :: x
+    !ERROR: Left-hand side of assignment is not definable
+    !BECAUSE: 'x' is polymorphic in a pure subprogram
+    x = t()
+  end subroutine
+  pure subroutine s3(x)
+    !ERROR: An INTENT(OUT) dummy argument of a pure subroutine may not be polymorphic
+    class(t), intent(out) :: x
+  end subroutine
+end module