diff --git a/gcc/fortran/ChangeLog.omp b/gcc/fortran/ChangeLog.omp
index 04ed7f88175..26375aca413 100644
--- a/gcc/fortran/ChangeLog.omp
+++ b/gcc/fortran/ChangeLog.omp
@@ -1,3 +1,26 @@
+2023-06-13  Sandra Loosemore  <sandra@codesourcery.com>
+
+	* openmp.cc: Include omp-api.h.
+	(resolve_omp_clauses): Consolidate inscan reduction clause conflict
+	checking here.
+	(scan_for_next_loop_in_chain): New.
+	(scan_for_next_loop_in_block): New.
+	(gfc_resolve_omp_do_blocks): Set omp_current_do_collapse properly.
+	Handle imperfectly-nested loops when looking for nested omp scan.
+	Refactor to move inscan reduction clause conflict checking to
+	resolve_omp_clauses.
+	(gfc_resolve_do_iterator): Handle imperfectly-nested loops.
+	(struct icode_error_state): New.
+	(icode_code_error_callback): New.
+	(icode_expr_error_callback): New.
+	(diagnose_intervening_code_errors_1): New.
+	(diagnose_intervening_code_errors): New.
+	(restructure_intervening_code): New.
+	(resolve_nested_loops): Update error handling, and extend to
+	detect imperfect nesting errors and check validity of
+	intervening code.  Call restructure_intervening_code if needed.
+	(resolve_omp_do): Rename collapse -> count.
+
 2023-06-13  Sandra Loosemore  <sandra@codesourcery.com>
 
 	* openmp.cc (find_nested_loop_in_chain): Move up in file.
diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index 5ab64b5231f..bdca36e4743 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -31,6 +31,7 @@ along with GCC; see the file COPYING3.  If not see
 #include "target-memory.h"  /* For gfc_encode_character.  */
 #include "bitmap.h"
 #include "options.h"
+#include "omp-api.h"  /* For omp_runtime_api_procname.  */
 
 
 static gfc_statement omp_code_to_statement (gfc_code *);
@@ -8183,15 +8184,24 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
 	  gfc_error ("Object %qs is not a variable at %L", n->sym->name,
 		     &n->where);
       }
-  if (omp_clauses->lists[OMP_LIST_REDUCTION_INSCAN]
-      && code->op != EXEC_OMP_DO
-      && code->op != EXEC_OMP_SIMD
-      && code->op != EXEC_OMP_DO_SIMD
-      && code->op != EXEC_OMP_PARALLEL_DO
-      && code->op != EXEC_OMP_PARALLEL_DO_SIMD)
-    gfc_error ("%<inscan%> REDUCTION clause on construct other than DO, SIMD, "
-	       "DO SIMD, PARALLEL DO, PARALLEL DO SIMD at %L",
-	       &omp_clauses->lists[OMP_LIST_REDUCTION_INSCAN]->where);
+  if (omp_clauses->lists[OMP_LIST_REDUCTION_INSCAN])
+    {
+      locus *loc = &omp_clauses->lists[OMP_LIST_REDUCTION_INSCAN]->where;
+      if (code->op != EXEC_OMP_DO
+	  && code->op != EXEC_OMP_SIMD
+	  && code->op != EXEC_OMP_DO_SIMD
+	  && code->op != EXEC_OMP_PARALLEL_DO
+	  && code->op != EXEC_OMP_PARALLEL_DO_SIMD)
+	gfc_error ("%<inscan%> REDUCTION clause on construct other than DO, "
+		   "SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD at %L",
+		   loc);
+      if (omp_clauses->ordered)
+	gfc_error ("ORDERED clause specified together with %<inscan%> "
+		   "REDUCTION clause at %L", loc);
+      if (omp_clauses->sched_kind != OMP_SCHED_NONE)
+	gfc_error ("SCHEDULE clause specified together with %<inscan%> "
+		   "REDUCTION clause at %L", loc);
+    }
 
   for (list = 0; list < OMP_LIST_NUM; list++)
     if (list != OMP_LIST_FIRSTPRIVATE
@@ -10091,68 +10101,130 @@ find_nested_loop_in_block (gfc_code *block)
   return find_nested_loop_in_chain (ns->code);
 }
 
+/* Forward declaration for mutually recursive functions.  */
+static gfc_code *
+scan_for_next_loop_in_block (gfc_code *block, gfc_code **imperfectp);
+
+/* Like find_nested_loop_in_chain, but also stop when a loop transform is
+   found and check for intervening code too.  Return the first nested
+   DO loop or loop transform in CHAIN, and set *IMPERFECTP to the first
+   intervening code statement if one is found.  */
+static gfc_code *
+scan_for_next_loop_in_chain (gfc_code *chain, gfc_code **imperfectp)
+{
+  gfc_code *code;
+  gfc_code *result = NULL;
+
+  if (!chain)
+    return NULL;
+
+  for (code = chain; code; code = code->next)
+    {
+      /* DO WHILE and DO CONCURRENT are errors, but we need to catch them
+	 here to ensure the right error is diagnosed elsewhere.  */
+      if (!result
+	  && (code->op == EXEC_DO
+	      || code->op == EXEC_DO_WHILE
+	      || code->op == EXEC_DO_CONCURRENT
+	      || loop_transform_p (code->op)))
+	result = code;
+      else if (!result && code->op == EXEC_BLOCK)
+	{
+	  result = scan_for_next_loop_in_block (code, imperfectp);
+	  /* If no loop in the block, the block itself is intervening code.  */
+	  if (!result && !*imperfectp)
+	    *imperfectp = code;
+	}
+      else if (code->op == EXEC_NOP || code->op == EXEC_CONTINUE)
+	continue;
+      else if (!*imperfectp)
+	*imperfectp = code;
+      if (result && *imperfectp)
+	break;
+    }
+  return result;
+}
+
+/* Like find_nested_loop_in_block, but also checks for intervening code.
+   Return the first nested DO loop in BLOCK, or NULL if there
+   isn't one.  Sets *IMPERFECTP to the first piece of intervening code.  */
+static gfc_code *
+scan_for_next_loop_in_block (gfc_code *block, gfc_code **imperfectp)
+{
+  gfc_namespace *ns;
+  gcc_assert (block->op == EXEC_BLOCK);
+  ns = block->ext.block.ns;
+  gcc_assert (ns);
+  return scan_for_next_loop_in_chain (ns->code, imperfectp);
+}
+
 void
 gfc_resolve_omp_do_blocks (gfc_code *code, gfc_namespace *ns)
 {
   if (code->block->next && code->block->next->op == EXEC_DO)
     {
       int i;
-      gfc_code *c;
 
       omp_current_do_code = code->block->next;
       if (code->ext.omp_clauses->orderedc)
 	omp_current_do_collapse = code->ext.omp_clauses->orderedc;
-      else
+      else if (code->ext.omp_clauses->collapse)
 	omp_current_do_collapse = code->ext.omp_clauses->collapse;
-      for (i = 1, c = omp_current_do_code; i < omp_current_do_collapse; i++)
-	{
-	  c = c->block;
-	  if (c->op != EXEC_DO || c->next == NULL)
-	    break;
-	  c = c->next;
-	  if (c->op != EXEC_DO)
-	    break;
-	}
-      if (i < omp_current_do_collapse || omp_current_do_collapse <= 0)
+      else
 	omp_current_do_collapse = 1;
       if (code->ext.omp_clauses->lists[OMP_LIST_REDUCTION_INSCAN])
 	{
+	  /* Checking that there is a matching EXEC_OMP_SCAN in the
+	     innermost body cannot be deferred to resolve_omp_do because
+	     we process directives nested in the loop before we get
+	     there.  */
 	  locus *loc
 	    = &code->ext.omp_clauses->lists[OMP_LIST_REDUCTION_INSCAN]->where;
-	  if (code->ext.omp_clauses->ordered)
-	    gfc_error ("ORDERED clause specified together with %<inscan%> "
-		       "REDUCTION clause at %L", loc);
-	  if (code->ext.omp_clauses->sched_kind != OMP_SCHED_NONE)
-	    gfc_error ("SCHEDULE clause specified together with %<inscan%> "
-		       "REDUCTION clause at %L", loc);
-	  gfc_code *block = c->block ? c->block->next : NULL;
-	  if (block && block->op != EXEC_OMP_SCAN)
-	    while (block && block->next && block->next->op != EXEC_OMP_SCAN)
-	      block = block->next;
-	  if (!block
-	      || (block->op != EXEC_OMP_SCAN
-		  && (!block->next || block->next->op != EXEC_OMP_SCAN)))
-	    gfc_error ("With INSCAN at %L, expected loop body with !$OMP SCAN "
-		       "between two structured block sequences", loc);
-	  else
+	  gfc_code *c;
+
+	  for (i = 1, c = omp_current_do_code;
+	       i < omp_current_do_collapse; i++)
 	    {
-	      if (block->op == EXEC_OMP_SCAN)
-		gfc_warning (0, "!$OMP SCAN at %L with zero executable "
-				"statements in preceding structured block "
-				"sequence", &block->loc);
-	      if ((block->op == EXEC_OMP_SCAN && !block->next)
-		  || (block->next && block->next->op == EXEC_OMP_SCAN
-		      && !block->next->next))
-		gfc_warning (0, "!$OMP SCAN at %L with zero executable "
-				"statements in succeeding structured block "
-				"sequence", block->op == EXEC_OMP_SCAN
-					    ? &block->loc : &block->next->loc);
-	    }
-	  if (block && block->op != EXEC_OMP_SCAN)
-	    block = block->next;
-	  if (block && block->op == EXEC_OMP_SCAN)
-	    /* Mark 'omp scan' as checked; flag will be unset later.  */
-	    block->ext.omp_clauses->if_present = true;
+	      c = find_nested_loop_in_chain (c->block->next);
+	      if (!c || c->op != EXEC_DO || c->block == NULL)
+		break;
+	    }
+
+	  /* Skip this if we don't have enough nested loops.  That
+	     problem will be diagnosed elsewhere.  */
+	  if (c && c->op == EXEC_DO)
+	    {
+	      gfc_code *block = c->block ? c->block->next : NULL;
+	      if (block && block->op != EXEC_OMP_SCAN)
+		while (block && block->next
+		       && block->next->op != EXEC_OMP_SCAN)
+		  block = block->next;
+	      if (!block
+		  || (block->op != EXEC_OMP_SCAN
+		      && (!block->next || block->next->op != EXEC_OMP_SCAN)))
+		gfc_error ("With INSCAN at %L, expected loop body with "
+			   "!$OMP SCAN between two "
+			   "structured block sequences", loc);
+	      else
+		{
+		  if (block->op == EXEC_OMP_SCAN)
+		    gfc_warning (0, "!$OMP SCAN at %L with zero executable "
+				 "statements in preceding structured block "
+				 "sequence", &block->loc);
+		  if ((block->op == EXEC_OMP_SCAN && !block->next)
+		      || (block->next && block->next->op == EXEC_OMP_SCAN
+			  && !block->next->next))
+		    gfc_warning (0, "!$OMP SCAN at %L with zero executable "
+				 "statements in succeeding structured block "
+				 "sequence", block->op == EXEC_OMP_SCAN
+				 ? &block->loc : &block->next->loc);
+		}
+	      if (block && block->op != EXEC_OMP_SCAN)
+		block = block->next;
+	      if (block && block->op == EXEC_OMP_SCAN)
+		/* Mark 'omp scan' as checked; flag will be unset later.  */
+		block->ext.omp_clauses->if_present = true;
+	    }
 	}
     }
   gfc_resolve_blocks (code->block, ns);
@@ -10282,13 +10354,12 @@ gfc_resolve_do_iterator (gfc_code *code, gfc_symbol *sym, bool add_clause)
      private just in the !$omp do resp. !$omp parallel do construct,
      with no implications for the outer parallel constructs.  */
 
-  while (i-- >= 1)
+  while (i-- >= 1 && c)
     {
       if (code == c)
 	return;
-
-      c = c->block->next;
-    }
+      c = find_nested_loop_in_chain (c->block->next);
+   }
 
   /* An openacc context may represent a data clause.  Abort if so.  */
   if (!omp_current_ctx->is_openmp && !oacc_is_loop (omp_current_ctx->code))
@@ -10327,6 +10398,328 @@ gfc_resolve_omp_local_vars (gfc_namespace *ns)
     gfc_traverse_ns (ns, handle_local_var);
 }
 
+/* Error checking on intervening code uses a code walker.  */
+
+struct icode_error_state
+{
+  const char *name;
+  bool errorp;
+  gfc_code *nested;
+  gfc_code *next;
+};
+
+static int
+icode_code_error_callback (gfc_code **codep,
+			   int *walk_subtrees ATTRIBUTE_UNUSED, void *opaque)
+{
+  gfc_code *code = *codep;
+  icode_error_state *state = (icode_error_state *)opaque;
+
+  /* gfc_code_walker walks down CODE's next chain as well as
+     walking things that are actually nested in CODE.  We need to
+     special-case traversal of outer blocks, so stop immediately if we
+     are heading down such a next chain.  */
+  if (code == state->next)
+    return 1;
+
+  switch (code->op)
+    {
+    case EXEC_DO:
+    case EXEC_DO_WHILE:
+    case EXEC_DO_CONCURRENT:
+      gfc_error ("%s cannot contain loop in intervening code at %L",
+		 state->name, &code->loc);
+      state->errorp = true;
+      break;
+    case EXEC_CYCLE:
+    case EXEC_EXIT:
+      /* Errors have already been diagnosed in match_exit_cycle.  */
+      state->errorp = true;
+      break;
+    case EXEC_OMP_CRITICAL:
+    case EXEC_OMP_DO:
+    case EXEC_OMP_FLUSH:
+    case EXEC_OMP_MASTER:
+    case EXEC_OMP_ORDERED:
+    case EXEC_OMP_PARALLEL:
+    case EXEC_OMP_PARALLEL_DO:
+    case EXEC_OMP_PARALLEL_SECTIONS:
+    case EXEC_OMP_PARALLEL_WORKSHARE:
+    case EXEC_OMP_SECTIONS:
+    case EXEC_OMP_SINGLE:
+    case EXEC_OMP_WORKSHARE:
+    case EXEC_OMP_ATOMIC:
+    case EXEC_OMP_BARRIER:
+    case EXEC_OMP_END_NOWAIT:
+    case EXEC_OMP_END_SINGLE:
+    case EXEC_OMP_TASK:
+    case EXEC_OMP_TASKWAIT:
+    case EXEC_OMP_TASKYIELD:
+    case EXEC_OMP_CANCEL:
+    case EXEC_OMP_CANCELLATION_POINT:
+    case EXEC_OMP_TASKGROUP:
+    case EXEC_OMP_SIMD:
+    case EXEC_OMP_DO_SIMD:
+    case EXEC_OMP_PARALLEL_DO_SIMD:
+    case EXEC_OMP_TARGET:
+    case EXEC_OMP_TARGET_DATA:
+    case EXEC_OMP_TEAMS:
+    case EXEC_OMP_DISTRIBUTE:
+    case EXEC_OMP_DISTRIBUTE_SIMD:
+    case EXEC_OMP_DISTRIBUTE_PARALLEL_DO:
+    case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD:
+    case EXEC_OMP_TARGET_TEAMS:
+    case EXEC_OMP_TEAMS_DISTRIBUTE:
+    case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD:
+    case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE:
+    case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
+    case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
+    case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
+    case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
+    case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
+    case EXEC_OMP_TARGET_UPDATE:
+    case EXEC_OMP_END_CRITICAL:
+    case EXEC_OMP_TARGET_ENTER_DATA:
+    case EXEC_OMP_TARGET_EXIT_DATA:
+    case EXEC_OMP_TARGET_PARALLEL:
+    case EXEC_OMP_TARGET_PARALLEL_DO:
+    case EXEC_OMP_TARGET_PARALLEL_DO_SIMD:
+    case EXEC_OMP_TARGET_SIMD:
+    case EXEC_OMP_TASKLOOP:
+    case EXEC_OMP_TASKLOOP_SIMD:
+    case EXEC_OMP_SCAN:
+    case EXEC_OMP_DEPOBJ:
+    case EXEC_OMP_PARALLEL_MASTER:
+    case EXEC_OMP_PARALLEL_MASTER_TASKLOOP:
+    case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
+    case EXEC_OMP_MASTER_TASKLOOP:
+    case EXEC_OMP_MASTER_TASKLOOP_SIMD:
+    case EXEC_OMP_LOOP:
+    case EXEC_OMP_PARALLEL_LOOP:
+    case EXEC_OMP_TEAMS_LOOP:
+    case EXEC_OMP_TARGET_PARALLEL_LOOP:
+    case EXEC_OMP_TARGET_TEAMS_LOOP:
+    case EXEC_OMP_MASKED:
+    case EXEC_OMP_PARALLEL_MASKED:
+    case EXEC_OMP_PARALLEL_MASKED_TASKLOOP:
+    case EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD:
+    case EXEC_OMP_MASKED_TASKLOOP:
+    case EXEC_OMP_MASKED_TASKLOOP_SIMD:
+    case EXEC_OMP_SCOPE:
+    case EXEC_OMP_ERROR:
+      gfc_error ("%s cannot contain OpenMP directive in intervening code "
+		 "at %L",
+		 state->name, &code->loc);
+      state->errorp = true;
+      break;
+    case EXEC_CALL:
+      /* Per OpenMP 5.2, the "omp_" prefix is reserved, so we don't have to
+	 consider the possibility that some locally-bound definition
+	 overrides the runtime routine.  */
+      if (code->resolved_sym
+	  && omp_runtime_api_procname (code->resolved_sym->name))
+	{
+	  gfc_error ("%s cannot contain OpenMP API call in intervening code "
+		     "at %L",
+		 state->name, &code->loc);
+	  state->errorp = true;
+	}
+      break;
+    default:
+      break;
+    }
+  return 0;
+}
+
+static int
+icode_expr_error_callback (gfc_expr **expr,
+			   int *walk_subtrees ATTRIBUTE_UNUSED, void *opaque)
+{
+  icode_error_state *state = (icode_error_state *)opaque;
+
+  switch ((*expr)->expr_type)
+    {
+      /* As for EXPR_CALL with "omp_"-prefixed symbols.  */
+    case EXPR_FUNCTION:
+      {
+	gfc_symbol *sym = (*expr)->value.function.esym;
+	if (sym && omp_runtime_api_procname (sym->name))
+	  {
+	    gfc_error ("%s cannot contain OpenMP API call in intervening code "
+		       "at %L",
+		       state->name, &((*expr)->where));
+	    state->errorp = true;
+	  }
+	}
+
+      break;
+    default:
+      break;
+    }
+
+  /* FIXME: The description of canonical loop form in the OpenMP standard
+     also says "array expressions" are not permitted in intervening code.
+     That term is not defined in either the OpenMP spec or the Fortran
+     standard, although the latter uses it informally to refer to any
+     expression that is not scalar-valued.  It is also apparently not the
+     thing GCC internally calls EXPR_ARRAY.  It seems the intent of the
+     OpenMP restriction is to disallow elemental operations/intrinsics
+     (including things that are not expressions, like assignment
+     statements) that generate implicit loops over array operands
+     (even if the result is a scalar), but even if the spec said
+     that there is no list of all the cases that would be forbidden.
+     This is OpenMP issue 3326.  */
+
+  return 0;
+}
+
+static void
+diagnose_intervening_code_errors_1 (gfc_code *chain,
+				    struct icode_error_state *state)
+{
+  gfc_code *code;
+  for (code = chain; code; code = code->next)
+    {
+      if (code == state->nested)
+	/* Do not walk the nested loop or its body, we are only
+	   interested in intervening code.  */
+	;
+      else if (code->op == EXEC_BLOCK
+	       && find_nested_loop_in_block (code) == state->nested)
+	/* This block contains the nested loop, recurse on its
+	   statements.  */
+	{
+	  gfc_namespace* ns = code->ext.block.ns;
+	  diagnose_intervening_code_errors_1 (ns->code, state);
+	}
+      else
+	/* Treat the whole statement as a unit.  */
+	{
+	  gfc_code *temp = state->next;
+	  state->next = code->next;
+	  gfc_code_walker (&code, icode_code_error_callback,
+			   icode_expr_error_callback, state);
+	  state->next = temp;
+	}
+    }
+}
+
+/* Diagnose intervening code errors in BLOCK with nested loop NESTED.
+   NAME is the user-friendly name of the OMP directive, used for error
+   messages.  Returns true if any error was found.  */
+static bool
+diagnose_intervening_code_errors (gfc_code *chain, const char *name,
+				  gfc_code *nested)
+{
+  struct icode_error_state state;
+  state.name = name;
+  state.errorp = false;
+  state.nested = nested;
+  state.next = NULL;
+  diagnose_intervening_code_errors_1 (chain, &state);
+  return state.errorp;
+}
+
+/* Push intervening code surrounding a loop, including nested scopes,
+   into the body of the loop.  CHAINP is the pointer to the head of
+   the next-chain to scan, OUTER_LOOP is the EXEC_DO for the next outer
+   loop level, and COLLAPSE is the number of nested loops we need to
+   process.
+   Note that CHAINP may point at outer_loop->block->next when we
+   are scanning the body of a loop, but if there is an intervening block
+   CHAINP points into the block's chain rather than its enclosing outer
+   loop.  This is why OUTER_LOOP is passed separately.  */
+static gfc_code *
+restructure_intervening_code (gfc_code **chainp, gfc_code *outer_loop,
+			      int count)
+{
+  gfc_code *code;
+  gfc_code *head = *chainp;
+  gfc_code *tail = NULL;
+  gfc_code *innermost_loop = NULL;
+
+  for (code = *chainp; code; code = code->next, chainp = &((*chainp)->next))
+    {
+      if (code->op == EXEC_DO || loop_transform_p (code->op))
+	{
+	  gfc_code *c = code;
+
+	  /* Treat a series of loop transforms as a unit, same as a single
+	     EXEC_DO.  CODE is the first and C is the last in the chain.  */
+	  while (loop_transform_p (c->op) && !c->block)
+	    c = c->next;
+
+	  gcc_assert (c);
+	  gcc_assert (c->op == EXEC_DO
+		      || (loop_transform_p (c->op) && c->block));
+
+	  /* Cut the transforms and the loop they apply to free from the
+	     chain, leaving the ends dangling.  */
+	  *chainp = NULL;
+	  tail = c->next;
+	  c->next = NULL;
+
+	  if (count == 1 && c->op == EXEC_DO)
+	    innermost_loop = c;
+	  else
+	    innermost_loop
+	      = restructure_intervening_code (&(c->block->next), c,
+					      (loop_transform_p (c->op)
+					       ? count : count - 1));
+	  break;
+	}
+      else if (code->op == EXEC_BLOCK
+	       && find_nested_loop_in_block (code))
+	{
+	  gfc_namespace *ns = code->ext.block.ns;
+
+	  /* Cut CODE free from its chain, leaving the ends dangling.  */
+	  *chainp = NULL;
+	  tail = code->next;
+	  code->next = NULL;
+
+	  innermost_loop
+	    = restructure_intervening_code (&(ns->code), outer_loop,
+					    count);
+
+	  /* At this point we have already pulled out the nested loop and
+	     pointed outer_loop at it, and moved the intervening code that
+	     was previously in the block into the body of innermost_loop.
+	     Now we want to move the BLOCK itself so it wraps the entire
+	     current body of innermost_loop.  */
+	  ns->code = innermost_loop->block->next;
+	  innermost_loop->block->next = code;
+	  break;
+	}
+    }
+
+  gcc_assert (innermost_loop);
+
+  /* Now we have split the intervening code into two parts:
+     head is the start of the part before the loop/block, terminating
+     at *chainp, and tail is the part after it.  Splice the two parts
+     around the existing body of the innermost loop.  */
+  if (head != code)
+    {
+      if (innermost_loop->block->next)
+	gfc_append_code (head, innermost_loop->block->next);
+      innermost_loop->block->next = head;
+    }
+  if (tail)
+    {
+      if (innermost_loop->block->next)
+	gfc_append_code (innermost_loop->block->next, tail);
+      else
+	innermost_loop->block->next = tail;
+    }
+
+  /* For loops, finally splice CODE into OUTER_LOOP.  We already handled
+     relinking EXEC_BLOCK above.  */
+  if ((code->op == EXEC_DO || loop_transform_p (code->op)) && outer_loop)
+    outer_loop->block->next = code;
+
+  return innermost_loop;
+}
 
 /* CODE is an OMP loop construct.  Return true if VAR matches an iteration
    variable outer to level DEPTH.  */
@@ -10556,29 +10949,36 @@ static void
 resolve_nested_loops (gfc_code *code, const char *name, gfc_code *do_code,
 		      int num_loops, bool is_simd, bool is_tile)
 {
+  bool errorp = false;
+  bool perfect_nesting_errorp = false;
+  bool is_nested_tile = false;
+  bool any_imperfect = false;
+
   for (int i = 1; i <= num_loops; i++)
     {
       gfc_symbol *dovar;
       gfc_symbol *start_var = NULL, *end_var = NULL;
-      gfc_code *c;
+      gfc_code *imperfect = NULL;
+      gfc_code *next;
 
+      /* Parse errors are not recoverable.  */
       if (do_code->op == EXEC_DO_WHILE)
 	{
 	  gfc_error ("%s cannot be a DO WHILE or DO without loop control "
 		     "at %L", name, &do_code->loc);
-	  break;
+	  return;
 	}
       if (do_code->op == EXEC_DO_CONCURRENT)
 	{
 	  gfc_error ("%s cannot be a DO CONCURRENT loop at %L", name,
 		     &do_code->loc);
-	  break;
+	  return;
 	}
       if (do_code->op != EXEC_DO)
 	{
 	  gfc_error ("%s must be DO loop at %L", name,
 		     &do_code->loc);
-	  break;
+	  return;
 	}
       dovar = do_code->ext.iterator->var->symtree->n.sym;
       if (!is_tile)
@@ -10587,11 +10987,17 @@ resolve_nested_loops (gfc_code *code, const char *name, gfc_code *do_code,
 	  gfc_omp_namelist *n;
 
 	  if (do_code->ext.iterator->var->ts.type != BT_INTEGER)
-	    gfc_error ("%s iteration variable must be of type integer at %L",
-		       name, &do_code->loc);
+	    {
+	      gfc_error ("%s iteration variable must be of type integer at %L",
+			 name, &do_code->loc);
+	      errorp = true;
+	    }
 	  if (dovar->attr.threadprivate)
-	    gfc_error ("%s iteration variable must not be THREADPRIVATE "
-		       "at %L", name, &do_code->loc);
+	    {
+	      gfc_error ("%s iteration variable must not be THREADPRIVATE "
+			 "at %L", name, &do_code->loc);
+	      errorp = true;
+	    }
 	  if (code->ext.omp_clauses)
 	    for (list = 0; list < OMP_LIST_NUM; list++)
 	      if (!is_simd || code->ext.omp_clauses->collapse > 1
@@ -10611,7 +11017,7 @@ resolve_nested_loops (gfc_code *code, const char *name, gfc_code *do_code,
 				   "other than PRIVATE, LASTPRIVATE, "
 				   "ALLOCATE or LINEAR at %L",
 				   name, &do_code->loc);
-		      break;
+		      errorp = true;
 		    }
 	}
       if (is_outer_iteration_variable (code, i, dovar))
@@ -10619,7 +11025,7 @@ resolve_nested_loops (gfc_code *code, const char *name, gfc_code *do_code,
 	  gfc_error ("%s iteration variable used in more than one loop at %L "
 		     "(depth %d)",
 		     name, &do_code->loc, i);
-	  break;
+	  errorp = true;
 	}
       else if (!bound_expr_is_canonical (code, i,
 					 do_code->ext.iterator->start,
@@ -10627,7 +11033,7 @@ resolve_nested_loops (gfc_code *code, const char *name, gfc_code *do_code,
 	{
 	  gfc_error ("%s loop start expression not in canonical form at %L",
 		     name, &do_code->loc);
-	  break;
+	  errorp = true;
 	}
       else if (!bound_expr_is_canonical (code, i,
 					 do_code->ext.iterator->end,
@@ -10635,53 +11041,125 @@ resolve_nested_loops (gfc_code *code, const char *name, gfc_code *do_code,
 	{
 	  gfc_error ("%s loop end expression not in canonical form at %L",
 		     name, &do_code->loc);
-	  break;
+	  errorp = true;
 	}
       else if (start_var && end_var && start_var != end_var)
 	{
 	  gfc_error ("%s loop bounds reference different "
 		     "iteration variables at %L", name, &do_code->loc);
-	  break;
+	  errorp = true;
 	}
       else if (!expr_is_invariant (code, i, do_code->ext.iterator->step))
 	{
 	  gfc_error ("%s loop increment not in canonical form at %L",
 		     name, &do_code->loc);
-	  break;
+	  errorp = true;
 	}
       if (start_var || end_var)
 	code->ext.omp_clauses->non_rectangular = 1;
 
-      for (c = do_code->next; c; c = c->next)
-	if (c->op != EXEC_NOP && c->op != EXEC_CONTINUE)
-	  {
-	    gfc_error ("%s loops not perfectly nested at %L",
-		       name, &c->loc);
-	    break;
-	  }
-      if (i == num_loops || c)
+      if (i == num_loops)
 	break;
-      do_code = do_code->block->next;
 
-      if (do_code)
-	do_code = resolve_nested_loop_transforms (do_code, name,
-						  num_loops - i,
-						  &code->loc);
-      if (!do_code
-	  || (do_code->op != EXEC_DO && do_code->op != EXEC_DO_WHILE))
+      next = scan_for_next_loop_in_chain (do_code->block->next, &imperfect);
+      if (!next)
 	{
+	  /* Parse error, can't recover from this.  */
 	  gfc_error ("not enough DO loops for %s at %L",
 		     name, &code->loc);
-	  break;
+	  return;
+	}
+
+      /* Only diagnose violation of imperfect nesting constraints once.  */
+      if (!perfect_nesting_errorp && imperfect)
+	{
+	  if (code->ext.omp_clauses->orderedc)
+	    {
+	      gfc_error ("%s inner loops must be perfectly nested with "
+			 "ORDERED clause at %L",
+			 name, &code->loc);
+	      perfect_nesting_errorp = true;
+	    }
+	  else if (code->ext.omp_clauses->lists[OMP_LIST_REDUCTION_INSCAN])
+	    {
+	      gfc_error ("%s inner loops must be perfectly nested with "
+			 "REDUCTION INSCAN clause at %L",
+			 name, &code->loc);
+	      perfect_nesting_errorp = true;
+	    }
+	  else if (is_tile)
+	    {
+	      gfc_error ("%s inner loops must be perfectly nested at %L",
+			 name, &code->loc);
+	      perfect_nesting_errorp = true;
+	    }
+	  else if (is_nested_tile)
+	    {
+	      gfc_error ("%s inner loops must be perfectly nested with "
+			 "nested !$OMP TILE at %L",
+			 name, &code->loc);
+	      perfect_nesting_errorp = true;
+	    }
+	  if (perfect_nesting_errorp)
+	    errorp = true;
+	}
+
+      /* Check constraints on intervening code, if we have some.  */
+      if (imperfect)
+	{
+	  any_imperfect = true;
+	  if (diagnose_intervening_code_errors (do_code->block->next,
+						name, next))
+	    errorp = true;
+	}
+
+      /* Check for presence of nested TILE directive, used for next level
+	 of the imperfect loop error checking above.  Then resolve all the
+	 transforms at this level.  */
+      if (!is_tile && !is_nested_tile && !perfect_nesting_errorp)
+	for (gfc_code *c = next; c && loop_transform_p (c->op); )
+	  {
+	    if (c->op == EXEC_OMP_TILE)
+	      {
+		is_nested_tile = true;
+		break;
+	      }
+	    if (c->block)
+	      c = c->block->next;
+	    else
+	      c = c->next;
+	  }
+      next = resolve_nested_loop_transforms (next, name, num_loops - i,
+					     &code->loc);
+      if (!next)
+	{
+	  gfc_error ("not enough DO loops for %s at %L",
+		     name, &code->loc);
+	  return;
 	}
+
+      do_code = next;
     }
+
+  /* Give up now if we found any constraint violations.  */
+  if (errorp)
+    return;
+
+  /* Only restructure intervening code if we found some.  Note that
+     restructure_intervening_code assumes CODE is a DO loop instead of a
+     top-level TILE directive, which should have been rejected already if
+     if contains intervening code.  */
+  if (is_tile)
+    gcc_assert (!any_imperfect);
+  if (any_imperfect)
+    restructure_intervening_code (&(code->block->next), code, num_loops);
 }
 
 static void
 resolve_omp_do (gfc_code *code)
 {
   gfc_code *do_code;
-  int collapse;
+  int count;
   const char *name;
   bool is_simd = false;
 
@@ -10787,15 +11265,15 @@ resolve_omp_do (gfc_code *code)
     resolve_omp_clauses (code, code->ext.omp_clauses, NULL);
 
   if (code->ext.omp_clauses->orderedc)
-    collapse = code->ext.omp_clauses->orderedc;
+    count = code->ext.omp_clauses->orderedc;
   else
     {
-      collapse = code->ext.omp_clauses->collapse;
-      if (collapse <= 0)
-	collapse = 1;
+      count = code->ext.omp_clauses->collapse;
+      if (count <= 0)
+	count = 1;
     }
 
-  do_code = resolve_nested_loop_transforms (code->block->next, name, collapse,
+  do_code = resolve_nested_loop_transforms (code->block->next, name, count,
 					    &code->loc);
 
   /* While the spec defines the loop nest depth independently of the COLLAPSE
@@ -10803,7 +11281,7 @@ resolve_omp_do (gfc_code *code)
      depth and treats any further inner loops as the final-loop-body.  So
      here we also check canonical loop nest form only for the number of
      outer loops specified by the COLLAPSE clause too.  */
-  resolve_nested_loops (code, name, do_code, collapse, is_simd, false);
+  resolve_nested_loops (code, name, do_code, count, is_simd, false);
 }
 
 static void
diff --git a/gcc/testsuite/ChangeLog.omp b/gcc/testsuite/ChangeLog.omp
index 24a8bc43b10..810f1e6c929 100644
--- a/gcc/testsuite/ChangeLog.omp
+++ b/gcc/testsuite/ChangeLog.omp
@@ -1,3 +1,16 @@
+2023-06-13  Sandra Loosemore  <sandra@codesourcery.com>
+
+	* gfortran.dg/gomp/collapse1.f90: Adjust expected errors.
+	* gfortran.dg/gomp/collapse2.f90: Likewise.
+	* gfortran.dg/gomp/imperfect1.f90: New.
+	* gfortran.dg/gomp/imperfect2.f90: New.
+	* gfortran.dg/gomp/imperfect3.f90: New.
+	* gfortran.dg/gomp/imperfect4.f90: New.
+	* gfortran.dg/gomp/imperfect5.f90: New.
+	* gfortran.dg/gomp/loop-transforms/tile-1.f90: Adjust expected errors.
+	* gfortran.dg/gomp/loop-transforms/tile-2.f90: Likewise.
+	* gfortran.dg/gomp/loop-transforms/tile-imperfect-nest.f90: Likewise.
+
 2023-06-13  Sandra Loosemore  <sandra@codesourcery.com>
 
 	* gfortran.dg/gomp/collapse1.f90: Adjust expected error message.
diff --git a/gcc/testsuite/gfortran.dg/gomp/collapse1.f90 b/gcc/testsuite/gfortran.dg/gomp/collapse1.f90
index d938e1b569d..485922569b3 100644
--- a/gcc/testsuite/gfortran.dg/gomp/collapse1.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/collapse1.f90
@@ -31,7 +31,7 @@ subroutine collapse1
     do i = 1, 3
       do j = 4, 6
       end do
-      k = 4  ! { dg-error "loops not perfectly nested" }
+      k = 4
     end do
   !$omp parallel do collapse(2)
     do i = 1, 3
diff --git a/gcc/testsuite/gfortran.dg/gomp/collapse2.f90 b/gcc/testsuite/gfortran.dg/gomp/collapse2.f90
index 0aa7d9391e5..60c1d7c0813 100644
--- a/gcc/testsuite/gfortran.dg/gomp/collapse2.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/collapse2.f90
@@ -6,24 +6,24 @@ program p
       do j = 1, 8
         do k = 1, 8
         end do
-        x = 5  ! { dg-error "loops not perfectly nested" }
+        x = 5
       end do
    end do
-   !$omp parallel do ordered(3)
+   !$omp parallel do ordered(3) ! { dg-error "inner loops must be perfectly nested with ORDERED clause" }
    do i = 1, 8
       do j = 1, 8
         do k = 1, 8
         end do
       end do
-      x = 5  ! { dg-error "loops not perfectly nested" }
+      x = 5
    end do
-   !$omp parallel do collapse(2)  ! { dg-error "not enough DO loops for" }
+   !$omp parallel do collapse(2)
    do i = 1, 8
       x = 5
       do j = 1, 8
       end do
    end do
-   !$omp parallel do ordered(2)  ! { dg-error "not enough DO loops for" }
+   !$omp parallel do ordered(2) ! { dg-error "inner loops must be perfectly nested with ORDERED clause" }
    do i = 1, 8
       x = 5
       do j = 1, 8
diff --git a/gcc/testsuite/gfortran.dg/gomp/imperfect1.f90 b/gcc/testsuite/gfortran.dg/gomp/imperfect1.f90
new file mode 100644
index 00000000000..4e750d9ad05
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/imperfect1.f90
@@ -0,0 +1,39 @@
+! This test case is expected to fail due to errors.
+
+subroutine f1 (depth, iter)
+  integer :: depth, iter
+end subroutine
+
+subroutine f2 (depth, iter)
+  integer :: depth, iter
+end subroutine
+
+subroutine s1 (a1, a2, a3)
+  integer :: a1, a2, a3
+  integer :: i, j, k
+
+  !$omp do collapse(3) 
+  do i = 1, a1
+    call f1 (1, i)
+    do j = 1, a2
+      call f1 (2, j)
+      if (i == 3) then
+        cycle  ! { dg-error "CYCLE statement" }
+      else
+        exit   ! { dg-error "EXIT statement" }
+      endif
+!$omp barrier  ! { dg-error "OpenMP directive in intervening code" }
+      do k = 1, a3
+        call f1 (3, k)
+        call f2 (3, k)
+      end do
+      call f2 (2, j)
+    end do
+    do k = 1, a3  ! { dg-error "loop in intervening code" }
+      call f1 (3, k)
+      call f2 (3, k)
+    end do
+    call f2 (1, i)
+  end do
+
+end subroutine
diff --git a/gcc/testsuite/gfortran.dg/gomp/imperfect2.f90 b/gcc/testsuite/gfortran.dg/gomp/imperfect2.f90
new file mode 100644
index 00000000000..d02191050d9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/imperfect2.f90
@@ -0,0 +1,56 @@
+! This test case is expected to fail due to errors.
+
+! Note that the calls to these functions in the test case don't make
+! any sense in terms of behavior, they're just there to test the error
+! behavior.
+
+module omp_lib
+ use iso_c_binding
+  interface
+     integer function omp_get_thread_num ()
+     end
+     subroutine omp_set_max_levels (i)
+       integer :: i
+     end
+  end interface
+end module
+
+program junk
+  use omp_lib
+  implicit none
+  
+contains
+	 
+subroutine f1 (depth, iter)
+  integer :: depth, iter
+end subroutine
+
+subroutine f2 (depth, iter)
+  integer :: depth, iter
+end subroutine
+
+subroutine s1 (a1, a2, a3)
+  integer :: a1, a2, a3
+  integer :: i, j, k
+
+  integer :: m
+
+  !$omp do collapse(3) 
+  do i = 1, a1
+    call f1 (1, i)
+    m = omp_get_thread_num ()  ! { dg-error "OpenMP API call in intervening code" }
+    do j = 1, a2 + omp_get_thread_num ()  ! This is OK
+      call f1 (2, j)
+      do k = 1, a3
+        call f1 (m, k)
+	call omp_set_max_active_levels (k)  ! This is OK too
+        call f2 (m, k)
+      end do
+      call f2 (2, j)
+    call omp_set_max_active_levels (i)  ! { dg-error "OpenMP API call in intervening code" }
+    end do
+    call f2 (1, i)
+  end do
+end subroutine
+
+end program
diff --git a/gcc/testsuite/gfortran.dg/gomp/imperfect3.f90 b/gcc/testsuite/gfortran.dg/gomp/imperfect3.f90
new file mode 100644
index 00000000000..2eccdfc8b58
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/imperfect3.f90
@@ -0,0 +1,29 @@
+! This test case is expected to fail due to errors.
+
+subroutine f1 (depth, iter)
+  integer :: depth, iter
+end subroutine
+
+subroutine f2 (depth, iter)
+  integer :: depth, iter
+end subroutine
+
+subroutine s1 (a1, a2, a3)
+  integer :: a1, a2, a3
+  integer :: i, j, k
+
+  !$omp do ordered(3)     ! { dg-error "inner loops must be perfectly nested" }
+  do i = 1, a1
+    call f1 (1, i)
+    do j = 1, a2
+      call f1 (2, j)
+      do k = 1, a3
+        call f1 (3, k)
+        call f2 (3, k)
+      end do
+      call f2 (2, j)
+    end do
+    call f2 (1, i)
+  end do
+
+end subroutine
diff --git a/gcc/testsuite/gfortran.dg/gomp/imperfect4.f90 b/gcc/testsuite/gfortran.dg/gomp/imperfect4.f90
new file mode 100644
index 00000000000..b7ccd8b6c53
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/imperfect4.f90
@@ -0,0 +1,36 @@
+! This test case is expected to fail due to errors.
+
+subroutine f1 (depth, iter)
+  integer :: depth, iter
+end subroutine
+
+subroutine f2 (depth, iter)
+  integer :: depth, iter
+end subroutine
+
+! Unlike the C/C++ front ends, the Fortran front end already has the whole
+! parse tree for the OMP DO construct before doing error checking on it.
+! It gives up immediately if there are not enough nested loops for the
+! specified COLLAPSE depth, without error-checking intervening code.
+
+subroutine s1 (a1, a2, a3)
+  integer :: a1, a2, a3
+  integer :: i, j, k
+
+  !$omp do collapse(4)     ! { dg-error "not enough DO loops" }
+  do i = 1, a1
+    call f1 (1, i)
+    do j = 1, a2
+      call f1 (2, j)
+      do k = 1, a3
+! This is not valid intervening code, but the above error takes precedence.
+!$omp barrier
+        call f1 (3, k)
+        call f2 (3, k)
+      end do
+      call f2 (2, j)
+    end do
+    call f2 (1, i)
+  end do
+
+end subroutine
diff --git a/gcc/testsuite/gfortran.dg/gomp/imperfect5.f90 b/gcc/testsuite/gfortran.dg/gomp/imperfect5.f90
new file mode 100644
index 00000000000..95cc7f144a2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/imperfect5.f90
@@ -0,0 +1,67 @@
+! This test case is expected to fail due to errors.
+
+subroutine f1 (depth, iter)
+  integer :: depth, iter
+end subroutine
+
+subroutine f2 (depth, iter)
+  integer :: depth, iter
+end subroutine
+
+function ijk (x, y, z)
+  integer :: ijk
+  integer :: x, y, z
+end function
+
+subroutine f3 (sum)
+  integer :: sum
+end subroutine  
+
+! This function isn't particularly meaningful, but it should compile without
+!  error.
+function s1 (a1, a2, a3)
+  integer :: s1
+  integer :: a1, a2, a3
+  integer :: i, j, k
+  integer :: r
+  
+  r = 0
+  !$omp simd collapse(3) reduction (inscan, +:r)
+  do i = 1, a1
+    do j = 1, a2
+      do k = 1, a3
+        r = r + ijk (i, j, k)
+!$omp scan exclusive (r)
+        call f3 (r)
+      end do
+    end do
+  end do
+
+  s1 = r
+end function
+
+! Adding intervening code should trigger an error.
+function s2 (a1, a2, a3)
+  integer :: s2
+  integer :: a1, a2, a3
+  integer :: i, j, k
+  integer :: r
+  
+  r = 0
+  !$omp simd collapse(3) reduction (inscan, +:r)     ! { dg-error "inner loops must be perfectly nested" }
+  do i = 1, a1
+    call f1 (1, i)
+    do j = 1, a2
+      call f1 (2, j)
+      do k = 1, a3
+        r = r + ijk (i, j, k)
+!$omp scan exclusive (r)
+        call f3 (r)
+      end do
+      call f2 (2, j)
+    end do
+    call f2 (1, i)
+  end do
+  
+  s2 = r
+end function
diff --git a/gcc/testsuite/gfortran.dg/gomp/loop-transforms/tile-1.f90 b/gcc/testsuite/gfortran.dg/gomp/loop-transforms/tile-1.f90
index 84ea93300fa..be3dd1e400c 100644
--- a/gcc/testsuite/gfortran.dg/gomp/loop-transforms/tile-1.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/loop-transforms/tile-1.f90
@@ -117,29 +117,29 @@ subroutine test
   end do
   !$end omp tile
 
-  !$omp tile sizes(1,2,1)
+  !$omp tile sizes(1,2,1) ! { dg-error {\!\$OMP TILE inner loops must be perfectly nested at \(1\)} }
   do i = 1,100
      do j = 1,100
         do k = 1,100
            call dummy(i)
         end do
      end do
-     call dummy(i) ! { dg-error {\!\$OMP TILE loops not perfectly nested at \(1\)} }
+     call dummy(i)
   end do
   !$end omp tile
 
-  !$omp tile sizes(1,2,1)
+  !$omp tile sizes(1,2,1) ! { dg-error {\!\$OMP TILE inner loops must be perfectly nested at \(1\)} }
   do i = 1,100
      do j = 1,100
         do k = 1,100
            call dummy(i)
         end do
-        call dummy(j) ! { dg-error {\!\$OMP TILE loops not perfectly nested at \(1\)} }
+        call dummy(j)
      end do
   end do
   !$end omp tile
 
-  !$omp tile sizes(1,2,1) ! { dg-error {not enough DO loops for \!\$OMP TILE at \(1\)} }
+  !$omp tile sizes(1,2,1) ! { dg-error {\!\$OMP TILE inner loops must be perfectly nested at \(1\)} }
   do i = 1,100
      call dummy(i)
      do j = 1,100
@@ -150,7 +150,7 @@ subroutine test
   end do
   !$end omp tile
 
-  !$omp tile sizes(1,2,1) ! { dg-error {not enough DO loops for \!\$OMP TILE at \(1\)} }
+  !$omp tile sizes(1,2,1) ! { dg-error {\!\$OMP TILE inner loops must be perfectly nested at \(1\)} }
   do i = 1,100
      do j = 1,100
         call dummy(j)
diff --git a/gcc/testsuite/gfortran.dg/gomp/loop-transforms/tile-2.f90 b/gcc/testsuite/gfortran.dg/gomp/loop-transforms/tile-2.f90
index f4c24f76eac..d14af08c27a 100644
--- a/gcc/testsuite/gfortran.dg/gomp/loop-transforms/tile-2.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/loop-transforms/tile-2.f90
@@ -64,7 +64,7 @@ subroutine test3
   implicit none
   integer :: i, j, k
 
-  !$omp taskloop collapse(3) ! { dg-error {not enough DO loops for \!\$OMP TASKLOOP at \(1\)} }
+  !$omp taskloop collapse(3)
   !$omp tile sizes (1,2) ! { dg-error {loop nest depth after \!\$OMP TILE at \(1\) is insufficient for outer \!\$OMP TASKLOOP} }
   !$omp tile sizes (1,2)
   do i = 1,100
diff --git a/gcc/testsuite/gfortran.dg/gomp/loop-transforms/tile-imperfect-nest.f90 b/gcc/testsuite/gfortran.dg/gomp/loop-transforms/tile-imperfect-nest.f90
index 3ec1671f01f..977a39af9da 100644
--- a/gcc/testsuite/gfortran.dg/gomp/loop-transforms/tile-imperfect-nest.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/loop-transforms/tile-imperfect-nest.f90
@@ -21,7 +21,7 @@ subroutine test0m
     integer :: i, j, k, inner
     !$omp parallel do collapse(2) private(inner)
     do i = 1,m
-       !$omp tile sizes (8, 1)
+       !$omp tile sizes (8, 1) ! { dg-error {\!\$OMP TILE inner loops must be perfectly nested at \(1\)} }
        do j = 1,n
           do k = 1, n
              if (k == 1) then
@@ -29,7 +29,7 @@ subroutine test0m
              endif
              inner = inner + a(k, i) * b(j, k)
           end do
-          c(j, i) = inner ! { dg-error {\!\$OMP TILE loops not perfectly nested at \(1\)} }
+          c(j, i) = inner
        end do
     end do
 end subroutine test0m
@@ -40,7 +40,7 @@ subroutine test1
     !$omp parallel do collapse(2) private(inner)
     !$omp tile sizes (8, 1)
     do i = 1,m
-       !$omp tile sizes (8, 1)
+       !$omp tile sizes (8, 1) ! { dg-error {\!\$OMP TILE inner loops must be perfectly nested at \(1\)} }
        do j = 1,n
           !$omp unroll partial(10)
           do k = 1, n
@@ -49,7 +49,7 @@ subroutine test1
              endif
              inner = inner + a(k, i) * b(j, k)
           end do
-          c(j, i) = inner ! { dg-error {\!\$OMP TILE loops not perfectly nested at \(1\)} "TODO Fix with upcoming imperfect loop nest handling" { xfail *-*-* } }
+          c(j, i) = inner
        end do
     end do
 end subroutine test1
@@ -61,7 +61,7 @@ subroutine test2
     !$omp parallel do collapse(2) private(inner)
     !$omp tile sizes (8, 1)
     do i = 1,m
-       !$omp tile sizes (8, 1)
+       !$omp tile sizes (8, 1) ! { dg-error {\!\$OMP TILE inner loops must be perfectly nested at \(1\)} }
        do j = 1,n
           do k = 1, n
              if (k == 1) then
@@ -69,7 +69,7 @@ subroutine test2
              endif
              inner = inner + a(k, i) * b(j, k)
           end do
-          c(j, i) = inner ! { dg-error {\!\$OMP TILE loops not perfectly nested at \(1\)} }
+          c(j, i) = inner
        end do
     end do
 end subroutine test2
@@ -79,7 +79,7 @@ subroutine test3
     integer :: i, j, k, inner
     !$omp parallel do collapse(2) private(inner)
     do i = 1,m
-       !$omp tile sizes (8, 1)
+       !$omp tile sizes (8, 1) ! { dg-error {\!\$OMP TILE inner loops must be perfectly nested at \(1\)} }
        do j = 1,n
           do k = 1, n
              if (k == 1) then
@@ -87,7 +87,7 @@ subroutine test3
              endif
              inner = inner + a(k, i) * b(j, k)
           end do
-          c(j, i) = inner ! { dg-error {\!\$OMP TILE loops not perfectly nested at \(1\)} }
+          c(j, i) = inner
        end do
     end do
 end subroutine test3
diff --git a/libgomp/ChangeLog.omp b/libgomp/ChangeLog.omp
index cd6dfa6af2d..f740f880934 100644
--- a/libgomp/ChangeLog.omp
+++ b/libgomp/ChangeLog.omp
@@ -1,3 +1,19 @@
+2023-06-13  Sandra Loosemore  <sandra@codesourcery.com>
+
+	* testsuite/libgomp.fortran/imperfect-destructor.f90: New.
+	* testsuite/libgomp.fortran/imperfect-transform-1.f90: New.
+	* testsuite/libgomp.fortran/imperfect-transform-2.f90: New.
+	* testsuite/libgomp.fortran/imperfect1.f90: New.
+	* testsuite/libgomp.fortran/imperfect2.f90: New.
+	* testsuite/libgomp.fortran/imperfect3.f90: New.
+	* testsuite/libgomp.fortran/imperfect4.f90: New.
+	* testsuite/libgomp.fortran/target-imperfect-transform-1.f90: New.
+	* testsuite/libgomp.fortran/target-imperfect-transform-2.f90: New.
+	* testsuite/libgomp.fortran/target-imperfect1.f90: New.
+	* testsuite/libgomp.fortran/target-imperfect2.f90: New.
+	* testsuite/libgomp.fortran/target-imperfect3.f90: New.
+	* testsuite/libgomp.fortran/target-imperfect4.f90: New.
+
 2023-06-13  Sandra Loosemore  <sandra@codesourcery.com>
 
 	* testsuite/libgomp.c-c++-common/imperfect-transform-1.c: New.
diff --git a/libgomp/testsuite/libgomp.fortran/imperfect-destructor.f90 b/libgomp/testsuite/libgomp.fortran/imperfect-destructor.f90
new file mode 100644
index 00000000000..664d27fe968
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/imperfect-destructor.f90
@@ -0,0 +1,142 @@
+! { dg-do run }
+
+! Like imperfect2.f90, but adds bindings to the blocks.
+
+module m
+  implicit none
+  type t
+      integer :: i
+    contains
+      final :: fini
+  end type t
+
+  integer :: ccount(3), dcount(3)
+
+  contains
+
+    subroutine init(x, n)
+      type(t) :: x
+      integer :: n
+      x%i = n
+      ccount(x%i) = ccount(x%i) + 1
+    end subroutine init
+
+    subroutine fini(x)
+      type(t) :: x
+      dcount(x%i) = dcount(x%i) + 1
+    end subroutine fini
+end module m
+
+program foo
+  use m
+
+  integer :: f1count(3), f2count(3), g1count(3), g2count(3)
+
+  f1count(1) = 0
+  f1count(2) = 0
+  f1count(3) = 0
+  f2count(1) = 0
+  f2count(2) = 0
+  f2count(3) = 0
+
+  g1count(1) = 0
+  g1count(2) = 0
+  g1count(3) = 0
+  g2count(1) = 0
+  g2count(2) = 0
+  g2count(3) = 0
+
+  call s1 (3, 4, 5)
+
+  ! All intervening code at the same depth must be executed the same
+  ! number of times.
+  if (f1count(1) /= f2count(1)) error stop 101
+  if (f1count(2) /= f2count(2)) error stop 102
+  if (f1count(3) /= f2count(3)) error stop 103
+  if (g1count(1) /= f1count(1)) error stop 104
+  if (g2count(1) /= f1count(1)) error stop 105
+  if (g1count(2) /= f1count(2)) error stop 106
+  if (g2count(2) /= f1count(2)) error stop 107
+  if (g1count(3) /= f1count(3)) error stop 108
+  if (g2count(3) /= f1count(3)) error stop 109
+
+  ! Intervening code must be executed at least as many times as the loop
+  ! that encloses it.
+  if (f1count(1) < 3) error stop 111
+  if (f1count(2) < 3 * 4) error stop 112
+
+  ! Intervening code must not be executed more times than the number
+  ! of logical iterations.
+  if (f1count(1) > 3 * 4 * 5) error stop 121
+  if (f1count(2) > 3 * 4 * 5) error stop 122
+
+  ! Check that the innermost loop body is executed exactly the number
+  ! of logical iterations expected.
+  if (f1count(3) /= 3 * 4 * 5) error stop 131
+
+  ! Check that constructors and destructors are called equal number of times.
+  if (ccount(1) /= dcount(1)) error stop 141
+  if (ccount(2) /= dcount(2)) error stop 142
+  if (ccount(3) /= dcount(3)) error stop 143
+
+contains
+
+subroutine f1 (depth, iter)
+  integer :: depth, iter
+  f1count(depth) = f1count(depth) + 1
+end subroutine
+
+subroutine f2 (depth, iter)
+  integer :: depth, iter
+  f2count(depth) = f2count(depth) + 1
+end subroutine
+
+subroutine g1 (depth, iter)
+  integer :: depth, iter
+  g1count(depth) = g1count(depth) + 1
+end subroutine
+
+subroutine g2 (depth, iter)
+  integer :: depth, iter
+  g2count(depth) = g2count(depth) + 1
+end subroutine
+
+subroutine s1 (a1, a2, a3)
+  integer :: a1, a2, a3
+  integer :: i, j, k
+
+  !$omp do collapse(3)
+  do i = 1, a1
+    call f1 (1, i)
+    block
+      type (t) :: local1
+      call init (local1, 1)
+      call g1 (local1%i, i)
+      do j = 1, a2
+        call f1 (2, j)
+        block
+	  type (t) :: local2
+	  call init (local2, 2)
+          call g1 (local2%i, j)
+          do k = 1, a3
+            call f1 (3, k)
+            block
+	      type (t) :: local3
+	      call init (local3, 3)
+              call g1 (local3%i, k)
+              call g2 (local3%i, k)
+            end block
+            call f2 (3, k)
+          end do
+          call g2 (local2%i, j)
+        end block
+        call f2 (2, j)
+      end do
+      call g2 (local1%i, i)
+    end block
+    call f2 (1, i)
+  end do
+
+end subroutine
+
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/imperfect-transform-1.f90 b/libgomp/testsuite/libgomp.fortran/imperfect-transform-1.f90
new file mode 100644
index 00000000000..aa956707414
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/imperfect-transform-1.f90
@@ -0,0 +1,70 @@
+! { dg-do run }
+
+! Like imperfect1.f90, but also includes loop transforms.
+
+program foo
+  integer, save :: f1count(3), f2count(3)
+
+  f1count(1) = 0
+  f1count(2) = 0
+  f1count(3) = 0
+  f2count(1) = 0
+  f2count(2) = 0
+  f2count(3) = 0
+
+  call s1 (3, 4, 5)
+
+  ! All intervening code at the same depth must be executed the same
+  ! number of times.
+  if (f1count(1) /= f2count(1)) error stop 101
+  if (f1count(2) /= f2count(2)) error stop 102
+  if (f1count(3) /= f2count(3)) error stop 103
+
+  ! Intervening code must be executed at least as many times as the loop
+  ! that encloses it.
+  if (f1count(1) < 3) error stop 111
+  if (f1count(2) < 3 * 4) error stop 112
+
+  ! Intervening code must not be executed more times than the number
+  ! of logical iterations.
+  if (f1count(1) > 3 * 4 * 5) error stop 121
+  if (f1count(2) > 3 * 4 * 5) error stop 122
+
+  ! Check that the innermost loop body is executed exactly the number
+  ! of logical iterations expected.
+  if (f1count(3) /= 3 * 4 * 5) error stop 131
+
+contains
+
+subroutine f1 (depth, iter)
+  integer :: depth, iter
+  f1count(depth) = f1count(depth) + 1
+end subroutine
+
+subroutine f2 (depth, iter)
+  integer :: depth, iter
+  f2count(depth) = f2count(depth) + 1
+end subroutine
+
+subroutine s1 (a1, a2, a3)
+  integer :: a1, a2, a3
+  integer :: i, j, k
+
+  !$omp do collapse(3)
+  do i = 1, a1
+    call f1 (1, i)
+    do j = 1, a2
+      call f1 (2, j)
+      !$omp unroll partial
+      do k = 1, a3
+        call f1 (3, k)
+        call f2 (3, k)
+      end do
+      call f2 (2, j)
+    end do
+    call f2 (1, i)
+  end do
+
+end subroutine
+
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/imperfect-transform-2.f90 b/libgomp/testsuite/libgomp.fortran/imperfect-transform-2.f90
new file mode 100644
index 00000000000..be199ab9218
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/imperfect-transform-2.f90
@@ -0,0 +1,70 @@
+! { dg-do run }
+
+! Like imperfect1.f90, but also includes loop transforms.
+
+program foo
+  integer, save :: f1count(3), f2count(3)
+
+  f1count(1) = 0
+  f1count(2) = 0
+  f1count(3) = 0
+  f2count(1) = 0
+  f2count(2) = 0
+  f2count(3) = 0
+
+  call s1 (3, 4, 5)
+
+  ! All intervening code at the same depth must be executed the same
+  ! number of times.
+  if (f1count(1) /= f2count(1)) error stop 101
+  if (f1count(2) /= f2count(2)) error stop 102
+  if (f1count(3) /= f2count(3)) error stop 103
+
+  ! Intervening code must be executed at least as many times as the loop
+  ! that encloses it.
+  if (f1count(1) < 3) error stop 111
+  if (f1count(2) < 3 * 4) error stop 112
+
+  ! Intervening code must not be executed more times than the number
+  ! of logical iterations.
+  if (f1count(1) > 3 * 4 * 5) error stop 121
+  if (f1count(2) > 3 * 4 * 5) error stop 122
+
+  ! Check that the innermost loop body is executed exactly the number
+  ! of logical iterations expected.
+  if (f1count(3) /= 3 * 4 * 5) error stop 131
+
+contains
+
+subroutine f1 (depth, iter)
+  integer :: depth, iter
+  f1count(depth) = f1count(depth) + 1
+end subroutine
+
+subroutine f2 (depth, iter)
+  integer :: depth, iter
+  f2count(depth) = f2count(depth) + 1
+end subroutine
+
+subroutine s1 (a1, a2, a3)
+  integer :: a1, a2, a3
+  integer :: i, j, k
+
+  !$omp do collapse(3)
+  do i = 1, a1
+    call f1 (1, i)
+    do j = 1, a2
+      call f1 (2, j)
+      !$omp tile sizes(5)
+      do k = 1, a3
+        call f1 (3, k)
+        call f2 (3, k)
+      end do
+      call f2 (2, j)
+    end do
+    call f2 (1, i)
+  end do
+
+end subroutine
+
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/imperfect1.f90 b/libgomp/testsuite/libgomp.fortran/imperfect1.f90
new file mode 100644
index 00000000000..8c483c2a4e5
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/imperfect1.f90
@@ -0,0 +1,67 @@
+! { dg-do run }
+
+program foo
+  integer, save :: f1count(3), f2count(3)
+
+  f1count(1) = 0
+  f1count(2) = 0
+  f1count(3) = 0
+  f2count(1) = 0
+  f2count(2) = 0
+  f2count(3) = 0
+
+  call s1 (3, 4, 5)
+
+  ! All intervening code at the same depth must be executed the same
+  ! number of times.
+  if (f1count(1) /= f2count(1)) error stop 101
+  if (f1count(2) /= f2count(2)) error stop 102
+  if (f1count(3) /= f2count(3)) error stop 103
+
+  ! Intervening code must be executed at least as many times as the loop
+  ! that encloses it.
+  if (f1count(1) < 3) error stop 111
+  if (f1count(2) < 3 * 4) error stop 112
+
+  ! Intervening code must not be executed more times than the number
+  ! of logical iterations.
+  if (f1count(1) > 3 * 4 * 5) error stop 121
+  if (f1count(2) > 3 * 4 * 5) error stop 122
+
+  ! Check that the innermost loop body is executed exactly the number
+  ! of logical iterations expected.
+  if (f1count(3) /= 3 * 4 * 5) error stop 131
+
+contains
+
+subroutine f1 (depth, iter)
+  integer :: depth, iter
+  f1count(depth) = f1count(depth) + 1
+end subroutine
+
+subroutine f2 (depth, iter)
+  integer :: depth, iter
+  f2count(depth) = f2count(depth) + 1
+end subroutine
+
+subroutine s1 (a1, a2, a3)
+  integer :: a1, a2, a3
+  integer :: i, j, k
+
+  !$omp do collapse(3)
+  do i = 1, a1
+    call f1 (1, i)
+    do j = 1, a2
+      call f1 (2, j)
+      do k = 1, a3
+        call f1 (3, k)
+        call f2 (3, k)
+      end do
+      call f2 (2, j)
+    end do
+    call f2 (1, i)
+  end do
+
+end subroutine
+
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/imperfect2.f90 b/libgomp/testsuite/libgomp.fortran/imperfect2.f90
new file mode 100644
index 00000000000..e42cb08031b
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/imperfect2.f90
@@ -0,0 +1,102 @@
+! { dg-do run }
+
+program foo
+  integer, save :: f1count(3), f2count(3), g1count(3), g2count(3)
+
+  f1count(1) = 0
+  f1count(2) = 0
+  f1count(3) = 0
+  f2count(1) = 0
+  f2count(2) = 0
+  f2count(3) = 0
+
+  g1count(1) = 0
+  g1count(2) = 0
+  g1count(3) = 0
+  g2count(1) = 0
+  g2count(2) = 0
+  g2count(3) = 0
+
+  call s1 (3, 4, 5)
+
+  ! All intervening code at the same depth must be executed the same
+  ! number of times.
+  if (f1count(1) /= f2count(1)) error stop 101
+  if (f1count(2) /= f2count(2)) error stop 102
+  if (f1count(3) /= f2count(3)) error stop 103
+  if (g1count(1) /= f1count(1)) error stop 104
+  if (g2count(1) /= f1count(1)) error stop 105
+  if (g1count(2) /= f1count(2)) error stop 106
+  if (g2count(2) /= f1count(2)) error stop 107
+  if (g1count(3) /= f1count(3)) error stop 108
+  if (g2count(3) /= f1count(3)) error stop 109
+
+  ! Intervening code must be executed at least as many times as the loop
+  ! that encloses it.
+  if (f1count(1) < 3) error stop 111
+  if (f1count(2) < 3 * 4) error stop 112
+
+  ! Intervening code must not be executed more times than the number
+  ! of logical iterations.
+  if (f1count(1) > 3 * 4 * 5) error stop 121
+  if (f1count(2) > 3 * 4 * 5) error stop 122
+
+  ! Check that the innermost loop body is executed exactly the number
+  ! of logical iterations expected.
+  if (f1count(3) /= 3 * 4 * 5) error stop 131
+
+contains
+
+subroutine f1 (depth, iter)
+  integer :: depth, iter
+  f1count(depth) = f1count(depth) + 1
+end subroutine
+
+subroutine f2 (depth, iter)
+  integer :: depth, iter
+  f2count(depth) = f2count(depth) + 1
+end subroutine
+
+subroutine g1 (depth, iter)
+  integer :: depth, iter
+  g1count(depth) = g1count(depth) + 1
+end subroutine
+
+subroutine g2 (depth, iter)
+  integer :: depth, iter
+  g2count(depth) = g2count(depth) + 1
+end subroutine
+
+subroutine s1 (a1, a2, a3)
+  integer :: a1, a2, a3
+  integer :: i, j, k
+
+  !$omp do collapse(3)
+  do i = 1, a1
+    call f1 (1, i)
+    block
+      call g1 (1, i)
+      do j = 1, a2
+        call f1 (2, j)
+        block
+          call g1 (2, j)
+          do k = 1, a3
+            call f1 (3, k)
+            block
+              call g1 (3, k)
+              call g2 (3, k)
+            end block
+            call f2 (3, k)
+          end do
+          call g2 (2, j)
+        end block
+        call f2 (2, j)
+      end do
+      call g2 (1, i)
+    end block
+    call f2 (1, i)
+  end do
+
+end subroutine
+
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/imperfect3.f90 b/libgomp/testsuite/libgomp.fortran/imperfect3.f90
new file mode 100644
index 00000000000..da094612332
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/imperfect3.f90
@@ -0,0 +1,110 @@
+! { dg-do run }
+
+! Like imperfect2.f90, but adds bindings to the blocks.
+
+program foo
+  integer, save :: f1count(3), f2count(3), g1count(3), g2count(3)
+
+  f1count(1) = 0
+  f1count(2) = 0
+  f1count(3) = 0
+  f2count(1) = 0
+  f2count(2) = 0
+  f2count(3) = 0
+
+  g1count(1) = 0
+  g1count(2) = 0
+  g1count(3) = 0
+  g2count(1) = 0
+  g2count(2) = 0
+  g2count(3) = 0
+
+  call s1 (3, 4, 5)
+
+  ! All intervening code at the same depth must be executed the same
+  ! number of times.
+  if (f1count(1) /= f2count(1)) error stop 101
+  if (f1count(2) /= f2count(2)) error stop 102
+  if (f1count(3) /= f2count(3)) error stop 103
+  if (g1count(1) /= f1count(1)) error stop 104
+  if (g2count(1) /= f1count(1)) error stop 105
+  if (g1count(2) /= f1count(2)) error stop 106
+  if (g2count(2) /= f1count(2)) error stop 107
+  if (g1count(3) /= f1count(3)) error stop 108
+  if (g2count(3) /= f1count(3)) error stop 109
+
+  ! Intervening code must be executed at least as many times as the loop
+  ! that encloses it.
+  if (f1count(1) < 3) error stop 111
+  if (f1count(2) < 3 * 4) error stop 112
+
+  ! Intervening code must not be executed more times than the number
+  ! of logical iterations.
+  if (f1count(1) > 3 * 4 * 5) error stop 121
+  if (f1count(2) > 3 * 4 * 5) error stop 122
+
+  ! Check that the innermost loop body is executed exactly the number
+  ! of logical iterations expected.
+  if (f1count(3) /= 3 * 4 * 5) error stop 131
+
+contains
+
+subroutine f1 (depth, iter)
+  integer :: depth, iter
+  f1count(depth) = f1count(depth) + 1
+end subroutine
+
+subroutine f2 (depth, iter)
+  integer :: depth, iter
+  f2count(depth) = f2count(depth) + 1
+end subroutine
+
+subroutine g1 (depth, iter)
+  integer :: depth, iter
+  g1count(depth) = g1count(depth) + 1
+end subroutine
+
+subroutine g2 (depth, iter)
+  integer :: depth, iter
+  g2count(depth) = g2count(depth) + 1
+end subroutine
+
+subroutine s1 (a1, a2, a3)
+  integer :: a1, a2, a3
+  integer :: i, j, k
+
+  !$omp do collapse(3)
+  do i = 1, a1
+    call f1 (1, i)
+    block
+      integer :: local1
+      local1 = 1
+      call g1 (local1, i)
+      do j = 1, a2
+        call f1 (2, j)
+        block
+	  integer :: local2
+	  local2 = 2
+          call g1 (local2, j)
+          do k = 1, a3
+            call f1 (3, k)
+            block
+	      integer :: local3
+	      local3 = 3
+              call g1 (local3, k)
+              call g2 (local3, k)
+            end block
+            call f2 (3, k)
+          end do
+          call g2 (local2, j)
+        end block
+        call f2 (2, j)
+      end do
+      call g2 (local1, i)
+    end block
+    call f2 (1, i)
+  end do
+
+end subroutine
+
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/imperfect4.f90 b/libgomp/testsuite/libgomp.fortran/imperfect4.f90
new file mode 100644
index 00000000000..1679c8c5b92
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/imperfect4.f90
@@ -0,0 +1,121 @@
+! { dg-do run }
+
+! Like imperfect2.f90, but includes blocks that are themselves wholly
+! intervening code and not containers for nested loops.
+
+program foo
+  integer, save :: f1count(3), f2count(3), g1count(3), g2count(3)
+
+  f1count(1) = 0
+  f1count(2) = 0
+  f1count(3) = 0
+  f2count(1) = 0
+  f2count(2) = 0
+  f2count(3) = 0
+
+  g1count(1) = 0
+  g1count(2) = 0
+  g1count(3) = 0
+  g2count(1) = 0
+  g2count(2) = 0
+  g2count(3) = 0
+
+  call s1 (3, 4, 5)
+
+  ! All intervening code at the same depth must be executed the same
+  ! number of times.
+  if (f1count(1) /= f2count(1)) error stop 101
+  if (f1count(2) /= f2count(2)) error stop 102
+  if (f1count(3) /= f2count(3)) error stop 103
+  if (g1count(1) /= f1count(1)) error stop 104
+  if (g2count(1) /= f1count(1)) error stop 105
+  if (g1count(2) /= f1count(2)) error stop 106
+  if (g2count(2) /= f1count(2)) error stop 107
+  if (g1count(3) /= f1count(3)) error stop 108
+  if (g2count(3) /= f1count(3)) error stop 109
+
+  ! Intervening code must be executed at least as many times as the loop
+  ! that encloses it.
+  if (f1count(1) < 3) error stop 111
+  if (f1count(2) < 3 * 4) error stop 112
+
+  ! Intervening code must not be executed more times than the number
+  ! of logical iterations.
+  if (f1count(1) > 3 * 4 * 5) error stop 121
+  if (f1count(2) > 3 * 4 * 5) error stop 122
+
+  ! Check that the innermost loop body is executed exactly the number
+  ! of logical iterations expected.
+  if (f1count(3) /= 3 * 4 * 5) error stop 131
+
+contains
+
+subroutine f1 (depth, iter)
+  integer :: depth, iter
+  f1count(depth) = f1count(depth) + 1
+end subroutine
+
+subroutine f2 (depth, iter)
+  integer :: depth, iter
+  f2count(depth) = f2count(depth) + 1
+end subroutine
+
+subroutine g1 (depth, iter)
+  integer :: depth, iter
+  g1count(depth) = g1count(depth) + 1
+end subroutine
+
+subroutine g2 (depth, iter)
+  integer :: depth, iter
+  g2count(depth) = g2count(depth) + 1
+end subroutine
+
+subroutine s1 (a1, a2, a3)
+  integer :: a1, a2, a3
+  integer :: i, j, k
+
+  !$omp do collapse(3)
+  do i = 1, a1
+    block
+      call f1 (1, i)
+    end block
+    block
+      block
+        call g1 (1, i)
+      end block
+      do j = 1, a2
+        block
+          call f1 (2, j)
+        end block
+        block
+          block
+            call g1 (2, j)
+          end block
+          do k = 1, a3
+            call f1 (3, k)
+            block
+              call g1 (3, k)
+              call g2 (3, k)
+            end block
+            call f2 (3, k)
+          end do
+          block
+            call g2 (2, j)
+          end block
+        end block
+        block
+          call f2 (2, j)
+        end block
+      end do
+      block
+        call g2 (1, i)
+      end block
+    end block
+    block
+      call f2 (1, i)
+    end block
+  end do
+
+end subroutine
+
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/target-imperfect-transform-1.f90 b/libgomp/testsuite/libgomp.fortran/target-imperfect-transform-1.f90
new file mode 100644
index 00000000000..34b6e075e05
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/target-imperfect-transform-1.f90
@@ -0,0 +1,73 @@
+! { dg-do run }
+
+! Like imperfect-transform.f90, but enables offloading.
+
+program foo
+  integer, save :: f1count(3), f2count(3)
+  !$omp declare target enter (f1count, f2count)
+
+  f1count(1) = 0
+  f1count(2) = 0
+  f1count(3) = 0
+  f2count(1) = 0
+  f2count(2) = 0
+  f2count(3) = 0
+
+  call s1 (3, 4, 5)
+
+  ! All intervening code at the same depth must be executed the same
+  ! number of times.
+  if (f1count(1) /= f2count(1)) error stop 101
+  if (f1count(2) /= f2count(2)) error stop 102
+  if (f1count(3) /= f2count(3)) error stop 103
+
+  ! Intervening code must be executed at least as many times as the loop
+  ! that encloses it.
+  if (f1count(1) < 3) error stop 111
+  if (f1count(2) < 3 * 4) error stop 112
+
+  ! Intervening code must not be executed more times than the number
+  ! of logical iterations.
+  if (f1count(1) > 3 * 4 * 5) error stop 121
+  if (f1count(2) > 3 * 4 * 5) error stop 122
+
+  ! Check that the innermost loop body is executed exactly the number
+  ! of logical iterations expected.
+  if (f1count(3) /= 3 * 4 * 5) error stop 131
+
+contains
+
+subroutine f1 (depth, iter)
+  integer :: depth, iter
+  !$omp atomic
+  f1count(depth) = f1count(depth) + 1
+end subroutine
+
+subroutine f2 (depth, iter)
+  integer :: depth, iter
+  !$omp atomic
+  f2count(depth) = f2count(depth) + 1
+end subroutine
+
+subroutine s1 (a1, a2, a3)
+  integer :: a1, a2, a3
+  integer :: i, j, k
+
+  !$omp target parallel do collapse(3) map(always, tofrom:f1count, f2count)
+  do i = 1, a1
+    call f1 (1, i)
+    do j = 1, a2
+      call f1 (2, j)
+      !$omp unroll partial
+      do k = 1, a3
+        call f1 (3, k)
+        call f2 (3, k)
+      end do
+      call f2 (2, j)
+    end do
+    call f2 (1, i)
+  end do
+
+end subroutine
+
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/target-imperfect-transform-2.f90 b/libgomp/testsuite/libgomp.fortran/target-imperfect-transform-2.f90
new file mode 100644
index 00000000000..188cca1e5b4
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/target-imperfect-transform-2.f90
@@ -0,0 +1,73 @@
+! { dg-do run }
+
+! Like imperfect-transform.f90, but enables offloading.
+
+program foo
+  integer, save :: f1count(3), f2count(3)
+  !$omp declare target enter (f1count, f2count)
+
+  f1count(1) = 0
+  f1count(2) = 0
+  f1count(3) = 0
+  f2count(1) = 0
+  f2count(2) = 0
+  f2count(3) = 0
+
+  call s1 (3, 4, 5)
+
+  ! All intervening code at the same depth must be executed the same
+  ! number of times.
+  if (f1count(1) /= f2count(1)) error stop 101
+  if (f1count(2) /= f2count(2)) error stop 102
+  if (f1count(3) /= f2count(3)) error stop 103
+
+  ! Intervening code must be executed at least as many times as the loop
+  ! that encloses it.
+  if (f1count(1) < 3) error stop 111
+  if (f1count(2) < 3 * 4) error stop 112
+
+  ! Intervening code must not be executed more times than the number
+  ! of logical iterations.
+  if (f1count(1) > 3 * 4 * 5) error stop 121
+  if (f1count(2) > 3 * 4 * 5) error stop 122
+
+  ! Check that the innermost loop body is executed exactly the number
+  ! of logical iterations expected.
+  if (f1count(3) /= 3 * 4 * 5) error stop 131
+
+contains
+
+subroutine f1 (depth, iter)
+  integer :: depth, iter
+  !$omp atomic
+  f1count(depth) = f1count(depth) + 1
+end subroutine
+
+subroutine f2 (depth, iter)
+  integer :: depth, iter
+  !$omp atomic
+  f2count(depth) = f2count(depth) + 1
+end subroutine
+
+subroutine s1 (a1, a2, a3)
+  integer :: a1, a2, a3
+  integer :: i, j, k
+
+  !$omp target parallel do collapse(3) map(always, tofrom:f1count, f2count)
+  do i = 1, a1
+    call f1 (1, i)
+    do j = 1, a2
+      call f1 (2, j)
+      !$omp tile sizes(5)
+      do k = 1, a3
+        call f1 (3, k)
+        call f2 (3, k)
+      end do
+      call f2 (2, j)
+    end do
+    call f2 (1, i)
+  end do
+
+end subroutine
+
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/target-imperfect1.f90 b/libgomp/testsuite/libgomp.fortran/target-imperfect1.f90
new file mode 100644
index 00000000000..608eee7e424
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/target-imperfect1.f90
@@ -0,0 +1,72 @@
+! { dg-do run }
+
+! Like imperfect1.f90, but enables offloading.
+
+program foo
+  integer, save :: f1count(3), f2count(3)
+  !$omp declare target enter (f1count, f2count)
+
+  f1count(1) = 0
+  f1count(2) = 0
+  f1count(3) = 0
+  f2count(1) = 0
+  f2count(2) = 0
+  f2count(3) = 0
+
+  call s1 (3, 4, 5)
+
+  ! All intervening code at the same depth must be executed the same
+  ! number of times.
+  if (f1count(1) /= f2count(1)) error stop 101
+  if (f1count(2) /= f2count(2)) error stop 102
+  if (f1count(3) /= f2count(3)) error stop 103
+
+  ! Intervening code must be executed at least as many times as the loop
+  ! that encloses it.
+  if (f1count(1) < 3) error stop 111
+  if (f1count(2) < 3 * 4) error stop 112
+
+  ! Intervening code must not be executed more times than the number
+  ! of logical iterations.
+  if (f1count(1) > 3 * 4 * 5) error stop 121
+  if (f1count(2) > 3 * 4 * 5) error stop 122
+
+  ! Check that the innermost loop body is executed exactly the number
+  ! of logical iterations expected.
+  if (f1count(3) /= 3 * 4 * 5) error stop 131
+
+contains
+
+subroutine f1 (depth, iter)
+  integer :: depth, iter
+  !$omp atomic
+  f1count(depth) = f1count(depth) + 1
+end subroutine
+
+subroutine f2 (depth, iter)
+  integer :: depth, iter
+  !$omp atomic
+  f2count(depth) = f2count(depth) + 1
+end subroutine
+
+subroutine s1 (a1, a2, a3)
+  integer :: a1, a2, a3
+  integer :: i, j, k
+
+  !$omp target parallel do collapse(3) map(always, tofrom:f1count, f2count)
+  do i = 1, a1
+    call f1 (1, i)
+    do j = 1, a2
+      call f1 (2, j)
+      do k = 1, a3
+        call f1 (3, k)
+        call f2 (3, k)
+      end do
+      call f2 (2, j)
+    end do
+    call f2 (1, i)
+  end do
+
+end subroutine
+
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/target-imperfect2.f90 b/libgomp/testsuite/libgomp.fortran/target-imperfect2.f90
new file mode 100644
index 00000000000..982661c278a
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/target-imperfect2.f90
@@ -0,0 +1,110 @@
+! { dg-do run }
+
+! Like imperfect2.f90, but enables offloading.
+
+program foo
+  integer, save :: f1count(3), f2count(3), g1count(3), g2count(3)
+  !$omp declare target enter (f1count, f2count)
+  !$omp declare target enter (g1count, g2count)
+
+  f1count(1) = 0
+  f1count(2) = 0
+  f1count(3) = 0
+  f2count(1) = 0
+  f2count(2) = 0
+  f2count(3) = 0
+
+  g1count(1) = 0
+  g1count(2) = 0
+  g1count(3) = 0
+  g2count(1) = 0
+  g2count(2) = 0
+  g2count(3) = 0
+
+  call s1 (3, 4, 5)
+
+  ! All intervening code at the same depth must be executed the same
+  ! number of times.
+  if (f1count(1) /= f2count(1)) error stop 101
+  if (f1count(2) /= f2count(2)) error stop 102
+  if (f1count(3) /= f2count(3)) error stop 103
+  if (g1count(1) /= f1count(1)) error stop 104
+  if (g2count(1) /= f1count(1)) error stop 105
+  if (g1count(2) /= f1count(2)) error stop 106
+  if (g2count(2) /= f1count(2)) error stop 107
+  if (g1count(3) /= f1count(3)) error stop 108
+  if (g2count(3) /= f1count(3)) error stop 109
+
+  ! Intervening code must be executed at least as many times as the loop
+  ! that encloses it.
+  if (f1count(1) < 3) error stop 111
+  if (f1count(2) < 3 * 4) error stop 112
+
+  ! Intervening code must not be executed more times than the number
+  ! of logical iterations.
+  if (f1count(1) > 3 * 4 * 5) error stop 121
+  if (f1count(2) > 3 * 4 * 5) error stop 122
+
+  ! Check that the innermost loop body is executed exactly the number
+  ! of logical iterations expected.
+  if (f1count(3) /= 3 * 4 * 5) error stop 131
+
+contains
+
+subroutine f1 (depth, iter)
+  integer :: depth, iter
+  !$omp atomic
+  f1count(depth) = f1count(depth) + 1
+end subroutine
+
+subroutine f2 (depth, iter)
+  integer :: depth, iter
+  !$omp atomic
+  f2count(depth) = f2count(depth) + 1
+end subroutine
+
+subroutine g1 (depth, iter)
+  integer :: depth, iter
+  !$omp atomic
+  g1count(depth) = g1count(depth) + 1
+end subroutine
+
+subroutine g2 (depth, iter)
+  integer :: depth, iter
+  !$omp atomic
+  g2count(depth) = g2count(depth) + 1
+end subroutine
+
+subroutine s1 (a1, a2, a3)
+  integer :: a1, a2, a3
+  integer :: i, j, k
+
+  !$omp target parallel do collapse(3) map(always, tofrom:f1count, f2count, g1count, g2count)
+  do i = 1, a1
+    call f1 (1, i)
+    block
+      call g1 (1, i)
+      do j = 1, a2
+        call f1 (2, j)
+        block
+          call g1 (2, j)
+          do k = 1, a3
+            call f1 (3, k)
+            block
+              call g1 (3, k)
+              call g2 (3, k)
+            end block
+            call f2 (3, k)
+          end do
+          call g2 (2, j)
+        end block
+        call f2 (2, j)
+      end do
+      call g2 (1, i)
+    end block
+    call f2 (1, i)
+  end do
+
+end subroutine
+
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/target-imperfect3.f90 b/libgomp/testsuite/libgomp.fortran/target-imperfect3.f90
new file mode 100644
index 00000000000..6f4f92d6f3f
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/target-imperfect3.f90
@@ -0,0 +1,116 @@
+! { dg-do run }
+
+! Like imperfect3.f90, but enables offloading.
+
+program foo
+  integer, save :: f1count(3), f2count(3), g1count(3), g2count(3)
+  !$omp declare target enter (f1count, f2count)
+  !$omp declare target enter (g1count, g2count)
+
+  f1count(1) = 0
+  f1count(2) = 0
+  f1count(3) = 0
+  f2count(1) = 0
+  f2count(2) = 0
+  f2count(3) = 0
+
+  g1count(1) = 0
+  g1count(2) = 0
+  g1count(3) = 0
+  g2count(1) = 0
+  g2count(2) = 0
+  g2count(3) = 0
+
+  call s1 (3, 4, 5)
+
+  ! All intervening code at the same depth must be executed the same
+  ! number of times.
+  if (f1count(1) /= f2count(1)) error stop 101
+  if (f1count(2) /= f2count(2)) error stop 102
+  if (f1count(3) /= f2count(3)) error stop 103
+  if (g1count(1) /= f1count(1)) error stop 104
+  if (g2count(1) /= f1count(1)) error stop 105
+  if (g1count(2) /= f1count(2)) error stop 106
+  if (g2count(2) /= f1count(2)) error stop 107
+  if (g1count(3) /= f1count(3)) error stop 108
+  if (g2count(3) /= f1count(3)) error stop 109
+
+  ! Intervening code must be executed at least as many times as the loop
+  ! that encloses it.
+  if (f1count(1) < 3) error stop 111
+  if (f1count(2) < 3 * 4) error stop 112
+
+  ! Intervening code must not be executed more times than the number
+  ! of logical iterations.
+  if (f1count(1) > 3 * 4 * 5) error stop 121
+  if (f1count(2) > 3 * 4 * 5) error stop 122
+
+  ! Check that the innermost loop body is executed exactly the number
+  ! of logical iterations expected.
+  if (f1count(3) /= 3 * 4 * 5) error stop 131
+
+contains
+
+subroutine f1 (depth, iter)
+  integer :: depth, iter
+  !$omp atomic
+  f1count(depth) = f1count(depth) + 1
+end subroutine
+
+subroutine f2 (depth, iter)
+  integer :: depth, iter
+  !$omp atomic
+  f2count(depth) = f2count(depth) + 1
+end subroutine
+
+subroutine g1 (depth, iter)
+  integer :: depth, iter
+  !$omp atomic
+  g1count(depth) = g1count(depth) + 1
+end subroutine
+
+subroutine g2 (depth, iter)
+  integer :: depth, iter
+  !$omp atomic
+  g2count(depth) = g2count(depth) + 1
+end subroutine
+
+subroutine s1 (a1, a2, a3)
+  integer :: a1, a2, a3
+  integer :: i, j, k
+
+  !$omp target parallel do collapse(3) map(always, tofrom:f1count, f2count, g1count, g2count)
+  do i = 1, a1
+    call f1 (1, i)
+    block
+      integer :: local1
+      local1 = 1
+      call g1 (local1, i)
+      do j = 1, a2
+        call f1 (2, j)
+        block
+	  integer :: local2
+	  local2 = 2
+          call g1 (local2, j)
+          do k = 1, a3
+            call f1 (3, k)
+            block
+	      integer :: local3
+	      local3 = 3
+              call g1 (local3, k)
+              call g2 (local3, k)
+            end block
+            call f2 (3, k)
+          end do
+          call g2 (local2, j)
+        end block
+        call f2 (2, j)
+      end do
+      call g2 (local1, i)
+    end block
+    call f2 (1, i)
+  end do
+
+end subroutine
+
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/target-imperfect4.f90 b/libgomp/testsuite/libgomp.fortran/target-imperfect4.f90
new file mode 100644
index 00000000000..59ec0e92b05
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/target-imperfect4.f90
@@ -0,0 +1,126 @@
+! { dg-do run }
+
+! Like imperfect4.f90, but enables offloading.
+
+program foo
+  integer, save :: f1count(3), f2count(3), g1count(3), g2count(3)
+  !$omp declare target enter (f1count, f2count)
+  !$omp declare target enter (g1count, g2count)
+
+  f1count(1) = 0
+  f1count(2) = 0
+  f1count(3) = 0
+  f2count(1) = 0
+  f2count(2) = 0
+  f2count(3) = 0
+
+  g1count(1) = 0
+  g1count(2) = 0
+  g1count(3) = 0
+  g2count(1) = 0
+  g2count(2) = 0
+  g2count(3) = 0
+
+  call s1 (3, 4, 5)
+
+  ! All intervening code at the same depth must be executed the same
+  ! number of times.
+  if (f1count(1) /= f2count(1)) error stop 101
+  if (f1count(2) /= f2count(2)) error stop 102
+  if (f1count(3) /= f2count(3)) error stop 103
+  if (g1count(1) /= f1count(1)) error stop 104
+  if (g2count(1) /= f1count(1)) error stop 105
+  if (g1count(2) /= f1count(2)) error stop 106
+  if (g2count(2) /= f1count(2)) error stop 107
+  if (g1count(3) /= f1count(3)) error stop 108
+  if (g2count(3) /= f1count(3)) error stop 109
+
+  ! Intervening code must be executed at least as many times as the loop
+  ! that encloses it.
+  if (f1count(1) < 3) error stop 111
+  if (f1count(2) < 3 * 4) error stop 112
+
+  ! Intervening code must not be executed more times than the number
+  ! of logical iterations.
+  if (f1count(1) > 3 * 4 * 5) error stop 121
+  if (f1count(2) > 3 * 4 * 5) error stop 122
+
+  ! Check that the innermost loop body is executed exactly the number
+  ! of logical iterations expected.
+  if (f1count(3) /= 3 * 4 * 5) error stop 131
+
+contains
+
+subroutine f1 (depth, iter)
+  integer :: depth, iter
+  !$omp atomic
+  f1count(depth) = f1count(depth) + 1
+end subroutine
+
+subroutine f2 (depth, iter)
+  integer :: depth, iter
+  !$omp atomic
+  f2count(depth) = f2count(depth) + 1
+end subroutine
+
+subroutine g1 (depth, iter)
+  integer :: depth, iter
+  !$omp atomic
+  g1count(depth) = g1count(depth) + 1
+end subroutine
+
+subroutine g2 (depth, iter)
+  integer :: depth, iter
+  !$omp atomic
+  g2count(depth) = g2count(depth) + 1
+end subroutine
+
+subroutine s1 (a1, a2, a3)
+  integer :: a1, a2, a3
+  integer :: i, j, k
+
+  !$omp target parallel do collapse(3) map(always, tofrom:f1count, f2count, g1count, g2count)
+  do i = 1, a1
+    block
+      call f1 (1, i)
+    end block
+    block
+      block
+        call g1 (1, i)
+      end block
+      do j = 1, a2
+        block
+          call f1 (2, j)
+        end block
+        block
+          block
+            call g1 (2, j)
+          end block
+          do k = 1, a3
+            call f1 (3, k)
+            block
+              call g1 (3, k)
+              call g2 (3, k)
+            end block
+            call f2 (3, k)
+          end do
+          block
+            call g2 (2, j)
+          end block
+        end block
+        block
+          call f2 (2, j)
+        end block
+      end do
+      block
+        call g2 (1, i)
+      end block
+    end block
+    block
+      call f2 (1, i)
+    end block
+  end do
+
+end subroutine
+
+end program
