NOTE: The patch has to be cleaned up a bit. Additionally, the ChangeLog
is not up to date.
TODO 2: Some test cases are badly missing.

TODO 3:
	* For nonpointer/nonallocatables, the bounds should be converted
	before the call. I think that matches the rules for Fortran
	functions, but that should be checked against the standard.
	In any case, the C function shall get the correct result.
	Alternatively, one can modify lbound/ubound to handle the
	conversion.
	lbound can also be simplified to directly set 1 for
	nonpointer/nonallocatables - no need to look at the values when
	the result it known.
	* Handle assumed-size (!) actual arguments
	* Handle scalars
	* Update the scalarizer

2012-06-21  Tobias Burnus  <burnus@net-b.de>

	* arraspec_sizey.c (gfc_match_array_spec, spec_size): Add support
	for assumed-rank arrays.
	* check.c (dim_rank_check): Ditto.
	* dump-parse-tree.c (show_array_spec): Ditto.
	* gfortran.h (array_type): Ditto.
	* interface.c (compare_type_rank, compare_parameter,
	argument_rank_mismatch, gfc_procedure_use): Ditto.
	* resolve.c (resolve_formal_arglist, resolve_global_procedure,
	expression_shape, resolve_variable, resolve_symbol,
	resolve_fl_var_and_proc): Ditto.
	(assumed_rank_type_expr_allowed): Renamed static variable from
	assumed_type_expr_allowed.
	* simplify.c (simplify_bound, gfc_simplify_range): Ditto.
	* trans-array.c (gfc_conv_array_parameter): Ditto.
	* trans-decl. (gfc_build_dummy_array_decl,
	gfc_trans_deferred_vars): Ditto.
	* trans-types.c (gfc_is_nodesc_array, gfc_build_array_type,
	gfc_get_array_descriptor_base): Ditto.
	* trans-expr.c (gfc_conv_procedure_call): Ditto.
	* trans-intrinsic.c (get_rank_from_desc): New function.
	(gfc_conv_intrinsic_rank, gfc_conv_intrinsic_bound,
	gfc_conv_associated): Use it.

diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c
index b36d517..c7a994c 100644
--- a/gcc/fortran/array.c
+++ b/gcc/fortran/array.c
@@ -457,6 +457,20 @@ gfc_match_array_spec (gfc_array_spec **asp, bool match_dim, bool match_codim)
       goto coarray;
     }
 
+  if (gfc_match (" .. )") == MATCH_YES)
+    {
+      as->type = AS_ASSUMED_RANK;
+      as->rank = -1;
+
+      if (gfc_notify_std (GFC_STD_F2008_TS, "TS 29113: Assumed-rank array "
+			  "at %C") == FAILURE)
+	goto cleanup;
+
+      if (!match_codim)
+	goto done;
+      goto coarray;
+    }
+
   for (;;)
     {
       as->rank++;
@@ -535,6 +549,9 @@ gfc_match_array_spec (gfc_array_spec **asp, bool match_dim, bool match_codim)
 
 	    gfc_error ("Bad specification for assumed size array at %C");
 	    goto cleanup;
+
+	  case AS_ASSUMED_RANK:
+	    gcc_unreachable (); 
 	  }
 
       if (gfc_match_char (')') == MATCH_YES)
@@ -641,6 +658,9 @@ coarray:
 	    case AS_ASSUMED_SIZE:
 	      gfc_error ("Bad specification for assumed size array at %C");
 	      goto cleanup;
+
+	    case AS_ASSUMED_RANK:
+	      gcc_unreachable (); 
 	  }
 
       if (gfc_match_char (']') == MATCH_YES)
@@ -1959,6 +1979,9 @@ spec_size (gfc_array_spec *as, mpz_t *result)
   mpz_t size;
   int d;
 
+  if (as->type == AS_ASSUMED_RANK)
+    return FAILURE;
+
   mpz_init_set_ui (*result, 1);
 
   for (d = 0; d < as->rank; d++)
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 7d505d5..b0c4b28 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -619,6 +619,10 @@ dim_rank_check (gfc_expr *dim, gfc_expr *array, int allow_assumed)
   else
     rank = array->rank;
 
+  /* Assumed-rank array.  */
+  if (rank == -1)
+    rank = GFC_MAX_DIMENSIONS;
+
   if (array->expr_type == EXPR_VARIABLE)
     {
       ar = gfc_find_array_ref (array);
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 26b5059..dfc04cd 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -593,7 +593,7 @@ merge_array_spec (gfc_array_spec *from, gfc_array_spec *to, bool copy)
 {
   int i;
 
-  if (to->rank == 0 && from->rank > 0)
+  if (to->rank == 0 && from->rank != 0)
     {
       to->rank = from->rank;
       to->type = from->type;
diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index 7f1d28f..d94d9d3 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -165,7 +165,7 @@ show_array_spec (gfc_array_spec *as)
 
   fprintf (dumpfile, "(%d [%d]", as->rank, as->corank);
 
-  if (as->rank + as->corank > 0)
+  if (as->rank + as->corank > 0 || as->rank == -1)
     {
       switch (as->type)
       {
@@ -173,6 +173,7 @@ show_array_spec (gfc_array_spec *as)
 	case AS_DEFERRED:      c = "AS_DEFERRED";      break;
 	case AS_ASSUMED_SIZE:  c = "AS_ASSUMED_SIZE";  break;
 	case AS_ASSUMED_SHAPE: c = "AS_ASSUMED_SHAPE"; break;
+	case AS_ASSUMED_RANK:  c = "AS_ASSUMED_RANK";  break;
 	default:
 	  gfc_internal_error ("show_array_spec(): Unhandled array shape "
 			      "type.");
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 4765afa..52735f9 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -4441,7 +4441,8 @@ gfc_is_simply_contiguous (gfc_expr *expr, bool strict)
 	    || (!part_ref
 		&& !sym->attr.contiguous
 		&& (sym->attr.pointer
-		      || sym->as->type == AS_ASSUMED_SHAPE))))
+		    || sym->as->type == AS_ASSUMED_RANK
+		    || sym->as->type == AS_ASSUMED_SHAPE))))
     return false;
 
   if (!ar || ar->type == AR_FULL)
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 759074a..454d873 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -132,7 +132,8 @@ expr_t;
 /* Array types.  */
 typedef enum
 { AS_EXPLICIT = 1, AS_ASSUMED_SHAPE, AS_DEFERRED,
-  AS_ASSUMED_SIZE, AS_IMPLIED_SHAPE, AS_UNKNOWN
+  AS_ASSUMED_SIZE, AS_IMPLIED_SHAPE, AS_ASSUMED_RANK,
+  AS_UNKNOWN
 }
 array_type;
 
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 95439c1..da6f034 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -511,7 +511,9 @@ compare_type_rank (gfc_symbol *s1, gfc_symbol *s2)
   r1 = (s1->as != NULL) ? s1->as->rank : 0;
   r2 = (s2->as != NULL) ? s2->as->rank : 0;
 
-  if (r1 != r2)
+  if (r1 != r2
+      && (!s1->as || s1->as->type != AS_ASSUMED_RANK)
+      && (!s2->as || s2->as->type != AS_ASSUMED_RANK))
     return 0;			/* Ranks differ.  */
 
   return gfc_compare_types (&s1->ts, &s2->ts)
@@ -1617,7 +1619,14 @@ static void
 argument_rank_mismatch (const char *name, locus *where,
 			int rank1, int rank2)
 {
-  if (rank1 == 0)
+
+  /* TS 29113, C407b.  */
+  if (rank2 == -1)
+    {
+      gfc_error ("The assumed-rank array at %L requires that the dummy argument"
+		 " '%s' has assumed-rank", where, name);
+    }
+  else if (rank1 == 0)
     {
       gfc_error ("Rank mismatch in argument '%s' at %L "
 		 "(scalar and rank-%d)", name, where, rank2);
@@ -1842,7 +1851,8 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
 		     " is modified",  &actual->where, formal->name);
     }
 
-  if (symbol_rank (formal) == actual->rank)
+  /* If the rank is the same or the formal argument has assumed-rank.  */
+  if (symbol_rank (formal) == actual->rank || symbol_rank (formal) == -1)
     return 1;
 
   if (actual->ts.type == BT_CLASS && CLASS_DATA (actual)->as
@@ -2973,6 +2983,15 @@ gfc_procedure_use (gfc_symbol *sym, gfc_actual_arglist **ap, locus *where)
 	      gfc_error ("MOLD argument to NULL required at %L", &a->expr->where);
 	      return;
 	    }
+
+	  /* TS 29113, C407b.  */
+	  if (a->expr && a->expr->expr_type == EXPR_VARIABLE
+	      && symbol_rank (a->expr->symtree->n.sym) == -1)
+	    {
+	      gfc_error ("Assumed-rank argument requires an explicit interface "
+			 "at %L", &a->expr->where);
+	      return;
+	    }
 	}
 
       return;
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index 60a74ca..87b903a 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -2340,6 +2340,7 @@ mio_typespec (gfc_typespec *ts)
 
 static const mstring array_spec_types[] = {
     minit ("EXPLICIT", AS_EXPLICIT),
+    minit ("ASSUMED_RANK", AS_ASSUMED_RANK),
     minit ("ASSUMED_SHAPE", AS_ASSUMED_SHAPE),
     minit ("DEFERRED", AS_DEFERRED),
     minit ("ASSUMED_SIZE", AS_ASSUMED_SIZE),
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index d09cb11..97e0b29 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -63,7 +63,8 @@ static code_stack *cs_base = NULL;
 static int forall_flag;
 static int do_concurrent_flag;
 
-static bool assumed_type_expr_allowed = false;
+/* Nonzero for assumed rank and for assumed type.  */
+static bool assumed_rank_type_expr_allowed = false;
 
 /* Nonzero if we're inside a OpenMP WORKSHARE or PARALLEL WORKSHARE block.  */
 
@@ -239,7 +240,7 @@ resolve_formal_arglist (gfc_symbol *proc)
 
   if (gfc_elemental (proc)
       || sym->attr.pointer || sym->attr.allocatable
-      || (sym->as && sym->as->rank > 0))
+      || (sym->as && sym->as->rank != 0))
     {
       proc->attr.always_explicit = 1;
       sym->attr.always_explicit = 1;
@@ -299,6 +300,7 @@ resolve_formal_arglist (gfc_symbol *proc)
 	}
 
       if ((sym->as && sym->as->rank > 0 && sym->as->type == AS_ASSUMED_SHAPE)
+	  || (sym->as && sym->as->type == AS_ASSUMED_RANK)
 	  || sym->attr.pointer || sym->attr.allocatable || sym->attr.target
 	  || sym->attr.optional)
 	{
@@ -1599,7 +1601,7 @@ resolve_actual_arglist (gfc_actual_arglist *arg, procedure_type ptype,
   gfc_expr *e;
   int save_need_full_assumed_size;
 
-  assumed_type_expr_allowed = true;
+  assumed_rank_type_expr_allowed = true;
 
   for (; arg; arg = arg->next)
     {
@@ -1832,8 +1834,18 @@ resolve_actual_arglist (gfc_actual_arglist *arg, procedure_type ptype,
 		     "component", &e->where);
           return FAILURE;
         }
+
+      /* TS29113, C407b and C535b: Assumed-type and assumed-rank are only
+	 allowed for the first argument.
+	 Cf. http://j3-fortran.org/pipermail/j3/2012-June/005419.html
+	 FIXME: It doesn't work reliably as inquiry_argument is not set
+	 for all inquiry functions in resolve_function; the reason is that
+	 the function-name resolution happens too late in that function.  */
+      if (inquiry_argument)
+	assumed_rank_type_expr_allowed = false;
+
     }
-  assumed_type_expr_allowed = false;
+  assumed_rank_type_expr_allowed = false;
 
   return SUCCESS;
 }
@@ -1895,7 +1907,7 @@ resolve_elemental_actual (gfc_expr *expr, gfc_code *c)
   /* The rank of an elemental is the rank of its array argument(s).  */
   for (arg = arg0; arg; arg = arg->next)
     {
-      if (arg->expr != NULL && arg->expr->rank > 0)
+      if (arg->expr != NULL && arg->expr->rank != 0)
 	{
 	  rank = arg->expr->rank;
 	  if (arg->expr->expr_type == EXPR_VARIABLE
@@ -2194,6 +2206,15 @@ resolve_global_procedure (gfc_symbol *sym, locus *where,
 			   sym->name, &sym->declared_at, arg->sym->name);
 		break;
 	      }
+	    /* TS 29113, 6.2.  */
+	    else if (arg->sym && arg->sym->as
+		     && arg->sym->as->type == AS_ASSUMED_RANK)
+	      {
+		gfc_error ("Procedure '%s' at %L with assumed-rank dummy "
+			   "argument '%s' must have an explicit interface",
+			   sym->name, &sym->declared_at, arg->sym->name);
+		break;
+	      }
 	    /* F2008, 12.4.2.2 (2c)  */
 	    else if (arg->sym->attr.codimension)
 	      {
@@ -2219,6 +2240,15 @@ resolve_global_procedure (gfc_symbol *sym, locus *where,
 			   sym->name, &sym->declared_at, arg->sym->name);
 		break;
 	      }
+	    /* As assumed-type is unlimited polymorphic (cf. above).
+	       See also  TS 29113, Note 6.1.  */
+	    else if (arg->sym->ts.type == BT_ASSUMED)
+	      {
+		gfc_error ("Procedure '%s' at %L with assumed-type dummy "
+			   "argument '%s' must have an explicit interface",
+			   sym->name, &sym->declared_at, arg->sym->name);
+		break;
+	      }
 	}
 
       if (def_sym->attr.function)
@@ -4964,7 +4994,7 @@ expression_shape (gfc_expr *e)
   mpz_t array[GFC_MAX_DIMENSIONS];
   int i;
 
-  if (e->rank == 0 || e->shape != NULL)
+  if (e->rank <= 0 || e->shape != NULL)
     return;
 
   for (i = 0; i < e->rank; i++)
@@ -5067,13 +5097,26 @@ resolve_variable (gfc_expr *e)
   sym = e->symtree->n.sym;
 
   /* TS 29113, 407b.  */
-  if (e->ts.type == BT_ASSUMED && !assumed_type_expr_allowed)
+  if (e->ts.type == BT_ASSUMED && !assumed_rank_type_expr_allowed)
     {
       gfc_error ("Invalid expression with assumed-type variable %s at %L",
 		 sym->name, &e->where);
       return FAILURE;
     }
 
+  /* TS 29113, C535b.  */
+  if (((sym->ts.type == BT_CLASS && sym->attr.class_ok
+	&& CLASS_DATA (sym)->as
+	&& CLASS_DATA (sym)->as->type == AS_ASSUMED_RANK)
+       || (sym->ts.type != BT_CLASS && sym->as
+	   && sym->as->type == AS_ASSUMED_RANK))
+      && !assumed_rank_type_expr_allowed)
+    {
+      gfc_error ("Invalid expression with assumed-rank variable %s at %L",
+		 sym->name, &e->where);
+      return FAILURE;
+    }
+
   /* TS 29113, 407b.  */
   if (e->ts.type == BT_ASSUMED && e->ref
       && !(e->ref->type == REF_ARRAY && e->ref->u.ar.type == AR_FULL
@@ -5084,6 +5127,22 @@ resolve_variable (gfc_expr *e)
       return FAILURE;
     }
 
+  /* TS 29113, C535b.  */
+  if (((sym->ts.type == BT_CLASS && sym->attr.class_ok
+	&& CLASS_DATA (sym)->as
+	&& CLASS_DATA (sym)->as->type == AS_ASSUMED_RANK)
+       || (sym->ts.type != BT_CLASS && sym->as
+	   && sym->as->type == AS_ASSUMED_RANK))
+      && e->ref
+      && !(e->ref->type == REF_ARRAY && e->ref->u.ar.type == AR_FULL
+           && e->ref->next == NULL))
+    {
+      gfc_error ("Assumed-rank variable %s with designator at %L",
+                 sym->name, &e->ref->u.ar.where);
+      return FAILURE;
+    }
+
+
   /* If this is an associate-name, it may be parsed with an array reference
      in error even though the target is scalar.  Fail directly in this case.
      TODO Understand why class scalar expressions must be excluded.  */
@@ -5584,7 +5643,7 @@ update_ppc_arglist (gfc_expr* e)
     return FAILURE;
 
   /* F08:R739.  */
-  if (po->rank > 0)
+  if (po->rank != 0)
     {
       gfc_error ("Passed-object at %L must be scalar", &e->where);
       return FAILURE;
@@ -5632,7 +5691,7 @@ check_typebound_baseobject (gfc_expr* e)
 
   /* F08:C1230. If the procedure called is NOPASS,
      the base object must be scalar.  */
-  if (e->value.compcall.tbp->nopass && base->rank > 0)
+  if (e->value.compcall.tbp->nopass && base->rank != 0)
     {
       gfc_error ("Base object for NOPASS type-bound procedure call at %L must"
 		 " be scalar", &e->where);
@@ -10319,10 +10378,10 @@ resolve_fl_var_and_proc (gfc_symbol *sym, int mp_flag)
 
       if (allocatable)
 	{
-	  if (dimension)
+	  if (dimension && as->type != AS_ASSUMED_RANK)
 	    {
-	      gfc_error ("Allocatable array '%s' at %L must have "
-			 "a deferred shape", sym->name, &sym->declared_at);
+	      gfc_error ("Allocatable array '%s' at %L must have a deferred "
+			 "shape or assumed rank", sym->name, &sym->declared_at);
 	      return FAILURE;
 	    }
 	  else if (gfc_notify_std (GFC_STD_F2003, "Scalar object '%s' at %L "
@@ -10331,10 +10390,10 @@ resolve_fl_var_and_proc (gfc_symbol *sym, int mp_flag)
 	    return FAILURE;
 	}
 
-      if (pointer && dimension)
+      if (pointer && dimension && as->type != AS_ASSUMED_RANK)
 	{
-	  gfc_error ("Array pointer '%s' at %L must have a deferred shape",
-		     sym->name, &sym->declared_at);
+	  gfc_error ("Array pointer '%s' at %L must have a deferred shape or "
+		     "deferred rank", sym->name, &sym->declared_at);
 	  return FAILURE;
 	}
     }
@@ -10948,7 +11007,7 @@ gfc_resolve_finalizers (gfc_symbol* derived)
 	}
 
       /* Warn if the procedure is non-scalar and not assumed shape.  */
-      if (gfc_option.warn_surprising && arg->as && arg->as->rank > 0
+      if (gfc_option.warn_surprising && arg->as && arg->as->rank != 0
 	  && arg->as->type != AS_ASSUMED_SHAPE)
 	gfc_warning ("Non-scalar FINAL procedure at %L should have assumed"
 		     " shape argument", &arg->declared_at);
@@ -11449,7 +11508,7 @@ resolve_typebound_procedure (gfc_symtree* stree)
 	}
   
       gcc_assert (me_arg->ts.type == BT_CLASS);
-      if (CLASS_DATA (me_arg)->as && CLASS_DATA (me_arg)->as->rank > 0)
+      if (CLASS_DATA (me_arg)->as && CLASS_DATA (me_arg)->as->rank != 0)
 	{
 	  gfc_error ("Passed-object dummy argument of '%s' at %L must be"
 		     " scalar", proc->name, &where);
@@ -12463,6 +12522,20 @@ resolve_symbol (gfc_symbol *sym)
 		       &sym->declared_at);
 	  return;
 	}
+      /* TS 29113, C535a.  */
+      if (as->type == AS_ASSUMED_RANK && !sym->attr.dummy)
+	{
+	  gfc_error ("Assumed-rank array at %L must be a dummy argument",
+		     &sym->declared_at);
+	  return;
+	}
+      if (as->type == AS_ASSUMED_RANK
+	  && (sym->attr.codimension || sym->attr.value))
+	{
+	  gfc_error ("Assumed-rank array at %L may not have the VALUE or "
+		     "CODIMENSION attribute", &sym->declared_at);
+	  return;
+	}
     }
 
   /* Make sure symbols with known intent or optional are really dummy
@@ -12535,6 +12608,13 @@ resolve_symbol (gfc_symbol *sym)
 		     sym->name, &sym->declared_at);
 	  return;
 	}
+      if (sym->attr.intent == INTENT_OUT)
+    	{
+	  gfc_error ("Assumed-type variable %s at %L may not have the "
+		     "INTENT(OUT) attribute",
+		     sym->name, &sym->declared_at);
+	  return;
+	}
       if (sym->attr.dimension && sym->as->type == AS_EXPLICIT)
 	{
 	  gfc_error ("Assumed-type variable %s at %L shall not be an "
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index 1578db1..10f654d 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -2934,7 +2934,6 @@ gfc_simplify_iparity (gfc_expr *array, gfc_expr *dim, gfc_expr *mask)
 }
 
 
-
 gfc_expr *
 gfc_simplify_is_iostat_end (gfc_expr *x)
 {
@@ -3380,7 +3379,8 @@ simplify_bound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind, int upper)
 
  done:
 
-  if (as && (as->type == AS_DEFERRED || as->type == AS_ASSUMED_SHAPE))
+  if (as && (as->type == AS_DEFERRED || as->type == AS_ASSUMED_SHAPE
+	     || as->type == AS_ASSUMED_RANK))
     return NULL;
 
   if (dim == NULL)
@@ -3442,13 +3442,16 @@ simplify_bound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind, int upper)
 
       d = mpz_get_si (dim->value.integer);
 
-      if (d < 1 || d > array->rank
+      if ((d < 1 || d > array->rank)
 	  || (d == array->rank && as && as->type == AS_ASSUMED_SIZE && upper))
 	{
 	  gfc_error ("DIM argument at %L is out of bounds", &dim->where);
 	  return &gfc_bad_expr;
 	}
 
+      if (as && as->type == AS_ASSUMED_RANK)
+	return NULL;
+
       return simplify_bound_dim (array, kind, d, upper, as, ref, false);
     }
 }
@@ -4779,6 +4782,10 @@ gfc_simplify_range (gfc_expr *e)
 gfc_expr *
 gfc_simplify_rank (gfc_expr *e)
 {
+  /* Assumed rank.  */
+  if (e->rank == -1)
+    return NULL;
+
   return gfc_get_int_expr (gfc_default_integer_kind, &e->where, e->rank);
 }
 
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index f135af1..6c58a8e 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -311,6 +311,7 @@ gfc_conv_descriptor_stride_get (tree desc, tree dim)
   if (integer_zerop (dim)
       && (GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ALLOCATABLE
 	  ||GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ASSUMED_SHAPE_CONT
+	  ||GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ASSUMED_RANK_CONT
 	  ||GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_POINTER_CONT))
     return gfc_index_one_node;
 
@@ -6906,9 +6907,10 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, bool g77,
 	}
 
       if (!sym->attr.pointer
-	    && sym->as
-	    && sym->as->type != AS_ASSUMED_SHAPE 
-            && !sym->attr.allocatable)
+	  && sym->as
+	  && sym->as->type != AS_ASSUMED_SHAPE 
+	  && sym->as->type != AS_ASSUMED_RANK 
+	  && !sym->attr.allocatable)
         {
 	  /* Some variables are declared directly, others are declared as
 	     pointers and allocated on the heap.  */
@@ -6944,10 +6946,12 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, bool g77,
   no_pack = ((sym && sym->as
 		  && !sym->attr.pointer
 		  && sym->as->type != AS_DEFERRED
+		  && sym->as->type != AS_ASSUMED_RANK
 		  && sym->as->type != AS_ASSUMED_SHAPE)
 		      ||
 	     (ref && ref->u.ar.as
 		  && ref->u.ar.as->type != AS_DEFERRED
+		  && ref->u.ar.as->type != AS_ASSUMED_RANK
 		  && ref->u.ar.as->type != AS_ASSUMED_SHAPE)
 		      ||
 	     gfc_is_simply_contiguous (expr, false));
@@ -8319,12 +8323,15 @@ gfc_walk_array_ref (gfc_ss * ss, gfc_expr * expr, gfc_ref * ref)
 	  break;
 
 	case AR_FULL:
-	  newss = gfc_get_array_ss (ss, expr, ar->as->rank, GFC_SS_SECTION);
+	  newss = gfc_get_array_ss (ss, expr,
+				    ar->as->rank < 0 ? GFC_MAX_DIMENSIONS
+						     : ar->as->rank,
+				    GFC_SS_SECTION);
 	  newss->info->data.array.ref = ref;
 
 	  /* Make sure array is the same as array(:,:), this way
 	     we don't need to special case all the time.  */
-	  ar->dimen = ar->as->rank;
+	  ar->dimen = ar->as->rank < 0 ? GFC_MAX_DIMENSIONS : ar->as->rank;
 	  for (n = 0; n < ar->dimen; n++)
 	    {
 	      ar->dimen_type[n] = DIMEN_RANGE;
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 75a2160..3f69184 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -933,7 +933,8 @@ gfc_build_dummy_array_decl (gfc_symbol * sym, tree dummy)
   int n;
   bool known_size;
 
-  if (sym->attr.pointer || sym->attr.allocatable)
+  if (sym->attr.pointer || sym->attr.allocatable
+      || (sym->as && sym->as->type == AS_ASSUMED_RANK))
     return dummy;
 
   /* Add to list of variables if not a fake result variable.  */
@@ -3670,6 +3671,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
 	      break;
 
 	    case AS_DEFERRED:
+	    case AS_ASSUMED_RANK:
 	      seen_trans_deferred_array = true;
 	      gfc_trans_deferred_array (sym, block);
 	      break;
@@ -4782,7 +4784,8 @@ add_argument_checking (stmtblock_t *block, gfc_symbol *sym)
 	   dummy argument is an array. (See "Sequence association" in
 	   Section 12.4.1.4 for F95 and 12.4.1.5 for F2003.)  */
 	if (fsym->attr.pointer || fsym->attr.allocatable
-	    || (fsym->as && fsym->as->type == AS_ASSUMED_SHAPE))
+	    || (fsym->as && (fsym->as->type == AS_ASSUMED_SHAPE
+			     || fsym->as->type == AS_ASSUMED_RANK)))
 	  {
 	    comparison = NE_EXPR;
 	    message = _("Actual string length does not match the declared one"
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 7d1a6d4..791b410 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -730,7 +730,8 @@ gfc_conv_expr_present (gfc_symbol * sym)
      as actual argument to denote absent dummies. For array descriptors,
      we thus also need to check the array descriptor.  */
   if (!sym->attr.pointer && !sym->attr.allocatable
-      && sym->as && sym->as->type == AS_ASSUMED_SHAPE
+      && sym->as && (sym->as->type == AS_ASSUMED_SHAPE
+		     || sym->as->type == AS_ASSUMED_RANK)
       && (gfc_option.allow_std & GFC_STD_F2008) != 0)
     {
       tree tmp;
@@ -1325,7 +1326,8 @@ gfc_conv_variable (gfc_se * se, gfc_expr * expr)
 	  /* Dereference non-character pointer variables. 
 	     These must be dummies, results, or scalars.  */
 	  if ((sym->attr.pointer || sym->attr.allocatable
-	       || gfc_is_associate_pointer (sym))
+	       || gfc_is_associate_pointer (sym)
+	       || (sym->as && sym->as->type == AS_ASSUMED_RANK))
 	      && (sym->attr.dummy
 		  || sym->attr.function
 		  || sym->attr.result
@@ -3769,7 +3771,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 	      bool f;
 	      f = (fsym != NULL)
 		  && !(fsym->attr.pointer || fsym->attr.allocatable)
-		  && fsym->as && fsym->as->type != AS_ASSUMED_SHAPE;
+		  && fsym->as && fsym->as->type != AS_ASSUMED_SHAPE
+		  && fsym->as->type != AS_ASSUMED_RANK;
 	      if (comp)
 		f = f || !comp->attr.always_explicit;
 	      else
@@ -3878,12 +3881,13 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 	     but do not always set fsym.  */
 	  if (e->expr_type == EXPR_VARIABLE
 	      && e->symtree->n.sym->attr.optional
-	      && ((e->rank > 0 && sym->attr.elemental)
+	      && ((e->rank != 0 && sym->attr.elemental)
 		  || e->representation.length || e->ts.type == BT_CHARACTER
-		  || (e->rank > 0
+		  || (e->rank != 0
 		      && (fsym == NULL 
 			  || (fsym-> as
 			      && (fsym->as->type == AS_ASSUMED_SHAPE
+				  || fsym->as->type == AS_ASSUMED_RANK
 			      	  || fsym->as->type == AS_DEFERRED))))))
 	    gfc_conv_missing_dummy (&parmse, e, fsym ? fsym->ts : e->ts,
 				    e->representation.length);
@@ -4129,7 +4133,9 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 	      tmp = caf_decl;
 	    }
 
-          if (fsym->as->type == AS_ASSUMED_SHAPE)
+          if (fsym->as->type == AS_ASSUMED_SHAPE
+	      || (fsym->as->type == AS_ASSUMED_RANK && !fsym->attr.pointer
+		  && !fsym->attr.allocatable))
 	    {
 	      gcc_assert (POINTER_TYPE_P (TREE_TYPE (parmse.expr)));
 	      gcc_assert (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index c74e81a..794eb7a 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -1316,29 +1316,37 @@ trans_num_images (gfc_se * se)
 }
 
 
+static tree
+get_rank_from_desc (tree desc)
+{
+  tree tmp;
+  tree dtype;
+
+  dtype = gfc_conv_descriptor_dtype (desc);
+  tmp = build_int_cst (TREE_TYPE (dtype), GFC_DTYPE_RANK_MASK);
+  tmp = fold_build2_loc (input_location, BIT_AND_EXPR, TREE_TYPE (dtype),
+			 dtype, tmp);
+  return fold_convert (gfc_get_int_type (gfc_default_integer_kind), tmp);
+}
+
+
 static void
 gfc_conv_intrinsic_rank (gfc_se *se, gfc_expr *expr)
 {
   gfc_se argse;
   gfc_ss *ss;
-  tree dtype, tmp;
 
   ss = gfc_walk_expr (expr->value.function.actual->expr);
   gcc_assert (ss != gfc_ss_terminator);
   gfc_init_se (&argse, NULL);
   argse.data_not_needed = 1;
-  argse.want_pointer = 1;
+  argse.descriptor_only = 1;
 
   gfc_conv_expr_descriptor (&argse, expr->value.function.actual->expr, ss);
   gfc_add_block_to_block (&se->pre, &argse.pre);
   gfc_add_block_to_block (&se->post, &argse.post);
-  argse.expr = build_fold_indirect_ref_loc (input_location, argse.expr);
-  argse.expr = build_fold_indirect_ref_loc (input_location, argse.expr);
-  dtype = gfc_conv_descriptor_dtype (argse.expr);
-  tmp = build_int_cst (TREE_TYPE (dtype), GFC_DTYPE_RANK_MASK);
-  tmp = fold_build2_loc (input_location, BIT_AND_EXPR, TREE_TYPE (dtype),
-			 dtype, tmp);
-  se->expr = fold_convert (gfc_get_int_type (gfc_default_integer_kind), tmp);
+
+  se->expr = get_rank_from_desc (argse.expr);
 }
 
 
@@ -1401,25 +1409,37 @@ gfc_conv_intrinsic_bound (gfc_se * se, gfc_expr * expr, int upper)
 
   desc = argse.expr;
 
+  as = gfc_get_full_arrayspec_from_expr (arg->expr);
+
+  /* FIXME: Why is this extra indirect_ref required?  */
+/*  if (as->type == AS_ASSUMED_RANK)
+    desc = build_fold_indirect_ref_loc (input_location, desc);*/
+
   if (INTEGER_CST_P (bound))
     {
       int hi, low;
 
       hi = TREE_INT_CST_HIGH (bound);
       low = TREE_INT_CST_LOW (bound);
-      if (hi || low < 0 || low >= GFC_TYPE_ARRAY_RANK (TREE_TYPE (desc)))
+      if (hi || low < 0
+	  || (as->type != AS_ASSUMED_RANK && low >= GFC_TYPE_ARRAY_RANK (TREE_TYPE (desc)))
+	  || low > GFC_MAX_DIMENSIONS)
 	gfc_error ("'dim' argument of %s intrinsic at %L is not a valid "
 		   "dimension index", upper ? "UBOUND" : "LBOUND",
 		   &expr->where);
     }
-  else
+
+  if (!INTEGER_CST_P (bound) || as->type == AS_ASSUMED_RANK)
     {
       if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)
         {
           bound = gfc_evaluate_now (bound, &se->pre);
           cond = fold_build2_loc (input_location, LT_EXPR, boolean_type_node,
 				  bound, build_int_cst (TREE_TYPE (bound), 0));
-          tmp = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (TREE_TYPE (desc))];
+	  if (as->type == AS_ASSUMED_RANK)
+	    tmp = get_rank_from_desc (desc);
+	  else
+	    tmp = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (TREE_TYPE (desc))];
           tmp = fold_build2_loc (input_location, GE_EXPR, boolean_type_node,
 				 bound, tmp);
           cond = fold_build2_loc (input_location, TRUTH_ORIF_EXPR,
@@ -1432,8 +1452,6 @@ gfc_conv_intrinsic_bound (gfc_se * se, gfc_expr * expr, int upper)
   ubound = gfc_conv_descriptor_ubound_get (desc, bound);
   lbound = gfc_conv_descriptor_lbound_get (desc, bound);
   
-  as = gfc_get_full_arrayspec_from_expr (arg->expr);
-
   /* 13.14.53: Result value for LBOUND
 
      Case (i): For an array section or for an array expression other than a
@@ -5856,8 +5874,11 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr)
 	     present.  */
 	  arg1se.descriptor_only = 1;
 	  gfc_conv_expr_lhs (&arg1se, arg1->expr);
-	  tmp = gfc_conv_descriptor_stride_get (arg1se.expr,
-					    gfc_rank_cst[arg1->expr->rank - 1]);
+	  if (arg1->expr->rank == -1)
+	    tmp = get_rank_from_desc (arg1se.expr);
+	  else
+	    tmp = gfc_rank_cst[arg1->expr->rank - 1];
+	  tmp = gfc_conv_descriptor_stride_get (arg1se.expr, tmp);
 	  nonzero_arraylen = fold_build2_loc (input_location, NE_EXPR,
 					      boolean_type_node, tmp,
 					      build_int_cst (TREE_TYPE (tmp), 0));
diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index aa50e3d..8b1caf8 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -1277,7 +1277,8 @@ gfc_is_nodesc_array (gfc_symbol * sym)
     return 0;
 
   if (sym->attr.dummy)
-    return sym->as->type != AS_ASSUMED_SHAPE;
+    return sym->as->type != AS_ASSUMED_SHAPE
+	   && sym->as->type != AS_ASSUMED_RANK;
 
   if (sym->attr.result || sym->attr.function)
     return 0;
@@ -1299,6 +1300,13 @@ gfc_build_array_type (tree type, gfc_array_spec * as,
   tree ubound[GFC_MAX_DIMENSIONS];
   int n;
 
+  if (as->type == AS_ASSUMED_RANK)
+    for (n = 0; n < GFC_MAX_DIMENSIONS; n++)
+      {
+	lbound[n] = NULL_TREE;
+	ubound[n] = NULL_TREE;
+      }
+
   for (n = 0; n < as->rank; n++)
     {
       /* Create expressions for the known bounds of the array.  */
@@ -1323,7 +1331,12 @@ gfc_build_array_type (tree type, gfc_array_spec * as,
   if (as->type == AS_ASSUMED_SHAPE)
     akind = contiguous ? GFC_ARRAY_ASSUMED_SHAPE_CONT
 		       : GFC_ARRAY_ASSUMED_SHAPE;
-  return gfc_get_array_type_bounds (type, as->rank, as->corank, lbound,
+  else if (as->type == AS_ASSUMED_RANK)
+    akind = contiguous ? GFC_ARRAY_ASSUMED_RANK_CONT
+		       : GFC_ARRAY_ASSUMED_RANK;
+  return gfc_get_array_type_bounds (type, as->rank == -1
+					  ? GFC_MAX_DIMENSIONS : as->rank,
+				    as->corank, lbound,
 				    ubound, 0, akind, restricted);
 }
 
@@ -1682,7 +1695,13 @@ gfc_get_array_descriptor_base (int dimen, int codimen, bool restricted,
 {
   tree fat_type, decl, arraytype, *chain = NULL;
   char name[16 + 2*GFC_RANK_DIGITS + 1 + 1];
-  int idx = 2 * (codimen + dimen - 1) + restricted;
+  int idx;
+
+  /* Assumed-rank array.  */
+  if (dimen == -1)
+    dimen = GFC_MAX_DIMENSIONS;
+
+  idx = 2 * (codimen + dimen - 1) + restricted;
 
   gcc_assert (codimen + dimen >= 1 && codimen + dimen <= GFC_MAX_DIMENSIONS);
 
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 3b77281..d4092f7 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -765,6 +765,8 @@ enum gfc_array_kind
   GFC_ARRAY_UNKNOWN,
   GFC_ARRAY_ASSUMED_SHAPE,
   GFC_ARRAY_ASSUMED_SHAPE_CONT,
+  GFC_ARRAY_ASSUMED_RANK,
+  GFC_ARRAY_ASSUMED_RANK_CONT,
   GFC_ARRAY_ALLOCATABLE,
   GFC_ARRAY_POINTER,
   GFC_ARRAY_POINTER_CONT