diff --git a/gcc/c-family/c-omp.c b/gcc/c-family/c-omp.c
index b9024cb15a9..af9eba8d008 100644
--- a/gcc/c-family/c-omp.c
+++ b/gcc/c-family/c-omp.c
@@ -2911,143 +2911,6 @@ c_omp_predetermined_mapping (tree decl)
 }
 
 
-/* Diagnose errors in an OpenMP context selector, return CTX if
-   it is correct or error_mark_node otherwise.  */
-
-tree
-c_omp_check_context_selector (location_t loc, tree ctx)
-{
-  /* Each trait-set-selector-name can only be specified once.
-     There are just 4 set names.  */
-  for (tree t1 = ctx; t1; t1 = TREE_CHAIN (t1))
-    for (tree t2 = TREE_CHAIN (t1); t2; t2 = TREE_CHAIN (t2))
-      if (TREE_PURPOSE (t1) == TREE_PURPOSE (t2))
-	{
-	  error_at (loc, "selector set %qs specified more than once",
-	  	    IDENTIFIER_POINTER (TREE_PURPOSE (t1)));
-	  return error_mark_node;
-	}
-  for (tree t = ctx; t; t = TREE_CHAIN (t))
-    {
-      /* Each trait-selector-name can only be specified once.  */
-      if (list_length (TREE_VALUE (t)) < 5)
-	{
-	  for (tree t1 = TREE_VALUE (t); t1; t1 = TREE_CHAIN (t1))
-	    for (tree t2 = TREE_CHAIN (t1); t2; t2 = TREE_CHAIN (t2))
-	      if (TREE_PURPOSE (t1) == TREE_PURPOSE (t2))
-		{
-		  error_at (loc,
-			    "selector %qs specified more than once in set %qs",
-			    IDENTIFIER_POINTER (TREE_PURPOSE (t1)),
-			    IDENTIFIER_POINTER (TREE_PURPOSE (t)));
-		  return error_mark_node;
-		}
-	}
-      else
-	{
-	  hash_set<tree> pset;
-	  for (tree t1 = TREE_VALUE (t); t1; t1 = TREE_CHAIN (t1))
-	    if (pset.add (TREE_PURPOSE (t1)))
-	      {
-		error_at (loc,
-			  "selector %qs specified more than once in set %qs",
-			  IDENTIFIER_POINTER (TREE_PURPOSE (t1)),
-			  IDENTIFIER_POINTER (TREE_PURPOSE (t)));
-		return error_mark_node;
-	      }
-	}
-
-      static const char *const kind[] = {
-	"host", "nohost", "cpu", "gpu", "fpga", "any", NULL };
-      static const char *const vendor[] = {
-	"amd", "arm", "bsc", "cray", "fujitsu", "gnu", "ibm", "intel",
-	"llvm", "nvidia", "pgi", "ti", "unknown", NULL };
-      static const char *const extension[] = { NULL };
-      static const char *const atomic_default_mem_order[] = {
-	"seq_cst", "relaxed", "acq_rel", NULL };
-      struct known_properties { const char *set; const char *selector;
-				const char *const *props; };
-      known_properties props[] = {
-	{ "device", "kind", kind },
-	{ "implementation", "vendor", vendor },
-	{ "implementation", "extension", extension },
-	{ "implementation", "atomic_default_mem_order",
-	  atomic_default_mem_order } };
-      for (tree t1 = TREE_VALUE (t); t1; t1 = TREE_CHAIN (t1))
-	for (unsigned i = 0; i < ARRAY_SIZE (props); i++)
-	  if (!strcmp (IDENTIFIER_POINTER (TREE_PURPOSE (t1)),
-					   props[i].selector)
-	      && !strcmp (IDENTIFIER_POINTER (TREE_PURPOSE (t)),
-					      props[i].set))
-	    for (tree t2 = TREE_VALUE (t1); t2; t2 = TREE_CHAIN (t2))
-	      for (unsigned j = 0; ; j++)
-		{
-		  if (props[i].props[j] == NULL)
-		    {
-		      if (TREE_PURPOSE (t2)
-			  && !strcmp (IDENTIFIER_POINTER (TREE_PURPOSE (t2)),
-				      " score"))
-			break;
-		      if (props[i].props == atomic_default_mem_order)
-			{
-			  error_at (loc,
-				    "incorrect property %qs of %qs selector",
-				    IDENTIFIER_POINTER (TREE_PURPOSE (t2)),
-				    "atomic_default_mem_order");
-			  return error_mark_node;
-			}
-		      else if (TREE_PURPOSE (t2))
-			warning_at (loc, 0,
-				    "unknown property %qs of %qs selector",
-				    IDENTIFIER_POINTER (TREE_PURPOSE (t2)),
-				    props[i].selector);
-		      else
-			warning_at (loc, 0,
-				    "unknown property %qE of %qs selector",
-				    TREE_VALUE (t2), props[i].selector);
-		      break;
-		    }
-		  else if (TREE_PURPOSE (t2) == NULL_TREE)
-		    {
-		      const char *str = TREE_STRING_POINTER (TREE_VALUE (t2));
-		      if (!strcmp (str, props[i].props[j])
-			  && ((size_t) TREE_STRING_LENGTH (TREE_VALUE (t2))
-			      == strlen (str) + 1))
-			break;
-		    }
-		  else if (!strcmp (IDENTIFIER_POINTER (TREE_PURPOSE (t2)),
-				    props[i].props[j]))
-		    break;
-		}
-    }
-  return ctx;
-}
-
-/* Register VARIANT as variant of some base function marked with
-   #pragma omp declare variant.  CONSTRUCT is corresponding construct
-   selector set.  */
-
-void
-c_omp_mark_declare_variant (location_t loc, tree variant, tree construct)
-{
-  tree attr = lookup_attribute ("omp declare variant variant",
-				DECL_ATTRIBUTES (variant));
-  if (attr == NULL_TREE)
-    {
-      attr = tree_cons (get_identifier ("omp declare variant variant"),
-			unshare_expr (construct),
-			DECL_ATTRIBUTES (variant));
-      DECL_ATTRIBUTES (variant) = attr;
-      return;
-    }
-  if ((TREE_VALUE (attr) != NULL_TREE) != (construct != NULL_TREE)
-      || (construct != NULL_TREE
-	  && omp_context_selector_set_compare ("construct", TREE_VALUE (attr),
-					       construct)))
-    error_at (loc, "%qD used as a variant with incompatible %<construct%> "
-		   "selector sets", variant);
-}
-
 /* For OpenACC, the OMP_CLAUSE_MAP_KIND of an OMP_CLAUSE_MAP is used internally
    to distinguish clauses as seen by the user.  Return the "friendly" clause
    name for error messages etc., where possible.  See also
diff --git a/gcc/c/c-parser.c b/gcc/c/c-parser.c
index 869a811ed90..80dd61d599e 100644
--- a/gcc/c/c-parser.c
+++ b/gcc/c/c-parser.c
@@ -21694,7 +21694,7 @@ c_finish_omp_declare_variant (c_parser *parser, tree fndecl, tree parms)
   tree ctx = c_parser_omp_context_selector_specification (parser, parms);
   if (ctx == error_mark_node)
     goto fail;
-  ctx = c_omp_check_context_selector (match_loc, ctx);
+  ctx = omp_check_context_selector (match_loc, ctx);
   if (ctx != error_mark_node && variant != error_mark_node)
     {
       if (TREE_CODE (variant) != FUNCTION_DECL)
@@ -21724,7 +21724,7 @@ c_finish_omp_declare_variant (c_parser *parser, tree fndecl, tree parms)
 	{
 	  C_DECL_USED (variant) = 1;
 	  tree construct = omp_get_context_selector (ctx, "construct", NULL);
-	  c_omp_mark_declare_variant (match_loc, variant, construct);
+	  omp_mark_declare_variant (match_loc, variant, construct);
 	  if (omp_context_selector_matches (ctx))
 	    {
 	      tree attr
diff --git a/gcc/cp/decl.c b/gcc/cp/decl.c
index 561debe6a0e..242429d9ef4 100644
--- a/gcc/cp/decl.c
+++ b/gcc/cp/decl.c
@@ -7768,7 +7768,7 @@ omp_declare_variant_finalize_one (tree decl, tree attr)
       else
 	{
 	  tree construct = omp_get_context_selector (ctx, "construct", NULL);
-	  c_omp_mark_declare_variant (match_loc, variant, construct);
+	  omp_mark_declare_variant (match_loc, variant, construct);
 	  if (!omp_context_selector_matches (ctx))
 	    return true;
 	  TREE_PURPOSE (TREE_VALUE (attr)) = variant;
diff --git a/gcc/cp/parser.c b/gcc/cp/parser.c
index 0818d66be07..865778e4d30 100644
--- a/gcc/cp/parser.c
+++ b/gcc/cp/parser.c
@@ -45319,7 +45319,7 @@ cp_finish_omp_declare_variant (cp_parser *parser, cp_token *pragma_tok,
   tree ctx = cp_parser_omp_context_selector_specification (parser, true);
   if (ctx == error_mark_node)
     goto fail;
-  ctx = c_omp_check_context_selector (match_loc, ctx);
+  ctx = omp_check_context_selector (match_loc, ctx);
   if (ctx != error_mark_node && variant != error_mark_node)
     {
       tree match_loc_node = maybe_wrap_with_location (integer_zero_node,
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index b2b0254a3c3..5b9f89748d2 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -239,7 +239,7 @@ enum gfc_statement
   ST_OMP_DO_SIMD, ST_OMP_END_DO_SIMD, ST_OMP_PARALLEL_DO_SIMD,
   ST_OMP_END_PARALLEL_DO_SIMD, ST_OMP_DECLARE_SIMD, ST_OMP_DECLARE_REDUCTION,
   ST_OMP_TARGET, ST_OMP_END_TARGET, ST_OMP_TARGET_DATA, ST_OMP_END_TARGET_DATA,
-  ST_OMP_TARGET_UPDATE, ST_OMP_DECLARE_TARGET,
+  ST_OMP_TARGET_UPDATE, ST_OMP_DECLARE_TARGET, ST_OMP_DECLARE_VARIANT,
   ST_OMP_TEAMS, ST_OMP_END_TEAMS, ST_OMP_DISTRIBUTE, ST_OMP_END_DISTRIBUTE,
   ST_OMP_DISTRIBUTE_SIMD, ST_OMP_END_DISTRIBUTE_SIMD,
   ST_OMP_DISTRIBUTE_PARALLEL_DO, ST_OMP_END_DISTRIBUTE_PARALLEL_DO,
@@ -1553,6 +1553,73 @@ typedef struct gfc_omp_declare_simd
 gfc_omp_declare_simd;
 #define gfc_get_omp_declare_simd() XCNEW (gfc_omp_declare_simd)
 
+
+enum gfc_omp_trait_property_kind
+{
+  CTX_PROPERTY_NONE,
+  CTX_PROPERTY_USER,
+  CTX_PROPERTY_NAME_LIST,
+  CTX_PROPERTY_ID,
+  CTX_PROPERTY_EXPR,
+  CTX_PROPERTY_SIMD
+};
+
+typedef struct gfc_omp_trait_property
+{
+  struct gfc_omp_trait_property *next;
+  enum gfc_omp_trait_property_kind property_kind;
+  bool is_name : 1;
+
+  union
+    {
+      gfc_expr *expr;
+      gfc_symbol *sym;
+      gfc_omp_clauses *clauses;
+      char *name;
+    };
+} gfc_omp_trait_property;
+#define gfc_get_omp_trait_property() XCNEW (gfc_omp_trait_property)
+
+typedef struct gfc_omp_selector
+{
+  struct gfc_omp_selector *next;
+
+  char *trait_selector_name;
+  gfc_expr *score;
+  struct gfc_omp_trait_property *properties;
+} gfc_omp_selector;
+#define gfc_get_omp_selector() XCNEW (gfc_omp_selector)
+
+typedef struct gfc_omp_set_selector
+{
+  struct gfc_omp_set_selector *next;
+
+  const char *trait_set_selector_name;
+  struct gfc_omp_selector *trait_selectors;
+} gfc_omp_set_selector;
+#define gfc_get_omp_set_selector() XCNEW (gfc_omp_set_selector)
+
+
+/* Node in the linked list used for storing !$omp declare variant
+   constructs.  */
+
+typedef struct gfc_omp_declare_variant
+{
+  struct gfc_omp_declare_variant *next;
+  locus where; /* Where the !$omp declare variant construct occurred.  */
+
+  struct gfc_symtree *base_proc_symtree;
+  struct gfc_symtree *variant_proc_symtree;
+
+  gfc_omp_set_selector *set_selectors;
+
+  bool checked_p : 1; /* Set if previously checked for errors.  */
+  bool error_p : 1; /* Set if error found in directive.  */
+}
+gfc_omp_declare_variant;
+#define gfc_get_omp_declare_variant() XCNEW (gfc_omp_declare_variant)
+
+
 typedef struct gfc_omp_udr
 {
   struct gfc_omp_udr *next;
@@ -2022,6 +2089,9 @@ typedef struct gfc_namespace
   /* Linked list of !$omp declare simd constructs.  */
   struct gfc_omp_declare_simd *omp_declare_simd;
 
+  /* Linked list of !$omp declare variant constructs.  */
+  struct gfc_omp_declare_variant *omp_declare_variant;
+
   /* A hash set for the the gfc expressions that have already
      been finalized in this namespace.  */
 
@@ -3422,6 +3492,7 @@ bool gfc_omp_requires_add_clause (gfc_omp_requires_kind, const char *,
 void gfc_check_omp_requires (gfc_namespace *, int);
 void gfc_free_omp_clauses (gfc_omp_clauses *);
 void gfc_free_oacc_declare_clauses (struct gfc_oacc_declare *);
+void gfc_free_omp_declare_variant_list (gfc_omp_declare_variant *list);
 void gfc_free_omp_declare_simd (gfc_omp_declare_simd *);
 void gfc_free_omp_declare_simd_list (gfc_omp_declare_simd *);
 void gfc_free_omp_udr (gfc_omp_udr *);
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index 92fd127a57f..21e94f79d95 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -160,6 +160,7 @@ match gfc_match_omp_critical (void);
 match gfc_match_omp_declare_reduction (void);
 match gfc_match_omp_declare_simd (void);
 match gfc_match_omp_declare_target (void);
+match gfc_match_omp_declare_variant (void);
 match gfc_match_omp_depobj (void);
 match gfc_match_omp_distribute (void);
 match gfc_match_omp_distribute_parallel_do (void);
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 6a4ca2868f8..2a161f3304c 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -168,6 +168,70 @@ gfc_free_omp_declare_simd_list (gfc_omp_declare_simd *list)
     }
 }
 
+static void
+gfc_free_omp_trait_property_list (gfc_omp_trait_property *list)
+{
+  while (list)
+    {
+      gfc_omp_trait_property *current = list;
+      list = list->next;
+      switch (current->property_kind)
+	{
+	case CTX_PROPERTY_ID:
+	  free (current->name);
+	  break;
+	case CTX_PROPERTY_NAME_LIST:
+	  if (current->is_name)
+	    free (current->name);
+	  break;
+	case CTX_PROPERTY_SIMD:
+	  gfc_free_omp_clauses (current->clauses);
+	  break;
+	default:
+	  break;
+	}
+      free (current);
+    }
+}
+
+static void
+gfc_free_omp_selector_list (gfc_omp_selector *list)
+{
+  while (list)
+    {
+      gfc_omp_selector *current = list;
+      list = list->next;
+      gfc_free_omp_trait_property_list (current->properties);
+      free (current);
+    }
+}
+
+static void
+gfc_free_omp_set_selector_list (gfc_omp_set_selector *list)
+{
+  while (list)
+    {
+      gfc_omp_set_selector *current = list;
+      list = list->next;
+      gfc_free_omp_selector_list (current->trait_selectors);
+      free (current);
+    }
+}
+
+/* Free an !$omp declare variant construct list.  */
+
+void
+gfc_free_omp_declare_variant_list (gfc_omp_declare_variant *list)
+{
+  while (list)
+    {
+      gfc_omp_declare_variant *current = list;
+      list = list->next;
+      gfc_free_omp_set_selector_list (current->set_selectors);
+      free (current);
+    }
+}
+
 /* Free an !$omp declare reduction.  */
 
 void
@@ -1353,7 +1417,7 @@ gfc_match_dupl_atomic (bool not_dupl, const char *name)
 static match
 gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 		       bool first = true, bool needs_space = true,
-		       bool openacc = false)
+		       bool openacc = false, bool context_selector = false)
 {
   bool error = false;
   gfc_omp_clauses *c = gfc_get_omp_clauses ();
@@ -2843,7 +2907,9 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
     }
 
 end:
-  if (error || gfc_match_omp_eos () != MATCH_YES)
+  if (error
+      || (context_selector && gfc_peek_ascii_char () != ')')
+      || (!context_selector && gfc_match_omp_eos () != MATCH_YES))
     {
       if (!gfc_error_flag_test ())
 	gfc_error ("Failed to match clause at %C");
@@ -4429,6 +4495,449 @@ cleanup:
 }
 
 
+static const char *const omp_construct_selectors[] = {
+  "simd", "target", "teams", "parallel", "do", NULL };
+static const char *const omp_device_selectors[] = {
+  "kind", "isa", "arch", NULL };
+static const char *const omp_implementation_selectors[] = {
+  "vendor", "extension", "atomic_default_mem_order", "unified_address",
+  "unified_shared_memory", "dynamic_allocators", "reverse_offload", NULL };
+static const char *const omp_user_selectors[] = {
+  "condition", NULL };
+
+
+/* OpenMP 5.0:
+
+   trait-selector:
+     trait-selector-name[([trait-score:]trait-property[,trait-property[,...]])]
+
+   trait-score:
+     score(score-expression)  */
+
+match
+gfc_match_omp_context_selector (gfc_omp_set_selector *oss)
+{
+  do
+    {
+      char selector[GFC_MAX_SYMBOL_LEN + 1];
+
+      if (gfc_match_name (selector) != MATCH_YES)
+	{
+	  gfc_error ("expected trait selector name at %C");
+	  return MATCH_ERROR;
+	}
+
+      gfc_omp_selector *os = gfc_get_omp_selector ();
+      os->trait_selector_name = XNEWVEC (char, strlen (selector) + 1);
+      strcpy (os->trait_selector_name, selector);
+      os->next = oss->trait_selectors;
+      oss->trait_selectors = os;
+
+      const char *const *selectors = NULL;
+      bool allow_score = true;
+      bool allow_user = false;
+      int property_limit = 0;
+      enum gfc_omp_trait_property_kind property_kind = CTX_PROPERTY_NONE;
+      switch (oss->trait_set_selector_name[0])
+	{
+	case 'c': /* construct */
+	  selectors = omp_construct_selectors;
+	  allow_score = false;
+	  property_limit = 1;
+	  property_kind = CTX_PROPERTY_SIMD;
+	  break;
+	case 'd': /* device */
+	  selectors = omp_device_selectors;
+	  allow_score = false;
+	  allow_user = true;
+	  property_limit = 3;
+	  property_kind = CTX_PROPERTY_NAME_LIST;
+	  break;
+	case 'i': /* implementation */
+	  selectors = omp_implementation_selectors;
+	  allow_user = true;
+	  property_limit = 3;
+	  property_kind = CTX_PROPERTY_NAME_LIST;
+	  break;
+	case 'u': /* user */
+	  selectors = omp_user_selectors;
+	  property_limit = 1;
+	  property_kind = CTX_PROPERTY_EXPR;
+	  break;
+	default:
+	  gcc_unreachable ();
+	}
+      for (int i = 0; ; i++)
+	{
+	  if (selectors[i] == NULL)
+	    {
+	      if (allow_user)
+		{
+		  property_kind = CTX_PROPERTY_USER;
+		  break;
+		}
+	      else
+		{
+		  gfc_error ("selector '%s' not allowed for context selector "
+			     "set '%s' at %C",
+			     selector, oss->trait_set_selector_name);
+		  return MATCH_ERROR;
+		}
+	    }
+	  if (i == property_limit)
+	    property_kind = CTX_PROPERTY_NONE;
+	  if (strcmp (selectors[i], selector) == 0)
+	    break;
+	}
+      if (property_kind == CTX_PROPERTY_NAME_LIST
+	  && oss->trait_set_selector_name[0] == 'i'
+	  && strcmp (selector, "atomic_default_mem_order") == 0)
+	property_kind = CTX_PROPERTY_ID;
+
+      if (gfc_match (" (") == MATCH_YES)
+	{
+	  if (property_kind == CTX_PROPERTY_NONE)
+	    {
+	      gfc_error ("selector '%s' does not accept any properties at %C",
+			 selector);
+	      return MATCH_ERROR;
+	    }
+
+	  if (allow_score && gfc_match (" score") == MATCH_YES)
+	    {
+	      if (gfc_match (" (") != MATCH_YES)
+		{
+		  gfc_error ("expected '(' at %C");
+		  return MATCH_ERROR;
+		}
+	      if (gfc_match_expr (&os->score) != MATCH_YES
+		  || !gfc_resolve_expr (os->score)
+		  || os->score->ts.type != BT_INTEGER
+		  || os->score->rank != 0)
+		{
+		  gfc_error ("score argument must be constant integer "
+			     "expression at %C");
+		  return MATCH_ERROR;
+		}
+
+	      if (os->score->expr_type == EXPR_CONSTANT
+		  && mpz_sgn (os->score->value.integer) < 0)
+		{
+		  gfc_error ("score argument must be non-negative at %C");
+		  return MATCH_ERROR;
+		}
+
+	      if (gfc_match (" )") != MATCH_YES)
+		{
+		  gfc_error ("expected ')' at %C");
+		  return MATCH_ERROR;
+		}
+
+	      if (gfc_match (" :") != MATCH_YES)
+		{
+		  gfc_error ("expected : at %C");
+		  return MATCH_ERROR;
+		}
+	    }
+
+	  gfc_omp_trait_property *otp = gfc_get_omp_trait_property ();
+	  otp->property_kind = property_kind;
+	  otp->next = os->properties;
+	  os->properties = otp;
+
+	  switch (property_kind)
+	    {
+	    case CTX_PROPERTY_USER:
+	      do
+		{
+		  if (gfc_match_expr (&otp->expr) != MATCH_YES)
+		    {
+		      gfc_error ("property must be constant integer "
+				 "expression or string literal at %C");
+		      return MATCH_ERROR;
+		    }
+
+		  if (gfc_match (" ,") != MATCH_YES)
+		    break;
+		}
+	      while (1);
+	      break;
+	    case CTX_PROPERTY_ID:
+	      {
+		char buf[GFC_MAX_SYMBOL_LEN + 1];
+		if (gfc_match_name (buf) == MATCH_YES)
+		  {
+		    otp->name = XNEWVEC (char, strlen (buf) + 1);
+		    strcpy (otp->name, buf);
+		  }
+		else
+		  {
+		    gfc_error ("expected identifier at %C");
+		    return MATCH_ERROR;
+		  }
+	      }
+	      break;
+	    case CTX_PROPERTY_NAME_LIST:
+	      do
+		{
+		  char buf[GFC_MAX_SYMBOL_LEN + 1];
+		  if (gfc_match_name (buf) == MATCH_YES)
+		    {
+		      otp->name = XNEWVEC (char, strlen (buf) + 1);
+		      strcpy (otp->name, buf);
+		      otp->is_name = true;
+		    }
+		  else if (gfc_match_literal_constant (&otp->expr, 0)
+			   != MATCH_YES
+			   || otp->expr->ts.type != BT_CHARACTER)
+		    {
+		      gfc_error ("expected identifier or string literal "
+				 "at %C");
+		      return MATCH_ERROR;
+		    }
+
+		  if (gfc_match (" ,") == MATCH_YES)
+		    {
+		      otp = gfc_get_omp_trait_property ();
+		      otp->property_kind = property_kind;
+		      otp->next = os->properties;
+		      os->properties = otp;
+		    }
+		  else
+		    break;
+		}
+	      while (1);
+	      break;
+	    case CTX_PROPERTY_EXPR:
+	      if (gfc_match_expr (&otp->expr) != MATCH_YES)
+		{
+		  gfc_error ("expected expression at %C");
+		  return MATCH_ERROR;
+		}
+	      if (!gfc_resolve_expr (otp->expr)
+		  || (otp->expr->ts.type != BT_LOGICAL
+		      && otp->expr->ts.type != BT_INTEGER)
+		  || otp->expr->rank != 0)
+		{
+		  gfc_error ("property must be constant integer or logical "
+			     "expression at %C");
+		  return MATCH_ERROR;
+		}
+	      break;
+	    case CTX_PROPERTY_SIMD:
+	      {
+		if (gfc_match_omp_clauses (&otp->clauses,
+					   OMP_DECLARE_SIMD_CLAUSES,
+					   true, false, false, true)
+		    != MATCH_YES)
+		  {
+		  gfc_error ("expected simd clause at %C");
+		    return MATCH_ERROR;
+		  }
+		break;
+	      }
+	    default:
+	      gcc_unreachable ();
+	    }
+
+	  if (gfc_match (" )") != MATCH_YES)
+	    {
+	      gfc_error ("expected ')' at %C");
+	      return MATCH_ERROR;
+	    }
+	}
+      else if (property_kind == CTX_PROPERTY_NAME_LIST
+	       || property_kind == CTX_PROPERTY_ID
+	       || property_kind == CTX_PROPERTY_EXPR)
+	{
+	  if (gfc_match (" (") != MATCH_YES)
+	    {
+	      gfc_error ("expected '(' at %C");
+	      return MATCH_ERROR;
+	    }
+	}
+
+      if (gfc_match (" ,") != MATCH_YES)
+	break;
+    }
+  while (1);
+
+  return MATCH_YES;
+}
+
+/* OpenMP 5.0:
+
+   trait-set-selector[,trait-set-selector[,...]]
+
+   trait-set-selector:
+     trait-set-selector-name = { trait-selector[, trait-selector[, ...]] }
+
+   trait-set-selector-name:
+     constructor
+     device
+     implementation
+     user  */
+
+match
+gfc_match_omp_context_selector_specification (gfc_omp_declare_variant *odv)
+{
+  do
+    {
+      match m;
+      const char *selector_sets[] = { "construct", "device",
+				      "implementation", "user" };
+      const int selector_set_count
+	= sizeof (selector_sets) / sizeof (*selector_sets);
+      int i;
+      char buf[GFC_MAX_SYMBOL_LEN + 1];
+
+      m = gfc_match_name (buf);
+      if (m == MATCH_YES)
+	for (i = 0; i < selector_set_count; i++)
+	  if (strcmp (buf, selector_sets[i]) == 0)
+	    break;
+
+      if (m != MATCH_YES || i == selector_set_count)
+	{
+	  gfc_error ("expected 'construct', 'device', 'implementation' or "
+		     "'user' at %C");
+	  return MATCH_ERROR;
+	}
+
+      m = gfc_match (" =");
+      if (m != MATCH_YES)
+	{
+	  gfc_error ("expected '=' at %C");
+	  return MATCH_ERROR;
+	}
+
+      m = gfc_match (" {");
+      if (m != MATCH_YES)
+	{
+	  gfc_error ("expected '{' at %C");
+	  return MATCH_ERROR;
+	}
+
+      gfc_omp_set_selector *oss = gfc_get_omp_set_selector ();
+      oss->next = odv->set_selectors;
+      oss->trait_set_selector_name = selector_sets[i];
+      odv->set_selectors = oss;
+
+      if (gfc_match_omp_context_selector (oss) != MATCH_YES)
+	return MATCH_ERROR;
+
+      m = gfc_match (" }");
+      if (m != MATCH_YES)
+	{
+	  gfc_error ("expected '}' at %C");
+	  return MATCH_ERROR;
+	}
+
+      m = gfc_match (" ,");
+      if (m != MATCH_YES)
+	break;
+    }
+  while (1);
+
+  return MATCH_YES;
+}
+
+
+match
+gfc_match_omp_declare_variant (void)
+{
+  bool first_p = true;
+  char buf[GFC_MAX_SYMBOL_LEN + 1];
+
+  if (gfc_match (" (") != MATCH_YES)
+    {
+      gfc_error ("expected '(' at %C");
+      return MATCH_ERROR;
+    }
+
+  gfc_symtree *base_proc_st, *variant_proc_st;
+  if (gfc_match_name (buf) != MATCH_YES)
+    {
+      gfc_error ("expected name at %C");
+      return MATCH_ERROR;
+    }
+
+  if (gfc_get_ha_sym_tree (buf, &base_proc_st))
+    return MATCH_ERROR;
+
+  if (gfc_match (" :") == MATCH_YES)
+    {
+      if (gfc_match_name (buf) != MATCH_YES)
+	{
+	  gfc_error ("expected variant name at %C");
+	  return MATCH_ERROR;
+	}
+
+      if (gfc_get_ha_sym_tree (buf, &variant_proc_st))
+	return MATCH_ERROR;
+    }
+  else
+    {
+      /* Base procedure not specified.  */
+      variant_proc_st = base_proc_st;
+      base_proc_st = NULL;
+    }
+
+  gfc_omp_declare_variant *odv;
+  odv = gfc_get_omp_declare_variant ();
+  odv->where = gfc_current_locus;
+  odv->variant_proc_symtree = variant_proc_st;
+  odv->base_proc_symtree = base_proc_st;
+  odv->next = NULL;
+  odv->error_p = false;
+
+  /* Add the new declare variant to the end of the list.  */
+  gfc_omp_declare_variant **prev_next = &gfc_current_ns->omp_declare_variant;
+  while (*prev_next)
+    prev_next = &((*prev_next)->next);
+  *prev_next = odv;
+
+  if (gfc_match (" )") != MATCH_YES)
+    {
+      gfc_error ("expected ')' at %C");
+      return MATCH_ERROR;
+    }
+
+  for (;;)
+    {
+      if (gfc_match (" match") != MATCH_YES)
+	{
+	  if (first_p)
+	    {
+	      gfc_error ("expected 'match' at %C");
+	      return MATCH_ERROR;
+	    }
+	  else
+	    break;
+	}
+
+      if (gfc_match (" (") != MATCH_YES)
+	{
+	  gfc_error ("expected '(' at %C");
+	  return MATCH_ERROR;
+	}
+
+      if (gfc_match_omp_context_selector_specification (odv) != MATCH_YES)
+	return MATCH_ERROR;
+
+      if (gfc_match (" )") != MATCH_YES)
+	{
+	  gfc_error ("expected ')' at %C");
+	  return MATCH_ERROR;
+	}
+
+      first_p = false;
+    }
+
+  return MATCH_YES;
+}
+
+
 match
 gfc_match_omp_threadprivate (void)
 {
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 7d765a0866d..2a454be79b0 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -26,6 +26,8 @@ along with GCC; see the file COPYING3.  If not see
 #include <setjmp.h>
 #include "match.h"
 #include "parse.h"
+#include "tree-core.h"
+#include "omp-general.h"
 
 /* Current statement label.  Zero means no statement label.  Because new_st
    can get wiped during statement matching, we have to keep it separate.  */
@@ -860,6 +862,8 @@ decode_omp_directive (void)
 	       ST_OMP_DECLARE_SIMD);
       matchdo ("declare target", gfc_match_omp_declare_target,
 	       ST_OMP_DECLARE_TARGET);
+      matchdo ("declare variant", gfc_match_omp_declare_variant,
+	       ST_OMP_DECLARE_VARIANT);
       break;
     case 's':
       matchs ("simd", gfc_match_omp_simd, ST_OMP_SIMD);
@@ -1718,6 +1722,7 @@ next_statement (void)
 
 #define case_omp_decl case ST_OMP_THREADPRIVATE: case ST_OMP_DECLARE_SIMD: \
   case ST_OMP_DECLARE_TARGET: case ST_OMP_DECLARE_REDUCTION: \
+  case ST_OMP_DECLARE_VARIANT: \
   case ST_OMP_REQUIRES: case ST_OACC_ROUTINE: case ST_OACC_DECLARE
 
 /* Block end statements.  Errors associated with interchanging these
@@ -2361,6 +2366,9 @@ gfc_ascii_statement (gfc_statement st)
     case ST_OMP_DECLARE_TARGET:
       p = "!$OMP DECLARE TARGET";
       break;
+    case ST_OMP_DECLARE_VARIANT:
+      p = "!$OMP DECLARE VARIANT";
+      break;
     case ST_OMP_DEPOBJ:
       p = "!$OMP DEPOBJ";
       break;
@@ -6793,6 +6801,24 @@ done:
        gfc_current_ns = gfc_current_ns->sibling)
     gfc_check_omp_requires (gfc_current_ns, omp_requires);
 
+  /* Populate omp_requires_mask (needed for resolving OpenMP
+     metadirectives and declare variant).  */
+  switch (omp_requires & OMP_REQ_ATOMIC_MEM_ORDER_MASK)
+    {
+    case OMP_REQ_ATOMIC_MEM_ORDER_SEQ_CST:
+      omp_requires_mask
+	= (enum omp_requires) (omp_requires_mask | OMP_MEMORY_ORDER_SEQ_CST);
+      break;
+    case OMP_REQ_ATOMIC_MEM_ORDER_ACQ_REL:
+      omp_requires_mask
+	= (enum omp_requires) (omp_requires_mask | OMP_MEMORY_ORDER_ACQ_REL);
+      break;
+    case OMP_REQ_ATOMIC_MEM_ORDER_RELAXED:
+      omp_requires_mask
+	= (enum omp_requires) (omp_requires_mask | OMP_MEMORY_ORDER_RELAXED);
+      break;
+    }
+
   /* Do the parse tree dump.  */
   gfc_current_ns = flag_dump_fortran_original ? gfc_global_ns_list : NULL;
 
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 6d61bf4982b..2c4acd5abe1 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -4046,6 +4046,7 @@ gfc_free_namespace (gfc_namespace *ns)
   free_tb_tree (ns->tb_uop_root);
   gfc_free_finalizer_list (ns->finalizers);
   gfc_free_omp_declare_simd_list (ns->omp_declare_simd);
+  gfc_free_omp_declare_variant_list (ns->omp_declare_variant);
   gfc_free_charlen (ns->cl_list, NULL);
   free_st_labels (ns->st_labels);
 
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 87455f8ce25..7da1d2ebdcf 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -2362,9 +2362,13 @@ module_sym:
     pushdecl_top_level (fndecl);
 
   if (sym->formal_ns
-      && sym->formal_ns->proc_name == sym
-      && sym->formal_ns->omp_declare_simd)
-    gfc_trans_omp_declare_simd (sym->formal_ns);
+      && sym->formal_ns->proc_name == sym)
+    {
+      if (sym->formal_ns->omp_declare_simd)
+	gfc_trans_omp_declare_simd (sym->formal_ns);
+      if (flag_openmp)
+	gfc_trans_omp_declare_variant (sym->formal_ns);
+    }
 
   return fndecl;
 }
@@ -3112,6 +3116,12 @@ gfc_create_function_decl (gfc_namespace * ns, bool global)
 
   if (ns->omp_declare_simd)
     gfc_trans_omp_declare_simd (ns);
+
+  /* Handle 'declare variant' directives.  The applicable directives might
+     be declared in a parent namespace, so this needs to be called even if
+     there are no local directives.  */
+  if (flag_openmp)
+    gfc_trans_omp_declare_variant (ns);
 }
 
 /* Return the decl used to hold the function return value.  If
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index d234d1b070f..37d23310e3e 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -7258,3 +7258,207 @@ gfc_trans_omp_declare_simd (gfc_namespace *ns)
       DECL_ATTRIBUTES (fndecl) = c;
     }
 }
+
+void
+gfc_trans_omp_declare_variant (gfc_namespace *ns)
+{
+  tree base_fn_decl = ns->proc_name->backend_decl;
+  gfc_namespace *search_ns = ns;
+  gfc_omp_declare_variant *next;
+
+  for (gfc_omp_declare_variant *odv = search_ns->omp_declare_variant;
+       search_ns; odv = next)
+    {
+      /* Look in the parent namespace if there are no more directives in the
+	 current namespace.  */
+      if (!odv)
+	{
+	  search_ns = search_ns->parent;
+	  if (search_ns)
+	    next = search_ns->omp_declare_variant;
+	  continue;
+	}
+
+      next = odv->next;
+
+      if (odv->error_p)
+	continue;
+
+      /* Check directive the first time it is encountered.  */
+      bool error_found = true;
+
+      if (odv->checked_p)
+	error_found = false;
+      if (odv->base_proc_symtree == NULL)
+	{
+	  if (!search_ns->proc_name->attr.function
+	      && !search_ns->proc_name->attr.subroutine)
+	    gfc_error ("The base name for 'declare variant' must be "
+		       "specified at %L ", &odv->where);
+	  else
+	    error_found = false;
+	}
+      else
+	{
+	  if (!search_ns->contained
+	      && strcmp (odv->base_proc_symtree->name,
+			 ns->proc_name->name))
+	    gfc_error ("The base name at %L does not match the name of the "
+		       "current procedure", &odv->where);
+	  else if (odv->base_proc_symtree->n.sym->attr.entry)
+	    gfc_error ("The base name at %L must not be an entry name",
+			&odv->where);
+	  else if (odv->base_proc_symtree->n.sym->attr.generic)
+	    gfc_error ("The base name at %L must not be a generic name",
+			&odv->where);
+	  else if (odv->base_proc_symtree->n.sym->attr.proc_pointer)
+	    gfc_error ("The base name at %L must not be a procedure pointer",
+			&odv->where);
+	  else if (odv->base_proc_symtree->n.sym->attr.implicit_type)
+	    gfc_error ("The base procedure at %L must have an explicit "
+			"interface", &odv->where);
+	  else
+	    error_found = false;
+	}
+
+      odv->checked_p = true;
+      if (error_found)
+	{
+	  odv->error_p = true;
+	  continue;
+	}
+
+      /* Ignore directives that do not apply to the current procedure.  */
+      if ((odv->base_proc_symtree == NULL && search_ns != ns)
+	  || (odv->base_proc_symtree != NULL
+	      && strcmp (odv->base_proc_symtree->name, ns->proc_name->name)))
+	continue;
+
+      tree set_selectors = NULL_TREE;
+      gfc_omp_set_selector *oss;
+
+      for (oss = odv->set_selectors; oss; oss = oss->next)
+	{
+	  tree selectors = NULL_TREE;
+	  gfc_omp_selector *os;
+	  for (os = oss->trait_selectors; os; os = os->next)
+	    {
+	      tree properties = NULL_TREE;
+	      gfc_omp_trait_property *otp;
+
+	      for (otp = os->properties; otp; otp = otp->next)
+		{
+		  switch (otp->property_kind)
+		    {
+		    case CTX_PROPERTY_USER:
+		    case CTX_PROPERTY_EXPR:
+		      {
+			gfc_se se;
+			gfc_init_se (&se, NULL);
+			gfc_conv_expr (&se, otp->expr);
+			properties = tree_cons (NULL_TREE, se.expr,
+						properties);
+		      }
+		      break;
+		    case CTX_PROPERTY_ID:
+		      properties = tree_cons (get_identifier (otp->name),
+					      NULL_TREE, properties);
+		      break;
+		    case CTX_PROPERTY_NAME_LIST:
+		      {
+			tree prop = NULL_TREE, value = NULL_TREE;
+			if (otp->is_name)
+			  prop = get_identifier (otp->name);
+			else
+			  value = gfc_conv_constant_to_tree (otp->expr);
+
+			properties = tree_cons (prop, value, properties);
+		      }
+		      break;
+		    case CTX_PROPERTY_SIMD:
+		      properties = gfc_trans_omp_clauses (NULL, otp->clauses,
+							  odv->where, true);
+		      break;
+		    default:
+		      gcc_unreachable ();
+		    }
+		}
+
+	      if (os->score)
+		{
+		  gfc_se se;
+		  gfc_init_se (&se, NULL);
+		  gfc_conv_expr (&se, os->score);
+		  properties = tree_cons (get_identifier (" score"),
+					  se.expr, properties);
+		}
+
+	      selectors = tree_cons (get_identifier (os->trait_selector_name),
+				     properties, selectors);
+	    }
+
+	  set_selectors
+	    = tree_cons (get_identifier (oss->trait_set_selector_name),
+			 selectors, set_selectors);
+	}
+
+      const char *variant_proc_name = odv->variant_proc_symtree->name;
+      gfc_symbol *variant_proc_sym = odv->variant_proc_symtree->n.sym;
+      if (variant_proc_sym == NULL || variant_proc_sym->attr.implicit_type)
+	{
+	  gfc_symtree *proc_st;
+	  gfc_find_sym_tree (variant_proc_name, gfc_current_ns, 1, &proc_st);
+	  variant_proc_sym = proc_st->n.sym;
+	}
+      if (variant_proc_sym == NULL)
+	{
+	  gfc_error ("Cannot find symbol %qs", variant_proc_name);
+	  continue;
+	}
+      set_selectors = omp_check_context_selector
+	  (gfc_get_location (&odv->where), set_selectors);
+      if (set_selectors != error_mark_node)
+	{
+	  if (!variant_proc_sym->attr.implicit_type
+	      && !variant_proc_sym->attr.subroutine
+	      && !variant_proc_sym->attr.function)
+	    {
+	      gfc_error ("variant %qs at %L is not a function or subroutine",
+			 variant_proc_name, &odv->where);
+	      variant_proc_sym = NULL;
+	    }
+	  else if (omp_get_context_selector (set_selectors, "construct",
+					     "simd") == NULL_TREE)
+	    {
+	      char err[256];
+	      if (!gfc_compare_interfaces (ns->proc_name, variant_proc_sym,
+					   variant_proc_sym->name, 0, 1,
+					   err, sizeof (err), NULL, NULL))
+		{
+		  gfc_error ("variant %qs and base %qs at %L have "
+			     "incompatible types: %s",
+			     variant_proc_name, ns->proc_name->name,
+			     &odv->where, err);
+		  variant_proc_sym = NULL;
+		}
+	    }
+	  if (variant_proc_sym != NULL)
+	    {
+	      gfc_set_sym_referenced (variant_proc_sym);
+	      tree construct = omp_get_context_selector (set_selectors,
+							 "construct", NULL);
+	      omp_mark_declare_variant (gfc_get_location (&odv->where),
+					gfc_get_symbol_decl (variant_proc_sym),
+					construct);
+	      if (omp_context_selector_matches (set_selectors))
+		{
+		  tree id = get_identifier ("omp declare variant base");
+		  tree variant = gfc_get_symbol_decl (variant_proc_sym);
+		  DECL_ATTRIBUTES (base_fn_decl)
+		    = tree_cons (id, build_tree_list (variant, set_selectors),
+				 DECL_ATTRIBUTES (base_fn_decl));
+		}
+	    }
+	}
+    }
+}
diff --git a/gcc/fortran/trans-stmt.h b/gcc/fortran/trans-stmt.h
index 763f8940404..1a24d9b4cdc 100644
--- a/gcc/fortran/trans-stmt.h
+++ b/gcc/fortran/trans-stmt.h
@@ -71,6 +71,7 @@ tree gfc_trans_deallocate_array (tree);
 /* trans-openmp.c */
 tree gfc_trans_omp_directive (gfc_code *);
 void gfc_trans_omp_declare_simd (gfc_namespace *);
+void gfc_trans_omp_declare_variant (gfc_namespace *);
 tree gfc_trans_oacc_directive (gfc_code *);
 tree gfc_trans_oacc_declare (gfc_namespace *);
 
diff --git a/gcc/omp-general.c b/gcc/omp-general.c
index 3e5ca94c2a7..44527552413 100644
--- a/gcc/omp-general.c
+++ b/gcc/omp-general.c
@@ -1095,6 +1095,146 @@ omp_maybe_offloaded (void)
   return false;
 }
 
+
+/* Diagnose errors in an OpenMP context selector, return CTX if
+   it is correct or error_mark_node otherwise.  */
+
+tree
+omp_check_context_selector (location_t loc, tree ctx)
+{
+  /* Each trait-set-selector-name can only be specified once.
+     There are just 4 set names.  */
+  for (tree t1 = ctx; t1; t1 = TREE_CHAIN (t1))
+    for (tree t2 = TREE_CHAIN (t1); t2; t2 = TREE_CHAIN (t2))
+      if (TREE_PURPOSE (t1) == TREE_PURPOSE (t2))
+	{
+	  error_at (loc, "selector set %qs specified more than once",
+		    IDENTIFIER_POINTER (TREE_PURPOSE (t1)));
+	  return error_mark_node;
+	}
+  for (tree t = ctx; t; t = TREE_CHAIN (t))
+    {
+      /* Each trait-selector-name can only be specified once.  */
+      if (list_length (TREE_VALUE (t)) < 5)
+	{
+	  for (tree t1 = TREE_VALUE (t); t1; t1 = TREE_CHAIN (t1))
+	    for (tree t2 = TREE_CHAIN (t1); t2; t2 = TREE_CHAIN (t2))
+	      if (TREE_PURPOSE (t1) == TREE_PURPOSE (t2))
+		{
+		  error_at (loc,
+			    "selector %qs specified more than once in set %qs",
+			    IDENTIFIER_POINTER (TREE_PURPOSE (t1)),
+			    IDENTIFIER_POINTER (TREE_PURPOSE (t)));
+		  return error_mark_node;
+		}
+	}
+      else
+	{
+	  hash_set<tree> pset;
+	  for (tree t1 = TREE_VALUE (t); t1; t1 = TREE_CHAIN (t1))
+	    if (pset.add (TREE_PURPOSE (t1)))
+	      {
+		error_at (loc,
+			  "selector %qs specified more than once in set %qs",
+			  IDENTIFIER_POINTER (TREE_PURPOSE (t1)),
+			  IDENTIFIER_POINTER (TREE_PURPOSE (t)));
+		return error_mark_node;
+	      }
+	}
+
+      static const char *const kind[] = {
+	"host", "nohost", "cpu", "gpu", "fpga", "any", NULL };
+      static const char *const vendor[] = {
+	"amd", "arm", "bsc", "cray", "fujitsu", "gnu", "ibm", "intel",
+	"llvm", "nvidia", "pgi", "ti", "unknown", NULL };
+      static const char *const extension[] = { NULL };
+      static const char *const atomic_default_mem_order[] = {
+	"seq_cst", "relaxed", "acq_rel", NULL };
+      struct known_properties { const char *set; const char *selector;
+				const char *const *props; };
+      known_properties props[] = {
+	{ "device", "kind", kind },
+	{ "implementation", "vendor", vendor },
+	{ "implementation", "extension", extension },
+	{ "implementation", "atomic_default_mem_order",
+	  atomic_default_mem_order } };
+      for (tree t1 = TREE_VALUE (t); t1; t1 = TREE_CHAIN (t1))
+	for (unsigned i = 0; i < ARRAY_SIZE (props); i++)
+	  if (!strcmp (IDENTIFIER_POINTER (TREE_PURPOSE (t1)),
+					   props[i].selector)
+	      && !strcmp (IDENTIFIER_POINTER (TREE_PURPOSE (t)),
+					      props[i].set))
+	    for (tree t2 = TREE_VALUE (t1); t2; t2 = TREE_CHAIN (t2))
+	      for (unsigned j = 0; ; j++)
+		{
+		  if (props[i].props[j] == NULL)
+		    {
+		      if (TREE_PURPOSE (t2)
+			  && !strcmp (IDENTIFIER_POINTER (TREE_PURPOSE (t2)),
+				      " score"))
+			break;
+		      if (props[i].props == atomic_default_mem_order)
+			{
+			  error_at (loc,
+				    "incorrect property %qs of %qs selector",
+				    IDENTIFIER_POINTER (TREE_PURPOSE (t2)),
+				    "atomic_default_mem_order");
+			  return error_mark_node;
+			}
+		      else if (TREE_PURPOSE (t2))
+			warning_at (loc, 0,
+				    "unknown property %qs of %qs selector",
+				    IDENTIFIER_POINTER (TREE_PURPOSE (t2)),
+				    props[i].selector);
+		      else
+			warning_at (loc, 0,
+				    "unknown property %qE of %qs selector",
+				    TREE_VALUE (t2), props[i].selector);
+		      break;
+		    }
+		  else if (TREE_PURPOSE (t2) == NULL_TREE)
+		    {
+		      const char *str = TREE_STRING_POINTER (TREE_VALUE (t2));
+		      if (!strcmp (str, props[i].props[j])
+			  && ((size_t) TREE_STRING_LENGTH (TREE_VALUE (t2))
+			      == strlen (str) + (lang_GNU_Fortran () ? 0 : 1)))
+			break;
+		    }
+		  else if (!strcmp (IDENTIFIER_POINTER (TREE_PURPOSE (t2)),
+				    props[i].props[j]))
+		    break;
+		}
+    }
+  return ctx;
+}
+
+
+/* Register VARIANT as variant of some base function marked with
+   #pragma omp declare variant.  CONSTRUCT is corresponding construct
+   selector set.  */
+
+void
+omp_mark_declare_variant (location_t loc, tree variant, tree construct)
+{
+  tree attr = lookup_attribute ("omp declare variant variant",
+				DECL_ATTRIBUTES (variant));
+  if (attr == NULL_TREE)
+    {
+      attr = tree_cons (get_identifier ("omp declare variant variant"),
+			unshare_expr (construct),
+			DECL_ATTRIBUTES (variant));
+      DECL_ATTRIBUTES (variant) = attr;
+      return;
+    }
+  if ((TREE_VALUE (attr) != NULL_TREE) != (construct != NULL_TREE)
+      || (construct != NULL_TREE
+	  && omp_context_selector_set_compare ("construct", TREE_VALUE (attr),
+					       construct)))
+    error_at (loc, "%qD used as a variant with incompatible %<construct%> "
+		   "selector sets", variant);
+}
+
+
 /* Return a name from PROP, a property in selectors accepting
    name lists.  */
 
@@ -1106,7 +1246,8 @@ omp_context_name_list_prop (tree prop)
   else
     {
       const char *ret = TREE_STRING_POINTER (TREE_VALUE (prop));
-      if ((size_t) TREE_STRING_LENGTH (TREE_VALUE (prop)) == strlen (ret) + 1)
+      if ((size_t) TREE_STRING_LENGTH (TREE_VALUE (prop))
+	  == strlen (ret) + (lang_GNU_Fortran () ? 0 : 1))
 	return ret;
       return NULL;
     }
diff --git a/gcc/omp-general.h b/gcc/omp-general.h
index 6a1468d2798..8fe744c6a7a 100644
--- a/gcc/omp-general.h
+++ b/gcc/omp-general.h
@@ -104,6 +104,9 @@ extern tree find_combined_omp_for (tree *, int *, void *);
 extern poly_uint64 omp_max_vf (void);
 extern int omp_max_simt_vf (void);
 extern int omp_constructor_traits_to_codes (tree, enum tree_code *);
+extern tree omp_check_context_selector (location_t loc, tree ctx);
+extern void omp_mark_declare_variant (location_t loc, tree variant,
+				      tree construct);
 extern int omp_context_selector_matches (tree);
 extern int omp_context_selector_set_compare (const char *, tree, tree);
 extern tree omp_get_context_selector (tree, const char *, const char *);
diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-variant-1.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-variant-1.f90
new file mode 100644
index 00000000000..de09dbfe806
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-variant-1.f90
@@ -0,0 +1,93 @@
+module main
+  implicit none
+
+  interface
+    integer function foo (a, b, c)
+      integer, intent(in) :: a, b
+      integer, intent(inout) :: c
+    end function
+
+    integer function bar (a, b, c)
+      integer, intent(in) :: a, b
+      integer, intent(inout) :: c
+    end function
+
+    integer function baz (a, b, c)
+      integer, intent(in) :: a, b
+      integer, intent(inout) :: c
+
+      !$omp declare variant (foo) &
+      !$omp & match (construct={parallel,do}, &
+      !$omp & device={isa(avx512f,avx512vl),kind(host,cpu)}, &
+      !$omp & implementation={vendor(score(0):gnu),unified_shared_memory}, &
+      !$omp & user={condition(score(0):0)})
+      !$omp declare variant (bar) &
+      !$omp & match (device={arch(x86_64,powerpc64),isa(avx512f,popcntb)}, &
+      !$omp & implementation={atomic_default_mem_order(seq_cst),made_up_selector("foo", 13, "bar")}, &
+      !$omp & user={condition(3-3)})
+    end function
+
+    subroutine quux
+    end subroutine quux
+
+    integer function baz3 (x, y, z)
+      integer, intent(in) :: x, y
+      integer, intent(inout) :: z
+
+      !$omp declare variant (bar) match &
+      !$omp & (implementation={atomic_default_mem_order(score(3): acq_rel)})
+    end function
+  end interface
+contains
+  integer function qux ()
+    integer :: i = 3
+
+    qux = baz (1, 2, i)
+  end function
+
+  subroutine corge
+    integer :: i
+    !$omp declare variant (quux) match (construct={parallel,do})
+
+    interface
+      subroutine waldo (x)
+        integer, intent(in) :: x
+      end subroutine
+    end interface
+
+    call waldo (5)
+    !$omp parallel do
+      do i = 1, 3
+	call waldo (6)
+      end do
+    !$omp end parallel do
+
+    !$omp parallel
+      !$omp taskgroup
+	!$omp do
+	  do i = 1, 3
+	    call waldo (7)
+	  end do
+        !$omp end do
+      !$omp end taskgroup
+    !$omp end parallel
+
+    !$omp parallel
+      !$omp master
+        call waldo (8)
+      !$omp end master
+    !$omp end parallel
+  end subroutine
+
+  integer function baz2 (x, y, z)
+    integer, intent(in) :: x, y
+    integer, intent(inout) :: z
+
+    !$omp declare variant (bar) match &
+    !$omp & (implementation={atomic_default_mem_order(relaxed), &
+    !$omp &		   unified_address, unified_shared_memory, &
+    !$omp &		   dynamic_allocators, reverse_offload})
+
+    baz2 = x + y + z
+  end function
+end module
diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-variant-10.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-variant-10.f90
new file mode 100644
index 00000000000..d6d2c8c262b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-variant-10.f90
@@ -0,0 +1,97 @@
+! { dg-do compile }
+! { dg-additional-options "-cpp -foffload=disable -fdump-tree-gimple" }
+! { dg-additional-options "-mavx512bw" { target { i?86-*-* x86_64-*-* } } }
+
+#undef i386
+
+program main
+  !$omp declare target to (test3)
+contains
+  subroutine f01 ()
+  end subroutine
+  subroutine f02 ()
+    !$omp declare variant (f01) match (device={isa(avx512f,avx512bw)})
+  end subroutine
+  subroutine f03 ()
+  end subroutine
+  subroutine f04 ()
+    !$omp declare variant (f03) match (device={kind("any"),arch(x86_64),isa(avx512f,avx512bw)})
+  end subroutine
+  subroutine f05 ()
+  end subroutine
+  subroutine f06 ()
+    !$omp declare variant (f05) match (device={kind(gpu)})
+  end subroutine
+  subroutine f07 ()
+  end subroutine
+  subroutine f08 ()
+    !$omp declare variant (f07) match (device={kind(cpu)})
+  end subroutine
+  subroutine f09 ()
+  end subroutine
+  subroutine f10 ()
+    !$omp declare variant (f09) match (device={isa(sm_35)})
+  end subroutine
+  subroutine f11 ()
+  end subroutine
+  subroutine f12 ()
+    !$omp declare variant (f11) match (device={arch("nvptx")})
+  end subroutine
+  subroutine f13 ()
+  end subroutine
+  subroutine f14 ()
+    !$omp declare variant (f13) match (device={arch(i386),isa("sse4")})
+  end subroutine
+  subroutine f15 ()
+  end subroutine
+  subroutine f16 ()
+    !$omp declare variant (f15) match (device={isa(sse4,ssse3),arch(i386)})
+  end subroutine
+  subroutine f17 ()
+  end subroutine
+  subroutine f18 ()
+    !$omp declare variant (f17) match (device={kind(any,fpga)})
+  end subroutine
+
+  subroutine test1 ()
+    !$omp declare target
+    integer :: i
+
+    call f02 ()	  ! { dg-final { scan-tree-dump-times "f01 \\\(\\\);" 1 "gimple" { target i?86-*-* x86_64-*-* } } }
+		  ! { dg-final { scan-tree-dump-times "f02 \\\(\\\);" 1 "gimple" { target { ! { i?86-*-* x86_64-*-* } } } } }
+    call f14 ()	  ! { dg-final { scan-tree-dump-times "f13 \\\(\\\);" 1 "gimple" { target ia32 } } }
+		  ! { dg-final { scan-tree-dump-times "f14 \\\(\\\);" 1 "gimple" { target { ! ia32 } } } }
+    call f18 ()	  ! { dg-final { scan-tree-dump-times "f18 \\\(\\\);" 1 "gimple" } } */
+  end subroutine
+
+#if defined(__i386__) || defined(__x86_64__)
+  __attribute__((target ("avx512f,avx512bw")))
+#endif
+  subroutine test2 ()
+    !$omp target
+      call f04 ()	! { dg-final { scan-tree-dump-times "f03 \\\(\\\);" 1 "gimple" { target { { i?86-*-* x86_64-*-* } && lp64 } } } }
+			! { dg-final { scan-tree-dump-times "f04 \\\(\\\);" 1 "gimple" { target { { ! lp64 } || { ! { i?86-*-* x86_64-*-* } } } } } }
+    !$omp end target
+    !$omp target
+      call f16 ()	! { dg-final { scan-tree-dump-times "f15 \\\(\\\);" 1 "gimple" { target ia32 } } }
+			! { dg-final { scan-tree-dump-times "f16 \\\(\\\);" 1 "gimple" { target { ! ia32 } } } }
+    !$omp end target
+  end subroutine
+
+  subroutine test3 ()
+    call f06 ()	  ! { dg-final { scan-tree-dump-times "f06 \\\(\\\);" 1 "gimple" { target { ! { nvptx*-*-* amdgcn*-*-* } } } } }
+    call f08 ()	  ! { dg-final { scan-tree-dump-times "f07 \\\(\\\);" 1 "gimple" { target { ! { nvptx*-*-* amdgcn*-*-* } } } } }
+  end subroutine
+
+  subroutine test4 ()
+    !$omp target
+      call f10 ()	! { dg-final { scan-tree-dump-times "f10 \\\(\\\);" 1 "gimple" { target { ! { nvptx*-*-* amdgcn*-*-* } } } } }
+    !$omp end target
+
+    !$omp target
+      call f12 ()	! { dg-final { scan-tree-dump-times "f12 \\\(\\\);" 1 "gimple" { target { ! { nvptx*-*-* } } } } }
+			! { dg-final { scan-tree-dump-times "f11 \\\(\\\);" 1 "gimple" { target { nvptx*-*-* } } } }
+    !$omp end target
+  end subroutine
+end program
+
diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-variant-11.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-variant-11.f90
new file mode 100644
index 00000000000..60aa0fcb3b0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-variant-11.f90
@@ -0,0 +1,134 @@
+! { dg-do compile }
+! { dg-additional-options "-foffload=disable -fdump-tree-gimple" }
+! { dg-additional-options "-mavx512bw -mavx512vl" { target { i?86-*-* x86_64-*-* } } }
+
+program main
+  implicit none
+contains
+  subroutine f01 ()
+  end subroutine
+
+  subroutine f02 ()
+  end subroutine
+
+  subroutine f03 ()
+    !$omp declare variant (f01) match (device={isa(avx512f,"avx512vl")})
+    !$omp declare variant (f02) match (device={isa(avx512bw,avx512vl,"avx512f")})
+  end subroutine
+
+  subroutine f04 ()
+  end subroutine
+
+  subroutine f05 ()
+  end subroutine
+
+  subroutine f06 ()
+    !$omp declare variant (f04) match (device={isa(avx512f,avx512vl)})
+    !$omp declare variant (f05) match (device={isa(avx512bw,avx512vl,avx512f)})
+  end subroutine
+
+  subroutine f07 ()
+  end subroutine
+
+  subroutine f08 ()
+  end subroutine
+
+  subroutine f09 ()
+    !$omp declare variant (f07) match (device={isa(sse4,"sse4.1","sse4.2",sse3,"avx")})
+    !$omp declare variant (f08) match (device={isa("avx",sse3)})
+  end subroutine
+
+  subroutine f10 ()
+  end subroutine
+
+  subroutine f11 ()
+  end subroutine
+
+  subroutine f12 ()
+  end subroutine
+
+  subroutine f13 ()
+    !$omp declare variant (f10) match (device={isa("avx512f")})
+    !$omp declare variant (f11) match (user={condition(1)},device={isa(avx512f)},implementation={vendor(gnu)})
+    !$omp declare variant (f12) match (user={condition(2 + 1)},device={isa(avx512f)})
+  end subroutine
+
+  subroutine f14 ()
+  end subroutine
+
+  subroutine f15 ()
+  end subroutine
+
+  subroutine f16 ()
+  end subroutine
+
+  subroutine f17 ()
+  end subroutine
+
+  subroutine f18 ()
+    !$omp declare variant (f14) match (construct={teams,do})
+    !$omp declare variant (f15) match (construct={teams,parallel,do})
+    !$omp declare variant (f16) match (construct={do})
+    !$omp declare variant (f17) match (construct={parallel,do})
+  end subroutine
+
+  subroutine f19 ()
+  end subroutine
+
+  subroutine f20 ()
+  end subroutine
+
+  subroutine f21 ()
+  end subroutine
+
+  subroutine f22 ()
+  end subroutine
+
+  subroutine f23 ()
+    !$omp declare variant (f19) match (construct={teams,do})
+    !$omp declare variant (f20) match (construct={teams,parallel,do})
+    !$omp declare variant (f21) match (construct={do})
+    !$omp declare variant (f22) match (construct={parallel,do})
+  end subroutine
+
+  subroutine f24 ()
+  end subroutine
+
+  subroutine f25 ()
+  end subroutine
+
+  subroutine f26 ()
+  end subroutine
+
+  subroutine f27 ()
+    !$omp declare variant (f24) match (device={kind(cpu)})
+    !$omp declare variant (f25) match (device={kind(cpu),isa(avx512f),arch(x86_64)})
+    !$omp declare variant (f26) match (device={arch(x86_64),kind(cpu)})
+  end subroutine
+
+  subroutine test1
+    integer :: i
+    call f03 ()	! { dg-final { scan-tree-dump-times "f02 \\\(\\\);" 1 "gimple" { target i?86-*-* x86_64-*-* } } }
+		! { dg-final { scan-tree-dump-times "f03 \\\(\\\);" 1 "gimple" { target { ! { i?86-*-* x86_64-*-* } } } } }
+    call f09 ()	! { dg-final { scan-tree-dump-times "f07 \\\(\\\);" 1 "gimple" { target i?86-*-* x86_64-*-* } } }
+		! { dg-final { scan-tree-dump-times "f09 \\\(\\\);" 1 "gimple" { target { ! { i?86-*-* x86_64-*-* } } } } }
+    call f13 ()	! { dg-final { scan-tree-dump-times "f11 \\\(\\\);" 1 "gimple" { target i?86-*-* x86_64-*-* } } }
+		! { dg-final { scan-tree-dump-times "f13 \\\(\\\);" 1 "gimple" { target { ! { i?86-*-* x86_64-*-* } } } } }
+    !$omp teams distribute parallel do
+    do i = 1, 2
+      call f18 ()	! { dg-final { scan-tree-dump-times "f15 \\\(\\\);" 1 "gimple" } }
+    end do
+    !$omp end teams distribute parallel do
+
+    !$omp parallel do
+    do i = 1, 2
+      call f23 ()	! { dg-final { scan-tree-dump-times "f22 \\\(\\\);" 1 "gimple" } }
+    end do
+    !$omp end parallel do
+
+    call f27 ()	! { dg-final { scan-tree-dump-times "f25 \\\(\\\);" 1 "gimple" { target { { i?86-*-* x86_64-*-* } && lp64 } } } }
+		! { dg-final { scan-tree-dump-times "f24 \\\(\\\);" 1 "gimple" { target { { i?86-*-* x86_64-*-* } && { ! lp64 } } } } }
+		! { dg-final { scan-tree-dump-times "f24 \\\(\\\);" 1 "gimple" { target { ! { nvptx*-*-* amdgcn*-*-* i?86-*-* x86_64-*-* } } } } }
+		! { dg-final { scan-tree-dump-times "f27 \\\(\\\);" 1 "gimple" { target { nvptx*-*-* amdgcn*-*-* } } } }
+  end subroutine
+end program
diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-variant-12.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-variant-12.f90
new file mode 100644
index 00000000000..610693e9807
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-variant-12.f90
@@ -0,0 +1,159 @@
+! { dg-do compile }
+! { dg-additional-options "-foffload=disable -fdump-tree-gimple" }
+! { dg-additional-options "-mavx512bw -mavx512vl" { target { i?86-*-* x86_64-*-* } } }
+
+program main
+  !$omp requires atomic_default_mem_order(seq_cst)
+contains
+  subroutine f01 ()
+  end subroutine
+
+  subroutine f02 ()
+  end subroutine
+
+  subroutine f03 ()
+  end subroutine
+
+  subroutine f04 ()
+    !$omp declare variant (f01) match (device={isa("avx512f","avx512vl")}) ! 16
+    !$omp declare variant (f02) match (implementation={vendor(score(15):gnu)})
+    !$omp declare variant (f03) match (user={condition(score(11):1)})
+  end subroutine
+
+  subroutine f05 ()
+  end subroutine
+
+  subroutine f06 ()
+  end subroutine
+
+  subroutine f07 ()
+  end subroutine
+
+  subroutine f08 ()
+    !$omp declare variant (f05) match (device={isa(avx512f,avx512vl)}) ! 16
+    !$omp declare variant (f06) match (implementation={vendor(score(15):gnu)})
+    !$omp declare variant (f07) match (user={condition(score(17):1)})
+  end subroutine
+
+  subroutine f09 ()
+  end subroutine
+
+  subroutine f10 ()
+  end subroutine
+
+  subroutine f11 ()
+  end subroutine
+
+  subroutine f12 ()
+  end subroutine
+
+  subroutine f13 ()
+    !$omp declare variant (f09) match (device={arch(x86_64)},user={condition(score(65):1)}) ! 64+65
+    !$omp declare variant (f10) match (implementation={vendor(score(127):"gnu")})
+    !$omp declare variant (f11) match (device={isa(ssse3)}) ! 128
+    !$omp declare variant (f12) match (implementation={atomic_default_mem_order(score(126):seq_cst)})
+  end subroutine
+
+  subroutine f14 ()
+  end subroutine
+
+  subroutine f15 ()
+  end subroutine
+
+  subroutine f16 ()
+  end subroutine
+
+  subroutine f17 ()
+    !$omp declare variant (f14) match (construct={teams,parallel,do}) ! 16+8+4
+    !$omp declare variant (f15) match (construct={parallel},user={condition(score(19):1)}) ! 8+19
+    !$omp declare variant (f16) match (implementation={atomic_default_mem_order(score(27):seq_cst)})
+  end subroutine
+
+  subroutine f18 ()
+  end subroutine
+
+  subroutine f19 ()
+  end subroutine
+
+  subroutine f20 ()
+  end subroutine
+
+  subroutine f21 ()
+    !$omp declare variant (f18) match (construct={teams,parallel,do}) ! 16+8+4
+    !$omp declare variant (f19) match (construct={do},user={condition(score(25):1)}) ! 4+25
+    !$omp declare variant (f20) match (implementation={atomic_default_mem_order(score(28):seq_cst)})
+  end subroutine
+
+  subroutine f22 ()
+  end subroutine
+
+  subroutine f23 ()
+  end subroutine
+
+  subroutine f24 ()
+  end subroutine
+
+  subroutine f25 ()
+    !$omp declare variant (f22) match (construct={parallel,do}) ! 2+1
+    !$omp declare variant (f23) match (construct={do}) ! 0
+    !$omp declare variant (f24) match (implementation={atomic_default_mem_order(score(2):seq_cst)})
+  end subroutine
+
+  subroutine f26 ()
+  end subroutine
+
+  subroutine f27 ()
+  end subroutine
+
+  subroutine f28 ()
+  end subroutine
+
+  subroutine f29 ()
+    !$omp declare variant (f26) match (construct={parallel,do}) ! 2+1
+    !$omp declare variant (f27) match (construct={do},user={condition(1)}) ! 4
+    !$omp declare variant (f28) match (implementation={atomic_default_mem_order(score(3):seq_cst)})
+  end subroutine
+
+  subroutine test1 ()
+    integer :: i, j
+
+    !$omp parallel do	! 2 constructs in OpenMP context, isa has score 2^4.
+    do i = 1, 2
+      call f04 ()	! { dg-final { scan-tree-dump-times "f01 \\\(\\\);" 1 "gimple" { target i?86-*-* x86_64-*-* } } }
+			! { dg-final { scan-tree-dump-times "f02 \\\(\\\);" 1 "gimple" { target { ! { i?86-*-* x86_64-*-* } } } } }
+    end do
+    !$omp end parallel do
+
+    !$omp target teams	! 2 constructs in OpenMP context, isa has score 2^4.
+      call f08 ()	! { dg-final { scan-tree-dump-times "f07 \\\(\\\);" 1 "gimple" } }
+    !$omp end target teams
+
+    !$omp teams
+    !$omp parallel do
+    do i = 1, 2
+      !$omp parallel do	! 5 constructs in OpenMP context, arch is 2^6, isa 2^7.
+      do j = 1, 2
+	  call f13 ()	! { dg-final { scan-tree-dump-times "f09 \\\(\\\);" 1 "gimple" { target { { i?86-*-* x86_64-*-* } && lp64 } } } }
+			! { dg-final { scan-tree-dump-times "f11 \\\(\\\);" 1 "gimple" { target { { i?86-*-* x86_64-*-* } && { ! lp64 } } } } }
+			! { dg-final { scan-tree-dump-times "f10 \\\(\\\);" 1 "gimple" { target { ! { i?86-*-* x86_64-*-* } } } } }
+	  call f17 ()	! { dg-final { scan-tree-dump-times "f14 \\\(\\\);" 1 "gimple" } }
+	  call f21 ()	! { dg-final { scan-tree-dump-times "f19 \\\(\\\);" 1 "gimple" } }
+      end do
+      !$omp end parallel do
+    end do
+    !$omp end parallel do
+    !$omp end teams
+
+    !$omp do
+    do i = 1, 2
+      !$omp parallel do
+      do j = 1, 2
+	call f25 ();	! { dg-final { scan-tree-dump-times "f22 \\\(\\\);" 1 "gimple" } }
+	call f29 ();	! { dg-final { scan-tree-dump-times "f27 \\\(\\\);" 1 "gimple" } }
+      end do
+      !$omp end parallel do
+    end do
+    !$omp end do
+  end subroutine
+end program
+
diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-variant-13.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-variant-13.f90
new file mode 100644
index 00000000000..91648f9bcf4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-variant-13.f90
@@ -0,0 +1,48 @@
+! { dg-do compile { target vect_simd_clones } }
+! { dg-additional-options "-fdump-tree-gimple" }
+! { dg-additional-options "-mno-sse3" { target { i?86-*-* x86_64-*-* } } }
+
+program main
+  implicit none
+contains
+  integer function f01 (x)
+    integer, intent(in) :: x
+    f01 = x
+  end function
+
+  integer function f02 (x)
+    integer, intent(in) :: x
+    f02 = x
+  end function
+
+  integer function f03 (x)
+    integer, intent(in) :: x
+    f03 = x
+  end function
+
+  integer function f04 (x)
+    integer, intent(in) :: x
+    f04 = x
+  end function
+
+  integer function f05 (x)
+    integer, intent(in) :: x
+
+    !$omp declare variant (f01) match (device={isa("avx512f")}) ! 4 or 8
+    !$omp declare variant (f02) match (implementation={vendor(score(3):gnu)},device={kind(cpu)}) ! (1 or 2) + 3
+    !$omp declare variant (f03) match (user={condition(score(9):1)})
+    !$omp declare variant (f04) match (implementation={vendor(score(6):gnu)},device={kind(host)}) ! (1 or 2) + 6
+    f05 = x
+  end function
+
+  integer function test1 (x)
+    !$omp declare simd
+    integer, intent(in) :: x
+
+    ! 0 or 1 (the latter if in a declare simd clone) constructs in OpenMP context,
+    ! isa has score 2^2 or 2^3.  We can't decide on whether avx512f will match or
+    ! not, that also depends on whether it is a declare simd clone or not and which
+    ! one, but the f03 variant has a higher score anyway.  */
+    test1 = f05 (x)	! { dg-final { scan-tree-dump-times "f03 \\\(x" 1 "gimple" } }
+  end function
+end program
diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-variant-14.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-variant-14.f90
new file mode 100644
index 00000000000..06c9a5d1ed8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-variant-14.f90
@@ -0,0 +1,49 @@
+! { dg-do compile { target vect_simd_clones } }
+! { dg-additional-options "-O0 -fdump-tree-gimple -fdump-tree-optimized" }
+! { dg-additional-options "-mno-sse3" { target { i?86-*-* x86_64-*-* } } }
+
+module main
+  implicit none
+contains
+  integer function f01 (x)
+    integer, intent (in) :: x
+    f01 = x
+  end function
+
+  integer function f02 (x)
+    integer, intent (in) :: x
+    f02 = x
+  end function
+
+  integer function f03 (x)
+    integer, intent (in) :: x
+    f03 = x
+  end function
+
+  integer function f04 (x)
+    integer, intent(in) :: x
+
+    !$omp declare variant (f01) match (device={isa("avx512f")}) ! 4 or 8
+    !$omp declare variant (f02) match (implementation={vendor(score(3):gnu)},device={kind(cpu)}) ! (1 or 2) + 3
+    !$omp declare variant (f03) match (implementation={vendor(score(5):gnu)},device={kind(host)}) ! (1 or 2) + 5
+    f04 = x
+  end function
+
+  integer function test1 (x)
+    !$omp declare simd
+    integer, intent (in) :: x
+    integer :: a, b
+
+    ! At gimplification time, we can't decide yet which function to call.
+    ! { dg-final { scan-tree-dump-times "f04 \\\(x" 2 "gimple" } }
+    ! After simd clones are created, the original non-clone test1 shall
+    ! call f03 (score 6), the sse2/avx/avx2 clones too, but avx512f clones
+    ! shall call f01 with score 8.
+    ! { dg-final { scan-tree-dump-not "f04 \\\(x" "optimized" } }
+    ! { dg-final { scan-tree-dump-times "f03 \\\(x" 14 "optimized" } }
+    ! { dg-final { scan-tree-dump-times "f01 \\\(x" 4 "optimized" } }
+    a = f04 (x)
+    b = f04 (x)
+    test1 = a + b
+  end function
+end module
diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-variant-15.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-variant-15.f90
new file mode 100644
index 00000000000..b2ad96a8998
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-variant-15.f90
@@ -0,0 +1,24 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-gimple" }
+
+! Test 'declare variant' directive with an explicit base procedure name.
+
+module main
+  implicit none
+  
+  !$omp declare variant (base: variant) match (construct={target,parallel})
+contains
+  subroutine variant ()
+  end subroutine
+
+  subroutine base ()
+  end subroutine
+
+  subroutine test1 ()
+    !$omp target
+      !$omp parallel
+	call base ()	! { dg-final { scan-tree-dump-times "variant \\\(\\\);" 1 "gimple" } }
+      !$omp end parallel
+    !$omp end target
+  end subroutine
+end module
diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-variant-16.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-variant-16.f90
new file mode 100644
index 00000000000..fc97322e667
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-variant-16.f90
@@ -0,0 +1,24 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-gimple" }
+
+! Test that 'declare variant' works when applied to an external subroutine
+
+module main
+  implicit none
+  
+  interface
+    subroutine base ()
+      !$omp declare variant (variant) match (construct={parallel})
+    end subroutine
+  end interface
+
+contains
+  subroutine variant ()
+  end subroutine
+
+  subroutine test ()
+    !$omp parallel
+      call base ()  ! { dg-final { scan-tree-dump-times "variant \\\(\\\);" 1 "gimple" } }
+    !$omp end parallel
+  end subroutine
+end module
diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-variant-17.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-variant-17.f90
new file mode 100644
index 00000000000..df57f9c089c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-variant-17.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+
+! Declare variant directives should only appear in the specification parts.
+
+program main
+  implicit none
+
+  continue
+
+  !$omp declare variant (base: variant) match (construct={parallel})  ! { dg-error "Unexpected \\\!\\\$OMP DECLARE VARIANT statement at .1." }
+contains
+  subroutine base ()
+    continue
+
+    !$omp declare variant (variant) match (construct={parallel})  ! { dg-error "Unexpected \\\!\\\$OMP DECLARE VARIANT statement at .1." }
+  end subroutine
+end program
diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-variant-18.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-variant-18.f90
new file mode 100644
index 00000000000..f97cf34a28a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-variant-18.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+
+! The base procedure must have an accessible explicit interface when the
+! directive appears.
+
+program main
+  interface
+    subroutine base_proc ()
+    end subroutine
+  end interface
+
+  !$omp declare variant (base_proc: variant_proc) match (construct={parallel})
+  !$omp declare variant (base_proc2: variant_proc) match (construct={parallel}) ! { dg-error "The base procedure at .1. must have an explicit interface" }
+contains
+  subroutine variant_proc ()
+  end subroutine
+end program
diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-variant-19.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-variant-19.f90
new file mode 100644
index 00000000000..d387f5e9065
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-variant-19.f90
@@ -0,0 +1,49 @@
+! { dg-do compile }
+
+! Test Fortran-specific compilation failures.
+
+module main
+  implicit none
+  
+  interface base_gen
+    subroutine base_gen_int (x)
+      integer :: x
+    end subroutine
+
+    subroutine base_gen_real (x)
+      real :: x
+    end subroutine
+  end interface
+
+  interface
+    subroutine base_p ()
+    end subroutine
+  end interface
+
+  procedure (base_p), pointer :: base_proc_ptr
+
+  !$omp declare variant (base_entry: variant) match (construct={parallel}) ! { dg-error "The base name at .1. must not be an entry name" }
+  !$omp declare variant (base_proc_ptr: variant) match (construct={parallel}) ! { dg-error "The base name at .1. must not be a procedure pointer" }
+  !$omp declare variant (base_gen: variant2) match (construct={parallel}) ! { dg-error "The base name at .1. must not be a generic name" }
+  !$omp declare variant (variant) match (construct={parallel}) ! { dg-error "The base name for 'declare variant' must be specified at .1." }
+  
+contains
+  subroutine base ()
+    entry base_entry
+  end subroutine
+
+  subroutine base2 ()
+    !$omp declare variant (variant2) match (construct={parallel})   ! { dg-error "variant .variant2. and base .base2. at .1. have incompatible types: .variant2. has the wrong number of arguments" }
+  end subroutine
+
+  subroutine base3 ()
+    !$omp declare variant (base: variant2) match (construct={parallel}) ! { dg-error "The base name at .1. does not match the name of the current procedure" }
+  end subroutine
+
+  subroutine variant ()
+  end subroutine
+
+  subroutine variant2 (x)
+    integer :: x
+  end subroutine
+end module
diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-variant-2.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-variant-2.f90
new file mode 100644
index 00000000000..63d77780196
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-variant-2.f90
@@ -0,0 +1,197 @@
+module main
+  implicit none
+contains
+  subroutine f0 ()
+  end subroutine
+  subroutine f1 ()
+  end subroutine
+  subroutine f2 ()
+    !$omp declare variant	! { dg-error "expected '\\(' at .1." }
+  end subroutine
+  subroutine f3 ()
+    !$omp declare variant (	! { dg-error "" }
+  end subroutine
+  subroutine f4 ()
+    !$omp declare variant ()	! { dg-error "" }
+  end subroutine
+  subroutine f5 ()
+    !$omp declare variant match(user={condition(0)})	! { dg-error "expected '\\(' at .1." }
+  end subroutine
+  subroutine f6 ()
+    !$omp declare variant (f1)	! { dg-error "expected 'match' at .1." }
+  end subroutine
+  subroutine f7 ()
+    !$omp declare variant (f1) simd	! { dg-error "expected 'match' at .1." }
+  end subroutine
+  subroutine f8 ()
+    !$omp declare variant (f1) match	! { dg-error "expected '\\(' at .1." }
+  end subroutine
+  subroutine f9 ()
+    !$omp declare variant (f1) match(	! { dg-error "expected 'construct', 'device', 'implementation' or 'user' at .1." }
+  end subroutine
+  subroutine f10 ()
+    !$omp declare variant (f1) match()	! { dg-error "expected 'construct', 'device', 'implementation' or 'user' at .1." }
+  end subroutine
+  subroutine f11 ()
+    !$omp declare variant (f1) match(foo)	! { dg-error "expected 'construct', 'device', 'implementation' or 'user' at .1." }
+  end subroutine
+  subroutine f12 ()
+    !$omp declare variant (f1) match(something={something})	! { dg-error "expected 'construct', 'device', 'implementation' or 'user' at .1." }
+  end subroutine
+  subroutine f13 ()
+    !$omp declare variant (f1) match(user)	! { dg-error "expected '=' at .1." }
+  end subroutine
+  subroutine f14 ()
+    !$omp declare variant (f1) match(user=)	! { dg-error "expected '\\\{' at .1." }
+  end subroutine
+  subroutine f15 ()
+    !$omp declare variant (f1) match(user=	! { dg-error "expected '\\\{' at .1." }
+  end subroutine
+  subroutine f16 ()
+    !$omp declare variant (f1) match(user={)	! { dg-error "expected trait selector name at .1." }
+  end subroutine
+  subroutine f17 ()
+    !$omp declare variant (f1) match(user={})	! { dg-error "expected trait selector name at .1." }
+  end subroutine
+  subroutine f18 ()
+    !$omp declare variant (f1) match(user={condition})	! { dg-error "expected '\\(' at .1." }
+  end subroutine
+  subroutine f19 ()
+    !$omp declare variant (f1) match(user={condition(})	! { dg-error "expected expression at .1." }
+  end subroutine
+  subroutine f20 ()
+    !$omp declare variant (f1) match(user={condition()})	! { dg-error "expected expression at .1." }
+  end subroutine
+  subroutine f21 ()
+    !$omp declare variant (f1) match(user={condition(f1)})	! { dg-error "expected expression at .1." }
+  end subroutine
+  subroutine f22 ()
+    !$omp declare variant (f1) match(user={condition(1, 2, 3)})	! { dg-error "expected '\\)' at .1." }
+  end subroutine
+  subroutine f23 ()
+    !$omp declare variant (f1) match(construct={master})	! { dg-error "selector 'master' not allowed for context selector set 'construct' at .1." }
+  end subroutine
+  subroutine f24 ()
+    !$omp declare variant (f1) match(construct={teams,parallel,master,do})	! { dg-error "selector 'master' not allowed for context selector set 'construct' at .1." }
+  end subroutine
+  subroutine f25 ()
+    !$omp declare variant (f1) match(construct={parallel(1	! { dg-error "selector 'parallel' does not accept any properties at .1." }
+  end subroutine
+  subroutine f26 ()
+    !$omp declare variant (f1) match(construct={parallel(1)})	! { dg-error "selector 'parallel' does not accept any properties at .1." }
+  end subroutine
+  subroutine f27 ()
+    !$omp declare variant (f0) match(construct={simd(12)})	! { dg-error "expected simd clause at .1." }
+  end subroutine
+  subroutine f32 ()
+    !$omp declare variant (f1) match(device={kind})	! { dg-error "expected '\\(' at .1." }
+  end subroutine
+  subroutine f33 ()
+    !$omp declare variant (f1) match(device={isa})	! { dg-error "expected '\\(' at .1." }
+  end subroutine
+  subroutine f34 ()
+    !$omp declare variant (f1) match(device={arch})	! { dg-error "expected '\\(' at .1." }
+  end subroutine
+  subroutine f35 ()
+    !$omp declare variant (f1) match(device={kind,isa,arch})	! { dg-error "expected '\\(' at .1." }
+  end subroutine
+  subroutine f36 ()
+    !$omp declare variant (f1) match(device={kind(})	! { dg-error "expected identifier or string literal at .1." }
+  end subroutine
+  subroutine f39 ()
+    !$omp declare variant (f1) match(device={isa(1)})	! { dg-error "expected identifier or string literal at .1." }
+  end subroutine
+  subroutine f40 ()
+    !$omp declare variant (f1) match(device={arch(17)})	! { dg-error "expected identifier or string literal at .1." }
+  end subroutine
+  subroutine f41 ()
+    !$omp declare variant (f1) match(device={foobar(3)})
+  end subroutine
+  subroutine f43 ()
+    !$omp declare variant (f1) match(implementation={foobar(3)})
+  end subroutine
+  subroutine f44 ()
+    !$omp declare variant (f1) match(implementation={vendor})	! { dg-error "expected '\\(' at .1." }
+  end subroutine
+  subroutine f45 ()
+    !$omp declare variant (f1) match(implementation={extension})	! { dg-error "expected '\\(' at .1." }
+  end subroutine
+  subroutine f45a ()
+    !$omp declare variant (f1) match(implementation={vendor()})	! { dg-error "expected identifier or string literal at .1." }
+  end subroutine
+  subroutine f46 ()
+    !$omp declare variant (f1) match(implementation={vendor(123-234)})	! { dg-error "expected identifier or string literal at .1." }
+  end subroutine
+  subroutine f48 ()
+    !$omp declare variant (f1) match(implementation={unified_address(yes)})	! { dg-error "selector 'unified_address' does not accept any properties at .1." }
+  end subroutine
+  subroutine f49 ()
+    !$omp declare variant (f1) match(implementation={unified_shared_memory(no)})	! { dg-error "selector 'unified_shared_memory' does not accept any properties at .1." }
+  end subroutine
+  subroutine f50 ()
+    !$omp declare variant (f1) match(implementation={dynamic_allocators(42)})	! { dg-error "selector 'dynamic_allocators' does not accept any properties at .1." }
+  end subroutine
+  subroutine f51 ()
+    !$omp declare variant (f1) match(implementation={reverse_offload()})	! { dg-error "selector 'reverse_offload' does not accept any properties at .1." }
+  end subroutine
+  subroutine f52 ()
+    !$omp declare variant (f1) match(implementation={atomic_default_mem_order})	! { dg-error "expected '\\('" }
+  end subroutine
+  subroutine f56 ()
+    !$omp declare variant (f1) match(implementation={atomic_default_mem_order(relaxed,seq_cst)})	! { dg-error "expected '\\)' at .1." }
+  end subroutine
+  subroutine f58 ()
+    !$omp declare variant (f1) match(user={foobar(3)})	! { dg-error "selector 'foobar' not allowed for context selector set 'user' at .1." }
+  end subroutine
+  subroutine f59 ()
+    !$omp declare variant (f1) match(construct={foobar(3)})	! { dg-error "selector 'foobar' not allowed for context selector set 'construct' at .1." }
+  end subroutine
+  subroutine f60 ()
+    !$omp declare variant (f1) match(construct={parallel},foobar={bar})	! { dg-error "expected 'construct', 'device', 'implementation' or 'user' at .1." }
+  end subroutine
+  subroutine f64 ()
+    !$omp declare variant (f1) match(construct={single})	! { dg-error "selector 'single' not allowed for context selector set 'construct' at .1." }
+  end subroutine
+  subroutine f65 ()
+    !$omp declare variant (f1) match(construct={taskgroup})	! { dg-error "selector 'taskgroup' not allowed for context selector set 'construct' at .1." }
+  end subroutine
+  subroutine f66 ()
+    !$omp declare variant (f1) match(construct={for})	! { dg-error "selector 'for' not allowed for context selector set 'construct' at .1." }
+  end subroutine
+  subroutine f67 ()
+    !$omp declare variant (f1) match(construct={threadprivate})	! { dg-error "selector 'threadprivate' not allowed for context selector set 'construct' at .1." }
+  end subroutine
+  subroutine f68 ()
+    !$omp declare variant (f1) match(construct={critical})	! { dg-error "selector 'critical' not allowed for context selector set 'construct' at .1." }
+  end subroutine
+  subroutine f69 ()
+    !$omp declare variant (f1) match(construct={task})	! { dg-error "selector 'task' not allowed for context selector set 'construct' at .1." }
+  end subroutine
+  subroutine f70 ()
+    !$omp declare variant (f1) match(construct={taskloop})	! { dg-error "selector 'taskloop' not allowed for context selector set 'construct' at .1." }
+  end subroutine
+  subroutine f71 ()
+    !$omp declare variant (f1) match(construct={sections})	! { dg-error "selector 'sections' not allowed for context selector set 'construct' at .1." }
+  end subroutine
+  subroutine f72 ()
+    !$omp declare variant (f1) match(construct={section})	! { dg-error "selector 'section' not allowed for context selector set 'construct' at .1." }
+  end subroutine
+  subroutine f73 ()
+    !$omp declare variant (f1) match(construct={workshare})	! { dg-error "selector 'workshare' not allowed for context selector set 'construct' at .1." }
+  end subroutine
+  subroutine f74 ()
+    !$omp declare variant (f1) match(construct={requires})	! { dg-error "selector 'requires' not allowed for context selector set 'construct' at .1." }
+  end subroutine
+  subroutine f75 ()
+    !$omp declare variant (f1),match(construct={parallel})	! { dg-error "expected 'match' at .1." }
+  end subroutine
+  subroutine f76 ()
+    !$omp declare variant (f1) match(implementation={atomic_default_mem_order("relaxed")})	! { dg-error "expected identifier at .1." }
+  end subroutine
+  subroutine f77 ()
+    !$omp declare variant (f1) match(user={condition(score(f76):1)})  ! { dg-error "score argument must be constant integer expression at .1." }
+  end subroutine
+  subroutine f78 ()
+    !$omp declare variant (f1) match(user={condition(score(-130):1)}) ! { dg-error "score argument must be non-negative" }
+  end subroutine
+end module
diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-variant-2a.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-variant-2a.f90
new file mode 100644
index 00000000000..56de1177789
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-variant-2a.f90
@@ -0,0 +1,53 @@
+module main
+  implicit none
+contains
+  subroutine f1 ()
+  end subroutine
+  subroutine f28 ()
+    !$omp declare variant (f1) match(construct={parallel},construct={do})  ! { dg-error "selector set 'construct' specified more than once" }
+  end subroutine
+  subroutine f29 ()
+    !$omp declare variant (f1) match(construct={parallel},construct={parallel}) ! { dg-error "selector set 'construct' specified more than once" }
+  end subroutine
+  subroutine f30 ()
+    !$omp declare variant (f1) match(user={condition(0)},construct={target},user={condition(0)})  ! { dg-error "selector set 'user' specified more than once" }
+  end subroutine
+  subroutine f31 ()
+    !$omp declare variant (f1) match(user={condition(0)},user={condition(1)}) ! { dg-error "selector set 'user' specified more than once" }
+  end subroutine
+  subroutine f37 ()
+    !$omp declare variant (f1) match(device={kind(unknown)})  ! { dg-warning "unknown property 'unknown' of 'kind' selector" }
+  end subroutine
+  subroutine f38 ()
+    !$omp declare variant (f1) match(device={kind(unknown,foobar)})	! { dg-warning "unknown property 'unknown' of 'kind' selector" }
+									! { dg-warning "unknown property 'foobar' of 'kind' selector" "" { target *-*-* } 22 }
+  end subroutine
+  subroutine f42 ()
+    !$omp declare variant (f1) match(device={arch(x86_64)},device={isa(avx512vl)})  ! { dg-error "selector set 'device' specified more than once" }
+  end subroutine
+  subroutine f47 ()
+    !$omp declare variant (f1) match(implementation={vendor("foobar")}) ! { dg-warning "unknown property '.foobar.' of 'vendor' selector" }
+  end subroutine
+  subroutine f53 ()
+    !$omp declare variant (f1) match(implementation={atomic_default_mem_order(acquire)})  ! { dg-error "incorrect property 'acquire' of 'atomic_default_mem_order' selector" }
+  end subroutine
+  subroutine f54 ()
+    !$omp declare variant (f1) match(implementation={atomic_default_mem_order(release)})  ! { dg-error "incorrect property 'release' of 'atomic_default_mem_order' selector" }
+  end subroutine
+  subroutine f55 ()
+    !$omp declare variant (f1) match(implementation={atomic_default_mem_order(foobar)}) ! { dg-error "incorrect property 'foobar' of 'atomic_default_mem_order' selector" }
+  end subroutine
+  subroutine f57 ()
+    !$omp declare variant (f1) match(implementation={atomic_default_mem_order(relaxed)},&
+    !$omp & implementation={atomic_default_mem_order(relaxed)}) ! { dg-error "selector set 'implementation' specified more than once" "" { target *-*-* } 41  }
+  end subroutine
+  subroutine f61 ()
+    !$omp declare variant (f1) match(construct={parallel,parallel}) ! { dg-error "selector 'parallel' specified more than once in set 'construct'" }
+  end subroutine
+  subroutine f62 ()
+    !$omp declare variant (f1) match(construct={target,parallel,do,simd,parallel}) ! { dg-error "selector 'parallel' specified more than once in set 'construct'" }
+  end subroutine
+  subroutine f63 ()
+    !$omp declare variant (f1) match(construct={target,teams,teams})  ! { dg-error "selector 'teams' specified more than once in set 'construct'" }
+  end subroutine
+end module
diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-variant-3.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-variant-3.f90
new file mode 100644
index 00000000000..c62622b607b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-variant-3.f90
@@ -0,0 +1,237 @@
+module main
+contains
+  subroutine f1 ()
+  end subroutine
+  subroutine f2 ()
+    !$omp declare variant (f1) match (construct={target})
+  end subroutine
+  subroutine f3 ()
+  end subroutine
+  subroutine f4 ()
+    !$omp declare variant (f3) match (construct={teams})
+  end subroutine
+  subroutine f5 ()
+  end subroutine
+  subroutine f6 ()
+    !$omp declare variant (f5) match (construct={parallel})
+  end subroutine
+  subroutine f7 ()
+  end subroutine
+  subroutine f8 ()
+    !$omp declare variant (f7) match (construct={do})
+  end subroutine
+  subroutine f9 ()
+  end subroutine
+  subroutine f10 ()
+    !$omp declare variant (f9) match (construct={target,teams,parallel,do})
+  end subroutine
+  subroutine f11 ()
+  end subroutine
+  subroutine f12 ()
+    !$omp declare variant (f11) match (construct={teams,do,parallel})
+  end subroutine
+  subroutine f13 ()
+  end subroutine
+  subroutine f14 ()
+    !$omp declare variant (f13) match (device={kind(any)})
+  end subroutine
+  subroutine f15 ()
+    !$omp declare variant (f13) match (device={kind("host")})
+  end subroutine
+  subroutine f16 ()
+    !$omp declare variant (f13) match (device={kind(nohost)})
+  end subroutine
+  subroutine f17 ()
+    !$omp declare variant (f13) match (device={kind(cpu)})
+  end subroutine
+  subroutine f18 ()
+    !$omp declare variant (f13) match (device={kind("gpu")})
+  end subroutine
+  subroutine f19 ()
+    !$omp declare variant (f13) match (device={kind(fpga)})
+  end subroutine
+  subroutine f20 ()
+    !$omp declare variant (f13) match (device={kind(any,any)})
+  end subroutine
+  subroutine f21 ()
+    !$omp declare variant (f13) match (device={kind(host,nohost)})
+  end subroutine
+  subroutine f22 ()
+    !$omp declare variant (f13) match (device={kind("cpu","gpu","fpga")})
+  end subroutine
+  subroutine f23 ()
+    !$omp declare variant (f13) match (device={kind(any,cpu,nohost)})
+  end subroutine
+  subroutine f24 ()
+    !$omp declare variant (f13) match (device={isa(avx)})
+  end subroutine
+  subroutine f25 ()
+    !$omp declare variant (f13) match (device={isa(sse4,"avx512f",avx512vl,avx512bw)})
+  end subroutine
+  subroutine f26 ()
+    !$omp declare variant (f13) match (device={arch("x86_64")})
+  end subroutine
+  subroutine f27 ()
+    !$omp declare variant (f13) match (device={arch(riscv64)})
+  end subroutine
+  subroutine f28 ()
+    !$omp declare variant (f13) match (device={arch(nvptx)})
+  end subroutine
+  subroutine f29 ()
+    !$omp declare variant (f13) match (device={arch(x86_64),isa("avx512f","avx512vl"),kind(cpu)})
+  end subroutine
+  subroutine f30 ()
+    !$omp declare variant (f13) match (implementation={vendor(amd)})
+  end subroutine
+  subroutine f31 ()
+    !$omp declare variant (f13) match (implementation={vendor(arm)})
+  end subroutine
+  subroutine f32 ()
+    !$omp declare variant (f13) match (implementation={vendor("bsc")})
+  end subroutine
+  subroutine f33 ()
+    !$omp declare variant (f13) match (implementation={vendor(cray)})
+  end subroutine
+  subroutine f34 ()
+    !$omp declare variant (f13) match (implementation={vendor(fujitsu)})
+  end subroutine
+  subroutine f35 ()
+    !$omp declare variant (f13) match (implementation={vendor(gnu)})
+  end subroutine
+  subroutine f36 ()
+    !$omp declare variant (f13) match (implementation={vendor(ibm)})
+  end subroutine
+  subroutine f37 ()
+    !$omp declare variant (f13) match (implementation={vendor("intel")})
+  end subroutine
+  subroutine f38 ()
+    !$omp declare variant (f13) match (implementation={vendor(llvm)})
+  end subroutine
+  subroutine f39 ()
+    !$omp declare variant (f13) match (implementation={vendor(pgi)})
+  end subroutine
+  subroutine f40 ()
+    !$omp declare variant (f13) match (implementation={vendor(ti)})
+  end subroutine
+  subroutine f41 ()
+    !$omp declare variant (f13) match (implementation={vendor(unknown)})
+  end subroutine
+  subroutine f42 ()
+    !$omp declare variant (f13) match (implementation={vendor(gnu,llvm,intel,ibm)})
+  end subroutine
+  subroutine f43 ()
+    !$omp declare variant (f13) match (implementation={extension(my_cute_extension)})	! { dg-warning "unknown property 'my_cute_extension' of 'extension' selector" }
+  end subroutine
+  subroutine f44 ()
+    !$omp declare variant (f13) match (implementation={extension(some_other_ext,another_ext)})	! { dg-warning "unknown property 'some_other_ext' of 'extension' selector" }
+												! { dg-warning "unknown property 'another_ext' of 'extension' selector" "" { target *-*-* } .-1 }
+  end subroutine
+  subroutine f45 ()
+    !$omp declare variant (f13) match (implementation={unified_shared_memory})
+  end subroutine
+  subroutine f46 ()
+    !$omp declare variant (f13) match (implementation={unified_address})
+  end subroutine
+  subroutine f47 ()
+    !$omp declare variant (f13) match (implementation={dynamic_allocators})
+  end subroutine
+  subroutine f48 ()
+    !$omp declare variant (f13) match (implementation={reverse_offload})
+  end subroutine
+  subroutine f49 ()
+    !$omp declare variant (f13) match (implementation={atomic_default_mem_order(seq_cst)})
+  end subroutine
+  subroutine f50 ()
+    !$omp declare variant (f13) match (implementation={atomic_default_mem_order(relaxed)})
+  end subroutine
+  subroutine f51 ()
+    !$omp declare variant (f13) match (implementation={atomic_default_mem_order(acq_rel)})
+  end subroutine
+  subroutine f52 ()
+    !$omp declare variant (f14) match (implementation={atomic_default_mem_order(acq_rel),vendor(gnu),&
+    !$omp&					       unified_address,extension(foobar)}) ! { dg-warning "unknown property 'foobar' of 'extension' selector" "" { target *-*-* } .-1 }
+  end subroutine
+  subroutine f53 ()
+    !$omp declare variant (f13) match (implementation={vendor(score(3):amd)})
+  end subroutine
+  subroutine f54 ()
+    !$omp declare variant (f13) match (implementation={vendor(score(4):"arm")})
+  end subroutine
+  subroutine f55 ()
+    !$omp declare variant (f13) match (implementation={vendor(score(5):bsc)})
+  end subroutine
+  subroutine f56 ()
+    !$omp declare variant (f13) match (implementation={vendor(score(6):cray)})
+  end subroutine
+  subroutine f57 ()
+    !$omp declare variant (f13) match (implementation={vendor(score(7):fujitsu)})
+  end subroutine
+  subroutine f58 ()
+    !$omp declare variant (f13) match (implementation={vendor(score(8):gnu)})
+  end subroutine
+  subroutine f59 ()
+    !$omp declare variant (f13) match (implementation={vendor(score(9):ibm)})
+  end subroutine
+  subroutine f60 ()
+    !$omp declare variant (f13) match (implementation={vendor(score(10):intel)})
+  end subroutine
+  subroutine f61 ()
+    !$omp declare variant (f13) match (implementation={vendor(score(11):llvm)})
+  end subroutine
+  subroutine f62 ()
+    !$omp declare variant (f13) match (implementation={vendor(score(12):pgi)})
+  end subroutine
+  subroutine f63 ()
+    !$omp declare variant (f13) match (implementation={vendor(score(13):"ti")})
+  end subroutine
+  subroutine f64 ()
+    !$omp declare variant (f13) match (implementation={vendor(score(14):unknown)})
+  end subroutine
+  subroutine f65 ()
+    !$omp declare variant (f13) match (implementation={vendor(score(15):gnu,llvm,intel,ibm)})
+  end subroutine
+  subroutine f66 ()
+    !$omp declare variant (f13) match (implementation={extension(score(16):my_cute_extension)})	! { dg-warning "unknown property 'my_cute_extension' of 'extension' selector" }
+  end subroutine
+  subroutine f67 ()
+    !$omp declare variant (f13) match (implementation={extension(score(17):some_other_ext,another_ext)})	! { dg-warning "unknown property 'some_other_ext' of 'extension' selector" }
+  end subroutine												! { dg-warning "unknown property 'another_ext' of 'extension' selector" "" { target *-*-* } .-1 }
+  subroutine f68 ()
+    !$omp declare variant (f13) match (implementation={atomic_default_mem_order(score(18):seq_cst)})
+  end subroutine
+  subroutine f69 ()
+    !$omp declare variant (f13) match (implementation={atomic_default_mem_order(score(19):relaxed)})
+  end subroutine
+  subroutine f70 ()
+    !$omp declare variant (f13) match (implementation={atomic_default_mem_order(score(20):acq_rel)})
+  end subroutine
+  subroutine f71 ()
+    !$omp declare variant (f13) match (implementation={atomic_default_mem_order(score(21):acq_rel),&
+    !$omp&					       vendor(score(22):gnu),unified_address,extension(score(22):foobar)})	! { dg-warning "unknown property 'foobar' of 'extension' selector" "" { target *-*-* } .-1 }
+  end subroutine
+  subroutine f72 ()
+    !$omp declare variant (f13) match (user={condition(0)})
+  end subroutine
+  subroutine f73 ()
+    !$omp declare variant (f13) match (user={condition(272-272*1)})
+  end subroutine
+  subroutine f74 ()
+    !$omp declare variant (f13) match (user={condition(score(25):1)})
+  end subroutine
+  subroutine f75 ()
+    !$omp declare variant (f13) match (device={kind(any,"any")})
+  end subroutine
+  subroutine f76 ()
+    !$omp declare variant (f13) match (device={kind("any","any")})
+  end subroutine
+  subroutine f77 ()
+    !$omp declare variant (f13) match (device={kind("any",any)})
+  end subroutine
+  subroutine f78 ()
+    !$omp declare variant (f13) match (implementation={vendor(nvidia)})
+  end subroutine
+  subroutine f79 ()
+    !$omp declare variant (f13) match (user={condition(score(0):0)})
+  end subroutine
+
+  end module
diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-variant-4.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-variant-4.f90
new file mode 100644
index 00000000000..bc4f41647b4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-variant-4.f90
@@ -0,0 +1,62 @@
+program main
+  implicit none
+contains
+  function f6 (x, y, z)
+    real (kind = 8) :: f6
+    integer, intent(in) :: x
+    integer (kind = 8), intent(in) :: y
+    real (kind = 4), intent(in) :: z
+
+    interface
+      function f1 (x, y, z)
+        real (kind = 8) :: f1
+        integer, intent(in) :: x
+        integer (kind = 8), intent(in) :: y
+        real (kind = 4), intent(in) :: z
+      end function
+
+      function f2 (x, y, z)
+        real (kind = 8) :: f2
+        integer, intent(in) :: x
+        integer (kind = 8), intent(in) :: y
+        real (kind = 4), intent(in) :: z
+      end function
+
+      function f3 (x, y, z)
+        real (kind = 8) :: f3
+        integer, intent(in) :: x
+        integer (kind = 8), intent(in) :: y
+        real (kind = 4), intent(in) :: z
+      end function
+
+      function f4 (x, y, z)
+        real (kind = 8) :: f4
+        integer, intent(in) :: x
+        integer (kind = 8), intent(in) :: y
+        real (kind = 4), intent(in) :: z
+      end function
+
+      function f5 (x, y, z)
+        real (kind = 8) :: f5
+        integer, intent(in) :: x
+        integer (kind = 8), intent(in) :: y
+        real (kind = 4), intent(in) :: z
+      end function
+    end interface
+
+    !$omp declare variant (f1) match (user={condition(1)})
+    !$omp declare variant (f2) match (user={condition(score(1):1)})
+    !$omp declare variant (f3) match (user={condition(score(3):1)})
+    !$omp declare variant (f4) match (user={condition(score(2):1)})
+    !$omp declare variant (f5) match (implementation={vendor(gnu)})
+
+    f6 = z + x + y
+  end function
+
+  function test (x)
+    real (kind = 8) :: test
+    integer, intent(in) :: x
+
+    test = f6 (x, int (x, kind = 8), 3.5)
+  end function
+end program
diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-variant-5.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-variant-5.f90
new file mode 100644
index 00000000000..ad7acb9842d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-variant-5.f90
@@ -0,0 +1,75 @@
+! { dg-do compile { target i?86-*-* x86_64-*-* } }
+! { dg-additional-options "-mavx2" }
+
+module main
+  implicit none
+contains
+  function f1 (x, y, z)
+    integer, dimension(4) :: f1
+    real, dimension(4), intent(in) :: x, y
+    real, intent(out) :: z
+
+    f1 = x
+  end function
+
+  function f2 (x, y, z)
+    integer, dimension(8) :: f2
+    real, dimension(8), intent(in) :: x, y
+    real, intent(out) :: z
+
+    f2 = x
+  end function
+
+  function f3 (x, y, z)
+    integer, dimension(4) :: f3
+    real, dimension(4), intent(in) :: x, z
+    integer, intent(in) :: y
+
+    f3 = x
+  end function
+
+  integer function f4 (x, y, z)
+    real, intent(in) :: x, y
+    real, intent(out) :: z
+    !$omp declare variant (f1) match (construct={parallel,do,simd(simdlen(4),notinbranch,uniform(z),aligned(z:16))})
+    !$omp declare variant (f2) match (construct={do,simd(uniform(z),simdlen(8),notinbranch)})
+  end function
+
+  integer function f5 (x, y)
+    integer, intent(in) :: x, y
+    !$omp declare variant (f3) match (construct={simd(simdlen(4),inbranch,linear(y:1))})
+  end function
+
+  subroutine test (x, y, z, w)
+    integer, dimension(8192), intent(inout) :: x
+    real, dimension(8192), intent(inout) :: y, z
+    real, pointer, intent(out) :: w
+    integer :: i
+
+    !$omp parallel
+    !$omp do simd aligned (w:16)
+    do i = 1, 1024
+      x(i) = f4 (y(i), z(i), w)
+    end do
+    !$omp end do simd
+    !$omp end parallel
+
+    !$omp parallel do simd aligned (w:16) simdlen(4)
+    do i = 1025, 2048
+      x(i) = f4 (y(i), z(i), w)
+    end do
+    !$omp end parallel do simd
+
+    !$omp simd aligned (w:16)
+    do i = 2049, 4096
+      x(i) = f4 (y(i), z(i), w)
+    end do
+    !$omp end simd
+
+    !$omp simd
+    do i = 4097, 8192
+      if (x(i) .gt. 10) x(i) = f5 (x(i), i)
+    end do
+    !$omp end simd
+  end subroutine
+end module
diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-variant-6.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-variant-6.f90
new file mode 100644
index 00000000000..3f33f38b9bc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-variant-6.f90
@@ -0,0 +1,188 @@
+module main
+  implicit none
+contains
+  function f1 (x, y, z)
+    real (kind = 8) :: f1
+    integer, intent(in) :: x
+    integer (kind = 8), intent(in) :: y
+    real :: z
+
+    f1 = 0.0
+  end function
+
+  function f2 (x, y, z)
+    real (kind = 8) :: f2
+    integer, intent(in) :: x
+    integer (kind = 8), intent(in) :: y
+    real :: z
+
+    f2 = 0.0
+  end function
+
+  function f3 (x, y, z)
+    real (kind = 8) :: f3
+    integer, intent(in) :: x
+    integer (kind = 8), intent(in) :: y
+    real :: z
+    !$omp declare variant (f1) match (user={condition(0)},construct={parallel})
+    f3 = 0.0
+  end function
+
+  function f4 (x, y, z)
+    real (kind = 8) :: f4
+    integer, intent(in) :: x
+    integer (kind = 8), intent(in) :: y
+    real :: z
+    !$omp declare variant (f1) match (construct={parallel},user={condition(score(1):1)})
+    f4 = 0.0
+  end function
+
+  function f5 (x, y, z)
+    real (kind = 8) :: f5
+    integer, intent(in) :: x
+    integer (kind = 8), intent(in) :: y
+    real :: z
+    f5 = 0.0
+  end function
+
+  function f6 (x, y, z)
+    real (kind = 8) :: f6
+    integer, intent(in) :: x
+    integer (kind = 8), intent(in) :: y
+    real :: z
+    !$omp declare variant (f5) match (user={condition(0)})  ! { dg-error "'f5' used as a variant with incompatible 'construct' selector sets" }
+    f6 = 0.0
+  end function
+
+  function f7 (x, y, z)
+    real (kind = 8) :: f7
+    integer, intent(in) :: x
+    integer (kind = 8), intent(in) :: y
+    real :: z
+    !$omp declare variant (f5) match (construct={parallel},user={condition(score(1):1)})
+    f7 = 0.0
+  end function
+
+  function f8 (x, y, z)
+    real (kind = 8) :: f8
+    integer, intent(in) :: x
+    integer (kind = 8), intent(in) :: y
+    real :: z
+    f8 = 0.0
+  end function
+
+  function f9 (x, y, z)
+    real (kind = 8) :: f9
+    integer, intent(in) :: x
+    integer (kind = 8), intent(in) :: y
+    real :: z
+    !$omp declare variant (f8) match (user={condition(0)},construct={do})  ! { dg-error "'f8' used as a variant with incompatible 'construct' selector sets" }
+    f9 = 0.0
+  end function
+
+  function f10 (x, y, z)
+    real (kind = 8) :: f10
+    integer, intent(in) :: x
+    integer (kind = 8), intent(in) :: y
+    real :: z
+    !$omp declare variant (f8) match (user={condition(1)})
+    f10 = 0.0
+  end function
+
+  function f11 (x, y, z)
+    real (kind = 8) :: f11
+    integer, intent(in) :: x
+    integer (kind = 8), intent(in) :: y
+    real :: z
+    f11 = 0.0
+  end function
+
+  function f12 (x, y, z)
+    real (kind = 8) :: f12
+    integer, intent(in) :: x
+    integer (kind = 8), intent(in) :: y
+    real :: z
+    !$omp declare variant (f11) match (construct={target,teams,parallel,do})  ! { dg-error "'f11' used as a variant with incompatible 'construct' selector sets" }
+    f12 = 0.0
+  end function
+
+  function f13 (x, y, z)
+    real (kind = 8) :: f13
+    integer, intent(in) :: x
+    integer (kind = 8), intent(in) :: y
+    real :: z
+    !$omp declare variant (f11) match (user={condition(score(1):1)},construct={target,teams,parallel,do})  ! { dg-error "'f11' used as a variant with incompatible 'construct' selector sets" }
+    f13 = 0.0
+  end function
+
+  function f14 (x, y, z)
+    real (kind = 8) :: f14
+    integer, intent(in) :: x
+    integer (kind = 8), intent(in) :: y
+    real :: z
+    !$omp declare variant (f11) match (implementation={vendor(gnu)},construct={target,teams,parallel})  ! { dg-error "'f11' used as a variant with incompatible 'construct' selector sets" }
+    f14 = 0.0
+  end function
+
+  function f15 (x, y, z)
+    real (kind = 8) :: f15
+    integer, intent(in) :: x
+    integer (kind = 8), intent(in) :: y
+    real :: z
+    !$omp declare variant (f11) match (device={kind(any)},construct={teams,parallel})
+    f15 = 0.0
+  end function
+
+  function f16 (x, y, z)
+    real (kind = 8) :: f16
+    integer, intent(in) :: x
+    integer (kind = 8), intent(in) :: y
+    real :: z
+    f16 = 0.0
+  end function
+
+  function f17 (x, y, z)
+    real (kind = 8) :: f17
+    integer, intent(in) :: x
+    integer (kind = 8), intent(in) :: y
+    real :: z
+    !$omp declare variant (f16) match (construct={teams,parallel})  ! { dg-error "'f16' used as a variant with incompatible 'construct' selector sets" }
+    f17 = 0.0
+  end function
+
+  function f18 (x, y, z)
+    real (kind = 8) :: f18
+    integer, intent(in) :: x
+    integer (kind = 8), intent(in) :: y
+    real :: z
+    !$omp declare variant (f16) match(construct={teams,parallel,do})
+    f18 = 0.0
+  end function
+
+  function f19 (x, y, z)
+    real (kind = 8) :: f19
+    integer, intent(in) :: x
+    integer (kind = 8), intent(in) :: y
+    real :: z
+    f19 = 0.0
+  end function
+
+  function f20 (x, y, z)
+    real (kind = 8) :: f20
+    integer, intent(in) :: x
+    integer (kind = 8), intent(in) :: y
+    real :: z
+    !$omp declare variant (f19) match (construct={parallel})  ! { dg-error "'f19' used as a variant with incompatible 'construct' selector sets" }
+    f20 = 0.0
+  end function
+
+  function f21 (x, y, z)
+    real (kind = 8) :: f21
+    integer, intent(in) :: x
+    integer (kind = 8), intent(in) :: y
+    real :: z
+    !$omp declare variant (f19) match (construct={do},implementation={vendor(gnu,llvm)})
+    f21 = 0.0
+  end function
+
+end module
diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-variant-7.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-variant-7.f90
new file mode 100644
index 00000000000..1590a2a26f0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-variant-7.f90
@@ -0,0 +1,93 @@
+! { dg-do compile { target i?86-*-* x86_64-*-* } }
+! { dg-additional-options "-mavx2" }
+
+module main
+  implicit none
+contains
+  function f1 (x, y, z)
+    integer, dimension(4) :: f1
+    real, dimension(4), intent(in) :: x, y
+    real, intent(out) :: z
+
+    f1 = x
+  end function
+
+  function f2 (x, y, z)
+    integer, dimension(8) :: f2
+    real, dimension(8), intent(in) :: x, y
+    real, intent(out) :: z
+
+    f2 = x
+  end function
+
+  function f3 (x, y, z)
+    integer, dimension(4) :: f3
+    real, dimension(4), intent(in) :: x, z
+    integer, intent(in) :: y
+
+    f3 = x
+  end function
+
+  integer function f4 (x, y, z)
+    real, intent(in) :: x, y
+    real, pointer, intent(out) :: z
+    !$omp declare variant (f1) match (construct={parallel,do,simd(simdlen(4),notinbranch,uniform(z),aligned(z:16))})	! { dg-error "'f1' used as a variant with incompatible 'construct' selector sets" }
+  end function
+
+  integer function f5 (u, v, w)
+    real, intent(in) :: u, v
+    real, pointer, intent(out) :: w
+    !$omp declare variant (f1) match (construct={parallel,do,simd(uniform(w),simdlen(8*2-12),aligned(w:16),notinbranch)})	! { dg-error "'f1' used as a variant with incompatible 'construct' selector sets" }
+  end function
+
+  integer function f6 (u, v, w)
+    real, intent(in) :: u, v
+    real, pointer, intent(out) :: w
+    !$omp declare variant (f1) match (construct={parallel,do,simd(linear(w),notinbranch,simdlen(4),aligned(w:16))})	! { dg-error "'f1' used as a variant with incompatible 'construct' selector sets" }
+  end function
+
+  integer function f7 (u, v, w)
+    real, intent(in) :: u, v
+    real, pointer, intent(out) :: w
+    !$omp declare variant (f1) match (construct={parallel,do,simd(uniform(w),notinbranch,simdlen(4),aligned(w:8))})	! { dg-error "'f1' used as a variant with incompatible 'construct' selector sets" }
+  end function
+
+  integer function f8 (u, v, w)
+    real, intent(in) :: u, v
+    real, pointer, intent(out) :: w
+    !$omp declare variant (f1) match (construct={parallel,do,simd(uniform(w),notinbranch,simdlen(4),aligned(w))})
+  end function
+
+  integer function f9 (x, y, z)
+    real, intent(in) :: x, y
+    real, pointer, intent(out) :: z
+    !$omp declare variant (f2) match (construct={do,simd(uniform(z),simdlen(8),notinbranch)})	! { dg-error "'f2' used as a variant with incompatible 'construct' selector sets" }
+  end function
+
+  integer function f10 (x, y, q)
+    real, intent(in) :: x, y
+    real, pointer, intent(out) :: q
+    !$omp declare variant (f2) match (construct={do,simd(notinbranch,simdlen(2+2+4),uniform (q))})	! { dg-error "'f2' used as a variant with incompatible 'construct' selector sets" }
+  end function
+
+  integer function f11 (x, y, z)
+    real, intent(in) :: x, y
+    real, pointer, intent(out) :: z
+    !$omp declare variant (f2) match (construct={do,simd(linear(z:2),simdlen(8),notinbranch)})
+  end function
+
+  integer function f12 (x, y)
+    integer, intent(in) :: x, y
+    !$omp declare variant (f3) match (construct={simd(simdlen(4),inbranch,linear(y:1))})	! { dg-error "'f3' used as a variant with incompatible 'construct' selector sets" }
+  end function
+
+  integer function f13 (x, q)
+    integer, intent(in) :: x, q
+    !$omp declare variant (f3) match (construct={simd(inbranch, simdlen (5-1), linear (q:4-3))})	! { dg-error "'f3' used as a variant with incompatible 'construct' selector sets" }
+  end function
+
+  integer function f14 (x, q)
+    integer, intent(in) :: x, q
+    !$omp declare variant (f3) match (construct={simd(inbranch,simdlen(4),linear(q:2))})
+  end function
+end module
diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-variant-8.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-variant-8.f90
new file mode 100644
index 00000000000..c751489a5db
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-variant-8.f90
@@ -0,0 +1,218 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-gimple" }
+
+program main
+  !$omp requires atomic_default_mem_order(seq_cst)
+  !$omp declare target to (test3)
+contains
+  subroutine f01 ()
+  end subroutine
+
+  subroutine f02 ()
+    !$omp declare variant (f01) match (user={condition(6 == 7)},implementation={vendor(gnu)})
+  end subroutine
+
+  subroutine f03 ()
+  end subroutine
+
+  subroutine f04 ()
+    !$omp declare variant (f03) match (user={condition(6 == 6)},implementation={atomic_default_mem_order(seq_cst)})
+  end subroutine
+
+  subroutine f05 ()
+  end subroutine
+
+  subroutine f06 ()
+    !$omp declare variant (f05) match (user={condition(1)},implementation={atomic_default_mem_order(relaxed)})
+  end subroutine
+
+  subroutine f07 ()
+  end subroutine
+
+  subroutine f08 ()
+    !$omp declare variant (f07) match (construct={parallel,do},device={kind("any")})
+  end subroutine
+
+  subroutine f09 ()
+  end subroutine
+
+  subroutine f10 ()
+    !$omp declare variant (f09) match (construct={parallel,do},implementation={vendor("gnu")})
+  end subroutine
+
+  subroutine f11 ()
+  end subroutine
+
+  subroutine f12 ()
+    !$omp declare variant (f11) match (construct={parallel,do})
+  end subroutine
+
+  subroutine f13 ()
+  end subroutine
+
+  subroutine f14 ()
+    !$omp declare variant (f13) match (construct={parallel,do})
+  end subroutine
+
+  subroutine f15 ()
+    !$omp declare target to (f13, f14)
+  end subroutine
+
+  subroutine f16 ()
+    !$omp declare variant (f15) match (implementation={vendor(llvm)})
+  end subroutine
+
+  subroutine f17 ()
+  end subroutine
+
+  subroutine f18 ()
+    !$omp declare variant (f17) match (construct={target,parallel})
+  end subroutine
+
+  subroutine f19 ()
+  end subroutine
+
+  subroutine f20 ()
+    !$omp declare variant (f19) match (construct={target,parallel})
+  end subroutine
+
+  subroutine f22 ()
+    !$omp declare variant (f21) match (construct={teams,parallel})
+  end subroutine
+
+  subroutine f23 ()
+  end subroutine
+
+  subroutine f24 ()
+    !$omp declare variant (f23) match (construct={teams,parallel,do})
+  end subroutine
+
+  subroutine f25 ()
+  end subroutine
+
+  subroutine f27 ()
+  end subroutine
+
+  subroutine f28 ()
+    !$omp declare variant (f27) match (construct={teams,parallel,do})
+  end subroutine
+
+  subroutine f30 ()
+    !$omp declare variant (f29) match (implementation={vendor(gnu)})
+  end subroutine
+
+  subroutine f31 ()
+  end subroutine
+
+  subroutine f32 ()
+    !$omp declare variant (f31) match (construct={teams,parallel,do})
+  end subroutine
+
+  subroutine f33 ()
+  end subroutine
+
+  subroutine f34 ()
+    !$omp declare variant (f33) match (device={kind("any\0any")})	! { dg-warning "unknown property '.any..0any.' of 'kind' selector" }
+  end subroutine
+
+  subroutine f35 ()
+  end subroutine
+
+  subroutine f36 ()
+    !$omp declare variant (f35) match (implementation={vendor("gnu\0")})	! { dg-warning "unknown property '.gnu..0.' of 'vendor' selector" }
+  end subroutine
+
+  subroutine test1 ()
+    integer :: i
+
+    call f02 ()	! { dg-final { scan-tree-dump-times "f02 \\\(\\\);" 1 "gimple" } }
+    call f04 ()	! { dg-final { scan-tree-dump-times "f03 \\\(\\\);" 1 "gimple" } }
+    call f06 ()	! { dg-final { scan-tree-dump-times "f06 \\\(\\\);" 1 "gimple" } }
+
+    !$omp parallel
+      !$omp do
+      do i = 1, 2
+	call f08 ()		! { dg-final { scan-tree-dump-times "f07 \\\(\\\);" 1 "gimple" } }
+      end do
+      !$omp end do
+    !$omp end parallel
+
+    !$omp parallel do
+      do i = 1, 2
+	call f10 ()		! { dg-final { scan-tree-dump-times "f09 \\\(\\\);" 1 "gimple" } }
+      end do
+    !$omp end parallel do
+
+    !$omp do
+      do i = 1, 2
+	!$omp parallel
+	  call f12 ()	! { dg-final { scan-tree-dump-times "f12 \\\(\\\);" 1 "gimple" } }
+	!$omp end parallel
+      end do
+    !$omp end do
+
+    !$omp parallel
+      !$omp target
+	!$omp do
+	do i = 1, 2
+	  call f14 ()		! { dg-final { scan-tree-dump-times "f14 \\\(\\\);" 1 "gimple" } }
+	end do
+	!$omp end do
+      !$omp end target
+    !$omp end parallel
+
+    call f16 ()	! { dg-final { scan-tree-dump-times "f16 \\\(\\\);" 1 "gimple" } }
+    call f34 ()	! { dg-final { scan-tree-dump-times "f34 \\\(\\\);" 1 "gimple" } }
+    call f36 ()	! { dg-final { scan-tree-dump-times "f36 \\\(\\\);" 1 "gimple" } }
+  end subroutine
+
+  subroutine test2 ()
+    ! OpenMP 5.0 specifies that the 'target' trait should be added for
+    ! functions within a declare target block, but Fortran does not have
+    ! the notion of a declare target _block_, so the variant is not used here.
+    ! This may change in later versions of OpenMP.
+
+    !$omp declare target
+    !$omp parallel
+      call f18 ()	! { dg-final { scan-tree-dump-times "f18 \\\(\\\);" 1 "gimple" } }
+    !$omp end parallel
+  end subroutine
+
+  subroutine test3 ()
+    ! In the C version, this test was used to check that the
+    ! 'declare target to' form of the directive did not result in the variant
+    ! being used.
+    !$omp parallel
+      call f20 ()	! { dg-final { scan-tree-dump-times "f20 \\\(\\\);" 1 "gimple" } }
+    !$omp end parallel
+  end subroutine
+
+  subroutine f21 ()
+    integer :: i
+    !$omp do
+      do i = 1, 2
+	call f24 ()	! { dg-final { scan-tree-dump-times "f23 \\\(\\\);" 1 "gimple" } }
+      end do
+    !$omp end do
+  end subroutine
+
+  subroutine f26 ()
+    !$omp declare variant (f25) match (construct={teams,parallel})
+
+    integer :: i
+    !$omp do
+      do i = 1, 2
+	call f28 ()	! { dg-final { scan-tree-dump-times "f28 \\\(\\\);" 1 "gimple" } }
+      end do
+    !$omp end do
+  end subroutine
+
+  subroutine f29 ()
+    integer :: i
+    !$omp do
+      do i = 1, 2
+	call f32 ()	! { dg-final { scan-tree-dump-times "f32 \\\(\\\);" 1 "gimple" } }
+      end do
+    !$omp end do
+  end subroutine
+end program
diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-variant-9.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-variant-9.f90
new file mode 100644
index 00000000000..ebd066609f3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-variant-9.f90
@@ -0,0 +1,58 @@
+! { dg-do compile }
+! { dg-additional-options "-cpp -fdump-tree-gimple" }
+! { dg-additional-options "-mno-sse3" { target { i?86-*-* x86_64-*-* } } }
+
+program main
+  implicit none
+contains
+  subroutine f01 ()
+  end subroutine
+  subroutine f02 ()
+    !$omp declare variant (f01) match (device={isa("avx512f",avx512bw)})
+  end subroutine
+  subroutine f05 ()
+  end subroutine
+  subroutine f06 ()
+    !$omp declare variant (f05) match (device={kind(gpu)})
+  end subroutine
+  subroutine f07 ()
+  end subroutine
+  subroutine f08 ()
+    !$omp declare variant (f07) match (device={kind("cpu")})
+  end subroutine
+  subroutine f09 ()
+  end subroutine
+  subroutine f10 ()
+    !$omp declare variant (f09) match (device={isa(sm_35)})
+  end subroutine
+  subroutine f11 ()
+  end subroutine
+  subroutine f12 ()
+    !$omp declare variant (f11) match (device={arch(nvptx)})
+  end subroutine
+  subroutine f13 ()
+  end subroutine
+  subroutine f14 ()
+    !$omp declare variant (f13) match (device={arch("i386"),isa(sse4)})
+  end subroutine
+  subroutine f17 ()
+  end subroutine
+  subroutine f18 ()
+    !$omp declare variant (f17) match (device={kind("any","fpga")})
+  end subroutine
+
+  subroutine test1 ()
+    integer ::  i;
+    call f02 ()	! { dg-final { scan-tree-dump-times "f02 \\\(\\\);" 1 "gimple" } }
+    call f14 ()	! { dg-final { scan-tree-dump-times "f14 \\\(\\\);" 1 "gimple" } }
+    call f18 ()	! { dg-final { scan-tree-dump-times "f18 \\\(\\\);" 1 "gimple" } }
+  end subroutine
+
+  subroutine test3 ()
+    call f06 ()	! { dg-final { scan-tree-dump-times "f06 \\\(\\\);" 1 "gimple" { target { ! { nvptx*-*-* amdgcn*-*-* } } } } }
+    call f08 ()	! { dg-final { scan-tree-dump-times "f07 \\\(\\\);" 1 "gimple" { target { ! { nvptx*-*-* amdgcn*-*-* } } } } }
+    call f10 ()	! { dg-final { scan-tree-dump-times "f10 \\\(\\\);" 1 "gimple" { target { ! { nvptx*-*-* amdgcn*-*-* } } } } }
+    call f12 ()	! { dg-final { scan-tree-dump-times "f12 \\\(\\\);" 1 "gimple" { target { ! { nvptx*-*-* } } } } }
+		! { dg-final { scan-tree-dump-times "f11 \\\(\\\);" 1 "gimple" { target { nvptx*-*-* } } } }
+  end subroutine
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/declare-variant-1.f90 b/libgomp/testsuite/libgomp.fortran/declare-variant-1.f90
new file mode 100644
index 00000000000..e6f69dccb49
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/declare-variant-1.f90
@@ -0,0 +1,33 @@
+! { dg-do run }
+
+program main
+  implicit none
+
+  integer :: v
+  !$omp target map(from:v)
+  v = on ()
+  !$omp end target
+
+  select case (v)
+    case default
+      write (*,*) "Host fallback or unknown offloading"
+    case (1)
+      write (*,*) "Offloading to NVidia PTX"
+    case (2)
+      write (*,*) "Offloading to AMD GCN"
+  end select
+contains
+  integer function on_nvptx ()
+    on_nvptx = 1
+  end function
+
+  integer function on_gcn ()
+    on_gcn = 2
+  end function
+
+  integer function on ()
+    !$omp declare variant (on_nvptx) match(construct={target},device={arch(nvptx)})
+    !$omp declare variant (on_gcn) match(construct={target},device={arch(gcn)})
+    on = 0
+  end function
+end program