diff --git a/flang/include/flang/Optimizer/Builder/MutableBox.h b/flang/include/flang/Optimizer/Builder/MutableBox.h
index 56f43a8475235..d49d2e7ae8119 100644
--- a/flang/include/flang/Optimizer/Builder/MutableBox.h
+++ b/flang/include/flang/Optimizer/Builder/MutableBox.h
@@ -161,6 +161,12 @@ mlir::Value genIsAllocatedOrAssociatedTest(fir::FirOpBuilder &builder,
                                            mlir::Location loc,
                                            const fir::MutableBoxValue &box);
 
+/// Generate allocation or association status test and returns the resulting
+/// i1. This is testing this for a valid/non-null base address value.
+mlir::Value genIsNotAllocatedOrAssociatedTest(fir::FirOpBuilder &builder,
+                                              mlir::Location loc,
+                                              const fir::MutableBoxValue &box);
+
 } // namespace fir::factory
 
 #endif // FORTRAN_OPTIMIZER_BUILDER_MUTABLEBOX_H
diff --git a/flang/lib/Lower/IntrinsicCall.cpp b/flang/lib/Lower/IntrinsicCall.cpp
index 26ae437d84b75..126696e0df474 100644
--- a/flang/lib/Lower/IntrinsicCall.cpp
+++ b/flang/lib/Lower/IntrinsicCall.cpp
@@ -18,6 +18,7 @@
 #include "flang/Lower/Mangler.h"
 #include "flang/Lower/Runtime.h"
 #include "flang/Lower/StatementContext.h"
+#include "flang/Lower/Support/Utils.h"
 #include "flang/Lower/SymbolMap.h"
 #include "flang/Optimizer/Builder/BoxValue.h"
 #include "flang/Optimizer/Builder/Character.h"
@@ -306,6 +307,8 @@ struct IntrinsicLibrary {
   mlir::Value genSpacing(mlir::Type resultType,
                          llvm::ArrayRef<mlir::Value> args);
   fir::ExtendedValue genSpread(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
+  fir::ExtendedValue genStorageSize(mlir::Type,
+                                    llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genSum(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   void genSystemClock(llvm::ArrayRef<fir::ExtendedValue>);
   mlir::Value genTrailz(mlir::Type, llvm::ArrayRef<mlir::Value>);
@@ -818,6 +821,10 @@ static constexpr IntrinsicHandler handlers[]{
      &I::genSpread,
      {{{"source", asBox}, {"dim", asValue}, {"ncopies", asValue}}},
      /*isElemental=*/false},
+    {"storage_size",
+     &I::genStorageSize,
+     {{{"a", asInquired}, {"kind", asValue}}},
+     /*isElemental=*/false},
     {"sum",
      &I::genSum,
      {{{"array", asBox},
@@ -4787,6 +4794,57 @@ IntrinsicLibrary::genSpread(mlir::Type resultType,
   return readAndAddCleanUp(resultMutableBox, resultType, "SPREAD");
 }
 
+// STORAGE_SIZE
+fir::ExtendedValue
+IntrinsicLibrary::genStorageSize(mlir::Type resultType,
+                                 llvm::ArrayRef<fir::ExtendedValue> args) {
+  assert(args.size() == 2 || args.size() == 1);
+  mlir::Value box = fir::getBase(args[0]);
+  mlir::Type boxTy = box.getType();
+  mlir::Type kindTy = builder.getDefaultIntegerType();
+  bool needRuntimeCheck = false;
+  std::string errorMsg;
+
+  if (fir::isUnlimitedPolymorphicType(boxTy) &&
+      (fir::isAllocatableType(boxTy) || fir::isPointerType(boxTy))) {
+    needRuntimeCheck = true;
+    errorMsg =
+        fir::isPointerType(boxTy)
+            ? "unlimited polymorphic disassociated POINTER in STORAGE_SIZE"
+            : "unlimited polymorphic unallocated ALLOCATABLE in STORAGE_SIZE";
+  } else if (fir::isPolymorphicType(boxTy) && fir::isPointerType(boxTy)) {
+    needRuntimeCheck = true;
+    errorMsg = "polymorphic disassociated POINTER in STORAGE_SIZE";
+  }
+  const fir::MutableBoxValue *mutBox = args[0].getBoxOf<fir::MutableBoxValue>();
+  if (needRuntimeCheck && mutBox) {
+    mlir::Value isNotAllocOrAssoc =
+        fir::factory::genIsNotAllocatedOrAssociatedTest(builder, loc, *mutBox);
+    builder.genIfThen(loc, isNotAllocOrAssoc)
+        .genThen([&]() {
+          fir::runtime::genReportFatalUserError(builder, loc, errorMsg);
+        })
+        .end();
+  }
+
+  // Handle optional kind argument
+  bool absentKind = isStaticallyAbsent(args, 1);
+  if (!absentKind) {
+    mlir::Operation *defKind = fir::getBase(args[1]).getDefiningOp();
+    assert(mlir::isa<mlir::arith::ConstantOp>(*defKind) &&
+           "kind not a constant");
+    auto constOp = mlir::dyn_cast<mlir::arith::ConstantOp>(*defKind);
+    kindTy = builder.getIntegerType(
+        builder.getKindMap().getIntegerBitsize(fir::toInt(constOp)));
+  }
+
+  if (box.getType().isa<fir::ReferenceType>())
+    box = builder.create<fir::LoadOp>(loc, box);
+  mlir::Value eleSize = builder.create<fir::BoxEleSizeOp>(loc, kindTy, box);
+  mlir::Value c8 = builder.createIntegerConstant(loc, kindTy, 8);
+  return builder.create<mlir::arith::MulIOp>(loc, eleSize, c8);
+}
+
 // SUM
 fir::ExtendedValue
 IntrinsicLibrary::genSum(mlir::Type resultType,
diff --git a/flang/lib/Optimizer/Builder/MutableBox.cpp b/flang/lib/Optimizer/Builder/MutableBox.cpp
index a66a4c607b68c..44b04c0b20516 100644
--- a/flang/lib/Optimizer/Builder/MutableBox.cpp
+++ b/flang/lib/Optimizer/Builder/MutableBox.cpp
@@ -440,6 +440,13 @@ fir::factory::genIsAllocatedOrAssociatedTest(fir::FirOpBuilder &builder,
   return builder.genIsNotNullAddr(loc, addr);
 }
 
+mlir::Value fir::factory::genIsNotAllocatedOrAssociatedTest(
+    fir::FirOpBuilder &builder, mlir::Location loc,
+    const fir::MutableBoxValue &box) {
+  auto addr = MutablePropertyReader(builder, loc, box).readBaseAddress();
+  return builder.genIsNullAddr(loc, addr);
+}
+
 /// Generate finalizer call and inlined free. This does not check that the
 /// address was allocated.
 static void genFinalizeAndFree(fir::FirOpBuilder &builder, mlir::Location loc,
diff --git a/flang/test/Lower/Intrinsics/storage_size.f90 b/flang/test/Lower/Intrinsics/storage_size.f90
new file mode 100644
index 0000000000000..2c975a194186c
--- /dev/null
+++ b/flang/test/Lower/Intrinsics/storage_size.f90
@@ -0,0 +1,116 @@
+! RUN: bbc -emit-fir -polymorphic-type %s -o - | FileCheck %s
+
+module storage_size_test
+  type :: p1
+    integer :: a
+  end type
+
+  type, extends(p1) :: p2
+    integer :: b
+  end type
+
+contains
+
+  integer function unlimited_polymorphic_pointer(p) result(size)
+    class(*), pointer :: p
+    size = storage_size(p)
+  end function
+
+! CHECK-LABEL: func.func @_QMstorage_size_testPunlimited_polymorphic_pointer(
+! CHECK-SAME: %[[P:.*]]: !fir.ref<!fir.class<!fir.ptr<none>>> {fir.bindc_name = "p"}) -> i32 {
+! CHECK: %[[SIZE:.*]] = fir.alloca i32 {bindc_name = "size", uniq_name = "_QMstorage_size_testFunlimited_polymorphic_pointerEsize"}
+! CHECK: %[[LOAD_P:.*]] = fir.load %[[P]] : !fir.ref<!fir.class<!fir.ptr<none>>>
+! CHECK: %[[P_ADDR:.*]] = fir.box_addr %[[LOAD_P]] : (!fir.class<!fir.ptr<none>>) -> !fir.ptr<none>
+! CHECK: %[[P_ADDR_I64:.*]] = fir.convert %[[P_ADDR]] : (!fir.ptr<none>) -> i64
+! CHECK: %[[C0:.*]] = arith.constant 0 : i64
+! CHECK: %[[IS_NULL_ADDR:.*]] = arith.cmpi eq, %[[P_ADDR_I64]], %[[C0]] : i64
+! CHECK: fir.if %[[IS_NULL_ADDR]] {
+! CHECK:   %{{.*}} = fir.call @_FortranAReportFatalUserError(%{{.*}}, %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref<i8>, !fir.ref<i8>, i32) -> none
+! CHECK: }
+! CHECK: %[[LOAD_P:.*]] = fir.load %[[P]] : !fir.ref<!fir.class<!fir.ptr<none>>>
+! CHECK: %[[ELE_SIZE:.*]] = fir.box_elesize %[[LOAD_P]] : (!fir.class<!fir.ptr<none>>) -> i32
+! CHECK: %[[C8:.*]] = arith.constant 8 : i32
+! CHECK: %[[BITS:.*]] = arith.muli %[[ELE_SIZE]], %[[C8]] : i32
+! CHECK: fir.store %[[BITS]] to %[[SIZE]] : !fir.ref<i32>
+! CHECK: %[[RES:.*]] = fir.load %[[SIZE]] : !fir.ref<i32>
+! CHECK: return %[[RES]] : i32
+
+  integer function unlimited_polymorphic_allocatable(p) result(size)
+    class(*), allocatable :: p
+    size = storage_size(p)
+  end function
+
+! CHECK-LABEL: func.func @_QMstorage_size_testPunlimited_polymorphic_allocatable(
+! CHECK-SAME: %[[P:.*]]: !fir.ref<!fir.class<!fir.heap<none>>> {fir.bindc_name = "p"}) -> i32 {
+! CHECK: %[[SIZE:.*]] = fir.alloca i32 {bindc_name = "size", uniq_name = "_QMstorage_size_testFunlimited_polymorphic_allocatableEsize"}
+! CHECK: %[[LOAD_P:.*]] = fir.load %[[P]] : !fir.ref<!fir.class<!fir.heap<none>>>
+! CHECK: %[[P_ADDR:.*]] = fir.box_addr %[[LOAD_P]] : (!fir.class<!fir.heap<none>>) -> !fir.heap<none>
+! CHECK: %[[P_ADDR_I64:.*]] = fir.convert %[[P_ADDR]] : (!fir.heap<none>) -> i64
+! CHECK: %[[C0:.*]] = arith.constant 0 : i64
+! CHECK: %[[IS_NULL_ADDR:.*]] = arith.cmpi eq, %[[P_ADDR_I64]], %[[C0]] : i64
+! CHECK: fir.if %[[IS_NULL_ADDR]] {
+! CHECK:   %{{.*}} = fir.call @_FortranAReportFatalUserError(%{{.*}}, %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref<i8>, !fir.ref<i8>, i32) -> none
+! CHECK: }
+! CHECK: %[[LOAD_P:.*]] = fir.load %[[P]] : !fir.ref<!fir.class<!fir.heap<none>>>
+! CHECK: %[[ELE_SIZE:.*]] = fir.box_elesize %[[LOAD_P]] : (!fir.class<!fir.heap<none>>) -> i32
+! CHECK: %[[C8:.*]] = arith.constant 8 : i32
+! CHECK: %[[BITS:.*]] = arith.muli %[[ELE_SIZE]], %[[C8]] : i32
+! CHECK: fir.store %[[BITS]] to %[[SIZE]] : !fir.ref<i32>
+! CHECK: %[[RES:.*]] = fir.load %[[SIZE]] : !fir.ref<i32>
+! CHECK: return %[[RES]] : i32
+
+  integer function polymorphic_pointer(p) result(size)
+    class(p1), pointer :: p
+    size = storage_size(p)
+  end function
+
+! CHECK-LABEL: func.func @_QMstorage_size_testPpolymorphic_pointer(
+! CHECK-SAME: %[[P:.*]]: !fir.ref<!fir.class<!fir.ptr<!fir.type<_QMstorage_size_testTp1{a:i32}>>>> {fir.bindc_name = "p"}) -> i32 {
+! CHECK: %[[SIZE:.*]] = fir.alloca i32 {bindc_name = "size", uniq_name = "_QMstorage_size_testFpolymorphic_pointerEsize"}
+! CHECK: %[[LOAD_P:.*]] = fir.load %[[P]] : !fir.ref<!fir.class<!fir.ptr<!fir.type<_QMstorage_size_testTp1{a:i32}>>>>
+! CHECK: %[[P_ADDR:.*]] = fir.box_addr %[[LOAD_P]] : (!fir.class<!fir.ptr<!fir.type<_QMstorage_size_testTp1{a:i32}>>>) -> !fir.ptr<!fir.type<_QMstorage_size_testTp1{a:i32}>>
+! CHECK: %[[P_ADDR_I64:.*]] = fir.convert %[[P_ADDR]] : (!fir.ptr<!fir.type<_QMstorage_size_testTp1{a:i32}>>) -> i64
+! CHECK: %[[C0:.*]] = arith.constant 0 : i64
+! CHECK: %[[IS_NULL_ADDR:.*]] = arith.cmpi eq, %[[P_ADDR_I64]], %[[C0]] : i64
+! CHECK: fir.if %[[IS_NULL_ADDR]] {
+! CHECK:   %{{.*}} = fir.call @_FortranAReportFatalUserError(%{{.*}}, %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref<i8>, !fir.ref<i8>, i32) -> none
+! CHECK: }
+! CHECK: %[[LOAD_P:.*]] = fir.load %[[P]] : !fir.ref<!fir.class<!fir.ptr<!fir.type<_QMstorage_size_testTp1{a:i32}>>>>
+! CHECK: %[[ELE_SIZE:.*]] = fir.box_elesize %[[LOAD_P]] : (!fir.class<!fir.ptr<!fir.type<_QMstorage_size_testTp1{a:i32}>>>) -> i32
+! CHECK: %[[C8:.*]] = arith.constant 8 : i32
+! CHECK: %[[BITS:.*]] = arith.muli %[[ELE_SIZE]], %[[C8]] : i32
+! CHECK: fir.store %[[BITS]] to %[[SIZE]] : !fir.ref<i32>
+! CHECK: %[[RES:.*]] = fir.load %[[SIZE]] : !fir.ref<i32>
+! CHECK: return %[[RES]] : i32
+
+  integer function polymorphic(p) result(size)
+    class(p1) :: p
+    size = storage_size(p)
+  end function
+
+! CHECK-LABEL: func.func @_QMstorage_size_testPpolymorphic(
+! CHECK-SAME: %[[P:.*]]: !fir.class<!fir.type<_QMstorage_size_testTp1{a:i32}>> {fir.bindc_name = "p"}) -> i32 {
+! CHECK: %[[SIZE:.*]] = fir.alloca i32 {bindc_name = "size", uniq_name = "_QMstorage_size_testFpolymorphicEsize"}
+! CHECK: %[[ELE_SIZE:.*]] = fir.box_elesize %[[P]] : (!fir.class<!fir.type<_QMstorage_size_testTp1{a:i32}>>) -> i32
+! CHECK: %[[C8:.*]] = arith.constant 8 : i32
+! CHECK: %[[BITS:.*]] = arith.muli %[[ELE_SIZE]], %[[C8]] : i32
+! CHECK: fir.store %[[BITS]] to %[[SIZE]] : !fir.ref<i32>
+! CHECK: %[[RES:.*]] = fir.load %[[SIZE]] : !fir.ref<i32>
+! CHECK: return %[[RES]] : i32
+
+  integer(8) function polymorphic_rank(p) result(size)
+    class(p1) :: p
+    size = storage_size(p, 8)
+  end function
+
+! CHECK-LABEL: func.func @_QMstorage_size_testPpolymorphic_rank(
+! CHECK-SAME: %[[P:.*]]: !fir.class<!fir.type<_QMstorage_size_testTp1{a:i32}>> {fir.bindc_name = "p"}) -> i64 {
+! CHECK: %[[SIZE:.*]] = fir.alloca i64 {bindc_name = "size", uniq_name = "_QMstorage_size_testFpolymorphic_rankEsize"}
+! CHECK: %[[ELE_SIZE:.*]] = fir.box_elesize %[[P]] : (!fir.class<!fir.type<_QMstorage_size_testTp1{a:i32}>>) -> i64
+! CHECK: %[[C8:.*]] = arith.constant 8 : i64
+! CHECK: %[[BITS:.*]] = arith.muli %[[ELE_SIZE]], %[[C8]] : i64
+! CHECK: fir.store %[[BITS]] to %[[SIZE]] : !fir.ref<i64>
+! CHECK: %[[RES:.*]] = fir.load %[[SIZE]] : !fir.ref<i64>
+! CHECK: return %[[RES]] : i64
+
+end module