Index: fortran/gfortran.h
===================================================================
--- fortran/gfortran.h	(Revision 271629)
+++ fortran/gfortran.h	(Arbeitskopie)
@@ -3532,6 +3532,7 @@ typedef int (*walk_expr_fn_t) (gfc_expr **, int *,
 int gfc_dummy_code_callback (gfc_code **, int *, void *);
 int gfc_expr_walker (gfc_expr **, walk_expr_fn_t, void *);
 int gfc_code_walker (gfc_code **, walk_code_fn_t, walk_expr_fn_t, void *);
+bool gfc_has_dimen_vector_ref (gfc_expr *e);
 
 /* simplify.c */
 
Index: fortran/trans.h
===================================================================
--- fortran/trans.h	(Revision 271629)
+++ fortran/trans.h	(Arbeitskopie)
@@ -535,8 +535,11 @@ int gfc_conv_procedure_call (gfc_se *, gfc_symbol
 void gfc_conv_subref_array_arg (gfc_se *, gfc_expr *, int, sym_intent, bool,
 				const gfc_symbol *fsym = NULL,
 				const char *proc_name = NULL,
-				gfc_symbol *sym = NULL);
+				gfc_symbol *sym = NULL,
+				bool check_contiguous = false);
 
+void gfc_conv_is_contiguous_expr (gfc_se *, gfc_expr *);
+
 /* Generate code for a scalar assignment.  */
 tree gfc_trans_scalar_assign (gfc_se *, gfc_se *, gfc_typespec, bool, bool,
 			      bool c = false);
Index: fortran/frontend-passes.c
===================================================================
--- fortran/frontend-passes.c	(Revision 271629)
+++ fortran/frontend-passes.c	(Arbeitskopie)
@@ -54,7 +54,6 @@ static gfc_code * create_do_loop (gfc_expr *, gfc_
 static gfc_expr* check_conjg_transpose_variable (gfc_expr *, bool *,
 						 bool *);
 static int call_external_blas (gfc_code **, int *, void *);
-static bool has_dimen_vector_ref (gfc_expr *);
 static int matmul_temp_args (gfc_code **, int *,void *data);
 static int index_interchange (gfc_code **, int*, void *);
 
@@ -2868,7 +2867,7 @@ matmul_temp_args (gfc_code **c, int *walk_subtrees
     {
       if (matrix_a->expr_type == EXPR_VARIABLE
 	  && (gfc_check_dependency (matrix_a, expr1, true)
-	      || has_dimen_vector_ref (matrix_a)))
+	      || gfc_has_dimen_vector_ref (matrix_a)))
 	a_tmp = true;
     }
   else
@@ -2881,7 +2880,7 @@ matmul_temp_args (gfc_code **c, int *walk_subtrees
     {
       if (matrix_b->expr_type == EXPR_VARIABLE
 	  && (gfc_check_dependency (matrix_b, expr1, true)
-	      || has_dimen_vector_ref (matrix_b)))
+	      || gfc_has_dimen_vector_ref (matrix_b)))
 	b_tmp = true;
     }
   else
@@ -3681,8 +3680,8 @@ scalarized_expr (gfc_expr *e_in, gfc_expr **index,
 
 /* Helper function to check for a dimen vector as subscript.  */
 
-static bool
-has_dimen_vector_ref (gfc_expr *e)
+bool
+gfc_has_dimen_vector_ref (gfc_expr *e)
 {
   gfc_array_ref *ar;
   int i;
@@ -3838,8 +3837,8 @@ inline_matmul_assign (gfc_code **c, int *walk_subt
   if (matrix_b == NULL)
     return 0;
 
-  if (has_dimen_vector_ref (expr1) || has_dimen_vector_ref (matrix_a)
-      || has_dimen_vector_ref (matrix_b))
+  if (gfc_has_dimen_vector_ref (expr1) || gfc_has_dimen_vector_ref (matrix_a)
+      || gfc_has_dimen_vector_ref (matrix_b))
     return 0;
 
   /* We do not handle data dependencies yet.  */
Index: fortran/trans-array.c
===================================================================
--- fortran/trans-array.c	(Revision 271629)
+++ fortran/trans-array.c	(Arbeitskopie)
@@ -8139,12 +8139,12 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr *
 	 optimizers.  */
 
       if (g77 && optimize && !optimize_size && expr->expr_type == EXPR_VARIABLE
-	  && !is_pointer (expr) && (fsym == NULL
-				    || fsym->ts.type != BT_ASSUMED))
+	  && !is_pointer (expr) && ! gfc_has_dimen_vector_ref (expr)
+	  && (fsym == NULL || fsym->ts.type != BT_ASSUMED))
 	{
 	  gfc_conv_subref_array_arg (se, expr, g77,
 				     fsym ? fsym->attr.intent : INTENT_INOUT,
-				     false, fsym, proc_name, sym);
+				     false, fsym, proc_name, sym, true);
 	  return;
 	}
 
Index: fortran/trans-expr.c
===================================================================
--- fortran/trans-expr.c	(Revision 271629)
+++ fortran/trans-expr.c	(Arbeitskopie)
@@ -4579,7 +4579,7 @@ void
 gfc_conv_subref_array_arg (gfc_se *se, gfc_expr * expr, int g77,
 			   sym_intent intent, bool formal_ptr,
 			   const gfc_symbol *fsym, const char *proc_name,
-			   gfc_symbol *sym)
+			   gfc_symbol *sym, bool check_contiguous)
 {
   gfc_se lse;
   gfc_se rse;
@@ -4602,7 +4602,7 @@ gfc_conv_subref_array_arg (gfc_se *se, gfc_expr *
 
   pass_optional = fsym && fsym->attr.optional && sym && sym->attr.optional;
 
-  if (pass_optional)
+  if (pass_optional || check_contiguous)
     {
       gfc_init_se (&work_se, NULL);
       parmse = &work_se;
@@ -4880,50 +4880,136 @@ class_array_fcn:
   else
     parmse->expr = gfc_build_addr_expr (NULL_TREE, parmse->expr);
 
-  if (pass_optional)
+  /* Basically make this into
+     
+     if (present)
+       {
+	 if (contiguous)
+	   {
+	     pointer = a;
+	   }
+	 else
+	   {
+	     parmse->pre();
+	     pointer = parmse->expr;
+	   }
+       }
+     else
+       pointer = NULL;
+
+     foo (pointer);
+     if (present && !contiguous)
+	   se->post();
+
+     */
+
+  if (pass_optional || check_contiguous)
     {
-      tree present;
       tree type;
       stmtblock_t else_block;
       tree pre_stmts, post_stmts;
       tree pointer;
       tree else_stmt;
+      tree present_var = NULL_TREE;
+      tree cont_var = NULL_TREE;
+      tree post_cond;
 
-      /* Make this into
+      type = TREE_TYPE (parmse->expr);
+      pointer = gfc_create_var (type, "arg_ptr");
 
-	 if (present (a))
-	   {
-	      parmse->pre;
-	      optional = parse->expr;
-	   }
-         else
-	   optional = NULL;
-         call foo (optional);
-         if (present (a))
-            parmse->post;
+      if (check_contiguous)
+	{
+	  gfc_se cont_se, array_se;
+	  stmtblock_t if_block, else_block;
+	  tree if_stmt, else_stmt;
 
-      */
+	  cont_var = gfc_create_var (boolean_type_node, "contiguous");
 
-      type = TREE_TYPE (parmse->expr);
-      pointer = gfc_create_var (type, "optional");
-      tmp = gfc_conv_expr_present (sym);
-      present = gfc_evaluate_now (tmp, &se->pre);
-      gfc_add_modify (&parmse->pre, pointer, parmse->expr);
-      pre_stmts = gfc_finish_block (&parmse->pre);
+	  /* cont_var = is_contiguous (expr); .  */
+	  gfc_init_se (&cont_se, parmse);
+	  gfc_conv_is_contiguous_expr (&cont_se, expr);
+	  gfc_add_block_to_block (&se->pre, &(&cont_se)->pre);
+	  gfc_add_modify (&se->pre, cont_var, cont_se.expr);
+	  gfc_add_block_to_block (&se->pre, &(&cont_se)->post);
 
-      gfc_init_block (&else_block);
-      gfc_add_modify (&else_block, pointer, build_int_cst (type, 0));
-      else_stmt = gfc_finish_block (&else_block);
+	  /* arrayse->expr = descriptor of a.  */
+	  gfc_init_se (&array_se, se);
+	  gfc_conv_expr_descriptor (&array_se, expr);
+	  gfc_add_block_to_block (&se->pre, &(&array_se)->pre);
+	  gfc_add_block_to_block (&se->pre, &(&array_se)->post);
 
-      tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, present,
-			     pre_stmts, else_stmt);
-      gfc_add_expr_to_block (&se->pre, tmp);
+	  /* if_stmt = { pointer = &a[0]; } .  */
+	  gfc_init_block (&if_block);
+	  tmp = gfc_conv_array_data (array_se.expr);
+	  tmp = fold_convert (type, tmp);
+	  gfc_add_modify (&if_block, pointer, tmp);
+	  if_stmt = gfc_finish_block (&if_block);
 
+	  /* else_stmt = { parmse->pre(); pointer = parmse->expr; } .  */
+	  gfc_init_block (&else_block);
+	  gfc_add_block_to_block (&else_block, &parmse->pre);
+	  gfc_add_modify (&else_block, pointer, parmse->expr);
+	  else_stmt = gfc_finish_block (&else_block);
+
+	  /* And put the above into an if statement.  */
+	  pre_stmts = fold_build3_loc (input_location, COND_EXPR, void_type_node,
+				      cont_var, if_stmt, else_stmt);
+	}
+      else
+	{
+	  /* pointer = pramse->expr;  .  */
+	  gfc_add_modify (&parmse->pre, pointer, parmse->expr);
+	  pre_stmts = gfc_finish_block (&parmse->pre);
+	}
+
+      if (pass_optional)
+	{
+	  present_var = gfc_create_var (boolean_type_node, "present");
+
+	  /* present_var = present(sym); .  */
+	  tmp = gfc_conv_expr_present (sym);
+	  tmp = fold_convert (boolean_type_node, tmp);
+	  gfc_add_modify (&se->pre, present_var, tmp);
+
+	  /* else_stmt = { pointer = NULL; } .  */
+	  gfc_init_block (&else_block);
+	  gfc_add_modify (&else_block, pointer, build_int_cst (type, 0));
+	  else_stmt = gfc_finish_block (&else_block);
+
+	  tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, present_var,
+				 pre_stmts, else_stmt);
+	  gfc_add_expr_to_block (&se->pre, tmp);
+
+
+	}
+      else
+	gfc_add_expr_to_block (&se->pre, pre_stmts);
+
       post_stmts = gfc_finish_block (&parmse->post);
-      tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, present,
+
+      /* Put together the post stuff, plus the optional
+	 deallocation.  */
+      if (check_contiguous)
+	{
+	  /* !cont_var.  */
+	  tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
+				 cont_var,
+				 build_zero_cst (boolean_type_node));
+	  if (pass_optional)
+	    post_cond = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR,
+					 boolean_type_node, present_var, tmp);
+	  else
+	    post_cond = tmp;
+	}
+      else
+	{
+	  gcc_assert (pass_optional);
+	  post_cond = present_var;
+	}
+
+      tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, post_cond,
 			     post_stmts, build_empty_stmt (input_location));
       gfc_add_expr_to_block (&se->post, tmp);
-
       se->expr = pointer;
     }
 
Index: fortran/trans-intrinsic.c
===================================================================
--- fortran/trans-intrinsic.c	(Revision 271629)
+++ fortran/trans-intrinsic.c	(Arbeitskopie)
@@ -2832,6 +2832,17 @@ static void
 gfc_conv_intrinsic_is_contiguous (gfc_se * se, gfc_expr * expr)
 {
   gfc_expr *arg;
+  arg = expr->value.function.actual->expr;
+  gfc_conv_is_contiguous_expr (se, arg);
+  se->expr = fold_convert (gfc_typenode_for_spec (&expr->ts), se->expr);
+}
+
+/* This function does the work for gfc_conv_intrinsic_is_contiguous,
+   plus it can be called directly.  */
+
+void
+gfc_conv_is_contiguous_expr (gfc_se *se, gfc_expr *arg)
+{
   gfc_ss *ss;
   gfc_se argse;
   tree desc, tmp, stride, extent, cond;
@@ -2839,8 +2850,6 @@ gfc_conv_intrinsic_is_contiguous (gfc_se * se, gfc
   tree fncall0;
   gfc_array_spec *as;
 
-  arg = expr->value.function.actual->expr;
-
   if (arg->ts.type == BT_CLASS)
     gfc_add_class_array_ref (arg);
 
@@ -2878,7 +2887,7 @@ gfc_conv_intrinsic_is_contiguous (gfc_se * se, gfc
       cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
 			      stride, build_int_cst (TREE_TYPE (stride), 1));
 
-      for (i = 0; i < expr->value.function.actual->expr->rank - 1; i++)
+      for (i = 0; i < arg->rank - 1; i++)
 	{
 	  tmp = gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[i]);
 	  extent = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[i]);
@@ -2896,7 +2905,7 @@ gfc_conv_intrinsic_is_contiguous (gfc_se * se, gfc
 	  cond = fold_build2_loc (input_location, TRUTH_AND_EXPR,
 				  boolean_type_node, cond, tmp);
 	}
-      se->expr = convert (gfc_typenode_for_spec (&expr->ts), cond);
+      se->expr = cond;
     }
 }
 
Index: testsuite/gfortran.dg/internal_pack_21.f90
===================================================================
--- testsuite/gfortran.dg/internal_pack_21.f90	(Revision 271629)
+++ testsuite/gfortran.dg/internal_pack_21.f90	(Arbeitskopie)
@@ -20,5 +20,5 @@ END MODULE M1
 USE M1
 CALL S2()
 END
-! { dg-final { scan-tree-dump-times "optional" 4 "original" } }
+! { dg-final { scan-tree-dump-times "arg_ptr" 5 "original" } }
 ! { dg-final { scan-tree-dump-not "_gfortran_internal_unpack" "original" } }
