Index: flang/lib/Semantics/resolve-names.cpp
===================================================================
--- flang/lib/Semantics/resolve-names.cpp
+++ flang/lib/Semantics/resolve-names.cpp
@@ -612,6 +612,10 @@
       return *symbol;
     } else {
       if (!CheckPossibleBadForwardRef(*symbol)) {
+        if (name.empty() && symbol->name().empty()) {
+          // report the error elsewhere
+          return *symbol;
+        }
         SayAlreadyDeclared(name, *symbol);
       }
       // replace the old symbol with a new one with correct details
@@ -1454,6 +1458,7 @@
   void Post(const parser::TypeGuardStmt &);
   bool Pre(const parser::StmtFunctionStmt &);
   bool Pre(const parser::DefinedOpName &);
+  bool Pre(const parser::Program &);
   bool Pre(const parser::ProgramUnit &);
   void Post(const parser::AssignStmt &);
   void Post(const parser::AssignedGotoStmt &);
@@ -7209,6 +7214,23 @@
   }
 }
 
+bool ResolveNamesVisitor::Pre(const parser::Program &program) {
+  unsigned mainProgCnt = 0;
+  for (auto &unit : program.v) {
+    if (const auto *mainProg{
+            std::get_if<common::Indirection<parser::MainProgram>>(&unit.u)}) {
+      auto &endProgStmt{std::get<parser::Statement<parser::EndProgramStmt>>(
+          mainProg->value().t)};
+      if (mainProgCnt > 0) {
+        Say(endProgStmt.source,
+            "A program cannot contain more than one main program"_err_en_US);
+      }
+      mainProgCnt++;
+    }
+  }
+  return true;
+}
+
 bool ResolveNamesVisitor::Pre(const parser::ProgramUnit &x) {
   if (std::holds_alternative<common::Indirection<parser::CompilerDirective>>(
           x.u)) {
Index: flang/test/Semantics/call02.f90
===================================================================
--- flang/test/Semantics/call02.f90
+++ flang/test/Semantics/call02.f90
@@ -110,7 +110,7 @@
   end
 end
 
-program p04
+subroutine p04
   implicit none
   !ERROR: No explicit type declared for 'index'
   call s1(index)
Index: flang/test/Semantics/case01.f90
===================================================================
--- flang/test/Semantics/case01.f90
+++ flang/test/Semantics/case01.f90
@@ -164,7 +164,7 @@
 
 end program
 
-program test_overlap
+subroutine test_overlap
   integer :: i
   !OK: these cases do not overlap
   select case(i)
@@ -178,7 +178,7 @@
   end select
 end
 
-program test_overflow
+subroutine test_overflow
   integer :: j
   select case(1_1)
   case (127)
Index: flang/test/Semantics/modfile41.f90
===================================================================
--- flang/test/Semantics/modfile41.f90
+++ flang/test/Semantics/modfile41.f90
@@ -34,61 +34,61 @@
   !ERROR: 'a' is use-associated from module 'm2' and cannot be re-declared
   integer :: a = 2
 end
-program testUse2
+subroutine testUse2
   use m1,only : a ! This forces the use association of m1's "a" as local "a"
   use m1,z=>a ! This rename doesn't affect the previous forced USE association
   !ERROR: 'a' is use-associated from module 'm1' and cannot be re-declared
   integer :: a = 2
 end
-program testUse3
+subroutine testUse3
   use m1 ! By itself, this would use associate m1's "a" with a local "a"
   use m1,z=>a ! This rename of m1'a "a" removes the previous use association
   integer :: a = 2
 end
-program testUse4
+subroutine testUse4
   use m1,only : a ! Use associate m1's "a" with local "a"
   use m1,z=>a ! Also use associate m1's "a" with local "z", also pulls in "b"
   !ERROR: 'b' is use-associated from module 'm1' and cannot be re-declared
   integer :: b = 2
 end
-program testUse5
+subroutine testUse5
   use m1,z=>a ! The rename prevents creation of a local "a"
   use m1 ! Does not create a local "a" because of the previous rename
   integer :: a = 2
 end
-program testUse6
+subroutine testUse6
   use m1, z => a ! Hides m1's "a"
   use m1, y => b ! Hides m1's "b"
   integer :: a = 4 ! OK
   integer :: b = 5 ! OK
 end
-program testUse7
+subroutine testUse7
   use m3,t1=>t2,t2=>t1 ! Looks weird but all is good
   type(t1) x
   type(t2) y
   x%t2_value = a
   y%t1_value = z
 end
-program testUse8
+subroutine testUse8
   use m4 ! This USE associates all of m1
   !ERROR: 'a' is use-associated from module 'm4' and cannot be re-declared
   integer :: a = 2
 end
-program testUse9
+subroutine testUse9
   use m5
   integer :: a = 2
 end
-program testUse10
+subroutine testUse10
   use m4
   use m4, z=>a ! This rename erases the USE assocated "a" from m1
   integer :: a = 2
 end
-program testUse11
+subroutine testUse11
   use m6
   use m6, z=>a ! This rename erases the USE assocated "a" from m1
   integer :: a = 2
 end
-program testUse12
+subroutine testUse12
   use m4 ! This USE associates "a" from m1
   use m1, z=>a ! This renames the "a" from m1, but not the one through m4
   !ERROR: 'a' is use-associated from module 'm4' and cannot be re-declared
Index: flang/test/Semantics/multi-programs01.f90
===================================================================
--- /dev/null
+++ flang/test/Semantics/multi-programs01.f90
@@ -0,0 +1,6 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+! Test the restriction in 5.2.2
+
+end
+!ERROR: A program cannot contain more than one main program
+end
Index: flang/test/Semantics/multi-programs02.f90
===================================================================
--- /dev/null
+++ flang/test/Semantics/multi-programs02.f90
@@ -0,0 +1,7 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+! Test the restriction in 5.2.2
+
+program m
+end
+!ERROR: A program cannot contain more than one main program
+end
Index: flang/test/Semantics/multi-programs03.f90
===================================================================
--- /dev/null
+++ flang/test/Semantics/multi-programs03.f90
@@ -0,0 +1,7 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+! Test the restriction in 5.2.2
+
+end
+program m
+!ERROR: A program cannot contain more than one main program
+end
Index: flang/test/Semantics/multi-programs04.f90
===================================================================
--- /dev/null
+++ flang/test/Semantics/multi-programs04.f90
@@ -0,0 +1,9 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+! Test the restriction in 5.2.2
+
+program m
+end
+!ERROR: 'm' is already declared in this scoping unit
+program m
+!ERROR: A program cannot contain more than one main program
+end
Index: flang/test/Semantics/multi-programs05.f90
===================================================================
--- /dev/null
+++ flang/test/Semantics/multi-programs05.f90
@@ -0,0 +1,8 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+! Test the restriction in 5.2.2
+
+program m
+end
+program m2
+!ERROR: A program cannot contain more than one main program
+end
Index: flang/test/Semantics/multi-programs06.f90
===================================================================
--- /dev/null
+++ flang/test/Semantics/multi-programs06.f90
@@ -0,0 +1,8 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+! Test the restriction in 5.2.2
+
+end
+!ERROR: A program cannot contain more than one main program
+end
+!ERROR: A program cannot contain more than one main program
+end
Index: flang/test/Semantics/omp-do04.f90
===================================================================
--- flang/test/Semantics/omp-do04.f90
+++ flang/test/Semantics/omp-do04.f90
@@ -4,7 +4,7 @@
 ! The loop iteration variable may not appear in a threadprivate directive.
 
 
-program omp_do
+subroutine omp_do
   integer, save:: i, j, k,n
   !$omp  threadprivate(k,j,i)
   !$omp  do collapse(2)
@@ -16,9 +16,10 @@
     end do
   end do
   !$omp end do
-end program omp_do
+end subroutine omp_do
 
-program omp_do1
+subroutine omp_do1
+  integer, save :: i, j, k
   !$omp  threadprivate(k,j,i)
   !$omp  do
   !ERROR: Loop iteration variable i is not allowed in THREADPRIVATE.
@@ -29,9 +30,10 @@
   end do
   !$omp end do
 
-end program omp_do1
+end subroutine omp_do1
 
-program omp_do2
+subroutine omp_do2
+  integer, save :: k, j
   !$omp threadprivate(k)
   !$omp threadprivate(j)
   call compute()
@@ -47,9 +49,10 @@
   !$omp end do
   end subroutine
 
-end program omp_do2
+end subroutine omp_do2
 
-program omp_do3
+subroutine omp_do3
+  integer, save :: i
   !$omp  threadprivate(i)
   !$omp parallel
   print *, "parallel"
@@ -63,7 +66,7 @@
   end do
   !$omp end do
 
-end program omp_do3
+end subroutine omp_do3
 
 module tp
   !integer i,j
@@ -76,7 +79,7 @@
   use tp
 end module usetp
 
-program main
+subroutine main
   use usetp
   !$omp  do
   !ERROR: Loop iteration variable i is not allowed in THREADPRIVATE.
@@ -86,9 +89,9 @@
     end do
   end do
   !$omp end do
-end program
+end subroutine
 
-program main1
+subroutine main1
   use tp
   !$omp  do
   !ERROR: Loop iteration variable j is not allowed in THREADPRIVATE.
@@ -98,4 +101,4 @@
     end do
   end do
   !$omp end do
-end program
+end subroutine
Index: flang/test/Semantics/omp-do11.f90
===================================================================
--- flang/test/Semantics/omp-do11.f90
+++ flang/test/Semantics/omp-do11.f90
@@ -21,8 +21,8 @@
   !$omp end do
 end program omp_do
 
-!DEF: /omp_do2 MainProgram
-program omp_do2
+!DEF: /omp_do2 (Subroutine)Subprogram
+subroutine omp_do2
   !DEF: /omp_do2/i ObjectEntity INTEGER(4)
   !DEF: /omp_do2/k ObjectEntity INTEGER(4)
   integer :: i = 0, k
@@ -33,4 +33,4 @@
     print *, "it", i
   end do
   !$omp end do
-end program omp_do2
+end subroutine omp_do2
Index: flang/test/Semantics/resolve102.f90
===================================================================
--- flang/test/Semantics/resolve102.f90
+++ flang/test/Semantics/resolve102.f90
@@ -26,7 +26,7 @@
   procedure(foo), pointer :: r 
 end function foo
 
-program iface
+subroutine iface
   !ERROR: Procedure 'p' is recursively defined.  Procedures in the cycle: 'p', 'sub', 'p2'
   procedure(sub) :: p
   interface
@@ -36,9 +36,9 @@
     end subroutine
   end interface
   call p(sub)
-end program
+end subroutine
 
-Program mutual
+subroutine mutual
   Procedure(sub1) :: p
 
   Call p(sub)
@@ -52,9 +52,9 @@
     Subroutine sub(p2)
       Procedure(sub1) :: p2
     End Subroutine
-End Program
+End subroutine
 
-Program mutual1
+subroutine mutual1
   Procedure(sub1) :: p
 
   Call p(sub)
@@ -68,18 +68,18 @@
     Subroutine sub(p2)
       Procedure(sub1) :: p2
     End Subroutine
-End Program
+End subroutine
 
-program twoCycle
+subroutine twoCycle
   !ERROR: The interface for procedure 'p1' is recursively defined
   !ERROR: The interface for procedure 'p2' is recursively defined
   procedure(p1) p2
   procedure(p2) p1
   call p1
   call p2
-end program
+end subroutine
 
-program threeCycle
+subroutine threeCycle
   !ERROR: The interface for procedure 'p1' is recursively defined
   !ERROR: The interface for procedure 'p2' is recursively defined
   procedure(p1) p2
@@ -89,7 +89,7 @@
   call p1
   call p2
   call p3
-end program
+end subroutine
 
 module mutualSpecExprs
 contains
Index: flang/test/Semantics/resolve14.f90
===================================================================
--- flang/test/Semantics/resolve14.f90
+++ flang/test/Semantics/resolve14.f90
@@ -12,7 +12,7 @@
   integer, parameter :: k2 = selected_int_kind(9)
 end
 
-program p1
+subroutine p1
   use m1
   use m2
   ! check that selected_int_kind is not use-associated
Index: flang/test/Semantics/resolve49.f90
===================================================================
--- flang/test/Semantics/resolve49.f90
+++ flang/test/Semantics/resolve49.f90
@@ -1,6 +1,6 @@
 ! RUN: %python %S/test_errors.py %s %flang_fc1
 ! Test section subscript
-program p1
+subroutine p1
   real :: a(10,10)
   real :: b(5,5)
   real :: c
@@ -10,7 +10,7 @@
 end
 
 ! Test substring
-program p2
+subroutine p2
   type t1(n1,n2)
     integer,kind :: n1,n2
     integer :: c2(iachar('ABCDEFGHIJ'(n1:n1)))
@@ -31,7 +31,7 @@
 end
 
 ! Test pointer assignment with bounds
-program p3
+subroutine p3
   integer, pointer :: a(:,:)
   integer, target :: b(2,2)
   integer :: n
@@ -41,7 +41,7 @@
 end
 
 ! Test pointer assignment to array element
-program p4
+subroutine p4
   type :: t
     real, pointer :: a
   end type
@@ -49,4 +49,4 @@
   integer :: i
   real, target :: y
   x(i)%a => y
-end program
+end subroutine
Index: flang/test/Semantics/resolve61.f90
===================================================================
--- flang/test/Semantics/resolve61.f90
+++ flang/test/Semantics/resolve61.f90
@@ -1,5 +1,5 @@
 ! RUN: %python %S/test_errors.py %s %flang_fc1
-program p1
+subroutine p1
   integer(8) :: a, b, c, d
   pointer(a, b)
   !ERROR: 'b' cannot be a Cray pointer as it is already a Cray pointee
@@ -8,38 +8,38 @@
   pointer(d, a)
 end
 
-program p2
+subroutine p2
   pointer(a, c)
   !ERROR: 'c' was already declared as a Cray pointee
   pointer(b, c)
 end
 
-program p3
+subroutine p3
   real a
   !ERROR: Cray pointer 'a' must have type INTEGER(8)
   pointer(a, b)
 end
 
-program p4
+subroutine p4
   implicit none
   real b
   !ERROR: No explicit type declared for 'd'
   pointer(a, b), (c, d)
 end
 
-program p5
+subroutine p5
   integer(8) a(10)
   !ERROR: Cray pointer 'a' must be a scalar
   pointer(a, b)
 end
 
-program p6
+subroutine p6
   real b(8)
   !ERROR: Array spec was already declared for 'b'
   pointer(a, b(4))
 end
 
-program p7
+subroutine p7
   !ERROR: Cray pointee 'b' must have must have explicit shape or assumed size
   pointer(a, b(:))
 contains
@@ -51,7 +51,7 @@
   end
 end
 
-program p8
+subroutine p8
   integer(8), parameter :: k = 2
   type t
   end type
@@ -66,7 +66,7 @@
   end
 end
 
-program p9
+subroutine p9
   integer(8), parameter :: k = 2
   type t
   end type
@@ -85,13 +85,13 @@
   integer(8) :: a
   real :: b
 end
-program p10
+subroutine p10
   use m10
   !ERROR: 'b' cannot be a Cray pointee as it is use-associated
   pointer(a, c),(d, b)
 end
 
-program p11
+subroutine p11
   pointer(a, b)
   !ERROR: PARAMETER attribute not allowed on 'a'
   parameter(a=2)
@@ -99,7 +99,7 @@
   parameter(b=3)
 end
 
-program p12
+subroutine p12
   type t1
     sequence
     real c1
Index: flang/test/Semantics/symbol16.f90
===================================================================
--- flang/test/Semantics/symbol16.f90
+++ flang/test/Semantics/symbol16.f90
@@ -16,12 +16,12 @@
  j = f(2)
 end program
 
-!DEF: /p2 MainProgram
-program p2
+!DEF: /p2 (Subroutine)Subprogram
+subroutine p2
  !DEF: /p2/f (Function, StmtFunction) Subprogram REAL(4)
  !DEF: /p2/f/x (Implicit) ObjectEntity REAL(4)
  !DEF: /p2/y (Implicit) ObjectEntity REAL(4)
  f(x) = y
  !REF: /p2/y
  y = 1.0
-end program
+end subroutine