Commit for Asher Langton

	PR fortran/17031
	PR fortran/22282

fortran/
	* check.c (gfc_check_loc) : New function
	* decl.c (variable_decl): New variables cp_as and sym. Added a
	check for variables that have already been declared as Cray
	Pointers, so we can get the necessary attributes without adding
	a new symbol.
	(attr_decl1): Added code to catch pointee symbols and "fix"
	their array specs.
	(cray_pointer_decl): New method.
	(gfc_match_pointer): Added Cray pointer parsing code.
	(gfc_mod_pointee_as): New method.
	* expr.c (gfc_check_assign): added a check to catch vector-type
	assignments to pointees with an unspecified final dimension.
	* gfortran.h: (GFC_ISYM_LOC): New.
	(symbol_attribute): Added cray_pointer and cray_pointee bits.
	(gfc_array_spec): Added cray_pointee and cp_was_assumed bools.
	(gfc_symbol): Added gfc_symbol *cp_pointer.
	(gfc_option): Added flag_cray_pointer.
	(gfc_add_cray_pointee): Declare.
	(gfc_add_cray_pointer ): Declare.
	(gfc_mod_pointee_as): Declare.
	* intrinsic.c (add_functions): Add code for loc() intrinsic.
	* intrinsic.h (gfc_check_loc): Declare.
	(gfc_resolve_loc): Declare.
	* iresolve.c (gfc_resolve_loc): New.
	* lang.opt: Added fcray-pointer flag.
	* options.c (gfc_init_options): Intialized
	gfc_match_option.flag_cray_pointer.
	(gfc_handle_option): Deal with -fcray-pointer.
	* parse.c:(resolve_equivalence): Added code prohibiting Cray
	pointees in equivalence statements.
	* resolve.c (resolve_array_ref): Added code to prevent bounds
	checking for Cray Pointee arrays.
	(resolve_equivalence): Prohibited pointees in equivalence
	statements.
	* symbol.c (check_conflict): Added Cray pointer/pointee
	attribute checking.
	(gfc_add_cray_pointer): New
	(gfc_add_cray_pointee): New
	(gfc_copy_attr): New code for Cray pointers and pointees
	* trans-array.c (gfc_trans_auto_array_allocation): Added code to
	prevent space from being allocated for pointees.
	(gfc_conv_array_parameter): Added code to catch pointees and
	correctly set their base address.
	* trans-decl.c (gfc_finish_var_decl): Added code to prevent
	pointee declarations from making it to the back end.
	(gfc_create_module_variable): Same.
	* trans-expr.c (gfc_conv_variable): added code to detect and
	translate pointees.
	(gfc_conv_cray_pointee): New.
	* trans-intrinsic.c (gfc_conv_intrinsic_loc): New.
	(gfc_conv_intrinsic_function): added entry point for loc
	translation.
	* trans.h (gfc_conv_cray_pointee): Declare.

	* gfortran.texi: Added section on Cray pointers, removed Cray
	pointers from list of proposed extensions
	* intrinsic.texi: Added documentation for loc intrinsic.
	* invoke.texi: Documented -fcray-pointer flag

testsuite/
	PR fortran/17031
	PR fortran/22282
	* gfortran.dg/cray_pointers_1.f90: New test.
	* gfortran.dg/cray_pointers_2.f90: New test.
	* gfortran.dg/cray_pointers_3.f90: New test.
	* gfortran.dg/loc_1.f90: New test.
	* gfortran.dg/loc_2.f90: New test.


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@105859 138bc75d-0d04-0410-961f-82ee72b054a4

26 files changed, 4556 insertions, 15 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index a019a1b2512..87c993e1c17 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,5 +1,68 @@
 2005-10-24  Asher Langton  <langton2@llnl.gov>
 
+	PR fortran/17031
+	PR fortran/22282
+	* check.c (gfc_check_loc) : New function
+	* decl.c (variable_decl): New variables cp_as and sym. Added a	  
+	check for variables that have already been declared as Cray
+	Pointers, so we can get the necessary attributes without adding
+	a new symbol.
+	(attr_decl1): Added code to catch pointee symbols and "fix"
+	their array specs.
+	(cray_pointer_decl): New method.
+	(gfc_match_pointer): Added Cray pointer parsing code.
+	(gfc_mod_pointee_as): New method.
+	* expr.c (gfc_check_assign): added a check to catch vector-type
+	assignments to pointees with an unspecified final dimension.
+	* gfortran.h: (GFC_ISYM_LOC): New.
+	(symbol_attribute): Added cray_pointer and cray_pointee bits.
+	(gfc_array_spec): Added cray_pointee and cp_was_assumed bools.
+	(gfc_symbol): Added gfc_symbol *cp_pointer.
+	(gfc_option): Added flag_cray_pointer.
+	(gfc_add_cray_pointee): Declare.
+	(gfc_add_cray_pointer ): Declare.
+	(gfc_mod_pointee_as): Declare.
+	* intrinsic.c (add_functions): Add code for loc() intrinsic.
+	* intrinsic.h (gfc_check_loc): Declare.
+	(gfc_resolve_loc): Declare.
+	* iresolve.c (gfc_resolve_loc): New.
+	* lang.opt: Added fcray-pointer flag.
+	* options.c (gfc_init_options): Intialized
+	gfc_match_option.flag_cray_pointer.
+	(gfc_handle_option): Deal with -fcray-pointer.
+	* parse.c:(resolve_equivalence): Added code prohibiting Cray
+	pointees in equivalence statements.
+	* resolve.c (resolve_array_ref): Added code to prevent bounds
+	checking for Cray Pointee arrays.
+	(resolve_equivalence): Prohibited pointees in equivalence
+	statements.
+	* symbol.c (check_conflict): Added Cray pointer/pointee	 
+	attribute checking.
+	(gfc_add_cray_pointer): New
+	(gfc_add_cray_pointee): New
+	(gfc_copy_attr): New code for Cray pointers and pointees
+	* trans-array.c (gfc_trans_auto_array_allocation): Added code to
+	prevent space from being allocated for pointees.
+	(gfc_conv_array_parameter): Added code to catch pointees and    
+	correctly set their base address.
+	* trans-decl.c (gfc_finish_var_decl): Added code to prevent     
+	pointee declarations from making it to the back end.
+	(gfc_create_module_variable): Same.
+	* trans-expr.c (gfc_conv_variable): added code to detect and
+	translate pointees.
+	(gfc_conv_cray_pointee): New.
+	* trans-intrinsic.c (gfc_conv_intrinsic_loc): New.
+	(gfc_conv_intrinsic_function): added entry point for loc		
+	translation.
+	* trans.h (gfc_conv_cray_pointee): Declare.
+
+	* gfortran.texi: Added section on Cray pointers, removed Cray
+	pointers from list of proposed extensions
+	* intrinsic.texi: Added documentation for loc intrinsic.
+	* invoke.texi: Documented -fcray-pointer flag
+
+2005-10-24  Asher Langton  <langton2@llnl.gov>
+
 	* decl.c (gfc_match_save): Changed duplicate SAVE errors to
 	warnings in the absence of strict standard conformance
 	* symbol.c (gfc_add_save): Same.
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 49a7505be6f..25601f7001d 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -1211,6 +1211,12 @@ gfc_check_link_sub (gfc_expr * path1, gfc_expr * path2, gfc_expr * status)
   return SUCCESS;
 }
 
+try
+gfc_check_loc (gfc_expr *expr)
+{
+  return variable_check (expr, 0);
+}
+
 
 try
 gfc_check_symlnk (gfc_expr * path1, gfc_expr * path2)
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 2ecd143190b..8102fa6b38d 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -912,13 +912,16 @@ variable_decl (int elem)
   char name[GFC_MAX_SYMBOL_LEN + 1];
   gfc_expr *initializer, *char_len;
   gfc_array_spec *as;
+  gfc_array_spec *cp_as; /* Extra copy for Cray Pointees.  */
   gfc_charlen *cl;
   locus var_locus;
   match m;
   try t;
+  gfc_symbol *sym;
 
   initializer = NULL;
   as = NULL;
+  cp_as = NULL;
 
   /* When we get here, we've just matched a list of attributes and
      maybe a type and a double colon.  The next thing we expect to see
@@ -931,7 +934,9 @@ variable_decl (int elem)
 
   /* Now we could see the optional array spec. or character length.  */
   m = gfc_match_array_spec (&as);
-  if (m == MATCH_ERROR)
+  if (gfc_option.flag_cray_pointer && m == MATCH_YES)
+    cp_as = gfc_copy_array_spec (as);
+  else if (m == MATCH_ERROR)
     goto cleanup;
   if (m == MATCH_NO)
     as = gfc_copy_array_spec (current_as);
@@ -972,6 +977,49 @@ variable_decl (int elem)
 	}
     }
 
+  /*  If this symbol has already shown up in a Cray Pointer declaration,
+      then we want to set the type & bail out. */
+  if (gfc_option.flag_cray_pointer)
+    {
+      gfc_find_symbol (name, gfc_current_ns, 1, &sym);
+      if (sym != NULL && sym->attr.cray_pointee)
+	{
+	  sym->ts.type = current_ts.type;
+	  sym->ts.kind = current_ts.kind;
+	  sym->ts.cl = cl;
+	  sym->ts.derived = current_ts.derived;
+	  m = MATCH_YES;
+	
+	  /* Check to see if we have an array specification.  */
+	  if (cp_as != NULL)
+	    {
+	      if (sym->as != NULL)
+		{
+		  gfc_error ("Duplicate array spec for Cray pointee at %C.");
+		  gfc_free_array_spec (cp_as);
+		  m = MATCH_ERROR;
+		  goto cleanup;
+		}
+	      else
+		{
+		  if (gfc_set_array_spec (sym, cp_as, &var_locus) == FAILURE)
+		    gfc_internal_error ("Couldn't set pointee array spec.");
+	      
+		  /* Fix the array spec.  */
+		  m = gfc_mod_pointee_as (sym->as);  
+		  if (m == MATCH_ERROR)
+		    goto cleanup;
+		}
+	    }     
+	  goto cleanup;
+	}
+      else
+	{
+	  gfc_free_array_spec (cp_as);
+	}
+    }
+  
+    
   /* OK, we've successfully matched the declaration.  Now put the
      symbol in the current namespace, because it might be used in the
      optional initialization expression for this symbol, e.g. this is
@@ -2875,6 +2923,14 @@ attr_decl1 (void)
       m = MATCH_ERROR;
       goto cleanup;
     }
+    
+  if (sym->attr.cray_pointee && sym->as != NULL)
+    {
+      /* Fix the array spec.  */
+      m = gfc_mod_pointee_as (sym->as);   	
+      if (m == MATCH_ERROR)
+	goto cleanup;
+    }
 
   if ((current_attr.external || current_attr.intrinsic)
       && sym->attr.flavor != FL_PROCEDURE
@@ -2928,6 +2984,157 @@ attr_decl (void)
 }
 
 
+/* This routine matches Cray Pointer declarations of the form:
+   pointer ( <pointer>, <pointee> )
+   or
+   pointer ( <pointer1>, <pointee1> ), ( <pointer2>, <pointee2> ), ...   
+   The pointer, if already declared, should be an integer.  Otherwise, we 
+   set it as BT_INTEGER with kind gfc_index_integer_kind.  The pointee may
+   be either a scalar, or an array declaration.  No space is allocated for
+   the pointee.  For the statement 
+   pointer (ipt, ar(10))
+   any subsequent uses of ar will be translated (in C-notation) as
+   ar(i) => ((<type> *) ipt)(i)   
+   By the time the code is translated into GENERIC, the pointee will
+   have disappeared from the code entirely. */
+
+static match
+cray_pointer_decl (void)
+{
+  match m;
+  gfc_array_spec *as;
+  gfc_symbol *cptr; /* Pointer symbol.  */
+  gfc_symbol *cpte; /* Pointee symbol.  */
+  locus var_locus;
+  bool done = false;
+
+  while (!done)
+    {
+      if (gfc_match_char ('(') != MATCH_YES)
+	{
+	  gfc_error ("Expected '(' at %C");
+	  return MATCH_ERROR;   
+	}
+ 
+      /* Match pointer.  */
+      var_locus = gfc_current_locus;
+      gfc_clear_attr (&current_attr);
+      gfc_add_cray_pointer (&current_attr, &var_locus);
+      current_ts.type = BT_INTEGER;
+      current_ts.kind = gfc_index_integer_kind;
+
+      m = gfc_match_symbol (&cptr, 0);  
+      if (m != MATCH_YES)
+	{
+	  gfc_error ("Expected variable name at %C");
+	  return m;
+	}
+  
+      if (gfc_add_cray_pointer (&cptr->attr, &var_locus) == FAILURE)
+	return MATCH_ERROR;
+
+      gfc_set_sym_referenced (cptr);      
+
+      if (cptr->ts.type == BT_UNKNOWN) /* Override the type, if necessary.  */
+	{
+	  cptr->ts.type = BT_INTEGER;
+	  cptr->ts.kind = gfc_index_integer_kind; 
+	}
+      else if (cptr->ts.type != BT_INTEGER)
+	{
+	  gfc_error ("Cray pointer at %C must be an integer.");
+	  return MATCH_ERROR;
+	}
+      else if (cptr->ts.kind < gfc_index_integer_kind)
+	gfc_warning ("Cray pointer at %C has %d bytes of precision;"
+		     " memory addresses require %d bytes.",
+		     cptr->ts.kind,
+		     gfc_index_integer_kind);
+
+      if (gfc_match_char (',') != MATCH_YES)
+	{
+	  gfc_error ("Expected \",\" at %C");
+	  return MATCH_ERROR;    
+	}
+
+      /* Match Pointee.  */  
+      var_locus = gfc_current_locus;
+      gfc_clear_attr (&current_attr);
+      gfc_add_cray_pointee (&current_attr, &var_locus);
+      current_ts.type = BT_UNKNOWN;
+      current_ts.kind = 0;
+
+      m = gfc_match_symbol (&cpte, 0);
+      if (m != MATCH_YES)
+	{
+	  gfc_error ("Expected variable name at %C");
+	  return m;
+	}
+       
+      /* Check for an optional array spec.  */
+      m = gfc_match_array_spec (&as);
+      if (m == MATCH_ERROR)
+	{
+	  gfc_free_array_spec (as);
+	  return m;
+	}
+      else if (m == MATCH_NO)
+	{
+	  gfc_free_array_spec (as);
+	  as = NULL;
+	}   
+
+      if (gfc_add_cray_pointee (&cpte->attr, &var_locus) == FAILURE)
+	return MATCH_ERROR;
+
+      gfc_set_sym_referenced (cpte);
+
+      if (cpte->as == NULL)
+	{
+	  if (gfc_set_array_spec (cpte, as, &var_locus) == FAILURE)
+	    gfc_internal_error ("Couldn't set Cray pointee array spec.");
+	}
+      else if (as != NULL)
+	{
+	  gfc_error ("Duplicate array spec for Cray pointee at %C.");
+	  gfc_free_array_spec (as);
+	  return MATCH_ERROR;
+	}
+      
+      as = NULL;
+    
+      if (cpte->as != NULL)
+	{
+	  /* Fix array spec.  */
+	  m = gfc_mod_pointee_as (cpte->as);
+	  if (m == MATCH_ERROR)
+	    return m;
+	} 
+   
+      /* Point the Pointee at the Pointer.  */
+      cpte->cp_pointer=cptr;
+
+      if (gfc_match_char (')') != MATCH_YES)
+	{
+	  gfc_error ("Expected \")\" at %C");
+	  return MATCH_ERROR;    
+	}
+      m = gfc_match_char (',');
+      if (m != MATCH_YES)
+	done = true; /* Stop searching for more declarations.  */
+
+    }
+  
+  if (m == MATCH_ERROR /* Failed when trying to find ',' above.  */
+      || gfc_match_eos () != MATCH_YES)
+    {
+      gfc_error ("Expected \",\" or end of statement at %C");
+      return MATCH_ERROR;
+    }
+  return MATCH_YES;
+}
+
+
 match
 gfc_match_external (void)
 {
@@ -2981,11 +3188,24 @@ gfc_match_optional (void)
 match
 gfc_match_pointer (void)
 {
-
-  gfc_clear_attr (&current_attr);
-  gfc_add_pointer (&current_attr, NULL);
-
-  return attr_decl ();
+  gfc_gobble_whitespace ();
+  if (gfc_peek_char () == '(')
+    {
+      if (!gfc_option.flag_cray_pointer)
+	{
+	  gfc_error ("Cray pointer declaration at %C requires -fcray-pointer"
+		     " flag.");
+	  return MATCH_ERROR;
+	}
+      return cray_pointer_decl ();
+    }
+  else
+    {
+      gfc_clear_attr (&current_attr);
+      gfc_add_pointer (&current_attr, NULL);
+    
+      return attr_decl ();
+    }
 }
 
 
@@ -3493,3 +3713,29 @@ loop:
 
   return MATCH_YES;
 }
+
+
+/* Cray Pointees can be declared as: 
+      pointer (ipt, a (n,m,...,*)) 
+   By default, this is treated as an AS_ASSUMED_SIZE array.  We'll
+   cheat and set a constant bound of 1 for the last dimension, if this
+   is the case. Since there is no bounds-checking for Cray Pointees,
+   this will be okay.  */
+
+try
+gfc_mod_pointee_as (gfc_array_spec *as)
+{
+  as->cray_pointee = true; /* This will be useful to know later.  */
+  if (as->type == AS_ASSUMED_SIZE)
+    {
+      as->type = AS_EXPLICIT;
+      as->upper[as->rank - 1] = gfc_int_expr (1);
+      as->cp_was_assumed = true;
+    }
+  else if (as->type == AS_ASSUMED_SHAPE)
+    {
+      gfc_error ("Cray Pointee at %C cannot be assumed shape array");
+      return MATCH_ERROR;
+    }
+  return MATCH_YES;
+}
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index ebfd8486a13..80099df5ad4 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -1841,6 +1841,16 @@ gfc_check_assign (gfc_expr * lvalue, gfc_expr * rvalue, int conform)
        return FAILURE;
      }
 
+   if (sym->attr.cray_pointee
+       && lvalue->ref != NULL
+       && lvalue->ref->u.ar.type != AR_ELEMENT
+       && lvalue->ref->u.ar.as->cp_was_assumed)
+     {
+       gfc_error ("Vector assignment to assumed-size Cray Pointee at %L"
+		  " is illegal.", &lvalue->where);
+       return FAILURE;
+     }
+
   /* This is possibly a typo: x = f() instead of x => f()  */
   if (gfc_option.warn_surprising 
       && rvalue->expr_type == EXPR_FUNCTION
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 894761367be..56d008c9797 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -360,6 +360,7 @@ enum gfc_generic_isym_id
   GFC_ISYM_LLE,
   GFC_ISYM_LLT,
   GFC_ISYM_LOG,
+  GFC_ISYM_LOC,
   GFC_ISYM_LOG10,
   GFC_ISYM_LOGICAL,
   GFC_ISYM_MATMUL,
@@ -476,6 +477,9 @@ typedef struct
   ENUM_BITFIELD (ifsrc) if_source:2;
 
   ENUM_BITFIELD (procedure_type) proc:3;
+  
+  /* Special attributes for Cray pointers, pointees.  */
+  unsigned cray_pointer:1, cray_pointee:1;    
 
 }
 symbol_attribute;
@@ -573,6 +577,13 @@ typedef struct
   int rank;	/* A rank of zero means that a variable is a scalar.  */
   array_type type;
   struct gfc_expr *lower[GFC_MAX_DIMENSIONS], *upper[GFC_MAX_DIMENSIONS];
+
+  /* These two fields are used with the Cray Pointer extension.  */
+  bool cray_pointee; /* True iff this spec belongs to a cray pointee.  */
+  bool cp_was_assumed; /* AS_ASSUMED_SIZE cp arrays are converted to
+			AS_EXPLICIT, but we want to remember that we
+			did this.  */
+
 }
 gfc_array_spec;
 
@@ -717,6 +728,9 @@ typedef struct gfc_symbol
   struct gfc_symbol *result;	/* function result symbol */
   gfc_component *components;	/* Derived type components */
 
+  /* Defined only for Cray pointees; points to their pointer.  */
+  struct gfc_symbol *cp_pointer;
+
   struct gfc_symbol *common_next;	/* Links for COMMON syms */
 
   /* This is in fact a gfc_common_head but it is only used for pointer
@@ -1458,6 +1472,7 @@ typedef struct
   int flag_f2c;
   int flag_automatic;
   int flag_backslash;
+  int flag_cray_pointer;
   int flag_d_lines;
 
   int q_kind;
@@ -1642,6 +1657,9 @@ try gfc_add_external (symbol_attribute *, locus *);
 try gfc_add_intrinsic (symbol_attribute *, locus *);
 try gfc_add_optional (symbol_attribute *, locus *);
 try gfc_add_pointer (symbol_attribute *, locus *);
+try gfc_add_cray_pointer (symbol_attribute *, locus *);
+try gfc_add_cray_pointee (symbol_attribute *, locus *);
+try gfc_mod_pointee_as (gfc_array_spec *as);
 try gfc_add_result (symbol_attribute *, const char *, locus *);
 try gfc_add_save (symbol_attribute *, const char *, locus *);
 try gfc_add_saved_common (symbol_attribute *, locus *);
diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi
index a4ecee3d9a0..b4e672eea50 100644
--- a/gcc/fortran/gfortran.texi
+++ b/gcc/fortran/gfortran.texi
@@ -491,9 +491,6 @@ Flag to generate @code{Makefile} info.
 Automatically extend single precision constants to double.
 
 @item
-Cray pointers (this was high on the @command{g77} wishlist).
-
-@item
 Compile code that conserves memory by dynamically allocating common and
 module storage either on stack or heap.
 
@@ -633,6 +630,7 @@ of extensions, and @option{-std=legacy} allows both without warning.
 * Unary operators::
 * Implicitly interconvert LOGICAL and INTEGER::
 * Hollerith constants support::
+* Cray pointers::
 @end menu
 
 @node Old-style kind specifications
@@ -843,6 +841,143 @@ a = 8H12345678 ! The Hollerith constant is too long. It will be truncated.
 a = 0H         ! At least one character needed.
 @end smallexample
 
+@node Cray pointers
+@section Cray pointers
+@cindex Cray pointers
+
+Cray pointers are part of a non-standard extension that provides a
+C-like pointer in Fortran.  This is accomplished through a pair of
+variables: an integer "pointer" that holds a memory address, and a
+"pointee" that is used to dereference the pointer.
+
+Pointer/pointee pairs are declared in statements of the form:
+@smallexample
+        pointer ( <pointer> , <pointee> )
+@end smallexample
+or,
+@smallexample
+        pointer ( <pointer1> , <pointee1> ), ( <pointer2> , <pointee2> ), ...
+@end smallexample
+The pointer is an integer that is intended to hold a memory address.
+The pointee may be an array or scalar.  A pointee can be an assumed
+size array -- that is, the last dimension may be left unspecified by
+using a '*' in place of a value -- but a pointee cannot be an assumed
+shape array.  No space is allocated for the pointee.
+
+The pointee may have its type declared before or after the pointer
+statement, and its array specification (if any) may be declared
+before, during, or after the pointer statement.  The pointer may be
+declared as an integer prior to the pointer statement.  However, some
+machines have default integer sizes that are different than the size
+of a pointer, and so the following code is not portable:
+@smallexample
+        integer ipt
+        pointer (ipt, iarr)
+@end smallexample
+If a pointer is declared with a kind that is too small, the compiler
+will issue a warning; the resulting binary will probably not work
+correctly, because the memory addresses stored in the pointers may be
+truncated.  It is safer to omit the first line of the above example;
+if explicit declaration of ipt's type is omitted, then the compiler
+will ensure that ipt is an integer variable large enough to hold a
+pointer.
+
+Pointer arithmetic is valid with Cray pointers, but it is not the same
+as C pointer arithmetic.  Cray pointers are just ordinary integers, so
+the user is responsible for determining how many bytes to add to a
+pointer in order to increment it.  Consider the following example:
+@smallexample
+        real target(10)
+        real pointee(10)
+        pointer (ipt, pointee)
+        ipt = loc (target)
+        ipt = ipt + 1       
+@end smallexample
+The last statement does not set ipt to the address of
+@code{target(1)}, as one familiar with C pointer arithmetic might
+expect.  Adding 1 to ipt just adds one byte to the address stored in
+ipt.
+
+Any expression involving the pointee will be translated to use the
+value stored in the pointer as the base address.  This translation is
+done in the front end, and so the pointees are not present in the
+GENERIC tree that is handed off to the backend.  One disadvantage of
+this is that pointees will not appear in gdb when debugging a Fortran
+program that uses Cray pointers.
+
+To get the address of elements, this extension provides an intrinsic
+function loc(), loc() is essentially the C '&' operator, except the
+address is cast to an integer type:
+@smallexample
+        real ar(10)
+        pointer(ipt, arpte(10))
+        real arpte
+        ipt = loc(ar)  ! Makes arpte is an alias for ar
+        arpte(1) = 1.0 ! Sets ar(1) to 1.0
+@end smallexample
+The pointer can also be set by a call to a malloc-type
+function.  There is no malloc intrinsic implemented as part of the
+Cray pointer extension, but it might be a useful future addition to
+@command{gfortran}.  Even without an intrinsic malloc function,
+dynamic memory allocation can be combined with Cray pointers by
+calling a short C function:
+@smallexample
+mymalloc.c:
+
+        void mymalloc_(void **ptr, int *nbytes)
+        @{
+            *ptr = malloc(*nbytes);
+            return;
+        @}
+
+caller.f:
+
+        program caller
+        integer ipinfo;
+        real*4 data
+        pointer (ipdata, data(1024))
+        call mymalloc(ipdata,4*1024)
+        end
+@end smallexample
+Cray pointees often are used to alias an existing variable.  For
+example:
+@smallexample
+        integer target(10)
+        integer iarr(10)
+        pointer (ipt, iarr)
+        ipt = loc(target)
+@end smallexample
+As long as ipt remains unchanged, iarr is now an alias for target.
+The optimizer, however, will not detect this aliasing, so it is unsafe
+to use iarr and target simultaneously.  Using a pointee in any way
+that violates the Fortran aliasing rules or assumptions is illegal.
+It is the user's responsibility to avoid doing this; the compiler
+works under the assumption that no such aliasing occurs.
+
+Cray pointers will work correctly when there is no aliasing (i.e.,
+when they're used to access a dynamically allocated block of memory),
+and also in any routine where a pointee is used, but any variable with
+which it shares storage is not used.  Code that violates these rules
+may not run as the user intends.  This is not a bug in the optimizer;
+any code that violates the aliasing rules is illegal.  (Note that this
+is not unique to gfortran; any Fortran compiler that supports Cray
+pointers will ``incorrectly'' optimize code with illegal aliasing.)
+
+There are a number of restrictions on the attributes that can be
+applied to Cray pointers and pointees.  Pointees may not have the
+attributes ALLOCATABLE, INTENT, OPTIONAL, DUMMY, TARGET, EXTERNAL,
+INTRINSIC, or POINTER.  Pointers may not have the attributes
+DIMENSION, POINTER, TARGET, ALLOCATABLE, EXTERNAL, or INTRINSIC.
+Pointees may not occur in more than one pointer statement.  A pointee
+cannot be a pointer.  Pointees cannot occur in equivalence, common, or
+data statements.
+
+A pointer may be modified during the course of a program, and this
+will change the location to which the pointee refers.  However, when
+pointees are passed as arguments, they are treated as ordinary
+variables in the invoked function.  Subsequent changes to the pointer
+will not change the base address of the array that was passed.
+
 @include intrinsic.texi
 @c ---------------------------------------------------------------------
 @c Contributing
diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index be23556b39e..93dde153d10 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -2098,6 +2098,13 @@ add_functions (void)
 	     bck, BT_LOGICAL, dl, OPTIONAL);
 
   make_generic ("verify", GFC_ISYM_VERIFY, GFC_STD_F95);
+    
+  add_sym_1 ("loc", 0, 1, BT_INTEGER, ii, GFC_STD_GNU,
+	    gfc_check_loc, NULL, gfc_resolve_loc,
+	    ar, BT_UNKNOWN, 0, REQUIRED);
+		
+  make_generic ("loc", GFC_ISYM_LOC, GFC_STD_GNU);
+
 }
 
 
diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h
index c405ccedba2..950ac7dfbeb 100644
--- a/gcc/fortran/intrinsic.h
+++ b/gcc/fortran/intrinsic.h
@@ -77,6 +77,7 @@ try gfc_check_kill (gfc_expr *, gfc_expr *);
 try gfc_check_kind (gfc_expr *);
 try gfc_check_lbound (gfc_expr *, gfc_expr *);
 try gfc_check_link (gfc_expr *, gfc_expr *);
+try gfc_check_loc (gfc_expr *);
 try gfc_check_logical (gfc_expr *, gfc_expr *);
 try gfc_check_min_max (gfc_actual_arglist *);
 try gfc_check_min_max_integer (gfc_actual_arglist *);
@@ -327,6 +328,7 @@ void gfc_resolve_lbound (gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_len (gfc_expr *, gfc_expr *);
 void gfc_resolve_len_trim (gfc_expr *, gfc_expr *);
 void gfc_resolve_link (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_loc (gfc_expr *, gfc_expr *);
 void gfc_resolve_log (gfc_expr *, gfc_expr *);
 void gfc_resolve_log10 (gfc_expr *, gfc_expr *);
 void gfc_resolve_logical (gfc_expr *, gfc_expr *, gfc_expr *);
diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi
index 2043c282e8e..5db2472590c 100644
--- a/gcc/fortran/intrinsic.texi
+++ b/gcc/fortran/intrinsic.texi
@@ -87,6 +87,7 @@ and editing.  All contributions and corrections are strongly encouraged.
 * @code{EXPONENT}:      EXPONENT,  Exponent function
 * @code{FLOOR}:         FLOOR,     Integer floor function
 * @code{FNUM}:          FNUM,      File number function
+* @code{LOC}:           LOC,       Returns the address of a variable
 * @code{LOG}:           LOG,       Logarithm function
 * @code{LOG10}:         LOG10,     Base 10 logarithm function 
 * @code{REAL}:          REAL,      Convert to real type 
@@ -2724,7 +2725,43 @@ end program test_fnum
 @end smallexample
 @end table
 
+@node LOC
+@section @code{LOC} --- Returns the address of a variable
+@findex @code{LOC} intrinsic
+@cindex loc
 
+@table @asis
+@item @emph{Description}:
+@code{LOC(X)} returns the address of @var{X} as an integer.
+
+@item @emph{Option}:
+gnu
+
+@item @emph{Class}:
+inquiry function
+
+@item @emph{Syntax}:
+@code{I = LOC(X)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .80
+@item @var{X} @tab Variable of any type.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{INTEGER(n)}, where @code{n} is the
+size (in bytes) of a memory address on the target machine.
+
+@item @emph{Example}:
+@smallexample
+program test_loc
+  integer :: i
+  real :: r
+  i = loc(r)
+  print *, i
+end program test_loc
+@end smallexample
+@end table
 
 @node LOG
 @section @code{LOG} --- Logarithm function
diff --git a/gcc/fortran/invoke.texi b/gcc/fortran/invoke.texi
index 88e8eefe969..db53302d0a3 100644
--- a/gcc/fortran/invoke.texi
+++ b/gcc/fortran/invoke.texi
@@ -119,7 +119,8 @@ by type.  Explanations are in the following sections.
 -fdollar-ok  -fimplicit-none  -fmax-identifier-length @gol
 -std=@var{std} -fd-lines-as-code -fd-lines-as-comments @gol
 -ffixed-line-length-@var{n}  -ffixed-line-length-none @gol
--fdefault-double-8  -fdefault-integer-8  -fdefault-real-8 }
+-fdefault-double-8  -fdefault-integer-8  -fdefault-real-8 @gol
+-fcray-pointer }
 
 @item Warning Options
 @xref{Warning Options,,Options to Request or Suppress Warnings}.
@@ -265,6 +266,11 @@ Specify that no implicit typing is allowed, unless overridden by explicit
 @samp{IMPLICIT} statements.  This is the equivalent of adding
 @samp{implicit none} to the start of every procedure.
 
+@cindex -fcray-pointer option
+@cindex options, -fcray-pointer
+@item -fcray-pointer
+Enables the Cray pointer extension, which provides a C-like pointer.
+
 @cindex -std=@var{std} option
 @cindex option, -std=@var{std}
 @item -std=@var{std}
diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index 9cba18bd1ef..09d85e33974 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -871,6 +871,15 @@ gfc_resolve_link (gfc_expr * f, gfc_expr * p1 ATTRIBUTE_UNUSED,
 
 
 void
+gfc_resolve_loc (gfc_expr *f, gfc_expr *x)
+{
+  f->ts.type= BT_INTEGER;
+  f->ts.kind = gfc_index_integer_kind;
+  f->value.function.name = gfc_get_string ("__loc_%d", x->ts.kind);
+}
+
+
+void
 gfc_resolve_log (gfc_expr * f, gfc_expr * x)
 {
   f->ts = x->ts;
diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
index 053cc3dbf70..b44c38b34a1 100644
--- a/gcc/fortran/lang.opt
+++ b/gcc/fortran/lang.opt
@@ -121,6 +121,10 @@ funderscoring
 Fortran
 Append underscores to externally visible names
 
+fcray-pointer
+Fortran
+Use the Cray Pointer extension
+
 fsecond-underscore
 Fortran
 Append a second underscore if the name already contains an underscore
diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c
index 95720bf5105..53e8ec7b419 100644
--- a/gcc/fortran/options.c
+++ b/gcc/fortran/options.c
@@ -72,6 +72,7 @@ gfc_init_options (unsigned int argc ATTRIBUTE_UNUSED,
   gfc_option.flag_repack_arrays = 0;
   gfc_option.flag_automatic = 1;
   gfc_option.flag_backslash = 1;
+  gfc_option.flag_cray_pointer = 0;
   gfc_option.flag_d_lines = -1;
 
   gfc_option.q_kind = gfc_default_double_kind;
@@ -364,6 +365,10 @@ gfc_handle_option (size_t scode, const char *arg, int value)
     case OPT_Wunused_labels:
       gfc_option.warn_unused_labels = value;
       break;
+      
+    case OPT_fcray_pointer:
+      gfc_option.flag_cray_pointer = value;
+      break;
 
     case OPT_ff2c:
       gfc_option.flag_f2c = value;
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 26f11c50583..8ae1162b6ae 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -2013,7 +2013,7 @@ resolve_array_ref (gfc_array_ref * ar)
 	  }
     }
 
-  if (compare_spec_to_ref (ar) == FAILURE)
+  if (!ar->as->cray_pointee && compare_spec_to_ref (ar) == FAILURE)
     return FAILURE;
 
   return SUCCESS;
@@ -5176,6 +5176,14 @@ resolve_equivalence (gfc_equiv *eq)
 		     sym->name, &e->where, sym->ns->proc_name->name);
           break;
         }
+ 
+     /* Shall not be a Cray pointee.  */
+      if (sym->attr.cray_pointee)
+        {
+          gfc_error ("Cray Pointee '%s' at %L cannot be an EQUIVALENCE "
+		     "object", sym->name, &e->where);
+          continue;
+        }
 
       /* Shall not be a named constant.  */      
       if (e->expr_type == EXPR_CONSTANT)
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index c1221eb72a5..b9e76ef195c 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -263,7 +263,8 @@ check_conflict (symbol_attribute * attr, const char * name, locus * where)
     *public = "PUBLIC", *optional = "OPTIONAL", *entry = "ENTRY",
     *function = "FUNCTION", *subroutine = "SUBROUTINE",
     *dimension = "DIMENSION", *in_equivalence = "EQUIVALENCE",
-    *use_assoc = "USE ASSOCIATED";
+    *use_assoc = "USE ASSOCIATED", *cray_pointer = "CRAY POINTER",
+    *cray_pointee = "CRAY POINTEE";
 
   const char *a1, *a2;
 
@@ -343,6 +344,31 @@ check_conflict (symbol_attribute * attr, const char * name, locus * where)
 
   conf (function, subroutine);
 
+  /* Cray pointer/pointee conflicts.  */
+  conf (cray_pointer, cray_pointee);
+  conf (cray_pointer, dimension);
+  conf (cray_pointer, pointer);
+  conf (cray_pointer, target);
+  conf (cray_pointer, allocatable);
+  conf (cray_pointer, external);
+  conf (cray_pointer, intrinsic);
+  conf (cray_pointer, in_namelist);
+  conf (cray_pointer, function);
+  conf (cray_pointer, subroutine);
+  conf (cray_pointer, entry);
+
+  conf (cray_pointee, allocatable);
+  conf (cray_pointee, intent);
+  conf (cray_pointee, optional);
+  conf (cray_pointee, dummy);
+  conf (cray_pointee, target);
+  conf (cray_pointee, external);
+  conf (cray_pointee, intrinsic);
+  conf (cray_pointee, pointer);
+  conf (cray_pointee, function);
+  conf (cray_pointee, subroutine);
+  conf (cray_pointee, entry);
+
   a1 = gfc_code2string (flavors, attr->flavor);
 
   if (attr->in_namelist
@@ -653,6 +679,37 @@ gfc_add_pointer (symbol_attribute * attr, locus * where)
 
 
 try
+gfc_add_cray_pointer (symbol_attribute * attr, locus * where)
+{
+
+  if (check_used (attr, NULL, where) || check_done (attr, where))
+    return FAILURE;
+
+  attr->cray_pointer = 1;
+  return check_conflict (attr, NULL, where);
+}
+
+
+try
+gfc_add_cray_pointee (symbol_attribute * attr, locus * where)
+{
+
+  if (check_used (attr, NULL, where) || check_done (attr, where))
+    return FAILURE;
+
+  if (attr->cray_pointee)
+    {
+      gfc_error ("Cray Pointee at %L appears in multiple pointer()"
+		 " statements.", where);
+      return FAILURE;
+    }
+
+  attr->cray_pointee = 1;
+  return check_conflict (attr, NULL, where);
+}
+
+
+try
 gfc_add_result (symbol_attribute * attr, const char *name, locus * where)
 {
 
@@ -1149,6 +1206,11 @@ gfc_copy_attr (symbol_attribute * dest, symbol_attribute * src, locus * where)
   if (gfc_missing_attr (dest, where) == FAILURE)
     goto fail;
 
+  if (src->cray_pointer && gfc_add_cray_pointer (dest, where) == FAILURE)
+    goto fail;
+  if (src->cray_pointee && gfc_add_cray_pointee (dest, where) == FAILURE)
+    goto fail;    
+  
   /* The subroutines that set these bits also cause flavors to be set,
      and that has already happened in the original, so don't let it
      happen again.  */
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index c284dca5465..1a09121f87c 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -3240,6 +3240,15 @@ gfc_trans_auto_array_allocation (tree decl, gfc_symbol * sym, tree fnbody)
 
   size = gfc_trans_array_bounds (type, sym, &offset, &block);
 
+  /* Don't actually allocate space for Cray Pointees.  */
+  if (sym->attr.cray_pointee)
+    {
+      if (TREE_CODE (GFC_TYPE_ARRAY_OFFSET (type)) == VAR_DECL)
+	gfc_add_modify_expr (&block, GFC_TYPE_ARRAY_OFFSET (type), offset);
+      gfc_add_expr_to_block (&block, fnbody);
+      return gfc_finish_block (&block);
+    }
+
   /* The size is the number of elements in the array, so multiply by the
      size of an element to get the total size.  */
   tmp = TYPE_SIZE_UNIT (gfc_get_element_type (type));
@@ -4074,7 +4083,13 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, int g77)
        && expr->ref->u.ar.type == AR_FULL && g77)
     {
       sym = expr->symtree->n.sym;
-      tmp = gfc_get_symbol_decl (sym);
+
+      /* Check to see if we're dealing with a Cray Pointee.  */
+      if (sym->attr.cray_pointee)
+	tmp = gfc_conv_cray_pointee (sym);
+      else
+	tmp = gfc_get_symbol_decl (sym);
+      
       if (sym->ts.type == BT_CHARACTER)
 	se->string_length = sym->ts.cl->backend_decl;
       if (!sym->attr.pointer && sym->as->type != AS_ASSUMED_SHAPE 
@@ -4625,4 +4640,3 @@ gfc_walk_expr (gfc_expr * expr)
   res = gfc_walk_subexpr (gfc_ss_terminator, expr);
   return gfc_reverse_ss (res);
 }
-
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 70e8e82856a..4b6e2265828 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -416,6 +416,11 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym)
      This is the equivalent of the TARGET variables.
      We also need to set this if the variable is passed by reference in a
      CALL statement.  */
+
+  /* We don't want real declarations for Cray Pointees.  */
+  if (sym->attr.cray_pointee)
+    return;
+
   if (sym->attr.target)
     TREE_ADDRESSABLE (decl) = 1;
   /* If it wasn't used we wouldn't be getting it.  */
@@ -2251,6 +2256,10 @@ gfc_create_module_variable (gfc_symbol * sym)
   /* Create the decl.  */
   decl = gfc_get_symbol_decl (sym);
 
+  /* Don't create a "real" declaration for a Cray Pointee.  */
+  if (sym->attr.cray_pointee)
+    return;
+
   /* Create the variable.  */
   pushdecl (decl);
   rest_of_decl_compilation (decl, 1, 0);
@@ -2672,4 +2681,36 @@ gfc_generate_block_data (gfc_namespace * ns)
   rest_of_decl_compilation (decl, 1, 0);
 }
 
+/* gfc_conv_cray_pointee takes a sym with attribute cray_pointee and
+   swaps in the backend_decl of its corresponding pointer.  There are
+   2 cases; one for variable size arrays, and one for everything else,
+   because variable-sized arrays require one fewer level of
+   indirection.  */
+
+tree
+gfc_conv_cray_pointee(gfc_symbol *sym)
+{
+  tree decl = gfc_get_symbol_decl (sym->cp_pointer);
+
+  /* Parameters need to be dereferenced.  */
+  if (sym->cp_pointer->attr.dummy) 
+    decl = gfc_build_indirect_ref (decl);
+
+  /* Check to see if we're dealing with a variable-sized array.  */
+  if (sym->attr.dimension
+      && TREE_CODE (TREE_TYPE (sym->backend_decl)) == POINTER_TYPE) 
+    {  
+      /* These decls will be derefenced later, so we don't dereference
+	 them here.  */
+      decl = convert (TREE_TYPE (sym->backend_decl), decl);
+    }
+  else
+    {
+      decl = convert (build_pointer_type (TREE_TYPE (sym->backend_decl)),
+		      decl);
+      decl = gfc_build_indirect_ref (decl);
+    }
+  return decl;
+}
+
 #include "gt-fortran-trans-decl.h"
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index fe5e24bdb07..4dc4d56b356 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -316,7 +316,11 @@ gfc_conv_variable (gfc_se * se, gfc_expr * expr)
     {
       tree se_expr = NULL_TREE;
 
-      se->expr = gfc_get_symbol_decl (sym);
+      /* Handle Cray Pointees.  */
+      if (sym->attr.cray_pointee)
+	se->expr = gfc_conv_cray_pointee (sym);
+      else
+	se->expr = gfc_get_symbol_decl (sym);
 
       /* Special case for assigning the return value of a function.
 	 Self recursive functions must have an explicit return value.  */
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 1d958e18ad7..4905ac57381 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -2739,6 +2739,36 @@ gfc_conv_intrinsic_iargc (gfc_se * se, gfc_expr * expr)
   se->expr = tmp;
 }
 
+
+/* The loc intrinsic returns the address of its argument as
+   gfc_index_integer_kind integer.  */
+
+static void
+gfc_conv_intrinsic_loc(gfc_se * se, gfc_expr * expr)
+{
+  tree temp_var;
+  gfc_expr *arg_expr;
+  gfc_ss *ss;
+
+  gcc_assert (!se->ss);
+
+  arg_expr = expr->value.function.actual->expr;
+  ss = gfc_walk_expr (arg_expr);
+  if (ss == gfc_ss_terminator)
+    gfc_conv_expr_reference (se, arg_expr);
+  else
+    gfc_conv_array_parameter (se, arg_expr, ss, 1); 
+  se->expr= convert (gfc_unsigned_type (long_integer_type_node), 
+		     se->expr);
+   
+  /* Create a temporary variable for loc return value.  Without this, 
+     we get an error an ICE in gcc/expr.c(expand_expr_addr_expr_1).  */
+  temp_var = gfc_create_var (gfc_unsigned_type (long_integer_type_node), 
+			     NULL);
+  gfc_add_modify_expr (&se->pre, temp_var, se->expr);
+  se->expr = temp_var;
+}
+
 /* Generate code for an intrinsic function.  Some map directly to library
    calls, others get special handling.  In some cases the name of the function
    used depends on the type specifiers.  */
@@ -3047,6 +3077,10 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
       gfc_conv_intrinsic_bound (se, expr, 1);
       break;
 
+    case GFC_ISYM_LOC:
+      gfc_conv_intrinsic_loc (se, expr);
+      break;
+
     case GFC_ISYM_CHDIR:
     case GFC_ISYM_DOT_PRODUCT:
     case GFC_ISYM_ETIME:
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 16d0a37ed3f..16dd51747b9 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -406,6 +406,9 @@ void gfc_generate_block_data (gfc_namespace *);
 /* Output a decl for a module variable.  */
 void gfc_generate_module_vars (gfc_namespace *);
 
+/* Translate the declaration for a Cray Pointee.  */
+tree gfc_conv_cray_pointee (gfc_symbol *sym);
+
 /* Get and set the current location.  */
 void gfc_set_backend_locus (locus *);
 void gfc_get_backend_locus (locus *);
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index f952b56f510..fa6e53c018c 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,13 @@
+2005-10-24  Asher Langton  <langton2@llnl.gov>
+
+	PR fortran/17031
+	PR fortran/22282
+	* gfortran.dg/cray_pointers_1.f90: New test.
+	* gfortran.dg/cray_pointers_2.f90: New test.
+	* gfortran.dg/cray_pointers_3.f90: New test.
+	* gfortran.dg/loc_1.f90: New test.
+	* gfortran.dg/loc_2.f90: New test.
+
 2005-10-24  Steven Bosscher  <stevenb@suse.de>
 
 	* gcc.dg/pr24225.c: New test.
diff --git a/gcc/testsuite/gfortran.dg/cray_pointers_1.f90 b/gcc/testsuite/gfortran.dg/cray_pointers_1.f90
new file mode 100644
index 00000000000..b23a300feac
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/cray_pointers_1.f90
@@ -0,0 +1,68 @@
+! { dg-do compile }
+! { dg-options "-fcray-pointer" }
+
+! Bad type for pointer
+subroutine err1
+  real ipt
+  real array(10)
+  pointer (ipt, array) ! { dg-error "integer" }
+end subroutine err1
+
+! Multiple declarations for the same pointee
+subroutine err2
+  real array(10)
+  pointer (ipt1, array)
+  pointer (ipt2, array) ! { dg-error "multiple" }
+end subroutine err2
+
+! Vector assignment to an assumed size array
+subroutine err3
+  real target(10)
+  real array(*)
+  pointer (ipt, array)
+  ipt = loc (target)
+  array = 0    ! { dg-error "Vector assignment" }
+end subroutine err3
+
+subroutine err4
+  pointer (ipt, ipt) ! { dg-error "POINTER attribute" }
+end subroutine err4
+
+! duplicate array specs
+subroutine err5
+  pointer (ipt, array(7))
+  real array(10)      ! { dg-error "Duplicate array" }  
+end subroutine err5
+
+subroutine err6
+  real array(10)
+  pointer (ipt, array(7))  ! { dg-error "Duplicate array" }
+end subroutine err6
+
+! parsing stuff
+subroutine err7
+  pointer (                  ! { dg-error "variable name" }
+  pointer (ipt               ! { dg-error "Expected" }
+  pointer (ipt,              ! { dg-error "variable name" }
+  pointer (ipt,a1            ! { dg-error "Expected" }
+  pointer (ipt,a2),          ! { dg-error "Expected" }
+  pointer (ipt,a3),(         ! { dg-error "variable name" }
+  pointer (ipt,a4),(ipt2     ! { dg-error "Expected" }
+  pointer (ipt,a5),(ipt2,    ! { dg-error "variable name" }
+  pointer (ipt,a6),(ipt2,a7  ! { dg-error "Expected" }
+end subroutine err7
+
+! more attributes
+subroutine err8(array)
+  real array(10)
+  integer dim(2)
+  integer, pointer :: f90ptr
+  integer, target :: f90targ
+  pointer (ipt, array)    ! { dg-error "DUMMY" }
+  pointer (dim, elt1)     ! { dg-error "DIMENSION" }
+  pointer (f90ptr, elt2)  ! { dg-error "POINTER" }
+  pointer (ipt, f90ptr)   ! { dg-error "POINTER" }
+  pointer (f90targ, elt3) ! { dg-error "TARGET" }
+  pointer (ipt, f90targ)  ! { dg-error "TARGET" }
+end subroutine err8
+
diff --git a/gcc/testsuite/gfortran.dg/cray_pointers_2.f90 b/gcc/testsuite/gfortran.dg/cray_pointers_2.f90
new file mode 100644
index 00000000000..7c958d57b0a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/cray_pointers_2.f90
@@ -0,0 +1,3606 @@
+! { dg-do run }
+! { dg-options "-fcray-pointer" }
+! Series of routines for testing a Cray pointer implementation
+program craytest
+  common /errors/errors(400)
+  common /foo/foo ! To prevent optimizations
+  integer foo
+  integer i
+  logical errors
+  errors = .false.
+  foo = 0
+  call ptr1
+  call ptr2
+  call ptr3
+  call ptr4
+  call ptr5
+  call ptr6
+  call ptr7
+  call ptr8
+  call ptr9(9,10,11)
+  call ptr10(9,10,11)
+  call ptr11(9,10,11)
+  call ptr12(9,10,11)
+  call ptr13(9,10)
+  call parmtest
+! NOTE: Tests 1 through 12 were removed from this file
+! and placed in loc_1.f90, so we start at 13
+  do i=13,400
+     if (errors(i)) then
+!        print *,"Test",i,"failed."
+        call abort()
+     endif
+  end do
+  if (foo.eq.0) then
+!     print *,"Test did not run correctly."
+     call abort()
+  endif
+end program craytest
+
+! ptr1 through ptr13 that Cray pointees are correctly used with
+! a variety of declaration styles
+subroutine ptr1
+  common /errors/errors(400)
+  logical :: errors, intne, realne, chne, ch8ne
+  integer :: i,j,k
+  integer, parameter :: n = 9
+  integer, parameter :: m = 10
+  integer, parameter :: o = 11
+  integer itarg1 (n)
+  integer itarg2 (m,n)
+  integer itarg3 (o,m,n)
+  real rtarg1(n)
+  real rtarg2(m,n)
+  real rtarg3(o,m,n)
+  character chtarg1(n)
+  character chtarg2(m,n)
+  character chtarg3(o,m,n)
+  character*8 ch8targ1(n)
+  character*8 ch8targ2(m,n)
+  character*8 ch8targ3(o,m,n)
+  type drvd
+     real r1
+     integer i1
+     integer i2(5)
+  end type drvd
+  type(drvd) dtarg1(n)
+  type(drvd) dtarg2(m,n)
+  type(drvd) dtarg3(o,m,n)
+
+  type(drvd) dpte1(n)
+  type(drvd) dpte2(m,n)
+  type(drvd) dpte3(o,m,n)
+  integer ipte1 (n)
+  integer ipte2 (m,n)
+  integer ipte3 (o,m,n)
+  real rpte1(n)
+  real rpte2(m,n)
+  real rpte3(o,m,n)
+  character chpte1(n)
+  character chpte2(m,n)
+  character chpte3(o,m,n)
+  character*8 ch8pte1(n)
+  character*8 ch8pte2(m,n)
+  character*8 ch8pte3(o,m,n)
+
+  pointer(iptr1,dpte1)
+  pointer(iptr2,dpte2)
+  pointer(iptr3,dpte3)
+  pointer(iptr4,ipte1)
+  pointer(iptr5,ipte2)
+  pointer(iptr6,ipte3)
+  pointer(iptr7,rpte1)
+  pointer(iptr8,rpte2)
+  pointer(iptr9,rpte3)
+  pointer(iptr10,chpte1)
+  pointer(iptr11,chpte2)
+  pointer(iptr12,chpte3)
+  pointer(iptr13,ch8pte1)
+  pointer(iptr14,ch8pte2)
+  pointer(iptr15,ch8pte3)
+
+  iptr1 = loc(dtarg1)
+  iptr2 = loc(dtarg2)
+  iptr3 = loc(dtarg3)
+  iptr4 = loc(itarg1)
+  iptr5 = loc(itarg2)
+  iptr6 = loc(itarg3)
+  iptr7 = loc(rtarg1)
+  iptr8 = loc(rtarg2)
+  iptr9 = loc(rtarg3)
+  iptr10= loc(chtarg1)
+  iptr11= loc(chtarg2)
+  iptr12= loc(chtarg3)
+  iptr13= loc(ch8targ1)
+  iptr14= loc(ch8targ2)
+  iptr15= loc(ch8targ3)
+
+
+  do, i=1,n
+     dpte1(i)%i1=i
+     if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
+        ! Error #13
+        errors(13) = .true.
+     endif
+
+     dtarg1(i)%i1=2*dpte1(i)%i1
+     if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
+        ! Error #14
+        errors(14) = .true.
+     endif
+
+     ipte1(i) = i
+     if (intne(ipte1(i), itarg1(i))) then
+        ! Error #15
+        errors(15) = .true.
+     endif
+
+     itarg1(i) = -ipte1(i)
+     if (intne(ipte1(i), itarg1(i))) then
+        ! Error #16
+        errors(16) = .true.
+     endif
+
+     rpte1(i) = i * 5.0
+     if (realne(rpte1(i), rtarg1(i))) then
+        ! Error #17
+        errors(17) = .true.
+     endif
+
+     rtarg1(i) = i * (-5.0)
+     if (realne(rpte1(i), rtarg1(i))) then
+        ! Error #18
+        errors(18) = .true.
+     endif
+
+     chpte1(i) = 'a'
+     if (chne(chpte1(i), chtarg1(i))) then
+        ! Error #19
+        errors(19) = .true.
+     endif
+
+     chtarg1(i) = 'z'
+     if (chne(chpte1(i), chtarg1(i))) then
+        ! Error #20
+        errors(20) = .true.
+     endif
+
+     ch8pte1(i) = 'aaaaaaaa'
+     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
+        ! Error #21
+        errors(21) = .true.
+     endif
+
+     ch8targ1(i) = 'zzzzzzzz'
+     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
+        ! Error #22
+        errors(22) = .true.
+     endif
+
+     do, j=1,m
+        dpte2(j,i)%r1=1.0
+        if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
+           ! Error #23
+           errors(23) = .true.
+        endif
+
+        dtarg2(j,i)%r1=2*dpte2(j,i)%r1
+        if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
+           ! Error #24
+           errors(24) = .true.
+        endif
+
+        ipte2(j,i) = i
+        if (intne(ipte2(j,i), itarg2(j,i))) then
+           ! Error #25
+           errors(25) = .true.
+        endif
+
+        itarg2(j,i) = -ipte2(j,i)
+        if (intne(ipte2(j,i), itarg2(j,i))) then
+           ! Error #26
+           errors(26) = .true.
+        endif
+
+        rpte2(j,i) = i * (-2.0)
+        if (realne(rpte2(j,i), rtarg2(j,i))) then
+           ! Error #27
+           errors(27) = .true.
+        endif
+
+        rtarg2(j,i) = i * (-3.0)
+        if (realne(rpte2(j,i), rtarg2(j,i))) then
+           ! Error #28
+           errors(28) = .true.
+        endif
+
+        chpte2(j,i) = 'a'
+        if (chne(chpte2(j,i), chtarg2(j,i))) then
+           ! Error #29
+           errors(29) = .true.
+        endif
+
+        chtarg2(j,i) = 'z'
+        if (chne(chpte2(j,i), chtarg2(j,i))) then
+           ! Error #30
+           errors(30) = .true.
+        endif
+
+        ch8pte2(j,i) = 'aaaaaaaa'
+        if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
+           ! Error #31
+           errors(31) = .true.
+        endif
+
+        ch8targ2(j,i) = 'zzzzzzzz'
+        if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
+           ! Error #32
+           errors(32) = .true.
+        endif
+        do k=1,o
+           dpte3(k,j,i)%i2(1+mod(i,5))=i
+           if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
+                dtarg3(k,j,i)%i2(1+mod(i,5)))) then
+              ! Error #33
+              errors(33) = .true.
+           endif
+
+           dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5))
+           if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
+                dtarg3(k,j,i)%i2(1+mod(i,5)))) then
+              ! Error #34
+              errors(34) = .true.
+           endif
+
+           ipte3(k,j,i) = i
+           if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
+              ! Error #35
+              errors(35) = .true.
+           endif
+
+           itarg3(k,j,i) = -ipte3(k,j,i)
+           if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
+              ! Error #36
+              errors(36) = .true.
+           endif
+
+           rpte3(k,j,i) = i * 2.0
+           if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
+              ! Error #37
+              errors(37) = .true.
+           endif
+
+           rtarg3(k,j,i) = i * 3.0
+           if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
+              ! Error #38
+              errors(38) = .true.
+           endif
+
+           chpte3(k,j,i) = 'a'
+           if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
+              ! Error #39
+              errors(39) = .true.
+           endif
+
+           chtarg3(k,j,i) = 'z'
+           if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
+              ! Error #40
+              errors(40) = .true.
+           endif
+
+           ch8pte3(k,j,i) = 'aaaaaaaa'
+           if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
+              ! Error #41
+              errors(41) = .true.
+           endif
+
+           ch8targ3(k,j,i) = 'zzzzzzzz'
+           if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
+              ! Error #42
+              errors(42) = .true.
+           endif
+        end do
+     end do
+  end do
+
+  rtarg3 = .5
+  ! Vector syntax
+  do, i=1,n
+     ipte3 = i
+     rpte3 = rpte3+1
+     do, j=1,m
+        do k=1,o
+           if (intne(itarg3(k,j,i), i)) then
+              ! Error #43
+              errors(43) = .true.
+           endif
+
+           if (realne(rtarg3(k,j,i), i+.5)) then
+              ! Error #44
+              errors(44) = .true.
+           endif
+        end do
+     end do
+  end do
+
+end subroutine ptr1
+
+
+subroutine ptr2
+  common /errors/errors(400)
+  logical :: errors, intne, realne, chne, ch8ne
+  integer :: i,j,k
+  integer, parameter :: n = 9
+  integer, parameter :: m = 10
+  integer, parameter :: o = 11
+  integer itarg1 (n)
+  integer itarg2 (m,n)
+  integer itarg3 (o,m,n)
+  real rtarg1(n)
+  real rtarg2(m,n)
+  real rtarg3(o,m,n)
+  character chtarg1(n)
+  character chtarg2(m,n)
+  character chtarg3(o,m,n)
+  character*8 ch8targ1(n)
+  character*8 ch8targ2(m,n)
+  character*8 ch8targ3(o,m,n)
+  type drvd
+     real r1
+     integer i1
+     integer i2(5)
+  end type drvd
+  type(drvd) dtarg1(n)
+  type(drvd) dtarg2(m,n)
+  type(drvd) dtarg3(o,m,n)
+
+  type(drvd) dpte1
+  type(drvd) dpte2
+  type(drvd) dpte3
+  integer ipte1
+  integer ipte2
+  integer ipte3
+  real rpte1
+  real rpte2
+  real rpte3
+  character chpte1
+  character chpte2
+  character chpte3
+  character*8 ch8pte1
+  character*8 ch8pte2
+  character*8 ch8pte3
+
+  pointer(iptr1,dpte1(n))
+  pointer(iptr2,dpte2(m,n))
+  pointer(iptr3,dpte3(o,m,n))
+  pointer(iptr4,ipte1(n))
+  pointer(iptr5,ipte2 (m,n))
+  pointer(iptr6,ipte3(o,m,n))
+  pointer(iptr7,rpte1(n))
+  pointer(iptr8,rpte2(m,n))
+  pointer(iptr9,rpte3(o,m,n))
+  pointer(iptr10,chpte1(n))
+  pointer(iptr11,chpte2(m,n))
+  pointer(iptr12,chpte3(o,m,n))
+  pointer(iptr13,ch8pte1(n))
+  pointer(iptr14,ch8pte2(m,n))
+  pointer(iptr15,ch8pte3(o,m,n))
+
+  iptr1 = loc(dtarg1)
+  iptr2 = loc(dtarg2)
+  iptr3 = loc(dtarg3)
+  iptr4 = loc(itarg1)
+  iptr5 = loc(itarg2)
+  iptr6 = loc(itarg3)
+  iptr7 = loc(rtarg1)
+  iptr8 = loc(rtarg2)
+  iptr9 = loc(rtarg3)
+  iptr10= loc(chtarg1)
+  iptr11= loc(chtarg2)
+  iptr12= loc(chtarg3)
+  iptr13= loc(ch8targ1)
+  iptr14= loc(ch8targ2)
+  iptr15= loc(ch8targ3)
+
+  do, i=1,n
+     dpte1(i)%i1=i
+     if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
+        ! Error #45
+        errors(45) = .true.
+     endif
+
+     dtarg1(i)%i1=2*dpte1(i)%i1
+     if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
+        ! Error #46
+        errors(46) = .true.
+     endif
+
+     ipte1(i) = i
+     if (intne(ipte1(i), itarg1(i))) then
+        ! Error #47
+        errors(47) = .true.
+     endif
+
+     itarg1(i) = -ipte1(i)
+     if (intne(ipte1(i), itarg1(i))) then
+        ! Error #48
+        errors(48) = .true.
+     endif
+
+     rpte1(i) = i * 5.0
+     if (realne(rpte1(i), rtarg1(i))) then
+        ! Error #49
+        errors(49) = .true.
+     endif
+
+     rtarg1(i) = i * (-5.0)
+     if (realne(rpte1(i), rtarg1(i))) then
+        ! Error #50
+        errors(50) = .true.
+     endif
+
+     chpte1(i) = 'a'
+     if (chne(chpte1(i), chtarg1(i))) then
+        ! Error #51
+        errors(51) = .true.
+     endif
+
+     chtarg1(i) = 'z'
+     if (chne(chpte1(i), chtarg1(i))) then
+        ! Error #52
+        errors(52) = .true.
+     endif
+
+     ch8pte1(i) = 'aaaaaaaa'
+     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
+        ! Error #53
+        errors(53) = .true.
+     endif
+
+     ch8targ1(i) = 'zzzzzzzz'
+     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
+        ! Error #54
+        errors(54) = .true.
+     endif
+
+     do, j=1,m
+        dpte2(j,i)%r1=1.0
+        if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
+           ! Error #55
+           errors(55) = .true.
+        endif
+
+        dtarg2(j,i)%r1=2*dpte2(j,i)%r1
+        if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
+           ! Error #56
+           errors(56) = .true.
+        endif
+
+        ipte2(j,i) = i
+        if (intne(ipte2(j,i), itarg2(j,i))) then
+           ! Error #57
+           errors(57) = .true.
+        endif
+
+        itarg2(j,i) = -ipte2(j,i)
+        if (intne(ipte2(j,i), itarg2(j,i))) then
+           ! Error #58
+           errors(58) = .true.
+        endif
+
+        rpte2(j,i) = i * (-2.0)
+        if (realne(rpte2(j,i), rtarg2(j,i))) then
+           ! Error #59
+           errors(59) = .true.
+        endif
+
+        rtarg2(j,i) = i * (-3.0)
+        if (realne(rpte2(j,i), rtarg2(j,i))) then
+           ! Error #60
+           errors(60) = .true.
+        endif
+
+        chpte2(j,i) = 'a'
+        if (chne(chpte2(j,i), chtarg2(j,i))) then
+           ! Error #61
+           errors(61) = .true.
+        endif
+
+        chtarg2(j,i) = 'z'
+        if (chne(chpte2(j,i), chtarg2(j,i))) then
+           ! Error #62
+           errors(62) = .true.
+        endif
+
+        ch8pte2(j,i) = 'aaaaaaaa'
+        if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
+           ! Error #63
+           errors(63) = .true.
+        endif
+
+        ch8targ2(j,i) = 'zzzzzzzz'
+        if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
+           ! Error #64
+           errors(64) = .true.
+        endif
+        do k=1,o
+           dpte3(k,j,i)%i2(1+mod(i,5))=i
+           if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), dtarg3(k,j,i)%i2(1+mod(i,5)))) then
+              ! Error #65
+              errors(65) = .true.
+           endif
+
+           dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5))
+           if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), dtarg3(k,j,i)%i2(1+mod(i,5)))) then
+              ! Error #66
+              errors(66) = .true.
+           endif
+
+           ipte3(k,j,i) = i
+           if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
+              ! Error #67
+              errors(67) = .true.
+           endif
+
+           itarg3(k,j,i) = -ipte3(k,j,i)
+           if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
+              ! Error #68
+              errors(68) = .true.
+           endif
+
+           rpte3(k,j,i) = i * 2.0
+           if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
+              ! Error #69
+              errors(69) = .true.
+           endif
+
+           rtarg3(k,j,i) = i * 3.0
+           if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
+              ! Error #70
+              errors(70) = .true.
+           endif
+
+           chpte3(k,j,i) = 'a'
+           if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
+              ! Error #71
+              errors(71) = .true.
+           endif
+
+           chtarg3(k,j,i) = 'z'
+           if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
+              ! Error #72
+              errors(72) = .true.
+           endif
+
+           ch8pte3(k,j,i) = 'aaaaaaaa'
+           if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
+              ! Error #73
+              errors(73) = .true.
+           endif
+
+           ch8targ3(k,j,i) = 'zzzzzzzz'
+           if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
+              ! Error #74
+              errors(74) = .true.
+           endif
+        end do
+     end do
+  end do
+
+  rtarg3 = .5
+  ! Vector syntax
+  do, i=1,n
+     ipte3 = i
+     rpte3 = rpte3+1
+     do, j=1,m
+        do k=1,o
+           if (intne(itarg3(k,j,i), i)) then
+              ! Error #75
+              errors(75) = .true.
+           endif
+
+           if (realne(rtarg3(k,j,i), i+.5)) then
+              ! Error #76
+              errors(76) = .true.
+           endif
+        end do
+     end do
+  end do
+end subroutine ptr2
+
+subroutine ptr3
+  common /errors/errors(400)
+  logical :: errors, intne, realne, chne, ch8ne
+  integer :: i,j,k
+  integer, parameter :: n = 9
+  integer, parameter :: m = 10
+  integer, parameter :: o = 11
+  integer itarg1 (n)
+  integer itarg2 (m,n)
+  integer itarg3 (o,m,n)
+  real rtarg1(n)
+  real rtarg2(m,n)
+  real rtarg3(o,m,n)
+  character chtarg1(n)
+  character chtarg2(m,n)
+  character chtarg3(o,m,n)
+  character*8 ch8targ1(n)
+  character*8 ch8targ2(m,n)
+  character*8 ch8targ3(o,m,n)
+  type drvd
+     real r1
+     integer i1
+     integer i2(5)
+  end type drvd
+  type(drvd) dtarg1(n)
+  type(drvd) dtarg2(m,n)
+  type(drvd) dtarg3(o,m,n)
+
+  pointer(iptr1,dpte1(n))
+  pointer(iptr2,dpte2(m,n))
+  pointer(iptr3,dpte3(o,m,n))
+  pointer(iptr4,ipte1(n))
+  pointer(iptr5,ipte2 (m,n))
+  pointer(iptr6,ipte3(o,m,n))
+  pointer(iptr7,rpte1(n))
+  pointer(iptr8,rpte2(m,n))
+  pointer(iptr9,rpte3(o,m,n))
+  pointer(iptr10,chpte1(n))
+  pointer(iptr11,chpte2(m,n))
+  pointer(iptr12,chpte3(o,m,n))
+  pointer(iptr13,ch8pte1(n))
+  pointer(iptr14,ch8pte2(m,n))
+  pointer(iptr15,ch8pte3(o,m,n))
+
+  type(drvd) dpte1
+  type(drvd) dpte2
+  type(drvd) dpte3
+  integer ipte1
+  integer ipte2
+  integer ipte3
+  real rpte1
+  real rpte2
+  real rpte3
+  character chpte1
+  character chpte2
+  character chpte3
+  character*8 ch8pte1
+  character*8 ch8pte2
+  character*8 ch8pte3
+
+  iptr1 = loc(dtarg1)
+  iptr2 = loc(dtarg2)
+  iptr3 = loc(dtarg3)
+  iptr4 = loc(itarg1)
+  iptr5 = loc(itarg2)
+  iptr6 = loc(itarg3)
+  iptr7 = loc(rtarg1)
+  iptr8 = loc(rtarg2)
+  iptr9 = loc(rtarg3)
+  iptr10= loc(chtarg1)
+  iptr11= loc(chtarg2)
+  iptr12= loc(chtarg3)
+  iptr13= loc(ch8targ1)
+  iptr14= loc(ch8targ2)
+  iptr15= loc(ch8targ3)
+
+  do, i=1,n
+     dpte1(i)%i1=i
+     if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
+        ! Error #77
+        errors(77) = .true.
+     endif
+
+     dtarg1(i)%i1=2*dpte1(i)%i1
+     if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
+        ! Error #78
+        errors(78) = .true.
+     endif
+
+     ipte1(i) = i
+     if (intne(ipte1(i), itarg1(i))) then
+        ! Error #79
+        errors(79) = .true.
+     endif
+
+     itarg1(i) = -ipte1(i)
+     if (intne(ipte1(i), itarg1(i))) then
+        ! Error #80
+        errors(80) = .true.
+     endif
+
+     rpte1(i) = i * 5.0
+     if (realne(rpte1(i), rtarg1(i))) then
+        ! Error #81
+        errors(81) = .true.
+     endif
+
+     rtarg1(i) = i * (-5.0)
+     if (realne(rpte1(i), rtarg1(i))) then
+        ! Error #82
+        errors(82) = .true.
+     endif
+
+     chpte1(i) = 'a'
+     if (chne(chpte1(i), chtarg1(i))) then
+        ! Error #83
+        errors(83) = .true.
+     endif
+
+     chtarg1(i) = 'z'
+     if (chne(chpte1(i), chtarg1(i))) then
+        ! Error #84
+        errors(84) = .true.
+     endif
+
+     ch8pte1(i) = 'aaaaaaaa'
+     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
+        ! Error #85
+        errors(85) = .true.
+     endif
+
+     ch8targ1(i) = 'zzzzzzzz'
+     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
+        ! Error #86
+        errors(86) = .true.
+     endif
+
+     do, j=1,m
+        dpte2(j,i)%r1=1.0
+        if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
+           ! Error #87
+           errors(87) = .true.
+        endif
+
+        dtarg2(j,i)%r1=2*dpte2(j,i)%r1
+        if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
+           ! Error #88
+           errors(88) = .true.
+        endif
+
+        ipte2(j,i) = i
+        if (intne(ipte2(j,i), itarg2(j,i))) then
+           ! Error #89
+           errors(89) = .true.
+        endif
+
+        itarg2(j,i) = -ipte2(j,i)
+        if (intne(ipte2(j,i), itarg2(j,i))) then
+           ! Error #90
+           errors(90) = .true.
+        endif
+
+        rpte2(j,i) = i * (-2.0)
+        if (realne(rpte2(j,i), rtarg2(j,i))) then
+           ! Error #91
+           errors(91) = .true.
+        endif
+
+        rtarg2(j,i) = i * (-3.0)
+        if (realne(rpte2(j,i), rtarg2(j,i))) then
+           ! Error #92
+           errors(92) = .true.
+        endif
+
+        chpte2(j,i) = 'a'
+        if (chne(chpte2(j,i), chtarg2(j,i))) then
+           ! Error #93
+           errors(93) = .true.
+        endif
+
+        chtarg2(j,i) = 'z'
+        if (chne(chpte2(j,i), chtarg2(j,i))) then
+           ! Error #94
+           errors(94) = .true.
+        endif
+
+        ch8pte2(j,i) = 'aaaaaaaa'
+        if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
+           ! Error #95
+           errors(95) = .true.
+        endif
+
+        ch8targ2(j,i) = 'zzzzzzzz'
+        if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
+           ! Error #96
+           errors(96) = .true.
+        endif
+        do k=1,o
+           dpte3(k,j,i)%i2(1+mod(i,5))=i
+           if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
+                dtarg3(k,j,i)%i2(1+mod(i,5)))) then
+              ! Error #97
+              errors(97) = .true.
+           endif
+
+           dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5))
+           if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
+                dtarg3(k,j,i)%i2(1+mod(i,5)))) then
+              ! Error #98
+              errors(98) = .true.
+           endif
+
+           ipte3(k,j,i) = i
+           if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
+              ! Error #99
+              errors(99) = .true.
+           endif
+
+           itarg3(k,j,i) = -ipte3(k,j,i)
+           if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
+              ! Error #100
+              errors(100) = .true.
+           endif
+
+           rpte3(k,j,i) = i * 2.0
+           if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
+              ! Error #101
+              errors(101) = .true.
+           endif
+
+           rtarg3(k,j,i) = i * 3.0
+           if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
+              ! Error #102
+              errors(102) = .true.
+           endif
+
+           chpte3(k,j,i) = 'a'
+           if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
+              ! Error #103
+              errors(103) = .true.
+           endif
+
+           chtarg3(k,j,i) = 'z'
+           if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
+              ! Error #104
+              errors(104) = .true.
+           endif
+
+           ch8pte3(k,j,i) = 'aaaaaaaa'
+           if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
+              ! Error #105
+              errors(105) = .true.
+           endif
+
+           ch8targ3(k,j,i) = 'zzzzzzzz'
+           if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
+              ! Error #106
+              errors(106) = .true.
+           endif
+        end do
+     end do
+  end do
+
+  rtarg3 = .5
+  ! Vector syntax
+  do, i=1,n
+     ipte3 = i
+     rpte3 = rpte3+1
+     do, j=1,m
+        do k=1,o
+           if (intne(itarg3(k,j,i), i)) then
+              ! Error #107
+              errors(107) = .true.
+           endif
+
+           if (realne(rtarg3(k,j,i), i+.5)) then
+              ! Error #108
+              errors(108) = .true.
+           endif
+        end do
+     end do
+  end do
+end subroutine ptr3
+
+subroutine ptr4
+  common /errors/errors(400)
+  logical :: errors, intne, realne, chne, ch8ne
+  integer :: i,j,k
+  integer, parameter :: n = 9
+  integer, parameter :: m = 10
+  integer, parameter :: o = 11
+  integer itarg1 (n)
+  integer itarg2 (m,n)
+  integer itarg3 (o,m,n)
+  real rtarg1(n)
+  real rtarg2(m,n)
+  real rtarg3(o,m,n)
+  character chtarg1(n)
+  character chtarg2(m,n)
+  character chtarg3(o,m,n)
+  character*8 ch8targ1(n)
+  character*8 ch8targ2(m,n)
+  character*8 ch8targ3(o,m,n)
+  type drvd
+     real r1
+     integer i1
+     integer i2(5)
+  end type drvd
+  type(drvd) dtarg1(n)
+  type(drvd) dtarg2(m,n)
+  type(drvd) dtarg3(o,m,n)
+
+  pointer(iptr1,dpte1),(iptr2,dpte2),(iptr3,dpte3)
+  pointer    (iptr4,ipte1),  (iptr5,ipte2) ,(iptr6,ipte3),(iptr7,rpte1)
+  pointer(iptr8,rpte2)
+  pointer(iptr9,rpte3),(iptr10,chpte1)
+  pointer(iptr11,chpte2),(iptr12,chpte3),(iptr13,ch8pte1)
+  pointer(iptr14,ch8pte2)
+  pointer(iptr15,ch8pte3)
+
+  type(drvd) dpte1(n)
+  type(drvd) dpte2(m,n)
+  type(drvd) dpte3(o,m,n)
+  integer ipte1 (n)
+  integer ipte2 (m,n)
+  integer ipte3 (o,m,n)
+  real rpte1(n)
+  real rpte2(m,n)
+  real rpte3(o,m,n)
+  character chpte1(n)
+  character chpte2(m,n)
+  character chpte3(o,m,n)
+  character*8 ch8pte1(n)
+  character*8 ch8pte2(m,n)
+  character*8 ch8pte3(o,m,n)
+
+  iptr1 = loc(dtarg1)
+  iptr2 = loc(dtarg2)
+  iptr3 = loc(dtarg3)
+  iptr4 = loc(itarg1)
+  iptr5 = loc(itarg2)
+  iptr6 = loc(itarg3)
+  iptr7 = loc(rtarg1)
+  iptr8 = loc(rtarg2)
+  iptr9 = loc(rtarg3)
+  iptr10= loc(chtarg1)
+  iptr11= loc(chtarg2)
+  iptr12= loc(chtarg3)
+  iptr13= loc(ch8targ1)
+  iptr14= loc(ch8targ2)
+  iptr15= loc(ch8targ3)
+
+
+  do, i=1,n
+     dpte1(i)%i1=i
+     if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
+        ! Error #109
+        errors(109) = .true.
+     endif
+
+     dtarg1(i)%i1=2*dpte1(i)%i1
+     if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
+        ! Error #110
+        errors(110) = .true.
+     endif
+
+     ipte1(i) = i
+     if (intne(ipte1(i), itarg1(i))) then
+        ! Error #111
+        errors(111) = .true.
+     endif
+
+     itarg1(i) = -ipte1(i)
+     if (intne(ipte1(i), itarg1(i))) then
+        ! Error #112
+        errors(112) = .true.
+     endif
+
+     rpte1(i) = i * 5.0
+     if (realne(rpte1(i), rtarg1(i))) then
+        ! Error #113
+        errors(113) = .true.
+     endif
+
+     rtarg1(i) = i * (-5.0)
+     if (realne(rpte1(i), rtarg1(i))) then
+        ! Error #114
+        errors(114) = .true.
+     endif
+
+     chpte1(i) = 'a'
+     if (chne(chpte1(i), chtarg1(i))) then
+        ! Error #115
+        errors(115) = .true.
+     endif
+
+     chtarg1(i) = 'z'
+     if (chne(chpte1(i), chtarg1(i))) then
+        ! Error #116
+        errors(116) = .true.
+     endif
+
+     ch8pte1(i) = 'aaaaaaaa'
+     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
+        ! Error #117
+        errors(117) = .true.
+     endif
+
+     ch8targ1(i) = 'zzzzzzzz'
+     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
+        ! Error #118
+        errors(118) = .true.
+     endif
+
+     do, j=1,m
+        dpte2(j,i)%r1=1.0
+        if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
+           ! Error #119
+           errors(119) = .true.
+        endif
+
+        dtarg2(j,i)%r1=2*dpte2(j,i)%r1
+        if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
+           ! Error #120
+           errors(120) = .true.
+        endif
+
+        ipte2(j,i) = i
+        if (intne(ipte2(j,i), itarg2(j,i))) then
+           ! Error #121
+           errors(121) = .true.
+        endif
+
+        itarg2(j,i) = -ipte2(j,i)
+        if (intne(ipte2(j,i), itarg2(j,i))) then
+           ! Error #122
+           errors(122) = .true.
+        endif
+
+        rpte2(j,i) = i * (-2.0)
+        if (realne(rpte2(j,i), rtarg2(j,i))) then
+           ! Error #123
+           errors(123) = .true.
+        endif
+
+        rtarg2(j,i) = i * (-3.0)
+        if (realne(rpte2(j,i), rtarg2(j,i))) then
+           ! Error #124
+           errors(124) = .true.
+        endif
+
+        chpte2(j,i) = 'a'
+        if (chne(chpte2(j,i), chtarg2(j,i))) then
+           ! Error #125
+           errors(125) = .true.
+        endif
+
+        chtarg2(j,i) = 'z'
+        if (chne(chpte2(j,i), chtarg2(j,i))) then
+           ! Error #126
+           errors(126) = .true.
+        endif
+
+        ch8pte2(j,i) = 'aaaaaaaa'
+        if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
+           ! Error #127
+           errors(127) = .true.
+        endif
+
+        ch8targ2(j,i) = 'zzzzzzzz'
+        if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
+           ! Error #128
+           errors(128) = .true.
+        endif
+        do k=1,o
+           dpte3(k,j,i)%i2(1+mod(i,5))=i
+           if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
+                dtarg3(k,j,i)%i2(1+mod(i,5)))) then
+              ! Error #129
+              errors(129) = .true.
+           endif
+
+           dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5))
+           if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
+                dtarg3(k,j,i)%i2(1+mod(i,5)))) then
+              ! Error #130
+              errors(130) = .true.
+           endif
+
+           ipte3(k,j,i) = i
+           if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
+              ! Error #131
+              errors(131) = .true.
+           endif
+
+           itarg3(k,j,i) = -ipte3(k,j,i)
+           if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
+              ! Error #132
+              errors(132) = .true.
+           endif
+
+           rpte3(k,j,i) = i * 2.0
+           if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
+              ! Error #133
+              errors(133) = .true.
+           endif
+
+           rtarg3(k,j,i) = i * 3.0
+           if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
+              ! Error #134
+              errors(134) = .true.
+           endif
+
+           chpte3(k,j,i) = 'a'
+           if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
+              ! Error #135
+              errors(135) = .true.
+           endif
+
+           chtarg3(k,j,i) = 'z'
+           if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
+              ! Error #136
+              errors(136) = .true.
+           endif
+
+           ch8pte3(k,j,i) = 'aaaaaaaa'
+           if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
+              ! Error #137
+              errors(137) = .true.
+           endif
+
+           ch8targ3(k,j,i) = 'zzzzzzzz'
+           if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
+              ! Error #138
+              errors(138) = .true.
+           endif
+        end do
+     end do
+  end do
+
+  rtarg3 = .5
+  ! Vector syntax
+  do, i=1,n
+     ipte3 = i
+     rpte3 = rpte3+1
+     do, j=1,m
+        do k=1,o
+           if (intne(itarg3(k,j,i), i)) then
+              ! Error #139
+              errors(139) = .true.
+           endif
+
+           if (realne(rtarg3(k,j,i), i+.5)) then
+              ! Error #140
+              errors(140) = .true.
+           endif
+        end do
+     end do
+  end do
+
+end subroutine ptr4
+
+subroutine ptr5
+  common /errors/errors(400)
+  logical :: errors, intne, realne, chne, ch8ne
+  integer :: i,j,k
+  integer, parameter :: n = 9
+  integer, parameter :: m = 10
+  integer, parameter :: o = 11
+  integer itarg1 (n)
+  integer itarg2 (m,n)
+  integer itarg3 (o,m,n)
+  real rtarg1(n)
+  real rtarg2(m,n)
+  real rtarg3(o,m,n)
+  character chtarg1(n)
+  character chtarg2(m,n)
+  character chtarg3(o,m,n)
+  character*8 ch8targ1(n)
+  character*8 ch8targ2(m,n)
+  character*8 ch8targ3(o,m,n)
+  type drvd
+     real r1
+     integer i1
+     integer i2(5)
+  end type drvd
+  type(drvd) dtarg1(n)
+  type(drvd) dtarg2(m,n)
+  type(drvd) dtarg3(o,m,n)
+
+  type(drvd) dpte1(*)
+  type(drvd) dpte2(m,*)
+  type(drvd) dpte3(o,m,*)
+  integer ipte1 (*)
+  integer ipte2 (m,*)
+  integer ipte3 (o,m,*)
+  real rpte1(*)
+  real rpte2(m,*)
+  real rpte3(o,m,*)
+  character chpte1(*)
+  character chpte2(m,*)
+  character chpte3(o,m,*)
+  character*8 ch8pte1(*)
+  character*8 ch8pte2(m,*)
+  character*8 ch8pte3(o,m,*)
+
+  pointer(iptr1,dpte1)
+  pointer(iptr2,dpte2)
+  pointer(iptr3,dpte3)
+  pointer(iptr4,ipte1)
+  pointer(iptr5,ipte2)
+  pointer(iptr6,ipte3)
+  pointer(iptr7,rpte1)
+  pointer(iptr8,rpte2)
+  pointer(iptr9,rpte3)
+  pointer(iptr10,chpte1)
+  pointer(iptr11,chpte2)
+  pointer(iptr12,chpte3)
+  pointer(iptr13,ch8pte1)
+  pointer(iptr14,ch8pte2)
+  pointer(iptr15,ch8pte3)
+
+  iptr1 = loc(dtarg1)
+  iptr2 = loc(dtarg2)
+  iptr3 = loc(dtarg3)
+  iptr4 = loc(itarg1)
+  iptr5 = loc(itarg2)
+  iptr6 = loc(itarg3)
+  iptr7 = loc(rtarg1)
+  iptr8 = loc(rtarg2)
+  iptr9 = loc(rtarg3)
+  iptr10= loc(chtarg1)
+  iptr11= loc(chtarg2)
+  iptr12= loc(chtarg3)
+  iptr13= loc(ch8targ1)
+  iptr14= loc(ch8targ2)
+  iptr15= loc(ch8targ3)
+
+
+  do, i=1,n
+     dpte1(i)%i1=i
+     if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
+        ! Error #141
+        errors(141) = .true.
+     endif
+
+     dtarg1(i)%i1=2*dpte1(i)%i1
+     if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
+        ! Error #142
+        errors(142) = .true.
+     endif
+
+     ipte1(i) = i
+     if (intne(ipte1(i), itarg1(i))) then
+        ! Error #143
+        errors(143) = .true.
+     endif
+
+     itarg1(i) = -ipte1(i)
+     if (intne(ipte1(i), itarg1(i))) then
+        ! Error #144
+        errors(144) = .true.
+     endif
+
+     rpte1(i) = i * 5.0
+     if (realne(rpte1(i), rtarg1(i))) then
+        ! Error #145
+        errors(145) = .true.
+     endif
+
+     rtarg1(i) = i * (-5.0)
+     if (realne(rpte1(i), rtarg1(i))) then
+        ! Error #146
+        errors(146) = .true.
+     endif
+
+     chpte1(i) = 'a'
+     if (chne(chpte1(i), chtarg1(i))) then
+        ! Error #147
+        errors(147) = .true.
+     endif
+
+     chtarg1(i) = 'z'
+     if (chne(chpte1(i), chtarg1(i))) then
+        ! Error #148
+        errors(148) = .true.
+     endif
+
+     ch8pte1(i) = 'aaaaaaaa'
+     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
+        ! Error #149
+        errors(149) = .true.
+     endif
+
+     ch8targ1(i) = 'zzzzzzzz'
+     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
+        ! Error #150
+        errors(150) = .true.
+     endif
+
+     do, j=1,m
+        dpte2(j,i)%r1=1.0
+        if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
+           ! Error #151
+           errors(151) = .true.
+        endif
+
+        dtarg2(j,i)%r1=2*dpte2(j,i)%r1
+        if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
+           ! Error #152
+           errors(152) = .true.
+        endif
+
+        ipte2(j,i) = i
+        if (intne(ipte2(j,i), itarg2(j,i))) then
+           ! Error #153
+           errors(153) = .true.
+        endif
+
+        itarg2(j,i) = -ipte2(j,i)
+        if (intne(ipte2(j,i), itarg2(j,i))) then
+           ! Error #154
+           errors(154) = .true.
+        endif
+
+        rpte2(j,i) = i * (-2.0)
+        if (realne(rpte2(j,i), rtarg2(j,i))) then
+           ! Error #155
+           errors(155) = .true.
+        endif
+
+        rtarg2(j,i) = i * (-3.0)
+        if (realne(rpte2(j,i), rtarg2(j,i))) then
+           ! Error #156
+           errors(156) = .true.
+        endif
+
+        chpte2(j,i) = 'a'
+        if (chne(chpte2(j,i), chtarg2(j,i))) then
+           ! Error #157
+           errors(157) = .true.
+        endif
+
+        chtarg2(j,i) = 'z'
+        if (chne(chpte2(j,i), chtarg2(j,i))) then
+           ! Error #158
+           errors(158) = .true.
+        endif
+
+        ch8pte2(j,i) = 'aaaaaaaa'
+        if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
+           ! Error #159
+           errors(159) = .true.
+        endif
+
+        ch8targ2(j,i) = 'zzzzzzzz'
+        if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
+           ! Error #160
+           errors(160) = .true.
+        endif
+        do k=1,o
+           dpte3(k,j,i)%i2(1+mod(i,5))=i
+           if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
+                dtarg3(k,j,i)%i2(1+mod(i,5)))) then
+              ! Error #161
+              errors(161) = .true.
+           endif
+
+           dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5))
+           if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
+                dtarg3(k,j,i)%i2(1+mod(i,5)))) then
+              ! Error #162
+              errors(162) = .true.
+           endif
+
+           ipte3(k,j,i) = i
+           if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
+              ! Error #163
+              errors(163) = .true.
+           endif
+
+           itarg3(k,j,i) = -ipte3(k,j,i)
+           if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
+              ! Error #164
+              errors(164) = .true.
+           endif
+
+           rpte3(k,j,i) = i * 2.0
+           if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
+              ! Error #165
+              errors(165) = .true.
+           endif
+
+           rtarg3(k,j,i) = i * 3.0
+           if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
+              ! Error #166
+              errors(166) = .true.
+           endif
+
+           chpte3(k,j,i) = 'a'
+           if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
+              ! Error #167
+              errors(167) = .true.
+           endif
+
+           chtarg3(k,j,i) = 'z'
+           if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
+              ! Error #168
+              errors(168) = .true.
+           endif
+
+           ch8pte3(k,j,i) = 'aaaaaaaa'
+           if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
+              ! Error #169
+              errors(169) = .true.
+           endif
+
+           ch8targ3(k,j,i) = 'zzzzzzzz'
+           if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
+              ! Error #170
+              errors(170) = .true.
+           endif
+        end do
+     end do
+  end do
+
+end subroutine ptr5
+
+
+subroutine ptr6
+  common /errors/errors(400)
+  logical :: errors, intne, realne, chne, ch8ne
+  integer :: i,j,k
+  integer, parameter :: n = 9
+  integer, parameter :: m = 10
+  integer, parameter :: o = 11
+  integer itarg1 (n)
+  integer itarg2 (m,n)
+  integer itarg3 (o,m,n)
+  real rtarg1(n)
+  real rtarg2(m,n)
+  real rtarg3(o,m,n)
+  character chtarg1(n)
+  character chtarg2(m,n)
+  character chtarg3(o,m,n)
+  character*8 ch8targ1(n)
+  character*8 ch8targ2(m,n)
+  character*8 ch8targ3(o,m,n)
+  type drvd
+     real r1
+     integer i1
+     integer i2(5)
+  end type drvd
+  type(drvd) dtarg1(n)
+  type(drvd) dtarg2(m,n)
+  type(drvd) dtarg3(o,m,n)
+
+  type(drvd) dpte1
+  type(drvd) dpte2
+  type(drvd) dpte3
+  integer ipte1
+  integer ipte2
+  integer ipte3
+  real rpte1
+  real rpte2
+  real rpte3
+  character chpte1
+  character chpte2
+  character chpte3
+  character*8 ch8pte1
+  character*8 ch8pte2
+  character*8 ch8pte3
+
+  pointer(iptr1,dpte1(*))
+  pointer(iptr2,dpte2(m,*))
+  pointer(iptr3,dpte3(o,m,*))
+  pointer(iptr4,ipte1(*))
+  pointer(iptr5,ipte2 (m,*))
+  pointer(iptr6,ipte3(o,m,*))
+  pointer(iptr7,rpte1(*))
+  pointer(iptr8,rpte2(m,*))
+  pointer(iptr9,rpte3(o,m,*))
+  pointer(iptr10,chpte1(*))
+  pointer(iptr11,chpte2(m,*))
+  pointer(iptr12,chpte3(o,m,*))
+  pointer(iptr13,ch8pte1(*))
+  pointer(iptr14,ch8pte2(m,*))
+  pointer(iptr15,ch8pte3(o,m,*))
+
+  iptr1 = loc(dtarg1)
+  iptr2 = loc(dtarg2)
+  iptr3 = loc(dtarg3)
+  iptr4 = loc(itarg1)
+  iptr5 = loc(itarg2)
+  iptr6 = loc(itarg3)
+  iptr7 = loc(rtarg1)
+  iptr8 = loc(rtarg2)
+  iptr9 = loc(rtarg3)
+  iptr10= loc(chtarg1)
+  iptr11= loc(chtarg2)
+  iptr12= loc(chtarg3)
+  iptr13= loc(ch8targ1)
+  iptr14= loc(ch8targ2)
+  iptr15= loc(ch8targ3)
+
+  do, i=1,n
+     dpte1(i)%i1=i
+     if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
+        ! Error #171
+        errors(171) = .true.
+     endif
+
+     dtarg1(i)%i1=2*dpte1(i)%i1
+     if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
+        ! Error #172
+        errors(172) = .true.
+     endif
+
+     ipte1(i) = i
+     if (intne(ipte1(i), itarg1(i))) then
+        ! Error #173
+        errors(173) = .true.
+     endif
+
+     itarg1(i) = -ipte1(i)
+     if (intne(ipte1(i), itarg1(i))) then
+        ! Error #174
+        errors(174) = .true.
+     endif
+
+     rpte1(i) = i * 5.0
+     if (realne(rpte1(i), rtarg1(i))) then
+        ! Error #175
+        errors(175) = .true.
+     endif
+
+     rtarg1(i) = i * (-5.0)
+     if (realne(rpte1(i), rtarg1(i))) then
+        ! Error #176
+        errors(176) = .true.
+     endif
+
+     chpte1(i) = 'a'
+     if (chne(chpte1(i), chtarg1(i))) then
+        ! Error #177
+        errors(177) = .true.
+     endif
+
+     chtarg1(i) = 'z'
+     if (chne(chpte1(i), chtarg1(i))) then
+        ! Error #178
+        errors(178) = .true.
+     endif
+
+     ch8pte1(i) = 'aaaaaaaa'
+     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
+        ! Error #179
+        errors(179) = .true.
+     endif
+
+     ch8targ1(i) = 'zzzzzzzz'
+     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
+        ! Error #180
+        errors(180) = .true.
+     endif
+
+     do, j=1,m
+        dpte2(j,i)%r1=1.0
+        if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
+           ! Error #181
+           errors(181) = .true.
+        endif
+
+        dtarg2(j,i)%r1=2*dpte2(j,i)%r1
+        if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
+           ! Error #182
+           errors(182) = .true.
+        endif
+
+        ipte2(j,i) = i
+        if (intne(ipte2(j,i), itarg2(j,i))) then
+           ! Error #183
+           errors(183) = .true.
+        endif
+
+        itarg2(j,i) = -ipte2(j,i)
+        if (intne(ipte2(j,i), itarg2(j,i))) then
+           ! Error #184
+           errors(184) = .true.
+        endif
+
+        rpte2(j,i) = i * (-2.0)
+        if (realne(rpte2(j,i), rtarg2(j,i))) then
+           ! Error #185
+           errors(185) = .true.
+        endif
+
+        rtarg2(j,i) = i * (-3.0)
+        if (realne(rpte2(j,i), rtarg2(j,i))) then
+           ! Error #186
+           errors(186) = .true.
+        endif
+
+        chpte2(j,i) = 'a'
+        if (chne(chpte2(j,i), chtarg2(j,i))) then
+           ! Error #187
+           errors(187) = .true.
+        endif
+
+        chtarg2(j,i) = 'z'
+        if (chne(chpte2(j,i), chtarg2(j,i))) then
+           ! Error #188
+           errors(188) = .true.
+        endif
+
+        ch8pte2(j,i) = 'aaaaaaaa'
+        if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
+           ! Error #189
+           errors(189) = .true.
+        endif
+
+        ch8targ2(j,i) = 'zzzzzzzz'
+        if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
+           ! Error #190
+           errors(190) = .true.
+        endif
+        do k=1,o
+           dpte3(k,j,i)%i2(1+mod(i,5))=i
+           if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
+                dtarg3(k,j,i)%i2(1+mod(i,5)))) then
+              ! Error #191
+              errors(191) = .true.
+           endif
+
+           dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5))
+           if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
+                dtarg3(k,j,i)%i2(1+mod(i,5)))) then
+              ! Error #192
+              errors(192) = .true.
+           endif
+
+           ipte3(k,j,i) = i
+           if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
+              ! Error #193
+              errors(193) = .true.
+           endif
+
+           itarg3(k,j,i) = -ipte3(k,j,i)
+           if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
+              ! Error #194
+              errors(194) = .true.
+           endif
+
+           rpte3(k,j,i) = i * 2.0
+           if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
+              ! Error #195
+              errors(195) = .true.
+           endif
+
+           rtarg3(k,j,i) = i * 3.0
+           if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
+              ! Error #196
+              errors(196) = .true.
+           endif
+
+           chpte3(k,j,i) = 'a'
+           if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
+              ! Error #197
+              errors(197) = .true.
+           endif
+
+           chtarg3(k,j,i) = 'z'
+           if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
+              ! Error #198
+              errors(198) = .true.
+           endif
+
+           ch8pte3(k,j,i) = 'aaaaaaaa'
+           if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
+              ! Error #199
+              errors(199) = .true.
+           endif
+
+           ch8targ3(k,j,i) = 'zzzzzzzz'
+           if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
+              ! Error #200
+              errors(200) = .true.
+           endif
+        end do
+     end do
+  end do
+
+end subroutine ptr6
+
+subroutine ptr7
+  common /errors/errors(400)
+  logical :: errors, intne, realne, chne, ch8ne
+  integer :: i,j,k
+  integer, parameter :: n = 9
+  integer, parameter :: m = 10
+  integer, parameter :: o = 11
+  integer itarg1 (n)
+  integer itarg2 (m,n)
+  integer itarg3 (o,m,n)
+  real rtarg1(n)
+  real rtarg2(m,n)
+  real rtarg3(o,m,n)
+  character chtarg1(n)
+  character chtarg2(m,n)
+  character chtarg3(o,m,n)
+  character*8 ch8targ1(n)
+  character*8 ch8targ2(m,n)
+  character*8 ch8targ3(o,m,n)
+  type drvd
+     real r1
+     integer i1
+     integer i2(5)
+  end type drvd
+  type(drvd) dtarg1(n)
+  type(drvd) dtarg2(m,n)
+  type(drvd) dtarg3(o,m,n)
+
+  pointer(iptr1,dpte1(*))
+  pointer(iptr2,dpte2(m,*))
+  pointer(iptr3,dpte3(o,m,*))
+  pointer(iptr4,ipte1(*))
+  pointer(iptr5,ipte2 (m,*))
+  pointer(iptr6,ipte3(o,m,*))
+  pointer(iptr7,rpte1(*))
+  pointer(iptr8,rpte2(m,*))
+  pointer(iptr9,rpte3(o,m,*))
+  pointer(iptr10,chpte1(*))
+  pointer(iptr11,chpte2(m,*))
+  pointer(iptr12,chpte3(o,m,*))
+  pointer(iptr13,ch8pte1(*))
+  pointer(iptr14,ch8pte2(m,*))
+  pointer(iptr15,ch8pte3(o,m,*))
+
+  type(drvd) dpte1
+  type(drvd) dpte2
+  type(drvd) dpte3
+  integer ipte1
+  integer ipte2
+  integer ipte3
+  real rpte1
+  real rpte2
+  real rpte3
+  character chpte1
+  character chpte2
+  character chpte3
+  character*8 ch8pte1
+  character*8 ch8pte2
+  character*8 ch8pte3
+
+  iptr1 = loc(dtarg1)
+  iptr2 = loc(dtarg2)
+  iptr3 = loc(dtarg3)
+  iptr4 = loc(itarg1)
+  iptr5 = loc(itarg2)
+  iptr6 = loc(itarg3)
+  iptr7 = loc(rtarg1)
+  iptr8 = loc(rtarg2)
+  iptr9 = loc(rtarg3)
+  iptr10= loc(chtarg1)
+  iptr11= loc(chtarg2)
+  iptr12= loc(chtarg3)
+  iptr13= loc(ch8targ1)
+  iptr14= loc(ch8targ2)
+  iptr15= loc(ch8targ3)
+
+  do, i=1,n
+     dpte1(i)%i1=i
+     if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
+        ! Error #201
+        errors(201) = .true.
+     endif
+
+     dtarg1(i)%i1=2*dpte1(i)%i1
+     if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
+        ! Error #202
+        errors(202) = .true.
+     endif
+
+     ipte1(i) = i
+     if (intne(ipte1(i), itarg1(i))) then
+        ! Error #203
+        errors(203) = .true.
+     endif
+
+     itarg1(i) = -ipte1(i)
+     if (intne(ipte1(i), itarg1(i))) then
+        ! Error #204
+        errors(204) = .true.
+     endif
+
+     rpte1(i) = i * 5.0
+     if (realne(rpte1(i), rtarg1(i))) then
+        ! Error #205
+        errors(205) = .true.
+     endif
+
+     rtarg1(i) = i * (-5.0)
+     if (realne(rpte1(i), rtarg1(i))) then
+        ! Error #206
+        errors(206) = .true.
+     endif
+
+     chpte1(i) = 'a'
+     if (chne(chpte1(i), chtarg1(i))) then
+        ! Error #207
+        errors(207) = .true.
+     endif
+
+     chtarg1(i) = 'z'
+     if (chne(chpte1(i), chtarg1(i))) then
+        ! Error #208
+        errors(208) = .true.
+     endif
+
+     ch8pte1(i) = 'aaaaaaaa'
+     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
+        ! Error #209
+        errors(209) = .true.
+     endif
+
+     ch8targ1(i) = 'zzzzzzzz'
+     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
+        ! Error #210
+        errors(210) = .true.
+     endif
+
+     do, j=1,m
+        dpte2(j,i)%r1=1.0
+        if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
+           ! Error #211
+           errors(211) = .true.
+        endif
+
+        dtarg2(j,i)%r1=2*dpte2(j,i)%r1
+        if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
+           ! Error #212
+           errors(212) = .true.
+        endif
+
+        ipte2(j,i) = i
+        if (intne(ipte2(j,i), itarg2(j,i))) then
+           ! Error #213
+           errors(213) = .true.
+        endif
+
+        itarg2(j,i) = -ipte2(j,i)
+        if (intne(ipte2(j,i), itarg2(j,i))) then
+           ! Error #214
+           errors(214) = .true.
+        endif
+
+        rpte2(j,i) = i * (-2.0)
+        if (realne(rpte2(j,i), rtarg2(j,i))) then
+           ! Error #215
+           errors(215) = .true.
+        endif
+
+        rtarg2(j,i) = i * (-3.0)
+        if (realne(rpte2(j,i), rtarg2(j,i))) then
+           ! Error #216
+           errors(216) = .true.
+        endif
+
+        chpte2(j,i) = 'a'
+        if (chne(chpte2(j,i), chtarg2(j,i))) then
+           ! Error #217
+           errors(217) = .true.
+        endif
+
+        chtarg2(j,i) = 'z'
+        if (chne(chpte2(j,i), chtarg2(j,i))) then
+           ! Error #218
+           errors(218) = .true.
+        endif
+
+        ch8pte2(j,i) = 'aaaaaaaa'
+        if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
+           ! Error #219
+           errors(219) = .true.
+        endif
+
+        ch8targ2(j,i) = 'zzzzzzzz'
+        if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
+           ! Error #220
+           errors(220) = .true.
+        endif
+        do k=1,o
+           dpte3(k,j,i)%i2(1+mod(i,5))=i
+           if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
+                dtarg3(k,j,i)%i2(1+mod(i,5)))) then
+              ! Error #221
+              errors(221) = .true.
+           endif
+
+           dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5))
+           if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
+                dtarg3(k,j,i)%i2(1+mod(i,5)))) then
+              ! Error #222
+              errors(222) = .true.
+           endif
+
+           ipte3(k,j,i) = i
+           if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
+              ! Error #223
+              errors(223) = .true.
+           endif
+
+           itarg3(k,j,i) = -ipte3(k,j,i)
+           if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
+              ! Error #224
+              errors(224) = .true.
+           endif
+
+           rpte3(k,j,i) = i * 2.0
+           if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
+              ! Error #225
+              errors(225) = .true.
+           endif
+
+           rtarg3(k,j,i) = i * 3.0
+           if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
+              ! Error #226
+              errors(226) = .true.
+           endif
+
+           chpte3(k,j,i) = 'a'
+           if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
+              ! Error #227
+              errors(227) = .true.
+           endif
+
+           chtarg3(k,j,i) = 'z'
+           if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
+              ! Error #228
+              errors(228) = .true.
+           endif
+
+           ch8pte3(k,j,i) = 'aaaaaaaa'
+           if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
+              ! Error #229
+              errors(229) = .true.
+           endif
+
+           ch8targ3(k,j,i) = 'zzzzzzzz'
+           if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
+              ! Error #230
+              errors(230) = .true.
+           endif
+        end do
+     end do
+  end do
+
+end subroutine ptr7
+
+subroutine ptr8
+  common /errors/errors(400)
+  logical :: errors, intne, realne, chne, ch8ne
+  integer :: i,j,k
+  integer, parameter :: n = 9
+  integer, parameter :: m = 10
+  integer, parameter :: o = 11
+  integer itarg1 (n)
+  integer itarg2 (m,n)
+  integer itarg3 (o,m,n)
+  real rtarg1(n)
+  real rtarg2(m,n)
+  real rtarg3(o,m,n)
+  character chtarg1(n)
+  character chtarg2(m,n)
+  character chtarg3(o,m,n)
+  character*8 ch8targ1(n)
+  character*8 ch8targ2(m,n)
+  character*8 ch8targ3(o,m,n)
+  type drvd
+     real r1
+     integer i1
+     integer i2(5)
+  end type drvd
+  type(drvd) dtarg1(n)
+  type(drvd) dtarg2(m,n)
+  type(drvd) dtarg3(o,m,n)
+
+  pointer(iptr1,dpte1)
+  pointer(iptr2,dpte2)
+  pointer(iptr3,dpte3)
+  pointer(iptr4,ipte1)
+  pointer(iptr5,ipte2)
+  pointer(iptr6,ipte3)
+  pointer(iptr7,rpte1)
+  pointer(iptr8,rpte2)
+  pointer(iptr9,rpte3)
+  pointer(iptr10,chpte1)
+  pointer(iptr11,chpte2)
+  pointer(iptr12,chpte3)
+  pointer(iptr13,ch8pte1)
+  pointer(iptr14,ch8pte2)
+  pointer(iptr15,ch8pte3)
+
+  type(drvd) dpte1(*)
+  type(drvd) dpte2(m,*)
+  type(drvd) dpte3(o,m,*)
+  integer ipte1 (*)
+  integer ipte2 (m,*)
+  integer ipte3 (o,m,*)
+  real rpte1(*)
+  real rpte2(m,*)
+  real rpte3(o,m,*)
+  character chpte1(*)
+  character chpte2(m,*)
+  character chpte3(o,m,*)
+  character*8 ch8pte1(*)
+  character*8 ch8pte2(m,*)
+  character*8 ch8pte3(o,m,*)
+
+  iptr1 = loc(dtarg1)
+  iptr2 = loc(dtarg2)
+  iptr3 = loc(dtarg3)
+  iptr4 = loc(itarg1)
+  iptr5 = loc(itarg2)
+  iptr6 = loc(itarg3)
+  iptr7 = loc(rtarg1)
+  iptr8 = loc(rtarg2)
+  iptr9 = loc(rtarg3)
+  iptr10= loc(chtarg1)
+  iptr11= loc(chtarg2)
+  iptr12= loc(chtarg3)
+  iptr13= loc(ch8targ1)
+  iptr14= loc(ch8targ2)
+  iptr15= loc(ch8targ3)
+
+
+  do, i=1,n
+     dpte1(i)%i1=i
+     if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
+        ! Error #231
+        errors(231) = .true.
+     endif
+
+     dtarg1(i)%i1=2*dpte1(i)%i1
+     if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
+        ! Error #232
+        errors(232) = .true.
+     endif
+
+     ipte1(i) = i
+     if (intne(ipte1(i), itarg1(i))) then
+        ! Error #233
+        errors(233) = .true.
+     endif
+
+     itarg1(i) = -ipte1(i)
+     if (intne(ipte1(i), itarg1(i))) then
+        ! Error #234
+        errors(234) = .true.
+     endif
+
+     rpte1(i) = i * 5.0
+     if (realne(rpte1(i), rtarg1(i))) then
+        ! Error #235
+        errors(235) = .true.
+     endif
+
+     rtarg1(i) = i * (-5.0)
+     if (realne(rpte1(i), rtarg1(i))) then
+        ! Error #236
+        errors(236) = .true.
+     endif
+
+     chpte1(i) = 'a'
+     if (chne(chpte1(i), chtarg1(i))) then
+        ! Error #237
+        errors(237) = .true.
+     endif
+
+     chtarg1(i) = 'z'
+     if (chne(chpte1(i), chtarg1(i))) then
+        ! Error #238
+        errors(238) = .true.
+     endif
+
+     ch8pte1(i) = 'aaaaaaaa'
+     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
+        ! Error #239
+        errors(239) = .true.
+     endif
+
+     ch8targ1(i) = 'zzzzzzzz'
+     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
+        ! Error #240
+        errors(240) = .true.
+     endif
+
+     do, j=1,m
+        dpte2(j,i)%r1=1.0
+        if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
+           ! Error #241
+           errors(241) = .true.
+        endif
+
+        dtarg2(j,i)%r1=2*dpte2(j,i)%r1
+        if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
+           ! Error #242
+           errors(242) = .true.
+        endif
+
+        ipte2(j,i) = i
+        if (intne(ipte2(j,i), itarg2(j,i))) then
+           ! Error #243
+           errors(243) = .true.
+        endif
+
+        itarg2(j,i) = -ipte2(j,i)
+        if (intne(ipte2(j,i), itarg2(j,i))) then
+           ! Error #244
+           errors(244) = .true.
+        endif
+
+        rpte2(j,i) = i * (-2.0)
+        if (realne(rpte2(j,i), rtarg2(j,i))) then
+           ! Error #245
+           errors(245) = .true.
+        endif
+
+        rtarg2(j,i) = i * (-3.0)
+        if (realne(rpte2(j,i), rtarg2(j,i))) then
+           ! Error #246
+           errors(246) = .true.
+        endif
+
+        chpte2(j,i) = 'a'
+        if (chne(chpte2(j,i), chtarg2(j,i))) then
+           ! Error #247
+           errors(247) = .true.
+        endif
+
+        chtarg2(j,i) = 'z'
+        if (chne(chpte2(j,i), chtarg2(j,i))) then
+           ! Error #248
+           errors(248) = .true.
+        endif
+
+        ch8pte2(j,i) = 'aaaaaaaa'
+        if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
+           ! Error #249
+           errors(249) = .true.
+        endif
+
+        ch8targ2(j,i) = 'zzzzzzzz'
+        if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
+           ! Error #250
+           errors(250) = .true.
+        endif
+        do k=1,o
+           dpte3(k,j,i)%i2(1+mod(i,5))=i
+           if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
+                dtarg3(k,j,i)%i2(1+mod(i,5)))) then
+              ! Error #251
+              errors(251) = .true.
+           endif
+
+           dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5))
+           if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
+                dtarg3(k,j,i)%i2(1+mod(i,5)))) then
+              ! Error #252
+              errors(252) = .true.
+           endif
+
+           ipte3(k,j,i) = i
+           if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
+              ! Error #253
+              errors(253) = .true.
+           endif
+
+           itarg3(k,j,i) = -ipte3(k,j,i)
+           if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
+              ! Error #254
+              errors(254) = .true.
+           endif
+
+           rpte3(k,j,i) = i * 2.0
+           if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
+              ! Error #255
+              errors(255) = .true.
+           endif
+
+           rtarg3(k,j,i) = i * 3.0
+           if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
+              ! Error #256
+              errors(256) = .true.
+           endif
+
+           chpte3(k,j,i) = 'a'
+           if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
+              ! Error #257
+              errors(257) = .true.
+           endif
+
+           chtarg3(k,j,i) = 'z'
+           if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
+              ! Error #258
+              errors(258) = .true.
+           endif
+
+           ch8pte3(k,j,i) = 'aaaaaaaa'
+           if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
+              ! Error #259
+              errors(259) = .true.
+           endif
+
+           ch8targ3(k,j,i) = 'zzzzzzzz'
+           if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
+              ! Error #260
+              errors(260) = .true.
+           endif
+        end do
+     end do
+  end do
+end subroutine ptr8
+
+
+subroutine ptr9(nnn,mmm,ooo)
+  common /errors/errors(400)
+  logical :: errors, intne, realne, chne, ch8ne
+  integer :: i,j,k
+  integer :: nnn,mmm,ooo
+  integer, parameter :: n = 9
+  integer, parameter :: m = 10
+  integer, parameter :: o = 11
+  integer itarg1 (n)
+  integer itarg2 (m,n)
+  integer itarg3 (o,m,n)
+  real rtarg1(n)
+  real rtarg2(m,n)
+  real rtarg3(o,m,n)
+  character chtarg1(n)
+  character chtarg2(m,n)
+  character chtarg3(o,m,n)
+  character*8 ch8targ1(n)
+  character*8 ch8targ2(m,n)
+  character*8 ch8targ3(o,m,n)
+  type drvd
+     real r1
+     integer i1
+     integer i2(5)
+  end type drvd
+  type(drvd) dtarg1(n)
+  type(drvd) dtarg2(m,n)
+  type(drvd) dtarg3(o,m,n)
+
+  type(drvd) dpte1(nnn)
+  type(drvd) dpte2(mmm,nnn)
+  type(drvd) dpte3(ooo,mmm,nnn)
+  integer ipte1 (nnn)
+  integer ipte2 (mmm,nnn)
+  integer ipte3 (ooo,mmm,nnn)
+  real rpte1(nnn)
+  real rpte2(mmm,nnn)
+  real rpte3(ooo,mmm,nnn)
+  character chpte1(nnn)
+  character chpte2(mmm,nnn)
+  character chpte3(ooo,mmm,nnn)
+  character*8 ch8pte1(nnn)
+  character*8 ch8pte2(mmm,nnn)
+  character*8 ch8pte3(ooo,mmm,nnn)
+
+  pointer(iptr1,dpte1)
+  pointer(iptr2,dpte2)
+  pointer(iptr3,dpte3)
+  pointer(iptr4,ipte1)
+  pointer(iptr5,ipte2)
+  pointer(iptr6,ipte3)
+  pointer(iptr7,rpte1)
+  pointer(iptr8,rpte2)
+  pointer(iptr9,rpte3)
+  pointer(iptr10,chpte1)
+  pointer(iptr11,chpte2)
+  pointer(iptr12,chpte3)
+  pointer(iptr13,ch8pte1)
+  pointer(iptr14,ch8pte2)
+  pointer(iptr15,ch8pte3)
+
+  iptr1 = loc(dtarg1)
+  iptr2 = loc(dtarg2)
+  iptr3 = loc(dtarg3)
+  iptr4 = loc(itarg1)
+  iptr5 = loc(itarg2)
+  iptr6 = loc(itarg3)
+  iptr7 = loc(rtarg1)
+  iptr8 = loc(rtarg2)
+  iptr9 = loc(rtarg3)
+  iptr10= loc(chtarg1)
+  iptr11= loc(chtarg2)
+  iptr12= loc(chtarg3)
+  iptr13= loc(ch8targ1)
+  iptr14= loc(ch8targ2)
+  iptr15= loc(ch8targ3)
+
+
+  do, i=1,n
+     dpte1(i)%i1=i
+     if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
+        ! Error #261
+        errors(261) = .true.
+     endif
+
+     dtarg1(i)%i1=2*dpte1(i)%i1
+     if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
+        ! Error #262
+        errors(262) = .true.
+     endif
+
+     ipte1(i) = i
+     if (intne(ipte1(i), itarg1(i))) then
+        ! Error #263
+        errors(263) = .true.
+     endif
+
+     itarg1(i) = -ipte1(i)
+     if (intne(ipte1(i), itarg1(i))) then
+        ! Error #264
+        errors(264) = .true.
+     endif
+
+     rpte1(i) = i * 5.0
+     if (realne(rpte1(i), rtarg1(i))) then
+        ! Error #265
+        errors(265) = .true.
+     endif
+
+     rtarg1(i) = i * (-5.0)
+     if (realne(rpte1(i), rtarg1(i))) then
+        ! Error #266
+        errors(266) = .true.
+     endif
+
+     chpte1(i) = 'a'
+     if (chne(chpte1(i), chtarg1(i))) then
+        ! Error #267
+        errors(267) = .true.
+     endif
+
+     chtarg1(i) = 'z'
+     if (chne(chpte1(i), chtarg1(i))) then
+        ! Error #268
+        errors(268) = .true.
+     endif
+
+     ch8pte1(i) = 'aaaaaaaa'
+     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
+        ! Error #269
+        errors(269) = .true.
+     endif
+
+     ch8targ1(i) = 'zzzzzzzz'
+     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
+        ! Error #270
+        errors(270) = .true.
+     endif
+
+     do, j=1,m
+        dpte2(j,i)%r1=1.0
+        if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
+           ! Error #271
+           errors(271) = .true.
+        endif
+
+        dtarg2(j,i)%r1=2*dpte2(j,i)%r1
+        if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
+           ! Error #272
+           errors(272) = .true.
+        endif
+
+        ipte2(j,i) = i
+        if (intne(ipte2(j,i), itarg2(j,i))) then
+           ! Error #273
+           errors(273) = .true.
+        endif
+
+        itarg2(j,i) = -ipte2(j,i)
+        if (intne(ipte2(j,i), itarg2(j,i))) then
+           ! Error #274
+           errors(274) = .true.
+        endif
+
+        rpte2(j,i) = i * (-2.0)
+        if (realne(rpte2(j,i), rtarg2(j,i))) then
+           ! Error #275
+           errors(275) = .true.
+        endif
+
+        rtarg2(j,i) = i * (-3.0)
+        if (realne(rpte2(j,i), rtarg2(j,i))) then
+           ! Error #276
+           errors(276) = .true.
+        endif
+
+        chpte2(j,i) = 'a'
+        if (chne(chpte2(j,i), chtarg2(j,i))) then
+           ! Error #277
+           errors(277) = .true.
+        endif
+
+        chtarg2(j,i) = 'z'
+        if (chne(chpte2(j,i), chtarg2(j,i))) then
+           ! Error #278
+           errors(278) = .true.
+        endif
+
+        ch8pte2(j,i) = 'aaaaaaaa'
+        if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
+           ! Error #279
+           errors(279) = .true.
+        endif
+
+        ch8targ2(j,i) = 'zzzzzzzz'
+        if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
+           ! Error #280
+           errors(280) = .true.
+        endif
+        do k=1,o
+           dpte3(k,j,i)%i2(1+mod(i,5))=i
+           if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
+                dtarg3(k,j,i)%i2(1+mod(i,5)))) then
+              ! Error #281
+              errors(281) = .true.
+           endif
+
+           dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5))
+           if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
+                dtarg3(k,j,i)%i2(1+mod(i,5)))) then
+              ! Error #282
+              errors(282) = .true.
+           endif
+
+           ipte3(k,j,i) = i
+           if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
+              ! Error #283
+              errors(283) = .true.
+           endif
+
+           itarg3(k,j,i) = -ipte3(k,j,i)
+           if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
+              ! Error #284
+              errors(284) = .true.
+           endif
+
+           rpte3(k,j,i) = i * 2.0
+           if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
+              ! Error #285
+              errors(285) = .true.
+           endif
+
+           rtarg3(k,j,i) = i * 3.0
+           if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
+              ! Error #286
+              errors(286) = .true.
+           endif
+
+           chpte3(k,j,i) = 'a'
+           if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
+              ! Error #287
+              errors(287) = .true.
+           endif
+
+           chtarg3(k,j,i) = 'z'
+           if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
+              ! Error #288
+              errors(288) = .true.
+           endif
+
+           ch8pte3(k,j,i) = 'aaaaaaaa'
+           if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
+              ! Error #289
+              errors(289) = .true.
+           endif
+
+           ch8targ3(k,j,i) = 'zzzzzzzz'
+           if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
+              ! Error #290
+              errors(290) = .true.
+           endif
+        end do
+     end do
+  end do
+
+  rtarg3 = .5
+  ! Vector syntax
+  do, i=1,n
+     ipte3 = i
+     rpte3 = rpte3+1
+     do, j=1,m
+        do k=1,o
+           if (intne(itarg3(k,j,i), i)) then
+              ! Error #291
+              errors(291) = .true.
+           endif
+
+           if (realne(rtarg3(k,j,i), i+.5)) then
+              ! Error #292
+              errors(292) = .true.
+           endif
+        end do
+     end do
+  end do
+
+end subroutine ptr9
+
+subroutine ptr10(nnn,mmm,ooo)
+  common /errors/errors(400)
+  logical :: errors, intne, realne, chne, ch8ne
+  integer :: i,j,k
+  integer :: nnn,mmm,ooo
+  integer, parameter :: n = 9
+  integer, parameter :: m = 10
+  integer, parameter :: o = 11
+  integer itarg1 (n)
+  integer itarg2 (m,n)
+  integer itarg3 (o,m,n)
+  real rtarg1(n)
+  real rtarg2(m,n)
+  real rtarg3(o,m,n)
+  character chtarg1(n)
+  character chtarg2(m,n)
+  character chtarg3(o,m,n)
+  character*8 ch8targ1(n)
+  character*8 ch8targ2(m,n)
+  character*8 ch8targ3(o,m,n)
+  type drvd
+     real r1
+     integer i1
+     integer i2(5)
+  end type drvd
+  type(drvd) dtarg1(n)
+  type(drvd) dtarg2(m,n)
+  type(drvd) dtarg3(o,m,n)
+
+  type(drvd) dpte1
+  type(drvd) dpte2
+  type(drvd) dpte3
+  integer ipte1
+  integer ipte2
+  integer ipte3
+  real rpte1
+  real rpte2
+  real rpte3
+  character chpte1
+  character chpte2
+  character chpte3
+  character*8 ch8pte1
+  character*8 ch8pte2
+  character*8 ch8pte3
+
+  pointer(iptr1,dpte1(nnn))
+  pointer(iptr2,dpte2(mmm,nnn))
+  pointer(iptr3,dpte3(ooo,mmm,nnn))
+  pointer(iptr4,ipte1(nnn))
+  pointer(iptr5,ipte2 (mmm,nnn))
+  pointer(iptr6,ipte3(ooo,mmm,nnn))
+  pointer(iptr7,rpte1(nnn))
+  pointer(iptr8,rpte2(mmm,nnn))
+  pointer(iptr9,rpte3(ooo,mmm,nnn))
+  pointer(iptr10,chpte1(nnn))
+  pointer(iptr11,chpte2(mmm,nnn))
+  pointer(iptr12,chpte3(ooo,mmm,nnn))
+  pointer(iptr13,ch8pte1(nnn))
+  pointer(iptr14,ch8pte2(mmm,nnn))
+  pointer(iptr15,ch8pte3(ooo,mmm,nnn))
+
+  iptr1 = loc(dtarg1)
+  iptr2 = loc(dtarg2)
+  iptr3 = loc(dtarg3)
+  iptr4 = loc(itarg1)
+  iptr5 = loc(itarg2)
+  iptr6 = loc(itarg3)
+  iptr7 = loc(rtarg1)
+  iptr8 = loc(rtarg2)
+  iptr9 = loc(rtarg3)
+  iptr10= loc(chtarg1)
+  iptr11= loc(chtarg2)
+  iptr12= loc(chtarg3)
+  iptr13= loc(ch8targ1)
+  iptr14= loc(ch8targ2)
+  iptr15= loc(ch8targ3)
+
+  do, i=1,n
+     dpte1(i)%i1=i
+     if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
+        ! Error #293
+        errors(293) = .true.
+     endif
+
+     dtarg1(i)%i1=2*dpte1(i)%i1
+     if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
+        ! Error #294
+        errors(294) = .true.
+     endif
+
+     ipte1(i) = i
+     if (intne(ipte1(i), itarg1(i))) then
+        ! Error #295
+        errors(295) = .true.
+     endif
+
+     itarg1(i) = -ipte1(i)
+     if (intne(ipte1(i), itarg1(i))) then
+        ! Error #296
+        errors(296) = .true.
+     endif
+
+     rpte1(i) = i * 5.0
+     if (realne(rpte1(i), rtarg1(i))) then
+        ! Error #297
+        errors(297) = .true.
+     endif
+
+     rtarg1(i) = i * (-5.0)
+     if (realne(rpte1(i), rtarg1(i))) then
+        ! Error #298
+        errors(298) = .true.
+     endif
+
+     chpte1(i) = 'a'
+     if (chne(chpte1(i), chtarg1(i))) then
+        ! Error #299
+        errors(299) = .true.
+     endif
+
+     chtarg1(i) = 'z'
+     if (chne(chpte1(i), chtarg1(i))) then
+        ! Error #300
+        errors(300) = .true.
+     endif
+
+     ch8pte1(i) = 'aaaaaaaa'
+     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
+        ! Error #301
+        errors(301) = .true.
+     endif
+
+     ch8targ1(i) = 'zzzzzzzz'
+     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
+        ! Error #302
+        errors(302) = .true.
+     endif
+
+     do, j=1,m
+        dpte2(j,i)%r1=1.0
+        if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
+           ! Error #303
+           errors(303) = .true.
+        endif
+
+        dtarg2(j,i)%r1=2*dpte2(j,i)%r1
+        if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
+           ! Error #304
+           errors(304) = .true.
+        endif
+
+        ipte2(j,i) = i
+        if (intne(ipte2(j,i), itarg2(j,i))) then
+           ! Error #305
+           errors(305) = .true.
+        endif
+
+        itarg2(j,i) = -ipte2(j,i)
+        if (intne(ipte2(j,i), itarg2(j,i))) then
+           ! Error #306
+           errors(306) = .true.
+        endif
+
+        rpte2(j,i) = i * (-2.0)
+        if (realne(rpte2(j,i), rtarg2(j,i))) then
+           ! Error #307
+           errors(307) = .true.
+        endif
+
+        rtarg2(j,i) = i * (-3.0)
+        if (realne(rpte2(j,i), rtarg2(j,i))) then
+           ! Error #308
+           errors(308) = .true.
+        endif
+
+        chpte2(j,i) = 'a'
+        if (chne(chpte2(j,i), chtarg2(j,i))) then
+           ! Error #309
+           errors(309) = .true.
+        endif
+
+        chtarg2(j,i) = 'z'
+        if (chne(chpte2(j,i), chtarg2(j,i))) then
+           ! Error #310
+           errors(310) = .true.
+        endif
+
+        ch8pte2(j,i) = 'aaaaaaaa'
+        if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
+           ! Error #311
+           errors(311) = .true.
+        endif
+
+        ch8targ2(j,i) = 'zzzzzzzz'
+        if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
+           ! Error #312
+           errors(312) = .true.
+        endif
+        do k=1,o
+           dpte3(k,j,i)%i2(1+mod(i,5))=i
+           if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
+                dtarg3(k,j,i)%i2(1+mod(i,5)))) then
+              ! Error #313
+              errors(313) = .true.
+           endif
+
+           dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5))
+           if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
+                dtarg3(k,j,i)%i2(1+mod(i,5)))) then
+              ! Error #314
+              errors(314) = .true.
+           endif
+
+           ipte3(k,j,i) = i
+           if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
+              ! Error #315
+              errors(315) = .true.
+           endif
+
+           itarg3(k,j,i) = -ipte3(k,j,i)
+           if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
+              ! Error #316
+              errors(316) = .true.
+           endif
+
+           rpte3(k,j,i) = i * 2.0
+           if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
+              ! Error #317
+              errors(317) = .true.
+           endif
+
+           rtarg3(k,j,i) = i * 3.0
+           if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
+              ! Error #318
+              errors(318) = .true.
+           endif
+
+           chpte3(k,j,i) = 'a'
+           if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
+              ! Error #319
+              errors(319) = .true.
+           endif
+
+           chtarg3(k,j,i) = 'z'
+           if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
+              ! Error #320
+              errors(320) = .true.
+           endif
+
+           ch8pte3(k,j,i) = 'aaaaaaaa'
+           if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
+              ! Error #321
+              errors(321) = .true.
+           endif
+
+           ch8targ3(k,j,i) = 'zzzzzzzz'
+           if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
+              ! Error #322
+              errors(322) = .true.
+           endif
+        end do
+     end do
+  end do
+
+  rtarg3 = .5
+  ! Vector syntax
+  do, i=1,n
+     ipte3 = i
+     rpte3 = rpte3+1
+     do, j=1,m
+        do k=1,o
+           if (intne(itarg3(k,j,i), i)) then
+              ! Error #323
+              errors(323) = .true.
+           endif
+
+           if (realne(rtarg3(k,j,i), i+.5)) then
+              ! Error #324
+              errors(324) = .true.
+           endif
+        end do
+     end do
+  end do
+end subroutine ptr10
+
+subroutine ptr11(nnn,mmm,ooo)
+  common /errors/errors(400)
+  logical :: errors, intne, realne, chne, ch8ne
+  integer :: i,j,k
+  integer :: nnn,mmm,ooo
+  integer, parameter :: n = 9
+  integer, parameter :: m = 10
+  integer, parameter :: o = 11
+  integer itarg1 (n)
+  integer itarg2 (m,n)
+  integer itarg3 (o,m,n)
+  real rtarg1(n)
+  real rtarg2(m,n)
+  real rtarg3(o,m,n)
+  character chtarg1(n)
+  character chtarg2(m,n)
+  character chtarg3(o,m,n)
+  character*8 ch8targ1(n)
+  character*8 ch8targ2(m,n)
+  character*8 ch8targ3(o,m,n)
+  type drvd
+     real r1
+     integer i1
+     integer i2(5)
+  end type drvd
+  type(drvd) dtarg1(n)
+  type(drvd) dtarg2(m,n)
+  type(drvd) dtarg3(o,m,n)
+
+  pointer(iptr1,dpte1(nnn))
+  pointer(iptr2,dpte2(mmm,nnn))
+  pointer(iptr3,dpte3(ooo,mmm,nnn))
+  pointer(iptr4,ipte1(nnn))
+  pointer(iptr5,ipte2 (mmm,nnn))
+  pointer(iptr6,ipte3(ooo,mmm,nnn))
+  pointer(iptr7,rpte1(nnn))
+  pointer(iptr8,rpte2(mmm,nnn))
+  pointer(iptr9,rpte3(ooo,mmm,nnn))
+  pointer(iptr10,chpte1(nnn))
+  pointer(iptr11,chpte2(mmm,nnn))
+  pointer(iptr12,chpte3(ooo,mmm,nnn))
+  pointer(iptr13,ch8pte1(nnn))
+  pointer(iptr14,ch8pte2(mmm,nnn))
+  pointer(iptr15,ch8pte3(ooo,mmm,nnn))
+
+  type(drvd) dpte1
+  type(drvd) dpte2
+  type(drvd) dpte3
+  integer ipte1
+  integer ipte2
+  integer ipte3
+  real rpte1
+  real rpte2
+  real rpte3
+  character chpte1
+  character chpte2
+  character chpte3
+  character*8 ch8pte1
+  character*8 ch8pte2
+  character*8 ch8pte3
+
+  iptr1 = loc(dtarg1)
+  iptr2 = loc(dtarg2)
+  iptr3 = loc(dtarg3)
+  iptr4 = loc(itarg1)
+  iptr5 = loc(itarg2)
+  iptr6 = loc(itarg3)
+  iptr7 = loc(rtarg1)
+  iptr8 = loc(rtarg2)
+  iptr9 = loc(rtarg3)
+  iptr10= loc(chtarg1)
+  iptr11= loc(chtarg2)
+  iptr12= loc(chtarg3)
+  iptr13= loc(ch8targ1)
+  iptr14= loc(ch8targ2)
+  iptr15= loc(ch8targ3)
+
+  do, i=1,n
+     dpte1(i)%i1=i
+     if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
+        ! Error #325
+        errors(325) = .true.
+     endif
+
+     dtarg1(i)%i1=2*dpte1(i)%i1
+     if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
+        ! Error #326
+        errors(326) = .true.
+     endif
+
+     ipte1(i) = i
+     if (intne(ipte1(i), itarg1(i))) then
+        ! Error #327
+        errors(327) = .true.
+     endif
+
+     itarg1(i) = -ipte1(i)
+     if (intne(ipte1(i), itarg1(i))) then
+        ! Error #328
+        errors(328) = .true.
+     endif
+
+     rpte1(i) = i * 5.0
+     if (realne(rpte1(i), rtarg1(i))) then
+        ! Error #329
+        errors(329) = .true.
+     endif
+
+     rtarg1(i) = i * (-5.0)
+     if (realne(rpte1(i), rtarg1(i))) then
+        ! Error #330
+        errors(330) = .true.
+     endif
+
+     chpte1(i) = 'a'
+     if (chne(chpte1(i), chtarg1(i))) then
+        ! Error #331
+        errors(331) = .true.
+     endif
+
+     chtarg1(i) = 'z'
+     if (chne(chpte1(i), chtarg1(i))) then
+        ! Error #332
+        errors(332) = .true.
+     endif
+
+     ch8pte1(i) = 'aaaaaaaa'
+     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
+        ! Error #333
+        errors(333) = .true.
+     endif
+
+     ch8targ1(i) = 'zzzzzzzz'
+     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
+        ! Error #334
+        errors(334) = .true.
+     endif
+
+     do, j=1,m
+        dpte2(j,i)%r1=1.0
+        if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
+           ! Error #335
+           errors(335) = .true.
+        endif
+
+        dtarg2(j,i)%r1=2*dpte2(j,i)%r1
+        if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
+           ! Error #336
+           errors(336) = .true.
+        endif
+
+        ipte2(j,i) = i
+        if (intne(ipte2(j,i), itarg2(j,i))) then
+           ! Error #337
+           errors(337) = .true.
+        endif
+
+        itarg2(j,i) = -ipte2(j,i)
+        if (intne(ipte2(j,i), itarg2(j,i))) then
+           ! Error #338
+           errors(338) = .true.
+        endif
+
+        rpte2(j,i) = i * (-2.0)
+        if (realne(rpte2(j,i), rtarg2(j,i))) then
+           ! Error #339
+           errors(339) = .true.
+        endif
+
+        rtarg2(j,i) = i * (-3.0)
+        if (realne(rpte2(j,i), rtarg2(j,i))) then
+           ! Error #340
+           errors(340) = .true.
+        endif
+
+        chpte2(j,i) = 'a'
+        if (chne(chpte2(j,i), chtarg2(j,i))) then
+           ! Error #341
+           errors(341) = .true.
+        endif
+
+        chtarg2(j,i) = 'z'
+        if (chne(chpte2(j,i), chtarg2(j,i))) then
+           ! Error #342
+           errors(342) = .true.
+        endif
+
+        ch8pte2(j,i) = 'aaaaaaaa'
+        if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
+           ! Error #343
+           errors(343) = .true.
+        endif
+
+        ch8targ2(j,i) = 'zzzzzzzz'
+        if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
+           ! Error #344
+           errors(344) = .true.
+        endif
+        do k=1,o
+           dpte3(k,j,i)%i2(1+mod(i,5))=i
+           if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
+                dtarg3(k,j,i)%i2(1+mod(i,5)))) then
+              ! Error #345
+              errors(345) = .true.
+           endif
+
+           dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5))
+           if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
+                dtarg3(k,j,i)%i2(1+mod(i,5)))) then
+              ! Error #346
+              errors(346) = .true.
+           endif
+
+           ipte3(k,j,i) = i
+           if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
+              ! Error #347
+              errors(347) = .true.
+           endif
+
+           itarg3(k,j,i) = -ipte3(k,j,i)
+           if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
+              ! Error #348
+              errors(348) = .true.
+           endif
+
+           rpte3(k,j,i) = i * 2.0
+           if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
+              ! Error #349
+              errors(349) = .true.
+           endif
+
+           rtarg3(k,j,i) = i * 3.0
+           if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
+              ! Error #350
+              errors(350) = .true.
+           endif
+
+           chpte3(k,j,i) = 'a'
+           if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
+              ! Error #351
+              errors(351) = .true.
+           endif
+
+           chtarg3(k,j,i) = 'z'
+           if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
+              ! Error #352
+              errors(352) = .true.
+           endif
+
+           ch8pte3(k,j,i) = 'aaaaaaaa'
+           if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
+              ! Error #353
+              errors(353) = .true.
+           endif
+
+           ch8targ3(k,j,i) = 'zzzzzzzz'
+           if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
+              ! Error #354
+              errors(354) = .true.
+           endif
+        end do
+     end do
+  end do
+
+  rtarg3 = .5
+  ! Vector syntax
+  do, i=1,n
+     ipte3 = i
+     rpte3 = rpte3+1
+     do, j=1,m
+        do k=1,o
+           if (intne(itarg3(k,j,i), i)) then
+              ! Error #355
+              errors(355) = .true.
+           endif
+
+           if (realne(rtarg3(k,j,i), i+.5)) then
+              ! Error #356
+              errors(356) = .true.
+           endif
+        end do
+     end do
+  end do
+end subroutine ptr11
+
+subroutine ptr12(nnn,mmm,ooo)
+  common /errors/errors(400)
+  logical :: errors, intne, realne, chne, ch8ne
+  integer :: i,j,k
+  integer :: nnn,mmm,ooo
+  integer, parameter :: n = 9
+  integer, parameter :: m = 10
+  integer, parameter :: o = 11
+  integer itarg1 (n)
+  integer itarg2 (m,n)
+  integer itarg3 (o,m,n)
+  real rtarg1(n)
+  real rtarg2(m,n)
+  real rtarg3(o,m,n)
+  character chtarg1(n)
+  character chtarg2(m,n)
+  character chtarg3(o,m,n)
+  character*8 ch8targ1(n)
+  character*8 ch8targ2(m,n)
+  character*8 ch8targ3(o,m,n)
+  type drvd
+     real r1
+     integer i1
+     integer i2(5)
+  end type drvd
+  type(drvd) dtarg1(n)
+  type(drvd) dtarg2(m,n)
+  type(drvd) dtarg3(o,m,n)
+
+  pointer(iptr1,dpte1)
+  pointer(iptr2,dpte2)
+  pointer(iptr3,dpte3)
+  pointer(iptr4,ipte1)
+  pointer(iptr5,ipte2)
+  pointer(iptr6,ipte3)
+  pointer(iptr7,rpte1)
+  pointer(iptr8,rpte2)
+  pointer(iptr9,rpte3)
+  pointer(iptr10,chpte1)
+  pointer(iptr11,chpte2)
+  pointer(iptr12,chpte3)
+  pointer(iptr13,ch8pte1)
+  pointer(iptr14,ch8pte2)
+  pointer(iptr15,ch8pte3)
+
+  type(drvd) dpte1(nnn)
+  type(drvd) dpte2(mmm,nnn)
+  type(drvd) dpte3(ooo,mmm,nnn)
+  integer ipte1 (nnn)
+  integer ipte2 (mmm,nnn)
+  integer ipte3 (ooo,mmm,nnn)
+  real rpte1(nnn)
+  real rpte2(mmm,nnn)
+  real rpte3(ooo,mmm,nnn)
+  character chpte1(nnn)
+  character chpte2(mmm,nnn)
+  character chpte3(ooo,mmm,nnn)
+  character*8 ch8pte1(nnn)
+  character*8 ch8pte2(mmm,nnn)
+  character*8 ch8pte3(ooo,mmm,nnn)
+
+  iptr1 = loc(dtarg1)
+  iptr2 = loc(dtarg2)
+  iptr3 = loc(dtarg3)
+  iptr4 = loc(itarg1)
+  iptr5 = loc(itarg2)
+  iptr6 = loc(itarg3)
+  iptr7 = loc(rtarg1)
+  iptr8 = loc(rtarg2)
+  iptr9 = loc(rtarg3)
+  iptr10= loc(chtarg1)
+  iptr11= loc(chtarg2)
+  iptr12= loc(chtarg3)
+  iptr13= loc(ch8targ1)
+  iptr14= loc(ch8targ2)
+  iptr15= loc(ch8targ3)
+
+
+  do, i=1,n
+     dpte1(i)%i1=i
+     if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
+        ! Error #357
+        errors(357) = .true.
+     endif
+
+     dtarg1(i)%i1=2*dpte1(i)%i1
+     if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
+        ! Error #358
+        errors(358) = .true.
+     endif
+
+     ipte1(i) = i
+     if (intne(ipte1(i), itarg1(i))) then
+        ! Error #359
+        errors(359) = .true.
+     endif
+
+     itarg1(i) = -ipte1(i)
+     if (intne(ipte1(i), itarg1(i))) then
+        ! Error #360
+        errors(360) = .true.
+     endif
+
+     rpte1(i) = i * 5.0
+     if (realne(rpte1(i), rtarg1(i))) then
+        ! Error #361
+        errors(361) = .true.
+     endif
+
+     rtarg1(i) = i * (-5.0)
+     if (realne(rpte1(i), rtarg1(i))) then
+        ! Error #362
+        errors(362) = .true.
+     endif
+
+     chpte1(i) = 'a'
+     if (chne(chpte1(i), chtarg1(i))) then
+        ! Error #363
+        errors(363) = .true.
+     endif
+
+     chtarg1(i) = 'z'
+     if (chne(chpte1(i), chtarg1(i))) then
+        ! Error #364
+        errors(364) = .true.
+     endif
+
+     ch8pte1(i) = 'aaaaaaaa'
+     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
+        ! Error #365
+        errors(365) = .true.
+     endif
+
+     ch8targ1(i) = 'zzzzzzzz'
+     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
+        ! Error #366
+        errors(366) = .true.
+     endif
+
+     do, j=1,m
+        dpte2(j,i)%r1=1.0
+        if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
+           ! Error #367
+           errors(367) = .true.
+        endif
+
+        dtarg2(j,i)%r1=2*dpte2(j,i)%r1
+        if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
+           ! Error #368
+           errors(368) = .true.
+        endif
+
+        ipte2(j,i) = i
+        if (intne(ipte2(j,i), itarg2(j,i))) then
+           ! Error #369
+           errors(369) = .true.
+        endif
+
+        itarg2(j,i) = -ipte2(j,i)
+        if (intne(ipte2(j,i), itarg2(j,i))) then
+           ! Error #370
+           errors(370) = .true.
+        endif
+
+        rpte2(j,i) = i * (-2.0)
+        if (realne(rpte2(j,i), rtarg2(j,i))) then
+           ! Error #371
+           errors(371) = .true.
+        endif
+
+        rtarg2(j,i) = i * (-3.0)
+        if (realne(rpte2(j,i), rtarg2(j,i))) then
+           ! Error #372
+           errors(372) = .true.
+        endif
+
+        chpte2(j,i) = 'a'
+        if (chne(chpte2(j,i), chtarg2(j,i))) then
+           ! Error #373
+           errors(373) = .true.
+        endif
+
+        chtarg2(j,i) = 'z'
+        if (chne(chpte2(j,i), chtarg2(j,i))) then
+           ! Error #374
+           errors(374) = .true.
+        endif
+
+        ch8pte2(j,i) = 'aaaaaaaa'
+        if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
+           ! Error #375
+           errors(375) = .true.
+        endif
+
+        ch8targ2(j,i) = 'zzzzzzzz'
+        if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
+           ! Error #376
+           errors(376) = .true.
+        endif
+        do k=1,o
+           dpte3(k,j,i)%i2(1+mod(i,5))=i
+           if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
+                dtarg3(k,j,i)%i2(1+mod(i,5)))) then
+              ! Error #377
+              errors(377) = .true.
+           endif
+
+           dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5))
+           if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
+                dtarg3(k,j,i)%i2(1+mod(i,5)))) then
+              ! Error #378
+              errors(378) = .true.
+           endif
+
+           ipte3(k,j,i) = i
+           if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
+              ! Error #379
+              errors(379) = .true.
+           endif
+
+           itarg3(k,j,i) = -ipte3(k,j,i)
+           if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
+              ! Error #380
+              errors(380) = .true.
+           endif
+
+           rpte3(k,j,i) = i * 2.0
+           if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
+              ! Error #381
+              errors(381) = .true.
+           endif
+
+           rtarg3(k,j,i) = i * 3.0
+           if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
+              ! Error #382
+              errors(382) = .true.
+           endif
+
+           chpte3(k,j,i) = 'a'
+           if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
+              ! Error #383
+              errors(383) = .true.
+           endif
+
+           chtarg3(k,j,i) = 'z'
+           if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
+              ! Error #384
+              errors(384) = .true.
+           endif
+
+           ch8pte3(k,j,i) = 'aaaaaaaa'
+           if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
+              ! Error #385
+              errors(385) = .true.
+           endif
+
+           ch8targ3(k,j,i) = 'zzzzzzzz'
+           if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
+              ! Error #386
+              errors(386) = .true.
+           endif
+        end do
+     end do
+  end do
+
+  rtarg3 = .5
+  ! Vector syntax
+  do, i=1,n
+     ipte3 = i
+     rpte3 = rpte3+1
+     do, j=1,m
+        do k=1,o
+           if (intne(itarg3(k,j,i), i)) then
+              ! Error #387
+              errors(387) = .true.
+           endif
+
+           if (realne(rtarg3(k,j,i), i+.5)) then
+              ! Error #388
+              errors(388) = .true.
+           endif
+        end do
+     end do
+  end do
+
+end subroutine ptr12
+
+! Misc
+subroutine ptr13(nnn,mmm)
+  common /errors/errors(400)
+  logical :: errors, intne, realne, chne, ch8ne
+  integer :: nnn,mmm
+  integer :: i,j
+  integer, parameter :: n = 9
+  integer, parameter :: m = 10
+  integer itarg1 (n)
+  integer itarg2 (m,n)
+  real rtarg1(n)
+  real rtarg2(m,n)
+
+  integer ipte1
+  integer ipte2
+  real rpte1
+  real rpte2
+
+  dimension ipte1(n)
+  dimension rpte2(mmm,nnn)
+
+  pointer(iptr4,ipte1)
+  pointer(iptr5,ipte2)
+  pointer(iptr7,rpte1)
+  pointer(iptr8,rpte2)
+
+  dimension ipte2(mmm,nnn)
+  dimension rpte1(n)
+
+  iptr4 = loc(itarg1)
+  iptr5 = loc(itarg2)
+  iptr7 = loc(rtarg1)
+  iptr8 = loc(rtarg2)  
+
+  do, i=1,n
+     ipte1(i) = i
+     if (intne(ipte1(i), itarg1(i))) then
+        ! Error #389
+        errors(389) = .true.
+     endif
+
+     itarg1(i) = -ipte1(i)
+     if (intne(ipte1(i), itarg1(i))) then
+        ! Error #390
+        errors(390) = .true.
+     endif
+
+     rpte1(i) = i * 5.0
+     if (realne(rpte1(i), rtarg1(i))) then
+        ! Error #391
+        errors(391) = .true.
+     endif
+
+     rtarg1(i) = i * (-5.0)
+     if (realne(rpte1(i), rtarg1(i))) then
+        ! Error #392
+        errors(392) = .true.
+     endif
+
+     do, j=1,m
+        ipte2(j,i) = i
+        if (intne(ipte2(j,i), itarg2(j,i))) then
+           ! Error #393
+           errors(393) = .true.
+        endif
+
+        itarg2(j,i) = -ipte2(j,i)
+        if (intne(ipte2(j,i), itarg2(j,i))) then
+           ! Error #394
+           errors(394) = .true.
+        endif
+
+        rpte2(j,i) = i * (-2.0)
+        if (realne(rpte2(j,i), rtarg2(j,i))) then
+           ! Error #395
+           errors(395) = .true.
+        endif
+
+        rtarg2(j,i) = i * (-3.0)
+        if (realne(rpte2(j,i), rtarg2(j,i))) then
+           ! Error #396
+           errors(396) = .true.
+        endif
+
+     end do
+  end do
+end subroutine ptr13
+
+
+! Test the passing of pointers and pointees as parameters
+subroutine parmtest
+  integer, parameter :: n = 12
+  integer, parameter :: m = 13
+  integer iarray(m,n)
+  pointer (ipt,iptee)
+  integer iptee (m,n)
+
+  ipt = loc(iarray)
+  !  write(*,*) "loc(iarray)",loc(iarray)
+  call parmptr(ipt,iarray,n,m)
+  !  write(*,*) "loc(iptee)",loc(iptee)
+  call parmpte(iptee,iarray,n,m)
+end subroutine parmtest
+
+subroutine parmptr(ipointer,intarr,n,m)
+  common /errors/errors(400)
+  logical :: errors, intne
+  integer :: n,m,i,j
+  integer intarr(m,n)
+  pointer (ipointer,newpte)
+  integer newpte(m,n)
+  ! write(*,*) "loc(newpte)",loc(newpte)
+  ! write(*,*) "loc(intarr)",loc(intarr) 
+  ! write(*,*) "loc(newpte(1,1))",loc(newpte(1,1))
+  ! newpte(1,1) = 101
+  ! write(*,*) "newpte(1,1)=",newpte(1,1)
+  ! write(*,*) "intarr(1,1)=",intarr(1,1)
+  do, i=1,n
+     do, j=1,m
+        newpte(j,i) = i
+        if (intne(newpte(j,i),intarr(j,i))) then
+           ! Error #397
+           errors(397) = .true.
+        endif
+
+        call donothing(newpte(j,i),intarr(j,i))
+        intarr(j,i) = -newpte(j,i)
+        if (intne(newpte(j,i),intarr(j,i))) then
+           ! Error #398
+           errors(398) = .true.
+        endif
+     end do
+  end do
+end subroutine parmptr
+
+subroutine parmpte(pointee,intarr,n,m)
+  common /errors/errors(400)
+  logical :: errors, intne
+  integer :: n,m,i,j
+  integer pointee (m,n)
+  integer intarr (m,n)
+  !  write(*,*) "loc(pointee)",loc(pointee)
+  !  write(*,*) "loc(intarr)",loc(intarr)
+  !  write(*,*) "loc(pointee(1,1))",loc(pointee(1,1))
+  !  pointee(1,1) = 99
+  !  write(*,*) "pointee(1,1)=",pointee(1,1)
+  !  write(*,*) "intarr(1,1)=",intarr(1,1)
+
+  do, i=1,n
+     do, j=1,m
+        pointee(j,i) = i
+        if (intne(pointee(j,i),intarr(j,i))) then
+           ! Error #399
+           errors(399) = .true.
+        endif
+
+        intarr(j,i) = 2*pointee(j,i)
+        call donothing(pointee(j,i),intarr(j,i))
+        if (intne(pointee(j,i),intarr(j,i))) then
+           ! Error #400
+           errors(400) = .true.
+        endif
+     end do
+  end do
+end subroutine parmpte
+
+! Separate function calls to break Cray pointer-indifferent optimization
+logical function intne(ii,jj)
+  integer :: i,j
+  common /foo/foo
+  integer foo
+  foo = foo + 1
+  intne = ii.ne.jj
+  if (intne) then
+     write (*,*) ii," doesn't equal ",jj
+  endif
+end function intne
+
+logical function realne(r1,r2)
+  real :: r1, r2  
+  common /foo/foo
+  integer foo
+  foo = foo + 1
+  realne = r1.ne.r2
+  if (realne) then
+     write (*,*) r1," doesn't equal ",r2
+  endif
+end function realne
+
+logical function chne(ch1,ch2)
+  character :: ch1, ch2  
+  common /foo/foo
+  integer foo
+  foo = foo + 1
+  chne = ch1.ne.ch2
+  if (chne) then
+     write (*,*) ch1," doesn't equal ",ch2
+  endif
+end function chne
+
+logical function ch8ne(ch1,ch2)
+  character*8 :: ch1, ch2  
+  common /foo/foo
+  integer foo
+  foo = foo + 1
+  ch8ne = ch1.ne.ch2
+  if (ch8ne) then
+     write (*,*) ch1," doesn't equal ",ch2
+  endif
+end function ch8ne
+
+subroutine donothing(ii,jj)
+  common/foo/foo
+  integer :: ii,jj,foo
+  if (foo.le.1) then
+     foo = 1
+  else
+     foo = foo - 1
+  endif
+  if (foo.eq.0) then
+     ii = -1
+     jj = 1
+!     print *,"Test did not run correctly"
+     call abort()
+  endif
+end subroutine donothing
+
diff --git a/gcc/testsuite/gfortran.dg/cray_pointers_3.f90 b/gcc/testsuite/gfortran.dg/cray_pointers_3.f90
new file mode 100644
index 00000000000..de50eee7744
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/cray_pointers_3.f90
@@ -0,0 +1,5 @@
+! { dg-do compile }
+program crayerr
+  real dpte1(10)
+  pointer (iptr1,dpte1) ! { dg-error "fcray-pointer" }
+end program crayerr
diff --git a/gcc/testsuite/gfortran.dg/loc_1.f90 b/gcc/testsuite/gfortran.dg/loc_1.f90
new file mode 100644
index 00000000000..ef0b1c10280
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/loc_1.f90
@@ -0,0 +1,25 @@
+! { dg-do run }
+
+! This test is here to prevent a regression in gfc_conv_intrinsic_loc.
+! Taking the loc of something in a common block was a special case
+! that caused in internal compiler error in gcc/expr.c, in
+! expand_expr_addr_expr_1().
+program test
+  common /targ/targ
+  integer targ(10)
+  call fn
+end program test
+
+subroutine fn
+  common /targ/targ
+  integer targ(10)
+  call foo (loc (targ)) ! Line that caused ICE
+end subroutine fn
+
+subroutine foo (ii)
+  common /targ/targ
+  integer targ(10)
+  integer ii
+  targ(2) = ii
+end subroutine foo
+
diff --git a/gcc/testsuite/gfortran.dg/loc_2.f90 b/gcc/testsuite/gfortran.dg/loc_2.f90
new file mode 100644
index 00000000000..196dcc6db74
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/loc_2.f90
@@ -0,0 +1,113 @@
+! { dg-do run }
+! Series of routines for testing a loc() implementation
+program test
+  common /errors/errors(12)
+  integer i
+  logical errors
+  errors = .false.
+  call testloc
+  do i=1,12
+     if (errors(i)) then
+        call abort()
+     endif
+  end do
+end program test
+
+! Test loc
+subroutine testloc
+  common /errors/errors(12)
+  logical errors
+  integer, parameter :: n = 9
+  integer, parameter :: m = 10
+  integer, parameter :: o = 11
+  integer :: offset
+  integer :: i,j,k,intsize,realsize,dblsize,chsize,ch8size
+  integer itarg1 (n)
+  integer itarg2 (m,n)
+  integer itarg3 (o,m,n)
+  real rtarg1(n)
+  real rtarg2(m,n)
+  real rtarg3(o,m,n)
+  character chtarg1(n)
+  character chtarg2(m,n)
+  character chtarg3(o,m,n)
+  character*8 ch8targ1(n)
+  character*8 ch8targ2(m,n)
+  character*8 ch8targ3(o,m,n)
+
+  intsize = kind(itarg1(1))
+  realsize = kind(rtarg1(1))
+  chsize = kind(chtarg1(1))*len(chtarg1(1))
+  ch8size = kind(ch8targ1(1))*len(ch8targ1(1))
+
+  do, i=1,n
+     offset = i-1
+     if (loc(itarg1).ne.loc(itarg1(i))-offset*intsize) then
+        ! Error #1
+        errors(1) = .true.
+     end if
+     if (loc(rtarg1).ne.loc(rtarg1(i))-offset*realsize) then
+        ! Error #2
+        errors(2) = .true.
+     end if
+     if (loc(chtarg1).ne.loc(chtarg1(i))-offset*chsize) then
+        ! Error #3
+        errors(3) = .true.
+     end if
+     if (loc(ch8targ1).ne.loc(ch8targ1(i))-offset*ch8size) then
+        ! Error #4
+        errors(4) = .true.
+     end if
+
+     do, j=1,m
+        offset = (j-1)+m*(i-1)
+        if (loc(itarg2).ne. &
+             loc(itarg2(j,i))-offset*intsize) then
+           ! Error #5
+           errors(5) = .true.
+        end if
+        if (loc(rtarg2).ne. &
+             loc(rtarg2(j,i))-offset*realsize) then
+           ! Error #6
+           errors(6) = .true.
+        end if
+        if (loc(chtarg2).ne. &
+             loc(chtarg2(j,i))-offset*chsize) then
+           ! Error #7
+           errors(7) = .true.
+        end if
+        if (loc(ch8targ2).ne. &
+             loc(ch8targ2(j,i))-offset*ch8size) then
+           ! Error #8
+           errors(8) = .true.
+        end if
+
+        do k=1,o
+           offset = (k-1)+o*(j-1)+o*m*(i-1)
+           if (loc(itarg3).ne. &
+                loc(itarg3(k,j,i))-offset*intsize) then
+              ! Error #9
+              errors(9) = .true.
+           end if
+           if (loc(rtarg3).ne. &
+                loc(rtarg3(k,j,i))-offset*realsize) then
+              ! Error #10
+              errors(10) = .true.
+           end if
+           if (loc(chtarg3).ne. &
+                loc(chtarg3(k,j,i))-offset*chsize) then
+              ! Error #11
+              errors(11) = .true.
+           end if
+           if (loc(ch8targ3).ne. &
+                loc(ch8targ3(k,j,i))-offset*ch8size) then
+              ! Error #12
+              errors(12) = .true.
+           end if
+
+        end do
+     end do
+  end do
+
+end subroutine testloc
+