diff --git a/flang/include/flang/Runtime/descriptor.h b/flang/include/flang/Runtime/descriptor.h
--- a/flang/include/flang/Runtime/descriptor.h
+++ b/flang/include/flang/Runtime/descriptor.h
@@ -36,6 +36,7 @@
 namespace Fortran::runtime {
 
 using SubscriptValue = ISO::CFI_index_t;
+class Terminator;
 
 RT_VAR_GROUP_BEGIN
 static constexpr RT_CONST_VAR_ATTRS int maxRank{CFI_MAX_RANK};
@@ -369,7 +370,8 @@
 
   // Deallocates storage, including allocatable and automatic
   // components.  Optionally invokes FINAL subroutines.
-  RT_API_ATTRS int Destroy(bool finalize = false, bool destroyPointers = false);
+  RT_API_ATTRS int Destroy(bool finalize = false, bool destroyPointers = false,
+      Terminator * = nullptr);
 
   RT_API_ATTRS bool IsContiguous(int leadingDimensions = maxRank) const {
     auto bytes{static_cast<SubscriptValue>(ElementBytes())};
diff --git a/flang/lib/Semantics/runtime-type-info.cpp b/flang/lib/Semantics/runtime-type-info.cpp
--- a/flang/lib/Semantics/runtime-type-info.cpp
+++ b/flang/lib/Semantics/runtime-type-info.cpp
@@ -163,14 +163,14 @@
 RuntimeTableBuilder::RuntimeTableBuilder(
     SemanticsContext &c, RuntimeDerivedTypeTables &t)
     : context_{c}, tables_{t}, derivedTypeSchema_{GetSchema("derivedtype")},
-      componentSchema_{GetSchema("component")}, procPtrSchema_{GetSchema(
-                                                    "procptrcomponent")},
-      valueSchema_{GetSchema("value")}, bindingSchema_{GetSchema(
-                                            bindingDescCompName)},
-      specialSchema_{GetSchema("specialbinding")}, deferredEnum_{GetEnumValue(
-                                                       "deferred")},
-      explicitEnum_{GetEnumValue("explicit")}, lenParameterEnum_{GetEnumValue(
-                                                   "lenparameter")},
+      componentSchema_{GetSchema("component")},
+      procPtrSchema_{GetSchema("procptrcomponent")},
+      valueSchema_{GetSchema("value")},
+      bindingSchema_{GetSchema(bindingDescCompName)},
+      specialSchema_{GetSchema("specialbinding")},
+      deferredEnum_{GetEnumValue("deferred")},
+      explicitEnum_{GetEnumValue("explicit")},
+      lenParameterEnum_{GetEnumValue("lenparameter")},
       scalarAssignmentEnum_{GetEnumValue("scalarassignment")},
       elementalAssignmentEnum_{GetEnumValue("elementalassignment")},
       readFormattedEnum_{GetEnumValue("readformatted")},
@@ -588,8 +588,9 @@
           DescribeSpecialGenerics(dtScope, dtScope, derivedTypeSpec)};
       if (derivedTypeSpec) {
         for (auto &ref : FinalsForDerivedTypeInstantiation(*derivedTypeSpec)) {
-          DescribeSpecialProc(specials, *ref, false /*!isAssignment*/, true,
-              std::nullopt, nullptr, derivedTypeSpec, true);
+          DescribeSpecialProc(specials, *ref, /*isAssignment-*/ false,
+              /*isFinal=*/true, std::nullopt, nullptr, derivedTypeSpec,
+              /*isTypeBound=*/true);
         }
         IncorporateDefinedIoGenericInterfaces(specials,
             common::DefinedIo::ReadFormatted, &scope, derivedTypeSpec);
@@ -1039,8 +1040,9 @@
           [&](const GenericKind::OtherKind &k) {
             if (k == GenericKind::OtherKind::Assignment) {
               for (auto ref : generic.specificProcs()) {
-                DescribeSpecialProc(specials, *ref, true, false /*!final*/,
-                    std::nullopt, &dtScope, derivedTypeSpec, true);
+                DescribeSpecialProc(specials, *ref, /*isAssignment=*/true,
+                    /*isFinal=*/false, std::nullopt, &dtScope, derivedTypeSpec,
+                    /*isTypeBound=*/true);
               }
             }
           },
@@ -1051,8 +1053,9 @@
             case common::DefinedIo::WriteFormatted:
             case common::DefinedIo::WriteUnformatted:
               for (auto ref : generic.specificProcs()) {
-                DescribeSpecialProc(specials, *ref, false, false /*!final*/, io,
-                    &dtScope, derivedTypeSpec, true);
+                DescribeSpecialProc(specials, *ref, /*isAssignment=*/false,
+                    /*isFinal=*/false, io, &dtScope, derivedTypeSpec,
+                    /*isTypeBound=*/true);
               }
               break;
             }
@@ -1076,6 +1079,7 @@
   if (auto proc{evaluate::characteristics::Procedure::Characterize(
           specific, context_.foldingContext())}) {
     std::uint8_t isArgDescriptorSet{0};
+    std::uint8_t isArgContiguousSet{0};
     int argThatMightBeDescriptor{0};
     MaybeExpr which;
     if (isAssignment) {
@@ -1115,10 +1119,10 @@
       if (proc->IsElemental()) {
         which = elementalFinalEnum_;
       } else {
-        const auto &typeAndShape{
+        const auto &dummyData{
             std::get<evaluate::characteristics::DummyDataObject>(
-                proc->dummyArguments.at(0).u)
-                .type};
+                proc->dummyArguments.at(0).u)};
+        const auto &typeAndShape{dummyData.type};
         if (typeAndShape.attrs().test(
                 evaluate::characteristics::TypeAndShape::Attr::AssumedRank)) {
           which = assumedRankFinalEnum_;
@@ -1126,8 +1130,16 @@
         } else {
           which = scalarFinalEnum_;
           if (int rank{evaluate::GetRank(typeAndShape.shape())}; rank > 0) {
-            argThatMightBeDescriptor = 1;
             which = IntExpr<1>(ToInt64(which).value() + rank);
+            if (!proc->dummyArguments[0].CanBePassedViaImplicitInterface()) {
+              argThatMightBeDescriptor = 1;
+            }
+            if (!typeAndShape.attrs().test(evaluate::characteristics::
+                        TypeAndShape::Attr::AssumedShape) ||
+                dummyData.attrs.test(evaluate::characteristics::
+                        DummyDataObject::Attr::Contiguous)) {
+              isArgContiguousSet |= 1;
+            }
           }
         }
       }
@@ -1176,6 +1188,8 @@
         IntExpr<1>(isArgDescriptorSet));
     AddValue(values, specialSchema_, "istypebound"s,
         IntExpr<1>(isTypeBound ? 1 : 0));
+    AddValue(values, specialSchema_, "isargcontiguousset"s,
+        IntExpr<1>(isArgContiguousSet));
     AddValue(values, specialSchema_, procCompName,
         SomeExpr{evaluate::ProcedureDesignator{specific}});
     // index might already be present in the case of an override
@@ -1219,9 +1233,7 @@
 // dummy argument.  Returns a non-null DeclTypeSpec pointer only if that
 // dtv argument exists and is a derived type.
 static const DeclTypeSpec *GetDefinedIoSpecificArgType(const Symbol &specific) {
-  const Symbol *interface {
-    &specific.GetUltimate()
-  };
+  const Symbol *interface{&specific.GetUltimate()};
   if (const auto *procEntity{specific.detailsIf<ProcEntityDetails>()}) {
     interface = procEntity->procInterface();
   }
diff --git a/flang/module/__fortran_type_info.f90 b/flang/module/__fortran_type_info.f90
--- a/flang/module/__fortran_type_info.f90
+++ b/flang/module/__fortran_type_info.f90
@@ -109,7 +109,8 @@
     integer(1) :: which ! SpecialBinding::Which
     integer(1) :: isArgDescriptorSet
     integer(1) :: isTypeBound
-    integer(1) :: __padding0(5)
+    integer(1) :: isArgContiguousSet
+    integer(1) :: __padding0(4)
     type(__builtin_c_funptr) :: proc
   end type
 
diff --git a/flang/runtime/allocatable.cpp b/flang/runtime/allocatable.cpp
--- a/flang/runtime/allocatable.cpp
+++ b/flang/runtime/allocatable.cpp
@@ -78,7 +78,8 @@
   }
 
   if (to.IsAllocated()) {
-    int stat{to.Destroy(/*finalize=*/true)};
+    int stat{
+        to.Destroy(/*finalize=*/true, /*destroyPointers=*/false, &terminator)};
     if (stat != StatOk) {
       return ReturnError(terminator, stat, errMsg, hasStat);
     }
@@ -188,7 +189,10 @@
   if (!descriptor.IsAllocated()) {
     return ReturnError(terminator, StatBaseNull, errMsg, hasStat);
   }
-  return ReturnError(terminator, descriptor.Destroy(true), errMsg, hasStat);
+  return ReturnError(terminator,
+      descriptor.Destroy(
+          /*finalize=*/true, /*destroyPointers=*/false, &terminator),
+      errMsg, hasStat);
 }
 
 int RTNAME(AllocatableDeallocatePolymorphic)(Descriptor &descriptor,
@@ -218,7 +222,9 @@
   } else if (!descriptor.IsAllocated()) {
     ReturnError(terminator, StatBaseNull);
   } else {
-    ReturnError(terminator, descriptor.Destroy(false));
+    ReturnError(terminator,
+        descriptor.Destroy(
+            /*finalize=*/false, /*destroyPointers=*/false, &terminator));
   }
 }
 
diff --git a/flang/runtime/assign.cpp b/flang/runtime/assign.cpp
--- a/flang/runtime/assign.cpp
+++ b/flang/runtime/assign.cpp
@@ -11,6 +11,7 @@
 #include "derived.h"
 #include "stat.h"
 #include "terminator.h"
+#include "tools.h"
 #include "type-info.h"
 #include "flang/Runtime/descriptor.h"
 
@@ -299,18 +300,7 @@
           RTNAME(AssignTemporary)
           (newFrom, from, terminator.sourceFileName(), terminator.sourceLine());
         } else {
-          char *toAt{newFrom.OffsetElement()};
-          std::size_t fromElements{from.Elements()};
-          if (from.IsContiguous()) {
-            std::memcpy(
-                toAt, from.OffsetElement(), fromElements * fromElementBytes);
-          } else {
-            SubscriptValue fromAt[maxRank];
-            for (from.GetLowerBounds(fromAt); fromElements-- > 0;
-                 toAt += fromElementBytes, from.IncrementSubscripts(fromAt)) {
-              std::memcpy(toAt, from.Element<char>(fromAt), fromElementBytes);
-            }
-          }
+          ShallowCopy(newFrom, from, true, from.IsContiguous());
         }
         Assign(to, newFrom, terminator,
             flags &
@@ -325,11 +315,12 @@
     if (mustDeallocateLHS) {
       if (deferDeallocation) {
         if ((flags & NeedFinalization) && toDerived) {
-          Finalize(to, *toDerived);
+          Finalize(to, *toDerived, &terminator);
           flags &= ~NeedFinalization;
         }
       } else {
-        to.Destroy((flags & NeedFinalization) != 0);
+        to.Destroy((flags & NeedFinalization) != 0, /*destroyPointers=*/false,
+            &terminator);
         flags &= ~NeedFinalization;
       }
     } else if (to.rank() != from.rank() && !to.IsAllocated()) {
@@ -394,7 +385,7 @@
     // for all components, including parent components (10.2.1.2-3).
     // The target is first finalized if still necessary (7.5.6.3(1))
     if (flags & NeedFinalization) {
-      Finalize(to, *updatedToDerived);
+      Finalize(to, *updatedToDerived, &terminator);
     }
     // Copy the data components (incl. the parent) first.
     const Descriptor &componentDesc{updatedToDerived->component()};
@@ -467,7 +458,8 @@
               // This is just a shortcut, because the recursive Assign()
               // below would initiate the destruction for to.
               // No finalization is required.
-              toDesc->Destroy();
+              toDesc->Destroy(
+                  /*finalize=*/false, /*destroyPointers=*/false, &terminator);
               continue; // F'2018 10.2.1.3(13)(2)
             }
           }
@@ -526,7 +518,8 @@
   if (deferDeallocation) {
     // deferDeallocation is used only when LHS is an allocatable.
     // The finalization has already been run for it.
-    deferDeallocation->Destroy();
+    deferDeallocation->Destroy(
+        /*finalize=*/false, /*destroyPointers=*/false, &terminator);
   }
 }
 
diff --git a/flang/runtime/derived-api.cpp b/flang/runtime/derived-api.cpp
--- a/flang/runtime/derived-api.cpp
+++ b/flang/runtime/derived-api.cpp
@@ -33,7 +33,9 @@
   if (const DescriptorAddendum * addendum{descriptor.Addendum()}) {
     if (const auto *derived{addendum->derivedType()}) {
       if (!derived->noDestructionNeeded()) {
-        Destroy(descriptor, true, *derived);
+        // TODO: Pass source file & line information to the API
+        // so that a good Terminator can be passed
+        Destroy(descriptor, true, *derived, nullptr);
       }
     }
   }
@@ -160,7 +162,7 @@
   if (const DescriptorAddendum * addendum{descriptor.Addendum()}) {
     if (const auto *derived{addendum->derivedType()}) {
       if (!derived->noDestructionNeeded()) {
-        Destroy(descriptor, /*finalize=*/false, *derived);
+        Destroy(descriptor, /*finalize=*/false, *derived, nullptr);
       }
     }
   }
diff --git a/flang/runtime/derived.h b/flang/runtime/derived.h
--- a/flang/runtime/derived.h
+++ b/flang/runtime/derived.h
@@ -25,11 +25,13 @@
     bool hasStat = false, const Descriptor *errMsg = nullptr);
 
 // Call FINAL subroutines, if any
-void Finalize(const Descriptor &, const typeInfo::DerivedType &derived);
+void Finalize(
+    const Descriptor &, const typeInfo::DerivedType &derived, Terminator *);
 
 // Call FINAL subroutines, deallocate allocatable & automatic components.
 // Does not deallocate the original descriptor.
-void Destroy(const Descriptor &, bool finalize, const typeInfo::DerivedType &);
+void Destroy(const Descriptor &, bool finalize, const typeInfo::DerivedType &,
+    Terminator *);
 
 // Return true if the passed descriptor is for a derived type
 // entity that has a dynamic (allocatable, automatic) component.
diff --git a/flang/runtime/derived.cpp b/flang/runtime/derived.cpp
--- a/flang/runtime/derived.cpp
+++ b/flang/runtime/derived.cpp
@@ -9,6 +9,7 @@
 #include "derived.h"
 #include "stat.h"
 #include "terminator.h"
+#include "tools.h"
 #include "type-info.h"
 #include "flang/Runtime/descriptor.h"
 
@@ -124,11 +125,9 @@
   }
 }
 
-static void CallFinalSubroutine(
-    const Descriptor &descriptor, const typeInfo::DerivedType &derived) {
+static void CallFinalSubroutine(const Descriptor &descriptor,
+    const typeInfo::DerivedType &derived, Terminator *terminator) {
   if (const auto *special{FindFinal(derived, descriptor.rank())}) {
-    // The following code relies on the fact that finalizable objects
-    // must be contiguous.
     if (special->which() == typeInfo::SpecialBinding::Which::ElementalFinal) {
       std::size_t byteStride{descriptor.ElementBytes()};
       std::size_t elements{descriptor.Elements()};
@@ -150,28 +149,51 @@
           p(descriptor.OffsetElement<char>(j * byteStride));
         }
       }
-    } else if (special->IsArgDescriptor(0)) {
-      StaticDescriptor<maxRank, true, 8 /*?*/> statDesc;
-      Descriptor &tmpDesc{statDesc.descriptor()};
-      tmpDesc = descriptor;
-      tmpDesc.raw().attribute = CFI_attribute_pointer;
-      tmpDesc.Addendum()->set_derivedType(&derived);
-      auto *p{special->GetProc<void (*)(const Descriptor &)>()};
-      p(tmpDesc);
     } else {
-      auto *p{special->GetProc<void (*)(char *)>()};
-      p(descriptor.OffsetElement<char>());
+      StaticDescriptor<maxRank, true, 10> statDesc;
+      Descriptor &copy{statDesc.descriptor()};
+      const Descriptor *argDescriptor{&descriptor};
+      if (descriptor.rank() > 0 && special->IsArgContiguous(0) &&
+          !descriptor.IsContiguous()) {
+        // The FINAL subroutine demands a contiguous array argument, but
+        // this INTENT(OUT) or intrinsic assignment LHS isn't contiguous.
+        // Finalize a shallow copy of the data.
+        copy = descriptor;
+        copy.set_base_addr(nullptr);
+        copy.raw().attribute = CFI_attribute_allocatable;
+        Terminator stubTerminator{"CallFinalProcedure() in Fortran runtime", 0};
+        RUNTIME_CHECK(terminator ? *terminator : stubTerminator,
+            copy.Allocate() == CFI_SUCCESS);
+        ShallowCopyDiscontiguousToContiguous(copy, descriptor);
+        argDescriptor = &copy;
+      }
+      if (special->IsArgDescriptor(0)) {
+        StaticDescriptor<maxRank, true, 8 /*?*/> statDesc;
+        Descriptor &tmpDesc{statDesc.descriptor()};
+        tmpDesc = *argDescriptor;
+        tmpDesc.raw().attribute = CFI_attribute_pointer;
+        tmpDesc.Addendum()->set_derivedType(&derived);
+        auto *p{special->GetProc<void (*)(const Descriptor &)>()};
+        p(tmpDesc);
+      } else {
+        auto *p{special->GetProc<void (*)(char *)>()};
+        p(argDescriptor->OffsetElement<char>());
+      }
+      if (argDescriptor == &copy) {
+        ShallowCopyContiguousToDiscontiguous(descriptor, copy);
+        copy.Deallocate();
+      }
     }
   }
 }
 
 // Fortran 2018 subclause 7.5.6.2
-void Finalize(
-    const Descriptor &descriptor, const typeInfo::DerivedType &derived) {
+void Finalize(const Descriptor &descriptor,
+    const typeInfo::DerivedType &derived, Terminator *terminator) {
   if (derived.noFinalizationNeeded() || !descriptor.IsAllocated()) {
     return;
   }
-  CallFinalSubroutine(descriptor, derived);
+  CallFinalSubroutine(descriptor, derived, terminator);
   const auto *parentType{derived.GetParentType()};
   bool recurse{parentType && !parentType->noFinalizationNeeded()};
   // If there's a finalizable parent component, handle it last, as required
@@ -181,9 +203,9 @@
   std::size_t myComponents{componentDesc.Elements()};
   std::size_t elements{descriptor.Elements()};
   std::size_t byteStride{descriptor.ElementBytes()};
-  for (auto k{recurse
-               ? std::size_t{1} /* skip first component, it's the parent */
-               : 0};
+  for (auto k{recurse ? std::size_t{1}
+                      /* skip first component, it's the parent */
+                      : 0};
        k < myComponents; ++k) {
     const auto &comp{
         *componentDesc.ZeroBasedIndexedElement<typeInfo::Component>(k)};
@@ -195,7 +217,7 @@
             const Descriptor &compDesc{*descriptor.OffsetElement<Descriptor>(
                 j * byteStride + comp.offset())};
             if (compDesc.IsAllocated()) {
-              Finalize(compDesc, *compType);
+              Finalize(compDesc, *compType, terminator);
             }
           }
         }
@@ -217,12 +239,12 @@
         compDesc.Establish(compType,
             descriptor.OffsetElement<char>(j * byteStride + comp.offset()),
             comp.rank(), extent);
-        Finalize(compDesc, compType);
+        Finalize(compDesc, compType, terminator);
       }
     }
   }
   if (recurse) {
-    Finalize(descriptor, *parentType);
+    Finalize(descriptor, *parentType, terminator);
   }
 }
 
@@ -231,12 +253,12 @@
 // before parent component finalization, and with all finalization
 // preceding any deallocation.
 void Destroy(const Descriptor &descriptor, bool finalize,
-    const typeInfo::DerivedType &derived) {
+    const typeInfo::DerivedType &derived, Terminator *terminator) {
   if (derived.noDestructionNeeded() || !descriptor.IsAllocated()) {
     return;
   }
   if (finalize && !derived.noFinalizationNeeded()) {
-    Finalize(descriptor, derived);
+    Finalize(descriptor, derived, terminator);
   }
   const Descriptor &componentDesc{derived.component()};
   std::size_t myComponents{componentDesc.Elements()};
diff --git a/flang/runtime/descriptor-io.h b/flang/runtime/descriptor-io.h
--- a/flang/runtime/descriptor-io.h
+++ b/flang/runtime/descriptor-io.h
@@ -315,7 +315,8 @@
         typeInfo::SpecialBinding special{DIR == Direction::Input
                 ? typeInfo::SpecialBinding::Which::ReadFormatted
                 : typeInfo::SpecialBinding::Which::WriteFormatted,
-            definedIo->subroutine, definedIo->isDtvArgPolymorphic, false};
+            definedIo->subroutine, definedIo->isDtvArgPolymorphic, false,
+            false};
         if (std::optional<bool> wasDefined{
                 DefinedFormattedIo(io, descriptor, *type, special)}) {
           return *wasDefined;
@@ -359,7 +360,8 @@
           typeInfo::SpecialBinding special{DIR == Direction::Input
                   ? typeInfo::SpecialBinding::Which::ReadUnformatted
                   : typeInfo::SpecialBinding::Which::WriteUnformatted,
-              definedIo->subroutine, definedIo->isDtvArgPolymorphic, false};
+              definedIo->subroutine, definedIo->isDtvArgPolymorphic, false,
+              false};
           if (std::optional<bool> wasDefined{
                   DefinedUnformattedIo(io, descriptor, *type, special)}) {
             return *wasDefined;
diff --git a/flang/runtime/descriptor.cpp b/flang/runtime/descriptor.cpp
--- a/flang/runtime/descriptor.cpp
+++ b/flang/runtime/descriptor.cpp
@@ -159,14 +159,15 @@
   return 0;
 }
 
-int Descriptor::Destroy(bool finalize, bool destroyPointers) {
+int Descriptor::Destroy(
+    bool finalize, bool destroyPointers, Terminator *terminator) {
   if (!destroyPointers && raw_.attribute == CFI_attribute_pointer) {
     return StatOk;
   } else {
     if (auto *addendum{Addendum()}) {
       if (const auto *derived{addendum->derivedType()}) {
         if (!derived->noDestructionNeeded()) {
-          runtime::Destroy(*this, finalize, *derived);
+          runtime::Destroy(*this, finalize, *derived, terminator);
         }
       }
     }
diff --git a/flang/runtime/pointer.cpp b/flang/runtime/pointer.cpp
--- a/flang/runtime/pointer.cpp
+++ b/flang/runtime/pointer.cpp
@@ -175,7 +175,9 @@
   if (!pointer.IsAllocated()) {
     return ReturnError(terminator, StatBaseNull, errMsg, hasStat);
   }
-  return ReturnError(terminator, pointer.Destroy(true, true), errMsg, hasStat);
+  return ReturnError(terminator,
+      pointer.Destroy(/*finalize=*/true, /*destroyPointers=*/true, &terminator),
+      errMsg, hasStat);
 }
 
 int RTNAME(PointerDeallocatePolymorphic)(Descriptor &pointer,
diff --git a/flang/runtime/tools.h b/flang/runtime/tools.h
--- a/flang/runtime/tools.h
+++ b/flang/runtime/tools.h
@@ -381,5 +381,18 @@
       std::memchr(data, static_cast<int>(ch), chars));
 }
 
+// Copy payload data from one allocated descriptor to another.
+// Assumes element counts and element sizes match, and that both
+// descriptors are allocated.
+void ShallowCopyDiscontiguousToDiscontiguous(
+    const Descriptor &to, const Descriptor &from);
+void ShallowCopyDiscontiguousToContiguous(
+    const Descriptor &to, const Descriptor &from);
+void ShallowCopyContiguousToDiscontiguous(
+    const Descriptor &to, const Descriptor &from);
+void ShallowCopy(const Descriptor &to, const Descriptor &from,
+    bool toIsContiguous, bool fromIsContiguous);
+void ShallowCopy(const Descriptor &to, const Descriptor &from);
+
 } // namespace Fortran::runtime
 #endif // FORTRAN_RUNTIME_TOOLS_H_
diff --git a/flang/runtime/tools.cpp b/flang/runtime/tools.cpp
--- a/flang/runtime/tools.cpp
+++ b/flang/runtime/tools.cpp
@@ -110,4 +110,63 @@
         "not yet implemented: %s: KIND=%d argument", intrinsic, kind);
   }
 }
+
+void ShallowCopyDiscontiguousToDiscontiguous(
+    const Descriptor &to, const Descriptor &from) {
+  SubscriptValue toAt[maxRank], fromAt[maxRank];
+  to.GetLowerBounds(toAt);
+  from.GetLowerBounds(fromAt);
+  std::size_t elementBytes{to.ElementBytes()};
+  for (std::size_t n{to.Elements()}; n-- > 0;
+       to.IncrementSubscripts(toAt), from.IncrementSubscripts(fromAt)) {
+    std::memcpy(
+        to.Element<char>(toAt), from.Element<char>(fromAt), elementBytes);
+  }
+}
+
+void ShallowCopyDiscontiguousToContiguous(
+    const Descriptor &to, const Descriptor &from) {
+  char *toAt{to.OffsetElement()};
+  SubscriptValue fromAt[maxRank];
+  from.GetLowerBounds(fromAt);
+  std::size_t elementBytes{to.ElementBytes()};
+  for (std::size_t n{to.Elements()}; n-- > 0;
+       toAt += elementBytes, from.IncrementSubscripts(fromAt)) {
+    std::memcpy(toAt, from.Element<char>(fromAt), elementBytes);
+  }
+}
+
+void ShallowCopyContiguousToDiscontiguous(
+    const Descriptor &to, const Descriptor &from) {
+  SubscriptValue toAt[maxRank];
+  to.GetLowerBounds(toAt);
+  char *fromAt{from.OffsetElement()};
+  std::size_t elementBytes{to.ElementBytes()};
+  for (std::size_t n{to.Elements()}; n-- > 0;
+       to.IncrementSubscripts(toAt), fromAt += elementBytes) {
+    std::memcpy(to.Element<char>(toAt), fromAt, elementBytes);
+  }
+}
+
+void ShallowCopy(const Descriptor &to, const Descriptor &from,
+    bool toIsContiguous, bool fromIsContiguous) {
+  if (toIsContiguous) {
+    if (fromIsContiguous) {
+      std::memcpy(to.OffsetElement(), from.OffsetElement(),
+          to.Elements() * to.ElementBytes());
+    } else {
+      ShallowCopyDiscontiguousToContiguous(to, from);
+    }
+  } else {
+    if (fromIsContiguous) {
+      ShallowCopyContiguousToDiscontiguous(to, from);
+    } else {
+      ShallowCopyDiscontiguousToDiscontiguous(to, from);
+    }
+  }
+}
+
+void ShallowCopy(const Descriptor &to, const Descriptor &from) {
+  ShallowCopy(to, from, to.IsContiguous(), from.IsContiguous());
+}
 } // namespace Fortran::runtime
diff --git a/flang/runtime/type-info.h b/flang/runtime/type-info.h
--- a/flang/runtime/type-info.h
+++ b/flang/runtime/type-info.h
@@ -136,9 +136,10 @@
   // Special bindings can be created during execution to handle defined
   // I/O procedures that are not type-bound.
   SpecialBinding(Which which, ProcedurePointer proc, std::uint8_t isArgDescSet,
-      std::uint8_t isTypeBound)
+      std::uint8_t isTypeBound, std::uint8_t isArgContiguousSet)
       : which_{which}, isArgDescriptorSet_{isArgDescSet},
-        isTypeBound_{isTypeBound}, proc_{proc} {}
+        isTypeBound_{isTypeBound}, isArgContiguousSet_{isArgContiguousSet},
+        proc_{proc} {}
 
   static constexpr Which RankFinal(int rank) {
     return static_cast<Which>(static_cast<int>(Which::ScalarFinal) + rank);
@@ -149,6 +150,9 @@
     return (isArgDescriptorSet_ >> zeroBasedArg) & 1;
   }
   bool isTypeBound() const { return isTypeBound_; }
+  bool IsArgContiguous(int zeroBasedArg) const {
+    return (isArgContiguousSet_ >> zeroBasedArg) & 1;
+  }
   template <typename PROC> PROC GetProc() const {
     return reinterpret_cast<PROC>(proc_);
   }
@@ -185,6 +189,9 @@
   //     called via a generic interface, not a generic TBP.
   std::uint8_t isArgDescriptorSet_{0};
   std::uint8_t isTypeBound_{0};
+  // True when a FINAL subroutine has a dummy argument that is an array that
+  // is CONTIGUOUS or neither assumed-rank nor assumed-shape.
+  std::uint8_t isArgContiguousSet_{0};
 
   ProcedurePointer proc_{nullptr};
 };
diff --git a/flang/runtime/type-info.cpp b/flang/runtime/type-info.cpp
--- a/flang/runtime/type-info.cpp
+++ b/flang/runtime/type-info.cpp
@@ -313,6 +313,8 @@
     break;
   }
   std::fprintf(f, "    isArgDescriptorSet: 0x%x\n", isArgDescriptorSet_);
+  std::fprintf(f, "    isTypeBound: 0x%x\n", isTypeBound_);
+  std::fprintf(f, "    isArgContiguousSet: 0x%x\n", isArgContiguousSet_);
   std::fprintf(f, "    proc: %p\n", reinterpret_cast<void *>(proc_));
   return f;
 }
diff --git a/flang/test/Semantics/typeinfo01.f90 b/flang/test/Semantics/typeinfo01.f90
--- a/flang/test/Semantics/typeinfo01.f90
+++ b/flang/test/Semantics/typeinfo01.f90
@@ -88,7 +88,7 @@
 !CHECK: .c.t2, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(component) shape: 0_8:0_8 init:[component::component(name=.n.t,genre=1_1,category=5_1,kind=0_1,rank=0_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),derived=.dt.t,lenvalue=NULL(),bounds=NULL(),initialization=NULL())]
 !CHECK: .dt.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=.v.t,name=.n.t,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=.s.t,specialbitset=2_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1)
 !CHECK: .dt.t2, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=.v.t2,name=.n.t2,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.t2,procptr=NULL(),special=NULL(),specialbitset=0_4,hasparent=1_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1)
-!CHECK: .s.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(specialbinding) shape: 0_8:0_8 init:[specialbinding::specialbinding(which=1_1,isargdescriptorset=3_1,istypebound=1_1,proc=s1)]
+!CHECK: .s.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(specialbinding) shape: 0_8:0_8 init:[specialbinding::specialbinding(which=1_1,isargdescriptorset=3_1,istypebound=1_1,isargcontiguousset=0_1,proc=s1)]
 !CHECK: .v.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(binding) shape: 0_8:0_8 init:[binding::binding(proc=s1,name=.n.s1)]
 !CHECK: .v.t2, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(binding) shape: 0_8:0_8 init:[binding::binding(proc=s2,name=.n.s1)]
 end module
@@ -105,14 +105,14 @@
     class(t), intent(in) :: y
   end subroutine
 !CHECK: .dt.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=.v.t,name=.n.t,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=.s.t,specialbitset=4_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1)
-!CHECK: .s.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(specialbinding) shape: 0_8:0_8 init:[specialbinding::specialbinding(which=2_1,isargdescriptorset=3_1,istypebound=1_1,proc=s1)]
+!CHECK: .s.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(specialbinding) shape: 0_8:0_8 init:[specialbinding::specialbinding(which=2_1,isargdescriptorset=3_1,istypebound=1_1,isargcontiguousset=0_1,proc=s1)]
 !CHECK: .v.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(binding) shape: 0_8:0_8 init:[binding::binding(proc=s1,name=.n.s1)]
 end module
 
 module m08
   type :: t
    contains
-    final :: s1, s2, s3
+    final :: s1, s2, s3, s4
   end type
  contains
   subroutine s1(x)
@@ -124,8 +124,11 @@
   impure elemental subroutine s3(x)
     type(t), intent(in) :: x
   end subroutine
-!CHECK: .dt.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=.s.t,specialbitset=3200_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=0_1,nofinalizationneeded=0_1)
-!CHECK: .s.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(specialbinding) shape: 0_8:2_8 init:[specialbinding::specialbinding(which=7_1,isargdescriptorset=0_1,istypebound=1_1,proc=s3),specialbinding(which=10_1,isargdescriptorset=1_1,istypebound=1_1,proc=s1),specialbinding(which=11_1,isargdescriptorset=0_1,istypebound=1_1,proc=s2)]
+  subroutine s4(x)
+    type(t), contiguous :: x(:,:,:)
+  end subroutine
+!CHECK: .dt.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=.s.t,specialbitset=7296_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=0_1,nofinalizationneeded=0_1)
+!CHECK: .s.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(specialbinding) shape: 0_8:3_8 init:[specialbinding::specialbinding(which=7_1,isargdescriptorset=0_1,istypebound=1_1,isargcontiguousset=0_1,proc=s3),specialbinding(which=10_1,isargdescriptorset=1_1,istypebound=1_1,isargcontiguousset=0_1,proc=s1),specialbinding(which=11_1,isargdescriptorset=0_1,istypebound=1_1,isargcontiguousset=1_1,proc=s2),specialbinding(which=12_1,isargdescriptorset=1_1,istypebound=1_1,isargcontiguousset=1_1,proc=s4)]
 end module
 
 module m09
@@ -167,7 +170,7 @@
     character(len=*), intent(inout) :: iomsg
   end subroutine
 !CHECK: .dt.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=.v.t,name=.n.t,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=.s.t,specialbitset=120_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1)
-!CHECK: .s.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(specialbinding) shape: 0_8:3_8 init:[specialbinding::specialbinding(which=3_1,isargdescriptorset=1_1,istypebound=1_1,proc=rf),specialbinding(which=4_1,isargdescriptorset=1_1,istypebound=1_1,proc=ru),specialbinding(which=5_1,isargdescriptorset=1_1,istypebound=1_1,proc=wf),specialbinding(which=6_1,isargdescriptorset=1_1,istypebound=1_1,proc=wu)]
+!CHECK: .s.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(specialbinding) shape: 0_8:3_8 init:[specialbinding::specialbinding(which=3_1,isargdescriptorset=1_1,istypebound=1_1,isargcontiguousset=0_1,proc=rf),specialbinding(which=4_1,isargdescriptorset=1_1,istypebound=1_1,isargcontiguousset=0_1,proc=ru),specialbinding(which=5_1,isargdescriptorset=1_1,istypebound=1_1,isargcontiguousset=0_1,proc=wf),specialbinding(which=6_1,isargdescriptorset=1_1,istypebound=1_1,isargcontiguousset=0_1,proc=wu)]
 !CHECK: .v.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(binding) shape: 0_8:3_8 init:[binding::binding(proc=rf,name=.n.rf),binding(proc=ru,name=.n.ru),binding(proc=wf,name=.n.wf),binding(proc=wu,name=.n.wu)]
 end module
 
@@ -216,7 +219,7 @@
     character(len=*), intent(inout) :: iomsg
   end subroutine
 !CHECK: .dt.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=.s.t,specialbitset=120_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1)
-!CHECK: .s.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(specialbinding) shape: 0_8:3_8 init:[specialbinding::specialbinding(which=3_1,isargdescriptorset=0_1,istypebound=0_1,proc=rf),specialbinding(which=4_1,isargdescriptorset=0_1,istypebound=0_1,proc=ru),specialbinding(which=5_1,isargdescriptorset=0_1,istypebound=0_1,proc=wf),specialbinding(which=6_1,isargdescriptorset=0_1,istypebound=0_1,proc=wu)]
+!CHECK: .s.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(specialbinding) shape: 0_8:3_8 init:[specialbinding::specialbinding(which=3_1,isargdescriptorset=0_1,istypebound=0_1,isargcontiguousset=0_1,proc=rf),specialbinding(which=4_1,isargdescriptorset=0_1,istypebound=0_1,isargcontiguousset=0_1,proc=ru),specialbinding(which=5_1,isargdescriptorset=0_1,istypebound=0_1,isargcontiguousset=0_1,proc=wf),specialbinding(which=6_1,isargdescriptorset=0_1,istypebound=0_1,isargcontiguousset=0_1,proc=wu)]
 end module
 
 module m11
@@ -259,7 +262,7 @@
    contains
     procedure :: assign1, assign2
     generic :: assignment(=) => assign1, assign2
-    ! CHECK: .s.t1, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(specialbinding) shape: 0_8:0_8 init:[specialbinding::specialbinding(which=2_1,isargdescriptorset=3_1,istypebound=1_1,proc=assign1)]
+    ! CHECK: .s.t1, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(specialbinding) shape: 0_8:0_8 init:[specialbinding::specialbinding(which=2_1,isargdescriptorset=3_1,istypebound=1_1,isargcontiguousset=0_1,proc=assign1)]
   end type
  contains
   impure elemental subroutine assign1(to, from)
diff --git a/flang/test/Semantics/typeinfo02.f90 b/flang/test/Semantics/typeinfo02.f90
--- a/flang/test/Semantics/typeinfo02.f90
+++ b/flang/test/Semantics/typeinfo02.f90
@@ -29,5 +29,5 @@
     character(len=*), intent(inout) :: iomsg
   end subroutine
 end module
-!CHECK: .s.base, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(specialbinding) shape: 0_8:0_8 init:[specialbinding::specialbinding(which=5_1,isargdescriptorset=1_1,istypebound=1_1,proc=wf1)]
-!CHECK: .s.extended, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(specialbinding) shape: 0_8:0_8 init:[specialbinding::specialbinding(which=5_1,isargdescriptorset=1_1,istypebound=1_1,proc=wf2)]
+!CHECK: .s.base, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(specialbinding) shape: 0_8:0_8 init:[specialbinding::specialbinding(which=5_1,isargdescriptorset=1_1,istypebound=1_1,isargcontiguousset=0_1,proc=wf1)]
+!CHECK: .s.extended, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(specialbinding) shape: 0_8:0_8 init:[specialbinding::specialbinding(which=5_1,isargdescriptorset=1_1,istypebound=1_1,isargcontiguousset=0_1,proc=wf2)]