tree-nested.c (convert_nonlocal_omp_clauses): Add support for OMP_CLAUSE_{NUM_GANGS,NUM_VECTORS,VECTOR_LENGTH,SEQ}.

	gcc/
	* tree-nested.c (convert_nonlocal_omp_clauses): Add support for
	OMP_CLAUSE_{NUM_GANGS,NUM_VECTORS,VECTOR_LENGTH,SEQ}.
	(convert_local_omp_clauses): Likewise.

	gcc/fortran/
	* f95-lang.c (gfc_attribute_table): Add an "oacc function"
	attribute.
	* gfortran.h (symbol_attribute): Add an oacc_function bit-field.
	(gfc_oacc_routine_name): New struct;
	(gfc_get_oacc_routine_name): New macro.
	(gfc_namespace): Add oacc_routine_clauses, oacc_routine_names and
	oacc_routine fields.
	(gfc_exec_op): Add EXEC_OACC_ROUTINE.
	* openmp.c (OACC_ROUTINE_CLAUSES): New mask.
	(gfc_oacc_routine_dims): New function.
	(gfc_match_oacc_routine): Add support for named routines and the
	gang, worker vector and seq clauses.
	* parse.c (is_oacc): Add EXEC_OACC_ROUTINE.
	* resolve.c (gfc_resolve_blocks): Likewise.
	* st.c (gfc_free_statement): Likewise.
	* trans-decl.c (add_attributes_to_decl): Attach an 'oacc function'
	attribute and shape geometry for acc routine.

	gcc/testsuite/
	* gfortran.dg/goacc/routine-3.f90: New test.
	* gfortran.dg/goacc/routine-4.f90: New test.
	* gfortran.dg/goacc/routine-5.f90: New test.
	* gfortran.dg/goacc/routine-6.f90: New test.
	* gfortran.dg/goacc/subroutines: New test.

	libgomp/
	* libgomp.oacc-fortran/routine-5.f90: New test.
	* libgomp.oacc-fortran/routine-7.f90: New test.
	* libgomp.oacc-fortran/routine-9.f90: New test.

From-SVN: r231081

20 files changed, 865 insertions, 45 deletions

diff --git a/gcc/ChangeLog b/gcc/ChangeLog
index 229aa77f89b..a1b4effd46a 100644
--- a/gcc/ChangeLog
+++ b/gcc/ChangeLog
@@ -1,3 +1,9 @@
+2015-11-30  Cesar Philippidis  <cesar@codesourcery.com>
+
+	* tree-nested.c (convert_nonlocal_omp_clauses): Add support for
+	OMP_CLAUSE_{NUM_GANGS,NUM_VECTORS,VECTOR_LENGTH,SEQ}.
+	(convert_local_omp_clauses): Likewise.
+
 2015-11-30  Tom de Vries  <tom@codesourcery.com>
 
 	PR tree-optimization/46032
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index c7c50647d00..52dcc826538 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,25 @@
+2015-11-30  Cesar Philippidis  <cesar@codesourcery.com>
+	    James Norris  <jnorris@codesourcery.com>
+	    Nathan Sidwell  <nathan@codesourcery.com>
+
+	* f95-lang.c (gfc_attribute_table): Add an "oacc function"
+	attribute.
+	* gfortran.h (symbol_attribute): Add an oacc_function bit-field.
+	(gfc_oacc_routine_name): New struct;
+	(gfc_get_oacc_routine_name): New macro.
+	(gfc_namespace): Add oacc_routine_clauses, oacc_routine_names and
+	oacc_routine fields.
+	(gfc_exec_op): Add EXEC_OACC_ROUTINE.
+	* openmp.c (OACC_ROUTINE_CLAUSES): New mask.
+	(gfc_oacc_routine_dims): New function.
+	(gfc_match_oacc_routine): Add support for named routines and the
+	gang, worker vector and seq clauses.
+	* parse.c (is_oacc): Add EXEC_OACC_ROUTINE.
+	* resolve.c (gfc_resolve_blocks): Likewise.
+	* st.c (gfc_free_statement): Likewise.
+	* trans-decl.c (add_attributes_to_decl): Attach an 'oacc function'
+	attribute and shape geometry for acc routine.
+
 2015-11-30  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/68534
diff --git a/gcc/fortran/f95-lang.c b/gcc/fortran/f95-lang.c
index 605c2abd01d..8556b706365 100644
--- a/gcc/fortran/f95-lang.c
+++ b/gcc/fortran/f95-lang.c
@@ -93,6 +93,8 @@ static const struct attribute_spec gfc_attribute_table[] =
        affects_type_identity } */
   { "omp declare target", 0, 0, true,  false, false,
     gfc_handle_omp_declare_target_attribute, false },
+  { "oacc function", 0, -1, true,  false, false,
+    gfc_handle_omp_declare_target_attribute, false },
   { NULL,		  0, 0, false, false, false, NULL, false }
 };
 
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 5487c9343e4..0628e8628c2 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -848,6 +848,9 @@ typedef struct
   unsigned oacc_declare_device_resident:1;
   unsigned oacc_declare_link:1;
 
+  /* This is an OpenACC acclerator function at level N - 1  */
+  unsigned oacc_function:3;
+
   /* Attributes set by compiler extensions (!GCC$ ATTRIBUTES).  */
   unsigned ext_attr:EXT_ATTR_NUM;
 
@@ -1606,6 +1609,16 @@ gfc_dt_list;
   /* A list of all derived types.  */
   extern gfc_dt_list *gfc_derived_types;
 
+typedef struct gfc_oacc_routine_name
+{
+  struct gfc_symbol *sym;
+  struct gfc_omp_clauses *clauses;
+  struct gfc_oacc_routine_name *next;
+}
+gfc_oacc_routine_name;
+
+#define gfc_get_oacc_routine_name() XCNEW (gfc_oacc_routine_name)
+
 /* A namespace describes the contents of procedure, module, interface block
    or BLOCK construct.  */
 /* ??? Anything else use these?  */
@@ -1672,6 +1685,12 @@ typedef struct gfc_namespace
   /* !$ACC DECLARE.  */
   gfc_oacc_declare *oacc_declare;
 
+  /* !$ACC ROUTINE clauses.  */
+  gfc_omp_clauses *oacc_routine_clauses;
+
+  /* !$ACC ROUTINE names.  */
+  gfc_oacc_routine_name *oacc_routine_names;
+
   gfc_charlen *cl_list, *old_cl_list;
 
   gfc_dt_list *derived_types;
@@ -1717,6 +1736,9 @@ typedef struct gfc_namespace
 
   /* Set to 1 for !$OMP DECLARE REDUCTION namespaces.  */
   unsigned omp_udr_ns:1;
+
+  /* Set to 1 for !$ACC ROUTINE namespaces.  */
+  unsigned oacc_routine:1;
 }
 gfc_namespace;
 
@@ -2344,7 +2366,7 @@ enum gfc_exec_op
   EXEC_READ, EXEC_WRITE, EXEC_IOLENGTH, EXEC_TRANSFER, EXEC_DT_END,
   EXEC_BACKSPACE, EXEC_ENDFILE, EXEC_INQUIRE, EXEC_REWIND, EXEC_FLUSH,
   EXEC_LOCK, EXEC_UNLOCK,
-  EXEC_OACC_KERNELS_LOOP, EXEC_OACC_PARALLEL_LOOP,
+  EXEC_OACC_KERNELS_LOOP, EXEC_OACC_PARALLEL_LOOP, EXEC_OACC_ROUTINE,
   EXEC_OACC_PARALLEL, EXEC_OACC_KERNELS, EXEC_OACC_DATA, EXEC_OACC_HOST_DATA,
   EXEC_OACC_LOOP, EXEC_OACC_UPDATE, EXEC_OACC_WAIT, EXEC_OACC_CACHE,
   EXEC_OACC_ENTER_DATA, EXEC_OACC_EXIT_DATA, EXEC_OACC_ATOMIC,
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index a07cee1a0b9..730b7f98cd0 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -1318,6 +1318,8 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
    | OMP_CLAUSE_DELETE)
 #define OACC_WAIT_CLAUSES \
   (OMP_CLAUSE_ASYNC)
+#define OACC_ROUTINE_CLAUSES \
+  (OMP_CLAUSE_GANG | OMP_CLAUSE_WORKER | OMP_CLAUSE_VECTOR | OMP_CLAUSE_SEQ)
 
 
 match
@@ -1619,13 +1621,44 @@ gfc_match_oacc_cache (void)
   return MATCH_YES;
 }
 
+/* Determine the loop level for a routine.   */
+
+static int
+gfc_oacc_routine_dims (gfc_omp_clauses *clauses)
+{
+  int level = -1;
+
+  if (clauses)
+    {
+      unsigned mask = 0;
+
+      if (clauses->gang)
+	level = GOMP_DIM_GANG, mask |= GOMP_DIM_MASK (level);
+      if (clauses->worker)
+	level = GOMP_DIM_WORKER, mask |= GOMP_DIM_MASK (level);
+      if (clauses->vector)
+	level = GOMP_DIM_VECTOR, mask |= GOMP_DIM_MASK (level);
+      if (clauses->seq)
+	level = GOMP_DIM_MAX, mask |= GOMP_DIM_MASK (level);
+
+      if (mask != (mask & -mask))
+	gfc_error ("Multiple loop axes specified for routine");
+    }
+
+  if (level < 0)
+    level = GOMP_DIM_MAX;
+
+  return level;
+}
 
 match
 gfc_match_oacc_routine (void)
 {
   locus old_loc;
-  gfc_symbol *sym;
+  gfc_symbol *sym = NULL;
   match m;
+  gfc_omp_clauses *c = NULL;
+  gfc_oacc_routine_name *n = NULL;
 
   old_loc = gfc_current_locus;
 
@@ -1640,52 +1673,85 @@ gfc_match_oacc_routine (void)
       goto cleanup;
     }
 
-  if (m == MATCH_NO
-      && gfc_current_ns->proc_name
-      && gfc_match_omp_eos () == MATCH_YES)
+  if (m == MATCH_YES)
     {
-      if (!gfc_add_omp_declare_target (&gfc_current_ns->proc_name->attr,
-				       gfc_current_ns->proc_name->name,
-				       &old_loc))
-	goto cleanup;
-      return MATCH_YES;
-    }
+      char buffer[GFC_MAX_SYMBOL_LEN + 1];
+      gfc_symtree *st;
 
-  if (m != MATCH_YES)
-    return m;
+      m = gfc_match_name (buffer);
+      if (m == MATCH_YES)
+	{
+	  st = gfc_find_symtree (gfc_current_ns->sym_root, buffer);
+	  if (st)
+	    {
+	      sym = st->n.sym;
+	      if (strcmp (sym->name, gfc_current_ns->proc_name->name) == 0)
+	        sym = NULL;
+	    }
 
-  /* Scan for a function name.  */
-  m = gfc_match_symbol (&sym, 0);
+	  if (st == NULL
+	      || (sym
+		  && !sym->attr.external
+		  && !sym->attr.function
+		  && !sym->attr.subroutine))
+	    {
+	      gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %C, "
+			 "invalid function name %s",
+			 (sym) ? sym->name : buffer);
+	      gfc_current_locus = old_loc;
+	      return MATCH_ERROR;
+	    }
+	}
+      else
+        {
+	  gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %C");
+	  gfc_current_locus = old_loc;
+	  return MATCH_ERROR;
+	}
 
-  if (m != MATCH_YES)
-    {
-      gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %C");
-      gfc_current_locus = old_loc;
-      return MATCH_ERROR;
+      if (gfc_match_char (')') != MATCH_YES)
+	{
+	  gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %C, expecting"
+		     " ')' after NAME");
+	  gfc_current_locus = old_loc;
+	  return MATCH_ERROR;
+	}
     }
 
-  if (!sym->attr.external && !sym->attr.function && !sym->attr.subroutine)
-    {
-      gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %C, invalid"
-		 " function name %qs", sym->name);
-      gfc_current_locus = old_loc;
-      return MATCH_ERROR;
-    }
+  if (gfc_match_omp_eos () != MATCH_YES
+      && (gfc_match_omp_clauses (&c, OACC_ROUTINE_CLAUSES, false, false, true)
+	  != MATCH_YES))
+    return MATCH_ERROR;
 
-  if (gfc_match_char (')') != MATCH_YES)
+  if (sym != NULL)
     {
-      gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %C, expecting"
-		 " ')' after NAME");
-      gfc_current_locus = old_loc;
-      return MATCH_ERROR;
+      n = gfc_get_oacc_routine_name ();
+      n->sym = sym;
+      n->clauses = NULL;
+      n->next = NULL;
+      if (gfc_current_ns->oacc_routine_names != NULL)
+	n->next = gfc_current_ns->oacc_routine_names;
+
+      gfc_current_ns->oacc_routine_names = n;
     }
-
-  if (gfc_match_omp_eos () != MATCH_YES)
+  else if (gfc_current_ns->proc_name)
     {
-      gfc_error ("Unexpected junk after !$ACC ROUTINE at %C");
-      goto cleanup;
+      if (!gfc_add_omp_declare_target (&gfc_current_ns->proc_name->attr,
+				       gfc_current_ns->proc_name->name,
+				       &old_loc))
+	goto cleanup;
+      gfc_current_ns->proc_name->attr.oacc_function
+	= gfc_oacc_routine_dims (c) + 1;
     }
-  return MATCH_YES;
+
+  if (n)
+    n->clauses = c;
+  else if (gfc_current_ns->oacc_routine)
+    gfc_current_ns->oacc_routine_clauses = c;
+
+  new_st.op = EXEC_OACC_ROUTINE;
+  new_st.ext.omp_clauses = c;
+  return MATCH_YES;  
 
 cleanup:
   gfc_current_locus = old_loc;
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index b2806214e1a..b2d15a89aeb 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -5786,6 +5786,7 @@ is_oacc (gfc_state_data *sd)
     case EXEC_OACC_ENTER_DATA:
     case EXEC_OACC_EXIT_DATA:
     case EXEC_OACC_ATOMIC:
+    case EXEC_OACC_ROUTINE:
       return true;
 
     default:
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 685e3f54007..febf0fa28d6 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -9373,6 +9373,7 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns)
 	case EXEC_OACC_ENTER_DATA:
 	case EXEC_OACC_EXIT_DATA:
 	case EXEC_OACC_ATOMIC:
+	case EXEC_OACC_ROUTINE:
 	case EXEC_OMP_ATOMIC:
 	case EXEC_OMP_CRITICAL:
 	case EXEC_OMP_DISTRIBUTE:
diff --git a/gcc/fortran/st.c b/gcc/fortran/st.c
index d0a11aab793..566150b1cc2 100644
--- a/gcc/fortran/st.c
+++ b/gcc/fortran/st.c
@@ -202,6 +202,7 @@ gfc_free_statement (gfc_code *p)
     case EXEC_OACC_CACHE:
     case EXEC_OACC_ENTER_DATA:
     case EXEC_OACC_EXIT_DATA:
+    case EXEC_OACC_ROUTINE:
     case EXEC_OMP_CANCEL:
     case EXEC_OMP_CANCELLATION_POINT:
     case EXEC_OMP_DISTRIBUTE:
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 39ff8e27f5b..331b43da413 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -44,6 +44,7 @@ along with GCC; see the file COPYING3.  If not see
 #include "trans-const.h"
 /* Only for gfc_trans_code.  Shouldn't need to include this.  */
 #include "trans-stmt.h"
+#include "gomp-constants.h"
 
 #define MAX_LABEL_VALUE 99999
 
@@ -1304,6 +1305,20 @@ add_attributes_to_decl (symbol_attribute sym_attr, tree list)
     list = tree_cons (get_identifier ("omp declare target"),
 		      NULL_TREE, list);
 
+  if (sym_attr.oacc_function)
+    {
+      tree dims = NULL_TREE;
+      int ix;
+      int level = sym_attr.oacc_function - 1;
+
+      for (ix = GOMP_DIM_MAX; ix--;)
+	dims = tree_cons (build_int_cst (boolean_type_node, ix >= level),
+			  integer_zero_node, dims);
+
+      list = tree_cons (get_identifier ("oacc function"),
+			dims, list);
+    }
+
   return list;
 }
 
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 466d357a59a..7cc59de9feb 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,12 @@
+2015-11-30  Cesar Philippidis  <cesar@codesourcery.com>
+	    Nathan Sidwell  <nathan@codesourcery.com>
+
+	* gfortran.dg/goacc/routine-3.f90: New test.
+	* gfortran.dg/goacc/routine-4.f90: New test.
+	* gfortran.dg/goacc/routine-5.f90: New test.
+	* gfortran.dg/goacc/routine-6.f90: New test.
+	* gfortran.dg/goacc/subroutines: New test.
+
 2015-11-30  Tom de Vries  <tom@codesourcery.com>
 
 	* gcc.dg/pr46032-2.c: New test.
diff --git a/gcc/testsuite/gfortran.dg/goacc/routine-3.f90 b/gcc/testsuite/gfortran.dg/goacc/routine-3.f90
new file mode 100644
index 00000000000..ca9b928fa02
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/routine-3.f90
@@ -0,0 +1,13 @@
+PROGRAM nested_gwv
+CONTAINS
+  SUBROUTINE gwv
+    INTEGER  :: i
+    REAL(KIND=8), ALLOCATABLE :: un(:),  ua(:)
+
+    !$acc parallel num_gangs(2) num_workers(4) vector_length(32)
+    DO jj = 1, 100
+       un(i) = ua(i)
+    END DO
+    !$acc end parallel
+  END SUBROUTINE gwv
+END PROGRAM nested_gwv
diff --git a/gcc/testsuite/gfortran.dg/goacc/routine-4.f90 b/gcc/testsuite/gfortran.dg/goacc/routine-4.f90
new file mode 100644
index 00000000000..6714c7b8229
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/routine-4.f90
@@ -0,0 +1,160 @@
+! Test invalid calls to routines.
+
+module param
+  integer, parameter :: N = 32
+end module param
+
+program main
+  use param
+  integer :: i
+  integer :: a(N)
+
+  do i = 1, N
+    a(i) = i
+  end do
+
+  !
+  ! Seq routine tests.
+  !
+
+  !$acc parallel copy (a)
+  !$acc loop
+  do i = 1, N
+     call seq (a)
+  end do
+
+  !$acc loop gang
+  do i = 1, N
+     call seq (a)
+  end do
+
+  !$acc loop worker
+  do i = 1, N
+     call seq (a)
+  end do
+
+  !$acc loop vector
+  do i = 1, N
+     call seq (a)
+  end do
+  !$acc end parallel
+
+  !
+  ! Gang routines loops.
+  !
+
+  !$acc parallel copy (a)
+  !$acc loop ! { dg-warning "insufficient partitioning" }
+  do i = 1, N
+     call gang (a)
+  end do
+
+  !$acc loop gang ! { dg-message "containing loop" }
+  do i = 1, N
+     call gang (a) ! { dg-error "routine call uses same" }
+  end do
+
+  !$acc loop worker ! { dg-message "containing loop" }
+  do i = 1, N
+     call gang (a)  ! { dg-error "routine call uses same" }
+  end do
+
+  !$acc loop vector ! { dg-message "containing loop" }
+  do i = 1, N
+     call gang (a)   ! { dg-error "routine call uses same" }
+  end do
+  !$acc end parallel
+
+  !
+  ! Worker routines loops.
+  !
+
+  !$acc parallel copy (a)
+  !$acc loop
+  do i = 1, N
+     call worker (a)
+  end do
+
+  !$acc loop gang
+  do i = 1, N
+     call worker (a)
+  end do
+
+  !$acc loop worker ! { dg-message "containing loop" }
+  do i = 1, N
+     call worker (a) ! { dg-error "routine call uses same" }
+  end do
+
+  !$acc loop vector ! { dg-message "containing loop" }
+  do i = 1, N
+     call worker (a) ! { dg-error "routine call uses same" }
+  end do
+  !$acc end parallel
+
+  !
+  ! Vector routines loops.
+  !
+
+  !$acc parallel copy (a)
+  !$acc loop
+  do i = 1, N
+     call vector (a)
+  end do
+
+  !$acc loop gang
+  do i = 1, N
+     call vector (a)
+  end do
+
+  !$acc loop worker
+  do i = 1, N
+     call vector (a)
+  end do
+
+  !$acc loop vector ! { dg-message "containing loop" }
+  do i = 1, N
+     call vector (a) ! { dg-error "routine call uses same" }
+  end do
+  !$acc end parallel
+contains
+
+  subroutine gang (a) ! { dg-message "declared here" 3 }
+    !$acc routine gang
+    integer, intent (inout) :: a(N)
+    integer :: i
+
+    do i = 1, N
+       a(i) = a(i) - a(i)
+    end do
+  end subroutine gang
+
+  subroutine worker (a) ! { dg-message "declared here" 2 }
+    !$acc routine worker
+    integer, intent (inout) :: a(N)
+    integer :: i
+
+    do i = 1, N
+       a(i) = a(i) - a(i)
+    end do
+  end subroutine worker
+
+  subroutine vector (a) ! { dg-message "declared here" }
+    !$acc routine vector
+    integer, intent (inout) :: a(N)
+    integer :: i
+
+    do i = 1, N
+       a(i) = a(i) - a(i)
+    end do
+  end subroutine vector
+
+  subroutine seq (a)
+    !$acc routine seq
+    integer, intent (inout) :: a(N)
+    integer :: i
+
+    do i = 1, N
+       a(i) = a(i) - a(i)
+    end do
+  end subroutine seq
+end program main
diff --git a/gcc/testsuite/gfortran.dg/goacc/routine-5.f90 b/gcc/testsuite/gfortran.dg/goacc/routine-5.f90
new file mode 100644
index 00000000000..68c51496866
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/routine-5.f90
@@ -0,0 +1,109 @@
+! Test invalid intra-routine parallellism.
+
+module param
+  integer, parameter :: N = 32
+end module param
+
+subroutine gang (a)
+  !$acc routine gang
+  integer, intent (inout) :: a(N)
+  integer :: i
+
+  !$acc loop
+  do i = 1, N
+     a(i) = a(i) - a(i)
+  end do
+
+  !$acc loop gang
+  do i = 1, N
+     a(i) = a(i) - a(i)
+  end do
+
+  !$acc loop worker
+  do i = 1, N
+     a(i) = a(i) - a(i)
+  end do
+
+  !$acc loop vector
+  do i = 1, N
+     a(i) = a(i) - a(i)
+  end do
+end subroutine gang
+
+subroutine worker (a)
+  !$acc routine worker
+  integer, intent (inout) :: a(N)
+  integer :: i
+
+  !$acc loop
+  do i = 1, N
+     a(i) = a(i) - a(i)
+  end do
+
+  !$acc loop gang ! { dg-error "disallowed by containing routine" }
+  do i = 1, N
+     a(i) = a(i) - a(i)
+  end do
+
+  !$acc loop worker
+  do i = 1, N
+     a(i) = a(i) - a(i)
+  end do
+
+  !$acc loop vector
+  do i = 1, N
+     a(i) = a(i) - a(i)
+  end do
+end subroutine worker
+
+subroutine vector (a)
+  !$acc routine vector
+  integer, intent (inout) :: a(N)
+  integer :: i
+
+  !$acc loop
+  do i = 1, N
+     a(i) = a(i) - a(i)
+  end do
+
+  !$acc loop gang  ! { dg-error "disallowed by containing routine" }
+  do i = 1, N
+     a(i) = a(i) - a(i)
+  end do
+
+  !$acc loop worker ! { dg-error "disallowed by containing routine" }
+  do i = 1, N
+     a(i) = a(i) - a(i)
+  end do
+
+  !$acc loop vector
+  do i = 1, N
+     a(i) = a(i) - a(i)
+  end do
+end subroutine vector
+
+subroutine seq (a)
+  !$acc routine seq
+  integer, intent (inout) :: a(N)
+  integer :: i
+
+  !$acc loop ! { dg-warning "insufficient partitioning" }
+  do i = 1, N
+     a(i) = a(i) - a(i)
+  end do
+
+  !$acc loop gang ! { dg-error "disallowed by containing routine" }
+  do i = 1, N
+     a(i) = a(i) - a(i)
+  end do
+
+  !$acc loop worker ! { dg-error "disallowed by containing routine" }
+  do i = 1, N
+     a(i) = a(i) - a(i)
+  end do
+
+  !$acc loop vector ! { dg-error "disallowed by containing routine" }
+  do i = 1, N
+     a(i) = a(i) - a(i)
+  end do
+end subroutine seq
diff --git a/gcc/testsuite/gfortran.dg/goacc/routine-6.f90 b/gcc/testsuite/gfortran.dg/goacc/routine-6.f90
new file mode 100644
index 00000000000..10951ee686e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/routine-6.f90
@@ -0,0 +1,89 @@
+
+module m
+  integer m1int
+contains
+  subroutine subr5 (x) 
+  implicit none
+  !$acc routine (subr5)
+  !$acc routine (m1int) ! { dg-error "invalid function name" }
+  integer, intent(inout) :: x
+  if (x < 1) then
+     x = 1
+  else
+     x = x * x - 1
+  end if
+  end subroutine subr5
+end module m
+
+program main
+  implicit none
+  interface
+    function subr6 (x) 
+    !$acc routine (subr6) ! { dg-error "without list is allowed in interface" }
+    integer, intent (in) :: x
+    integer :: subr6
+    end function subr6
+  end interface
+  integer, parameter :: n = 10
+  integer :: a(n), i
+  !$acc routine (subr1) ! { dg-error "invalid function name" }
+  external :: subr2
+  !$acc routine (subr2)
+  !$acc parallel
+  !$acc loop
+  do i = 1, n
+     call subr1 (i)
+     call subr2 (i)
+  end do
+  !$acc end parallel
+end program main
+
+subroutine subr1 (x) 
+  !$acc routine
+  integer, intent(inout) :: x
+  if (x < 1) then
+     x = 1
+  else
+     x = x * x - 1
+  end if
+end subroutine subr1
+
+subroutine subr2 (x) 
+  !$acc routine (subr1) ! { dg-error "invalid function name" }
+  integer, intent(inout) :: x
+  if (x < 1) then
+     x = 1
+  else
+     x = x * x - 1
+  end if
+end subroutine subr2
+
+subroutine subr3 (x) 
+  !$acc routine (subr3)
+  integer, intent(inout) :: x
+  if (x < 1) then
+     x = 1
+  else
+     call subr4 (x)
+  end if
+end subroutine subr3
+
+subroutine subr4 (x) 
+  !$acc routine (subr4)
+  integer, intent(inout) :: x
+  if (x < 1) then
+     x = 1
+  else
+     x = x * x - 1
+  end if
+end subroutine subr4
+
+subroutine subr10 (x)
+  !$acc routine (subr10) device ! { dg-error "Unclassifiable OpenACC directive" }
+  integer, intent(inout) :: x
+  if (x < 1) then
+     x = 1
+  else
+     x = x * x - 1
+  end if
+end subroutine subr10
diff --git a/gcc/testsuite/gfortran.dg/goacc/subroutines.f90 b/gcc/testsuite/gfortran.dg/goacc/subroutines.f90
new file mode 100644
index 00000000000..6cab798d458
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/subroutines.f90
@@ -0,0 +1,73 @@
+! Exercise how tree-nested.c handles gang, worker vector and seq.
+
+! { dg-do compile } 
+
+program main
+  integer, parameter :: N = 100
+  integer :: nonlocal_arg
+  integer :: nonlocal_a(N)
+  integer :: nonlocal_i
+  integer :: nonlocal_j
+  
+  nonlocal_a (:) = 5
+  nonlocal_arg = 5
+  
+  call local ()
+  call nonlocal ()
+
+contains
+
+  subroutine local ()
+    integer :: local_i
+    integer :: local_arg
+    integer :: local_a(N)
+    integer :: local_j
+    
+    local_a (:) = 5
+    local_arg = 5
+
+    !$acc kernels loop gang(num:local_arg) worker(local_arg) vector(local_arg)
+    do local_i = 1, N
+       local_a(local_i) = 100
+       !$acc loop seq
+       do local_j = 1, N
+       enddo
+    enddo
+    !$acc end kernels loop
+
+    !$acc kernels loop gang(static:local_arg) worker(local_arg) &
+    !$acc vector(local_arg)
+    do local_i = 1, N
+       local_a(local_i) = 100
+       !$acc loop seq
+       do local_j = 1, N
+       enddo
+    enddo
+    !$acc end kernels loop
+  end subroutine local
+
+  subroutine nonlocal ()
+    nonlocal_a (:) = 5
+    nonlocal_arg = 5
+  
+    !$acc kernels loop gang(num:nonlocal_arg) worker(nonlocal_arg) &
+    !$acc vector(nonlocal_arg)
+    do nonlocal_i = 1, N
+       nonlocal_a(nonlocal_i) = 100
+       !$acc loop seq
+       do nonlocal_j = 1, N
+       enddo
+    enddo
+    !$acc end kernels loop
+
+    !$acc kernels loop gang(static:nonlocal_arg) worker(nonlocal_arg) &
+    !$acc vector(nonlocal_arg)
+    do nonlocal_i = 1, N
+       nonlocal_a(nonlocal_i) = 100
+       !$acc loop seq
+       do nonlocal_j = 1, N
+       enddo
+    enddo
+    !$acc end kernels loop
+  end subroutine nonlocal
+end program main
diff --git a/gcc/tree-nested.c b/gcc/tree-nested.c
index 280d29b9247..8b5aba20a01 100644
--- a/gcc/tree-nested.c
+++ b/gcc/tree-nested.c
@@ -1108,10 +1108,31 @@ convert_nonlocal_omp_clauses (tree *pclauses, struct walk_stmt_info *wi)
 	case OMP_CLAUSE_NUM_TASKS:
 	case OMP_CLAUSE_HINT:
 	case OMP_CLAUSE__CILK_FOR_COUNT_:
-	  wi->val_only = true;
-	  wi->is_lhs = false;
-	  convert_nonlocal_reference_op (&OMP_CLAUSE_OPERAND (clause, 0),
-					 &dummy, wi);
+	case OMP_CLAUSE_NUM_GANGS:
+	case OMP_CLAUSE_NUM_WORKERS:
+	case OMP_CLAUSE_VECTOR_LENGTH:
+	case OMP_CLAUSE_GANG:
+	case OMP_CLAUSE_WORKER:
+	case OMP_CLAUSE_VECTOR:
+	  /* Several OpenACC clauses have optional arguments.  Check if they
+	     are present.  */
+	  if (OMP_CLAUSE_OPERAND (clause, 0))
+	    {
+	      wi->val_only = true;
+	      wi->is_lhs = false;
+	      convert_nonlocal_reference_op (&OMP_CLAUSE_OPERAND (clause, 0),
+					     &dummy, wi);
+	    }
+
+	  /* The gang clause accepts two arguments.  */
+	  if (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_GANG
+	      && OMP_CLAUSE_GANG_STATIC_EXPR (clause))
+	    {
+		wi->val_only = true;
+		wi->is_lhs = false;
+		convert_nonlocal_reference_op
+		  (&OMP_CLAUSE_GANG_STATIC_EXPR (clause), &dummy, wi);
+	    }
 	  break;
 
 	case OMP_CLAUSE_DIST_SCHEDULE:
@@ -1175,6 +1196,7 @@ convert_nonlocal_omp_clauses (tree *pclauses, struct walk_stmt_info *wi)
 	case OMP_CLAUSE_THREADS:
 	case OMP_CLAUSE_SIMD:
 	case OMP_CLAUSE_DEFAULTMAP:
+	case OMP_CLAUSE_SEQ:
 	  break;
 
 	default:
@@ -1762,10 +1784,31 @@ convert_local_omp_clauses (tree *pclauses, struct walk_stmt_info *wi)
 	case OMP_CLAUSE_NUM_TASKS:
 	case OMP_CLAUSE_HINT:
 	case OMP_CLAUSE__CILK_FOR_COUNT_:
-	  wi->val_only = true;
-	  wi->is_lhs = false;
-	  convert_local_reference_op (&OMP_CLAUSE_OPERAND (clause, 0), &dummy,
-				      wi);
+	case OMP_CLAUSE_NUM_GANGS:
+	case OMP_CLAUSE_NUM_WORKERS:
+	case OMP_CLAUSE_VECTOR_LENGTH:
+	case OMP_CLAUSE_GANG:
+	case OMP_CLAUSE_WORKER:
+	case OMP_CLAUSE_VECTOR:
+	  /* Several OpenACC clauses have optional arguments.  Check if they
+	     are present.  */
+	  if (OMP_CLAUSE_OPERAND (clause, 0))
+	    {
+	      wi->val_only = true;
+	      wi->is_lhs = false;
+	      convert_local_reference_op (&OMP_CLAUSE_OPERAND (clause, 0),
+					  &dummy, wi);
+	    }
+
+	  /* The gang clause accepts two arguments.  */
+	  if (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_GANG
+	      && OMP_CLAUSE_GANG_STATIC_EXPR (clause))
+	    {
+		wi->val_only = true;
+		wi->is_lhs = false;
+		convert_nonlocal_reference_op
+		  (&OMP_CLAUSE_GANG_STATIC_EXPR (clause), &dummy, wi);
+	    }
 	  break;
 
 	case OMP_CLAUSE_DIST_SCHEDULE:
@@ -1834,6 +1877,7 @@ convert_local_omp_clauses (tree *pclauses, struct walk_stmt_info *wi)
 	case OMP_CLAUSE_THREADS:
 	case OMP_CLAUSE_SIMD:
 	case OMP_CLAUSE_DEFAULTMAP:
+	case OMP_CLAUSE_SEQ:
 	  break;
 
 	default:
diff --git a/libgomp/ChangeLog b/libgomp/ChangeLog
index ce2828a8301..cb8b10c9c32 100644
--- a/libgomp/ChangeLog
+++ b/libgomp/ChangeLog
@@ -1,3 +1,11 @@
+2015-11-30  James Norris  <jnorris@codesourcery.com>
+	    Cesar Philippidis  <cesar@codesourcery.com>
+
+	libgomp/
+	* libgomp.oacc-fortran/routine-5.f90: New test.
+	* libgomp.oacc-fortran/routine-7.f90: New test.
+	* libgomp.oacc-fortran/routine-9.f90: New test.
+
 2015-11-30  Tom de Vries  <tom@codesourcery.com>
 
 	PR tree-optimization/46032
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/routine-5.f90 b/libgomp/testsuite/libgomp.oacc-fortran/routine-5.f90
new file mode 100644
index 00000000000..956da8ed043
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/routine-5.f90
@@ -0,0 +1,27 @@
+! { dg-do run }
+! { dg-options "-fno-inline" }
+
+program main
+    integer :: n
+
+    n = 5
+
+    !$acc parallel copy (n)
+      n = func (n)
+    !$acc end parallel
+
+    if (n .ne. 6) call abort
+
+contains
+
+    function func (n) result (rc)
+    !$acc routine
+    integer, intent (in) :: n
+    integer :: rc
+
+    rc = n
+    rc = rc + 1
+
+    end function
+
+end program
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/routine-7.f90 b/libgomp/testsuite/libgomp.oacc-fortran/routine-7.f90
new file mode 100644
index 00000000000..7fc81691bfb
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/routine-7.f90
@@ -0,0 +1,121 @@
+
+! { dg-do run }
+! { dg-additional-options "-cpp" }
+
+#define M 8
+#define N 32
+
+program main
+  integer :: i
+  integer :: a(N)
+  integer :: b(M * N)
+
+  do i = 1, N
+    a(i) = 0
+  end do
+
+  !$acc parallel copy (a)
+  !$acc loop seq
+    do i = 1, N
+      call seq (a)
+    end do
+  !$acc end parallel
+
+  do i = 1, N
+    if (a(i) .ne.N) call abort
+  end do
+
+  !$acc parallel copy (a)
+  !$acc loop seq
+    do i = 1, N 
+      call gang (a)
+    end do
+  !$acc end parallel
+
+  do i = 1, N
+    if (a(i) .ne. (N + (N * (-1 * i)))) call abort
+  end do
+
+  do i = 1, N
+    b(i) = i
+  end do
+
+  !$acc parallel copy (b)
+  !$acc loop
+    do i = 1, N
+      call worker (b)
+    end do
+  !$acc end parallel
+
+  do i = 1, N
+    if (b(i) .ne. N + i) call abort
+  end do
+
+  do i = 1, N
+    a(i) = i
+  end do
+
+  !$acc parallel copy (a)
+  !$acc loop
+    do i = 1, N
+      call vector (a)
+    end do
+  !$acc end parallel
+
+  do i = 1, N
+    if (a(i) .ne. 0) call abort
+  end do
+
+contains
+
+subroutine vector (a)
+  !$acc routine vector
+  integer, intent (inout) :: a(N)
+  integer :: i
+
+  !$acc loop vector
+  do i = 1, N
+    a(i) = a(i) - a(i) 
+  end do
+
+end subroutine vector
+
+subroutine worker (b)
+  !$acc routine worker
+  integer, intent (inout) :: b(M*N)
+  integer :: i, j
+
+  !$acc loop worker
+  do i = 1, N
+  !$acc loop vector
+    do j = 1, M
+      b(j + ((i - 1) * M)) = b(j + ((i - 1) * M)) + 1
+    end do
+  end do
+
+end subroutine worker
+
+subroutine gang (a)
+  !$acc routine gang
+  integer, intent (inout) :: a(N)
+  integer :: i
+
+  !$acc loop gang
+  do i = 1, N
+    a(i) = a(i) - i 
+  end do
+
+end subroutine gang
+
+subroutine seq (a)
+  !$acc routine seq
+  integer, intent (inout) :: a(M)
+  integer :: i
+
+  do i = 1, N
+    a(i) = a(i) + 1
+  end do
+
+end subroutine seq
+
+end program main
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/routine-9.f90 b/libgomp/testsuite/libgomp.oacc-fortran/routine-9.f90
new file mode 100644
index 00000000000..95d1a1392d8
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/routine-9.f90
@@ -0,0 +1,31 @@
+! { dg-do run }
+! { dg-options "-fno-inline" }
+
+program main
+  implicit none
+  integer, parameter :: n = 10
+  integer :: a(n), i
+  integer, external :: fact
+  !$acc routine (fact)
+  !$acc parallel
+  !$acc loop
+  do i = 1, n
+     a(i) = fact (i)
+  end do
+  !$acc end parallel
+  do i = 1, n
+     if (a(i) .ne. fact(i)) call abort
+  end do
+end program main
+
+recursive function fact (x) result (res)
+  implicit none
+  !$acc routine (fact)
+  integer, intent(in) :: x
+  integer :: res
+  if (x < 1) then
+     res = 1
+  else
+     res = x * fact(x - 1)
+  end if
+end function fact