diff --git a/flang/include/flang/Lower/HostAssociations.h b/flang/include/flang/Lower/HostAssociations.h
new file mode 100644
index 0000000000000..c091dbc3339a4
--- /dev/null
+++ b/flang/include/flang/Lower/HostAssociations.h
@@ -0,0 +1,68 @@
+//===-- Lower/HostAssociations.h --------------------------------*- C++ -*-===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_LOWER_HOSTASSOCIATIONS_H
+#define FORTRAN_LOWER_HOSTASSOCIATIONS_H
+
+#include "mlir/IR/Location.h"
+#include "mlir/IR/Types.h"
+#include "mlir/IR/Value.h"
+#include "llvm/ADT/SetVector.h"
+
+namespace Fortran {
+namespace semantics {
+class Symbol;
+}
+
+namespace lower {
+class AbstractConverter;
+class SymMap;
+
+/// Internal procedures in Fortran may access variables declared in the host
+/// procedure directly. We bundle these variables together in a tuple and pass
+/// them as an extra argument.
+class HostAssociations {
+public:
+  /// Returns true iff there are no host associations.
+  bool empty() const { return symbols.empty(); }
+
+  /// Adds a set of Symbols that will be the host associated bindings for this
+  /// host procedure.
+  void addSymbolsToBind(
+      const llvm::SetVector<const Fortran::semantics::Symbol *> &s) {
+    assert(empty() && "symbol set must be initially empty");
+    symbols = s;
+  }
+
+  /// Code gen the FIR for the local bindings for the host associated symbols
+  /// for the host (parent) procedure using `builder`.
+  void hostProcedureBindings(AbstractConverter &converter, SymMap &symMap);
+
+  /// Code gen the FIR for the local bindings for the host associated symbols
+  /// for an internal (child) procedure using `builder`.
+  void internalProcedureBindings(AbstractConverter &converter, SymMap &symMap);
+
+  /// Return the type of the extra argument to add to each internal procedure.
+  mlir::Type getArgumentType(AbstractConverter &convert);
+
+  /// Is \p symbol host associated ?
+  bool isAssociated(const Fortran::semantics::Symbol &symbol) const {
+    return symbols.contains(&symbol);
+  }
+
+private:
+  /// Canonical vector of host associated symbols.
+  llvm::SetVector<const Fortran::semantics::Symbol *> symbols;
+
+  /// The type of the extra argument to be added to each internal procedure.
+  mlir::Type argType;
+};
+} // namespace lower
+} // namespace Fortran
+
+#endif // FORTRAN_LOWER_HOSTASSOCIATIONS_H
diff --git a/flang/include/flang/Lower/IntervalSet.h b/flang/include/flang/Lower/IntervalSet.h
new file mode 100644
index 0000000000000..3d7a36e30b570
--- /dev/null
+++ b/flang/include/flang/Lower/IntervalSet.h
@@ -0,0 +1,109 @@
+//===-- IntervalSet.h -------------------------------------------*- C++ -*-===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_LOWER_INTERVALSET_H
+#define FORTRAN_LOWER_INTERVALSET_H
+
+#include <cassert>
+#include <map>
+
+namespace Fortran::lower {
+
+//===----------------------------------------------------------------------===//
+// Interval set
+//===----------------------------------------------------------------------===//
+
+/// Interval set to keep track of intervals, merging them when they overlap one
+/// another. Used to refine the pseudo-offset ranges of the front-end symbols
+/// into groups of aliasing variables.
+struct IntervalSet {
+  using MAP = std::map<std::size_t, std::size_t>;
+  using Iterator = MAP::const_iterator;
+
+  // Handles the merging of overlapping intervals correctly, efficiently.
+  void merge(std::size_t lo, std::size_t up) {
+    assert(lo <= up);
+    if (empty()) {
+      m.insert({lo, up});
+      return;
+    }
+    auto i = m.lower_bound(lo);
+    // i->first >= lo
+    if (i == begin()) {
+      if (up < i->first) {
+        // [lo..up] < i->first
+        m.insert({lo, up});
+        return;
+      }
+      // up >= i->first
+      if (i->second > up)
+        up = i->second;
+      fuse(lo, up, i);
+      return;
+    }
+    auto i1 = i;
+    if (i == end() || i->first > lo)
+      i = std::prev(i);
+    // i->first <= lo
+    if (i->second >= up) {
+      // i->first <= lo && up <= i->second, keep i
+      return;
+    }
+    // i->second < up
+    if (i->second < lo) {
+      if (i1 == end() || i1->first > up) {
+        // i < [lo..up] < i1
+        m.insert({lo, up});
+        return;
+      }
+      // i < [lo..up], i1->first <= up  -->  [lo..up] union [i1..?]
+      i = i1;
+    } else {
+      // i->first <= lo, lo <= i->second  -->  [i->first..up] union [i..?]
+      lo = i->first;
+    }
+    fuse(lo, up, i);
+  }
+
+  Iterator find(std::size_t pt) const {
+    auto i = m.lower_bound(pt);
+    if (i != end() && i->first == pt)
+      return i;
+    if (i == begin())
+      return end();
+    i = std::prev(i);
+    if (i->second < pt)
+      return end();
+    return i;
+  }
+
+  Iterator begin() const { return m.begin(); }
+  Iterator end() const { return m.end(); }
+  bool empty() const { return m.empty(); }
+  std::size_t size() const { return m.size(); }
+
+private:
+  // Find and fuse overlapping sets.
+  void fuse(std::size_t lo, std::size_t up, Iterator i) {
+    auto j = m.upper_bound(up);
+    // up < j->first
+    std::size_t cu = std::prev(j)->second;
+    // cu < j->first
+    if (cu > up)
+      up = cu;
+    m.erase(i, j);
+    // merge [i .. j) with [i->first, max(up, cu)]
+    m.insert({lo, up});
+  }
+
+  MAP m{};
+};
+
+} // namespace Fortran::lower
+
+#endif // FORTRAN_LOWER_INTERVALSET_H
diff --git a/flang/include/flang/Lower/PFTBuilder.h b/flang/include/flang/Lower/PFTBuilder.h
index 0e625bf86b99c..1d4788451a42c 100644
--- a/flang/include/flang/Lower/PFTBuilder.h
+++ b/flang/include/flang/Lower/PFTBuilder.h
@@ -19,9 +19,11 @@
 
 #include "flang/Common/reference.h"
 #include "flang/Common/template.h"
+#include "flang/Lower/HostAssociations.h"
 #include "flang/Lower/PFTDefs.h"
 #include "flang/Parser/parse-tree.h"
 #include "flang/Semantics/attr.h"
+#include "flang/Semantics/scope.h"
 #include "flang/Semantics/symbol.h"
 #include "llvm/Support/ErrorHandling.h"
 #include "llvm/Support/raw_ostream.h"
@@ -62,7 +64,7 @@ class ReferenceVariantBase {
   }
   template <typename B>
   constexpr BaseType<B> *getIf() const {
-    auto *ptr = std::get_if<Ref<B>>(&u);
+    const Ref<B> *ptr = std::get_if<Ref<B>>(&u);
     return ptr ? &ptr->get() : nullptr;
   }
   template <typename B>
@@ -106,8 +108,7 @@ using ActionStmts = std::tuple<
     parser::ComputedGotoStmt, parser::ForallStmt, parser::ArithmeticIfStmt,
     parser::AssignStmt, parser::AssignedGotoStmt, parser::PauseStmt>;
 
-using OtherStmts =
-    std::tuple<parser::FormatStmt, parser::EntryStmt, parser::NamelistStmt>;
+using OtherStmts = std::tuple<parser::EntryStmt, parser::FormatStmt>;
 
 using ConstructStmts = std::tuple<
     parser::AssociateStmt, parser::EndAssociateStmt, parser::BlockStmt,
@@ -134,7 +135,11 @@ using Constructs =
 
 using Directives =
     std::tuple<parser::CompilerDirective, parser::OpenACCConstruct,
-               parser::OpenMPConstruct, parser::OmpEndLoopDirective>;
+               parser::OpenACCDeclarativeConstruct, parser::OpenMPConstruct,
+               parser::OpenMPDeclarativeConstruct, parser::OmpEndLoopDirective>;
+
+using DeclConstructs = std::tuple<parser::OpenMPDeclarativeConstruct,
+                                  parser::OpenACCDeclarativeConstruct>;
 
 template <typename A>
 static constexpr bool isActionStmt{common::HasMember<A, ActionStmts>};
@@ -154,6 +159,9 @@ static constexpr bool isConstruct{common::HasMember<A, Constructs>};
 template <typename A>
 static constexpr bool isDirective{common::HasMember<A, Directives>};
 
+template <typename A>
+static constexpr bool isDeclConstruct{common::HasMember<A, DeclConstructs>};
+
 template <typename A>
 static constexpr bool isIntermediateConstructStmt{common::HasMember<
     A, std::tuple<parser::CaseStmt, parser::ElseIfStmt, parser::ElseStmt,
@@ -161,10 +169,14 @@ static constexpr bool isIntermediateConstructStmt{common::HasMember<
 
 template <typename A>
 static constexpr bool isNopConstructStmt{common::HasMember<
-    A, std::tuple<parser::EndAssociateStmt, parser::CaseStmt,
-                  parser::EndSelectStmt, parser::ElseIfStmt, parser::ElseStmt,
-                  parser::EndIfStmt, parser::SelectRankCaseStmt,
-                  parser::TypeGuardStmt>>};
+    A, std::tuple<parser::CaseStmt, parser::EndSelectStmt, parser::ElseIfStmt,
+                  parser::ElseStmt, parser::EndIfStmt,
+                  parser::SelectRankCaseStmt, parser::TypeGuardStmt>>};
+
+template <typename A>
+static constexpr bool isExecutableDirective{common::HasMember<
+    A, std::tuple<parser::CompilerDirective, parser::OpenACCConstruct,
+                  parser::OpenMPConstruct>>};
 
 template <typename A>
 static constexpr bool isFunctionLike{common::HasMember<
@@ -244,6 +256,11 @@ struct Evaluation : EvaluationVariant {
       return pft::isNopConstructStmt<std::decay_t<decltype(r)>>;
     }});
   }
+  constexpr bool isExecutableDirective() const {
+    return visit(common::visitors{[](auto &r) {
+      return pft::isExecutableDirective<std::decay_t<decltype(r)>>;
+    }});
+  }
 
   /// Return the predicate:  "This is a non-initial, non-terminal construct
   /// statement."  For an IfConstruct, this is ElseIfStmt and ElseStmt.
@@ -295,11 +312,12 @@ struct Evaluation : EvaluationVariant {
 
   // FIR generation looks primarily at PFT ActionStmt and ConstructStmt leaf
   // nodes.  Members such as lexicalSuccessor and block are applicable only
-  // to these nodes.  The controlSuccessor member is used for nonlexical
-  // successors, such as linking to a GOTO target.  For multiway branches,
-  // it is set to the first target.  Successor and exit links always target
-  // statements.  An internal Construct node has a constructExit link that
-  // applies to exits from anywhere within the construct.
+  // to these nodes, plus some directives.  The controlSuccessor member is
+  // used for nonlexical successors, such as linking to a GOTO target.  For
+  // multiway branches, it is set to the first target.  Successor and exit
+  // links always target statements or directives.  An internal Construct
+  // node has a constructExit link that applies to exits from anywhere within
+  // the construct.
   //
   // An unstructured construct is one that contains some form of goto.  This
   // is indicated by the isUnstructured member flag, which may be set on a
@@ -327,8 +345,8 @@ struct Evaluation : EvaluationVariant {
   std::optional<parser::Label> label{};
   std::unique_ptr<EvaluationList> evaluationList; // nested evaluations
   Evaluation *parentConstruct{nullptr};  // set for nodes below the top level
-  Evaluation *lexicalSuccessor{nullptr}; // set for ActionStmt, ConstructStmt
-  Evaluation *controlSuccessor{nullptr}; // set for some statements
+  Evaluation *lexicalSuccessor{nullptr}; // set for leaf nodes, some directives
+  Evaluation *controlSuccessor{nullptr}; // set for some leaf nodes
   Evaluation *constructExit{nullptr};    // set for constructs
   bool isNewBlock{false};                // evaluation begins a new basic block
   bool isUnstructured{false};  // evaluation has unstructured control flow
@@ -354,13 +372,6 @@ struct ProgramUnit : ProgramVariant {
   PftNode parent;
 };
 
-/// Helper to get location from FunctionLikeUnit/ModuleLikeUnit begin/end
-/// statements.
-template <typename T>
-static parser::CharBlock stmtSourceLoc(const T &stmt) {
-  return stmt.visit(common::visitors{[](const auto &x) { return x.source; }});
-}
-
 /// A variable captures an object to be created per the declaration part of a
 /// function like unit.
 ///
@@ -386,9 +397,6 @@ struct Variable {
     const semantics::Symbol *symbol{};
 
     bool isGlobal() const { return global; }
-    bool isDeclaration() const {
-      return !symbol || symbol != &symbol->GetUltimate();
-    }
 
     int depth{};
     bool global{};
@@ -399,32 +407,45 @@ struct Variable {
     std::size_t aliasOffset{};
   };
 
+  /// <offset, size> pair
   using Interval = std::tuple<std::size_t, std::size_t>;
 
   /// An interval of storage is a contiguous block of memory to be allocated or
   /// mapped onto another variable. Aliasing variables will be pointers into
   /// interval stores and may overlap each other.
   struct AggregateStore {
-    AggregateStore(Interval &&interval, const Fortran::semantics::Scope &scope,
-                   bool isDeclaration = false)
-        : interval{std::move(interval)}, scope{&scope}, isDecl{isDeclaration} {}
-    AggregateStore(Interval &&interval, const Fortran::semantics::Scope &scope,
-                   const llvm::SmallVector<const semantics::Symbol *, 8> &vars,
-                   bool isDeclaration = false)
-        : interval{std::move(interval)}, scope{&scope}, vars{vars},
-          isDecl{isDeclaration} {}
-
-    bool isGlobal() const { return vars.size() > 0; }
-    bool isDeclaration() const { return isDecl; }
+    AggregateStore(Interval &&interval,
+                   const Fortran::semantics::Symbol &namingSym,
+                   bool isGlobal = false)
+        : interval{std::move(interval)}, namingSymbol{&namingSym},
+          isGlobalAggregate{isGlobal} {}
+    AggregateStore(const semantics::Symbol &initialValueSym,
+                   const semantics::Symbol &namingSym, bool isGlobal = false)
+        : interval{initialValueSym.offset(), initialValueSym.size()},
+          namingSymbol{&namingSym}, initialValueSymbol{&initialValueSym},
+          isGlobalAggregate{isGlobal} {};
+
+    bool isGlobal() const { return isGlobalAggregate; }
     /// Get offset of the aggregate inside its scope.
     std::size_t getOffset() const { return std::get<0>(interval); }
-
+    /// Returns symbols holding the aggregate initial value if any.
+    const semantics::Symbol *getInitialValueSymbol() const {
+      return initialValueSymbol;
+    }
+    /// Returns the symbol that gives its name to the aggregate.
+    const semantics::Symbol &getNamingSymbol() const { return *namingSymbol; }
+    /// Scope to which the aggregates belongs to.
+    const semantics::Scope &getOwningScope() const {
+      return getNamingSymbol().owner();
+    }
+    /// <offset, size> of the aggregate in its scope.
     Interval interval{};
-    /// scope in which the interval is.
-    const Fortran::semantics::Scope *scope;
-    llvm::SmallVector<const semantics::Symbol *, 8> vars{};
-    /// Is this a declaration of a storage defined in another scope ?
-    bool isDecl;
+    /// Symbol that gives its name to the aggregate. Always set by constructor.
+    const semantics::Symbol *namingSymbol;
+    /// Compiler generated symbol with the aggregate initial value if any.
+    const semantics::Symbol *initialValueSymbol = nullptr;
+    /// Is this a global aggregate ?
+    bool isGlobalAggregate;
   };
 
   explicit Variable(const Fortran::semantics::Symbol &sym, bool global = false,
@@ -463,31 +484,32 @@ struct Variable {
     return std::visit([](const auto &x) { return x.isGlobal(); }, var);
   }
 
-  /// Is this a declaration of a variable owned by another scope ?
-  bool isDeclaration() const {
-    return std::visit([](const auto &x) { return x.isDeclaration(); }, var);
+  /// Is this a module variable ?
+  bool isModuleVariable() const {
+    const semantics::Scope *scope = getOwningScope();
+    return scope && scope->IsModule();
   }
 
   const Fortran::semantics::Scope *getOwningScope() const {
     return std::visit(
         common::visitors{
             [](const Nominal &x) { return &x.symbol->GetUltimate().owner(); },
-            [](const AggregateStore &agg) { return agg.scope; }},
+            [](const AggregateStore &agg) { return &agg.getOwningScope(); }},
         var);
   }
 
   bool isHeapAlloc() const {
-    if (const auto *s = std::get_if<Nominal>(&var))
+    if (auto *s = std::get_if<Nominal>(&var))
       return s->heapAlloc;
     return false;
   }
   bool isPointer() const {
-    if (const auto *s = std::get_if<Nominal>(&var))
+    if (auto *s = std::get_if<Nominal>(&var))
       return s->pointer;
     return false;
   }
   bool isTarget() const {
-    if (const auto *s = std::get_if<Nominal>(&var))
+    if (auto *s = std::get_if<Nominal>(&var))
       return s->target;
     return false;
   }
@@ -495,7 +517,7 @@ struct Variable {
   /// An alias(er) is a variable that is part of a EQUIVALENCE that is allocated
   /// locally on the stack.
   bool isAlias() const {
-    if (const auto *s = std::get_if<Nominal>(&var))
+    if (auto *s = std::get_if<Nominal>(&var))
       return s->aliaser;
     return false;
   }
@@ -534,7 +556,7 @@ struct Variable {
 
   /// The depth is recorded for nominal variables as a debugging aid.
   int getDepth() const {
-    if (const auto *s = std::get_if<Nominal>(&var))
+    if (auto *s = std::get_if<Nominal>(&var))
       return s->depth;
     return 0;
   }
@@ -574,17 +596,6 @@ struct FunctionLikeUnit : public ProgramUnit {
   FunctionLikeUnit(FunctionLikeUnit &&) = default;
   FunctionLikeUnit(const FunctionLikeUnit &) = delete;
 
-  /// Return true iff this function like unit is Fortran recursive (actually
-  /// meaning it's reentrant).
-  bool isRecursive() const {
-    if (isMainProgram())
-      return false;
-    const auto &sym = getSubprogramSymbol();
-    return sym.attrs().test(semantics::Attr::RECURSIVE) ||
-           (!sym.attrs().test(semantics::Attr::NON_RECURSIVE) &&
-            defaultRecursiveFunctionSetting());
-  }
-
   std::vector<Variable> getOrderedSymbolTable() { return varList[0]; }
 
   bool isMainProgram() const {
@@ -592,13 +603,7 @@ struct FunctionLikeUnit : public ProgramUnit {
   }
 
   /// Get the starting source location for this function like unit
-  parser::CharBlock getStartingSourceLoc() {
-    if (beginStmt)
-      return stmtSourceLoc(*beginStmt);
-    if (!evaluationList.empty())
-      return evaluationList.front().position;
-    return stmtSourceLoc(endStmt);
-  }
+  parser::CharBlock getStartingSourceLoc() const;
 
   void setActiveEntry(int entryIndex) {
     assert(entryIndex >= 0 && entryIndex < (int)entryPointList.size() &&
@@ -610,7 +615,7 @@ struct FunctionLikeUnit : public ProgramUnit {
   /// This should not be called if the FunctionLikeUnit is the main program
   /// since anonymous main programs do not have a symbol.
   const semantics::Symbol &getSubprogramSymbol() const {
-    const auto *symbol = entryPointList[activeEntry].first;
+    const semantics::Symbol *symbol = entryPointList[activeEntry].first;
     if (!symbol)
       llvm::report_fatal_error(
           "not inside a procedure; do not call on main program.");
@@ -623,11 +628,27 @@ struct FunctionLikeUnit : public ProgramUnit {
     return entryPointList[activeEntry].second;
   }
 
-  /// Helper to get location from FunctionLikeUnit begin/end statements.
-  static parser::CharBlock stmtSourceLoc(const FunctionStatement &stmt) {
-    return stmt.visit(common::visitors{[](const auto &x) { return x.source; }});
+  //===--------------------------------------------------------------------===//
+  // Host associations
+  //===--------------------------------------------------------------------===//
+
+  void setHostAssociatedSymbols(
+      const llvm::SetVector<const semantics::Symbol *> &symbols) {
+    hostAssociations.addSymbolsToBind(symbols);
   }
 
+  /// Return the host associations, if any, from the parent (host) procedure.
+  /// Crashes if the parent is not a procedure.
+  HostAssociations &parentHostAssoc();
+
+  /// Return true iff the parent is a procedure and the parent has a non-empty
+  /// set of host associations.
+  bool parentHasHostAssoc();
+
+  /// Return the host associations for this function like unit. The list of host
+  /// associations are kept in the host procedure.
+  HostAssociations &getHostAssoc() { return hostAssociations; }
+
   LLVM_DUMP_METHOD void dump() const;
 
   /// Anonymous programs do not have a begin statement
@@ -647,13 +668,14 @@ struct FunctionLikeUnit : public ProgramUnit {
   /// Current index into entryPointList.  Index 0 is the primary entry point.
   int activeEntry = 0;
   /// Dummy arguments that are not universal across entry points.
-  llvm::SmallVector<const semantics::Symbol *, 3> nonUniversalDummyArguments;
+  llvm::SmallVector<const semantics::Symbol *, 1> nonUniversalDummyArguments;
   /// Primary result for function subprograms with alternate entries.  This
   /// is one of the largest result values, not necessarily the first one.
   const semantics::Symbol *primaryResult{nullptr};
   /// Terminal basic block (if any)
   mlir::Block *finalBlock{};
   std::vector<std::vector<Variable>> varList;
+  HostAssociations hostAssociations;
 };
 
 /// Module-like units contain a list of function-like units.
@@ -675,9 +697,16 @@ struct ModuleLikeUnit : public ProgramUnit {
 
   std::vector<Variable> getOrderedSymbolTable() { return varList[0]; }
 
+  /// Get the starting source location for this module like unit.
+  parser::CharBlock getStartingSourceLoc() const;
+
+  /// Get the module scope.
+  const Fortran::semantics::Scope &getScope() const;
+
   ModuleStatement beginStmt;
   ModuleStatement endStmt;
   std::list<FunctionLikeUnit> nestedFunctions;
+  EvaluationList evaluationList;
   std::vector<std::vector<Variable>> varList;
 };
 
@@ -722,6 +751,33 @@ struct Program {
   std::list<Units> units;
 };
 
+/// Return the list of variables that appears in the specification expressions
+/// of a function result.
+std::vector<pft::Variable>
+buildFuncResultDependencyList(const Fortran::semantics::Symbol &);
+
+/// Helper to get location from FunctionLikeUnit/ModuleLikeUnit begin/end
+/// statements.
+template <typename T>
+static parser::CharBlock stmtSourceLoc(const T &stmt) {
+  return stmt.visit(common::visitors{[](const auto &x) { return x.source; }});
+}
+
+/// Get the first PFT ancestor node that has type ParentType.
+template <typename ParentType, typename A>
+ParentType *getAncestor(A &node) {
+  if (auto *seekedParent = node.parent.template getIf<ParentType>())
+    return seekedParent;
+  return node.parent.visit(common::visitors{
+      [](Program &p) -> ParentType * { return nullptr; },
+      [](auto &p) -> ParentType * { return getAncestor<ParentType>(p); }});
+}
+
+/// Call the provided \p callBack on all symbols that are referenced inside \p
+/// funit.
+void visitAllSymbols(const FunctionLikeUnit &funit,
+                     std::function<void(const semantics::Symbol &)> callBack);
+
 } // namespace Fortran::lower::pft
 
 namespace Fortran::lower {
@@ -739,7 +795,6 @@ createPFT(const parser::Program &root,
 
 /// Dumper for displaying a PFT.
 void dumpPFT(llvm::raw_ostream &outputStream, const pft::Program &pft);
-
 } // namespace Fortran::lower
 
 #endif // FORTRAN_LOWER_PFTBUILDER_H
diff --git a/flang/include/flang/Lower/PFTDefs.h b/flang/include/flang/Lower/PFTDefs.h
index 4dc31756ea4af..194f1020da57c 100644
--- a/flang/include/flang/Lower/PFTDefs.h
+++ b/flang/include/flang/Lower/PFTDefs.h
@@ -42,6 +42,7 @@ class Reference;
 namespace lower {
 
 bool definedInCommonBlock(const semantics::Symbol &sym);
+bool symbolIsGlobal(const semantics::Symbol &sym);
 bool defaultRecursiveFunctionSetting();
 
 namespace pft {
diff --git a/flang/lib/Lower/PFTBuilder.cpp b/flang/lib/Lower/PFTBuilder.cpp
index b0bd5bec1694e..c6a5ceb7b044d 100644
--- a/flang/lib/Lower/PFTBuilder.cpp
+++ b/flang/lib/Lower/PFTBuilder.cpp
@@ -1,4 +1,4 @@
-//===-- PFTBuilder.cc -----------------------------------------------------===//
+//===-- PFTBuilder.cpp ----------------------------------------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
@@ -7,7 +7,7 @@
 //===----------------------------------------------------------------------===//
 
 #include "flang/Lower/PFTBuilder.h"
-#include "IntervalSet.h"
+#include "flang/Lower/IntervalSet.h"
 #include "flang/Lower/Support/Utils.h"
 #include "flang/Parser/dump-parse-tree.h"
 #include "flang/Parser/parse-tree-visitor.h"
@@ -160,6 +160,8 @@ class PFTBuilder {
       exitFunction();
     } else if constexpr (lower::pft::isConstruct<A> ||
                          lower::pft::isDirective<A>) {
+      if constexpr (lower::pft::isDeclConstruct<A>)
+        return;
       exitConstructOrDirective();
     }
   }
@@ -221,14 +223,17 @@ class PFTBuilder {
   /// Initialize a new module-like unit and make it the builder's focus.
   template <typename A>
   bool enterModule(const A &func) {
-    auto &unit =
+    Fortran::lower::pft::ModuleLikeUnit &unit =
         addUnit(lower::pft::ModuleLikeUnit{func, pftParentStack.back()});
     functionList = &unit.nestedFunctions;
+    pushEvaluationList(&unit.evaluationList);
     pftParentStack.emplace_back(unit);
     return true;
   }
 
   void exitModule() {
+    if (!evaluationListStack.empty())
+      popEvaluationList();
     pftParentStack.pop_back();
     resetFunctionState();
   }
@@ -240,6 +245,11 @@ class PFTBuilder {
     if (evaluationListStack.empty())
       return;
     auto evaluationList = evaluationListStack.back();
+    if (evaluationList->empty() &&
+        pftParentStack.back().getIf<lower::pft::ModuleLikeUnit>()) {
+      popEvaluationList();
+      return;
+    }
     if (evaluationList->empty() || !evaluationList->back().isEndStmt()) {
       const auto &endStmt =
           pftParentStack.back().get<lower::pft::FunctionLikeUnit>().endStmt;
@@ -274,8 +284,9 @@ class PFTBuilder {
   bool enterFunction(const A &func,
                      const semantics::SemanticsContext &semanticsContext) {
     endFunctionBody(); // enclosing host subprogram body, if any
-    auto &unit = addFunction(lower::pft::FunctionLikeUnit{
-        func, pftParentStack.back(), semanticsContext});
+    Fortran::lower::pft::FunctionLikeUnit &unit =
+        addFunction(lower::pft::FunctionLikeUnit{func, pftParentStack.back(),
+                                                 semanticsContext});
     labelEvaluationMap = &unit.labelEvaluationMap;
     assignSymbolLabelMap = &unit.assignSymbolLabelMap;
     functionList = &unit.nestedFunctions;
@@ -296,20 +307,38 @@ class PFTBuilder {
     resetFunctionState();
   }
 
-  /// Initialize a new construct and make it the builder's focus.
+  /// Initialize a new construct or directive and make it the builder's focus.
   template <typename A>
-  bool enterConstructOrDirective(const A &construct) {
-    auto &eval =
-        addEvaluation(lower::pft::Evaluation{construct, pftParentStack.back()});
+  bool enterConstructOrDirective(const A &constructOrDirective) {
+    Fortran::lower::pft::Evaluation &eval = addEvaluation(
+        lower::pft::Evaluation{constructOrDirective, pftParentStack.back()});
     eval.evaluationList.reset(new lower::pft::EvaluationList);
     pushEvaluationList(eval.evaluationList.get());
     pftParentStack.emplace_back(eval);
     constructAndDirectiveStack.emplace_back(&eval);
+    if constexpr (lower::pft::isDeclConstruct<A>) {
+      popEvaluationList();
+      pftParentStack.pop_back();
+      constructAndDirectiveStack.pop_back();
+      popEvaluationList();
+    }
     return true;
   }
 
   void exitConstructOrDirective() {
     rewriteIfGotos();
+    auto *eval = constructAndDirectiveStack.back();
+    if (eval->isExecutableDirective()) {
+      // A construct at the end of an (unstructured) OpenACC or OpenMP
+      // construct region must have an exit target inside the region.
+      Fortran::lower::pft::EvaluationList &evaluationList =
+          *eval->evaluationList;
+      if (!evaluationList.empty() && evaluationList.back().isConstruct()) {
+        static const parser::ContinueStmt exitTarget{};
+        addEvaluation(
+            lower::pft::Evaluation{exitTarget, pftParentStack.back(), {}, {}});
+      }
+    }
     popEvaluationList();
     pftParentStack.pop_back();
     constructAndDirectiveStack.pop_back();
@@ -372,7 +401,8 @@ class PFTBuilder {
     auto &entryPointList = eval.getOwningProcedure()->entryPointList;
     evaluationListStack.back()->emplace_back(std::move(eval));
     lower::pft::Evaluation *p = &evaluationListStack.back()->back();
-    if (p->isActionStmt() || p->isConstructStmt() || p->isEndStmt()) {
+    if (p->isActionStmt() || p->isConstructStmt() || p->isEndStmt() ||
+        p->isExecutableDirective()) {
       if (lastLexicalEvaluation) {
         lastLexicalEvaluation->lexicalSuccessor = p;
         p->printIndex = lastLexicalEvaluation->printIndex + 1;
@@ -380,13 +410,14 @@ class PFTBuilder {
         p->printIndex = 1;
       }
       lastLexicalEvaluation = p;
-      for (auto entryIndex = entryPointList.size() - 1;
+      for (std::size_t entryIndex = entryPointList.size() - 1;
            entryIndex && !entryPointList[entryIndex].second->lexicalSuccessor;
            --entryIndex)
         // Link to the entry's first executable statement.
         entryPointList[entryIndex].second->lexicalSuccessor = p;
     } else if (const auto *entryStmt = p->getIf<parser::EntryStmt>()) {
-      const auto *sym = std::get<parser::Name>(entryStmt->t).symbol;
+      const semantics::Symbol *sym =
+          std::get<parser::Name>(entryStmt->t).symbol;
       assert(sym->has<semantics::SubprogramDetails>() &&
              "entry must be a subprogram");
       entryPointList.push_back(std::pair{sym, p});
@@ -410,8 +441,9 @@ class PFTBuilder {
     evaluationListStack.pop_back();
   }
 
-  /// Rewrite IfConstructs containing a GotoStmt to eliminate an unstructured
-  /// branch and a trivial basic block.  The pre-branch-analysis code:
+  /// Rewrite IfConstructs containing a GotoStmt or CycleStmt to eliminate an
+  /// unstructured branch and a trivial basic block.  The pre-branch-analysis
+  /// code:
   ///
   ///       <<IfConstruct>>
   ///         1 If[Then]Stmt: if(cond) goto L
@@ -433,8 +465,8 @@ class PFTBuilder {
   ///       6 Statement: L ...
   ///
   /// The If[Then]Stmt condition is implicitly negated.  It is not modified
-  /// in the PFT.  It must be negated when generating FIR.  The GotoStmt is
-  /// deleted.
+  /// in the PFT.  It must be negated when generating FIR.  The GotoStmt or
+  /// CycleStmt is deleted.
   ///
   /// The transformation is only valid for forward branch targets at the same
   /// construct nesting level as the IfConstruct.  The result must not violate
@@ -449,56 +481,86 @@ class PFTBuilder {
   /// not significant, but could be changed.
   ///
   void rewriteIfGotos() {
-    using T = struct {
+    auto &evaluationList = *evaluationListStack.back();
+    if (!evaluationList.size())
+      return;
+    struct T {
       lower::pft::EvaluationList::iterator ifConstructIt;
       parser::Label ifTargetLabel;
+      bool isCycleStmt = false;
     };
-    llvm::SmallVector<T, 8> ifExpansionStack;
-    auto &evaluationList = *evaluationListStack.back();
+    llvm::SmallVector<T> ifCandidateStack;
+    const auto *doStmt =
+        evaluationList.begin()->getIf<parser::NonLabelDoStmt>();
+    std::string doName = doStmt ? getConstructName(*doStmt) : std::string{};
     for (auto it = evaluationList.begin(), end = evaluationList.end();
          it != end; ++it) {
       auto &eval = *it;
       if (eval.isA<parser::EntryStmt>()) {
-        ifExpansionStack.clear();
+        ifCandidateStack.clear();
         continue;
       }
       auto firstStmt = [](lower::pft::Evaluation *e) {
         return e->isConstruct() ? &*e->evaluationList->begin() : e;
       };
-      auto &targetEval = *firstStmt(&eval);
-      if (targetEval.label) {
-        while (!ifExpansionStack.empty() &&
-               ifExpansionStack.back().ifTargetLabel == *targetEval.label) {
-          auto ifConstructIt = ifExpansionStack.back().ifConstructIt;
-          auto successorIt = std::next(ifConstructIt);
+      const Fortran::lower::pft::Evaluation &targetEval = *firstStmt(&eval);
+      bool targetEvalIsEndDoStmt = targetEval.isA<parser::EndDoStmt>();
+      auto branchTargetMatch = [&]() {
+        if (const parser::Label targetLabel =
+                ifCandidateStack.back().ifTargetLabel)
+          if (targetLabel == *targetEval.label)
+            return true; // goto target match
+        if (targetEvalIsEndDoStmt && ifCandidateStack.back().isCycleStmt)
+          return true; // cycle target match
+        return false;
+      };
+      if (targetEval.label || targetEvalIsEndDoStmt) {
+        while (!ifCandidateStack.empty() && branchTargetMatch()) {
+          lower::pft::EvaluationList::iterator ifConstructIt =
+              ifCandidateStack.back().ifConstructIt;
+          lower::pft::EvaluationList::iterator successorIt =
+              std::next(ifConstructIt);
           if (successorIt != it) {
-            auto &ifBodyList = *ifConstructIt->evaluationList;
-            auto gotoStmtIt = std::next(ifBodyList.begin());
-            assert(gotoStmtIt->isA<parser::GotoStmt>() && "expected GotoStmt");
-            ifBodyList.erase(gotoStmtIt);
-            auto &ifStmt = *ifBodyList.begin();
+            Fortran::lower::pft::EvaluationList &ifBodyList =
+                *ifConstructIt->evaluationList;
+            lower::pft::EvaluationList::iterator branchStmtIt =
+                std::next(ifBodyList.begin());
+            assert((branchStmtIt->isA<parser::GotoStmt>() ||
+                    branchStmtIt->isA<parser::CycleStmt>()) &&
+                   "expected goto or cycle statement");
+            ifBodyList.erase(branchStmtIt);
+            lower::pft::Evaluation &ifStmt = *ifBodyList.begin();
             ifStmt.negateCondition = true;
             ifStmt.lexicalSuccessor = firstStmt(&*successorIt);
-            auto endIfStmtIt = std::prev(ifBodyList.end());
+            lower::pft::EvaluationList::iterator endIfStmtIt =
+                std::prev(ifBodyList.end());
             std::prev(it)->lexicalSuccessor = &*endIfStmtIt;
             endIfStmtIt->lexicalSuccessor = firstStmt(&*it);
             ifBodyList.splice(endIfStmtIt, evaluationList, successorIt, it);
             for (; successorIt != endIfStmtIt; ++successorIt)
               successorIt->parentConstruct = &*ifConstructIt;
           }
-          ifExpansionStack.pop_back();
+          ifCandidateStack.pop_back();
         }
       }
       if (eval.isA<parser::IfConstruct>() && eval.evaluationList->size() == 3) {
-        if (auto *gotoStmt = std::next(eval.evaluationList->begin())
-                                 ->getIf<parser::GotoStmt>())
-          ifExpansionStack.push_back({it, gotoStmt->v});
+        const auto bodyEval = std::next(eval.evaluationList->begin());
+        if (const auto *gotoStmt = bodyEval->getIf<parser::GotoStmt>()) {
+          ifCandidateStack.push_back({it, gotoStmt->v});
+        } else if (doStmt) {
+          if (const auto *cycleStmt = bodyEval->getIf<parser::CycleStmt>()) {
+            std::string cycleName = getConstructName(*cycleStmt);
+            if (cycleName.empty() || cycleName == doName)
+              // This candidate will match doStmt's EndDoStmt.
+              ifCandidateStack.push_back({it, {}, true});
+          }
+        }
       }
     }
   }
 
-  /// Mark I/O statement ERR, EOR, and END specifier branch targets.
-  /// Mark an I/O statement with an assigned format as unstructured.
+  /// Mark IO statement ERR, EOR, and END specifier branch targets.
+  /// Mark an IO statement with an assigned format as unstructured.
   template <typename A>
   void analyzeIoBranches(lower::pft::Evaluation &eval, const A &stmt) {
     auto analyzeFormatSpec = [&](const parser::Format &format) {
@@ -566,8 +628,8 @@ class PFTBuilder {
     // If this is a branch into the body of a construct (usually illegal,
     // but allowed in some legacy cases), then the targetEvaluation and its
     // ancestors must be marked as unstructured.
-    auto *sourceConstruct = sourceEvaluation.parentConstruct;
-    auto *targetConstruct = targetEvaluation.parentConstruct;
+    lower::pft::Evaluation *sourceConstruct = sourceEvaluation.parentConstruct;
+    lower::pft::Evaluation *targetConstruct = targetEvaluation.parentConstruct;
     if (targetConstruct &&
         &targetConstruct->getFirstNestedEvaluation() == &targetEvaluation)
       // A branch to an initial constructStmt is a branch to the construct.
@@ -575,9 +637,18 @@ class PFTBuilder {
     if (targetConstruct) {
       while (sourceConstruct && sourceConstruct != targetConstruct)
         sourceConstruct = sourceConstruct->parentConstruct;
-      if (sourceConstruct != targetConstruct)
-        for (auto *eval = &targetEvaluation; eval; eval = eval->parentConstruct)
+      if (sourceConstruct != targetConstruct) // branch into a construct body
+        for (lower::pft::Evaluation *eval = &targetEvaluation; eval;
+             eval = eval->parentConstruct) {
           eval->isUnstructured = true;
+          // If the branch is a backward branch into an already analyzed
+          // DO or IF construct, mark the construct exit as a new block.
+          // For a forward branch, the isUnstructured flag will cause this
+          // to be done when the construct is analyzed.
+          if (eval->constructExit && (eval->isA<parser::DoConstruct>() ||
+                                      eval->isA<parser::IfConstruct>()))
+            eval->constructExit->isNewBlock = true;
+        }
     }
   }
   void markBranchTarget(lower::pft::Evaluation &sourceEvaluation,
@@ -615,18 +686,18 @@ class PFTBuilder {
         parser::MaskedElsewhereStmt, parser::NonLabelDoStmt,
         parser::SelectCaseStmt, parser::SelectRankCaseStmt,
         parser::TypeGuardStmt, parser::WhereConstructStmt>;
-
     if constexpr (common::HasMember<A, MaybeConstructNameInTuple>) {
       if (auto name = std::get<std::optional<parser::Name>>(stmt.t))
         return name->ToString();
     }
 
-    // These statements have several std::optional<parser::Name>
+    // These statements have multiple std::optional<parser::Name> elements.
     if constexpr (std::is_same_v<A, parser::SelectRankStmt> ||
                   std::is_same_v<A, parser::SelectTypeStmt>) {
       if (auto name = std::get<0>(stmt.t))
         return name->ToString();
     }
+
     return {};
   }
 
@@ -648,7 +719,7 @@ class PFTBuilder {
     lower::pft::Evaluation *lastConstructStmtEvaluation{};
     for (auto &eval : evaluationList) {
       eval.visit(common::visitors{
-          // Action statements (except I/O statements)
+          // Action statements (except IO statements)
           [&](const parser::CallStmt &s) {
             // Look for alternate return specifiers.
             const auto &args =
@@ -726,6 +797,11 @@ class PFTBuilder {
             markSuccessorAsNewBlock(eval);
           },
 
+          // The first executable statement after an EntryStmt is a new block.
+          [&](const parser::EntryStmt &) {
+            eval.lexicalSuccessor->isNewBlock = true;
+          },
+
           // Construct statements
           [&](const parser::AssociateStmt &s) {
             insertConstructName(s, parentConstruct);
@@ -861,7 +937,7 @@ class PFTBuilder {
             eval.isUnstructured = true;
           },
 
-          // Default - Common analysis for I/O statements; otherwise nop.
+          // Default - Common analysis for IO statements; otherwise nop.
           [&](const auto &stmt) {
             using A = std::decay_t<decltype(stmt)>;
             using IoStmts = std::tuple<
@@ -901,7 +977,8 @@ class PFTBuilder {
   /// also find one of the largest function results, since a single result
   /// container holds the result for all entries.
   void processEntryPoints() {
-    auto *unit = evaluationListStack.back()->front().getOwningProcedure();
+    lower::pft::Evaluation *initialEval = &evaluationListStack.back()->front();
+    lower::pft::FunctionLikeUnit *unit = initialEval->getOwningProcedure();
     int entryCount = unit->entryPointList.size();
     if (entryCount == 1)
       return;
@@ -910,7 +987,7 @@ class PFTBuilder {
       unit->setActiveEntry(entryIndex);
       const auto &details =
           unit->getSubprogramSymbol().get<semantics::SubprogramDetails>();
-      for (auto *arg : details.dummyArgs()) {
+      for (semantics::Symbol *arg : details.dummyArgs()) {
         if (!arg)
           continue; // alternate return specifier (no actual argument)
         const auto iter = dummyCountMap.find(arg);
@@ -920,7 +997,7 @@ class PFTBuilder {
           ++iter->second;
       }
       if (details.isFunction()) {
-        const auto *resultSym = &details.result();
+        const semantics::Symbol *resultSym = &details.result();
         assert(resultSym && "missing result symbol");
         if (!unit->primaryResult ||
             unit->primaryResult->size() < resultSym->size())
@@ -931,6 +1008,13 @@ class PFTBuilder {
     for (auto arg : dummyCountMap)
       if (arg.second < entryCount)
         unit->nonUniversalDummyArguments.push_back(arg.first);
+    // The first executable statement in the subprogram is preceded by a
+    // branch to the entry point, so it starts a new block.
+    if (initialEval->hasNestedEvaluations())
+      initialEval = &initialEval->getFirstNestedEvaluation();
+    else if (initialEval->isA<Fortran::parser::EntryStmt>())
+      initialEval = initialEval->lexicalSuccessor;
+    initialEval->isNewBlock = true;
   }
 
   std::unique_ptr<lower::pft::Program> pgm;
@@ -985,33 +1069,32 @@ class PFTDumper {
                       const lower::pft::Evaluation &eval,
                       const std::string &indentString, int indent = 1) {
     llvm::StringRef name = evaluationName(eval);
-    std::string bang = eval.isUnstructured ? "!" : "";
-    if (eval.isConstruct() || eval.isDirective()) {
-      outputStream << indentString << "<<" << name << bang << ">>";
-      if (eval.constructExit)
-        outputStream << " -> " << eval.constructExit->printIndex;
-      outputStream << '\n';
-      dumpEvaluationList(outputStream, *eval.evaluationList, indent + 1);
-      outputStream << indentString << "<<End " << name << bang << ">>\n";
-      return;
-    }
+    llvm::StringRef newBlock = eval.isNewBlock ? "^" : "";
+    llvm::StringRef bang = eval.isUnstructured ? "!" : "";
     outputStream << indentString;
     if (eval.printIndex)
       outputStream << eval.printIndex << ' ';
-    if (eval.isNewBlock)
-      outputStream << '^';
-    outputStream << name << bang;
-    if (eval.isActionStmt() || eval.isConstructStmt()) {
-      if (eval.negateCondition)
-        outputStream << " [negate]";
-      if (eval.controlSuccessor)
-        outputStream << " -> " << eval.controlSuccessor->printIndex;
-    } else if (eval.isA<parser::EntryStmt>() && eval.lexicalSuccessor) {
+    if (eval.hasNestedEvaluations())
+      outputStream << "<<" << newBlock << name << bang << ">>";
+    else
+      outputStream << newBlock << name << bang;
+    if (eval.negateCondition)
+      outputStream << " [negate]";
+    if (eval.constructExit)
+      outputStream << " -> " << eval.constructExit->printIndex;
+    else if (eval.controlSuccessor)
+      outputStream << " -> " << eval.controlSuccessor->printIndex;
+    else if (eval.isA<parser::EntryStmt>() && eval.lexicalSuccessor)
       outputStream << " -> " << eval.lexicalSuccessor->printIndex;
-    }
     if (!eval.position.empty())
       outputStream << ": " << eval.position.ToString();
+    else if (auto *dir = eval.getIf<Fortran::parser::CompilerDirective>())
+      outputStream << ": !" << dir->source.ToString();
     outputStream << '\n';
+    if (eval.hasNestedEvaluations()) {
+      dumpEvaluationList(outputStream, *eval.evaluationList, indent + 1);
+      outputStream << indentString << "<<End " << name << bang << ">>\n";
+    }
   }
 
   void dumpEvaluation(llvm::raw_ostream &ostream,
@@ -1024,7 +1107,7 @@ class PFTDumper {
                           int indent = 1) {
     static const auto white = "                                      ++"s;
     auto indentString = white.substr(0, indent * 2);
-    for (const auto &eval : evaluationList)
+    for (const lower::pft::Evaluation &eval : evaluationList)
       dumpEvaluation(outputStream, eval, indentString, indent);
   }
 
@@ -1069,7 +1152,8 @@ class PFTDumper {
     dumpEvaluationList(outputStream, functionLikeUnit.evaluationList);
     if (!functionLikeUnit.nestedFunctions.empty()) {
       outputStream << "\nContains\n";
-      for (auto &func : functionLikeUnit.nestedFunctions)
+      for (const lower::pft::FunctionLikeUnit &func :
+           functionLikeUnit.nestedFunctions)
         dumpFunctionLikeUnit(outputStream, func);
       outputStream << "End Contains\n";
     }
@@ -1081,7 +1165,8 @@ class PFTDumper {
     outputStream << getNodeIndex(moduleLikeUnit) << " ";
     outputStream << "ModuleLike: ";
     outputStream << "\nContains\n";
-    for (auto &func : moduleLikeUnit.nestedFunctions)
+    for (const lower::pft::FunctionLikeUnit &func :
+         moduleLikeUnit.nestedFunctions)
       dumpFunctionLikeUnit(outputStream, func);
     outputStream << "End Contains\nEnd ModuleLike\n\n";
   }
@@ -1122,6 +1207,7 @@ getFunctionStmt(const T &func) {
       std::get<parser::Statement<A>>(func.t)};
   return result;
 }
+
 template <typename A, typename T>
 static lower::pft::ModuleLikeUnit::ModuleStatement getModuleStmt(const T &mod) {
   lower::pft::ModuleLikeUnit::ModuleStatement result{
@@ -1179,12 +1265,39 @@ bool Fortran::lower::definedInCommonBlock(const semantics::Symbol &sym) {
   return semantics::FindCommonBlockContaining(sym);
 }
 
+static bool isReEntrant(const Fortran::semantics::Scope &scope) {
+  if (scope.kind() == Fortran::semantics::Scope::Kind::MainProgram)
+    return false;
+  if (scope.kind() == Fortran::semantics::Scope::Kind::Subprogram) {
+    const Fortran::semantics::Symbol *sym = scope.symbol();
+    assert(sym && "Subprogram scope must have a symbol");
+    return sym->attrs().test(semantics::Attr::RECURSIVE) ||
+           (!sym->attrs().test(semantics::Attr::NON_RECURSIVE) &&
+            Fortran::lower::defaultRecursiveFunctionSetting());
+  }
+  if (scope.kind() == Fortran::semantics::Scope::Kind::Module)
+    return false;
+  return true;
+}
+
 /// Is the symbol `sym` a global?
-static bool symbolIsGlobal(const semantics::Symbol &sym) {
-  if (const auto *details = sym.detailsIf<semantics::ObjectEntityDetails>())
+bool Fortran::lower::symbolIsGlobal(const semantics::Symbol &sym) {
+  if (const auto *details = sym.detailsIf<semantics::ObjectEntityDetails>()) {
     if (details->init())
       return true;
-  return semantics::IsSaved(sym) || lower::definedInCommonBlock(sym);
+    if (!isReEntrant(sym.owner())) {
+      // Turn array and character of non re-entrant programs (like the main
+      // program) into global memory.
+      if (const Fortran::semantics::DeclTypeSpec *symTy = sym.GetType())
+        if (symTy->category() == semantics::DeclTypeSpec::Character)
+          if (auto e = symTy->characterTypeSpec().length().GetExplicit())
+            return true;
+      if (!details->shape().empty() || !details->coshape().empty())
+        return true;
+    }
+  }
+  return semantics::IsSaved(sym) || lower::definedInCommonBlock(sym) ||
+         semantics::IsNamedConstant(sym);
 }
 
 namespace {
@@ -1194,91 +1307,86 @@ namespace {
 /// symbol table, which is sorted by name.
 struct SymbolDependenceDepth {
   explicit SymbolDependenceDepth(
-      std::vector<std::vector<lower::pft::Variable>> &vars, bool reentrant)
-      : vars{vars}, reentrant{reentrant} {}
+      std::vector<std::vector<lower::pft::Variable>> &vars)
+      : vars{vars} {}
 
   void analyzeAliasesInCurrentScope(const semantics::Scope &scope) {
+    // FIXME: When this function is called on the scope of an internal
+    // procedure whose parent contains an EQUIVALENCE set and the internal
+    // procedure uses variables from that EQUIVALENCE set, we end up creating
+    // an AggregateStore for those variables unnecessarily.
+    //
+    /// If this is a function nested in a module no host associated
+    /// symbol are added to the function scope for module symbols used in this
+    /// scope. As a result, alias analysis in parent module scopes must be
+    /// preformed here.
+    const semantics::Scope *parentScope = &scope;
+    while (!parentScope->IsGlobal()) {
+      parentScope = &parentScope->parent();
+      if (parentScope->IsModule())
+        analyzeAliases(*parentScope);
+    }
     for (const auto &iter : scope) {
-      const auto &ultimate = iter.second.get().GetUltimate();
+      const semantics::Symbol &ultimate = iter.second.get().GetUltimate();
       if (skipSymbol(ultimate))
         continue;
-      bool isDeclaration = scope != ultimate.owner();
-      analyzeAliases(ultimate.owner(), isDeclaration);
+      analyzeAliases(ultimate.owner());
     }
     // add all aggregate stores to the front of the work list
     adjustSize(1);
     // The copy in the loop matters, 'stores' will still be used.
-    for (auto st : stores) {
+    for (auto st : stores)
       vars[0].emplace_back(std::move(st));
-    }
   }
+
+  // Compute the offset of the last byte that resides in the symbol.
+  inline static std::size_t offsetWidth(const Fortran::semantics::Symbol &sym) {
+    std::size_t width = sym.offset();
+    if (std::size_t size = sym.size())
+      width += size - 1;
+    return width;
+  }
+
   // Analyze the equivalence sets. This analysis need not be performed when the
   // scope has no equivalence sets.
-  void analyzeAliases(const semantics::Scope &scope, bool isDeclaration) {
+  void analyzeAliases(const semantics::Scope &scope) {
     if (scope.equivalenceSets().empty())
       return;
-    if (scopeAnlyzedForAliases.find(&scope) != scopeAnlyzedForAliases.end())
+    // Don't analyze a scope if it has already been analyzed.
+    if (analyzedScopes.find(&scope) != analyzedScopes.end())
       return;
-    scopeAnlyzedForAliases.insert(&scope);
-    Fortran::lower::IntervalSet intervals;
-    llvm::DenseMap<std::size_t, llvm::SmallVector<const semantics::Symbol *, 8>>
-        aliasSets;
-    llvm::DenseMap<std::size_t, const semantics::Symbol *> setIsGlobal;
-
-    // 1. Construct the intervals. Determine each entity's interval, merging
-    // overlapping intervals into aggregates.
-    for (const auto &pair : scope) {
-      const auto &sym = pair.second.get();
-      if (skipSymbol(sym))
-        continue;
-      LLVM_DEBUG(llvm::dbgs() << "symbol: " << sym << '\n');
-      intervals.merge(sym.offset(), sym.offset() + sym.size() - 1);
-    }
-
-    // 2. Compute alias sets. Adds each entity to a set for the interval it
-    // appears to be mapped into.
-    for (const auto &pair : scope) {
-      const auto &sym = pair.second.get();
-      if (skipSymbol(sym))
-        continue;
-      auto iter = intervals.find(sym.offset());
-      if (iter != intervals.end()) {
-        LLVM_DEBUG(llvm::dbgs()
-                   << "symbol: " << toStringRef(sym.name()) << " on ["
-                   << iter->first << ".." << iter->second << "]\n");
-        aliasSets[iter->first].push_back(&sym);
-        if (symbolIsGlobal(sym))
-          setIsGlobal.insert({iter->first, &sym});
-      }
-    }
 
-    // 3. For each alias set with more than 1 member, add an Interval to the
-    // stores. The Interval will be lowered into a single memory allocation,
-    // with the co-located, overlapping variables mapped into that memory range.
-    for (const auto &pair : aliasSets) {
-      if (pair.second.size() > 1) {
-        // Set contains more than 1 aliasing variable.
-        // 1. Mark the symbols as aliasing for lowering.
-        for (auto *sym : pair.second)
-          aliasSyms.insert(sym);
-        auto gvarIter = setIsGlobal.find(pair.first);
-        auto iter = intervals.find(pair.first);
-        auto ibgn = iter->first;
-        auto ilen = iter->second - ibgn + 1;
-        // 2. Add an Interval to the list of stores allocated for this unit.
-        lower::pft::Variable::Interval interval(ibgn, ilen);
-        if (gvarIter != setIsGlobal.end()) {
-          LLVM_DEBUG(llvm::dbgs()
-                     << "interval [" << ibgn << ".." << ibgn + ilen
-                     << ") added as global " << *gvarIter->second << '\n');
-          stores.emplace_back(std::move(interval), scope, pair.second,
-                              isDeclaration);
+    analyzedScopes.insert(&scope);
+    std::list<std::list<semantics::SymbolRef>> aggregates =
+        Fortran::semantics::GetStorageAssociations(scope);
+    for (std::list<semantics::SymbolRef> aggregate : aggregates) {
+      const Fortran::semantics::Symbol *aggregateSym = nullptr;
+      bool isGlobal = false;
+      const semantics::Symbol &first = *aggregate.front();
+      std::size_t start = first.offset();
+      std::size_t end = first.offset() + first.size();
+      const Fortran::semantics::Symbol *namingSym = nullptr;
+      for (semantics::SymbolRef symRef : aggregate) {
+        const semantics::Symbol &sym = *symRef;
+        aliasSyms.insert(&sym);
+        if (sym.test(Fortran::semantics::Symbol::Flag::CompilerCreated)) {
+          aggregateSym = &sym;
         } else {
-          LLVM_DEBUG(llvm::dbgs() << "interval [" << ibgn << ".." << ibgn + ilen
-                                  << ") added\n");
-          stores.emplace_back(std::move(interval), scope, isDeclaration);
+          isGlobal |= lower::symbolIsGlobal(sym);
+          start = std::min(sym.offset(), start);
+          end = std::max(sym.offset() + sym.size(), end);
+          if (!namingSym || (sym.name() < namingSym->name()))
+            namingSym = &sym;
         }
       }
+      assert(namingSym && "must contain at least one user symbol");
+      if (!aggregateSym) {
+        stores.emplace_back(
+            Fortran::lower::pft::Variable::Interval{start, end - start},
+            *namingSym, isGlobal);
+      } else {
+        stores.emplace_back(*aggregateSym, *namingSym, isGlobal);
+      }
     }
   }
 
@@ -1293,7 +1401,14 @@ struct SymbolDependenceDepth {
       // TODO: add declaration?
       return 0;
     }
-    auto ultimate = sym.GetUltimate();
+    semantics::Symbol ultimate = sym.GetUltimate();
+    if (const auto *details =
+            ultimate.detailsIf<semantics::NamelistDetails>()) {
+      // handle namelist group symbols
+      for (const semantics::SymbolRef &s : details->objects())
+        analyze(s);
+      return 0;
+    }
     if (!ultimate.has<semantics::ObjectEntityDetails>() &&
         !ultimate.has<semantics::ProcEntityDetails>())
       return 0;
@@ -1302,21 +1417,22 @@ struct SymbolDependenceDepth {
       llvm_unreachable("not yet implemented - derived type analysis");
 
     // Symbol must be something lowering will have to allocate.
-    bool global = semantics::IsSaved(sym);
     int depth = 0;
-    const auto *symTy = sym.GetType();
+    const semantics::DeclTypeSpec *symTy = sym.GetType();
     assert(symTy && "symbol must have a type");
 
-    // check CHARACTER's length
-    if (symTy->category() == semantics::DeclTypeSpec::Character)
-      if (auto e = symTy->characterTypeSpec().length().GetExplicit()) {
-        // turn variable into a global if this unit is not reentrant
-        global = global || !reentrant;
-        for (const auto &s : evaluate::CollectSymbols(*e))
-          depth = std::max(analyze(s) + 1, depth);
-      }
-
+    // Analyze symbols appearing in object entity specification expression. This
+    // ensures these symbols will be instantiated before the current one.
+    // This is not done for object entities that are host associated because
+    // they must be instantiated from the value of the host symbols (the
+    // specification expressions should not be re-evaluated).
     if (const auto *details = sym.detailsIf<semantics::ObjectEntityDetails>()) {
+      // check CHARACTER's length
+      if (symTy->category() == semantics::DeclTypeSpec::Character)
+        if (auto e = symTy->characterTypeSpec().length().GetExplicit())
+          for (const auto &s : evaluate::CollectSymbols(*e))
+            depth = std::max(analyze(s) + 1, depth);
+
       auto doExplicit = [&](const auto &bound) {
         if (bound.isExplicit()) {
           semantics::SomeExpr e{*bound.GetExplicit()};
@@ -1325,28 +1441,22 @@ struct SymbolDependenceDepth {
         }
       };
       // handle any symbols in array bound declarations
-      if (!details->shape().empty())
-        global = global || !reentrant;
-      for (const auto &subs : details->shape()) {
+      for (const semantics::ShapeSpec &subs : details->shape()) {
         doExplicit(subs.lbound());
         doExplicit(subs.ubound());
       }
       // handle any symbols in coarray bound declarations
-      if (!details->coshape().empty())
-        global = global || !reentrant;
-      for (const auto &subs : details->coshape()) {
+      for (const semantics::ShapeSpec &subs : details->coshape()) {
         doExplicit(subs.lbound());
         doExplicit(subs.ubound());
       }
       // handle any symbols in initialization expressions
-      if (auto e = details->init()) {
-        // A PARAMETER may not be marked as implicitly SAVE, so set the flag.
-        global = true;
+      if (auto e = details->init())
         for (const auto &s : evaluate::CollectSymbols(*e))
           depth = std::max(analyze(s) + 1, depth);
-      }
     }
     adjustSize(depth + 1);
+    bool global = lower::symbolIsGlobal(sym);
     vars[depth].emplace_back(sym, global, depth);
     if (semantics::IsAllocatable(sym))
       vars[depth].back().setHeapAlloc();
@@ -1357,7 +1467,7 @@ struct SymbolDependenceDepth {
 
     // If there are alias sets, then link the participating variables to their
     // aggregate stores when constructing the new variable on the list.
-    if (auto *store = findStoreIfAlias(sym)) {
+    if (lower::pft::Variable::AggregateStore *store = findStoreIfAlias(sym)) {
       vars[depth].back().setAlias(store->getOffset());
     }
     return depth;
@@ -1373,26 +1483,31 @@ struct SymbolDependenceDepth {
 
   Fortran::lower::pft::Variable::AggregateStore *
   findStoreIfAlias(const Fortran::evaluate::Symbol &sym) {
-    const auto &ultimate = sym.GetUltimate();
-    const auto &scope = ultimate.owner();
+    const semantics::Symbol &ultimate = sym.GetUltimate();
+    const semantics::Scope &scope = ultimate.owner();
     // Expect the total number of EQUIVALENCE sets to be small for a typical
     // Fortran program.
     if (aliasSyms.find(&ultimate) != aliasSyms.end()) {
       LLVM_DEBUG(llvm::dbgs() << "symbol: " << ultimate << '\n');
       LLVM_DEBUG(llvm::dbgs() << "scope: " << scope << '\n');
-      auto off = ultimate.offset();
-      for (auto &v : stores) {
-        if (v.scope == &scope) {
-          auto bot = std::get<0>(v.interval);
-          if (off >= bot && off < bot + std::get<1>(v.interval))
+      std::size_t off = ultimate.offset();
+      std::size_t symSize = ultimate.size();
+      for (lower::pft::Variable::AggregateStore &v : stores) {
+        if (&v.getOwningScope() == &scope) {
+          auto intervalOff = std::get<0>(v.interval);
+          auto intervalSize = std::get<1>(v.interval);
+          if (off >= intervalOff && off < intervalOff + intervalSize)
+            return &v;
+          // Zero sized symbol in zero sized equivalence.
+          if (off == intervalOff && symSize == 0)
             return &v;
         }
       }
       // clang-format off
       LLVM_DEBUG(
           llvm::dbgs() << "looking for " << off << "\n{\n";
-          for (auto v : stores) {
-            llvm::dbgs() << " in scope: " << v.scope << "\n";
+          for (lower::pft::Variable::AggregateStore &v : stores) {
+            llvm::dbgs() << " in scope: " << &v.getOwningScope() << "\n";
             llvm::dbgs() << "  i = [" << std::get<0>(v.interval) << ".."
                 << std::get<0>(v.interval) + std::get<1>(v.interval)
                 << "]\n";
@@ -1407,8 +1522,11 @@ struct SymbolDependenceDepth {
 private:
   /// Skip symbol in alias analysis.
   bool skipSymbol(const semantics::Symbol &sym) {
+    // Common block equivalences are largely managed by the front end.
+    // Compiler generated symbols ('.' names) cannot be equivalenced.
+    // FIXME: Equivalence code generation may need to be revisited.
     return !sym.has<semantics::ObjectEntityDetails>() ||
-           lower::definedInCommonBlock(sym);
+           lower::definedInCommonBlock(sym) || sym.name()[0] == '.';
   }
 
   // Make sure the table is of appropriate size.
@@ -1420,23 +1538,26 @@ struct SymbolDependenceDepth {
   llvm::SmallSet<const semantics::Symbol *, 32> seen;
   std::vector<std::vector<lower::pft::Variable>> &vars;
   llvm::SmallSet<const semantics::Symbol *, 32> aliasSyms;
-  llvm::SmallSet<const semantics::Scope *, 4> scopeAnlyzedForAliases;
+  /// Set of Scope that have been analyzed for aliases.
+  llvm::SmallSet<const semantics::Scope *, 4> analyzedScopes;
   std::vector<Fortran::lower::pft::Variable::AggregateStore> stores;
-  bool reentrant;
 };
 } // namespace
 
 static void processSymbolTable(
     const semantics::Scope &scope,
-    std::vector<std::vector<Fortran::lower::pft::Variable>> &varList,
-    bool reentrant) {
-  SymbolDependenceDepth sdd{varList, reentrant};
+    std::vector<std::vector<Fortran::lower::pft::Variable>> &varList) {
+  SymbolDependenceDepth sdd{varList};
   sdd.analyzeAliasesInCurrentScope(scope);
   for (const auto &iter : scope)
     sdd.analyze(iter.second.get());
   sdd.finalize();
 }
 
+//===----------------------------------------------------------------------===//
+// FunctionLikeUnit implementation
+//===----------------------------------------------------------------------===//
+
 Fortran::lower::pft::FunctionLikeUnit::FunctionLikeUnit(
     const parser::MainProgram &func, const lower::pft::PftNode &parent,
     const semantics::SemanticsContext &semanticsContext)
@@ -1447,14 +1568,14 @@ Fortran::lower::pft::FunctionLikeUnit::FunctionLikeUnit(
       std::get<std::optional<parser::Statement<parser::ProgramStmt>>>(func.t);
   if (programStmt.has_value()) {
     beginStmt = FunctionStatement(programStmt.value());
-    const auto *symbol = getSymbol(*beginStmt);
+    const semantics::Symbol *symbol = getSymbol(*beginStmt);
     entryPointList[0].first = symbol;
-    processSymbolTable(*symbol->scope(), varList, isRecursive());
+    processSymbolTable(*symbol->scope(), varList);
   } else {
     processSymbolTable(
         semanticsContext.FindScope(
             std::get<parser::Statement<parser::EndProgramStmt>>(func.t).source),
-        varList, isRecursive());
+        varList);
   }
 }
 
@@ -1464,9 +1585,9 @@ Fortran::lower::pft::FunctionLikeUnit::FunctionLikeUnit(
     : ProgramUnit{func, parent},
       beginStmt{getFunctionStmt<parser::FunctionStmt>(func)},
       endStmt{getFunctionStmt<parser::EndFunctionStmt>(func)} {
-  const auto *symbol = getSymbol(*beginStmt);
+  const semantics::Symbol *symbol = getSymbol(*beginStmt);
   entryPointList[0].first = symbol;
-  processSymbolTable(*symbol->scope(), varList, isRecursive());
+  processSymbolTable(*symbol->scope(), varList);
 }
 
 Fortran::lower::pft::FunctionLikeUnit::FunctionLikeUnit(
@@ -1475,9 +1596,9 @@ Fortran::lower::pft::FunctionLikeUnit::FunctionLikeUnit(
     : ProgramUnit{func, parent},
       beginStmt{getFunctionStmt<parser::SubroutineStmt>(func)},
       endStmt{getFunctionStmt<parser::EndSubroutineStmt>(func)} {
-  const auto *symbol = getSymbol(*beginStmt);
+  const semantics::Symbol *symbol = getSymbol(*beginStmt);
   entryPointList[0].first = symbol;
-  processSymbolTable(*symbol->scope(), varList, isRecursive());
+  processSymbolTable(*symbol->scope(), varList);
 }
 
 Fortran::lower::pft::FunctionLikeUnit::FunctionLikeUnit(
@@ -1486,17 +1607,43 @@ Fortran::lower::pft::FunctionLikeUnit::FunctionLikeUnit(
     : ProgramUnit{func, parent},
       beginStmt{getFunctionStmt<parser::MpSubprogramStmt>(func)},
       endStmt{getFunctionStmt<parser::EndMpSubprogramStmt>(func)} {
-  const auto *symbol = getSymbol(*beginStmt);
+  const semantics::Symbol *symbol = getSymbol(*beginStmt);
   entryPointList[0].first = symbol;
-  processSymbolTable(*symbol->scope(), varList, isRecursive());
+  processSymbolTable(*symbol->scope(), varList);
+}
+
+Fortran::lower::HostAssociations &
+Fortran::lower::pft::FunctionLikeUnit::parentHostAssoc() {
+  if (auto *par = parent.getIf<FunctionLikeUnit>())
+    return par->hostAssociations;
+  llvm::report_fatal_error("parent is not a function");
 }
 
+bool Fortran::lower::pft::FunctionLikeUnit::parentHasHostAssoc() {
+  if (auto *par = parent.getIf<FunctionLikeUnit>())
+    return !par->hostAssociations.empty();
+  return false;
+}
+
+parser::CharBlock
+Fortran::lower::pft::FunctionLikeUnit::getStartingSourceLoc() const {
+  if (beginStmt)
+    return stmtSourceLoc(*beginStmt);
+  if (!evaluationList.empty())
+    return evaluationList.front().position;
+  return stmtSourceLoc(endStmt);
+}
+
+//===----------------------------------------------------------------------===//
+// ModuleLikeUnit implementation
+//===----------------------------------------------------------------------===//
+
 Fortran::lower::pft::ModuleLikeUnit::ModuleLikeUnit(
     const parser::Module &m, const lower::pft::PftNode &parent)
     : ProgramUnit{m, parent}, beginStmt{getModuleStmt<parser::ModuleStmt>(m)},
       endStmt{getModuleStmt<parser::EndModuleStmt>(m)} {
-  const auto *symbol = getSymbol(beginStmt);
-  processSymbolTable(*symbol->scope(), varList, /*reentrant=*/false);
+  const semantics::Symbol *symbol = getSymbol(beginStmt);
+  processSymbolTable(*symbol->scope(), varList);
 }
 
 Fortran::lower::pft::ModuleLikeUnit::ModuleLikeUnit(
@@ -1504,9 +1651,25 @@ Fortran::lower::pft::ModuleLikeUnit::ModuleLikeUnit(
     : ProgramUnit{m, parent}, beginStmt{getModuleStmt<parser::SubmoduleStmt>(
                                   m)},
       endStmt{getModuleStmt<parser::EndSubmoduleStmt>(m)} {
-  const auto *symbol = getSymbol(beginStmt);
-  processSymbolTable(*symbol->scope(), varList, /*reentrant=*/false);
+  const semantics::Symbol *symbol = getSymbol(beginStmt);
+  processSymbolTable(*symbol->scope(), varList);
+}
+
+parser::CharBlock
+Fortran::lower::pft::ModuleLikeUnit::getStartingSourceLoc() const {
+  return stmtSourceLoc(beginStmt);
 }
+const Fortran::semantics::Scope &
+Fortran::lower::pft::ModuleLikeUnit::getScope() const {
+  const Fortran::semantics::Symbol *symbol = getSymbol(beginStmt);
+  assert(symbol && symbol->scope() &&
+         "Module statement must have a symbol with a scope");
+  return *symbol->scope();
+}
+
+//===----------------------------------------------------------------------===//
+// BlockDataUnit implementation
+//===----------------------------------------------------------------------===//
 
 Fortran::lower::pft::BlockDataUnit::BlockDataUnit(
     const parser::BlockData &bd, const lower::pft::PftNode &parent,
@@ -1562,14 +1725,11 @@ void Fortran::lower::pft::Variable::dump() const {
   } else if (auto *s = std::get_if<AggregateStore>(&var)) {
     llvm::errs() << "interval[" << std::get<0>(s->interval) << ", "
                  << std::get<1>(s->interval) << "]:";
+    llvm::errs() << " name: " << toStringRef(s->getNamingSymbol().name());
     if (s->isGlobal())
       llvm::errs() << ", global";
-    if (s->vars.size()) {
-      llvm::errs() << ", vars: {";
-      llvm::interleaveComma(s->vars, llvm::errs(),
-                            [](auto *y) { llvm::errs() << *y; });
-      llvm::errs() << '}';
-    }
+    if (s->initialValueSymbol)
+      llvm::errs() << ", initial value: {" << *s->initialValueSymbol << "}";
   } else {
     llvm_unreachable("not a Variable");
   }
@@ -1588,3 +1748,70 @@ void Fortran::lower::pft::ModuleLikeUnit::dump() const {
 void Fortran::lower::pft::BlockDataUnit::dump() const {
   llvm::errs() << "block data {\n" << symTab << "\n}\n";
 }
+
+std::vector<Fortran::lower::pft::Variable>
+Fortran::lower::pft::buildFuncResultDependencyList(
+    const Fortran::semantics::Symbol &symbol) {
+  std::vector<std::vector<pft::Variable>> variableList;
+  SymbolDependenceDepth sdd(variableList);
+  sdd.analyzeAliasesInCurrentScope(symbol.owner());
+  sdd.analyze(symbol);
+  sdd.finalize();
+  // Remove the pft::variable for the result itself, only its dependencies
+  // should be returned in the list.
+  assert(!variableList[0].empty() && "must at least contain the result");
+  assert(&variableList[0].back().getSymbol() == &symbol &&
+         "result sym should be last");
+  variableList[0].pop_back();
+  return variableList[0];
+}
+
+namespace {
+/// Helper class to find all the symbols referenced in a FunctionLikeUnit.
+/// It defines a parse tree visitor doing a deep visit in all nodes with
+/// symbols (including evaluate::Expr).
+struct SymbolVisitor {
+  template <typename A>
+  bool Pre(const A &x) {
+    if constexpr (Fortran::parser::HasTypedExpr<A>::value)
+      if (const auto *expr = Fortran::semantics::GetExpr(x))
+        visitExpr(*expr);
+    return true;
+  }
+
+  bool Pre(const Fortran::parser::Name &name) {
+    if (const semantics::Symbol *symbol = name.symbol)
+      visitSymbol(*symbol);
+    return false;
+  }
+
+  void visitExpr(const Fortran::lower::SomeExpr &expr) {
+    for (const semantics::Symbol &symbol :
+         Fortran::evaluate::CollectSymbols(expr))
+      visitSymbol(symbol);
+  }
+
+  void visitSymbol(const Fortran::semantics::Symbol &symbol) {
+    callBack(symbol);
+    // Visit statement function body since it will be inlined in lowering.
+    if (const auto *subprogramDetails =
+            symbol.detailsIf<Fortran::semantics::SubprogramDetails>())
+      if (const auto &maybeExpr = subprogramDetails->stmtFunction())
+        visitExpr(*maybeExpr);
+  }
+
+  template <typename A>
+  constexpr void Post(const A &) {}
+
+  const std::function<void(const Fortran::semantics::Symbol &)> &callBack;
+};
+} // namespace
+
+void Fortran::lower::pft::visitAllSymbols(
+    const Fortran::lower::pft::FunctionLikeUnit &funit,
+    const std::function<void(const Fortran::semantics::Symbol &)> callBack) {
+  SymbolVisitor visitor{callBack};
+  funit.visit([&](const auto &functionParserNode) {
+    parser::Walk(functionParserNode, visitor);
+  });
+}
diff --git a/flang/test/Lower/pre-fir-tree01.f90 b/flang/test/Lower/pre-fir-tree01.f90
index ba26510d58f03..0af8eef28fc53 100644
--- a/flang/test/Lower/pre-fir-tree01.f90
+++ b/flang/test/Lower/pre-fir-tree01.f90
@@ -1,4 +1,4 @@
-! RUN: %flang_fc1 -fdebug-pre-fir-tree %s | FileCheck %s
+! RUN: bbc -pft-test -o %t %s | FileCheck %s
 
 ! Test structure of the Pre-FIR tree
 
@@ -132,14 +132,12 @@ function bar()
 ! Test top level directives
 !DIR$ INTEGER=64
 ! CHECK: CompilerDirective:
-! CHECK: End CompilerDirective
 
 ! Test nested directive
 ! CHECK: Subroutine test_directive
 subroutine test_directive()
   !DIR$ INTEGER=64
-  ! CHECK: <<CompilerDirective>>
-  ! CHECK: <<End CompilerDirective>>
+  ! CHECK: CompilerDirective:
 end subroutine
 ! CHECK: EndSubroutine
 
diff --git a/flang/test/Lower/pre-fir-tree02.f90 b/flang/test/Lower/pre-fir-tree02.f90
index 5692505a9bdb7..7cc55df4c0bb8 100644
--- a/flang/test/Lower/pre-fir-tree02.f90
+++ b/flang/test/Lower/pre-fir-tree02.f90
@@ -1,4 +1,4 @@
-! RUN: %flang_fc1 -fdebug-pre-fir-tree %s | FileCheck %s
+! RUN: bbc -pft-test -o %t %s | FileCheck %s
 
 ! Test Pre-FIR Tree captures all the intended nodes from the parse-tree
 ! Coarray and OpenMP related nodes are tested in other files.
@@ -212,8 +212,7 @@ function bar(x)
   ! CHECK: Subroutine sub
   subroutine sub(a)
     real(4):: a
-    ! CompilerDirective
-    ! CHECK: <<CompilerDirective>>
+    ! CompilerDirective:
     !DIR$ IGNORE_TKR a
   end subroutine
 
@@ -254,7 +253,7 @@ subroutine iostmts(filename, a, b, c)
   read(10, *) length
   ! CHECK: RewindStmt
   rewind 10
-  ! CHECK: NamelistStmt
+  ! CHECK-NOT: NamelistStmt
   namelist /nlist/ a, b, c
   ! CHECK: WriteStmt
   write(10, NML=nlist)
diff --git a/flang/test/Lower/pre-fir-tree05.f90 b/flang/test/Lower/pre-fir-tree05.f90
index 0e4576cf7c14d..aeca3ab79ac9f 100644
--- a/flang/test/Lower/pre-fir-tree05.f90
+++ b/flang/test/Lower/pre-fir-tree05.f90
@@ -24,14 +24,15 @@ subroutine foo()
   ! CHECK-NEXT: EndDoStmt
   ! CHECK-NEXT: <<End DoConstruct>>
   end do
+  ! CHECK-NEXT: ContinueStmt
   !$acc end parallel
-  ! CHECK-NEXT: <<End OpenACCConstruct>>
+  ! CHECK-NEXT:      <<End OpenACCConstruct>>
   ! CHECK-NEXT: <<End OpenACCConstruct>>
   ! CHECK-NEXT: EndSubroutineStmt
 end subroutine
 ! CHECK-NEXT: End Subroutine foo
 
-! CHECK: Subroutine foo
+! CHECK: Subroutine foo2
 subroutine foo2()
   ! CHECK-NEXT: <<OpenACCConstruct>>
   !$acc parallel loop
@@ -41,9 +42,9 @@ subroutine foo2()
   ! CHECK-NEXT: EndDoStmt
   ! CHECK-NEXT: <<End DoConstruct>>
   end do
+  ! CHECK-NEXT: ContinueStmt
   !$acc end parallel loop
   ! CHECK-NEXT: <<End OpenACCConstruct>>
   ! CHECK-NEXT: EndSubroutineStmt
 end subroutine
 ! CHECK-NEXT: End Subroutine foo2
-