diff --git a/flang/include/flang/Runtime/allocatable.h b/flang/include/flang/Runtime/allocatable.h
--- a/flang/include/flang/Runtime/allocatable.h
+++ b/flang/include/flang/Runtime/allocatable.h
@@ -32,6 +32,8 @@
     int kind = 1, int rank = 0, int corank = 0);
 void RTNAME(AllocatableInitDerived)(
     Descriptor &, const typeInfo::DerivedType &, int rank = 0, int corank = 0);
+void RTNAME(AllocatableInitFromUnlimitedPolymorphicSource)(
+    Descriptor &, const Descriptor &, int rank = 0, int corank = 0);
 
 // Checks that an allocatable is not already allocated in statements
 // with STAT=.  Use this on a value descriptor before setting bounds or
diff --git a/flang/include/flang/Runtime/pointer.h b/flang/include/flang/Runtime/pointer.h
--- a/flang/include/flang/Runtime/pointer.h
+++ b/flang/include/flang/Runtime/pointer.h
@@ -27,6 +27,8 @@
     int kind = 1, int rank = 0, int corank = 0);
 void RTNAME(PointerNullifyDerived)(
     Descriptor &, const typeInfo::DerivedType &, int rank = 0, int corank = 0);
+void RTNAME(PointerNullifyFromUnlimitedPolymorphicSource)(
+    Descriptor &, const Descriptor &, int rank = 0, int corank = 0);
 
 // Explicitly sets the bounds of an initialized disassociated pointer.
 // The upper cobound is ignored for the last codimension.
diff --git a/flang/lib/Lower/Allocatable.cpp b/flang/lib/Lower/Allocatable.cpp
--- a/flang/lib/Lower/Allocatable.cpp
+++ b/flang/lib/Lower/Allocatable.cpp
@@ -566,11 +566,10 @@
     if (alloc.type.IsPolymorphic()) {
       assert(sourceExpr->GetType() && "null type not expected");
       if (alloc.type.IsUnlimitedPolymorphic() &&
-          sourceExpr->GetType()->IsUnlimitedPolymorphic())
-        TODO(loc, "allocate unlimited polymorphic entity from unlimited "
-                  "polymorphic source");
-
-      if (sourceExpr->GetType()->category() == TypeCategory::Derived) {
+          sourceExpr->GetType()->IsUnlimitedPolymorphic()) {
+        genInitFromUnlimitedPolymorphic(box, sourceExv,
+                                        alloc.getSymbol().Rank());
+      } else if (sourceExpr->GetType()->category() == TypeCategory::Derived) {
         mlir::Type tdescType =
             fir::TypeDescType::get(mlir::NoneType::get(builder.getContext()));
         mlir::Value typeDescAddr = builder.create<fir::BoxTypeDescOp>(
@@ -656,6 +655,34 @@
     builder.create<fir::CallOp>(loc, callee, args);
   }
 
+  /// Generate call to PointerNullifyFromUnlimitedPolymorphicSource or
+  /// AllocatableInitFromUnlimitedPolymorphicSource to set the dynamic type
+  /// information for an unlimited polymorphic entity from an unlimited
+  /// polymorphic source.
+  void genInitFromUnlimitedPolymorphic(const fir::MutableBoxValue &box,
+                                       fir::ExtendedValue source, int rank,
+                                       int corank = 0) {
+    mlir::func::FuncOp callee =
+        box.isPointer()
+            ? fir::runtime::getRuntimeFunc<mkRTKey(
+                  PointerNullifyFromUnlimitedPolymorphicSource)>(loc, builder)
+            : fir::runtime::getRuntimeFunc<mkRTKey(
+                  AllocatableInitFromUnlimitedPolymorphicSource)>(loc, builder);
+    llvm::ArrayRef<mlir::Type> inputTypes =
+        callee.getFunctionType().getInputs();
+    llvm::SmallVector<mlir::Value> args;
+    args.push_back(builder.createConvert(loc, inputTypes[0], box.getAddr()));
+    args.push_back(
+        builder.createConvert(loc, inputTypes[1], fir::getBase(source)));
+    mlir::Value rankValue =
+        builder.createIntegerConstant(loc, inputTypes[2], rank);
+    mlir::Value corankValue =
+        builder.createIntegerConstant(loc, inputTypes[3], corank);
+    args.push_back(rankValue);
+    args.push_back(corankValue);
+    builder.create<fir::CallOp>(loc, callee, args);
+  }
+
   /// Generate call to the AllocatableInitDerived to set up the type descriptor
   /// and other part of the descriptor for derived type.
   void genSetType(const Allocation &alloc, const fir::MutableBoxValue &box,
diff --git a/flang/runtime/allocatable.cpp b/flang/runtime/allocatable.cpp
--- a/flang/runtime/allocatable.cpp
+++ b/flang/runtime/allocatable.cpp
@@ -38,6 +38,22 @@
       derivedType, nullptr, rank, nullptr, CFI_attribute_allocatable);
 }
 
+void RTNAME(AllocatableInitFromUnlimitedPolymorphicSource)(
+    Descriptor &descriptor, const Descriptor &source, int rank, int corank) {
+  if (source.type().IsDerived()) {
+    const DescriptorAddendum *addendum{source.Addendum()};
+    INTERNAL_CHECK(addendum != nullptr);
+    RTNAME(AllocatableInitDerived)
+    (descriptor, *addendum->derivedType(), rank, corank);
+  } else {
+    std::optional<std::pair<TypeCategory, int>> typeCode{
+        source.type().GetCategoryAndKind()};
+    INTERNAL_CHECK(typeCode);
+    RTNAME(AllocatableInitIntrinsic)
+    (descriptor, typeCode->first, typeCode->second, rank, corank);
+  }
+}
+
 int RTNAME(MoveAlloc)(Descriptor &to, const Descriptor & /*from*/,
     bool /*hasStat*/, const Descriptor * /*errMsg*/,
     const char * /*sourceFile*/, int /*sourceLine*/) {
diff --git a/flang/runtime/pointer.cpp b/flang/runtime/pointer.cpp
--- a/flang/runtime/pointer.cpp
+++ b/flang/runtime/pointer.cpp
@@ -38,6 +38,22 @@
   pointer.Establish(derivedType, nullptr, rank, nullptr, CFI_attribute_pointer);
 }
 
+void RTNAME(PointerNullifyFromUnlimitedPolymorphicSource)(
+    Descriptor &descriptor, const Descriptor &source, int rank, int corank) {
+  if (source.type().IsDerived()) {
+    const DescriptorAddendum *addendum{source.Addendum()};
+    INTERNAL_CHECK(addendum != nullptr);
+    RTNAME(PointerNullifyDerived)
+    (descriptor, *addendum->derivedType(), rank, corank);
+  } else {
+    std::optional<std::pair<TypeCategory, int>> typeCode{
+        source.type().GetCategoryAndKind()};
+    INTERNAL_CHECK(typeCode);
+    RTNAME(PointerNullifyIntrinsic)
+    (descriptor, typeCode->first, typeCode->second, rank, corank);
+  }
+}
+
 void RTNAME(PointerSetBounds)(Descriptor &pointer, int zeroBasedDim,
     SubscriptValue lower, SubscriptValue upper) {
   INTERNAL_CHECK(zeroBasedDim >= 0 && zeroBasedDim < pointer.rank());
diff --git a/flang/test/Lower/allocatable-polymorphic.f90 b/flang/test/Lower/allocatable-polymorphic.f90
--- a/flang/test/Lower/allocatable-polymorphic.f90
+++ b/flang/test/Lower/allocatable-polymorphic.f90
@@ -492,6 +492,24 @@
 ! CHECK: %[[CORANK:.*]] = arith.constant 0 : i32
 ! CHECK: %{{.*}} = fir.call @_FortranAPointerNullifyIntrinsic(%[[UP_BOX_NONE]], %[[CAT]], %[[KIND]], %[[RANK]], %[[CORANK]]) {{.*}} : (!fir.ref<!fir.box<none>>, i32, i32, i32, i32) -> none
 
+  subroutine test_allocatable_up_from_up_mold(a, b)
+    class(*), allocatable :: a
+    class(*), pointer :: b
+    allocate(a, source = b)
+  end subroutine
+
+! CHECK-LABEL: func.func @_QMpolyPtest_allocatable_up_from_up_mold(
+! CHECK-SAME: %[[A:.*]]: !fir.ref<!fir.class<!fir.heap<none>>> {fir.bindc_name = "a"}, %[[B:.*]]: !fir.ref<!fir.class<!fir.ptr<none>>> {fir.bindc_name = "b"}) {
+! CHECK: %[[LOAD_B:.*]] = fir.load %[[B]] : !fir.ref<!fir.class<!fir.ptr<none>>>
+! CHECK: %[[A_BOX_NONE:.*]] = fir.convert %[[A]] : (!fir.ref<!fir.class<!fir.heap<none>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %[[B_BOX_NONE:.*]] = fir.convert %[[LOAD_B]] : (!fir.class<!fir.ptr<none>>) -> !fir.box<none>
+! CHECK: %[[RANK:.*]] = arith.constant 0 : i32 
+! CHECK: %[[CORANK:.*]] = arith.constant 0 : i32 
+! CHECK: %{{.*}} = fir.call @_FortranAAllocatableInitFromUnlimitedPolymorphicSo(%[[A_BOX_NONE]], %[[B_BOX_NONE]], %[[RANK]], %[[CORANK]]) fastmath<contract> : (!fir.ref<!fir.box<none>>, !fir.box<none>, i32, i32) -> none 
+! CHECK: %[[A_BOX_NONE:.*]] = fir.convert %[[A]] : (!fir.ref<!fir.class<!fir.heap<none>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %[[B_BOX_NONE:.*]] = fir.convert %[[LOAD_B]] : (!fir.class<!fir.ptr<none>>) -> !fir.box<none>
+! CHECK: %{{.*}} = fir.call @_FortranAAllocatableAllocateSource(%[[A_BOX_NONE]], %[[B_BOX_NONE]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref<!fir.box<none>>, !fir.box<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+
 end module