Fortran/OpenMP: Support most of 5.1 atomic extensions

Implements moste of OpenMP 5.1 atomic extensions,
except that 'compare' is parsed but rejected during
resolution. (As the trans-openmp.c handling is missing.)

gcc/fortran/ChangeLog:

	* dump-parse-tree.c (show_omp_clauses): Handle
	weak/compare/fail clause.
	* gfortran.h (gfc_omp_clauses): Add weak, compare, fail.
	* openmp.c (enum omp_mask1, gfc_match_omp_clauses,
	OMP_ATOMIC_CLAUSES): Update for new clauses.
	(gfc_match_omp_atomic): Update for 5.1 atomic changes.
	(is_conversion): Support widening in one go.
	(is_scalar_intrinsic_expr): New.
	(resolve_omp_atomic): Update for 5.1 atomic changes.
	* parse.c (parse_omp_oacc_atomic): Update for compare.
	* resolve.c (gfc_resolve_blocks): Update asserts.
	* trans-openmp.c (gfc_trans_omp_atomic): Handle new clauses.

gcc/testsuite/ChangeLog:

	* gfortran.dg/gomp/atomic-2.f90: Move now supported code to ...
	* gfortran.dg/gomp/atomic.f90: here.
	* gfortran.dg/gomp/atomic-10.f90: New test.
	* gfortran.dg/gomp/atomic-12.f90: New test.
	* gfortran.dg/gomp/atomic-15.f90: New test.
	* gfortran.dg/gomp/atomic-16.f90: New test.
	* gfortran.dg/gomp/atomic-17.f90: New test.
	* gfortran.dg/gomp/atomic-18.f90: New test.
	* gfortran.dg/gomp/atomic-19.f90: New test.
	* gfortran.dg/gomp/atomic-20.f90: New test.
	* gfortran.dg/gomp/atomic-22.f90: New test.
	* gfortran.dg/gomp/atomic-24.f90: New test.
	* gfortran.dg/gomp/atomic-25.f90: New test.
	* gfortran.dg/gomp/atomic-26.f90: New test.

libgomp/ChangeLog

	* libgomp.texi (OpenMP 5.1): Update status.

 gcc/fortran/dump-parse-tree.c                |  20 +
 gcc/fortran/gfortran.h                       |   3 +-
 gcc/fortran/intrinsic.c                      |   2 +-
 gcc/fortran/openmp.c                         | 584 +++++++++++++++++----------
 gcc/fortran/parse.c                          |  19 +-
 gcc/fortran/resolve.c                        |   9 +-
 gcc/fortran/trans-openmp.c                   |  15 +-
 gcc/testsuite/gfortran.dg/gomp/atomic-10.f90 |  32 ++
 gcc/testsuite/gfortran.dg/gomp/atomic-12.f90 | 364 +++++++++++++++++
 gcc/testsuite/gfortran.dg/gomp/atomic-15.f90 |  44 ++
 gcc/testsuite/gfortran.dg/gomp/atomic-16.f90 |  36 ++
 gcc/testsuite/gfortran.dg/gomp/atomic-17.f90 |  41 ++
 gcc/testsuite/gfortran.dg/gomp/atomic-18.f90 |  27 ++
 gcc/testsuite/gfortran.dg/gomp/atomic-19.f90 |  39 ++
 gcc/testsuite/gfortran.dg/gomp/atomic-2.f90  |  42 +-
 gcc/testsuite/gfortran.dg/gomp/atomic-20.f90 |  39 ++
 gcc/testsuite/gfortran.dg/gomp/atomic-22.f90 |  24 ++
 gcc/testsuite/gfortran.dg/gomp/atomic-24.f90 |  13 +
 gcc/testsuite/gfortran.dg/gomp/atomic-25.f90 |  53 +++
 gcc/testsuite/gfortran.dg/gomp/atomic-26.f90 |  75 ++++
 gcc/testsuite/gfortran.dg/gomp/atomic.f90    |  40 +-
 gcc/testsuite/gfortran.dg/gomp/atomic2.f90   |   0
 22 files changed, 1256 insertions(+), 265 deletions(-)

diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index 04660d5074a..34b332751d8 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -1810,6 +1810,10 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses)
 	}
       fputc (')', dumpfile);
     }
+  if (omp_clauses->weak)
+    fputs (" WEAK", dumpfile);
+  if (omp_clauses->compare)
+    fputs (" COMPARE", dumpfile);
   if (omp_clauses->nogroup)
     fputs (" NOGROUP", dumpfile);
   if (omp_clauses->simd)
@@ -1926,6 +1930,22 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses)
       fputc (' ', dumpfile);
       fputs (memorder, dumpfile);
     }
+  if (omp_clauses->fail != OMP_MEMORDER_UNSET)
+    {
+      const char *memorder;
+      switch (omp_clauses->fail)
+	{
+	case OMP_MEMORDER_ACQ_REL: memorder = "ACQ_REL"; break;
+	case OMP_MEMORDER_ACQUIRE: memorder = "AQUIRE"; break;
+	case OMP_MEMORDER_RELAXED: memorder = "RELAXED"; break;
+	case OMP_MEMORDER_RELEASE: memorder = "RELEASE"; break;
+	case OMP_MEMORDER_SEQ_CST: memorder = "SEQ_CST"; break;
+	default: gcc_unreachable ();
+	}
+      fputs (" FAIL(", dumpfile);
+      fputs (memorder, dumpfile);
+      putc (')', dumpfile);
+    }
   if (omp_clauses->at != OMP_AT_UNSET)
     {
       if (omp_clauses->at != OMP_AT_COMPILATION)
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 1ad2f0df702..54bdd5ab2e5 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1526,10 +1526,11 @@ typedef struct gfc_omp_clauses
   unsigned sched_simd:1, sched_monotonic:1, sched_nonmonotonic:1;
   unsigned simd:1, threads:1, depend_source:1, destroy:1, order_concurrent:1;
   unsigned order_unconstrained:1, order_reproducible:1, capture:1;
-  unsigned grainsize_strict:1, num_tasks_strict:1;
+  unsigned grainsize_strict:1, num_tasks_strict:1, compare:1, weak:1;
   ENUM_BITFIELD (gfc_omp_sched_kind) sched_kind:3;
   ENUM_BITFIELD (gfc_omp_device_type) device_type:2;
   ENUM_BITFIELD (gfc_omp_memorder) memorder:3;
+  ENUM_BITFIELD (gfc_omp_memorder) fail:3;
   ENUM_BITFIELD (gfc_omp_cancel_kind) cancel:3;
   ENUM_BITFIELD (gfc_omp_proc_bind_kind) proc_bind:3;
   ENUM_BITFIELD (gfc_omp_depend_op) depobj_update:3;
diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index 2d7d2461fd0..0f6ed7aeb75 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -2029,7 +2029,7 @@ add_functions (void)
 
   add_sym_1 ("get_team", GFC_ISYM_GET_TEAM, CLASS_TRANSFORMATIONAL,
 	     ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2018,
-	     gfc_check_get_team, NULL, gfc_resolve_get_team,
+	     gfc_check_get_team, gfc_simplify_get_team, gfc_resolve_get_team,
 	     level, BT_INTEGER, di, OPTIONAL);
 
   add_sym_0 ("getuid", GFC_ISYM_GETUID, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 2893ab2befb..af985b92ef5 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -917,6 +917,9 @@ enum omp_mask1
   OMP_CLAUSE_AT,  /* OpenMP 5.1.  */
   OMP_CLAUSE_MESSAGE,  /* OpenMP 5.1.  */
   OMP_CLAUSE_SEVERITY,  /* OpenMP 5.1.  */
+  OMP_CLAUSE_COMPARE,  /* OpenMP 5.1.  */
+  OMP_CLAUSE_FAIL,  /* OpenMP 5.1.  */
+  OMP_CLAUSE_WEAK,  /* OpenMP 5.1.  */
   OMP_CLAUSE_NOWAIT,
   /* This must come last.  */
   OMP_MASK1_LAST
@@ -1449,8 +1452,9 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
   gcc_checking_assert (OMP_MASK1_LAST <= 64 && OMP_MASK2_LAST <= 64);
   *cp = NULL;
   while (1)
-    {
-      if ((first || gfc_match_char (',') != MATCH_YES)
+    { 
+      match m = MATCH_NO;
+      if ((first || (m = gfc_match_char (',')) != MATCH_YES)
 	  && (needs_space && gfc_match_space () != MATCH_YES))
 	break;
       needs_space = false;
@@ -1460,7 +1464,11 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
       gfc_omp_namelist **head;
       old_loc = gfc_current_locus;
       char pc = gfc_peek_ascii_char ();
-      match m;
+      if (pc == '\n' && m == MATCH_YES)
+	{
+	  gfc_error ("Clause expected at %C after tailing comma");
+	  goto error;
+	}
       switch (pc)
 	{
 	case 'a':
@@ -1654,6 +1662,16 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 		continue;
 	      }
 	    }
+	  if ((mask & OMP_CLAUSE_COMPARE)
+	      && (m = gfc_match_dupl_check (!c->compare, "compare"))
+		 != MATCH_NO)
+	    {
+	      if (m == MATCH_ERROR)
+		goto error;
+	      c->compare = true;
+	      needs_space = true;
+	      continue;
+	    }
 	  if ((mask & OMP_CLAUSE_COPY)
 	      && gfc_match ("copy ( ") == MATCH_YES
 	      && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
@@ -2009,6 +2027,27 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 	    }
 	  break;
 	case 'f':
+	  if ((mask & OMP_CLAUSE_FAIL)
+	      && (m = gfc_match_dupl_check (c->fail == OMP_MEMORDER_UNSET,
+					    "fail", true)) != MATCH_NO)
+	    {
+	      if (m == MATCH_ERROR)
+		goto error;
+	      if (gfc_match ("seq_cst") == MATCH_YES)
+		c->fail = OMP_MEMORDER_SEQ_CST;
+	      else if (gfc_match ("acquire") == MATCH_YES)
+		c->fail = OMP_MEMORDER_ACQUIRE;
+	      else if (gfc_match ("relaxed") == MATCH_YES)
+		c->fail = OMP_MEMORDER_RELAXED;
+	      else
+		{
+		  gfc_error ("Expected SEQ_CST, ACQUIRE or RELAXED at %C");
+		  break;
+		}
+	      if (gfc_match (" )") != MATCH_YES)
+		goto error;
+	      continue;
+	    }
 	  if ((mask & OMP_CLAUSE_FILTER)
 	      && (m = gfc_match_dupl_check (!c->filter, "filter", true,
 					    &c->filter)) != MATCH_NO)
@@ -2903,6 +2942,16 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 		}
 	      continue;
 	    }
+	  if ((mask & OMP_CLAUSE_WEAK)
+	      && (m = gfc_match_dupl_check (!c->weak, "weak"))
+		 != MATCH_NO)
+	    {
+	      if (m == MATCH_ERROR)
+		goto error;
+	      c->weak = true;
+	      needs_space = true;
+	      continue;
+	    }
 	  if ((mask & OMP_CLAUSE_WORKER)
 	      && (m = gfc_match_dupl_check (!c->worker, "worker")) != MATCH_NO)
 	    {
@@ -3592,7 +3641,8 @@ cleanup:
   (omp_mask (OMP_CLAUSE_TO) | OMP_CLAUSE_LINK | OMP_CLAUSE_DEVICE_TYPE)
 #define OMP_ATOMIC_CLAUSES \
   (omp_mask (OMP_CLAUSE_ATOMIC) | OMP_CLAUSE_CAPTURE | OMP_CLAUSE_HINT	\
-   | OMP_CLAUSE_MEMORDER)
+   | OMP_CLAUSE_MEMORDER | OMP_CLAUSE_COMPARE | OMP_CLAUSE_FAIL 	\
+   | OMP_CLAUSE_WEAK)
 #define OMP_MASKED_CLAUSES \
   (omp_mask (OMP_CLAUSE_FILTER))
 #define OMP_ERROR_CLAUSES \
@@ -5717,6 +5767,7 @@ gfc_match_omp_ordered_depend (void)
    - capture
    - memory-order-clause: seq_cst | acq_rel | release | acquire | relaxed
    - hint(hint-expr)
+   - OpenMP 5.1: compare | fail (seq_cst | acquire | relaxed ) | weak
 */
 
 match
@@ -5728,12 +5779,25 @@ gfc_match_omp_atomic (void)
   if (gfc_match_omp_clauses (&c, OMP_ATOMIC_CLAUSES, true, true) != MATCH_YES)
     return MATCH_ERROR;
 
-  if (c->capture && c->atomic_op != GFC_OMP_ATOMIC_UNSET)
-    gfc_error ("OMP ATOMIC at %L with multiple atomic clauses", &loc);
-
   if (c->atomic_op == GFC_OMP_ATOMIC_UNSET)
     c->atomic_op = GFC_OMP_ATOMIC_UPDATE;
 
+  if (c->capture && c->atomic_op != GFC_OMP_ATOMIC_UPDATE)
+    gfc_error ("!$OMP ATOMIC at %L with %s clause is incompatible with "
+	       "READ or WRITE", &loc, "CAPTURE");
+  if (c->compare && c->atomic_op != GFC_OMP_ATOMIC_UPDATE)
+    gfc_error ("!$OMP ATOMIC at %L with %s clause is incompatible with "
+	       "READ or WRITE", &loc, "COMPARE");
+  if (c->fail != OMP_MEMORDER_UNSET && c->atomic_op != GFC_OMP_ATOMIC_UPDATE)
+    gfc_error ("!$OMP ATOMIC at %L with %s clause is incompatible with "
+	       "READ or WRITE", &loc, "FAIL");
+  if (c->weak && !c->compare)
+    {
+      gfc_error ("!$OMP ATOMIC at %L with %s clause requires %s clause", &loc,
+		 "WEAK", "COMPARE");
+      c->weak = false;
+    }
+
   if (c->memorder == OMP_MEMORDER_UNSET)
     {
       gfc_namespace *prog_unit = gfc_current_ns;
@@ -5764,32 +5828,24 @@ gfc_match_omp_atomic (void)
     switch (c->atomic_op)
       {
       case GFC_OMP_ATOMIC_READ:
-	if (c->memorder == OMP_MEMORDER_ACQ_REL
-	    || c->memorder == OMP_MEMORDER_RELEASE)
+	if (c->memorder == OMP_MEMORDER_RELEASE)
 	  {
 	    gfc_error ("!$OMP ATOMIC READ at %L incompatible with "
-		       "ACQ_REL or RELEASE clauses", &loc);
+		       "RELEASE clause", &loc);
 	    c->memorder = OMP_MEMORDER_SEQ_CST;
 	  }
+	else if (c->memorder == OMP_MEMORDER_ACQ_REL)
+	  c->memorder = OMP_MEMORDER_ACQUIRE;
 	break;
       case GFC_OMP_ATOMIC_WRITE:
-	if (c->memorder == OMP_MEMORDER_ACQ_REL
-	    || c->memorder == OMP_MEMORDER_ACQUIRE)
+	if (c->memorder == OMP_MEMORDER_ACQUIRE)
 	  {
 	    gfc_error ("!$OMP ATOMIC WRITE at %L incompatible with "
-		       "ACQ_REL or ACQUIRE clauses", &loc);
-	    c->memorder = OMP_MEMORDER_SEQ_CST;
-	  }
-	break;
-      case GFC_OMP_ATOMIC_UPDATE:
-	if ((c->memorder == OMP_MEMORDER_ACQ_REL
-	     || c->memorder == OMP_MEMORDER_ACQUIRE)
-	    && !c->capture)
-	  {
-	    gfc_error ("!$OMP ATOMIC UPDATE at %L incompatible with "
-		       "ACQ_REL or ACQUIRE clauses", &loc);
+		       "ACQUIRE clause", &loc);
 	    c->memorder = OMP_MEMORDER_SEQ_CST;
 	  }
+	else if (c->memorder == OMP_MEMORDER_ACQ_REL)
+	  c->memorder = OMP_MEMORDER_RELEASE;
 	break;
       default:
 	break;
@@ -7450,20 +7506,24 @@ expr_references_sym (gfc_expr *e, gfc_symbol *s, gfc_expr *se)
 
 
 /* If EXPR is a conversion function that widens the type
-   if WIDENING is true or narrows the type if WIDENING is false,
+   if WIDENING is true or narrows the type if NARROW is true,
    return the inner expression, otherwise return NULL.  */
 
 static gfc_expr *
-is_conversion (gfc_expr *expr, bool widening)
+is_conversion (gfc_expr *expr, bool narrowing, bool widening)
 {
   gfc_typespec *ts1, *ts2;
 
   if (expr->expr_type != EXPR_FUNCTION
       || expr->value.function.isym == NULL
       || expr->value.function.esym != NULL
-      || expr->value.function.isym->id != GFC_ISYM_CONVERSION)
+      || expr->value.function.isym->id != GFC_ISYM_CONVERSION
+      || (!narrowing && !widening))
     return NULL;
 
+  if (narrowing && widening)
+    return expr->value.function.actual->expr;
+
   if (widening)
     {
       ts1 = &expr->ts;
@@ -7482,163 +7542,297 @@ is_conversion (gfc_expr *expr, bool widening)
   return NULL;
 }
 
+static bool
+is_scalar_intrinsic_expr (gfc_expr *expr, bool must_be_var, bool conv_ok)
+{
+  if (must_be_var
+      && (expr->expr_type != EXPR_VARIABLE || !expr->symtree)
+      && (!conv_ok || !is_conversion (expr, true, true)))
+    return false;
+  return (expr->rank == 0
+	  && !gfc_is_coindexed (expr)
+	  && (expr->ts.type != BT_INTEGER
+	      || expr->ts.type != BT_REAL
+	      || expr->ts.type != BT_COMPLEX
+	      || expr->ts.type != BT_LOGICAL));
+}
 
-static void
+/*static */ void
 resolve_omp_atomic (gfc_code *code)
 {
   gfc_code *atomic_code = code->block;
   gfc_symbol *var;
-  gfc_expr *expr2, *expr2_tmp;
+  gfc_expr *stmt_expr2, *capt_expr2;
   gfc_omp_atomic_op aop
     = (gfc_omp_atomic_op) (atomic_code->ext.omp_clauses->atomic_op
 			   & GFC_OMP_ATOMIC_MASK);
+  gfc_code *stmt = NULL, *capture_stmt = NULL;
+  gfc_expr *comp_cond = NULL;
+  locus *loc = NULL;
 
   code = code->block->next;
-  /* resolve_blocks asserts this is initially EXEC_ASSIGN.
+  /* resolve_blocks asserts this is initially EXEC_ASSIGN or EXEC_IF
      If it changed to EXEC_NOP, assume an error has been emitted already.  */
-  if (code->op == EXEC_NOP)
+  if (code->op == EXEC_NOP /* FIXME: || (code->next && code->next->op == EXEC_NOP)*/)
     return;
-  if (code->op != EXEC_ASSIGN)
+
+  if (code->op == EXEC_IF && code->block->op == EXEC_IF)
+    comp_cond = code->block->expr1;
+
+  if (atomic_code->ext.omp_clauses->compare
+      && atomic_code->ext.omp_clauses->capture)
     {
-    unexpected:
-      gfc_error ("unexpected !$OMP ATOMIC expression at %L", &code->loc);
-      return;
+      /* Must be either "if (x == e) then; x = d; else; v = x; end if"
+	 or "v = expr" followed/preceded by
+	 "if (x == e) then; x = d; end if" or "if (x == e) x = d".  */
+      gfc_code *next = code;
+      if (code->op == EXEC_ASSIGN)
+	{
+	  capture_stmt = code;
+	  next = code->next;
+	}
+      if (next->op == EXEC_IF
+	  && next->block
+	  && next->block->op == EXEC_IF
+	  && next->block->next->op == EXEC_ASSIGN)
+	{
+	  stmt = next->block->next;
+	  if (stmt->next)
+	    {
+	      loc = &stmt->loc;
+	      goto unexpected;
+	    }
+	}
+      if (stmt && !capture_stmt && next->block->block)
+	{
+	  if (next->block->block->expr1)
+	    {
+	      gfc_error ("Expected ELSE at %L in atomic compare capture",
+			  &next->block->block->expr1->where);
+	    }
+	  if (!code->block->block->next
+	      || code->block->block->next->op != EXEC_ASSIGN)
+	    {
+	      loc = (code->block->block->next ? &code->block->block->next->loc
+					      : &code->block->block->loc);
+	      goto unexpected;
+	    }
+	  capture_stmt = code->block->block->next;
+	  if (capture_stmt->next)
+	    {
+	      loc = &capture_stmt->next->loc;
+	      goto unexpected;
+	    }
+	}
+      if (stmt && !capture_stmt && code->op == EXEC_ASSIGN)
+	{
+	  capture_stmt = code;
+	}
+      else if (!capture_stmt)
+	{
+	  loc = &code->loc;
+	  goto unexpected;
+	}
+    }
+  else if (atomic_code->ext.omp_clauses->compare)
+    {
+      /* Must be: "if (x == e) then; x = d; end if" or "if (x == e) x = d".  */
+      if (code->op == EXEC_IF
+	  && code->block
+	  && code->block->op == EXEC_IF
+	  && code->block->next->op == EXEC_ASSIGN)
+	{
+	  stmt = code->block->next;
+	  if (stmt->next || code->block->block)
+	    {
+	      loc = stmt->next ? &stmt->next->loc : &code->block->block->loc;
+	      goto unexpected;
+	    }
+	}
+      else
+	{
+	  loc = &code->loc;
+	  goto unexpected;
+	}
     }
-  if (!atomic_code->ext.omp_clauses->capture)
+  else if (atomic_code->ext.omp_clauses->capture)
     {
-      if (code->next != NULL)
+      /* Must be: "v = x" followed/preceded by "x = ...". */
+      if (code->op != EXEC_ASSIGN)
 	goto unexpected;
+      if (code->next->op != EXEC_ASSIGN)
+	{
+	  loc = &code->next->loc;
+	  goto unexpected;
+	}
+      gfc_expr *expr2, *expr2_next;
+      expr2 = is_conversion (code->expr2, true, true);
+      if (expr2 == NULL)
+	expr2 = code->expr2;
+      expr2_next = is_conversion (code->next->expr2, true, true);
+      if (expr2_next == NULL)
+	expr2_next = code->next->expr2;
+      if (code->expr1->expr_type == EXPR_VARIABLE
+	  && code->next->expr1->expr_type == EXPR_VARIABLE
+	  && expr2->expr_type == EXPR_VARIABLE
+	  && expr2_next->expr_type == EXPR_VARIABLE)
+	{
+	  if (code->expr1->symtree->n.sym == expr2_next->symtree->n.sym)
+	    {
+	      stmt = code;
+	      capture_stmt = code->next;
+	    }
+	  else
+	    {
+	      capture_stmt = code;
+	      stmt = code->next;
+	    }
+	}
+      else if (expr2->expr_type == EXPR_VARIABLE)
+	{
+	  capture_stmt = code;
+	  stmt = code->next;
+	}
+      else
+	{
+	  stmt = code;
+	  capture_stmt = code->next;
+	}
+      gcc_assert (!code->next->next);
     }
   else
     {
-      if (code->next == NULL)
+      /* x = ... */
+      stmt = code;
+      if ((!atomic_code->ext.omp_clauses->compare && stmt->op != EXEC_ASSIGN)
+	  || (atomic_code->ext.omp_clauses->compare && stmt->op != EXEC_IF))
 	goto unexpected;
-      if (code->next->op == EXEC_NOP)
-	return;
-      if (code->next->op != EXEC_ASSIGN || code->next->next)
+      gcc_assert (!code->next);
+    }
+
+  if (comp_cond)
+    {
+      if (comp_cond->expr_type != EXPR_OP
+	  || (comp_cond->value.op.op != INTRINSIC_EQ
+	      && comp_cond->value.op.op != INTRINSIC_EQ_OS
+	      && comp_cond->value.op.op != INTRINSIC_EQV))
 	{
-	  code = code->next;
-	  goto unexpected;
+	  gfc_error ("Expected %<==%>, %<.EQ.%> or %<.EQV.%> atomic comparison "
+		     "expression at %L", &comp_cond->where);
+	  return;
+	}
+      if (!is_scalar_intrinsic_expr (comp_cond->value.op.op1, true, false))
+	{
+	  gfc_error ("Expected scalar intrinsic variable at %L in atomic "
+		     "comparison", &comp_cond->value.op.op1->where);
+	  return;
+	}
+      if (!gfc_resolve_expr (comp_cond->value.op.op2)
+	  || !is_scalar_intrinsic_expr (comp_cond->value.op.op2, false, false))
+	{
+	  gfc_error ("Expected scalar intrinsic expression at %L in atomic "
+		     "comparison", &comp_cond->value.op.op1->where);
+	  return;
 	}
     }
 
-  if (code->expr1->expr_type != EXPR_VARIABLE
-      || code->expr1->symtree == NULL
-      || code->expr1->rank != 0
-      || (code->expr1->ts.type != BT_INTEGER
-	  && code->expr1->ts.type != BT_REAL
-	  && code->expr1->ts.type != BT_COMPLEX
-	  && code->expr1->ts.type != BT_LOGICAL))
+  if (!is_scalar_intrinsic_expr (stmt->expr1, true, false))
     {
       gfc_error ("!$OMP ATOMIC statement must set a scalar variable of "
-		 "intrinsic type at %L", &code->loc);
+		 "intrinsic type at %L", &stmt->expr1->where);
       return;
     }
 
-  var = code->expr1->symtree->n.sym;
-  expr2 = is_conversion (code->expr2, false);
-  if (expr2 == NULL)
+  if (!gfc_resolve_expr (stmt->expr2)
+      || !is_scalar_intrinsic_expr (stmt->expr2, false, false))
     {
-      if (aop == GFC_OMP_ATOMIC_READ || aop == GFC_OMP_ATOMIC_WRITE)
-	expr2 = is_conversion (code->expr2, true);
-      if (expr2 == NULL)
-	expr2 = code->expr2;
+      gfc_error ("!$OMP ATOMIC statement must assign an expression of "
+		 "intrinsic type at %L", &stmt->expr2->where);
+      return;
     }
 
+  if (gfc_expr_attr (stmt->expr1).allocatable)
+    {
+      gfc_error ("!$OMP ATOMIC with ALLOCATABLE variable at %L",
+		 &stmt->expr1->where);
+      return;
+    }
+
+  var = stmt->expr1->symtree->n.sym;
+  stmt_expr2 = is_conversion (stmt->expr2, true, true);
+  if (stmt_expr2 == NULL)
+    stmt_expr2 = stmt->expr2;
+
   switch (aop)
     {
     case GFC_OMP_ATOMIC_READ:
-      if (expr2->expr_type != EXPR_VARIABLE
-	  || expr2->symtree == NULL
-	  || expr2->rank != 0
-	  || (expr2->ts.type != BT_INTEGER
-	      && expr2->ts.type != BT_REAL
-	      && expr2->ts.type != BT_COMPLEX
-	      && expr2->ts.type != BT_LOGICAL))
+      if (stmt_expr2->expr_type != EXPR_VARIABLE)
 	gfc_error ("!$OMP ATOMIC READ statement must read from a scalar "
-		   "variable of intrinsic type at %L", &expr2->where);
+		   "variable of intrinsic type at %L", &stmt_expr2->where);
       return;
     case GFC_OMP_ATOMIC_WRITE:
-      if (expr2->rank != 0 || expr_references_sym (code->expr2, var, NULL))
+      if (expr_references_sym (stmt_expr2, var, NULL))
 	gfc_error ("expr in !$OMP ATOMIC WRITE assignment var = expr "
 		   "must be scalar and cannot reference var at %L",
-		   &expr2->where);
+		   &stmt_expr2->where);
       return;
     default:
       break;
     }
+
+  if (atomic_code->ext.omp_clauses->compare
+      && !atomic_code->ext.omp_clauses->capture)
+    {
+      gfc_error ("Sorry, COMPARE clause in ATOMIC at %L is not yet "
+		 "supported", &atomic_code->loc);
+      return;
+    }
+
   if (atomic_code->ext.omp_clauses->capture)
     {
-      expr2_tmp = expr2;
-      if (expr2 == code->expr2)
+      if (!is_scalar_intrinsic_expr (capture_stmt->expr1, true, false))
 	{
-	  expr2_tmp = is_conversion (code->expr2, true);
-	  if (expr2_tmp == NULL)
-	    expr2_tmp = expr2;
+	  gfc_error ("!$OMP ATOMIC capture-statement must set a scalar "
+		     "variable of intrinsic type at %L",
+		     &capture_stmt->expr1->where);
+	  return;
 	}
-      if (expr2_tmp->expr_type == EXPR_VARIABLE)
+
+      if (!is_scalar_intrinsic_expr (capture_stmt->expr2, true, true))
 	{
-	  if (expr2_tmp->symtree == NULL
-	      || expr2_tmp->rank != 0
-	      || (expr2_tmp->ts.type != BT_INTEGER
-		  && expr2_tmp->ts.type != BT_REAL
-		  && expr2_tmp->ts.type != BT_COMPLEX
-		  && expr2_tmp->ts.type != BT_LOGICAL)
-	      || expr2_tmp->symtree->n.sym == var)
-	    {
-	      gfc_error ("!$OMP ATOMIC CAPTURE capture statement must read from "
-			 "a scalar variable of intrinsic type at %L",
-			 &expr2_tmp->where);
-	      return;
-	    }
-	  var = expr2_tmp->symtree->n.sym;
-	  code = code->next;
-	  if (code->expr1->expr_type != EXPR_VARIABLE
-	      || code->expr1->symtree == NULL
-	      || code->expr1->rank != 0
-	      || (code->expr1->ts.type != BT_INTEGER
-		  && code->expr1->ts.type != BT_REAL
-		  && code->expr1->ts.type != BT_COMPLEX
-		  && code->expr1->ts.type != BT_LOGICAL))
-	    {
-	      gfc_error ("!$OMP ATOMIC CAPTURE update statement must set "
-			 "a scalar variable of intrinsic type at %L",
-			 &code->expr1->where);
-	      return;
-	    }
-	  if (code->expr1->symtree->n.sym != var)
-	    {
-	      gfc_error ("!$OMP ATOMIC CAPTURE capture statement reads from "
-			 "different variable than update statement writes "
-			 "into at %L", &code->expr1->where);
-	      return;
-	    }
-	  expr2 = is_conversion (code->expr2, false);
-	  if (expr2 == NULL)
-	    expr2 = code->expr2;
+	  gfc_error ("!$OMP ATOMIC capture-statement requires a scalar variable"
+		     " of intrinsic type at %L", &capture_stmt->expr2->where);
+	  return;
 	}
-    }
+      capt_expr2 = is_conversion (capture_stmt->expr2, true, true);
+      if (capt_expr2 == NULL)
+	capt_expr2 = capture_stmt->expr2;
 
-  if (gfc_expr_attr (code->expr1).allocatable)
-    {
-      gfc_error ("!$OMP ATOMIC with ALLOCATABLE variable at %L",
-		 &code->loc);
-      return;
+      if (capt_expr2->symtree->n.sym != var)
+	{
+	  gfc_error ("!$OMP ATOMIC CAPTURE capture statement reads from "
+		     "different variable than update statement writes "
+		     "into at %L", &capture_stmt->expr2->where);
+	      return;
+	}
     }
 
   if (atomic_code->ext.omp_clauses->capture
-      && code->next == NULL
-      && code->expr2->rank == 0
-      && !expr_references_sym (code->expr2, var, NULL))
+      && !expr_references_sym (stmt_expr2, var, NULL))
     atomic_code->ext.omp_clauses->atomic_op
       = (gfc_omp_atomic_op) (atomic_code->ext.omp_clauses->atomic_op
 			     | GFC_OMP_ATOMIC_SWAP);
-  else if (expr2->expr_type == EXPR_OP)
+  else if (stmt_expr2->expr_type == EXPR_OP)
     {
       gfc_expr *v = NULL, *e, *c;
-      gfc_intrinsic_op op = expr2->value.op.op;
+      gfc_intrinsic_op op = stmt_expr2->value.op.op;
       gfc_intrinsic_op alt_op = INTRINSIC_NONE;
 
+      if (atomic_code->ext.omp_clauses->fail != OMP_MEMORDER_UNSET
+	  && !atomic_code->ext.omp_clauses->compare)
+	gfc_error ("!$OMP ATOMIC UPDATE at %L with FAIL clause requiries either"
+		   " the COMPARE clause or using the intrinsic MIN/MAX "
+		   "procedure", &atomic_code->loc);
       switch (op)
 	{
 	case INTRINSIC_PLUS:
@@ -7665,7 +7859,7 @@ resolve_omp_atomic (gfc_code *code)
 	default:
 	  gfc_error ("!$OMP ATOMIC assignment operator must be binary "
 		     "+, *, -, /, .AND., .OR., .EQV. or .NEQV. at %L",
-		     &expr2->where);
+		     &stmt_expr2->where);
 	  return;
 	}
 
@@ -7675,12 +7869,12 @@ resolve_omp_atomic (gfc_code *code)
 	 (expr) op var.  We rely here on the fact that the matcher
 	 for x op1 y op2 z where op1 and op2 have equal precedence
 	 returns (x op1 y) op2 z.  */
-      e = expr2->value.op.op2;
+      e = stmt_expr2->value.op.op2;
       if (e->expr_type == EXPR_VARIABLE
 	  && e->symtree != NULL
 	  && e->symtree->n.sym == var)
 	v = e;
-      else if ((c = is_conversion (e, true)) != NULL
+      else if ((c = is_conversion (e, false, true)) != NULL
 	       && c->expr_type == EXPR_VARIABLE
 	       && c->symtree != NULL
 	       && c->symtree->n.sym == var)
@@ -7688,7 +7882,7 @@ resolve_omp_atomic (gfc_code *code)
       else
 	{
 	  gfc_expr **p = NULL, **q;
-	  for (q = &expr2->value.op.op1; (e = *q) != NULL; )
+	  for (q = &stmt_expr2->value.op.op1; (e = *q) != NULL; )
 	    if (e->expr_type == EXPR_VARIABLE
 		&& e->symtree != NULL
 		&& e->symtree->n.sym == var)
@@ -7696,7 +7890,7 @@ resolve_omp_atomic (gfc_code *code)
 		v = e;
 		break;
 	      }
-	    else if ((c = is_conversion (e, true)) != NULL)
+	    else if ((c = is_conversion (e, false, true)) != NULL)
 	      q = &e->value.function.actual->expr;
 	    else if (e->expr_type != EXPR_OP
 		     || (e->value.op.op != op
@@ -7712,7 +7906,7 @@ resolve_omp_atomic (gfc_code *code)
 	  if (v == NULL)
 	    {
 	      gfc_error ("!$OMP ATOMIC assignment must be var = var op expr "
-			 "or var = expr op var at %L", &expr2->where);
+			 "or var = expr op var at %L", &stmt_expr2->where);
 	      return;
 	    }
 
@@ -7727,7 +7921,7 @@ resolve_omp_atomic (gfc_code *code)
 		case INTRINSIC_NEQV:
 		  gfc_error ("!$OMP ATOMIC var = var op expr not "
 			     "mathematically equivalent to var = var op "
-			     "(expr) at %L", &expr2->where);
+			     "(expr) at %L", &stmt_expr2->where);
 		  break;
 		default:
 		  break;
@@ -7735,43 +7929,44 @@ resolve_omp_atomic (gfc_code *code)
 
 	      /* Canonicalize into var = var op (expr).  */
 	      *p = e->value.op.op2;
-	      e->value.op.op2 = expr2;
-	      e->ts = expr2->ts;
-	      if (code->expr2 == expr2)
-		code->expr2 = expr2 = e;
+	      e->value.op.op2 = stmt_expr2;
+	      e->ts = stmt_expr2->ts;
+	      if (stmt->expr2 == stmt_expr2)
+		stmt->expr2 = stmt_expr2 = e;
 	      else
-		code->expr2->value.function.actual->expr = expr2 = e;
+		stmt->expr2->value.function.actual->expr = stmt_expr2 = e;
 
-	      if (!gfc_compare_types (&expr2->value.op.op1->ts, &expr2->ts))
+	      if (!gfc_compare_types (&stmt_expr2->value.op.op1->ts,
+				      &stmt_expr2->ts))
 		{
-		  for (p = &expr2->value.op.op1; *p != v;
+		  for (p = &stmt_expr2->value.op.op1; *p != v;
 		       p = &(*p)->value.function.actual->expr)
 		    ;
 		  *p = NULL;
-		  gfc_free_expr (expr2->value.op.op1);
-		  expr2->value.op.op1 = v;
-		  gfc_convert_type (v, &expr2->ts, 2);
+		  gfc_free_expr (stmt_expr2->value.op.op1);
+		  stmt_expr2->value.op.op1 = v;
+		  gfc_convert_type (v, &stmt_expr2->ts, 2);
 		}
 	    }
 	}
 
-      if (e->rank != 0 || expr_references_sym (code->expr2, var, v))
+      if (e->rank != 0 || expr_references_sym (stmt->expr2, var, v))
 	{
 	  gfc_error ("expr in !$OMP ATOMIC assignment var = var op expr "
 		     "must be scalar and cannot reference var at %L",
-		     &expr2->where);
+		     &stmt_expr2->where);
 	  return;
 	}
     }
-  else if (expr2->expr_type == EXPR_FUNCTION
-	   && expr2->value.function.isym != NULL
-	   && expr2->value.function.esym == NULL
-	   && expr2->value.function.actual != NULL
-	   && expr2->value.function.actual->next != NULL)
+  else if (stmt_expr2->expr_type == EXPR_FUNCTION
+	   && stmt_expr2->value.function.isym != NULL
+	   && stmt_expr2->value.function.esym == NULL
+	   && stmt_expr2->value.function.actual != NULL
+	   && stmt_expr2->value.function.actual->next != NULL)
     {
       gfc_actual_arglist *arg, *var_arg;
 
-      switch (expr2->value.function.isym->id)
+      switch (stmt_expr2->value.function.isym->id)
 	{
 	case GFC_ISYM_MIN:
 	case GFC_ISYM_MAX:
@@ -7779,31 +7974,37 @@ resolve_omp_atomic (gfc_code *code)
 	case GFC_ISYM_IAND:
 	case GFC_ISYM_IOR:
 	case GFC_ISYM_IEOR:
-	  if (expr2->value.function.actual->next->next != NULL)
+	  if (stmt_expr2->value.function.actual->next->next != NULL)
 	    {
 	      gfc_error ("!$OMP ATOMIC assignment intrinsic IAND, IOR "
 			 "or IEOR must have two arguments at %L",
-			 &expr2->where);
+			 &stmt_expr2->where);
 	      return;
 	    }
 	  break;
 	default:
 	  gfc_error ("!$OMP ATOMIC assignment intrinsic must be "
 		     "MIN, MAX, IAND, IOR or IEOR at %L",
-		     &expr2->where);
+		     &stmt_expr2->where);
 	  return;
 	}
 
       var_arg = NULL;
-      for (arg = expr2->value.function.actual; arg; arg = arg->next)
-	{
-	  if ((arg == expr2->value.function.actual
-	       || (var_arg == NULL && arg->next == NULL))
-	      && arg->expr->expr_type == EXPR_VARIABLE
-	      && arg->expr->symtree != NULL
-	      && arg->expr->symtree->n.sym == var)
-	    var_arg = arg;
-	  else if (expr_references_sym (arg->expr, var, NULL))
+      for (arg = stmt_expr2->value.function.actual; arg; arg = arg->next)
+	{
+	  gfc_expr *e = NULL;
+	  if (arg == stmt_expr2->value.function.actual
+	      || (var_arg == NULL && arg->next == NULL))
+	    {
+	      e = is_conversion (arg->expr, false, true);
+	      if (!e)
+		e = arg->expr;	
+	      if (e->expr_type == EXPR_VARIABLE
+		  && e->symtree != NULL
+		  && e->symtree->n.sym == var)
+		var_arg = arg;
+	    }
+	  if ((!var_arg || !e) && expr_references_sym (arg->expr, var, NULL))
 	    {
 	      gfc_error ("!$OMP ATOMIC intrinsic arguments except one must "
 			 "not reference %qs at %L",
@@ -7821,72 +8022,35 @@ resolve_omp_atomic (gfc_code *code)
       if (var_arg == NULL)
 	{
 	  gfc_error ("First or last !$OMP ATOMIC intrinsic argument must "
-		     "be %qs at %L", var->name, &expr2->where);
+		     "be %qs at %L", var->name, &stmt_expr2->where);
 	  return;
 	}
 
-      if (var_arg != expr2->value.function.actual)
+      if (var_arg != stmt_expr2->value.function.actual)
 	{
 	  /* Canonicalize, so that var comes first.  */
 	  gcc_assert (var_arg->next == NULL);
-	  for (arg = expr2->value.function.actual;
+	  for (arg = stmt_expr2->value.function.actual;
 	       arg->next != var_arg; arg = arg->next)
 	    ;
-	  var_arg->next = expr2->value.function.actual;
-	  expr2->value.function.actual = var_arg;
+	  var_arg->next = stmt_expr2->value.function.actual;
+	  stmt_expr2->value.function.actual = var_arg;
 	  arg->next = NULL;
 	}
     }
   else
     gfc_error ("!$OMP ATOMIC assignment must have an operator or "
-	       "intrinsic on right hand side at %L", &expr2->where);
-
-  if (atomic_code->ext.omp_clauses->capture && code->next)
-    {
-      code = code->next;
-      if (code->expr1->expr_type != EXPR_VARIABLE
-	  || code->expr1->symtree == NULL
-	  || code->expr1->rank != 0
-	  || (code->expr1->ts.type != BT_INTEGER
-	      && code->expr1->ts.type != BT_REAL
-	      && code->expr1->ts.type != BT_COMPLEX
-	      && code->expr1->ts.type != BT_LOGICAL))
-	{
-	  gfc_error ("!$OMP ATOMIC CAPTURE capture statement must set "
-		     "a scalar variable of intrinsic type at %L",
-		     &code->expr1->where);
-	  return;
-	}
+	       "intrinsic on right hand side at %L", &stmt_expr2->where);
 
-      expr2 = is_conversion (code->expr2, false);
-      if (expr2 == NULL)
-	{
-	  expr2 = is_conversion (code->expr2, true);
-	  if (expr2 == NULL)
-	    expr2 = code->expr2;
-	}
+  if (atomic_code->ext.omp_clauses->compare)
+    gfc_error ("Sorry, COMPARE clause in ATOMIC at %L is not yet "
+	       "supported", &atomic_code->loc);
+  return;
 
-      if (expr2->expr_type != EXPR_VARIABLE
-	  || expr2->symtree == NULL
-	  || expr2->rank != 0
-	  || (expr2->ts.type != BT_INTEGER
-	      && expr2->ts.type != BT_REAL
-	      && expr2->ts.type != BT_COMPLEX
-	      && expr2->ts.type != BT_LOGICAL))
-	{
-	  gfc_error ("!$OMP ATOMIC CAPTURE capture statement must read "
-		     "from a scalar variable of intrinsic type at %L",
-		     &expr2->where);
-	  return;
-	}
-      if (expr2->symtree->n.sym != var)
-	{
-	  gfc_error ("!$OMP ATOMIC CAPTURE capture statement reads from "
-		     "different variable than update statement writes "
-		     "into at %L", &expr2->where);
-	  return;
-	}
-    }
+unexpected:
+  gfc_error ("unexpected !$OMP ATOMIC expression at %L",
+	     loc ? loc : &code->loc);
+  return;
 }
 
 
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 94b677f2a70..1f111091b0a 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -5313,7 +5313,22 @@ parse_omp_oacc_atomic (bool omp_p)
       st = next_statement ();
       if (st == ST_NONE)
 	unexpected_eof ();
-      else if (st == ST_ASSIGNMENT)
+      else if (np->ext.omp_clauses->compare
+	       && (st == ST_SIMPLE_IF || st == ST_IF_BLOCK))
+	{
+	  count--;
+	  if (st == ST_IF_BLOCK)
+	    {
+	      parse_if_block ();
+	      /* With else (or elseif).  */
+	      if (gfc_state_stack->tail->block->block)
+		count--;
+	    }
+	  accept_statement (st);
+	}
+      else if (st == ST_ASSIGNMENT
+	       && (!np->ext.omp_clauses->compare
+		   || np->ext.omp_clauses->capture))
 	{
 	  accept_statement (st);
 	  count--;
@@ -5332,8 +5347,6 @@ parse_omp_oacc_atomic (bool omp_p)
       gfc_warning_check ();
       st = next_statement ();
     }
-  else if (np->ext.omp_clauses->capture)
-    gfc_error ("Missing !$OMP END ATOMIC after !$OMP ATOMIC CAPTURE at %C");
   return st;
 }
 
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 705d2326a29..56131cf527a 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -10848,13 +10848,8 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns)
 	  {
 	    /* Verify this before calling gfc_resolve_code, which might
 	       change it.  */
-	    gcc_assert (b->next && b->next->op == EXEC_ASSIGN);
-	    gcc_assert ((!b->ext.omp_clauses->capture
-			 && b->next->next == NULL)
-			|| (b->ext.omp_clauses->capture
-			    && b->next->next != NULL
-			    && b->next->next->op == EXEC_ASSIGN
-			    && b->next->next->next == NULL));
+	    gcc_assert (b->op == EXEC_OMP_ATOMIC
+			|| b->next && b->next->op == EXEC_ASSIGN);
 	  }
 	  break;
 
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index b86c7cf9833..decb712aad8 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -4497,7 +4497,7 @@ gfc_trans_omp_atomic (gfc_code *code)
   enum tree_code op = ERROR_MARK;
   enum tree_code aop = OMP_ATOMIC;
   bool var_on_left = false;
-  enum omp_memory_order mo;
+  enum omp_memory_order mo, fail_mo;
   switch (atomic_code->ext.omp_clauses->memorder)
     {
     case OMP_MEMORDER_UNSET: mo = OMP_MEMORY_ORDER_UNSPECIFIED; break;
@@ -4508,6 +4508,17 @@ gfc_trans_omp_atomic (gfc_code *code)
     case OMP_MEMORDER_SEQ_CST: mo = OMP_MEMORY_ORDER_SEQ_CST; break;
     default: gcc_unreachable ();
     }
+  switch (atomic_code->ext.omp_clauses->fail)
+    {
+    case OMP_MEMORDER_UNSET: fail_mo = OMP_FAIL_MEMORY_ORDER_UNSPECIFIED; break;
+    case OMP_MEMORDER_ACQ_REL: fail_mo = OMP_FAIL_MEMORY_ORDER_RELAXED; break;
+    case OMP_MEMORDER_ACQUIRE: fail_mo = OMP_FAIL_MEMORY_ORDER_ACQUIRE; break;
+    case OMP_MEMORDER_RELAXED: fail_mo = OMP_FAIL_MEMORY_ORDER_RELAXED; break;
+    case OMP_MEMORDER_RELEASE: fail_mo = OMP_FAIL_MEMORY_ORDER_RELEASE; break;
+    case OMP_MEMORDER_SEQ_CST: fail_mo = OMP_FAIL_MEMORY_ORDER_SEQ_CST; break;
+    default: gcc_unreachable ();
+    }
+   mo = (omp_memory_order) (mo | fail_mo);
 
   code = code->block->next;
   gcc_assert (code->op == EXEC_ASSIGN);
@@ -4738,6 +4749,7 @@ gfc_trans_omp_atomic (gfc_code *code)
     {
       x = build2_v (OMP_ATOMIC, lhsaddr, convert (type, x));
       OMP_ATOMIC_MEMORY_ORDER (x) = mo;
+      OMP_ATOMIC_WEAK (x) = atomic_code->ext.omp_clauses->weak;
       gfc_add_expr_to_block (&block, x);
     }
   else
@@ -4761,6 +4773,7 @@ gfc_trans_omp_atomic (gfc_code *code)
 	}
       x = build2 (aop, type, lhsaddr, convert (type, x));
       OMP_ATOMIC_MEMORY_ORDER (x) = mo;
+      OMP_ATOMIC_WEAK (x) = atomic_code->ext.omp_clauses->weak;
       x = convert (TREE_TYPE (vse.expr), x);
       gfc_add_modify (&block, vse.expr, x);
     }
diff --git a/gcc/testsuite/gfortran.dg/gomp/atomic-10.f90 b/gcc/testsuite/gfortran.dg/gomp/atomic-10.f90
new file mode 100644
index 00000000000..bafc88b0d84
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/atomic-10.f90
@@ -0,0 +1,32 @@
+! PR middle-end/28046  for the original C tet.
+! { dg-do compile }
+! { dg-options "-fopenmp -fdump-tree-ompexp" }
+! { dg-require-effective-target cas_int }
+
+module m
+  implicit none
+  integer a(3), b
+  type t_C
+     integer :: x, y
+  end type
+  type(t_C) :: c
+
+  interface
+    integer function bar(); end
+    integer function baz(); end
+  end interface
+  pointer :: baz
+contains
+subroutine foo
+!$omp atomic
+  a(2) = a(2) + bar ()
+!$omp atomic
+  b = b + bar ()
+!$omp atomic
+  c%y = c%y + bar ()
+!$omp atomic
+  b = b + baz ()
+end
+end module
+
+! { dg-final { scan-tree-dump-times "__atomic_fetch_add" 4 "ompexp" } }
diff --git a/gcc/testsuite/gfortran.dg/gomp/atomic-12.f90 b/gcc/testsuite/gfortran.dg/gomp/atomic-12.f90
new file mode 100644
index 00000000000..a0970767ff5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/atomic-12.f90
@@ -0,0 +1,364 @@
+! PR middle-end/45423 - for the original C/C++ testcase
+! { dg-do compile }
+! { dg-options "-fopenmp -fdump-tree-gimple -g0 -Wno-deprecated" }
+! atomicvar should never be referenced in between the barrier and
+! following #pragma omp atomic_load.
+! { dg-final { scan-tree-dump-not "barrier\[^#\]*atomicvar" "gimple" } }
+
+module m
+  implicit none
+  logical :: atomicvar, c
+  integer :: i, atomicvar2, c2
+contains
+integer function foo ()
+  !$omp barrier
+  !$omp atomic
+    atomicvar = atomicvar .or. .true.
+  !$omp barrier
+  !$omp atomic
+    atomicvar = atomicvar .or. .false.
+  !$omp barrier
+  !$omp atomic
+    atomicvar = atomicvar .or. c
+  !$omp barrier
+  !$omp atomic
+    atomicvar = atomicvar .and. .true.
+  !$omp barrier
+  !$omp atomic
+    atomicvar = atomicvar .and. .false.
+  !$omp barrier
+  !$omp atomic
+    atomicvar = atomicvar .and. c
+  !$omp barrier
+  !$omp atomic
+    atomicvar = atomicvar .neqv. .true.
+  !$omp barrier
+  !$omp atomic
+    atomicvar = atomicvar .neqv. .false.
+  !$omp barrier
+  !$omp atomic
+    atomicvar = atomicvar .neqv. c
+  !$omp barrier
+  !$omp atomic
+    atomicvar = atomicvar .eqv. .true.
+  !$omp barrier
+  !$omp atomic
+    atomicvar = atomicvar .eqv. .false.
+  !$omp barrier
+  !$omp atomic
+    atomicvar = atomicvar .eqv. c
+  !$omp barrier
+  !$omp atomic
+    atomicvar = .true. .or. atomicvar
+  !$omp barrier
+  !$omp atomic
+    atomicvar = .false. .or. atomicvar
+  !$omp barrier
+  !$omp atomic
+    atomicvar = c .or. atomicvar
+  !$omp barrier
+  !$omp atomic
+    atomicvar = .true. .and. atomicvar
+  !$omp barrier
+  !$omp atomic
+    atomicvar = .false. .and. atomicvar
+  !$omp barrier
+  !$omp atomic
+    atomicvar = c .and. atomicvar
+  !$omp barrier
+  !$omp atomic
+    atomicvar = .true. .neqv. atomicvar
+  !$omp barrier
+  !$omp atomic
+    atomicvar = .false. .neqv. atomicvar
+  !$omp barrier
+  !$omp atomic
+    atomicvar = c .neqv. atomicvar
+  !$omp barrier
+  !$omp atomic
+    atomicvar = .true. .eqv. atomicvar
+  !$omp barrier
+  !$omp atomic
+    atomicvar = .false. .eqv. atomicvar
+  !$omp barrier
+  !$omp atomic
+    atomicvar = c .eqv. atomicvar
+  !$omp barrier
+  foo = 0
+end
+
+integer function bar ()
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = ior (atomicvar2, -1)
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = ior (atomicvar2, 0)
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = ior (atomicvar2, 1)
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = ior (atomicvar2, 2)
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = ior (atomicvar2, c2)
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = ior (-1, atomicvar2)
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = ior (0, atomicvar2)
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = ior (1, atomicvar2)
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = ior (2, atomicvar2)
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = ior (c2, atomicvar2)
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = ieor (atomicvar2, -1)
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = ieor (atomicvar2, 0)
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = ieor (atomicvar2, 1)
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = ieor (atomicvar2, 2)
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = ieor (atomicvar2, c2)
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = ieor (-1, atomicvar2)
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = ieor (0, atomicvar2)
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = ieor (1, atomicvar2)
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = ior (2, atomicvar2)
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = ior (c2, atomicvar2)
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = iand (atomicvar2, -1)
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = iand (atomicvar2, 0)
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = iand (atomicvar2, 1)
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = iand (atomicvar2, 2)
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = iand (atomicvar2, c2)
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = iand (-1, atomicvar2)
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = iand (0, atomicvar2)
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = iand (1, atomicvar2)
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = iand (2, atomicvar2)
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = iand (c2, atomicvar2)
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = min (atomicvar2, -1)
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = min (atomicvar2, 0)
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = min (atomicvar2, 1)
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = min (atomicvar2, 2)
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = min (atomicvar2, c2)
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = min (-1, atomicvar2)
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = min (0, atomicvar2)
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = min (1, atomicvar2)
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = min (2, atomicvar2)
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = min (c2, atomicvar2)
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = max (atomicvar2, -1)
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = max (atomicvar2, 0)
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = max (atomicvar2, 1)
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = max (atomicvar2, 2)
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = max (atomicvar2, c2)
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = max (-1, atomicvar2)
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = max (0, atomicvar2)
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = max (1, atomicvar2)
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = max (2, atomicvar2)
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = max (c2, atomicvar2)
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = atomicvar2 + (-1)
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = atomicvar2 + 0
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = atomicvar2 + 1
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = atomicvar2 + 2
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = atomicvar2 + c2
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = -1 + atomicvar2
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = 0 + atomicvar2
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = 1 + atomicvar2
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = 2 + atomicvar2
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = c2 + atomicvar2
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = atomicvar2 - (-1)
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = atomicvar2 - 0
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = atomicvar2 - 1
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = atomicvar2 - 2
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = atomicvar2 - c2
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = -1 - atomicvar2
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = 0 - atomicvar2
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = 1 - atomicvar2
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = 2 - atomicvar2
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = c2 - atomicvar2
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = atomicvar2 * (-1)
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = atomicvar2 * 0
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = atomicvar2 * 1
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = atomicvar2 * 2
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = atomicvar2 * c2
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = (-1) * atomicvar2
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = 0 * atomicvar2
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = 1 * atomicvar2
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = 2 * atomicvar2
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = c2 * atomicvar2
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = atomicvar2 / (-1)
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = atomicvar2 / 0
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = atomicvar2 / 1
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = atomicvar2 / 2
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = atomicvar2 / c2
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = (-1) / atomicvar2
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = 0 / atomicvar2
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = 1 / atomicvar2
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = 2 / atomicvar2
+  !$omp barrier
+  !$omp atomic
+    atomicvar2 = c2 / atomicvar2
+  !$omp barrier
+  bar = 0
+end
+end module
diff --git a/gcc/testsuite/gfortran.dg/gomp/atomic-15.f90 b/gcc/testsuite/gfortran.dg/gomp/atomic-15.f90
new file mode 100644
index 00000000000..4c81791e5dd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/atomic-15.f90
@@ -0,0 +1,44 @@
+! { dg-do compile }
+! { dg-options "-fopenmp" }
+module m
+  implicit none
+  integer :: x = 6
+end module m
+
+program main
+  use m
+  implicit none
+  integer v
+  !$omp atomic
+    x = x * 7 + 6       ! { dg-error "assignment must be var = var op expr or var = expr op var" }
+  !$omp atomic
+    x = ieor (x * 7, 6)       ! { dg-error "intrinsic arguments except one must not reference 'x'" }
+  !$omp atomic update
+    x = x - 8 + 6       ! { dg-error "var = var op expr not mathematically equivalent to var = var op \\(expr\\)" }
+  !$omp atomic
+    x = ior (ieor (x, 7), 2)       ! { dg-error "intrinsic arguments except one must not reference 'x'" }
+  !$omp atomic
+    x = x / 7 * 2       ! { dg-error "var = var op expr not mathematically equivalent to var = var op \\(expr\\)" }
+  !$omp atomic
+    x = x / 7 / 2       ! { dg-error "var = var op expr not mathematically equivalent to var = var op \\(expr\\)" }
+  !$omp atomic capture
+    v = x; x = x * 7 + 6   ! { dg-error "assignment must be var = var op expr or var = expr op var" }
+  !$omp atomic capture
+    v = x; x = ieor(x * 7, 6)   ! { dg-error "intrinsic arguments except one must not reference 'x'" }
+  !$omp atomic capture
+    v = x; x = x - 8 + 6   ! { dg-error "var = var op expr not mathematically equivalent to var = var op \\(expr\\)" }
+  !$omp atomic capture
+    v = x; x = ior (ieor(x, 7), 2)   ! { dg-error "intrinsic arguments except one must not reference 'x'" }
+  !$omp atomic capture
+    v = x; x = x / 7 * 2   ! { dg-error "var = var op expr not mathematically equivalent to var = var op \\(expr\\)" }
+  !$omp atomic capture
+    v = x; x = x / 7 / 2   ! { dg-error "var = var op expr not mathematically equivalent to var = var op \\(expr\\)" }
+  !$omp atomic capture
+    x = x * 7 + 6; v = x   ! { dg-error "assignment must be var = var op expr or var = expr op var" }
+  !$omp atomic capture
+    x = ieor(x * 7, 6); v = x   ! { dg-error "intrinsic arguments except one must not reference 'x'" }
+  !$omp atomic capture
+    x = x - 8 + 6; v = x   ! { dg-error "var = var op expr not mathematically equivalent to var = var op \\(expr\\)" }
+  !$omp atomic capture
+    x = ior(ieor(x, 7), 2); v = x   ! { dg-error "intrinsic arguments except one must not reference 'x'" }
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/atomic-16.f90 b/gcc/testsuite/gfortran.dg/gomp/atomic-16.f90
new file mode 100644
index 00000000000..766085855e1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/atomic-16.f90
@@ -0,0 +1,36 @@
+! { dg-do compile }
+! { dg-options "-fopenmp" }
+
+module m
+  implicit none
+  integer :: x = 6
+contains
+
+subroutine foo ()
+  integer v
+  !$omp atomic seq_cst read
+  v = x
+  !$omp atomic seq_cst, read
+  v = x
+  !$omp atomic seq_cst write
+  x = v
+  !$omp atomic seq_cst ,write
+  x = v
+  !$omp atomic seq_cst update
+  x = x + v;
+  !$omp atomic seq_cst , update
+  x = v + x;
+  !$omp atomic seq_cst capture
+  v = x; x = x + 2;
+  !$omp atomic seq_cst, capture
+  v = x; x = 2 + x;
+  !$omp atomic read , seq_cst
+  v = x
+  !$omp atomic write ,seq_cst
+  x = v
+  !$omp atomic update, seq_cst
+  x = x + v
+  !$omp atomic capture, seq_cst
+  x = x + 2; v = x
+end
+end module m
diff --git a/gcc/testsuite/gfortran.dg/gomp/atomic-17.f90 b/gcc/testsuite/gfortran.dg/gomp/atomic-17.f90
new file mode 100644
index 00000000000..d6864f5a178
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/atomic-17.f90
@@ -0,0 +1,41 @@
+module m
+implicit none
+integer i, v
+real f
+contains
+
+subroutine foo ()
+  !$omp atomic release, hint (0), update
+  i = i + 1
+  !$omp atomic hint(0)seq_cst
+  i = i + 1
+  !$omp atomic relaxed,update,hint (0)
+  i = i + 1
+  !$omp atomic release
+  i = i + 1
+  !$omp atomic relaxed
+  i = i + 1
+  !$omp atomic acq_rel capture
+  i = i + 1; v = i
+  !$omp atomic capture,acq_rel , hint (1)
+  i = i + 1; v = i
+  !$omp atomic hint(0),acquire capture
+  i = i + 1; v = i
+  !$omp atomic read acquire
+  v = i
+  !$omp atomic acq_rel read
+  v = i
+  !$omp atomic release,write
+  i = v
+  !$omp atomic write,acq_rel
+  i = v
+  !$omp atomic hint(1),update,release
+  f = f + 2.0
+  !$omp atomic update ,acquire
+  i = i + 1
+  !$omp atomic acq_rel update
+  i = i + 1
+  !$omp atomic acq_rel,hint(0)
+  i = i + 1
+end
+end module
diff --git a/gcc/testsuite/gfortran.dg/gomp/atomic-18.f90 b/gcc/testsuite/gfortran.dg/gomp/atomic-18.f90
new file mode 100644
index 00000000000..9bc6f637aca
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/atomic-18.f90
@@ -0,0 +1,27 @@
+module m
+implicit none
+integer i, v
+real f
+contains
+subroutine foo (j)
+integer, value :: j
+  !$omp atomic update,update        ! { dg-error "Duplicated atomic clause: unexpected update clause" }
+  i = i + 1
+  !$omp atomic seq_cst release      ! { dg-error "Duplicated memory-order clause: unexpected release clause" }
+  i = i + 1
+  !$omp atomic read,release         ! { dg-error "ATOMIC READ at .1. incompatible with RELEASE clause" }
+  v = i
+  !$omp atomic acquire , write      ! { dg-error "ATOMIC WRITE at .1. incompatible with ACQUIRE clause" }
+  i = v
+  !$omp atomic capture hint (0) capture  ! { dg-error "Duplicated 'capture' clause" }
+  v = i = i + 1
+  !$omp atomic hint(j + 2)      ! { dg-error "Value of HINT clause at .1. shall be a valid constant hint expression" }
+  i = i + 1
+  !$omp atomic hint(f)
+    ! { dg-error "HINT clause at .1. requires a scalar INTEGER expression" "" { target *-*-* } .-1 }
+    ! { dg-error "Value of HINT clause at .1. shall be a valid constant hint expression" "" { target *-*-* } .-2 }
+  i = i + 1
+  !$omp atomic foobar           ! { dg-error "Failed to match clause" }
+  i = i + 1
+end
+end module
diff --git a/gcc/testsuite/gfortran.dg/gomp/atomic-19.f90 b/gcc/testsuite/gfortran.dg/gomp/atomic-19.f90
new file mode 100644
index 00000000000..ade4c940469
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/atomic-19.f90
@@ -0,0 +1,39 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+! { dg-final { scan-tree-dump-times "omp atomic release" 1 "original" } }
+! { dg-final { scan-tree-dump-times "omp atomic relaxed" 3 "original" } }
+! { dg-final { scan-tree-dump-times "omp atomic read relaxed" 1 "original" } }
+! { dg-final { scan-tree-dump-times "omp atomic capture relaxed" 1 "original" } }
+
+module mod
+  implicit none
+  integer i, j, k, l, m, n
+
+contains
+
+subroutine foo ()
+  !$omp atomic release
+  i = i + 1;
+end
+end
+
+module m2
+use mod
+implicit none
+!$omp requires atomic_default_mem_order (relaxed)
+
+contains
+subroutine bar ()
+  integer v;
+  !$omp atomic
+  j = j + 1
+  !$omp atomic update
+  k = k + 1
+  !$omp atomic read
+  v = l
+  !$omp atomic write
+  m = v
+  !$omp atomic capture
+  n = n + 1; v = n
+end
+end module m2
diff --git a/gcc/testsuite/gfortran.dg/gomp/atomic-2.f90 b/gcc/testsuite/gfortran.dg/gomp/atomic-2.f90
index 1de418dcc95..b6c1b6a519e 100644
--- a/gcc/testsuite/gfortran.dg/gomp/atomic-2.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/atomic-2.f90
@@ -3,13 +3,13 @@
 subroutine bar
   integer :: i, v
   real :: f
-  !$omp atomic update acq_rel hint("abc") ! { dg-error "OMP ATOMIC UPDATE at .1. incompatible with ACQ_REL or ACQUIRE clauses" }
+  !$omp atomic update acq_rel hint("abc")
     ! { dg-error "HINT clause at .1. requires a scalar INTEGER expression" "" { target *-*-* } .-1 }
     ! { dg-error "Value of HINT clause at .1. shall be a valid constant hint expression" "" { target *-*-* } .-2 }
     i = i + 1
   !$omp end atomic
 
-  !$omp atomic acq_rel ! { dg-error "OMP ATOMIC UPDATE at .1. incompatible with ACQ_REL or ACQUIRE clauses" }
+  !$omp atomic acq_rel
   i = i + 1
   !$omp end atomic
 
@@ -18,7 +18,7 @@ subroutine bar
   v = i
   !$omp end atomic
 
-  !$omp atomic acq_rel , hint (1), update ! { dg-error "OMP ATOMIC UPDATE at .1. incompatible with ACQ_REL or ACQUIRE clauses" }
+  !$omp atomic acq_rel , hint (1), update
   i = i + 1
   !$omp end atomic
 
@@ -27,44 +27,10 @@ subroutine bar
   v = i
   !$omp end atomic
 
-  !$omp atomic write capture ! { dg-error "multiple atomic clauses" }
+  !$omp atomic write capture ! { dg-error "with CAPTURE clause is incompatible with READ or WRITE" }
   i = 2
   v = i
   !$omp end atomic
 
   !$omp atomic foobar ! { dg-error "Failed to match clause" }
 end
-
-! moved here from atomic.f90
-subroutine openmp51_foo
-  integer :: x, v
-  !$omp atomic update seq_cst capture  ! { dg-error "multiple atomic clauses" }
-  x = x + 2
-  v = x
-  !$omp end atomic
-  !$omp atomic seq_cst, capture, update  ! { dg-error "multiple atomic clauses" }
-  x = x + 2
-  v = x
-  !$omp end atomic
-  !$omp atomic capture, seq_cst ,update  ! { dg-error "multiple atomic clauses" }
-  x = x + 2
-  v = x
-  !$omp end atomic
-end
-
-subroutine openmp51_bar
-  integer :: i, v
-  real :: f
-  !$omp atomic relaxed capture update  ! { dg-error "multiple atomic clauses" }
-  i = i + 1
-  v = i
-  !$omp end atomic
-  !$omp atomic update capture,release , hint (1)  ! { dg-error "multiple atomic clauses" }
-  i = i + 1
-  v = i
-  !$omp end atomic
-  !$omp atomic hint(0),update relaxed capture  ! { dg-error "multiple atomic clauses" }
-  i = i + 1
-  v = i
-  !$omp end atomic
-end
diff --git a/gcc/testsuite/gfortran.dg/gomp/atomic-20.f90 b/gcc/testsuite/gfortran.dg/gomp/atomic-20.f90
new file mode 100644
index 00000000000..29193e17ddd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/atomic-20.f90
@@ -0,0 +1,39 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+! { dg-final { scan-tree-dump-times "omp atomic release" 1 "original" } }
+! { dg-final { scan-tree-dump-times "omp atomic seq_cst" 3 "original" } }
+! { dg-final { scan-tree-dump-times "omp atomic read seq_cst" 1 "original" } }
+! { dg-final { scan-tree-dump-times "omp atomic capture seq_cst" 1 "original" } }
+
+module mod
+implicit none
+integer i, j, k, l, m, n
+
+contains 
+subroutine foo ()
+  !$omp atomic release
+  i = i + 1
+end
+end module
+
+module m2
+use mod
+implicit none
+!$omp requires atomic_default_mem_order (seq_cst)
+
+contains
+
+subroutine bar ()
+  integer v
+  !$omp atomic
+  j = j + 1
+  !$omp atomic update
+  k = k + 1
+  !$omp atomic read
+  v = l
+  !$omp atomic write
+  m = v
+  !$omp atomic capture
+  n = n + 1; v = n
+end
+end module
diff --git a/gcc/testsuite/gfortran.dg/gomp/atomic-22.f90 b/gcc/testsuite/gfortran.dg/gomp/atomic-22.f90
new file mode 100644
index 00000000000..584c0d39723
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/atomic-22.f90
@@ -0,0 +1,24 @@
+module mod
+integer i, j
+
+contains
+subroutine foo ()
+  integer v
+  !$omp atomic release
+  i = i + 1
+  !$omp atomic read
+  v = j
+end
+end module
+
+module m2
+!$omp requires atomic_default_mem_order (acq_rel)	! OK
+contains
+subroutine bar
+  !$omp atomic release
+  i = i + 1
+!$omp requires atomic_default_mem_order (acq_rel)	! { dg-error "must appear in the specification part of a program unit" }
+  !$omp atomic read
+  v = j
+end subroutine
+end module m2
diff --git a/gcc/testsuite/gfortran.dg/gomp/atomic-24.f90 b/gcc/testsuite/gfortran.dg/gomp/atomic-24.f90
new file mode 100644
index 00000000000..ba105c232ab
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/atomic-24.f90
@@ -0,0 +1,13 @@
+! PR c/101297
+
+module m
+implicit none
+integer :: i
+contains
+subroutine foo ()
+  !$omp atomic update,	! { dg-error "Clause expected at .1. after tailing comma" }
+  i = i + 1
+  !$omp atomic update,,	! { dg-error "Failed to match clause" }
+  i = i + 1
+end
+end module
diff --git a/gcc/testsuite/gfortran.dg/gomp/atomic-25.f90 b/gcc/testsuite/gfortran.dg/gomp/atomic-25.f90
new file mode 100644
index 00000000000..598ff4e54db
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/atomic-25.f90
@@ -0,0 +1,53 @@
+! { dg-do compile }
+
+module m
+use iso_fortran_env
+implicit none
+integer, parameter :: mrk = maxval(real_kinds)
+integer x, r, z
+real(kind(4.0d0)) d, v
+real(mrk) ld
+
+contains
+subroutine foo (y, e, f)
+  integer :: y
+  real(kind(4.0d0)) :: e
+  real(mrk) :: f
+  !$omp atomic update seq_cst fail(acquire)
+  x = min(x, y)
+  !$omp atomic relaxed fail(relaxed)
+  d = max (e, d)
+  !$omp atomic fail(SEQ_CST)
+  d = min (d, f)
+  !$omp atomic seq_cst compare fail(relaxed)  ! { dg-error "Sorry, COMPARE clause in ATOMIC at .1. is not yet supported" }
+  if (x == 7) x = 24
+  !$omp atomic compare  ! { dg-error "Sorry, COMPARE clause in ATOMIC at .1. is not yet supported" }
+  if (x == 7) x = 24
+  !$omp atomic compare  ! { dg-error "Sorry, COMPARE clause in ATOMIC at .1. is not yet supported" }
+  if (x == 123) x = 256
+  !$omp atomic compare  ! { dg-error "Sorry, COMPARE clause in ATOMIC at .1. is not yet supported" }
+  if (ld == f)  ld = f + 5.0_mrk
+  !$omp atomic compare  ! { dg-error "Sorry, COMPARE clause in ATOMIC at .1. is not yet supported" }
+  if (x == 9) then
+    x = 5
+  endif
+  !$omp atomic compare update capture seq_cst fail(acquire)  ! { dg-error "Sorry, COMPARE clause in ATOMIC at .1. is not yet supported" }
+  if (x == 42) then
+    x = f
+  else
+    v = x
+  endif
+  !$omp atomic capture compare weak  ! { dg-error "Sorry, COMPARE clause in ATOMIC at .1. is not yet supported" }
+  if (x == 42) then
+    x = f
+  else
+    v = x
+  endif
+  !$omp atomic capture compare fail(seq_cst)  ! { dg-error "Sorry, COMPARE clause in ATOMIC at .1. is not yet supported" }
+  if (d == 8.0) then
+    d = 16.0
+  else
+    v = d
+  end if
+end
+end module
diff --git a/gcc/testsuite/gfortran.dg/gomp/atomic-26.f90 b/gcc/testsuite/gfortran.dg/gomp/atomic-26.f90
new file mode 100644
index 00000000000..5f21d3b6f92
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/atomic-26.f90
@@ -0,0 +1,75 @@
+! { dg-do compile }
+
+module m
+implicit none
+integer x
+real d
+
+contains
+
+real function foo (y, e, f)
+  integer :: y
+  real v, e
+  real(8) :: f
+  !$omp atomic compare compare	! { dg-error "Duplicated 'compare' clause" }
+  if (x == y) x = d
+  !$omp atomic compare fail(seq_cst) fail(seq_cst)	! { dg-error "Duplicated 'fail' clause" }
+  if (x == y) x = d
+  !$omp atomic compare,fail(seq_cst),fail(relaxed)	! { dg-error "Duplicated 'fail' clause" }
+  if (x == y) x = d
+  !$omp atomic compare weak weak	! { dg-error "Duplicated 'weak' clause" }
+  if (x == y) x = d
+  !$omp atomic read capture	! { dg-error "CAPTURE clause is incompatible with READ or WRITE" }
+  v = d
+  !$omp atomic capture, write	! { dg-error "CAPTURE clause is incompatible with READ or WRITE" }
+  d = v; v = v + 1              ! { dg-error "Unexpected ..OMP ATOMIC statement" "" { target *-*-* } .-1 }
+  foo = v
+end
+
+real function bar (y, e, f)
+  integer :: y
+  real v, e
+  real(8) :: f
+  !$omp atomic read compare	! { dg-error "COMPARE clause is incompatible with READ or WRITE" }
+  if (x == y) x = d
+  !$omp atomic compare, write	! { dg-error "COMPARE clause is incompatible with READ or WRITE" }
+  if (x == y) x = d
+  !$omp atomic read fail(seq_cst)	! { dg-error "FAIL clause is incompatible with READ or WRITE" }
+  v = d
+  !$omp atomic fail(relaxed), write	! { dg-error "FAIL clause is incompatible with READ or WRITE" }
+  d = v
+  !$omp atomic fail(relaxed) update	! { dg-error "FAIL clause requiries either the COMPARE clause or using the intrinsic MIN/MAX procedure" }
+  d = d + 3.0
+  !$omp atomic fail(relaxed)	! { dg-error "FAIL clause requiries either the COMPARE clause or using the intrinsic MIN/MAX procedure" }
+  d = d + 3.0
+  !$omp atomic capture fail(relaxed)	! { dg-error "FAIL clause requiries either the COMPARE clause or using the intrinsic MIN/MAX procedure" }
+  v = d; d = d + 3.0
+  !$omp atomic read weak		! { dg-error "WEAK clause requires COMPARE clause" }
+  v = d
+  !$omp atomic weak, write	! { dg-error "WEAK clause requires COMPARE clause" }
+  d = v
+  !$omp atomic weak update	! { dg-error "WEAK clause requires COMPARE clause" }
+  d = d + 3.0
+  !$omp atomic weak		! { dg-error "WEAK clause requires COMPARE clause" }
+  d = d + 3.0
+  !$omp atomic capture weak	! { dg-error "WEAK clause requires COMPARE clause" }
+  d = d + 3.0; v = d
+  !$omp atomic capture
+  d = d + 3.0; v = x            ! { dg-error "capture statement reads from different variable than update statement writes" }
+  !$omp atomic compare fail	! { dg-error "Expected '\\\(' after 'fail'" }
+  if (x == y) x = d
+  !$omp atomic compare fail(	! { dg-error "Expected SEQ_CST, ACQUIRE or RELAXED" }
+  if (x == y) x = d             ! { dg-error "Sorry, COMPARE clause in ATOMIC at .1. is not yet supported" "" { target *-*-* } .-1 }
+  !$omp atomic compare fail()	! { dg-error "Expected SEQ_CST, ACQUIRE or RELAXED" }
+  if (x == y) x = d
+  !$omp atomic compare fail(foobar)	! { dg-error "Expected SEQ_CST, ACQUIRE or RELAXED" }
+  if (x == y) x = d
+  !$omp atomic compare fail(acq_rel)	! { dg-error "Expected SEQ_CST, ACQUIRE or RELAXED" }
+  if (x == y) x = d
+  !$omp atomic compare fail(release)	! { dg-error "Expected SEQ_CST, ACQUIRE or RELAXED" }
+  if (x == y) x = d
+  !$omp atomic compare fail(seq_cst	! { dg-error "Failed to match clause" }
+  if (x == y) x = d
+  bar = v
+end
+end module
diff --git a/gcc/testsuite/gfortran.dg/gomp/atomic.f90 b/gcc/testsuite/gfortran.dg/gomp/atomic.f90
index b4caf03952d..ca127965570 100644
--- a/gcc/testsuite/gfortran.dg/gomp/atomic.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/atomic.f90
@@ -3,14 +3,13 @@
 
 ! { dg-final { scan-tree-dump-times "#pragma omp atomic relaxed" 4 "original" } }
 ! { dg-final { scan-tree-dump-times "#pragma omp atomic release" 4 "original" } }
-! { dg-final { scan-tree-dump-times "v = #pragma omp atomic capture relaxed" 2 "original" } }
-! { dg-final { scan-tree-dump-times "v = #pragma omp atomic capture release" 1 "original" } }
+! { dg-final { scan-tree-dump-times "v = #pragma omp atomic capture relaxed" 4 "original" } }
+! { dg-final { scan-tree-dump-times "v = #pragma omp atomic capture release" 2 "original" } }
 ! { dg-final { scan-tree-dump-times "v = #pragma omp atomic read acquire" 1 "original" } }
 
 ! { dg-final { scan-tree-dump-times "#pragma omp atomic seq_cst" 7 "original" } }
 ! { dg-final { scan-tree-dump-times "v = #pragma omp atomic read seq_cst" 3 "original" } }
-! { dg-final { scan-tree-dump-times "v = #pragma omp atomic capture seq_cst" 3 "original" } }
-
+! { dg-final { scan-tree-dump-times "v = #pragma omp atomic capture seq_cst" 6 "original" } }
 
 subroutine foo ()
   integer :: x, v
@@ -85,3 +84,36 @@ subroutine bar
   !$omp atomic hint(1),update,release
   f = f + 2.0
 end
+
+subroutine openmp51_foo
+  integer :: x, v
+  !$omp atomic update seq_cst capture
+  x = x + 2
+  v = x
+  !$omp end atomic
+  !$omp atomic seq_cst, capture, update
+  x = x + 2
+  v = x
+  !$omp end atomic
+  !$omp atomic capture, seq_cst ,update
+  x = x + 2
+  v = x
+  !$omp end atomic
+end
+
+subroutine openmp51_bar
+  integer :: i, v
+  real :: f
+  !$omp atomic relaxed capture update
+  i = i + 1
+  v = i
+  !$omp end atomic
+  !$omp atomic update capture,release , hint (1)
+  i = i + 1
+  v = i
+  !$omp end atomic
+  !$omp atomic hint(0),update relaxed capture
+  i = i + 1
+  v = i
+  !$omp end atomic
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/atomic2.f90 b/gcc/testsuite/gfortran.dg/gomp/atomic2.f90
new file mode 100644
index 00000000000..e69de29bb2d
diff --git a/libgomp/libgomp.texi b/libgomp/libgomp.texi
index fd747b91192..37dd88fe6ba 100644
--- a/libgomp/libgomp.texi
+++ b/libgomp/libgomp.texi
@@ -301,7 +301,8 @@ The OpenMP 4.5 specification is fully supported.
 @item @code{interop} directive @tab N @tab
 @item @code{omp_interop_t} object support in runtime routines @tab N @tab
 @item @code{nowait} clause in @code{taskwait} directive @tab N @tab
-@item Extensions to the @code{atomic} directive @tab P @tab C/C++ only
+@item Extensions to the @code{atomic} directive @tab P
+      @tab @code{compare} unsupported in Fortran
 @item @code{seq_cst} clause on a @code{flush} construct @tab Y @tab
 @item @code{inoutset} argument to the @code{depend} clause @tab N @tab
 @item @code{private} and @code{firstprivate} argument to @code{default}
